Skip to content

Commit

Permalink
Bilateral mesh loading
Browse files Browse the repository at this point in the history
  • Loading branch information
neurolabusc committed Oct 28, 2020
1 parent 6008b0e commit 6adc969
Show file tree
Hide file tree
Showing 59 changed files with 7,838 additions and 736 deletions.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
2 changes: 1 addition & 1 deletion commandsu.pas
Original file line number Diff line number Diff line change
Expand Up @@ -520,7 +520,7 @@ procedure ATLAS2NODE(lFilename: string);
begin
if not IsReadable(lFilename) then exit;
if not GLForm1.Atlas2Node(lFilename) then begin
GLForm1.ScriptOutputMemo.Lines.Add('Unable to convert labels to nodes (make sure .annot file is loaded)');
GLForm1.ScriptOutputMemo.Lines.Add('Unable to convert mesh to nodes (make sure mesh is not watertight or that .annot file is loaded)');
end;
end;

Expand Down
4 changes: 3 additions & 1 deletion curv.pas
Original file line number Diff line number Diff line change
Expand Up @@ -69,8 +69,10 @@ procedure SaveCurv(fnm: string; k: TFloats; num_f: integer);
CloseFile(f);
except
// If there was an error the reason can be found here
on E: EInOutError do
on E: EInOutError do begin
{$IFDEF UNIX} writeln('Unable to create '+fnm+' Details: '+ E.ClassName+ '/'+ E.Message);{$ENDIF}
Showmessage('Unable to create '+fnm+' Details: '+ E.ClassName+ '/'+ E.Message);
end;
end;
end;

Expand Down
22 changes: 21 additions & 1 deletion define_types.pas
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ interface
{$endif}

const
kVers = 'v1.0.20200729';
kVers = 'v1.0.20201028';
NaN : double = 1/0;
kTab = chr(9);
kCR = chr (13);
Expand Down Expand Up @@ -104,13 +104,33 @@ function Blue(rgb: TColor): BYTE;
{$else}
function asRGBA(clr: TColor): TRGBA;
{$endif}
procedure Xswap4r ( var s:single);

implementation

uses
{$IFDEF UNIX} BaseUnix, {$ELSE} windows, shlobj, {$ENDIF}
{$IFDEF Darwin}CocoaAll,{$ENDIF}
fileutil, sysutils, math;

procedure Xswap4r ( var s:single);
type
swaptype = packed record
case byte of
0:(Word1,Word2 : word); //word is 16 bit
end;
swaptypep = ^swaptype;
var
inguy:swaptypep;
outguy:swaptype;
begin
inguy := @s; //assign address of s to inguy
outguy.Word1 := swap(inguy^.Word2);
outguy.Word2 := swap(inguy^.Word1);
inguy^.Word1 := outguy.Word1;
inguy^.Word2 := outguy.Word2;
end;

function UpCaseExt(lFileName: string): string; // "file.gii.dset" -> ".GII.DSET"
var
fnm : string;
Expand Down
191 changes: 191 additions & 0 deletions dialogsx.pas
Original file line number Diff line number Diff line change
@@ -0,0 +1,191 @@
unit dialogsx;
{$mode Delphi} //{$mode objfpc}
{$Include isgui.inc}
{$H+}
interface
uses

SysUtils,IniFiles;

{$IFNDEF GUI}
type
TMsgDlgBtn = (mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, mbIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp);
TMsgDlgButtons = set of TMsgDlgBtn;
TMsgDlgType = (mtWarning, mtError, mtInformation, mtConfirmation, mtCustom);
{$ENDIF}
procedure Msg (lStr: string);
procedure ShowMsg (lStr: string);
procedure msgfx (a,b,c,d: double); overload; //fx used to help debugging - reports number values
//function MsgDlg(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint): Word;
function GetInt(lStr: string; lMin,lDefault,lMax: integer): integer;
function GetFloat(lStr: string; lMin,lDefault,lMax: single): single;
procedure MyReadLn;//no GUI: waits for user
function GetStr(lPrompt: string): string;
//procedure vx (a,b,c,d: double);

const
mrCancel = 2;
mrAbort = 1;// idAbort
mrNo = 0;
implementation
{$IFDEF GUI}uses
dialogs; {$ENDIF}

procedure vx (a,b,c,d: double); //vx used to help debugging - reports number values
begin
msg(floattostr(a)+':'+floattostr(b)+':'+floattostr(c)+':'+floattostr(d));
end;


procedure MyReadLn;
{$IFDEF GUI}
begin
//do nothing
end;
{$ELSE}
begin
{$IFNDEF UNIX}
if IsConsole then
ReadLn;
{$ENDIF}
end;
{$ENDIF}

function MsgDlg(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint): Word;
{$IFDEF GUI}
begin
result := 0;
ShowMsg('WARNING: MsgDlg not coded. Unabled to process this '+Msg);
{$ELSE}
begin
result := 0;
writeln('WARNING: dialogs not being used. Unabled to process this '+Msg);
{$ENDIF}
end;

procedure ShowMsg (lStr: string);
begin
{$IFDEF GUI}
ShowMessage(lStr); //if you get an error here - adjust isgui.inc
{$ELSE}
writeln(lStr)
{$ENDIF}
end;
procedure msgfx (a,b,c,d: double); overload; //fx used to help debugging - reports number values
begin
{$IFDEF GUI}
msg(floattostr(a)+'x'+floattostr(b)+'x'+floattostr(c)+'x'+floattostr(d));
{$ELSE}
msg(floattostr(a)+'x'+floattostr(b)+'x'+floattostr(c)+'x'+floattostr(d));
{$ENDIF}
end;

procedure Msg (lStr: string);
begin
{$IFDEF GUI}
Showmessage(lStr);
{$ELSE}
writeln(lStr)
{$ENDIF}
end;

function GetStr(lPrompt: string): string;
{$IFDEF GUI}
var
lOK: boolean;
begin
lOK := InputQuery(lPrompt, lPrompt, result);
if not lOK then
result := '';
end;
{$ELSE}
var
lS: string;
begin
writeln ( lPrompt);
readln(lS);
result := lS;
end;
{$ENDIF}

function GetFloat(lStr: string; lMin,lDefault,lMax: single): single;
{$IFDEF GUI}
var
s: string;
begin
s := floattostr(ldefault);
InputQuery('Integer required',lStr,s);
try
result := StrToFloat(S);
except
on Exception : EConvertError do
result := ldefault;
end;
if result < lmin then
result := lmin;
if result > lmax then
result := lmax;
end;
{$ELSE}
var
lS: string;
lError,lI: integer;
begin
writeln ( lStr+' ['+floattostr(lMin)+'..'+floattostr(lMax)+'], default '+floattostr(lDefault));
readln(lS);
Val(lS,lI,lError);
if lError = 0 then
result := (lI)
else begin
writeln(floattostr(lDefault));
result := lDefault;
end;
if result < lMin then
result := lMin;
if result > lMax then
result := lMax;
end;
{$ENDIF}

function GetInt(lStr: string; lMin,lDefault,lMax: integer): integer;
{$IFDEF GUI}
var
s: string;
begin
s := inttostr(ldefault);
InputQuery('Integer required',lStr,s);
try
result := StrToInt(S);
except
on Exception : EConvertError do
result := ldefault;
end;
if result < lmin then
result := lmin;
if result > lmax then
result := lmax;
end;
{$ELSE}
var
lS: string;
lError,lI: integer;
begin
writeln ( lStr+' ['+inttostr(lMin)+'..'+inttostr(lMax)+'], default '+inttostr(lDefault));
readln(lS);
Val(lS,lI,lError);
if lError = 0 then
result := round(lI)
else begin
writeln(inttostr(lDefault));
result := lDefault;
end;
if result < lMin then
result := lMin;
if result > lMax then
result := lMax;
end;
{$ENDIF}


end.

45 changes: 34 additions & 11 deletions gl_core_3d.pas
Original file line number Diff line number Diff line change
Expand Up @@ -5,14 +5,19 @@
interface

uses
{$IFDEF LHRH}meshlhrh,{$ENDIF}
{$IFDEF DGL} dglOpenGL, {$ELSE DGL} {$IFDEF COREGL}glcorearb, {$ELSE} gl, {$ENDIF} {$ENDIF DGL}
gl_core_matrix, Classes, SysUtils, mesh, matMath, Graphics, define_types, Prefs, Track, math;

//procedure LoadBufferData (var faces: TFaces; var vertices: TVertices; var vertexRGBA: TVertexRGBA) ;
//function BuildDisplayList(var faces: TFaces; vertices: TVertices; vRGBA: TVertexRGBA): GLuint;
procedure BuildDisplayList(var faces: TFaces; vertices: TVertices; vRGBA: TVertexRGBA; var vao, vbo: gluint; Clr: TRGBA);
//procedure SetLighting (var lPrefs: TPrefs);
{$IFDEF LHRH}
procedure DrawScene(w,h: integer; isFlipMeshOverlay, isOverlayClipped,isDrawMesh, isMultiSample: boolean; var lPrefs: TPrefs; origin : TPoint3f; ClipPlane: TPoint4f; scale, distance, elevation, azimuth: single; var lMesh: TMeshLHRH; lNode: TMesh; lTrack: TTrack);
{$ELSE}
procedure DrawScene(w,h: integer; isFlipMeshOverlay, isOverlayClipped,isDrawMesh, isMultiSample: boolean; var lPrefs: TPrefs; origin : TPoint3f; ClipPlane: TPoint4f; scale, distance, elevation, azimuth: single; var lMesh,lNode: TMesh; lTrack: TTrack);
{$ENDIF}
//procedure SetCoreUniformsX(lProg: Gluint);
procedure SetTrackUniforms (lineWidth, ScreenPixelX, ScreenPixelY: integer);
//procedure BuildDisplayListStrip(Indices: TInts; Verts, vNorms: TVertices; vRGBA: TVertexRGBA; LineWidth: integer; var vao, vbo: gluint);
Expand Down Expand Up @@ -469,16 +474,18 @@ function Float2Int16(f: single): int16;
else
result := round(f * 32768);
end;*)
function AsGL_INT_2_10_10_10_REV(f: TPoint3f): int32;

function AsGL_INT_2_10_10_10_REV(f: TPoint3f): uint32;
//pack 3 32-bit floats as 10 bit signed integers, assumes floats normalized to -1..1
var
x,y,z: int32;
x,y,z: uint32;
begin
x := (Float2Int16(f.X)) shr 6;
y := (Float2Int16(f.Y)) shr 6;
z := (Float2Int16(f.Z)) shr 6;
x := uint16(Float2Int16(f.X)) shr 6;
y := uint16(Float2Int16(f.Y)) shr 6;
z := uint16(Float2Int16(f.Z)) shr 6;
result := (z shl 20)+ (y shl 10) + (x shl 0);
end;

(*function AsGL_INT_2_10_10_10_REV(f: TPoint3f): int32;
//pack 3 32-bit floats as 10 bit signed integers, assumes floats normalized to -1..1
var
Expand All @@ -490,10 +497,10 @@ function AsGL_INT_2_10_10_10_REV(f: TPoint3f): int32;
result := (z shl 20)+ (y shl 10) + (x shl 0);
end; *)

function AsGL_INT_2_10_10_10_REV_T(f: TPoint3f; g: uint16): int32;
function AsGL_INT_2_10_10_10_REV_T(f: TPoint3f; g: uint16): uint32;
//pack 3 32-bit floats as 10 bit signed integers, assumes floats normalized to -1..1 and uses the 2bit to a int between 0 and 3
var
a,x,y,z: uint16;
a,x,y,z: uint32;
begin
x := uint16(Float2Int16(f.X)) shr 6;
y := uint16(Float2Int16(f.Y)) shr 6;
Expand All @@ -502,7 +509,6 @@ function AsGL_INT_2_10_10_10_REV_T(f: TPoint3f; g: uint16): int32;
result := (a shl 30)+ (z shl 20)+ (y shl 10) + (x shl 0);
end;


procedure BuildDisplayList(var faces: TFaces; vertices: TVertices; vRGBA: TVertexRGBA; var vao, vbo: gluint; Clr: TRGBA);
const
kATTRIB_VERT = 0; //vertex XYZ are positions 0,1,2
Expand Down Expand Up @@ -571,7 +577,7 @@ procedure BuildDisplayList(var faces: TFaces; vertices: TVertices; vRGBA: TVerte
glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, vbo);
glBufferData(GL_ELEMENT_ARRAY_BUFFER, Length(faces)*sizeof(TPoint3i), @faces[0], GL_STATIC_DRAW);
glDeleteBuffers(1, @vbo_point);
end;
end; //BuildDisplayList()

procedure BuildDisplayListStrip(Indices: TInts; vertices, vNorm: TVertices; vRGBA: TVertexRGBA; vType: TInts; LineWidth: integer; var vao, vbo: gluint);
const
Expand Down Expand Up @@ -718,7 +724,7 @@ procedure BuildDisplayListStrip(Indices: TInts; vertices, vNorm: TVertices; vRGB
glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, vbo);
glBufferData(GL_ELEMENT_ARRAY_BUFFER, Length(Indices)*sizeof(int32), @Indices[0], GL_STATIC_DRAW);
glDeleteBuffers(1, @vbo_point);
end;
end; //BuildDisplayListStrip()

procedure SetLighting (var lPrefs: TPrefs);
begin
Expand Down Expand Up @@ -749,7 +755,11 @@ procedure nSetOrtho (w,h: integer; Distance, MaxDistance: single; isMultiSample,
end;
end;

{$IFDEF LHRH}
procedure DrawScene(w,h: integer; isFlipMeshOverlay, isOverlayClipped,isDrawMesh, isMultiSample: boolean; var lPrefs: TPrefs; origin : TPoint3f; ClipPlane: TPoint4f; scale, distance, elevation, azimuth: single; var lMesh: TMeshLHRH; lNode: TMesh; lTrack: TTrack);
{$ELSE}
procedure DrawScene(w,h: integer; isFlipMeshOverlay, isOverlayClipped, isDrawMesh, isMultiSample: boolean; var lPrefs: TPrefs; origin : TPoint3f; ClipPlane: TPoint4f; scale, distance, elevation, azimuth: single; var lMesh,lNode: TMesh; lTrack: TTrack);
{$ENDIF}
//procedure DrawScene(w,h: integer; isDrawMesh, isMultiSample: boolean; var lPrefs: TPrefs; origin : TPoint3f; ClipPlane: TPoint4f; scale, distance, elevation, azimuth: single; var lMesh,lNode: TMesh; lTrack: TTrack);
var
clr: TRGBA;
Expand All @@ -759,7 +769,7 @@ procedure DrawScene(w,h: integer; isFlipMeshOverlay, isOverlayClipped, isDrawMes
glClearColor(red(lPrefs.BackColor)/255, green(lPrefs.BackColor)/255, blue(lPrefs.BackColor)/255, 0); //Set background
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glEnable(GL_DEPTH_TEST);

//distance *= 0.77;
nglMatrixMode(nGL_PROJECTION);
nglLoadIdentity();
nSetOrtho(w, h, Distance, kMaxDistance, isMultiSample, lPrefs.Perspective);
Expand Down Expand Up @@ -802,13 +812,26 @@ procedure DrawScene(w,h: integer; isFlipMeshOverlay, isOverlayClipped, isDrawMes
end;
if (length(lMesh.faces) > 0) then begin
lMesh.isVisible := isDrawMesh;
{$IFDEF LHRH}if not lMesh.isShowLH then lMesh.isVisible := false; {$ENDIF}
RunMeshGLSL (clipPlane, false);
if not isOverlayClipped then
lMesh.DrawGL(clr, asPt4f(2,ClipPlane.Y,ClipPlane.Z,ClipPlane.W), isFlipMeshOverlay )
else
lMesh.DrawGL(clr, clipPlane, isFlipMeshOverlay);
lMesh.isVisible := true;
end;
{$IFDEF LHRH}
if (lMesh.isShowRH) and (length(lMesh.RH.faces) > 0) then begin
lMesh.RH.isVisible := isDrawMesh;
RunMeshGLSL (clipPlane, false);
if not isOverlayClipped then
lMesh.RH.DrawGL(clr, asPt4f(2,ClipPlane.Y,ClipPlane.Z,ClipPlane.W), isFlipMeshOverlay )
else
lMesh.RH.DrawGL(clr, clipPlane, isFlipMeshOverlay);
lMesh.RH.isVisible := true;
end;
{$ENDIF}


end;

Expand Down
Loading

0 comments on commit 6adc969

Please sign in to comment.