diff --git a/lut/Blue-Cyan.clut b/Resources/lut/Blue-Cyan.clut similarity index 100% rename from lut/Blue-Cyan.clut rename to Resources/lut/Blue-Cyan.clut diff --git a/lut/Bronze-Gold.clut b/Resources/lut/Bronze-Gold.clut similarity index 100% rename from lut/Bronze-Gold.clut rename to Resources/lut/Bronze-Gold.clut diff --git a/lut/Electric-Blue.clut b/Resources/lut/Electric-Blue.clut similarity index 100% rename from lut/Electric-Blue.clut rename to Resources/lut/Electric-Blue.clut diff --git a/lut/gold.clut b/Resources/lut/Gold.clut similarity index 100% rename from lut/gold.clut rename to Resources/lut/Gold.clut diff --git a/lut/Kelvin.clut b/Resources/lut/Kelvin.clut similarity index 100% rename from lut/Kelvin.clut rename to Resources/lut/Kelvin.clut diff --git a/lut/Montserrat.json b/Resources/lut/Montserrat.json similarity index 100% rename from lut/Montserrat.json rename to Resources/lut/Montserrat.json diff --git a/lut/montserrat.png b/Resources/lut/Montserrat.png similarity index 100% rename from lut/montserrat.png rename to Resources/lut/Montserrat.png diff --git a/lut/OpenSans.json b/Resources/lut/OpenSans.json similarity index 100% rename from lut/OpenSans.json rename to Resources/lut/OpenSans.json diff --git a/lut/opensans.png b/Resources/lut/OpenSans.png similarity index 100% rename from lut/opensans.png rename to Resources/lut/OpenSans.png diff --git a/lut/Oswald.json b/Resources/lut/Oswald.json similarity index 100% rename from lut/Oswald.json rename to Resources/lut/Oswald.json diff --git a/lut/Oswald.png b/Resources/lut/Oswald.png similarity index 100% rename from lut/Oswald.png rename to Resources/lut/Oswald.png diff --git a/lut/Oxygen.json b/Resources/lut/Oxygen.json similarity index 100% rename from lut/Oxygen.json rename to Resources/lut/Oxygen.json diff --git a/lut/oxygen.png b/Resources/lut/Oxygen.png similarity index 100% rename from lut/oxygen.png rename to Resources/lut/Oxygen.png diff --git a/lut/Roboto.json b/Resources/lut/Roboto.json similarity index 100% rename from lut/Roboto.json rename to Resources/lut/Roboto.json diff --git a/lut/roboto.png b/Resources/lut/Roboto.png similarity index 100% rename from lut/roboto.png rename to Resources/lut/Roboto.png diff --git a/lut/surface.clut b/Resources/lut/Surface.clut similarity index 100% rename from lut/surface.clut rename to Resources/lut/Surface.clut diff --git a/lut/Ubuntu.json b/Resources/lut/Ubuntu.json similarity index 100% rename from lut/Ubuntu.json rename to Resources/lut/Ubuntu.json diff --git a/lut/ubuntu.png b/Resources/lut/Ubuntu.png similarity index 100% rename from lut/ubuntu.png rename to Resources/lut/Ubuntu.png diff --git a/lut/unused/GE_color.clut b/Resources/lut/unused/GE_color.clut similarity index 100% rename from lut/unused/GE_color.clut rename to Resources/lut/unused/GE_color.clut diff --git a/lut/unused/cw_psych.clut b/Resources/lut/unused/cw_psych.clut similarity index 100% rename from lut/unused/cw_psych.clut rename to Resources/lut/unused/cw_psych.clut diff --git a/lut/unused/cwn_clear.clut b/Resources/lut/unused/cwn_clear.clut similarity index 100% rename from lut/unused/cwn_clear.clut rename to Resources/lut/unused/cwn_clear.clut diff --git a/lut/unused/cwn_fidl.clut b/Resources/lut/unused/cwn_fidl.clut similarity index 100% rename from lut/unused/cwn_fidl.clut rename to Resources/lut/unused/cwn_fidl.clut diff --git a/lut/unused/cwn_hsb8.clut b/Resources/lut/unused/cwn_hsb8.clut similarity index 100% rename from lut/unused/cwn_hsb8.clut rename to Resources/lut/unused/cwn_hsb8.clut diff --git a/lut/unused/cwn_raich4.clut b/Resources/lut/unused/cwn_raich4.clut similarity index 100% rename from lut/unused/cwn_raich4.clut rename to Resources/lut/unused/cwn_raich4.clut diff --git a/lut/unused/cwn_videen.clut b/Resources/lut/unused/cwn_videen.clut similarity index 100% rename from lut/unused/cwn_videen.clut rename to Resources/lut/unused/cwn_videen.clut diff --git a/lut/unused/cwp_clear.clut b/Resources/lut/unused/cwp_clear.clut similarity index 100% rename from lut/unused/cwp_clear.clut rename to Resources/lut/unused/cwp_clear.clut diff --git a/lut/unused/cwp_fidl.clut b/Resources/lut/unused/cwp_fidl.clut similarity index 100% rename from lut/unused/cwp_fidl.clut rename to Resources/lut/unused/cwp_fidl.clut diff --git a/lut/unused/cwp_hsb8.clut b/Resources/lut/unused/cwp_hsb8.clut similarity index 100% rename from lut/unused/cwp_hsb8.clut rename to Resources/lut/unused/cwp_hsb8.clut diff --git a/lut/unused/cwp_raich4.clut b/Resources/lut/unused/cwp_raich4.clut similarity index 100% rename from lut/unused/cwp_raich4.clut rename to Resources/lut/unused/cwp_raich4.clut diff --git a/lut/unused/cwp_videen.clut b/Resources/lut/unused/cwp_videen.clut similarity index 100% rename from lut/unused/cwp_videen.clut rename to Resources/lut/unused/cwp_videen.clut diff --git a/lut/unused/electric_blue.clut b/Resources/lut/unused/electric_blue.clut similarity index 100% rename from lut/unused/electric_blue.clut rename to Resources/lut/unused/electric_blue.clut diff --git a/lut/unused/gold.clut b/Resources/lut/unused/gold.clut similarity index 100% rename from lut/unused/gold.clut rename to Resources/lut/unused/gold.clut diff --git a/lut/unused/surface.clut b/Resources/lut/unused/surface.clut similarity index 100% rename from lut/unused/surface.clut rename to Resources/lut/unused/surface.clut diff --git a/lut/unused/x_rain.clut b/Resources/lut/unused/x_rain.clut similarity index 100% rename from lut/unused/x_rain.clut rename to Resources/lut/unused/x_rain.clut diff --git a/script/basic_paint_surface.gls b/Resources/script/basic_paint_surface.gls similarity index 100% rename from script/basic_paint_surface.gls rename to Resources/script/basic_paint_surface.gls diff --git a/script/create_atlas.gls b/Resources/script/create_atlas.gls similarity index 100% rename from script/create_atlas.gls rename to Resources/script/create_atlas.gls diff --git a/script/fmri_mesh.gls b/Resources/script/fmri_mesh.gls similarity index 100% rename from script/fmri_mesh.gls rename to Resources/script/fmri_mesh.gls diff --git a/script/frontal_atlas.gls b/Resources/script/frontal_atlas.gls similarity index 100% rename from script/frontal_atlas.gls rename to Resources/script/frontal_atlas.gls diff --git a/script/hide_curves.gls b/Resources/script/hide_curves.gls similarity index 100% rename from script/hide_curves.gls rename to Resources/script/hide_curves.gls diff --git a/script/mesh.gls b/Resources/script/mesh.gls similarity index 100% rename from script/mesh.gls rename to Resources/script/mesh.gls diff --git a/script/newer_2017.gls b/Resources/script/newer_2017.gls similarity index 100% rename from script/newer_2017.gls rename to Resources/script/newer_2017.gls diff --git a/script/node.gls b/Resources/script/node.gls similarity index 100% rename from script/node.gls rename to Resources/script/node.gls diff --git a/script/shaders.gls b/Resources/script/shaders.gls similarity index 100% rename from script/shaders.gls rename to Resources/script/shaders.gls diff --git a/script/track.gls b/Resources/script/track.gls similarity index 100% rename from script/track.gls rename to Resources/script/track.gls diff --git a/script/unused/caudate_atlas.gls b/Resources/script/unused/caudate_atlas.gls similarity index 100% rename from script/unused/caudate_atlas.gls rename to Resources/script/unused/caudate_atlas.gls diff --git a/script/unused/caudate_atlas_gray.gls b/Resources/script/unused/caudate_atlas_gray.gls similarity index 100% rename from script/unused/caudate_atlas_gray.gls rename to Resources/script/unused/caudate_atlas_gray.gls diff --git a/script/unused/forever.gls b/Resources/script/unused/forever.gls similarity index 100% rename from script/unused/forever.gls rename to Resources/script/unused/forever.gls diff --git a/script/unused/new_2017.gls b/Resources/script/unused/new_2017.gls similarity index 100% rename from script/unused/new_2017.gls rename to Resources/script/unused/new_2017.gls diff --git a/script/unused/outline.gls b/Resources/script/unused/outline.gls similarity index 100% rename from script/unused/outline.gls rename to Resources/script/unused/outline.gls diff --git a/shaders/Default.txt b/Resources/shaders/Default.txt similarity index 100% rename from shaders/Default.txt rename to Resources/shaders/Default.txt diff --git a/shaders/Default_Sky.txt b/Resources/shaders/Default_Sky.txt similarity index 100% rename from shaders/Default_Sky.txt rename to Resources/shaders/Default_Sky.txt diff --git a/shaders/Flat.txt b/Resources/shaders/Flat.txt similarity index 100% rename from shaders/Flat.txt rename to Resources/shaders/Flat.txt diff --git a/shaders/Gooch.txt b/Resources/shaders/Gooch.txt similarity index 100% rename from shaders/Gooch.txt rename to Resources/shaders/Gooch.txt diff --git a/shaders/Grid.txt b/Resources/shaders/Grid.txt similarity index 100% rename from shaders/Grid.txt rename to Resources/shaders/Grid.txt diff --git a/shaders/Heidrich-Seidel.txt b/Resources/shaders/Heidrich-Seidel.txt similarity index 100% rename from shaders/Heidrich-Seidel.txt rename to Resources/shaders/Heidrich-Seidel.txt diff --git a/shaders/Hemispheric.txt b/Resources/shaders/Hemispheric.txt similarity index 100% rename from shaders/Hemispheric.txt rename to Resources/shaders/Hemispheric.txt diff --git a/shaders/HideCurves.txt b/Resources/shaders/HideCurves.txt similarity index 100% rename from shaders/HideCurves.txt rename to Resources/shaders/HideCurves.txt diff --git a/shaders/Kelvin.txt b/Resources/shaders/Kelvin.txt similarity index 100% rename from shaders/Kelvin.txt rename to Resources/shaders/Kelvin.txt diff --git a/shaders/Matte.txt b/Resources/shaders/Matte.txt similarity index 100% rename from shaders/Matte.txt rename to Resources/shaders/Matte.txt diff --git a/shaders/Metal.txt b/Resources/shaders/Metal.txt similarity index 100% rename from shaders/Metal.txt rename to Resources/shaders/Metal.txt diff --git a/shaders/Minimal.txt b/Resources/shaders/Minimal.txt similarity index 100% rename from shaders/Minimal.txt rename to Resources/shaders/Minimal.txt diff --git a/shaders/MixMatch.txt b/Resources/shaders/MixMatch.txt similarity index 100% rename from shaders/MixMatch.txt rename to Resources/shaders/MixMatch.txt diff --git a/shaders/Oren-Nayer.txt b/Resources/shaders/Oren-Nayer.txt similarity index 100% rename from shaders/Oren-Nayer.txt rename to Resources/shaders/Oren-Nayer.txt diff --git a/shaders/Outline.txt b/Resources/shaders/Outline.txt similarity index 100% rename from shaders/Outline.txt rename to Resources/shaders/Outline.txt diff --git a/shaders/Phong.txt b/Resources/shaders/Phong.txt similarity index 100% rename from shaders/Phong.txt rename to Resources/shaders/Phong.txt diff --git a/shaders/PhongX.txt b/Resources/shaders/PhongX.txt similarity index 100% rename from shaders/PhongX.txt rename to Resources/shaders/PhongX.txt diff --git a/shaders/Phong_Matte.txt b/Resources/shaders/Phong_Matte.txt similarity index 100% rename from shaders/Phong_Matte.txt rename to Resources/shaders/Phong_Matte.txt diff --git a/shaders/Squares.txt b/Resources/shaders/Squares.txt similarity index 100% rename from shaders/Squares.txt rename to Resources/shaders/Squares.txt diff --git a/shaders/Toon.txt b/Resources/shaders/Toon.txt similarity index 100% rename from shaders/Toon.txt rename to Resources/shaders/Toon.txt diff --git a/shaders/Unused/Danny.txt b/Resources/shaders/Unused/Danny.txt similarity index 100% rename from shaders/Unused/Danny.txt rename to Resources/shaders/Unused/Danny.txt diff --git a/shaders/Unused/FloorReflect.txt b/Resources/shaders/Unused/FloorReflect.txt similarity index 100% rename from shaders/Unused/FloorReflect.txt rename to Resources/shaders/Unused/FloorReflect.txt diff --git a/shaders/Unused/NightVision.txt b/Resources/shaders/Unused/NightVision.txt similarity index 100% rename from shaders/Unused/NightVision.txt rename to Resources/shaders/Unused/NightVision.txt diff --git a/shaders/Unused/Simon.txt b/Resources/shaders/Unused/Simon.txt similarity index 100% rename from shaders/Unused/Simon.txt rename to Resources/shaders/Unused/Simon.txt diff --git a/shaders/Unused/mini.txt b/Resources/shaders/Unused/mini.txt similarity index 100% rename from shaders/Unused/mini.txt rename to Resources/shaders/Unused/mini.txt diff --git a/shaders/Ward.txt b/Resources/shaders/Ward.txt similarity index 100% rename from shaders/Ward.txt rename to Resources/shaders/Ward.txt diff --git a/shaders/Wire.txt b/Resources/shaders/Wire.txt similarity index 100% rename from shaders/Wire.txt rename to Resources/shaders/Wire.txt diff --git a/shaders/Wireframe.txt b/Resources/shaders/Wireframe.txt similarity index 100% rename from shaders/Wireframe.txt rename to Resources/shaders/Wireframe.txt diff --git a/shaders/xExploded.txt b/Resources/shaders/xExploded.txt similarity index 100% rename from shaders/xExploded.txt rename to Resources/shaders/xExploded.txt diff --git a/shaders/xGaps.txt b/Resources/shaders/xGaps.txt similarity index 100% rename from shaders/xGaps.txt rename to Resources/shaders/xGaps.txt diff --git a/shaders/xNormals.txt b/Resources/shaders/xNormals.txt similarity index 100% rename from shaders/xNormals.txt rename to Resources/shaders/xNormals.txt diff --git a/shadersOld/Default.txt b/Resources/shadersOld/Default.txt similarity index 100% rename from shadersOld/Default.txt rename to Resources/shadersOld/Default.txt diff --git a/shadersOld/Default_Sky.txt b/Resources/shadersOld/Default_Sky.txt similarity index 100% rename from shadersOld/Default_Sky.txt rename to Resources/shadersOld/Default_Sky.txt diff --git a/shadersOld/Fastest.txt b/Resources/shadersOld/Fastest.txt similarity index 100% rename from shadersOld/Fastest.txt rename to Resources/shadersOld/Fastest.txt diff --git a/shadersOld/Flat.txt b/Resources/shadersOld/Flat.txt similarity index 100% rename from shadersOld/Flat.txt rename to Resources/shadersOld/Flat.txt diff --git a/shadersOld/Gooch.txt b/Resources/shadersOld/Gooch.txt similarity index 100% rename from shadersOld/Gooch.txt rename to Resources/shadersOld/Gooch.txt diff --git a/shadersOld/Grid.txt b/Resources/shadersOld/Grid.txt similarity index 100% rename from shadersOld/Grid.txt rename to Resources/shadersOld/Grid.txt diff --git a/shadersOld/Heidrich-Seidel.txt b/Resources/shadersOld/Heidrich-Seidel.txt similarity index 100% rename from shadersOld/Heidrich-Seidel.txt rename to Resources/shadersOld/Heidrich-Seidel.txt diff --git a/shadersOld/Hemispheric.txt b/Resources/shadersOld/Hemispheric.txt similarity index 100% rename from shadersOld/Hemispheric.txt rename to Resources/shadersOld/Hemispheric.txt diff --git a/shadersOld/Matte.txt b/Resources/shadersOld/Matte.txt similarity index 100% rename from shadersOld/Matte.txt rename to Resources/shadersOld/Matte.txt diff --git a/shadersOld/Metal.txt b/Resources/shadersOld/Metal.txt similarity index 100% rename from shadersOld/Metal.txt rename to Resources/shadersOld/Metal.txt diff --git a/shadersOld/Minimal.txt b/Resources/shadersOld/Minimal.txt similarity index 100% rename from shadersOld/Minimal.txt rename to Resources/shadersOld/Minimal.txt diff --git a/shadersOld/MixMatch.txt b/Resources/shadersOld/MixMatch.txt similarity index 100% rename from shadersOld/MixMatch.txt rename to Resources/shadersOld/MixMatch.txt diff --git a/shadersOld/Oren-Nayer.txt b/Resources/shadersOld/Oren-Nayer.txt similarity index 100% rename from shadersOld/Oren-Nayer.txt rename to Resources/shadersOld/Oren-Nayer.txt diff --git a/shadersOld/Outline.txt b/Resources/shadersOld/Outline.txt similarity index 100% rename from shadersOld/Outline.txt rename to Resources/shadersOld/Outline.txt diff --git a/shadersOld/Phong.txt b/Resources/shadersOld/Phong.txt similarity index 100% rename from shadersOld/Phong.txt rename to Resources/shadersOld/Phong.txt diff --git a/shadersOld/Phong_Matte.txt b/Resources/shadersOld/Phong_Matte.txt similarity index 100% rename from shadersOld/Phong_Matte.txt rename to Resources/shadersOld/Phong_Matte.txt diff --git a/shadersOld/Toon.txt b/Resources/shadersOld/Toon.txt similarity index 100% rename from shadersOld/Toon.txt rename to Resources/shadersOld/Toon.txt diff --git a/shadersOld/Ward.txt b/Resources/shadersOld/Ward.txt similarity index 100% rename from shadersOld/Ward.txt rename to Resources/shadersOld/Ward.txt diff --git a/shadersOld/Wire.txt b/Resources/shadersOld/Wire.txt similarity index 100% rename from shadersOld/Wire.txt rename to Resources/shadersOld/Wire.txt diff --git a/shadersOld/Wireframe.txt b/Resources/shadersOld/Wireframe.txt similarity index 100% rename from shadersOld/Wireframe.txt rename to Resources/shadersOld/Wireframe.txt diff --git a/shadersOld/xExploded.txt b/Resources/shadersOld/xExploded.txt similarity index 100% rename from shadersOld/xExploded.txt rename to Resources/shadersOld/xExploded.txt diff --git a/shadersOld/xGaps.txt b/Resources/shadersOld/xGaps.txt similarity index 100% rename from shadersOld/xGaps.txt rename to Resources/shadersOld/xGaps.txt diff --git a/colorTable.pas b/colorTable.pas index 346319d..7626ea2 100755 --- a/colorTable.pas +++ b/colorTable.pas @@ -159,7 +159,7 @@ function loadCustomLUT(var lIndex: integer): TLUTnodes; setNode(0,0,0,0,0, 0, result); setNode(255,255,255,255,255, 1, result); result.isFreeSurfer:= false; - lFilename := CLUTdir+pathdelim+GLForm1.LUTdrop.Items[lIndex]+'.clut'; + lFilename := CLUTdir+pathdelim+GLForm1.LayerColorDrop.Items[lIndex]+'.clut'; if not fileexists(lFilename) then begin lIndex := 0; exit; @@ -263,9 +263,14 @@ function makeLUT(var lIndex: integer): TLUTnodes; end; 15: begin //FreeSurferCurve - valleys dark result.isFreeSurfer:= true; - setNode(0,0,0,0,0, 0, result); - setNode(0,0,0,0,156, 1, result); - setNode(0,0,0,255,255, 2, result); + setNode( 0, 0, 0, 0, 0, 0, result); + setNode( 0, 0, 0, 0,136, 1, result); + setNode( 0, 0, 0,140,155, 2, result); + setNode( 0, 0, 0,200,255, 3, result); + + //setNode(255,0,0,255,0, 0, result); + //setNode(0,255,0,0,156, 1, result); + //setNode(0,0,255,255,255, 2, result); end; 16: begin //FreeSurferCurve - curves (valleys and ridges) dark @@ -335,6 +340,8 @@ function UpdateTransferFunction (var lIndex: integer; isInvert: boolean): TLUT;/ result[255].A := rev[255].A; end; if lLUTNodes.isFreeSurfer then begin + //for lInc := 1 to 255 do + // result[lInc].A := 128; //result[255].R := 0; //result[255].G := 0; //result[255].B := 0; diff --git a/commandsu.pas b/commandsu.pas index 0693a51..b874399 100755 --- a/commandsu.pas +++ b/commandsu.pas @@ -159,12 +159,15 @@ procedure WAIT (MSEC: integer); implementation uses //{$IFDEF UNIX}fileutil,{$ENDIF} - mainunit, define_types, shaderui, graphics, LCLintf, Forms, SysUtils, Dialogs, scriptengine, mesh, meshify; + mainunit, define_types, shaderui, graphics, LCLintf, Forms, SysUtils, Dialogs, mesh, meshify; procedure SCRIPTFORMVISIBLE (VISIBLE: boolean); begin - GLForm1.ScriptMenuClick(nil); - ScriptForm.visible := VISIBLE; + //ScriptForm.visible := VISIBLE; + if (GLForm1.ScriptPanel.Width < 24) and (VISIBLE) then + GLForm1.ScriptPanel.Width := 240; + if (not VISIBLE) then + GLForm1.ScriptPanel.Width := 0; end; function ATLASMAXINDEX(OVERLAY: integer): integer; @@ -174,7 +177,7 @@ function ATLASMAXINDEX(OVERLAY: integer): integer; else result := gMesh.overlay[OVERLAY].atlasMaxIndex; if result < 1 then - ScriptForm.Memo2.Lines.Add('Current mesh is not an atlas.'); + GLForm1.ScriptOutputMemo.Lines.Add('Current mesh is not an atlas.'); end; procedure ATLASGRAYBG(const Filt: array of integer); @@ -327,16 +330,15 @@ procedure ATLASSTATMAP(ATLASNAME, STATNAME: string; const Indices: array of inte STATNAME := DefaultToHomeDir(STATNAME); STATNAME := changefileext(STATNAME,'.mz3'); gMesh.SaveOverlay(STATNAME, gMesh.OpenOverlays); - ScriptForm.Memo2.Lines.Add('Creating mesh '+STATNAME); + GLForm1.ScriptOutputMemo.Lines.Add('Creating mesh '+STATNAME); end; //err := gMesh.AtlasStatMapCore(AtlasName, StatName, idxs, intens); 123: if err <> '' then //report error - ScriptForm.Memo2.Lines.Add('ATLASSTATMAP: '+err); + GLForm1.ScriptOutputMemo.Lines.Add('ATLASSTATMAP: '+err); GLForm1.GLboxRequestUpdate(nil); GLForm1.UpdateToolbar; - GLForm1.StringGrid1.RowCount := gMesh.OpenOverlays+1; - GLForm1.UpdateOverlaySpread; + GLForm1.UpdateLayerBox(true); end; procedure BMPZOOM(Z: byte); @@ -454,32 +456,32 @@ procedure MESHCREATE(niiname, meshname: string; threshold, decimateFrac: single; begin //Nii2MeshCore(niiname, meshname: string; threshold, decimateFrac: single; minimumClusterVox, smoothStyle: integer): integer; if (niiname = '') then begin - ScriptForm.Memo2.Lines.Add('meshcreate error: no NIfTI name'); + GLForm1.ScriptOutputMemo.Lines.Add('meshcreate error: no NIfTI name'); exit; end; if (meshname = '') then begin - ScriptForm.Memo2.Lines.Add('meshcreate error: no mesh name'); + GLForm1.ScriptOutputMemo.Lines.Add('meshcreate error: no mesh name'); exit; end; meshnamePth := DefaultToHomeDir(meshname); nVtx := Nii2MeshCore(niiname, meshnamePth, threshold, decimateFrac, minimumClusterVox, smoothStyle); if (nVtx < 3) then - ScriptForm.Memo2.Lines.Add('meshcreate error: no mesh created') + GLForm1.ScriptOutputMemo.Lines.Add('meshcreate error: no mesh created') else - ScriptForm.Memo2.Lines.Add('meshcreate generated mesh with '+inttostr(nVtx)+' vertices'); + GLForm1.ScriptOutputMemo.Lines.Add('meshcreate generated mesh with '+inttostr(nVtx)+' vertices'); end; procedure MESHLOAD(lFilename: string); begin if not GLForm1.OpenMesh(lFilename) then begin - ScriptForm.Memo2.Lines.Add('Unable to load mesh named "'+lFilename+'"'); + GLForm1.ScriptOutputMemo.Lines.Add('Unable to load mesh named "'+lFilename+'"'); end; end; procedure MESHSAVE(lFilename: string); begin if not GLForm1.SaveMeshCore(lFilename) then begin - ScriptForm.Memo2.Lines.Add('Unable to save mesh named "'+lFilename+'"'); + GLForm1.ScriptOutputMemo.Lines.Add('Unable to save mesh named "'+lFilename+'"'); end; end; @@ -492,25 +494,25 @@ procedure MESHOVERLAYORDER (FLIP: boolean); procedure OVERLAYLOAD(lFilename: string); begin if not GLForm1.OpenOverlay(lFilename)then - ScriptForm.Memo2.Lines.Add('Unable to load overlay named "'+lFilename+'"'); + GLForm1.ScriptOutputMemo.Lines.Add('Unable to load overlay named "'+lFilename+'"'); end; procedure TRACKLOAD(lFilename: string); begin if not GLForm1.OpenTrack(lFilename) then - ScriptForm.Memo2.Lines.Add('Unable to load track named "'+lFilename+'"'); + GLForm1.ScriptOutputMemo.Lines.Add('Unable to load track named "'+lFilename+'"'); end; procedure NODELOAD(lFilename: string); begin if not GLForm1.OpenNode(lFilename) then - ScriptForm.Memo2.Lines.Add('Unable to load node named "'+lFilename+'"'); + GLForm1.ScriptOutputMemo.Lines.Add('Unable to load node named "'+lFilename+'"'); end; procedure EDGELOAD(lFilename: string); begin if not GLForm1.OpenEdge(lFilename)then - ScriptForm.Memo2.Lines.Add('Unable to load edge named "'+lFilename+'"'); + GLForm1.ScriptOutputMemo.Lines.Add('Unable to load edge named "'+lFilename+'"'); end; procedure SHADERNAME(lFilename: string); @@ -601,8 +603,8 @@ procedure MODALMESSAGE(STR: string); procedure MODELESSMESSAGE(STR: string); begin - ScriptForm.Memo2.Lines.Add(STR); - ScriptForm.Refresh; + GLForm1.ScriptOutputMemo.Lines.Add(STR); + GLForm1.Refresh; end; procedure NODECOLOR(name: string; varies: boolean); @@ -664,7 +666,7 @@ procedure EDGECREATE(filename: string; const mtx: array of single); n := length(mtx); nRow := round(sqrt(n)); if (n < 1) or ((nRow * nRow) <> n) then begin - ScriptForm.Memo2.Lines.Add('EDGECREATE expects a matrix that has a size of n*n. For example, a connectome with 3 nodes should have a matrix with 9 items.'); + GLForm1.ScriptOutputMemo.Lines.Add('EDGECREATE expects a matrix that has a size of n*n. For example, a connectome with 3 nodes should have a matrix with 9 items.'); exit; end; //write output @@ -691,9 +693,9 @@ procedure EDGECREATE(filename: string; const mtx: array of single); CloseFile(f); FileMode := fmOpenRead; if not GLForm1.OpenEdge(fnm) then - ScriptForm.Memo2.Lines.Add('EDGECREATE Unable to load edge file named "'+fnm+'" (use nodecreate or nodeload first) ') + GLForm1.ScriptOutputMemo.Lines.Add('EDGECREATE Unable to load edge file named "'+fnm+'" (use nodecreate or nodeload first) ') else - ScriptForm.Memo2.Lines.Add('EDGECREATE created "'+fnm+'"') + GLForm1.ScriptOutputMemo.Lines.Add('EDGECREATE created "'+fnm+'"') end; procedure NODECREATE(filename: string; const x,y,z,clr,radius: array of single); @@ -705,15 +707,15 @@ procedure NODECREATE(filename: string; const x,y,z,clr,radius: array of single); begin n := length(x); if (n < 1) or (n <> length(y)) or (n <> length(z)) then begin - ScriptForm.Memo2.Lines.Add('NODECREATE error: x,y,z must have same number of nodes'); + GLForm1.ScriptOutputMemo.Lines.Add('NODECREATE error: x,y,z must have same number of nodes'); exit; end; if (length(clr) > 1) and (length(clr) <> n) then begin - ScriptForm.Memo2.Lines.Add('NODECREATE error: color must have same number of items as x,y and z'); + GLForm1.ScriptOutputMemo.Lines.Add('NODECREATE error: color must have same number of items as x,y and z'); exit; end; if (length(radius) > 1) and (length(radius) <> n) then begin - ScriptForm.Memo2.Lines.Add('NODECREATE error: radius must have same number of items as x,y and z'); + GLForm1.ScriptOutputMemo.Lines.Add('NODECREATE error: radius must have same number of items as x,y and z'); exit; end; //set color @@ -756,9 +758,9 @@ procedure NODECREATE(filename: string; const x,y,z,clr,radius: array of single); CloseFile(f); FileMode := fmOpenRead; if not GLForm1.OpenNode(fnm) then - ScriptForm.Memo2.Lines.Add('NODECREATE Unable to load node named "'+fnm+'"') + GLForm1.ScriptOutputMemo.Lines.Add('NODECREATE Unable to load node named "'+fnm+'"') else - ScriptForm.Memo2.Lines.Add('NODECREATE created "'+fnm+'"') + GLForm1.ScriptOutputMemo.Lines.Add('NODECREATE created "'+fnm+'"') end; procedure NODESIZE(size: single; varies: boolean); diff --git a/define_types.pas b/define_types.pas index b9a903c..0ab0fce 100755 --- a/define_types.pas +++ b/define_types.pas @@ -4,7 +4,7 @@ interface uses graphics; {$endif} const - kVers = 'v1.0.20180622'; + kVers = 'v1.0.20181114)'; NaN : double = 1/0; kTab = chr(9); kCR = chr (13); diff --git a/mainunit.lfm b/mainunit.lfm index 13ef12e..816c5f3 100755 --- a/mainunit.lfm +++ b/mainunit.lfm @@ -1,11 +1,11 @@ object GLForm1: TGLForm1 Left = 253 - Height = 699 - Top = 23 + Height = 684 + Top = 22 Width = 1027 AllowDropFiles = True Caption = 'Surf Ice' - ClientHeight = 699 + ClientHeight = 684 ClientWidth = 1027 Menu = MainMenu1 OnChangeBounds = FormChangeBounds @@ -15,44 +15,212 @@ object GLForm1: TGLForm1 OnDropFiles = FormDropFiles OnShow = FormShow Position = poDesktopCenter - LCLVersion = '1.9.0.0' - object ToolPanel: TPanel + LCLVersion = '2.1.0.0' + object ToolPanel: TScrollBox Left = 0 - Height = 699 + Height = 684 Top = 0 - Width = 272 + Width = 261 + HorzScrollBar.Page = 1 + HorzScrollBar.Visible = False + VertScrollBar.Page = 682 Align = alLeft - BevelOuter = bvSpace - ClientHeight = 699 - ClientWidth = 272 + ClientHeight = 682 + ClientWidth = 244 + Constraints.MaxWidth = 272 + Constraints.MinWidth = 4 ParentFont = False - TabOrder = 1 + TabOrder = 2 + object OverlayBox: TGroupBox + Left = 0 + Height = 187 + Hint = 'Click on name to hide, control+click to reverse palette' + Top = 0 + Width = 244 + Align = alTop + AutoSize = True + Caption = 'Overlays' + ClientHeight = 169 + ClientWidth = 236 + Constraints.MinHeight = 2 + ParentFont = False + ParentShowHint = False + ShowHint = True + TabOrder = 1 + Visible = False + object LayerList: TCheckListBox + Left = 0 + Height = 72 + Hint = 'Right-click for options' + Top = 0 + Width = 236 + Align = alTop + Constraints.MaxHeight = 72 + ItemHeight = 0 + OnClickCheck = LayerListClickCheck + OnSelectionChange = LayerListSelectionChange + OnShowHint = LayerListShowHint + ParentFont = False + ParentShowHint = False + PopupMenu = LayerPopup + ShowHint = True + TabOrder = 4 + end + object LayerDarkLabel: TLabel + AnchorSideLeft.Control = LayerList + AnchorSideTop.Control = LayerDarkEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 16 + Top = 100 + Width = 47 + Caption = 'Darkest' + ParentColor = False + ParentFont = False + end + object LayerDarkEdit: TEdit + AnchorSideTop.Control = LayerColorDrop + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 122 + Height = 21 + Top = 98 + Width = 116 + BorderSpacing.Left = 122 + BorderSpacing.Top = 2 + OnKeyUp = LayerContrastKeyUp + ParentFont = False + TabOrder = 5 + Text = '20' + end + object LayerBrightEdit: TEdit + AnchorSideTop.Control = LayerDarkEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 122 + Height = 21 + Top = 121 + Width = 116 + BorderSpacing.Left = 122 + BorderSpacing.Top = 2 + OnKeyUp = LayerContrastKeyUp + ParentFont = False + TabOrder = 0 + Text = '80' + end + object LayerBrightLabel: TLabel + AnchorSideLeft.Control = LayerList + AnchorSideTop.Control = LayerBrightEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 16 + Top = 123 + Width = 55 + Caption = 'Brightest' + ParentColor = False + ParentFont = False + end + object LayerColorDrop: TComboBox + AnchorSideLeft.Control = LayerList + AnchorSideTop.Control = LayerList + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 20 + Top = 76 + Width = 137 + BorderSpacing.Top = 4 + ItemHeight = 26 + ItemIndex = 0 + Items.Strings = ( + 'Grayscale' + ) + OnChange = LayerWidgetChange + ParentFont = False + Style = csDropDownList + TabOrder = 1 + Text = 'Grayscale' + end + object LayerAlphaLabel: TLabel + AnchorSideLeft.Control = LayerList + AnchorSideTop.Control = LayerAlphaTrack + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 16 + Top = 148 + Width = 47 + Caption = 'Opacity' + ParentColor = False + ParentFont = False + end + object LayerAlphaTrack: TTrackBar + AnchorSideTop.Control = LayerBrightEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 122 + Height = 25 + Top = 144 + Width = 116 + Max = 2 + Position = 2 + TickStyle = tsNone + BorderSpacing.Left = 122 + BorderSpacing.Top = 2 + OnMouseUp = LayerAlphaTrackMouseUp + ParentFont = False + TabOrder = 2 + end + object LayerOptionsBtn: TButton + AnchorSideLeft.Control = LayerColorDrop + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = LayerColorDrop + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = LayerList + AnchorSideRight.Side = asrBottom + Left = 143 + Height = 25 + Top = 74 + Width = 88 + BorderSpacing.Left = 6 + Caption = 'Options' + OnClick = LayerOptionsBtnClick + ParentFont = False + TabOrder = 3 + end + end object ClipBox: TGroupBox - Left = 1 - Height = 110 - Top = 559 - Width = 270 + Left = 0 + Height = 114 + Top = 317 + Width = 244 Align = alTop + AutoSize = True Caption = 'Clipping' - ClientHeight = 88 - ClientWidth = 256 + ClientHeight = 96 + ClientWidth = 236 ParentFont = False - TabOrder = 1 + TabOrder = 0 OnDblClick = DepthLabelDblClick object DepthLabel: TLabel - Left = 4 + AnchorSideLeft.Control = ClipBox + AnchorSideTop.Control = ClipTrack + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 2 + Top = 9 Width = 37 + BorderSpacing.Left = 2 Caption = 'Depth' ParentColor = False ParentFont = False OnClick = DepthLabelClick end object AzimuthLabel: TLabel - Left = 4 + AnchorSideLeft.Control = DepthLabel + AnchorSideTop.Control = ClipAziTrack + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 32 + Top = 41 Width = 50 Caption = 'Azimuth' ParentColor = False @@ -60,9 +228,12 @@ object GLForm1: TGLForm1 OnClick = AzimuthLabelClick end object ElevationLabel: TLabel - Left = 4 + AnchorSideLeft.Control = DepthLabel + AnchorSideTop.Control = ClipElevTrack + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 62 + Top = 73 Width = 55 Caption = 'Elevation' ParentColor = False @@ -70,124 +241,185 @@ object GLForm1: TGLForm1 OnClick = ElevationLabelClick end object ClipTrack: TTrackBar - Left = 70 + AnchorSideLeft.Control = ElevationLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ClipBox + AnchorSideRight.Control = ClipBox + AnchorSideRight.Side = asrBottom + Left = 61 Height = 30 - Top = 0 - Width = 190 + Top = 2 + Width = 172 Max = 1000 OnChange = ClipTrackChange Position = 0 TickStyle = tsNone + BorderSpacing.Left = 4 + BorderSpacing.Top = 2 + BorderSpacing.Right = 2 ParentFont = False TabOrder = 0 end object ClipAziTrack: TTrackBar - Left = 70 + AnchorSideLeft.Control = ClipTrack + AnchorSideTop.Control = ClipTrack + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ClipTrack + AnchorSideRight.Side = asrBottom + Left = 61 Height = 30 - Top = 30 - Width = 190 + Top = 34 + Width = 172 Max = 360 OnChange = ClipTrackChange Position = 180 TickStyle = tsNone + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 ParentFont = False TabOrder = 1 end object ClipElevTrack: TTrackBar - Left = 70 + AnchorSideLeft.Control = ClipTrack + AnchorSideTop.Control = ClipAziTrack + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ClipTrack + AnchorSideRight.Side = asrBottom + Left = 61 Height = 30 - Top = 60 - Width = 190 + Top = 66 + Width = 172 Max = 180 Min = -180 OnChange = ClipTrackChange Position = 0 TickStyle = tsNone + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 ParentFont = False TabOrder = 2 end end object TrackBox: TGroupBox Tag = 270 - Left = 1 - Height = 135 - Top = 1 - Width = 270 + Left = 0 + Height = 130 + Top = 187 + Width = 244 Align = alTop + AutoSize = True Caption = 'Tracks' - ClientHeight = 113 - ClientWidth = 256 + ClientHeight = 112 + ClientWidth = 236 ParentFont = False - TabOrder = 3 + TabOrder = 2 Visible = False object TrackLengthLabel: TLabel - Left = 4 + AnchorSideLeft.Control = TrackBox + AnchorSideTop.Control = TrackLengthTrack + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 2 + Top = 8 Width = 42 + BorderSpacing.Left = 2 Caption = 'Length' ParentColor = False ParentFont = False end object TrackLengthTrack: TTrackBar - Left = 98 + AnchorSideLeft.Control = TrackLengthLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = TrackBox + AnchorSideRight.Control = TrackBox + AnchorSideRight.Side = asrBottom + Left = 50 Height = 28 - Top = 0 - Width = 162 + Top = 2 + Width = 172 Max = 100 OnChange = TrackBoxChange Position = 20 TickStyle = tsNone + BorderSpacing.Left = 6 + BorderSpacing.Top = 2 + BorderSpacing.Right = 2 ParentFont = False TabOrder = 0 end object TrackWidthTrack: TTrackBar - Left = 98 + AnchorSideLeft.Control = TrackLengthTrack + AnchorSideTop.Control = TrackLengthTrack + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = TrackLengthTrack + AnchorSideRight.Side = asrBottom + Left = 50 Height = 28 - Top = 30 - Width = 162 + Top = 32 + Width = 172 Max = 12 Min = 1 OnChange = TrackBoxChange Position = 2 TickStyle = tsNone + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 ParentFont = False TabOrder = 1 end object TrackWidthLabel: TLabel - Left = 4 + AnchorSideLeft.Control = TrackBox + AnchorSideTop.Control = TrackWidthTrack + AnchorSideTop.Side = asrCenter + Left = 0 Height = 16 - Top = 32 + Top = 38 Width = 36 Caption = 'Width' ParentColor = False ParentFont = False end object TrackDitherTrack: TTrackBar - Left = 98 + AnchorSideLeft.Control = TrackLengthTrack + AnchorSideTop.Control = TrackWidthTrack + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = TrackLengthTrack + AnchorSideRight.Side = asrBottom + Left = 50 Height = 28 - Top = 60 - Width = 162 + Top = 62 + Width = 172 OnChange = TrackBoxChange Position = 5 TickStyle = tsNone + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 ParentFont = False TabOrder = 2 end object TrackDitherLabel: TLabel - Left = 4 + AnchorSideLeft.Control = TrackLengthLabel + AnchorSideTop.Control = TrackDitherTrack + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 62 + Top = 68 Width = 37 Caption = 'Dither' ParentColor = False ParentFont = False end object TrackScalarLUTdrop: TComboBox - Left = 116 - Height = 26 - Top = 90 + AnchorSideLeft.Control = TrackScalarNameDrop + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = TrackDitherTrack + AnchorSideTop.Side = asrBottom + Left = 112 + Height = 20 + Top = 92 Width = 108 + BorderSpacing.Left = 2 + BorderSpacing.Top = 2 DropDownCount = 22 ItemHeight = 26 Items.Strings = ( @@ -206,9 +438,12 @@ object GLForm1: TGLForm1 Text = '0' end object TrackScalarNameDrop: TComboBox - Left = 4 - Height = 26 - Top = 90 + AnchorSideLeft.Control = TrackLengthLabel + AnchorSideTop.Control = TrackScalarLUTdrop + AnchorSideTop.Side = asrCenter + Left = 2 + Height = 20 + Top = 92 Width = 108 DropDownCount = 22 ItemHeight = 26 @@ -223,111 +458,62 @@ object GLForm1: TGLForm1 Text = 'Direction' end object TrackScalarRangeBtn: TButton - Left = 232 + AnchorSideLeft.Control = TrackScalarLUTdrop + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = TrackScalarLUTdrop + AnchorSideTop.Side = asrCenter + Left = 222 Height = 20 - Top = 90 + Top = 92 Width = 28 + BorderSpacing.Left = 2 Caption = '...' OnClick = TrackScalarRangeBtnClick ParentFont = False TabOrder = 5 end end - object OverlayBox: TGroupBox - Left = 1 - Height = 82 - Hint = 'Click on name to hide, control+click to reverse palette' - Top = 391 - Width = 270 - Align = alTop - Caption = 'Overlays' - ClientHeight = 60 - ClientWidth = 256 - Constraints.MaxHeight = 240 - Constraints.MinHeight = 2 - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 2 - Visible = False - object StringGrid1: TStringGrid - Left = 0 - Height = 60 - Hint = 'Click on name to hide, control+click to reverse palette' - Top = 0 - Width = 256 - Align = alClient - BorderStyle = bsNone - ColCount = 4 - DefaultColWidth = 66 - DefaultRowHeight = 24 - FixedCols = 2 - Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected, goEditing, goTabs, goAlwaysShowEditor, goSmoothScroll] - ParentFont = False - ParentShowHint = False - RowCount = 2 - ScrollBars = ssAutoVertical - ShowHint = True - TabOrder = 0 - OnDrawCell = StringGrid1DrawCell - OnEditingDone = StringGrid1EditingDone - OnEnter = StringGrid1Enter - OnExit = StringGrid1Exit - OnKeyPress = StringGrid1KeyPress - OnMouseDown = StringGrid1MouseDown - OnMouseMove = StringGrid1MouseMove - end - object LUTdrop: TComboBox - Left = 88 - Height = 26 - Top = 40 - Width = 73 - DropDownCount = 22 - ItemHeight = 26 - Items.Strings = ( - 'a' - 'b' - 'c' - 'd' - 'e' - 'f' - 'g' - ) - OnChange = LUTdropChange - ParentFont = False - Style = csDropDownList - TabOrder = 1 - Text = '0' - Visible = False - end - end object NodeBox: TGroupBox Tag = 270 - Left = 1 - Height = 140 - Top = 136 - Width = 270 + Left = 0 + Height = 117 + Top = 431 + Width = 244 Align = alTop + AutoSize = True Caption = 'Nodes' - ClientHeight = 118 - ClientWidth = 256 + ClientHeight = 99 + ClientWidth = 236 ParentFont = False - TabOrder = 4 + TabOrder = 3 Visible = False - object TrackWidthLabel1: TLabel - Left = 0 + object NodeColorLabel: TLabel + AnchorSideLeft.Control = NodeBox + AnchorSideTop.Control = LUTdropNode + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 90 + Top = 81 Width = 33 + BorderSpacing.Left = 2 Caption = 'Color' ParentColor = False ParentFont = False end object LUTdropNode: TComboBox - Left = 97 - Height = 26 - Top = 88 - Width = 161 + AnchorSideLeft.Control = NodeColorVariesCheck + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NodeThreshDrop + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = NodeBox + AnchorSideRight.Side = asrBottom + Left = 65 + Height = 20 + Top = 79 + Width = 180 + BorderSpacing.Left = 4 + BorderSpacing.Top = 2 + BorderSpacing.Right = 2 DropDownCount = 22 ItemHeight = 26 Items.Strings = ( @@ -346,11 +532,17 @@ object GLForm1: TGLForm1 Text = '0' end object NodeColorVariesCheck: TCheckBox - Left = 58 + AnchorSideLeft.Control = NodeColorLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = LUTdropNode + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = LUTdropNode + Left = 39 Height = 18 Hint = 'If checked, node color varies' - Top = 90 + Top = 80 Width = 22 + BorderSpacing.Left = 4 Checked = True OnChange = NodePrefChange ParentFont = False @@ -360,32 +552,48 @@ object GLForm1: TGLForm1 TabOrder = 1 end object NodeScaleTrack: TTrackBar - Left = 98 + AnchorSideLeft.Control = NodeSizeVariesCheck + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NodeBox + AnchorSideRight.Control = NodeBox + AnchorSideRight.Side = asrBottom + Left = 65 Height = 30 - Top = 0 - Width = 162 + Top = 2 + Width = 147 Max = 200 OnChange = NodePrefChange Position = 20 TickStyle = tsNone + BorderSpacing.Left = 4 + BorderSpacing.Top = 2 + BorderSpacing.Right = 2 ParentFont = False TabOrder = 2 end object NodeScaleLabel: TLabel - Left = 4 + AnchorSideLeft.Control = NodeBox + AnchorSideTop.Control = NodeScaleTrack + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 2 + Top = 9 Width = 25 Alignment = taRightJustify + BorderSpacing.Left = 2 Caption = 'Size' ParentColor = False ParentFont = False end object NodeThreshDrop: TComboBox - Left = 15 - Height = 26 - Top = 64 + AnchorSideLeft.Control = NodeColorLabel + AnchorSideTop.Control = NodeMaxEdit + AnchorSideTop.Side = asrBottom + Left = 2 + Height = 20 + Top = 57 Width = 242 + BorderSpacing.Top = 2 DropDownCount = 22 ItemHeight = 26 ItemIndex = 0 @@ -400,10 +608,17 @@ object GLForm1: TGLForm1 Text = 'Threshold based on size' end object NodeMinEdit: TFloatSpinEdit - Left = 58 + AnchorSideLeft.Control = NodeThreshLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NodeMaxEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NodeMaxEdit + Left = 53 Height = 21 - Top = 40 - Width = 90 + Top = 34 + Width = 80 + BorderSpacing.Left = 5 + BorderSpacing.Right = 2 MaxValue = 65535 MinValue = 0 OnChange = NodePrefChange @@ -411,20 +626,32 @@ object GLForm1: TGLForm1 TabOrder = 4 Value = 0 end - object EdgeMinLabel1: TLabel - Left = 4 + object NodeThreshLabel: TLabel + AnchorSideLeft.Control = NodeScaleLabel + AnchorSideTop.Control = NodeMaxEdit + AnchorSideTop.Side = asrCenter + Left = 6 Height = 16 - Top = 40 + Top = 36 Width = 42 + BorderSpacing.Left = 4 Caption = 'Thresh' ParentColor = False ParentFont = False end object NodeMaxEdit: TFloatSpinEdit - Left = 162 + AnchorSideLeft.Control = NodeMinEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NodeScaleTrack + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = NodeScaleTrack + AnchorSideRight.Side = asrBottom + Left = 137 Height = 21 - Top = 40 - Width = 90 + Top = 34 + Width = 100 + BorderSpacing.Left = 4 + BorderSpacing.Top = 2 MaxValue = 65535 MinValue = 0 OnChange = NodePrefChange @@ -433,11 +660,18 @@ object GLForm1: TGLForm1 Value = 1 end object NodeSizeVariesCheck: TCheckBox - Left = 58 + AnchorSideLeft.Control = NodeColorLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NodeScaleTrack + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NodeScaleTrack + Left = 39 Height = 18 Hint = 'If checked, node size varies' - Top = 2 + Top = 8 Width = 22 + BorderSpacing.Left = 4 + BorderSpacing.Right = 4 Checked = True OnChange = NodePrefChange ParentFont = False @@ -450,31 +684,43 @@ object GLForm1: TGLForm1 end object EdgeBox: TGroupBox Tag = 270 - Left = 1 - Height = 115 - Top = 276 - Width = 270 + Left = 0 + Height = 95 + Top = 548 + Width = 244 Align = alTop + AutoSize = True Caption = 'Edges' - ClientHeight = 93 - ClientWidth = 256 + ClientHeight = 77 + ClientWidth = 236 ParentFont = False - TabOrder = 5 + TabOrder = 4 Visible = False - object TrackWidthLabel2: TLabel + object EdgeColorLabel: TLabel + AnchorSideLeft.Control = EdgeBox + AnchorSideTop.Control = LUTdropEdge Left = 2 Height = 16 - Top = 66 + Top = 57 Width = 33 + BorderSpacing.Left = 2 Caption = 'Color' ParentColor = False ParentFont = False end object LUTdropEdge: TComboBox - Left = 99 - Height = 26 - Top = 64 + AnchorSideLeft.Control = EdgeColorVariesCheck + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = EdgeMaxEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = EdgeMaxEdit + AnchorSideRight.Side = asrBottom + Left = 65 + Height = 20 + Top = 57 Width = 161 + BorderSpacing.Left = 4 + BorderSpacing.Top = 2 DropDownCount = 22 ItemHeight = 26 Items.Strings = ( @@ -493,11 +739,18 @@ object GLForm1: TGLForm1 Text = '0' end object EdgeColorVariesCheck: TCheckBox - Left = 58 + AnchorSideLeft.Control = EdgeColorLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = LUTdropEdge + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = LUTdropEdge + Left = 39 Height = 18 Hint = 'If checked, edge color varies' - Top = 66 + Top = 58 Width = 22 + BorderSpacing.Left = 4 + BorderSpacing.Right = 4 Checked = True OnChange = NodePrefChange ParentFont = False @@ -506,20 +759,31 @@ object GLForm1: TGLForm1 State = cbChecked TabOrder = 1 end - object EdgeMinLabel: TLabel - Left = 4 + object EdgeThreshLabel: TLabel + AnchorSideLeft.Control = EdgeBox + AnchorSideTop.Control = EdgeMaxEdit + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 40 + Top = 36 Width = 42 + BorderSpacing.Left = 2 Caption = 'Thresh' ParentColor = False ParentFont = False end object EdgeMinEdit: TFloatSpinEdit - Left = 58 + AnchorSideLeft.Control = EdgeThreshLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = EdgeMaxEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = EdgeMaxEdit + Left = 48 Height = 21 - Top = 40 + Top = 34 Width = 90 + BorderSpacing.Left = 4 + BorderSpacing.Right = 2 MaxValue = 65535 MinValue = 0 OnChange = NodePrefChange @@ -528,10 +792,18 @@ object GLForm1: TGLForm1 Value = 0 end object EdgeMaxEdit: TFloatSpinEdit - Left = 162 + AnchorSideLeft.Control = EdgeMinEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = edgeScaleTrack + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = edgeScaleTrack + AnchorSideRight.Side = asrBottom + Left = 142 Height = 21 - Top = 40 + Top = 34 Width = 90 + BorderSpacing.Left = 4 + BorderSpacing.Top = 2 MaxValue = 65535 MinValue = 0 OnChange = NodePrefChange @@ -540,32 +812,51 @@ object GLForm1: TGLForm1 Value = 1 end object edgeScaleTrack: TTrackBar - Left = 98 + AnchorSideLeft.Control = EdgeSizeVariesCheck + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = EdgeBox + AnchorSideRight.Control = EdgeBox + AnchorSideRight.Side = asrBottom + Left = 57 Height = 30 - Top = 0 + Top = 2 Width = 162 Max = 100 OnChange = NodePrefChange Position = 37 TickStyle = tsNone + BorderSpacing.Left = 4 + BorderSpacing.Top = 2 + BorderSpacing.Right = 2 ParentFont = False TabOrder = 4 end - object NodeScaleLabel1: TLabel - Left = 4 + object EdgeSizeLabel: TLabel + AnchorSideLeft.Control = EdgeBox + AnchorSideTop.Control = edgeScaleTrack + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 2 + Top = 9 Width = 25 + BorderSpacing.Left = 2 Caption = 'Size' ParentColor = False ParentFont = False end object EdgeSizeVariesCheck: TCheckBox - Left = 58 + AnchorSideLeft.Control = EdgeSizeLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = edgeScaleTrack + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = edgeScaleTrack + Left = 31 Height = 18 Hint = 'If checked, edge size varies' - Top = 2 + Top = 8 Width = 22 + BorderSpacing.Left = 4 + BorderSpacing.Right = 4 Checked = True OnChange = NodePrefChange ParentFont = False @@ -577,54 +868,74 @@ object GLForm1: TGLForm1 end object MeshColorBox: TGroupBox Tag = 270 - Left = 1 - Height = 86 - Top = 473 - Width = 270 + Left = 0 + Height = 82 + Top = 643 + Width = 244 Align = alTop + AutoSize = True Caption = 'Mesh Color' ClientHeight = 64 - ClientWidth = 256 + ClientWidth = 236 ParentFont = False TabOrder = 6 Visible = False - object TrackLengthLabel1: TLabel - Left = 4 + object SatLabel: TLabel + AnchorSideLeft.Control = MeshColorBox + AnchorSideTop.Control = MeshSaturationTrack + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 2 + Top = 9 Width = 62 + BorderSpacing.Left = 2 Caption = 'Saturation' ParentColor = False ParentFont = False end object MeshSaturationTrack: TTrackBar - Left = 100 + AnchorSideLeft.Control = TransLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = MeshColorBox + AnchorSideRight.Control = MeshColorBox + AnchorSideRight.Side = asrBottom + Left = 88 Height = 30 - Top = 0 + Top = 2 Width = 160 Max = 100 OnChange = MeshColorBoxChange Position = 100 TickStyle = tsNone + BorderSpacing.Left = 4 + BorderSpacing.Top = 2 + BorderSpacing.Right = 2 ParentFont = False TabOrder = 0 end object MeshTransparencyTrack: TTrackBar - Left = 100 + AnchorSideLeft.Control = MeshSaturationTrack + AnchorSideTop.Control = MeshSaturationTrack + AnchorSideTop.Side = asrBottom + Left = 88 Height = 30 - Top = 30 + Top = 34 Width = 160 Max = 100 OnChange = MeshColorBoxChange Position = 100 TickStyle = tsNone + BorderSpacing.Top = 2 ParentFont = False TabOrder = 1 end - object TrackWidthLabel3: TLabel - Left = 4 + object TransLabel: TLabel + AnchorSideLeft.Control = SatLabel + AnchorSideTop.Control = MeshTransparencyTrack + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 32 + Top = 41 Width = 82 Caption = 'Transparency' ParentColor = False @@ -632,52 +943,71 @@ object GLForm1: TGLForm1 end end object BackgroundBox: TGroupBox - Left = 1 - Height = 78 - Top = 669 - Width = 270 + Left = 0 + Height = 70 + Top = 725 + Width = 244 Align = alTop + AutoSize = True Caption = 'Background Mesh' - ClientHeight = 56 - ClientWidth = 256 + ClientHeight = 52 + ClientWidth = 236 ParentFont = False - TabOrder = 8 + TabOrder = 5 object meshAlphaTrack: TTrackBar - Left = 52 + AnchorSideLeft.Control = XRayLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = MeshBlendTrack + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = MeshBlendTrack + Left = 37 Height = 30 Hint = 'Adjust main mesh transparency' - Top = 0 + Top = 2 Width = 92 Max = 100 OnChange = SurfaceAppearanceChange Position = 100 TickStyle = tsNone + BorderSpacing.Left = 4 + BorderSpacing.Right = 4 ParentFont = False ParentShowHint = False ShowHint = True TabOrder = 0 end object MeshBlendTrack: TTrackBar - Left = 170 + AnchorSideLeft.Control = meshAlphaTrack + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = BackgroundBox + AnchorSideRight.Side = asrBottom + Left = 134 Height = 30 Hint = 'XRay: make internal overlays, tracks and nodes visible' - Top = 0 + Top = 2 Width = 92 Max = 100 OnChange = SurfaceAppearanceChange Position = 0 TickStyle = tsNone + BorderSpacing.Left = 5 + BorderSpacing.Top = 2 + BorderSpacing.Right = 2 ParentFont = False ParentShowHint = False ShowHint = True TabOrder = 1 end - object TrackLengthLabel2: TLabel - Left = 4 + object XRayLabel: TLabel + AnchorSideLeft.Control = BackgroundBox + AnchorSideTop.Control = MeshBlendTrack + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 Hint = 'XRay: make internal overlays, tracks and nodes visible' - Top = 2 + Top = 9 Width = 31 + BorderSpacing.Left = 2 Caption = 'XRay' ParentColor = False ParentFont = False @@ -685,11 +1015,19 @@ object GLForm1: TGLForm1 ShowHint = True end object ShaderForBackgroundOnlyCheck: TCheckBox - Left = 222 + AnchorSideLeft.Control = BGShader + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = meshAlphaTrack + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = MeshBlendTrack + AnchorSideRight.Side = asrBottom + Left = 180 Height = 18 Hint = 'If checked, edge size varies' - Top = 32 + Top = 34 Width = 22 + BorderSpacing.Left = 4 + BorderSpacing.Top = 2 Checked = True OnChange = ShaderForBackgroundOnlyClick ParentFont = False @@ -699,9 +1037,12 @@ object GLForm1: TGLForm1 TabOrder = 2 end object BGShader: TLabel - Left = 4 + AnchorSideLeft.Control = XRayLabel + AnchorSideTop.Control = ShaderForBackgroundOnlyCheck + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 34 + Top = 35 Width = 174 Caption = 'Shader For Background Only' ParentColor = False @@ -709,23 +1050,28 @@ object GLForm1: TGLForm1 end end object ShaderBox: TGroupBox - Left = 1 - Height = 0 - Top = 698 - Width = 270 + Left = 0 + Height = 402 + Top = 795 + Width = 244 Align = alClient + AutoSize = True Caption = 'Shader' - ClientHeight = 0 - ClientWidth = 256 + ClientHeight = 384 + ClientWidth = 236 ParentFont = False TabOrder = 7 OnResize = ShaderBoxResize object Label2: TLabel - Left = 4 + AnchorSideLeft.Control = ShaderBox + AnchorSideTop.Control = LightElevTrack + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 Hint = 'Set the elevation and azimuth of the illumination' - Top = 34 + Top = 41 Width = 31 + BorderSpacing.Left = 2 Caption = 'Light' ParentColor = False ParentFont = False @@ -733,10 +1079,14 @@ object GLForm1: TGLForm1 ShowHint = True end object ShaderDrop: TComboBox + AnchorSideLeft.Control = ShaderBox + AnchorSideTop.Control = ShaderBox Left = 2 - Height = 26 - Top = 0 + Height = 20 + Top = 6 Width = 127 + BorderSpacing.Left = 2 + BorderSpacing.Top = 6 DropDownCount = 36 ItemHeight = 26 OnChange = ShaderDropChange @@ -746,52 +1096,79 @@ object GLForm1: TGLForm1 Text = '0' end object LightElevTrack: TTrackBar - Left = 52 + AnchorSideTop.Control = LightAziTrack + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = LightAziTrack + Left = 61 Height = 30 - Top = 30 + Top = 34 Width = 92 Max = 90 Min = -90 OnChange = SurfaceAppearanceChange Position = 25 TickStyle = tsNone + Anchors = [akTop, akRight] + BorderSpacing.Right = 4 ParentFont = False TabOrder = 1 end object LightAziTrack: TTrackBar - Left = 170 + AnchorSideTop.Control = ShaderDrop + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = occlusionTrack + AnchorSideRight.Side = asrBottom + Left = 157 Height = 30 - Top = 30 + Top = 34 Width = 92 Max = 90 Min = -90 OnChange = SurfaceAppearanceChange Position = 0 TickStyle = tsNone + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 ParentFont = False TabOrder = 2 end object occlusionTrack: TTrackBar - Left = 170 + AnchorSideLeft.Control = AOLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ShaderDrop + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = ShaderBox + AnchorSideRight.Side = asrBottom + Left = 157 Height = 30 Hint = 'Ambient Occlusion: make sulci and other crevices darker' - Top = 0 + Top = 1 Width = 92 Max = 100 OnChange = SurfaceAppearanceChange Position = 25 TickStyle = tsNone + BorderSpacing.Left = 4 + BorderSpacing.Top = 2 + BorderSpacing.Right = 2 ParentFont = False ParentShowHint = False ShowHint = True TabOrder = 4 end object AOLabel: TLabel - Left = 138 + AnchorSideLeft.Control = ShaderDrop + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = occlusionTrack + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = occlusionTrack + Left = 135 Height = 16 Hint = 'Ambient occlusion makes sucli and other crevices darker' - Top = 6 + Top = 8 Width = 18 + BorderSpacing.Left = 6 + BorderSpacing.Right = 4 Caption = 'AO' ParentColor = False ParentFont = False @@ -800,204 +1177,157 @@ object GLForm1: TGLForm1 end object S1Track: TTrackBar Tag = 1 - Left = 170 + AnchorSideLeft.Control = occlusionTrack + AnchorSideTop.Control = LightAziTrack + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ShaderBox + AnchorSideRight.Side = asrBottom + Left = 157 Height = 30 - Top = 64 + Top = 66 Width = 88 Max = 100 OnChange = UniformChange Position = 51 TickStyle = tsNone + BorderSpacing.Top = 2 + BorderSpacing.Right = 2 ParentFont = False TabOrder = 5 end object S1Label: TLabel Tag = 1 - Left = 4 + AnchorSideLeft.Control = ShaderBox + AnchorSideTop.Control = S1Track + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 64 + Top = 73 Width = 14 + BorderSpacing.Left = 2 Caption = 'S1' ParentColor = False ParentFont = False ParentShowHint = False end - object S1Check: TCheckBox - Tag = 1 - Left = 140 - Height = 18 - Hint = 'If checked, edge color varies' - Top = 66 - Width = 22 - Checked = True - OnChange = UniformChange - ParentFont = False - ParentShowHint = False - ShowHint = True - State = cbChecked - TabOrder = 6 - end object S2Label: TLabel Tag = 2 - Left = 4 + AnchorSideLeft.Control = S1Label + AnchorSideTop.Control = S2Track + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 94 + Top = 105 Width = 16 Caption = 'S2' ParentColor = False ParentFont = False ParentShowHint = False end - object S2Check: TCheckBox - Tag = 2 - Left = 140 - Height = 18 - Hint = 'If checked, edge color varies' - Top = 96 - Width = 22 - Checked = True - OnChange = UniformChange - ParentFont = False - ParentShowHint = False - ShowHint = True - State = cbChecked - TabOrder = 8 - end object S2Track: TTrackBar Tag = 2 - Left = 170 + AnchorSideLeft.Control = S1Track + AnchorSideTop.Control = S1Track + AnchorSideTop.Side = asrBottom + Left = 157 Height = 30 - Top = 94 + Top = 98 Width = 88 Max = 100 OnChange = UniformChange Position = 50 TickStyle = tsNone + BorderSpacing.Top = 2 ParentFont = False - TabOrder = 7 + TabOrder = 6 end object S3Track: TTrackBar Tag = 3 - Left = 170 + AnchorSideLeft.Control = S1Track + AnchorSideTop.Control = S2Track + AnchorSideTop.Side = asrBottom + Left = 157 Height = 30 - Top = 124 + Top = 130 Width = 88 Max = 100 OnChange = UniformChange Position = 50 TickStyle = tsNone + BorderSpacing.Top = 2 ParentFont = False - TabOrder = 9 - end - object S3Check: TCheckBox - Tag = 3 - Left = 140 - Height = 18 - Hint = 'If checked, edge color varies' - Top = 126 - Width = 22 - Checked = True - OnChange = UniformChange - ParentFont = False - ParentShowHint = False - ShowHint = True - State = cbChecked - TabOrder = 10 - end - object S3Label: TLabel - Tag = 3 - Left = 4 - Height = 16 - Top = 124 - Width = 16 - Caption = 'S3' - ParentColor = False - ParentFont = False - ParentShowHint = False + TabOrder = 7 end object S4Label: TLabel Tag = 4 - Left = 4 + AnchorSideLeft.Control = S1Label + AnchorSideTop.Control = S4Track + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 154 + Top = 169 Width = 16 Caption = 'S4' ParentColor = False ParentFont = False ParentShowHint = False end - object S4Check: TCheckBox - Tag = 4 - Left = 140 - Height = 18 - Hint = 'If checked, edge color varies' - Top = 156 - Width = 22 - Checked = True - OnChange = UniformChange - ParentFont = False - ParentShowHint = False - ShowHint = True - State = cbChecked - TabOrder = 12 - end object S4Track: TTrackBar Tag = 4 - Left = 170 + AnchorSideLeft.Control = S1Track + AnchorSideTop.Control = S3Track + AnchorSideTop.Side = asrBottom + Left = 157 Height = 30 - Top = 154 + Top = 162 Width = 88 Max = 100 OnChange = UniformChange Position = 50 TickStyle = tsNone + BorderSpacing.Top = 2 ParentFont = False - TabOrder = 11 + TabOrder = 8 end object S5Label: TLabel Tag = 5 - Left = 4 + AnchorSideLeft.Control = S1Label + AnchorSideTop.Control = S5Track + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 184 + Top = 201 Width = 16 Caption = 'S5' ParentColor = False ParentFont = False ParentShowHint = False end - object S5Check: TCheckBox - Tag = 5 - Left = 140 - Height = 18 - Hint = 'If checked, edge color varies' - Top = 186 - Width = 22 - Checked = True - OnChange = UniformChange - ParentFont = False - ParentShowHint = False - ShowHint = True - State = cbChecked - TabOrder = 14 - end object S5Track: TTrackBar Tag = 5 - Left = 170 + AnchorSideLeft.Control = S1Track + AnchorSideTop.Control = S4Track + AnchorSideTop.Side = asrBottom + Left = 157 Height = 30 - Top = 184 + Top = 194 Width = 88 Max = 100 OnChange = UniformChange Position = 50 TickStyle = tsNone + BorderSpacing.Top = 2 ParentFont = False - TabOrder = 13 + TabOrder = 9 end object S6Label: TLabel Tag = 6 - Left = 4 + AnchorSideLeft.Control = S1Label + AnchorSideTop.Control = S6Track + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 214 + Top = 233 Width = 16 Caption = 'S6' ParentColor = False @@ -1006,9 +1336,12 @@ object GLForm1: TGLForm1 end object S7Label: TLabel Tag = 7 - Left = 4 + AnchorSideLeft.Control = S1Label + AnchorSideTop.Control = S7Track + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 244 + Top = 265 Width = 16 Caption = 'S7' ParentColor = False @@ -1017,9 +1350,12 @@ object GLForm1: TGLForm1 end object S8Label: TLabel Tag = 8 - Left = 4 + AnchorSideLeft.Control = S1Label + AnchorSideTop.Control = S8Track + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 274 + Top = 297 Width = 16 Caption = 'S8' ParentColor = False @@ -1028,9 +1364,12 @@ object GLForm1: TGLForm1 end object S9Label: TLabel Tag = 9 - Left = 4 + AnchorSideLeft.Control = S1Label + AnchorSideTop.Control = S9Track + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 304 + Top = 329 Width = 16 Caption = 'S9' ParentColor = False @@ -1039,191 +1378,246 @@ object GLForm1: TGLForm1 end object S10Label: TLabel Tag = 10 - Left = 4 + AnchorSideLeft.Control = S1Label + AnchorSideTop.Control = S10Track + AnchorSideTop.Side = asrCenter + Left = 2 Height = 16 - Top = 334 + Top = 359 Width = 22 Caption = 'S10' ParentColor = False ParentFont = False ParentShowHint = False end - object S6Check: TCheckBox - Tag = 6 - Left = 141 - Height = 18 - Hint = 'If checked, edge color varies' - Top = 216 - Width = 22 - Checked = True - OnChange = UniformChange - ParentFont = False - ParentShowHint = False - ShowHint = True - State = cbChecked - TabOrder = 16 - end - object S7Check: TCheckBox - Tag = 7 - Left = 141 - Height = 18 - Hint = 'If checked, edge color varies' - Top = 246 - Width = 22 - Checked = True - OnChange = UniformChange - ParentFont = False - ParentShowHint = False - ShowHint = True - State = cbChecked - TabOrder = 18 - end - object S8Check: TCheckBox - Tag = 8 - Left = 141 - Height = 18 - Hint = 'If checked, edge color varies' - Top = 276 - Width = 22 - Checked = True - OnChange = UniformChange - ParentFont = False - ParentShowHint = False - ShowHint = True - State = cbChecked - TabOrder = 20 - end - object S9Check: TCheckBox - Tag = 9 - Left = 141 - Height = 18 - Hint = 'If checked, edge color varies' - Top = 306 - Width = 22 - Checked = True - OnChange = UniformChange - ParentFont = False - ParentShowHint = False - ShowHint = True - State = cbChecked - TabOrder = 22 - end - object S10Check: TCheckBox - Tag = 10 - Left = 141 - Height = 18 - Hint = 'If checked, edge color varies' - Top = 336 - Width = 22 - Checked = True - OnChange = UniformChange - ParentFont = False - ParentShowHint = False - ShowHint = True - State = cbChecked - TabOrder = 24 - end object S6Track: TTrackBar Tag = 6 - Left = 170 + AnchorSideLeft.Control = S1Track + AnchorSideTop.Control = S5Track + AnchorSideTop.Side = asrBottom + Left = 157 Height = 30 - Top = 214 + Top = 226 Width = 88 Max = 100 OnChange = UniformChange Position = 50 TickStyle = tsNone + BorderSpacing.Top = 2 ParentFont = False - TabOrder = 15 + TabOrder = 10 end object S7Track: TTrackBar Tag = 7 - Left = 170 + AnchorSideLeft.Control = S1Track + AnchorSideTop.Control = S6Track + AnchorSideTop.Side = asrBottom + Left = 157 Height = 30 - Top = 244 + Top = 258 Width = 88 Max = 100 OnChange = UniformChange Position = 50 TickStyle = tsNone + BorderSpacing.Top = 2 ParentFont = False - TabOrder = 17 + TabOrder = 11 end object S8Track: TTrackBar Tag = 8 - Left = 170 + AnchorSideLeft.Control = S1Track + AnchorSideTop.Control = S7Track + AnchorSideTop.Side = asrBottom + Left = 157 Height = 30 - Top = 274 + Top = 290 Width = 88 Max = 100 OnChange = UniformChange Position = 50 TickStyle = tsNone + BorderSpacing.Top = 2 ParentFont = False - TabOrder = 19 + TabOrder = 12 end object S9Track: TTrackBar Tag = 9 - Left = 170 + AnchorSideLeft.Control = S1Track + AnchorSideTop.Control = S8Track + AnchorSideTop.Side = asrBottom + Left = 157 Height = 30 - Top = 304 + Top = 322 Width = 88 Max = 100 OnChange = UniformChange Position = 50 TickStyle = tsNone + BorderSpacing.Top = 2 ParentFont = False - TabOrder = 21 + TabOrder = 13 end object S10Track: TTrackBar Tag = 10 - Left = 170 + AnchorSideLeft.Control = S1Track + AnchorSideTop.Control = S9Track + AnchorSideTop.Side = asrBottom + Left = 157 Height = 30 - Top = 334 + Top = 352 Width = 88 Max = 100 OnChange = UniformChange Position = 50 TickStyle = tsNone + BorderSpacing.Bottom = 2 ParentFont = False - TabOrder = 23 + TabOrder = 14 end object Memo1: TMemo Left = 0 Height = 54 - Top = -54 - Width = 256 + Top = 330 + Width = 236 Align = alBottom Lines.Strings = ( '' ) ParentFont = False TabOrder = 3 + WordWrap = False + end + object S3Label: TLabel + Tag = 3 + AnchorSideLeft.Control = S1Label + AnchorSideTop.Control = S3Track + AnchorSideTop.Side = asrCenter + Left = 2 + Height = 16 + Top = 137 + Width = 16 + Caption = 'S3' + ParentColor = False + ParentFont = False + ParentShowHint = False end - end - object CollapseToolPanelBtn: TButton - Left = 252 - Height = 16 - Hint = 'Click here to hide the tool panel' - Top = 1 - Width = 16 - OnClick = CollapseToolPanelBtnClick - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 0 end end - object CollapsedToolPanel: TPanel - Left = 272 - Height = 699 + object LeftSplitter: TSplitter + Left = 261 + Height = 684 Top = 0 Width = 6 - Align = alLeft + OnCanOffset = LeftSplitterCanOffset + OnCanResize = LeftSplitterCanResize + OnChangeBounds = LeftSplitterChangeBounds + OnMoved = LeftSplitterMoved + end + object CenterPanel: TPanel + Left = 267 + Height = 684 + Top = 0 + Width = 454 + Align = alClient + Constraints.MinHeight = 32 + Constraints.MinWidth = 32 + ParentFont = False + TabOrder = 4 + end + object RightSplitter: TSplitter + Left = 721 + Height = 684 + Top = 0 + Width = 6 + Align = alRight + ResizeAnchor = akRight + end + object ScriptPanel: TPanel + Left = 727 + Height = 684 + Top = 0 + Width = 300 + Align = alRight + BevelOuter = bvNone + ClientHeight = 684 + ClientWidth = 300 + Constraints.MinWidth = 2 ParentFont = False TabOrder = 0 - Visible = False - OnClick = CollapseToolPanelBtnClick + OnDblClick = ScriptPanelDblClick + object ScriptBox: TGroupBox + Left = 0 + Height = 684 + Top = 0 + Width = 300 + Align = alClient + Caption = 'Scripting' + ClientHeight = 666 + ClientWidth = 292 + ParentFont = False + TabOrder = 0 + OnDblClick = ScriptPanelDblClick + object ScriptMemo: TMemo + Left = 0 + Height = 460 + Top = 0 + Width = 292 + Align = alClient + BorderStyle = bsNone + Lines.Strings = ( + 'import gl' + 'import sys' + 'print(sys.version)' + 'print(gl.version())' + 'gl.resetdefaults()' + 'gl.meshload(''BrainMesh_ICBM152Right.mz3'')' + ) + ParentFont = False + ScrollBars = ssAutoBoth + TabOrder = 0 + WantTabs = True + WordWrap = False + end + object ScriptOutputMemo: TMemo + Left = 0 + Height = 200 + Top = 466 + Width = 292 + Align = alBottom + BorderStyle = bsNone + Lines.Strings = ( + '' + ) + ParentFont = False + ReadOnly = True + ScrollBars = ssAutoBoth + TabOrder = 1 + WordWrap = False + end + object ScriptSplitter: TSplitter + Cursor = crVSplit + Left = 0 + Height = 6 + Top = 460 + Width = 292 + Align = alBottom + ResizeAnchor = akBottom + end + end + end + object LayerPopup: TPopupMenu + OnPopup = LayerPopupPopup + left = 280 + top = 27 + object LayerInvertColorsMenu: TMenuItem + Caption = 'Invert Colors' + OnClick = LayerInvertColorsMenuClick + end + object LayerShowHeaderMenu: TMenuItem + Caption = 'Show Header' + OnClick = LayerShowHeaderMenuClick + end end object ColorDialog1: TColorDialog Color = 15119026 @@ -1611,11 +2005,6 @@ object GLForm1: TGLForm1 Caption = 'Convert voxelwise atlas to meshes' OnClick = VolumeToMeshMenuClick end - object ScriptMenu: TMenuItem - Caption = 'Scripting' - ShortCut = 16474 - OnClick = ScriptMenuClick - end object SimplifyMeshMenu: TMenuItem Caption = 'Simplify mesh' OnClick = SimplifyMeshMenuClick @@ -1633,6 +2022,483 @@ object GLForm1: TGLForm1 OnClick = CurvMenuClick end end + object ScriptingMenu: TMenuItem + Caption = 'Scripting' + object ScriptingNewMenu: TMenuItem + Caption = 'New' + ShortCut = 16462 + OnClick = ScriptingNewMenuClick + end + object ScriptingOpenMenu: TMenuItem + Caption = 'Open...' + OnClick = ScriptingOpenMenuClick + end + object ScriptingSaveMenu: TMenuItem + Caption = 'Save' + OnClick = ScriptingSaveMenuClick + end + object ScriptingTemplatesMenu: TMenuItem + Caption = 'Python' + end + object ScriptingPascalMenu: TMenuItem + Caption = 'Pascal' + end + object ScriptingInsertMenu: TMenuItem + Caption = 'Insert' + object mesh1: TMenuItem + Caption = 'Mesh' + object meshload1: TMenuItem + Tag = 4 + Caption = 'meshload' + Hint = 'meshload (filename: string) Opens a mesh to view.' + OnClick = InsertCommand + end + object meshcolor1: TMenuItem + Tag = 36 + Caption = 'meshcolor' + Hint = 'meshcolor (r, g, b: integer) Set red/green/blue components of main image.' + OnClick = InsertCommand + end + object meshcurv1: TMenuItem + Caption = 'meshcurv' + Hint = 'meshcurv () Displays mesh curvature, so crevices appear dark.' + OnClick = InsertCommand + end + object meshcreate1: TMenuItem + Tag = 242322 + Caption = 'meshcreate' + Hint = 'meshcreate (niiname, meshname: string; threshold, decimateFrac: float; minimumClusterVox, smoothStyle: integer) Convert a NIfTI voxel-based image into a mesh' + OnClick = InsertCommand + end + object meshreversefaces1: TMenuItem + Caption = 'meshreversefaces' + Hint = 'meshreversefaces() reverse triangle winding to reverse front/back faces' + OnClick = InsertCommand + end + object meshsave1: TMenuItem + Tag = 4 + Caption = 'meshsave' + Hint = 'meshsave (filename: string) Saves currently open mesh to disk.' + OnClick = InsertCommand + end + end + object overlays1: TMenuItem + Caption = 'Overlays' + object overlayload1: TMenuItem + Tag = 4 + Caption = 'overlayload' + Hint = 'overlayload (filename: string) integer; Will add the overlay named filename and return the number of the overlay.' + OnClick = InsertCommand + end + object overlayadditive1: TMenuItem + Tag = 1 + Caption = 'overlayadditive' + Hint = 'overlayadditive (add: boolean) Determines whether overlay colors are combined by adding or mixing the colors. For example, overlap of red and green overlays will appear yellow if additive is true' + OnClick = InsertCommand + end + object overlaycloseall1: TMenuItem + Caption = 'overlaycloseall' + Hint = 'overlaycloseall () This function has no parameters. All open overlays will be closed.' + OnClick = InsertCommand + end + object overlaycolorname1: TMenuItem + Tag = 1214 + Caption = 'overlaycolorname' + Hint = 'overlaycolorname (overlay: integer; filename: string) Set the colorscheme for the target overlay to a specified name.' + OnClick = InsertCommand + end + object overlayminmax1: TMenuItem + Tag = 1223 + Caption = 'overlayminmax' + Hint = 'overlayminmax (overlay: integer; min, max: float) Sets the color range for the overlay.' + OnClick = InsertCommand + end + object overlaytransparencyonbackground1: TMenuItem + Tag = 2 + Caption = 'overlaytransparencyonbackground' + Hint = 'overlaytransparencyonbackground (percent: integer) Controls the opacity of the overlays on the background.' + OnClick = InsertCommand + end + object overlaycolorfromzero1: TMenuItem + Tag = 1 + Caption = 'overlaycolorfromzero' + Hint = 'overlaycolorfromzero (fromzero: boolean) If set to false, then the full color range is used to show the overlay.' + Visible = False + OnClick = InsertCommand + end + object overlayvisible1: TMenuItem + Tag = 1211 + Caption = 'overlayvisible' + Hint = 'overlayvisible (overlay: integer; visible: boolean) This feature allows you to make individual overlays visible or invisible.' + OnClick = InsertCommand + end + object overlaytranslucent1: TMenuItem + Tag = 1211 + Caption = 'overlaytranslucent' + Hint = 'overlaytranslucent (overlay: integer; translucent: boolean) This feature allows you to make individual overlays translucent or opaque.' + OnClick = InsertCommand + end + object overlayinvert1: TMenuItem + Tag = 1211 + Caption = 'overlayinvert' + Hint = 'overlayinvert (overlay: integer; invert: boolean) toggle whether overlay color scheme is inverted.' + OnClick = InsertCommand + end + object overlaysmoothvoxelwisedata1: TMenuItem + Tag = 1 + Caption = 'overlaysmoothvoxelwisedata' + Hint = 'overlaysmoothvoxelwisedata (smooth: boolean) Determines if overlays are loaded using interpolation (smooth) or nearest neighbor (un-smoothed) interpolation.' + OnClick = InsertCommand + end + object meshoverlayorder1: TMenuItem + Tag = 1 + Caption = 'meshoverlayorder' + Hint = 'meshoverlayorder (flip: boolean) If true, the mesh will be drawn after the overlay, and xray sliders will influence overlay not mesh.' + OnClick = InsertCommand + end + end + object Nodes1: TMenuItem + Caption = 'Nodes' + object edgeload1: TMenuItem + Tag = 4 + Caption = 'edgeload' + Hint = 'edgeload (filename: string) Loads a BrainNet Viewer format Edge file, e.g. connectome map' + OnClick = InsertCommand + end + object edgecolor1: TMenuItem + Tag = 1411 + Caption = 'edgecolor' + Hint = 'edgecolor (name: string; varies: boolean) Select color scheme for connectome edge map' + OnClick = InsertCommand + end + object edgecreate1: TMenuItem + Tag = 1419 + Caption = 'edgecreate' + Hint = 'edgecreate (filename: string; const mtx: array of single) Create a connectome edge map. For example, if you have 3 nodes, mtx should be an array with 9 values (3*3). For example, edgecreate('''',[1,2,3, 2,4,5, 3,5,6]) creates the links between 3 regions. Note the lower triangle and diagonal of this matrix is ignored.' + OnClick = InsertCommand + end + object edgesize1: TMenuItem + Tag = 1311 + Caption = 'edgesize' + Hint = 'edgesize (size: float; varies: boolean) Set the diameters of the cylinders of the connectome.' + OnClick = InsertCommand + end + object edgethresh1: TMenuItem + Tag = 23 + Caption = 'edgethresh' + Hint = 'edgethresh (lo, hi: float) Set minimum and maximum values for connectome edge diameters.' + OnClick = InsertCommand + end + object nodeload1: TMenuItem + Tag = 4 + Caption = 'nodeload' + Hint = 'nodeload (filename: string) Loads BrainNet viewer format node file.' + OnClick = InsertCommand + end + object nodecolor1: TMenuItem + Tag = 1411 + Caption = 'nodecolor' + Hint = 'nodecolor (name: string; varies: boolean) set colorscheme used for nodes.' + OnClick = InsertCommand + end + object nodecreate1: TMenuItem + Tag = 1459 + Caption = 'nodecreate' + Hint = 'nodecreate (filename: string; const x, y, z, color, radius: array of single) Generates and displays a connectome hub map. The arrays x,y,z refer to the 3D spatial coordinates. The optional color and radius arrays allow you to specify the size. For example nodecreate(''mynode.node'',[0, 10, 8], [9, 0, 8], [0, 9, 0], [], []) creates three spheres with the default size and color. On the other hand, nodecreate(''mynode.node'',[0, 10, 8], [9, 0, 8], [0, 9, 0], [1, 2, 9], [5]) creates three spheres each with a unique color intensity and with a size of 5.' + OnClick = InsertCommand + end + object nodehemisphere1: TMenuItem + Tag = 2 + Caption = 'nodehemisphere' + Hint = 'nodehemisphere (val: integer) Set -1 for left hemipshere, 0 for both, 1 for right' + OnClick = InsertCommand + end + object ndepolarity1: TMenuItem + Tag = 2 + Caption = 'nodepolarity' + Hint = 'nodepolarity (val: integer) Set -1 for negative only, 0 for either, 1 for positive only.' + OnClick = InsertCommand + end + object nodesize1: TMenuItem + Tag = 1311 + Caption = 'nodesize' + Hint = 'nodesize (size: float; varies: boolean) Determine size scaling factor for nodes.' + OnClick = InsertCommand + end + object nodethresh1: TMenuItem + Tag = 23 + Caption = 'nodethresh' + Hint = 'nodethresh (lo, hi: float) Set the minimum and maximum range for nodes.' + OnClick = InsertCommand + end + object nodethreshbysizenotcolor1: TMenuItem + Tag = 1 + Caption = 'nodethreshbysizenotcolor' + Hint = 'nodethreshbysizenotcolor (NodeThresholdBySize: boolean) If true then nodes will be hidden if they are smaller than the provided threshold. If false, they will be hidden if their color intensity is below the provided threshold.' + OnClick = InsertCommand + end + end + object Tracks1: TMenuItem + Caption = 'Tracks' + object trackload1: TMenuItem + Tag = 4 + Caption = 'trackload' + Hint = 'trackload (filename: string) Load fiber steam lines from a file.' + OnClick = InsertCommand + end + object trackprefs1: TMenuItem + Tag = 33 + Caption = 'trackprefs' + Hint = 'trackprefs (length, width, dither: float) set the size and properties for streamlines' + OnClick = InsertCommand + end + end + object Atlas1: TMenuItem + Caption = 'Atlas' + object atlasgray1: TMenuItem + Tag = 1218 + Caption = 'atlasgray' + Hint = 'atlasgray (overlay: integer; const filt: array of integer) Gray atlas areas. For example atlasgray(0,[3,7]) will gray-out areas 3 and 7 of the background atlas. On the other hand, atlashide(1,[2,5]) will gray-out areas 2 and 5 of the first overlay image. For example atlashide(0,[3,7]) will gray the areas 3 and 7 of the background atlas. On the other hand, atlashide(1,[2,5]) will gray areas 2 and 5 of the first overlay image.' + OnClick = InsertCommand + end + object atlashide1: TMenuItem + Tag = 1218 + Caption = 'atlashide' + Hint = 'atlashide (overlay: integer; const filt: array of integer) Hide atlas areas. For example atlashide(0,[3,7]) will hide the areas 3 and 7 of the background atlas. On the other hand, atlashide(1,[2,5]) will hide areas 2 and 5 of the first overlay image.' + OnClick = InsertCommand + end + object atlasmaxindex1: TMenuItem + Tag = 2 + Caption = 'atlasmaxindex' + Hint = 'atlasmaxindex (overlay: integer): integer Reports maximum region humber in specified atlas. For example, if you load the CIT168 atlas (which has 15 regions) as your background image, then atlasmaxindex(0) will return 15.' + OnClick = InsertCommand + end + object atlassaturationalpha1: TMenuItem + Tag = 23 + Caption = 'atlassaturationalpha' + Hint = 'atlassaturationalpha (saturation, transparency: float) Set saturation and transparency of atlas. A desaturated atlas will appear gray, a transparent atlas will reveal the background color.' + OnClick = InsertCommand + end + object atlasstatmap1: TMenuItem + Tag = 241819 + Caption = 'atlasstatmap' + Hint = 'atlasstatmap (atlasname, statname: string; const indices: array of integer; const intensities: array of single) This creates a new mesh, where indexed regions are saved having the corresponding brightness from the array ''indices''. For example atlasstatmap(''jhu.mz3'','''',[1,3,9],[1.1, 4.4, 2.4]) creates a mesh where regions 1, 3, and 9 are given values 1.1, 4.4 and 2.4. If statname is provided, a mesh will be saved to disk, e.g. atlasstatmap(''jhu.mz3'',''out.mz3'',[1,3,9],[1.1, 4.4, 2.4]). nb this function is for creating maps, you can load them with loadmesh() and loadoverlay(). ' + OnClick = InsertCommand + end + end + object Dialogs1: TMenuItem + Caption = 'Dialogs' + object modalmessage1: TMenuItem + Tag = 4 + Caption = 'modalmessage' + Hint = 'modalmessage (str: string) Shows a modal dialog, script stops until user presses ''OK'' button to dismiss dialog.' + OnClick = InsertCommand + end + object modelessmessage1: TMenuItem + Tag = 4 + Caption = 'modelessmessage' + Hint = 'modelessmessage (str: string) Shows text in the bottom status region of the scripting window.' + OnClick = InsertCommand + end + end + object Shaders1: TMenuItem + Caption = 'Shaders' + object shaderadjust1: TMenuItem + Tag = 1413 + Caption = 'shaderadjust' + Hint = 'shaderadjust (property: string; value: float) Sets one of the user-adjustable properties.' + OnClick = InsertCommand + end + object shaderambientocclusion1: TMenuItem + Tag = 3 + Caption = 'shaderambientocclusion' + Hint = 'shaderambientocclusion (amount: float) Specify a value in the range 0..1 to set the strength of the crevice shadows' + OnClick = InsertCommand + end + object shadername1: TMenuItem + Tag = 4 + Caption = 'shadername' + Hint = 'shadername (Filename: string) Loads the requested shader.' + OnClick = InsertCommand + end + object shaderlightazimuthelevation1: TMenuItem + Tag = 22 + Caption = 'shaderlightazimuthelevation' + Hint = 'shaderlightazimuthelevation (azimuth, elevation: integer) Changes location of light source.' + OnClick = InsertCommand + end + object shaderxray1: TMenuItem + Tag = 23 + Caption = 'shaderxray' + Hint = 'shaderxray (object, overlay: float) See occluded overlays/tracks/nodes by making either object transparent (0..1) or overlay/tracks/nodes emphasized (0..1)' + OnClick = InsertCommand + end + object MenuItem1: TMenuItem + Tag = 1 + Caption = 'shaderforbackgroundonly' + Hint = 'shaderforbackgroundonly (onlybg: boolean) If true selected shader only influeces background image, otherwise shader influences background, overlays, tracks and nodes.' + OnClick = InsertCommand + end + end + object Render1: TMenuItem + Caption = 'View' + object azimuth1: TMenuItem + Tag = 2 + Caption = 'azimuth' + Hint = 'azimuth (degrees: integer) This command rotates the rendering.' + OnClick = InsertCommand + end + object azimuthelevation1: TMenuItem + Tag = 22 + Caption = 'azimuthelevation' + Hint = 'azimuthelevation (azi, elev: integer) Sets the viewer location.' + OnClick = InsertCommand + end + object backcolor1: TMenuItem + Tag = 36 + Caption = 'backcolor' + Hint = 'backcolor(r, g, b: integer) Changes the background color, for example backcolor(255, 0, 0) will set a bright red background' + OnClick = InsertCommand + end + object cameradistance1: TMenuItem + Tag = 3 + Caption = 'cameradistance' + Hint = 'cameradistance (z: float) Sets the viewing distance from the object.' + OnClick = InsertCommand + end + object camerapan1: TMenuItem + Tag = 23 + Caption = 'camerapan' + Hint = 'camerapan (x, y: float) Translate image horizontally (x) and vertically (y). range -1..+1, where 0 is centered. ' + OnClick = InsertCommand + end + object MenuItem2: TMenuItem + Tag = 2 + Caption = 'colorbarposition' + Hint = 'colorbarposition (pos: integer) Sets the position of the colorbar: 1=bottom, 2=left, 3=top, 4=right.' + OnClick = InsertCommand + end + object colorbarvisible1: TMenuItem + Tag = 1 + Caption = 'colorbarvisible' + Hint = 'colorbarvisible (visible: boolean) Shows a colorbar on the main images.' + OnClick = InsertCommand + end + object clip1: TMenuItem + Tag = 3 + Caption = 'clip' + Hint = 'clip (depth: float) Creates a clip plane that hides information close to the viewer.' + OnClick = InsertCommand + end + object clipazimuthelevation1: TMenuItem + Tag = 33 + Caption = 'clipazimuthelevation' + Hint = 'clipazimuthelevation (depth, azi, elev: float) Set a view-point independent clip plane.' + OnClick = InsertCommand + end + object elevation1: TMenuItem + Tag = 2 + Caption = 'elevation' + Hint = 'elevation (degrees: integer) Changes the render camera up or down.' + OnClick = InsertCommand + end + object orientcubevisible1: TMenuItem + Tag = 1 + Caption = 'orientcubevisible' + Hint = 'orientcubevisible (visible: boolean) Show or hide cube that indicates object rotation' + OnClick = InsertCommand + end + object viewaxial1: TMenuItem + Tag = 1 + Caption = 'viewaxial' + Hint = 'viewaxial (std: boolean) Creates rendering from an axial viewpoint.' + OnClick = InsertCommand + end + object viewcoronal1: TMenuItem + Tag = 1 + Caption = 'viewcoronal' + Hint = 'viewcoronal (std: boolean) Creates rendering from a coronal viewpoint.' + OnClick = InsertCommand + end + object viewsagittal1: TMenuItem + Tag = 1 + Caption = 'viewsagittal' + Hint = 'viewsagittal (std: boolean) creates rendering from an sagittal viewpoint.' + OnClick = InsertCommand + end + end + object Advanced1: TMenuItem + Caption = 'Advanced' + object bmpzoom1: TMenuItem + Tag = 2 + Caption = 'bmpzoom' + Hint = 'bmpzoom (z: integer) copy and save bitmaps at higher resolution than screen. bmpzoom(2) will save images at twice the resolution.' + OnClick = InsertCommand + end + object exists1: TMenuItem + Tag = 4 + Caption = 'exists' + Hint = 'exists (filename: string): boolean Returns true if file exists on disk.' + OnClick = InsertCommand + end + object fontname1: TMenuItem + Tag = 4 + Caption = 'fontname' + Hint = 'fontname (filename) Changes font used for colorbar. For example, "fontname(''''ubuntu'''')" will use the Ubuntu font.' + OnClick = InsertCommand + end + object savebmp1: TMenuItem + Tag = 4 + Caption = 'savebmp' + Hint = 'savebmp (filename: string) Saves the currently viewed image as a PNG format compressed bitmap image.' + OnClick = InsertCommand + end + object savebmpxy1: TMenuItem + Tag = 1422 + Caption = 'savebmpxy' + Hint = 'savebmpxy (filename: string; x, y: integer) Saves the currently viewed image as a PNG bitmap image. Specify the image width (x) and height (y)' + OnClick = InsertCommand + end + object scriptformvisible1: TMenuItem + Tag = 1 + Caption = 'scriptformvisible' + Hint = 'scriptformvisible (visible: boolean) Shows/hides the scripting form.' + OnClick = InsertCommand + end + object version1: TMenuItem + Caption = 'version' + Hint = 'version (): string Returns software version name.' + end + object quit1: TMenuItem + Caption = 'quit' + Hint = 'quit () Terminate application. Useful if another program is controlling this software' + OnClick = InsertCommand + end + end + object Close1: TMenuItem + Caption = 'closeall' + Hint = 'closeall () Closes all open meshes, overlays, nodes and tracks' + Visible = False + OnClick = InsertCommand + end + object resetdefaults1: TMenuItem + Caption = 'resetdefaults' + Hint = 'resetdefaults () Sets all of the user adjustable settings to their default values.' + OnClick = InsertCommand + end + object wait1: TMenuItem + Tag = 2 + Caption = 'wait' + Hint = 'wait (msec: integer) The program pauses for the specified duration. For example WAIT(1000) delays the script for one second.' + OnClick = InsertCommand + end + end + object ScriptingRunMenu: TMenuItem + Caption = 'Run' + ShortCut = 16466 + OnClick = ScriptingRunMenuClick + end + end object HelpMenu: TMenuItem Caption = 'Help' Visible = False @@ -1683,4 +2549,22 @@ object GLForm1: TGLForm1 left = 448 top = 24 end + object ScriptOpenDialog: TOpenDialog + DefaultExt = '.py' + Filter = 'Scripts (*.py;*.gls)|*.py;*.gls|Python scripts (*.py)|*.py|Pascal scripts (*.gls)|*.gls' + left = 280 + top = 368 + end + object PSScript1: TPSScript + CompilerOptions = [] + OnCompile = PSScript1Compile + Plugins = <> + UsePreProcessor = False + left = 39 + top = 64 + end + object SaveScriptDialog: TSaveDialog + left = 461 + top = 141 + end end diff --git a/mainunit.pas b/mainunit.pas index 513488d..b062445 100755 --- a/mainunit.pas +++ b/mainunit.pas @@ -1,25 +1,129 @@ unit mainunit; {$Include opts.inc} //optiosn: DGL, CoreGL or legacy GL {$mode delphi}{$H+} +{$DEFINE MYPY} interface uses {$IFDEF DGL} dglOpenGL, {$ELSE DGL} {$IFDEF COREGL}glcorearb, {$ELSE} gl, {$ENDIF} {$ENDIF DGL} fphttpclient, strutils, + {$IFDEF MYPY}PythonEngine, {$ENDIF} //{$IFDEF SCRIPTING} - scriptengine, //{$ENDIF} {$IFNDEF UNIX} shellapi, {$ELSE} Process, {$ENDIF} - {$IFNDEF Darwin}uscaledpi, {$ENDIF} {$IFDEF COREGL} gl_core_3d, {$ELSE} gl_legacy_3d, {$ENDIF} - Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, + uPSComponent,Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, math, ExtCtrls, OpenGLContext, mesh, LCLintf, ComCtrls, Menus, graphtype, curv, ClipBrd, shaderui, shaderu, prefs, userdir, LCLtype, Grids, Spin, Buttons, matmath, colorTable, Track, types, glcube, glclrbar, define_types, - meshify, zstream, gl_core_matrix, meshify_simplify; + meshify, zstream, gl_core_matrix, meshify_simplify, CheckLst; type { TGLForm1 } TGLForm1 = class(TForm) +LayerList: TCheckListBox; +LayerDarkLabel: TLabel; +LayerDarkEdit: TEdit; +LayerBrightEdit: TEdit; +LayerBrightLabel: TLabel; +LayerColorDrop: TComboBox; +LayerAlphaLabel: TLabel; +LayerAlphaTrack: TTrackBar; +LayerOptionsBtn: TButton; + LeftSplitter: TSplitter; + CenterPanel: TPanel; + overlayload1: TMenuItem; + overlayvisible1: TMenuItem; + PSScript1: TPSScript; + S3Label: TLabel; + SaveScriptDialog: TSaveDialog; + ScriptingInsertMenu: TMenuItem; +mesh1: TMenuItem; +meshload1: TMenuItem; +meshcolor1: TMenuItem; +meshcurv1: TMenuItem; +meshcreate1: TMenuItem; +meshreversefaces1: TMenuItem; +meshsave1: TMenuItem; +overlays1: TMenuItem; +overlayadditive1: TMenuItem; +overlaycloseall1: TMenuItem; +overlaycolorname1: TMenuItem; +overlayminmax1: TMenuItem; +overlaytransparencyonbackground1: TMenuItem; +overlaycolorfromzero1: TMenuItem; +overlaytranslucent1: TMenuItem; +overlayinvert1: TMenuItem; +overlaysmoothvoxelwisedata1: TMenuItem; +meshoverlayorder1: TMenuItem; +Nodes1: TMenuItem; +edgeload1: TMenuItem; +edgecolor1: TMenuItem; +edgecreate1: TMenuItem; +edgesize1: TMenuItem; +edgethresh1: TMenuItem; +nodeload1: TMenuItem; +nodecolor1: TMenuItem; +nodecreate1: TMenuItem; +nodehemisphere1: TMenuItem; +ndepolarity1: TMenuItem; +nodesize1: TMenuItem; +nodethresh1: TMenuItem; +nodethreshbysizenotcolor1: TMenuItem; +Tracks1: TMenuItem; +trackload1: TMenuItem; +trackprefs1: TMenuItem; +Atlas1: TMenuItem; +atlasgray1: TMenuItem; +atlashide1: TMenuItem; +atlasmaxindex1: TMenuItem; +atlassaturationalpha1: TMenuItem; +atlasstatmap1: TMenuItem; +Dialogs1: TMenuItem; +modalmessage1: TMenuItem; +modelessmessage1: TMenuItem; +Shaders1: TMenuItem; +shaderadjust1: TMenuItem; +shaderambientocclusion1: TMenuItem; +shadername1: TMenuItem; +shaderlightazimuthelevation1: TMenuItem; +shaderxray1: TMenuItem; +MenuItem1: TMenuItem; +Render1: TMenuItem; +azimuth1: TMenuItem; +azimuthelevation1: TMenuItem; +backcolor1: TMenuItem; +cameradistance1: TMenuItem; +camerapan1: TMenuItem; +MenuItem2: TMenuItem; +colorbarvisible1: TMenuItem; +clip1: TMenuItem; +clipazimuthelevation1: TMenuItem; +elevation1: TMenuItem; +orientcubevisible1: TMenuItem; +viewaxial1: TMenuItem; +viewcoronal1: TMenuItem; +viewsagittal1: TMenuItem; +Advanced1: TMenuItem; +bmpzoom1: TMenuItem; +exists1: TMenuItem; +fontname1: TMenuItem; +savebmp1: TMenuItem; +savebmpxy1: TMenuItem; +scriptformvisible1: TMenuItem; +version1: TMenuItem; +quit1: TMenuItem; +Close1: TMenuItem; +resetdefaults1: TMenuItem; +wait1: TMenuItem; + + + ScriptingPascalMenu: TMenuItem; + ScriptPanel: TPanel; + ScriptBox: TGroupBox; + ScriptMemo: TMemo; + ScriptOutputMemo: TMemo; + ScriptSplitter: TSplitter; + RightSplitter: TSplitter; AOLabel: TLabel; CurvMenu: TMenuItem; CurvMenuTemp: TMenuItem; @@ -33,39 +137,29 @@ TGLForm1 = class(TForm) MeshBlendTrack: TTrackBar; BGShader: TLabel; ROImeshMenu: TMenuItem; - TrackLengthLabel2: TLabel; + XRayLabel: TLabel; TransBlackClrbarMenu: TMenuItem; ColorBarVisibleMenu: TMenuItem; WhiteClrbarMenu: TMenuItem; TransWhiteClrBarMenu: TMenuItem; NewWindow1: TMenuItem; S1Check: TCheckBox; - S6Check: TCheckBox; S6Label: TLabel; S6Track: TTrackBar; - S2Check: TCheckBox; S1Label: TLabel; - S7Check: TCheckBox; S7Label: TLabel; S7Track: TTrackBar; - S3Check: TCheckBox; S2Label: TLabel; S1Track: TTrackBar; RestrictSep2Menu: TMenuItem; RestrictHideNodesWithoutEdges: TMenuItem; - S8Check: TCheckBox; S8Label: TLabel; S8Track: TTrackBar; - S4Check: TCheckBox; - S3Label: TLabel; S2Track: TTrackBar; - S9Check: TCheckBox; S9Label: TLabel; S9Track: TTrackBar; - S5Check: TCheckBox; S4Label: TLabel; S3Track: TTrackBar; - S10Check: TCheckBox; S5Label: TLabel; S4Track: TTrackBar; S10Label: TLabel; @@ -80,7 +174,6 @@ TGLForm1 = class(TForm) TrackScalarLUTdrop: TComboBox; TrackScalarNameDrop: TComboBox; SimplifyMeshMenu: TMenuItem; - ScriptMenu: TMenuItem; SimplifyTracksMenu: TMenuItem; TransparencySepMenu: TMenuItem; ReverseFacesMenu: TMenuItem; @@ -99,9 +192,9 @@ TGLForm1 = class(TForm) PrefMenu: TMenuItem; NodeMaxEdit: TFloatSpinEdit; NodeMinEdit: TFloatSpinEdit; - EdgeMinLabel1: TLabel; + NodeThreshLabel: TLabel; NodeThreshDrop: TComboBox; - NodeScaleLabel1: TLabel; + EdgeSizeLabel: TLabel; NodeScaleTrack: TTrackBar; EdgeMinEdit: TFloatSpinEdit; EdgeMaxEdit: TFloatSpinEdit; @@ -109,7 +202,7 @@ TGLForm1 = class(TForm) EdgeBox: TGroupBox; EdgeColorVariesCheck: TCheckBox; NodeScaleLabel: TLabel; - EdgeMinLabel: TLabel; + EdgeThreshLabel: TLabel; edgeScaleTrack: TTrackBar; RestrictSepMenu: TMenuItem; RestrictAnyEdgeMenu: TMenuItem; @@ -141,7 +234,7 @@ TGLForm1 = class(TForm) QuickColorMenu: TMenuItem; NodeBox: TGroupBox; MeshColorBox: TGroupBox; - TrackLengthLabel1: TLabel; + SatLabel: TLabel; MeshSaturationTrack: TTrackBar; TrackWidthLabel: TLabel; TrackLengthTrack: TTrackBar; @@ -150,7 +243,6 @@ TGLForm1 = class(TForm) ClipAziTrack: TTrackBar; ClipBox: TGroupBox; ClipTrack: TTrackBar; - CollapseToolPanelBtn: TButton; ColorDialog1: TColorDialog; LightElevTrack: TTrackBar; ClipElevTrack: TTrackBar; @@ -159,7 +251,6 @@ TGLForm1 = class(TForm) DepthLabel: TLabel; AzimuthLabel: TLabel; ElevationLabel: TLabel; - LUTdrop: TComboBox; MainMenu1: TMainMenu; AppleMenu: TMenuItem; FileMenu: TMenuItem; @@ -173,9 +264,9 @@ TGLForm1 = class(TForm) CloseOverlaysMenu: TMenuItem; AddTracksMenu: TMenuItem; CloseTracksMenu: TMenuItem; - TrackWidthLabel1: TLabel; - TrackWidthLabel2: TLabel; - TrackWidthLabel3: TLabel; + NodeColorLabel: TLabel; + EdgeColorLabel: TLabel; + TransLabel: TLabel; TrackDitherLabel: TLabel; TrackWidthTrack: TTrackBar; TracksMenu: TMenuItem; @@ -188,25 +279,60 @@ TGLForm1 = class(TForm) TransparencyMenu: TMenuItem; OverlaysMenu: TMenuItem; OpenDialog: TOpenDialog; - CollapsedToolPanel: TPanel; OverlayBox: TGroupBox; ShaderBox: TGroupBox; ShaderDrop: TComboBox; ErrorTimer: TTimer; - StringGrid1: TStringGrid; OverlayTimer: TTimer; UpdateTimer: TTimer; - ToolPanel: TPanel; + ToolPanel: TScrollBox; SaveBitmapDialog: TSaveDialog; SaveMenu: TMenuItem; ObjectColorMenu: TMenuItem; OpenMenu: TMenuItem; BackgroundBox: TGroupBox; + ScriptingMenu: TMenuItem; + ScriptingNewMenu: TMenuItem; + ScriptingOpenMenu: TMenuItem; + ScriptingTemplatesMenu: TMenuItem; + ScriptingRunMenu: TMenuItem; + ScriptingSaveMenu: TMenuItem; +ScriptOpenDialog: TOpenDialog; +LayerPopup: TPopupMenu; +LayerInvertColorsMenu: TMenuItem; +LayerShowHeaderMenu: TMenuItem; +procedure LayerListClickCheck(Sender: TObject); +procedure LayerPopupPopup(Sender: TObject); +procedure LayerInvertColorsMenuClick(Sender: TObject); +procedure LayerShowHeaderMenuClick(Sender: TObject); +procedure LayerWidgetChange(Sender: TObject); +procedure LayerOptionsBtnClick(Sender: TObject); +procedure LayerContrastKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); +procedure LayerListSelectionChange(Sender: TObject; User: boolean); +procedure LayerAlphaTrackMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure LayerListShowHint(Sender: TObject; HintInfo: PHintInfo); + procedure LeftSplitterCanOffset(Sender: TObject; var NewOffset: Integer; + var Accept: Boolean); + procedure LeftSplitterCanResize(Sender: TObject; var NewSize: Integer; + var Accept: Boolean); + procedure LeftSplitterChangeBounds(Sender: TObject); + procedure LeftSplitterMoved(Sender: TObject); + procedure UpdateLayerBox(NewLayers: boolean); + + procedure ScriptingNewMenuClick(Sender: TObject); + procedure ScriptingOpenMenuClick(Sender: TObject); + procedure ScriptingTemplatesMenuClick(Sender: TObject); + procedure ScriptingPascalMenuClick(Sender: TObject); + + procedure ScriptingRunMenuClick(Sender: TObject); + procedure ScriptingSaveMenuClick(Sender: TObject); + procedure ScriptingGenerateTemplateMenu(isPython: boolean); + procedure ScriptFormVisible(vis: boolean); + procedure OpenScript(scriptname: string; isShowScriptPanel: boolean = true); + procedure FormDestroy(Sender: TObject); procedure NodeThreshDropChange(Sender: TObject); procedure ROImeshMenuClick(Sender: TObject); - procedure StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, - Y: Integer); function UpdateClrbar: integer; procedure ClrbarClr(i: integer); procedure UpdateFont(initialSetup: boolean); @@ -244,7 +370,6 @@ TGLForm1 = class(TForm) procedure CloseNodesMenuClick(Sender: TObject); procedure CloseOverlaysMenuClick(Sender: TObject); procedure CloseTracksMenuClick(Sender: TObject); - procedure CollapseToolPanelBtnClick(Sender: TObject); procedure CopyMenuClick(Sender: TObject); procedure DepthLabelClick(Sender: TObject); procedure DisplayMenuClick(Sender: TObject); @@ -252,7 +377,7 @@ TGLForm1 = class(TForm) procedure ErrorTimerTimer(Sender: TObject); procedure GLBoxMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); - procedure LUTdropChange(Sender: TObject); + procedure UpdateLUT(lOverlay,lLUTIndex: integer); procedure NodePrefChange(Sender: TObject); procedure OrientCubeMenuClick(Sender: TObject); procedure OverlayTimerStart; @@ -295,7 +420,7 @@ TGLForm1 = class(TForm) procedure ScalarDropChange(Sender: TObject); function ScreenShot(lForceRedraw: boolean = false): TBitmap; function ScreenShotX1: TBitmap; - procedure ScriptMenuClick(Sender: TObject); + procedure ScriptPanelDblClick(Sender: TObject); procedure SetOverlayTransparency(Sender: TObject); procedure ShaderBoxResize(Sender: TObject); procedure ShaderDropChange(Sender: TObject); @@ -303,30 +428,17 @@ TGLForm1 = class(TForm) procedure GLboxRequestUpdate(Sender: TObject); procedure SimplifyMeshMenuClick(Sender: TObject); procedure SimplifyTracksMenuClick(Sender: TObject); - procedure StringGrid1EditingDone(Sender: TObject); - procedure StringGrid1Enter(Sender: TObject); procedure SurfaceAppearanceChange(Sender: TObject); - procedure ReadCell (ACol,ARow: integer; Update: boolean); - procedure StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer; - aRect: TRect; aState: TGridDrawState); - procedure StringGrid1Exit(Sender: TObject); - procedure StringGrid1KeyPress(Sender: TObject; var Key: char); - procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); - procedure StringGrid1SelectCell(Sender: TObject; aCol, aRow: Integer; - var CanSelect: Boolean); procedure SwapYZMenuClick(Sender: TObject); procedure TrackBoxChange(Sender: TObject); procedure TrackScalarRangeBtnClick(Sender: TObject); procedure UniformChange(Sender: TObject); procedure UpdateTimerTimer(Sender: TObject); procedure UpdateImageIntensity; - procedure UpdateLUT(lOverlay,lLUTIndex: integer; lChangeDrop: boolean); function ComboBoxName2Index(var lCombo: TComboBox; lName: string): integer; procedure SetDistance(Distance: single); procedure OVERLAYMINMAX (lOverlay: integer; lMin,lMax: single); procedure OVERLAYCOLORNAME(lOverlay: integer; lFilename: string); - procedure UpdateOverlaySpread;// (lIndex: integer); //procedure SetOrtho (w,h: integer; isMultiSample: boolean); procedure AddMRU(lFilename: string); procedure UpdateMRU; @@ -337,69 +449,1618 @@ TGLForm1 = class(TForm) procedure VolumeToMeshMenuClick(Sender: TObject); procedure ShaderForBackgroundOnlyClick(Sender: TObject); procedure GLInvalidate; - private + procedure InsertCommand(Sender: TObject); + procedure CompileMainClick(Sender: TObject); + procedure PyIOSendData(Sender: TObject; const Data: AnsiString); + procedure PyIOSendUniData(Sender: TObject; const Data: UnicodeString); + + function PyIsPythonScriptMain(): boolean; + function PyExecMain(): boolean; + function PyCreate: boolean; + procedure PyModInitialization(Sender: TObject); + procedure PSScript1Compile(Sender: TPSScript); + + private { private declarations } public { public declarations } end; var - GLForm1: TGLForm1; - gCube : TGLCube; - gClrbar: TGLClrbar; - gPrefs : TPrefs; - gElevation : integer =20; - gAzimuth : integer = 250; - gMesh: TMesh; -implementation -//{$IFDEF COREGL} -{$IFDEF LCLcarbon} - This program does not support Carbon - Please choose Project/ProjectOptions, go to the CompilerOptions/Additions&Overrides and set the BuildMode pull-down to "MacOS" -{$ENDIF} -//{$ENDIF} + GLForm1: TGLForm1; + gCube : TGLCube; + gClrbar: TGLClrbar; + gPrefs : TPrefs; + gElevation : integer =20; + gAzimuth : integer = 250; + gMesh: TMesh; +implementation +//{$IFDEF COREGL} +{$IFDEF LCLcarbon} + This program does not support Carbon + Please choose Project/ProjectOptions, go to the CompilerOptions/Additions&Overrides and set the BuildMode pull-down to "MacOS" +{$ENDIF} +//{$ENDIF} + +{$R *.lfm} +{$IFDEF LCLCocoa} +uses + commandsu,UserNotification, nsappkitext, glcocoanscontext; +{$ELSE} +uses + commandsu; + +{$ENDIF} +var + PythonIO : TPythonInputOutput; + PyMod: TPythonModule; + PyEngine: TPythonEngine = nil; + + gNode: TMesh; + gTrack: TTrack; + gnLUT: integer = 0; + isBusy: boolean = true; + {$IFDEF Darwin}gRetinaScale : single = 1;{$ENDIF} + gDistance : single = 1; + gMouseX : integer = -1; + gMouseY : integer = -1; + GLerror : string = ''; + clipPlane : TPoint4f; //clipping bottom + GLbox: TOpenGLControl; +const + kFname=0; + kLUT=1; + kMin=2; + kMax=3; + kTrackFilter = 'Camino, VTK, MRTrix, Quench, TrakVis, DTIstudio|*.Bfloat;*.Bfloat.gz;*.trk.gz;*.trk;*.tck;*.pdb;*.fib;*.vtk;*.dat|Any file|*.*'; + +procedure CleanStr (var lStr: string); +//remove symbols, set lower case... +var + lLen,lPos: integer; + lS: string; +begin + lLen := length(lStr); + if lLen < 1 then + exit; + lS := ''; + for lPos := 1 to lLen do + if lStr[lPos] in ['0'..'9','a'..'z','A'..'Z'] then + lS := lS + AnsiLowerCase(lStr[lPos]); + lStr := lS; +end; + +function IsPythonCompatible(lType: integer): boolean; +//current Python can not handle passing array types +var + lTstr: string; + i, len, n, t: integer; +begin + result := true; + lTStr := inttostr(lType); + len := length(lTStr); + i := 1; + while i <= len do begin + if i = len then + n := 1 + else begin + n := strtoint(lTStr[i]); + inc(i); + end; + t := strtoint(lTStr[i]); + if (t = 8) or (t = 9) then + result := false; + inc(i); + end; +end; + +function TypeStr (lType: integer; isPy: boolean = false): string; +var + lTStr,lStr : string; + i,n,len,lLoop,lT: integer;//1=boolean,2=integer,3=float,4=string[filename] +begin + result := ''; + if (lType = 0) and (isPy) then + result := '()'; + if lType = 0 then + exit; + lTStr := inttostr(lType); + lStr := '('; + len := length(lTStr); + i := 1; + while i <= len do begin + if i = len then + n := 1 + else begin + n := strtoint(lTStr[i]); + inc(i); + end; + lT := strtoint(lTStr[i]); + inc(i); + for lLoop := 1 to n do begin + case lT of + 1: begin + if isPy then + lStr := lStr +'1' + else + lStr := lStr +'true'; + + end; + 2: lStr := lStr +'1'; + 3: begin + if lLoop <= 3 then //for Cutout view, we need six values - make them different so this is a sensible cutout + lStr := lStr +'0.5' + else + lStr := lStr +'1.0'; + end; + 4: lStr := lStr +'''filename'''; + 5: lStr := lStr + '''0.2 0.4 0.6; 0.8 S 0.5'''; + 6: begin //byte + if lLoop <= 3 then //for Cutout view, we need six values - make them different so this is a sensible cutout + lStr := lStr +'1' + else + lStr := lStr +'255'; + end; + 7: lStr := lStr +'5';//kludge - make integer where 1 is not a good default, e.g. shaderquality + 8: lStr := lStr +'[1, 2, 4]'; + 9: lStr := lStr +'[1.1, 2.5, 4.2]'; + else lStr := lStr + '''?'''; + end;//case + if lLoop < n then + lStr := lStr+', '; + end;//for each loop + if i < len then + lStr := lStr+', '; + end; + lStr := lStr + ')'; + result := lStr; +end; + +procedure MyWriteln(const s: string); +begin + GLForm1.ScriptOutputMemo.lines.add(S); + {$IFDEF Unix}writeln(s);{$ENDIF} +end; + +procedure TGLForm1.PSScript1Compile(Sender: TPSScript); +var + i: integer; +begin + //Sender.AddFunction( @TScriptForm.MyWriteln,'procedure Writeln(const s: string);'); + Sender.AddFunction(@MyWriteln, 'procedure Writeln(s: string);'); + for i := 1 to knFunc do + Sender.AddFunction(kFuncRA[i].Ptr,'function '+kFuncRA[i].Decl+kFuncRA[i].Vars+';'); + for i := 1 to knProc do + Sender.AddFunction(kProcRA[i].Ptr,'procedure '+kProcRA[i].Decl+kProcRA[i].Vars+':'); +end; + +procedure TGLForm1.InsertCommand(Sender: TObject); +var + lStr: string; + isPy: boolean; +begin + {$IFDEF MYPY} + isPy := PyIsPythonScriptMain(); + {$ELSE} + isPy := false; + {$ENDIF} + lStr := (Sender as TMenuItem).Hint; + if lStr <> '' then begin + ScriptOutputMemo.Lines.Clear; + ScriptOutputMemo.Lines.Add(lStr); + end; + lStr := (Sender as TMenuItem).Caption; + CleanStr(lStr); + if isPy then begin + if IsPythonCompatible((Sender as TMenuItem).Tag) then + lStr := 'gl.'+lStr+TypeStr((Sender as TMenuItem).Tag, isPy) + else + lStr := '#not yet Python Compatible: gl.'+lStr+TypeStr((Sender as TMenuItem).Tag, isPy) + end else + lStr := lStr+TypeStr((Sender as TMenuItem).Tag)+ ';'; + Clipboard.AsText := lStr; + {$IFDEF UNIX} + ScriptMemo.SelText := (lStr)+ kUNIXeoln; + {$ELSE} + ScriptMemo.SelText := (lStr)+ #13#10; + {$ENDIF} +end; + +function ScriptDir: string; +begin + result := AppDir+'script'; + {$IFDEF UNIX} + if fileexists(result) then exit; + result := '/usr/share/mricrogl/script'; + if fileexists(result) then exit; + result := AppDir+'script' + {$ENDIF} +end; + + +function searchPy(pth: string): string; +var + searchResult : TSearchRec; +begin + result := ''; + {$IFDEF Darwin} + if FindFirst(IncludeTrailingPathDelimiter(pth)+'libpython*.dylib', faDirectory, searchResult) = 0 then + {$ELSE} + if FindFirst(IncludeTrailingPathDelimiter(pth)+'libpython*.so', faDirectory, searchResult) = 0 then + {$ENDIF} + result := IncludeTrailingPathDelimiter(pth)+(searchResult.Name); + FindClose(searchResult); +end; +{$IFDEF Darwin} + const + kBasePath = '/Library/Frameworks/Python.framework/Versions/'; +{$ENDIF} + + {$IFDEF UNIX} + function InitPyLibraryPath: string; + // + function GetMacPath(NMinorVersion: integer): string; + begin + Result:= Format('/Library/Frameworks/Python.framework/Versions/3.%d/lib/libpython3.%d.dylib', + [NMinorVersion, NMinorVersion]); + end; + // + var + N: integer; + begin + Result:= ''; + {$ifdef windows} + exit('python35.dll'); + {$endif} + + {$ifdef linux} + exit('libpython3.6m.so.1.0'); + {$endif} + + {$ifdef freebsd} + exit('libpython3.6m.so'); + {$endif} + + {$ifdef darwin} + for N:= 4 to 9 do + begin + Result:= GetMacPath(N); + if FileExists(Result) then exit; + end; + {$endif} + end; +{$ENDIF} + + function findPythonLib(def: string): string; + {$IFDEF WINDOWS} + var + fnm: string; + begin + result := def; + if fileexists(def) then exit; + result :=''; //assume failure + fnm := ScriptDir + pathdelim + 'python35.dll'; + if not FileExists(fnm) then exit; + if not FileExists(changefileext(fnm,'.zip')) then exit; + result := fnm; + end; + {$ELSE} + {$IFDEF Linux} + const + knPaths = 8; + // /usr/lib/i386-linux-gnu/ + {$IFDEF CPU64} + kBasePaths : array [1..knPaths] of string = ('/lib/','/lib64/','/usr/lib64/','/usr/lib/x86_64-linux-gnu/','/usr/lib/','/usr/local/lib/','/usr/lib/python2.7/config-x86_64-linux-gnu/','/opt/gitlab/embedded/lib/'); + {$ELSE} + kBasePaths : array [1..knPaths] of string = ('/lib/','/lib32/','/usr/lib32/','/usr/lib/i386-linux-gnu/','/usr/lib/','/usr/local/lib/','/usr/lib/python2.7/config-i386-linux-gnu/','/opt/gitlab/embedded/lib/'); + {$ENDIF} + kBaseName = 'libpython'; + {$ENDIF} + {$IFDEF Darwin} + const + knPaths = 3; + kBasePaths : array [1..knPaths] of string = (kBasePath, '/System'+kBasePath, '/System/Library/Frameworks/Python.framework/Versions/Current/lib/'); + + {$ENDIF} + var + searchResult : TSearchRec; + pth, fnm: string; + vers : TStringList; + n: integer; + begin + result := def; + if DirectoryExists(def) then begin //in case the user supplies libdir not the library name + result := searchPy(def); + (*{$IFDEF Darwin} + if FindFirst(IncludeTrailingPathDelimiter(def)+'libpython*.dylib', faDirectory, searchResult) = 0 then + {$ELSE} + if FindFirst(IncludeTrailingPathDelimiter(def)+'libpython*.so', faDirectory, searchResult) = 0 then + {$ENDIF} + result := IncludeTrailingPathDelimiter(def)+(searchResult.Name); + FindClose(searchResult); *) + if length(result) > 0 then exit; + end; + {$IFDEF LCLCocoa} + result := searchPy('/System/Library/Frameworks/Python.framework/Versions/Current/lib'); + if fileexists(result) then exit; + {$ENDIF} + //if fileexists(def) then exit; + result := InitPyLibraryPath; + if fileexists(result) then exit; + vers := TStringList.Create; + n := 1; + while (n <= knPaths) and (vers.Count < 1) do begin + pth := kBasePaths[n]; + n := n + 1; + if not DirectoryExists(pth) then continue; + {$IFDEF Linux} + if FindFirst(pth+'*.so', faDirectory, searchResult) = 0 then begin + {$ELSE} + if FindFirst(pth+'*', faDirectory, searchResult) = 0 then begin + {$ENDIF} + repeat + //showmessage('?'+searchResult.Name); + if (length(searchResult.Name) < 1) or (searchResult.Name[1] = '.') then continue; + {$IFDEF LINUX} + if (pos(kBaseName,searchResult.Name) < 1) then continue; + {$ELSE} + if (not (searchResult.Name[1] in ['0'..'9'])) then continue; + {$ENDIF} + if (pos('libpython2.6',searchResult.Name) < 1) then + vers.Add(searchResult.Name); + until findnext(searchResult) <> 0; + end; + FindClose(searchResult); + end; + if vers.Count < 1 then begin + vers.Free; + result :=''; //assume failure + for n := 1 to knPaths do begin + pth := kBasePaths[n]; + result := searchPy(pth); + if fileexists(result) then exit; + end; + result := ''; + exit; + end; + vers.Sort; + fnm := vers.Strings[vers.Count-1]; //newest version? what if 3.10 vs 3.9? + vers.Free; + {$IFDEF Darwin} + fnm := kBasePath+fnm+'/lib/libpython'+fnm+'.dylib'; + {$ENDIF} + {$IFDEF LINUX} + fnm := pth+ fnm; + {$ENDIF} + if fileexists(fnm) then + result := fnm; + end; + {$ENDIF} + +function PyVERSION(Self, Args : PPyObject): PPyObject; cdecl; +begin + with GetPythonEngine do + Result:= PyString_FromString(kVers); +end; + +function PyRESETDEFAULTS(Self, Args : PPyObject): PPyObject; cdecl; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + RESETDEFAULTS; +end; + +function PyMESHCURV(Self, Args : PPyObject): PPyObject; cdecl; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + MESHCURV; + //GLForm1.Caption := inttostr(random(888)); +end; + +function PyMESHREVERSEFACES(Self, Args : PPyObject): PPyObject; cdecl; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + MESHREVERSEFACES; +end; + + +function BOOL(i: integer): boolean; +begin + result := i <> 0; +end; + +function PySAVEBMP(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:savebmp', @PtrName)) then + begin + StrName:= string(PtrName); + SAVEBMP(StrName); + end; +end; + +function PySAVEBMPXY(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; + x,y: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'sii:savebmpxy', @PtrName, @x, @y)) then + begin + StrName:= string(PtrName); + SAVEBMPXY(StrName, x, y); + end; +end; +function PyBACKCOLOR(Self, Args : PPyObject): PPyObject; cdecl; +var + R,G,B: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'iii:backcolor', @R,@G,@B)) then + BACKCOLOR(R,G,B); +end; + +function PyMESHCOLOR(Self, Args : PPyObject): PPyObject; cdecl; +var + R,G,B: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'iii:meshcolor', @R,@G,@B)) then + MESHCOLOR(R,G,B); +end; + +function PyATLASMAXINDEX(Self, Args : PPyObject): PPyObject; cdecl; +var + i: integer; +begin + Result:= GetPythonEngine.PyInt_FromLong(-1); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:atlasmaxindex', @I)) then + Result:= GetPythonEngine.PyInt_FromLong(ATLASMAXINDEX(I)); +end; + +function PyEXISTS(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:exists', @PtrName)) then + begin + StrName:= string(PtrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(EXISTS(StrName))); + end; +end; + +function PyAZIMUTH(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:azimuth', @A)) then + AZIMUTH(A); +end; + +function PyAZIMUTHELEVATION(Self, Args : PPyObject): PPyObject; cdecl; +var + A,E: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ii:azimuthelevation', @A, @E)) then + AZIMUTHELEVATION(A,E); +end; + +function PyBMPZOOM(Self, Args : PPyObject): PPyObject; cdecl; +var + Z: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:bmpzoom', @Z)) then + bmpzoom(Z); +end; + +function PyCAMERADISTANCE(Self, Args : PPyObject): PPyObject; cdecl; +var + Z: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'f:cameradistance', @Z)) then + CAMERADISTANCE(Z); +end; + +function PySHADERAMBIENTOCCLUSION(Self, Args : PPyObject): PPyObject; cdecl; +var + Z: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'f:shaderambientocclusion', @Z)) then + SHADERAMBIENTOCCLUSION(Z); +end; + +function PyCLIP(Self, Args : PPyObject): PPyObject; cdecl; +var + D: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'f:clip', @D)) then + CLIP(D); +end; + +function PyCLIPAZIMUTHELEVATION(Self, Args : PPyObject): PPyObject; cdecl; +var + D,A,E: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'fff:clipazimuthelevation', @D,@A,@E)) then + CLIPAZIMUTHELEVATION(D,A,E); +end; + +function PyTRACKPREFS(Self, Args : PPyObject): PPyObject; cdecl; +var + D,A,E: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'fff:trackprefs', @D,@A,@E)) then + TRACKPREFS(D,A,E); +end; + +function PyATLASSATURATIONALPHA(Self, Args : PPyObject): PPyObject; cdecl; +var + A,B: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ff:atlassaturationalpha', @A,@B)) then + ATLASSATURATIONALPHA(A,B); +end; + +function PyCAMERAPAN(Self, Args : PPyObject): PPyObject; cdecl; +var + A,B: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ff:camerapan', @A,@B)) then + CAMERAPAN(A,B); +end; + +function PyNODESIZE(Self, Args : PPyObject): PPyObject; cdecl; +var + A: single; + I: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'fi:nodesize', @A,@I)) then + NODESIZE(A,Bool(I)); +end; + +function PyEDGESIZE(Self, Args : PPyObject): PPyObject; cdecl; +var + A: single; + I: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'fi:edgesize', @A,@I)) then + EDGESIZE(A,Bool(I)); +end; + +function PyOVERLAYINVERT(Self, Args : PPyObject): PPyObject; cdecl; +var + B,I: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ii:overlayinvert', @I,@B)) then + OVERLAYINVERT(I,Bool(B)); +end; + +function PyOVERLAYTRANSLUCENT(Self, Args : PPyObject): PPyObject; cdecl; +var + B,I: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ii:overlaytranslucent', @I,@B)) then + OVERLAYTRANSLUCENT(I,Bool(B)); +end; + +function PyEDGETHRESH(Self, Args : PPyObject): PPyObject; cdecl; +var + A,B: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ff:edgethresh', @A,@B)) then + EDGETHRESH(A,B); +end; + +function PySHADERXRAY(Self, Args : PPyObject): PPyObject; cdecl; +var + A,B: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ff:shaderxray', @A,@B)) then + SHADERXRAY(A,B); +end; + +function PyNODETHRESH(Self, Args : PPyObject): PPyObject; cdecl; +var + A,B: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ff:nodethresh', @A,@B)) then + NODETHRESH(A,B); +end; + +function PyCOLORBARPOSITION(Self, Args : PPyObject): PPyObject; cdecl; +var + P: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:colorbarposition', @P)) then + COLORBARPOSITION (P); +end; + +function PyMESHOVERLAYORDER(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:meshoverlayorder', @A)) then + MESHOVERLAYORDER(BOOL(A)); +end; + +function PyORIENTCUBEVISIBLE(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:orientcubevisible', @A)) then + ORIENTCUBEVISIBLE(BOOL(A)); +end; + +function PyOVERLAYADDITIVE(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:overlayadditive', @A)) then + OVERLAYADDITIVE(BOOL(A)); +end; + +function PyOVERLAYSMOOTHVOXELWISEDATA(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:overlaysmoothvoxelwisedata', @A)) then + OVERLAYSMOOTHVOXELWISEDATA(BOOL(A)); +end; + +function PySHADERFORBACKGROUNDONLY(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:shaderforbackgroundonly', @A)) then + SHADERFORBACKGROUNDONLY(BOOL(A)); +end; + +function PyNODETHRESHBYSIZENOTCOLOR(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:nodethreshbysizenotcolor', @A)) then + NODETHRESHBYSIZENOTCOLOR(BOOL(A)); +end; + +function PyCOLORBARVISIBLE(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:colorbarvisible', @A)) then + COLORBARVISIBLE(BOOL(A)); +end; + +function PyFONTNAME(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:fontname', @PtrName)) then + begin + StrName:= string(PtrName); + FONTNAME(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyELEVATION(Self, Args : PPyObject): PPyObject; cdecl; +var + E: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:elevation', @E)) then + ELEVATION(E); +end; + +function PyNODEHEMISPHERE(Self, Args : PPyObject): PPyObject; cdecl; +var + E: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:nodehemisphere', @E)) then + NODEHEMISPHERE(E); +end; + +function PyNODEPOLARITY(Self, Args : PPyObject): PPyObject; cdecl; +var + E: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:nodepolarity', @E)) then + NODEPOLARITY(E); +end; + +function PyMESHLOAD(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:meshload', @PtrName)) then + begin + StrName:= string(PtrName); + MESHLOAD(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyTRACKLOAD(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:trackload', @PtrName)) then + begin + StrName:= string(PtrName); + TRACKLOAD(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyMESHSAVE(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:meshsave', @PtrName)) then + begin + StrName:= string(PtrName); + MESHSAVE(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyNODELOAD(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:nodeload', @PtrName)) then + begin + StrName:= string(PtrName); + NODELOAD(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyOVERLAYLOAD(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:overlayload', @PtrName)) then + begin + StrName:= string(PtrName); + OVERLAYLOAD(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyEDGELOAD(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:edgeload', @PtrName)) then + begin + StrName:= string(PtrName); + EDGELOAD(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyMODALMESSAGE(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:modalmessage', @PtrName)) then + begin + StrName:= string(PtrName); + MODALMESSAGE(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyMODELESSMESSAGE(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:modelessmessage', @PtrName)) then + begin + StrName:= string(PtrName); + MODELESSMESSAGE(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyOVERLAYCLOSEALL(Self, Args : PPyObject): PPyObject; cdecl; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(TRUE)); + OVERLAYCLOSEALL; +end; + +function PyQUIT(Self, Args : PPyObject): PPyObject; cdecl; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(TRUE)); + QUIT; +end; + +function PyOVERLAYCOLORNAME(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; + V: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'is:overlaycolorname', @V, @PtrName)) then + begin + StrName:= string(PtrName); + OVERLAYCOLORNAME(V, StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PySHADERNAME(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; + V: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:shadername', @PtrName)) then + begin + StrName:= string(PtrName); + SHADERNAME(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PySHADERADJUST(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; + f: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'sf:shaderadjust', @PtrName, @f)) then + begin + StrName:= string(PtrName); + SHADERADJUST(StrName, f); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyEDGECOLOR(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; + i: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'si:edgecolor', @PtrName, @i)) then + begin + StrName:= string(PtrName); + EDGECOLOR(StrName, bool(i)); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyNODECOLOR(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; + i: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'si:nodecolor', @PtrName, @i)) then + begin + StrName:= string(PtrName); + NODECOLOR(StrName, bool(i)); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyMESHCREATE(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName,PtrName2: PChar; + StrName,StrName2: string; + f,f2: single; + i,i2: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ssffii:meshcreate', @PtrName, @PtrName2, @f, @f2, @i, @i2)) then + begin + StrName:= string(PtrName); + StrName2:= string(PtrName2); + MESHCREATE(StrName, StrName2, f, f2, i, i2); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PySCRIPTFORMVISIBLE(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:scriptformvisible', @A)) then + SCRIPTFORMVISIBLE(BOOL(A)); +end; + +function PyVIEWAXIAL(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:viewaxial', @A)) then + VIEWAXIAL(BOOL(A)); +end; + +function PyVIEWCORONAL(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:viewcoronal', @A)) then + VIEWCORONAL(BOOL(A)); +end; + +function PyOVERLAYTRANSPARENCYONBACKGROUND(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:overlaytransparencyonbackground', @A)) then + OVERLAYTRANSPARENCYONBACKGROUND(A); +end; + +function PyWAIT(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:wait', @A)) then + WAIT(A); +end; + +function PySHADERLIGHTAZIMUTHELEVATION(Self, Args : PPyObject): PPyObject; cdecl; +var + A,B: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ii:shaderlightazimuthelevation', @A, @B)) then + SHADERLIGHTAZIMUTHELEVATION(A,B); +end; + +function PyOVERLAYMINMAX(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; + B,C: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'iff:overlayminmax', @A, @B, @C)) then + OVERLAYMINMAX(A,B,C); +end; + +function PyOVERLAYVISIBLE(Self, Args : PPyObject): PPyObject; cdecl; +var + A,B: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ii:overlayvisible', @A, @B)) then + OVERLAYVISIBLE(A,BOOL(B)); +end; + + + +function PyVIEWSAGITTAL(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:viewsagittal', @A)) then + VIEWSAGITTAL(BOOL(A)); +end; + +(*function pyAbort(Self, Args : PPyObject): PPyObject; cdecl; +begin + Result := nil; + Abort; +end;*) + + +procedure TGLForm1.PyModInitialization(Sender: TObject); +begin + with Sender as TPythonModule do begin + //AddMethod('atlasgraybg', @PyATLASGRAYBG, ''); + AddMethod('atlasmaxindex', @PyATLASMAXINDEX, ' atlasmaxindex(overlayNum) -> Returns maximum region humber in specified atlas. For example, if you load the CIT168 atlas (which has 15 regions) as your background image, then atlasmaxindex(0) will return 15.'); + AddMethod('atlassaturationalpha', @PyATLASSATURATIONALPHA, ' atlassaturationalpha(saturation, transparency) -> Set saturation and transparency of atlas. A desaturated atlas will appear gray, a transparent atlas will reveal the background color.'); + AddMethod('azimuth', @PyAZIMUTH, ' azimuthe(azi) -> Rotate image by specified degrees.'); + AddMethod('azimuthelevation', @PyAZIMUTHELEVATION, ' azimuthelevation(azi, elev) -> Sets the camera location.'); + AddMethod('backcolor', @PyBACKCOLOR, ' backcolor(r, g, b) -> changes the background color, for example backcolor(255, 0, 0) will set a bright red background'); + AddMethod('bmpzoom', @PyBMPZOOM, ' bmpzoom(z) -> changes resolution of savebmp(), for example bmpzoom(2) will save bitmaps at twice screen resolution'); + AddMethod('cameradistance', @PyCAMERADISTANCE, ' cameradistance(z) -> Sets the viewing distance from the object.'); + AddMethod('camerapan', @PyCAMERAPAN, ' camerapan(x, y) -> Translate image horizontally (x) and vertically (y). range -1..+1, where 0 is centered.'); + AddMethod('clip', @PyCLIP, ' clip(depth) -> Creates a clip plane that hides information close to the viewer.'); + AddMethod('clipazimuthelevation', @PyCLIPAZIMUTHELEVATION, ' clipazimuthelevation(depth, azi, elev) -> Set a view-point independent clip plane.'); + AddMethod('colorbarposition', @PyCOLORBARPOSITION, ' colorbarposition(p) -> Set colorbar position (1=bottom, 2=left, 3=top, 4=right).'); + AddMethod('colorbarvisible', @PyCOLORBARVISIBLE, ' colorbarvisible(v) -> Show (1) or hide (0) the color bar.'); + AddMethod('edgecolor', @PyEDGECOLOR, ' edgecolor(name, varies) -> Select color scheme for connectome edge map. If varies=1 then edge color depends on strength of connection.'); + AddMethod('edgeload', @PyEDGELOAD, ' edgeload(filename) -> Loads a BrainNet Viewer format Edge file, e.g. connectome map.'); + AddMethod('edgesize', @PyEDGESIZE, ' edgesize (size, varies) -> Set the diameters of the cylinders of the connectome. If varies=1 then edge diameter depends on strength of connection.'); + AddMethod('edgethresh', @PyEDGETHRESH, ' edgethresh (lo, hi) -> Set minimum and maximum values for connectome edge diameters.'); + AddMethod('elevation', @PyELEVATION, ' elevation(degrees) -> Rotates volume rendering relative to camera.'); + AddMethod('exists', @PyEXISTS, ' exists(filename) -> Returns true if filename is found.'); + AddMethod('fontname', @PyFONTNAME, ' fontname(name) -> Set typeface for display.'); + AddMethod('meshcolor', @PyMESHCOLOR, ' meshcolor(r, g, b) -> Set red/green/blue components of main image. Each component is an integer 0..255.'); + AddMethod('meshcreate', @PyMESHCREATE, ' meshcreate(niiname, meshname, threshold, decimateFrac, minimumClusterVox, smoothStyle) -> Convert a NIfTI voxel-based image into a mesh.'); + AddMethod('meshcurv', @PyMESHCURV, ' meshcurv() -> Displays mesh curvature, so crevices appear dark.'); + AddMethod('meshload', @PyMESHLOAD, ' meshload(imageName) -> Close all open images and load new background image.'); + AddMethod('meshoverlayorder', @PyMESHOVERLAYORDER, ' meshoverlayorder (flip) -> If flip=1, the mesh will be drawn after the overlay, and xray sliders will influence overlay not mesh.'); + AddMethod('meshreversefaces', @PyMESHREVERSEFACES, ' meshreversefaces() -> reverse triangle winding to reverse front/back faces.'); + AddMethod('meshsave', @PyMESHSAVE, ' meshsave(filename) -> Saves currently open mesh to disk.'); + AddMethod('modalmessage', @PyMODALMESSAGE, ' modalmessage(msg) -> Shows a modal dialog, script stops until user presses ''OK'' button to dismiss dialog.'); + AddMethod('modelessmessage', @PyMODELESSMESSAGE, ' modelessmessage(msg) -> Prints text in the bottom status region of the scripting window.'); + AddMethod('nodecolor', @PyNODECOLOR, ' nodecolor(name, varies) -> set colorscheme used for nodes. If varies=1, the color of nodes will differ depending on size or intensity.'); + AddMethod('nodehemisphere', @PyNODEHEMISPHERE, ' nodehemisphere (val) -> Set -1 for left hemipshere, 0 for both, 1 for right'); + AddMethod('nodeload', @PyNODELOAD, ' nodeload(filename) -> Loads BrainNet viewer format node file.'); + AddMethod('nodepolarity', @PyNODEPOLARITY, ' nodepolarity(val) -> Set -1 for negative only, 0 for either, 1 for positive only.'); + AddMethod('nodesize', @PyNODESIZE, ' nodesize(size, varies) -> Determine size scaling factor for nodes.'); + AddMethod('nodethresh', @PyNODETHRESH, ' nodethresh(lo, hi) -> Set the minimum and maximum range for nodes.'); + AddMethod('nodethreshbysizenotcolor', @PyNODETHRESHBYSIZENOTCOLOR, ' nodethreshbysizenotcolor(NodeThresholdBySize) -> If true (1) then nodes will be hidden if they are smaller than the provided threshold. If false (0), they will be hidden if their color intensity is below the provided threshold.'); + AddMethod('orientcubevisible', @PyORIENTCUBEVISIBLE, ' orientcubevisible (visible) -> Show (1) or hide (0) cube that indicates object rotation'); + AddMethod('overlayadditive', @PyOVERLAYADDITIVE, ' overlayadditive (add) -> Determines whether overlay colors are combined by adding or mixing the colors. For example, overlap of red and green overlays will appear yellow if additive is true (1)'); + AddMethod('overlaycloseall', @PyOVERLAYCLOSEALL, ' overlaycloseall() -> Close all open overlays.'); + AddMethod('overlaycolorname', @PyOVERLAYCOLORNAME, ' overlaycolorname(overlayLayer, filename) -> Set the colorscheme for the target overlay to a specified name.'); + AddMethod('overlayinvert', @PyOVERLAYINVERT, ' overlayinvert(overlaLayer, invert) -> Toggle whether overlay color scheme is inverted.'); + AddMethod('overlayload', @PyOVERLAYLOAD, ' overlayload(filename) -> Load an image on top of prior images.'); + AddMethod('overlayminmax', @PyOVERLAYMINMAX, ' overlayminmax(layer, min, max) -> Sets the color range for the overlay (layer 0 = background).'); + AddMethod('overlaysmoothvoxelwisedata', @PyOVERLAYSMOOTHVOXELWISEDATA, ' overlaysmoothvoxelwisedata(smooth) -> Determines if overlays are loaded using interpolation (smooth, 1) or nearest neighbor (un-smoothed, 0) interpolation.'); + AddMethod('overlaytranslucent', @PyOVERLAYTRANSLUCENT, ' overlaytranslucent(overlayLayer, translucent) -> This feature allows you to make individual overlays translucent or opaque.'); + AddMethod('overlaytransparencyonbackground', @PyOVERLAYTRANSPARENCYONBACKGROUND, ' overlaytransparencyonbackground(percent) -> Controls the opacity of the overlays on the background.'); + AddMethod('overlayvisible', @PyOVERLAYVISIBLE, ' overlayvisible(overlayLayer, visible) -> This feature allows you to make individual overlays visible or invisible.'); + AddMethod('quit', @PyQUIT, ' quit() -> Terminate the application.'); + AddMethod('resetdefaults', @PyRESETDEFAULTS, ' resetdefaults() -> Revert settings to sensible values.'); + AddMethod('savebmp', @PySAVEBMP, ' savebmp(pngName) -> Save screen display as bitmap. For example "savebmp(''test.png'')"'); + AddMethod('savebmpxy', @PySAVEBMPXY, ' savebmpxy(pngName, x, y) -> Saves the currently viewed image as a PNG bitmap image. Specify the image width (x) and height (y).'); + AddMethod('scriptformvisible', @PySCRIPTFORMVISIBLE, ' scriptformvisible (visible) -> Show (1) or hide (0) the scripting window.'); + AddMethod('shaderadjust', @PySHADERADJUST, ' shaderadjust(sliderName, sliderValue) -> Set level of shader property. Example "gl.shaderadjust(''Diffuse'', 0.6)"'); + AddMethod('shaderambientocclusion', @PySHADERAMBIENTOCCLUSION, ' shaderambientocclusion(amount) -> Specify a value in the range 0..1 to set the strength of the crevice shadows'); + AddMethod('shaderforbackgroundonly', @PySHADERFORBACKGROUNDONLY, ' shaderforbackgroundonly(onlybg) -> If true (1) selected shader only influeces background image, otherwise shader influences background, overlays, tracks and nodes.'); + AddMethod('shaderlightazimuthelevation', @PySHADERLIGHTAZIMUTHELEVATION, ' shaderlightazimuthelevation (azimuth, elevation) -> Changes location of light source.'); + AddMethod('shadername', @PySHADERNAME, ' shadername(name) -> Choose rendering shader function. For example, "shadername(''phong'')" renders using Phong shading.'); + AddMethod('shaderxray', @PySHADERXRAY, ' shaderxray (object, overlay) -> See occluded overlays/tracks/nodes by making either object transparent (0..1) or overlay/tracks/nodes emphasized (0..1)'); + AddMethod('trackload', @PyTRACKLOAD, ' trackload (filename) -> Load fiber steam lines from a file.'); + AddMethod('trackprefs', @PyTRACKPREFS, ' trackprefs(length, width, dither) -> Set the size and properties for streamlines.'); + AddMethod('version', @PyVERSION, ' version() -> Return the version of Surfice.'); + AddMethod('viewaxial', @PyVIEWAXIAL, ' viewaxial(SI) -> Show rendering with camera superior (1) or inferior (0) of volume.'); + AddMethod('viewcoronal', @PyVIEWCORONAL, ' viewcoronal(AP) -> Show rendering with camera posterior (1) or anterior (0) of volume.'); + AddMethod('viewsagittal', @PyVIEWSAGITTAL, ' viewsagittal(LR) -> Show rendering with camera left (1) or right (0) of volume.'); + AddMethod('wait', @PyWAIT, ' wait(ms) -> Pause script for (at least) the desired milliseconds.'); + end; +end; + + +procedure TGLForm1.PyIOSendData(Sender: TObject; + const Data: AnsiString); +begin + ScriptOutputMemo.Lines.Add(Data); +end; + +procedure TGLForm1.PyIOSendUniData(Sender: TObject; + const Data: UnicodeString); +begin + ScriptOutputMemo.Lines.Add(Data); +end; +function TGLForm1.PyCreate: boolean; +//const +// cPyLibraryMac = '/Library/Frameworks/Python.framework/Versions/2.7/lib/libpython2.7.dylib'; +var + S: string; +begin + result := false; + if FileExists(gPrefs.PyLib) then begin + {$IFDEF UNIX}writeln('Using PyLib from preferences "'+gPrefs.PyLib+'"');{$ENDIF} + S := gPrefs.PyLib; + end else + S:= findPythonLib(gPrefs.PyLib); + if (S = '') then exit; + gPrefs.PyLib := S; + result := true; + PythonIO := TPythonInputOutput.Create(GLForm1); + PyMod := TPythonModule.Create(GLForm1); + PyEngine := TPythonEngine.Create(GLForm1); + PyEngine.IO := PythonIO; + PyEngine.PyFlags:=[pfIgnoreEnvironmentFlag]; + PyEngine.UseLastKnownVersion:=false; + PyMod.Engine := PyEngine; + PyMod.ModuleName := 'gl'; + PyMod.OnInitialization:=PyModInitialization; + PythonIO.OnSendData := PyIOSendData; + PythonIO.OnSendUniData:= PyIOSendUniData; + PyEngine.DllPath:= ExtractFileDir(S); + PyEngine.DllName:= ExtractFileName(S); + PyEngine.LoadDll +end; -{$R *.lfm} -{$IFDEF LCLCocoa} -uses - UserNotification, nsappkitext, glcocoanscontext; -{$ENDIF} + +function TGLForm1.PyIsPythonScriptMain(): boolean; +begin + result := ( Pos('import gl', GLForm1.ScriptMemo.Lines.Text) > 0); //any python project must import gl +end; + +function TGLForm1.PyExecMain(): boolean; +begin + result := false; //assume code is not Python + if not (PyIsPythonScriptMain) then exit; + GLForm1.ScriptOutputMemo.lines.Clear; + result := true; + if PyEngine = nil then begin + if not PyCreate then begin //do this the first time + {$IFDEF Windows} + GLForm1.ScriptOutputMemo.lines.Add('Unable to find Python library [place Python .dll and .zip in Script folder]'); + {$ENDIF} + {$IFDEF Unix} + GLForm1.ScriptOutputMemo.lines.Add('Unable to find Python library'); + {$IFDEF Darwin} + GLForm1.ScriptOutputMemo.lines.Add(' For MacOS this is typically in: '+kBasePath+''); + {$ELSE} + GLForm1.ScriptOutputMemo.lines.Add(' run ''find -name "*libpython*"'' to find the library'); + GLForm1.ScriptOutputMemo.lines.Add(' if it does not exist, install it (e.g. ''apt-get install libpython2.7'')'); + {$ENDIF} + GLForm1.ScriptOutputMemo.lines.Add(' if it does exist, set use the Preferences/Advanced to set ''PyLib'''); + {$IFDEF Darwin} + GLForm1.ScriptOutputMemo.lines.Add(' PyLib should be the complete path and filename of libpython*.dylib'); + {$ELSE} + GLForm1.ScriptOutputMemo.lines.Add(' PyLib should be the complete path and filename of libpython*.so'); + {$ENDIF} + GLForm1.ScriptOutputMemo.lines.Add(' This file should be in your LIBDIR, which you can detect by running Python from the terminal:'); + GLForm1.ScriptOutputMemo.lines.Add(' ''import sysconfig; print(sysconfig.get_config_var("LIBDIR"))'''); + {$ENDIF} + result := true; + exit; + + end; + end; + GLForm1.ScriptOutputMemo.lines.Add('Running Python script'); + try + PyEngine.ExecStrings(GLForm1.ScriptMemo.Lines); + except + caption := 'Python Engine Failed'; + end; + GLForm1.ScriptOutputMemo.lines.Add('Python Succesfully Executed'); + result := true; + ToolPanel.refresh; + + ToolPanel.refresh; +end; + + +procedure TGLForm1.CompileMainClick(Sender: TObject); var - gNode: TMesh; - gTrack: TTrack; - gnLUT: integer = 0; - isBusy: boolean = true; - {$IFDEF Darwin}gRetinaScale : single = 1;{$ENDIF} - gDistance : single = 1; - gMouseX : integer = -1; - gMouseY : integer = -1; - GLerror : string = ''; - clipPlane : TPoint4f; //clipping bottom - GLbox: TOpenGLControl; -const - kFname=0; - kLUT=1; - kMin=2; - kMax=3; - kTrackFilter = 'Camino, VTK, MRTrix, Quench, TrakVis, DTIstudio|*.Bfloat;*.Bfloat.gz;*.trk.gz;*.trk;*.tck;*.pdb;*.fib;*.vtk;*.dat|Any file|*.*'; -{$IFDEF LCLCocoa} + i: integer; + compiled: boolean; +begin + {$IFDEF MYPY} + if PyExecMain() then exit; + if (not (AnsiContainsText(GLForm1.ScriptMemo.Lines.Text, 'begin'))) then begin + GLForm1.ScriptOutputMemo.Lines.Clear; + GLForm1.ScriptOutputMemo.Lines.Add('Error: script must contain "import gl" (for Python) or "begin" (for Pascal).'); + exit; + end; + {$ENDIF} + GLForm1.ScriptOutputMemo.Lines.Clear; + PSScript1.Script.Text := GLForm1.ScriptMemo.Lines.Text; + //PSScript1.Script.Text := Memo1.Lines.GetText; //<- this will leak! requires StrDispose + Compiled := PSScript1.Compile; + for i := 0 to PSScript1.CompilerMessageCount -1 do + MyWriteln( PSScript1.CompilerMessages[i].MessageToString); + if Compiled then + MyWriteln('Successfully Compiled Script'); + if Compiled then begin + if PSScript1.Execute then + MyWriteln('Succesfully Executed') + else + MyWriteln('Error while executing script: '+ + PSScript1.ExecErrorToString); + end; + GLForm1.Refresh; + ToolPanel.refresh; +end; + +procedure TGLForm1.ScriptingGenerateTemplateMenu(isPython: boolean); +var + i: integer; + scriptPath, scriptName: string; + scriptNames : TStringList; + newMenu: TMenuItem; + begin + //auto generate template script + scriptPath := ScriptDir; + if not DirectoryExists(scriptPath) then showmessage('Unable to find scripts "'+scriptPath+'"'); + if isPython then + scriptNames := FindAllFiles(scriptPath, '*.py', false) + else + scriptNames := FindAllFiles(scriptPath, '*.gls', false); + //showmessage(inttostr(scriptNames.Count)); + if scriptNames.Count > 0 then begin + scriptNames.Sort; + for i := 0 to (scriptNames.Count-1) do begin + scriptName := ChangeFileExt(ExtractFileName(scriptNames[i]),''); + if (length(scriptName) < 1) or (scriptName[1] = '_') or (scriptName[1] = '.') then + continue; + newMenu := TMenuItem.Create(MainMenu1); + newMenu.Caption := scriptName; + //newMenu.AutoCheck := true; + //newMenu.RadioItem := true; + if isPython then begin + newMenu.OnClick := ScriptingTemplatesMenuClick; + //newMenu.GroupIndex := 132; + ScriptingTemplatesMenu.Add(newMenu) + end else begin + newMenu.OnClick := ScriptingPascalMenuClick; + //newMenu.GroupIndex := 133; + ScriptingPascalMenu.Add(newMenu); + end; + end; + end; + scriptNames.Free; +end; + +procedure TGLForm1.ScriptFormVisible(vis: boolean); +begin + if (vis) and (GLForm1.ScriptPanel.Width < GLForm1.ToolPanel.Constraints.MaxWidth) then + GLForm1.ScriptPanel.Width := GLForm1.ToolPanel.Constraints.MaxWidth + else if (not vis) then + GLForm1.ScriptPanel.width := 0; + //{$IFDEF METALAPI} + //ViewGPU1.Invalidate; + //{$ENDIF} +end; + +procedure TGLForm1.ScriptPanelDblClick(Sender: TObject); +begin + ScriptPanel.Width := 4; +end; + +procedure TGLForm1.ScriptingNewMenuClick(Sender: TObject); +begin + ScriptFormVisible(true); + ScriptMemo.Lines.Clear; + ScriptMemo.Lines.Add('import gl'); + ScriptMemo.Lines.Add('gl.resetdefaults()'); +end; + +procedure TGLForm1.OpenScript(scriptname: string; isShowScriptPanel: boolean = true); +begin + if not fileexists(scriptname) then exit; + if (ScriptPanel.Width < 24) and (isShowScriptPanel) then + ScriptPanel.Width := 240; + ScriptMemo.Lines.LoadFromFile(scriptname); + gPrefs.InitScript:=''; + ScriptingRunMenuClick(nil); +end; + +procedure TGLForm1.ScriptingOpenMenuClick(Sender: TObject); +begin + if not ScriptOpenDialog.execute then exit; + OpenScript(ScriptOpenDialog.Filename); +end; + +procedure TGLForm1.ScriptingTemplatesMenuClick(Sender: TObject); +var + scriptName: string; +begin + //shaderName := ResourceDir+pathdelim+'script' + pathdelim + (Sender as TMenuItem).caption+'.py'; + scriptName := ScriptDir + pathdelim + (Sender as TMenuItem).caption+'.py'; + if not fileexists(scriptName) then + showmessage('Unable to find '+scriptName); + OpenScript(scriptName); +end; + +procedure TGLForm1.ScriptingPascalMenuClick(Sender: TObject); +var + scriptName: string; +begin + //shaderName := ResourceDir+pathdelim+'script' + pathdelim + (Sender as TMenuItem).caption+'.py'; + scriptName := ScriptDir + pathdelim + (Sender as TMenuItem).caption+'.gls'; + if not fileexists(scriptName) then + showmessage('Unable to find '+scriptName); + OpenScript(scriptName); +end; +procedure TGLForm1.ScriptingRunMenuClick(Sender: TObject); +begin + CompileMainClick(Sender);// PyExecMain(); +end; + +procedure TGLForm1.ScriptingSaveMenuClick(Sender: TObject); +begin + SaveScriptDialog.InitialDir:= ScriptDir; + if PyIsPythonScriptMain() then + SaveScriptDialog.DefaultExt := '.py' + else + SaveScriptDialog.DefaultExt := '.gls'; + if PyIsPythonScriptMain() then + SaveScriptDialog.Filter := 'Python script|*.py' + else + SaveScriptDialog.Filter := 'Pascal script|*.gls'; + SaveScriptDialog.FileName := ''; + if not SaveScriptDialog.Execute then + exit; + ScriptMemo.Lines.SaveToFile(SaveScriptDialog.Filename); +end; + +procedure TGLForm1.UpdateLUT(lOverlay,lLUTIndex: integer); +begin + if (gMesh.OpenOverlays > kMaxOverlays) then + exit; + if lLUTIndex >= LayerColorDrop.Items.Count then + gMesh.Overlay[lOverlay].LUTindex:= 0 + else + gMesh.Overlay[lOverlay].LUTindex:= lLUTIndex; + gMesh.overlay[lOverlay].LUT := UpdateTransferFunction (gMesh.Overlay[lOverlay].LUTindex, gMesh.Overlay[lOverlay].LUTinvert); + //LUTdropLoad(gMesh.Overlay[lOverlay].LUTindex, gMesh.Overlay[lOverlay].LUT, LUTdrop.Items[lLUTindex], gOverlayCLUTrec[lOverlay]); +end; + +procedure TGLForm1.LayerInvertColorsMenuClick(Sender: TObject); +var + i: integer; + //s: string; + //mn, mx: single; +begin + i := LayerList.ItemIndex+ 1; + if (i < 1) or (i > gMesh.OpenOverlays) then exit; + OverlayInvert(i, not gMesh.Overlay[i].LUTinvert); + gnLUT := -1; +end; + +procedure TGLForm1.LayerPopupPopup(Sender: TObject); +var + i: integer; +begin + i := LayerList.ItemIndex+ 1; + if (i < 1) or (i > gMesh.OpenOverlays) then exit; + LayerInvertColorsMenu.Checked := gMesh.Overlay[i].LUTinvert; +end; + +procedure TGLForm1.LayerListClickCheck(Sender: TObject); +begin + UpdateLayerBox(false); + if LayerList.Checked[LayerList.ItemIndex] then + LayerAlphaTrack.Position := 100 + else + LayerAlphaTrack.Position := 0; + LayerWidgetChange(sender); +end; + +procedure TGLForm1.LayerShowHeaderMenuClick(Sender: TObject); +var + i: integer; + s: string; +begin + i := LayerList.ItemIndex+ 1; + if (i < 1) or (i > gMesh.OpenOverlays) then exit; + s :=''; + if (gMesh.Overlay[i].atlasMaxIndex > 0) then + s := 'Atlas'; + showmessage(format('%s Layer %d, range %.6g..%.6g, Name: %s', [s, i, gMesh.Overlay[i].minIntensity, gMesh.Overlay[i].maxIntensity, gMesh.Overlay[i].Filename])); +end; + +procedure TGLForm1.LayerWidgetChange(Sender: TObject); +var + i: integer; + //mn,mx: single; + //lutName: string; + //isChange: boolean = false; +begin + i := LayerList.ItemIndex+ 1; + if (i < 1) or (i > gMesh.OpenOverlays) then exit; + gMesh.Overlay[i].WindowScaledMin := strtofloatdef(LayerDarkEdit.Caption, gMesh.Overlay[i].WindowScaledMin); + gMesh.Overlay[i].WindowScaledMax := strtofloatdef(LayerBrightEdit.Caption, gMesh.Overlay[i].WindowScaledMax); + gMesh.Overlay[i].LUTvisible := LayerAlphaTrack.position; + if (gMesh.Overlay[i].LUTindex <> LayerColorDrop.ItemIndex) then begin + //gMesh.Overlay[i].LUTindex := LayerColorDrop.ItemIndex; + //UpdateLUT(intRow,GLForm1.LUTdrop.ItemIndex,true); + UpdateLUT(i, LayerColorDrop.ItemIndex); + + end; + UpdateImageIntensity; + OverlayTimerStart; +end; + +procedure TGLForm1.LayerOptionsBtnClick(Sender: TObject); +begin + LayerPopup.PopUp; + +end; + +(**) +procedure TGLForm1.LayerContrastKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + LayerWidgetChange(Sender); +end; + +procedure TGLForm1.LayerListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateLayerBox(false); +end; + +procedure TGLForm1.LayerListShowHint(Sender: TObject; HintInfo: PHintInfo); +begin + +end; + +procedure TGLForm1.LeftSplitterCanOffset(Sender: TObject; + var NewOffset: Integer; var Accept: Boolean); +begin + //caption := inttostr(random(888)); +end; + +procedure TGLForm1.LeftSplitterCanResize(Sender: TObject; var NewSize: Integer; + var Accept: Boolean); +begin + (*caption := inttostr(random(888)); + ToolPanel.AutoSize := not ToolPanel.AutoSize; + if not ToolPanel.AutoSize then + ToolPanel.Width := 2;*) + //ToolPanel.Visible := not ToolPanel.Visible; +end; + +procedure TGLForm1.LeftSplitterChangeBounds(Sender: TObject); +begin +end; + +procedure TGLForm1.LeftSplitterMoved(Sender: TObject); +begin + + //caption := inttostr(random(888)); +end; + +procedure TGLForm1.LayerAlphaTrackMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + //caption := format('%d %d', [ViewGPU1.width, ViewGPU1.clientWidth]); + LayerWidgetChange(sender); +end; + +procedure TGLForm1.UpdateLayerBox(NewLayers: boolean); +var + i: integer; + s: string; + isAtlas: boolean; +begin + if (NewLayers) then begin + LayerList.Items.Clear; + if gMesh.OpenOverlays < 1 then exit; + for i := 1 to gMesh.OpenOverlays do begin + s := gMesh.Overlay[i].FileName; + LayerList.Items.add(s); + LayerList.Checked[i-1] := true; + end; + LayerList.ItemIndex := gMesh.OpenOverlays - 1; + end; + if (LayerList.ItemIndex < 0) then + LayerList.ItemIndex := LayerList.Items.Count -1; + if (gMesh.OpenOverlays < 1) then exit; + i := LayerList.ItemIndex + 1; + if (i < 1) or (i > gMesh.OpenOverlays) then exit; + isAtlas := (gMesh.Overlay[i].atlasMaxIndex > 0); + LayerDarkEdit.Enabled := not isAtlas; + LayerBrightEdit.Enabled := not isAtlas; + LayerColorDrop.Enabled := not isAtlas; + LayerDarkEdit.Text := format('%.6g', [gMesh.Overlay[i].WindowScaledMin]); + LayerBrightEdit.Text := format('%.6g', [gMesh.Overlay[i].WindowScaledMax]); + LayerColorDrop.ItemIndex := gMesh.Overlay[i].LUTindex; + LayerAlphaTrack.Position := gMesh.Overlay[i].LUTvisible; +end; +{$IFDEF LCLCocoa} procedure TGLForm1.SetDarkMode; begin - setThemeMode(Self.Handle, gPrefs.DarkMode); - if gPrefs.DarkMode then begin - //MosaicText.Color := clGray; - Memo1.Color := clGray; - StringGrid1.Color := clGray; - StringGrid1.AlternateColor:= clGray; - StringGrid1.FixedColor:= clBlack; - end else begin - //MosaicText.Color:= clDefault; + //setThemeMode(Self.Handle, gPrefs.DarkMode); + setThemeMode(Self, gPrefs.DarkMode); + if gPrefs.DarkMode then + Memo1.Color := clGray + else Memo1.Color := Graphics.clDefault; - StringGrid1.Color := Graphics.clWindow; - StringGrid1.AlternateColor:= Graphics.clWindow; - StringGrid1.FixedColor:= Graphics.clBtnFace; - end; + ScriptMemo.Color := Memo1.Color; + ScriptOutputMemo.Color := Memo1.Color; end; procedure TGLForm1.SetRetina; @@ -422,7 +2083,8 @@ procedure SetFormDarkMode(var f: TForm); begin f.PopupMode:= pmAuto; f.HandleNeeded; - setThemeMode(f.Handle, true); + //setThemeMode(f.Handle, true); + setThemeMode(f, true); end; procedure Mouse2Retina(var X,Y: integer); @@ -495,22 +2157,27 @@ function FindFileExt(Filename: string): string; result := ''; //failed! end; -function FindFile(Filename: string): string; +function FindFile(fnm: string): string; var - p,n,x: string; + Filename, p,n,x: string; begin - result := FindFileExt(Filename); - if result <> '' then exit; - FilenameParts (Filename, p,n,x); // if user selects 'jhu' then open 'jhu.mz3' - if x <> '' then exit; - result := FindFileExt(ChangeFileExt(Filename,'.mz3')); - if result <> '' then exit; - result := FindFileExt(ChangeFileExt(Filename,'.gii')); - if result <> '' then exit; - result := FindFileExt(ChangeFileExt(Filename,'.ply')); - if result <> '' then exit; - result := FindFileExt(ChangeFileExt(Filename,'.obj')); - //if result <> '' then exit;*) + Filename := fnm; + {$IFDEF UNIX} + if Filename[1] = '~' then + Filename := ExpandFileName(Filename); + {$ENDIF} + result := FindFileExt(Filename); + if result <> '' then exit; + FilenameParts (Filename, p,n,x); // if user selects 'jhu' then open 'jhu.mz3' + if x <> '' then exit; + result := FindFileExt(ChangeFileExt(Filename,'.mz3')); + if result <> '' then exit; + result := FindFileExt(ChangeFileExt(Filename,'.gii')); + if result <> '' then exit; + result := FindFileExt(ChangeFileExt(Filename,'.ply')); + if result <> '' then exit; + result := FindFileExt(ChangeFileExt(Filename,'.obj')); + //if result <> '' then exit;*) end; procedure TGLForm1.GLInvalidate; @@ -647,6 +2314,8 @@ function meshBackgroundOpen: boolean; procedure TGLForm1.UpdateToolbar; begin + OverlayBox.Visible := (gMesh.OpenOverlays > 0); + //OverlayBox.Top := 0; BackgroundBox.Visible := (length(gNode.nodes) > 0) or (gTrack.n_count > 0) or ((gMesh.OpenOverlays > 0) and (meshBackgroundOpen)); NodeBox.Visible:= (length(gNode.nodes) > 0) ; if (length(gNode.edges) > 0) and (EdgeBox.Visible = false) and (BackgroundBox.Visible) then begin @@ -658,14 +2327,14 @@ procedure TGLForm1.UpdateToolbar; end; EdgeBox.Visible:= (length(gNode.edges) > 0) ; TrackBox.Visible:= (gTrack.n_count > 0); - OverlayBox.Visible := (gMesh.OpenOverlays > 0); MeshColorBox.Visible := (length(gMesh.vertexRGBA) > 0); gnLUT := -1; //refresh colorbar Memo1.Lines.clear; + ToolPanel.Refresh; end; //UpdateToolbar() function TGLForm1.OpenNode(FilenameIn: string): boolean; - var +var FileName, edgename: string; begin result := false; @@ -751,7 +2420,6 @@ function TGLForm1.OpenOverlay(FilenameIn: string): boolean; var Filename: string; begin - //StringGrid1.Col := 3; result := false; Filename := FindFile(FilenameIn); if Filename = '' then exit; @@ -763,11 +2431,9 @@ function TGLForm1.OpenOverlay(FilenameIn: string): boolean; result := true; gPrefs.PrevOverlayname := FileName; OpenDialog.InitialDir:= ExtractFileDir(FileName); - StringGrid1.RowCount := gMesh.OpenOverlays+1; - StringGrid1.Col := kMin; - //Caption := format('%g..%g',[gMesh.overlay[gMesh.OpenOverlays].minIntensity, gMesh.overlay[gMesh.OpenOverlays].maxIntensity]); UpdateToolbar; - UpdateOverlaySpread; + UpdateLayerBox(true); + GLBoxRequestUpdate(nil); end; function TGLForm1.OpenTrack(FilenameIN: string): boolean; @@ -902,9 +2568,7 @@ function TGLForm1.OpenMesh(FilenameIN: string): boolean; result := true; ext := ExtractFileExtGzUpper(Filename); if (ext = '.GLS') then begin - ScriptForm.Show; - if ScriptForm.OpenScript(Filename) then - ScriptForm.Compile1Click(nil); + OpenScript(Filename); exit; end; //ext := UpperCase(ExtractFileExt(Filename)); @@ -945,8 +2609,7 @@ function TGLForm1.OpenMesh(FilenameIN: string): boolean; OpenDialog.InitialDir:= ExtractFileDir(Filename); UpdateToolbar; if gMesh.OpenOverlays > 0 then begin //e.g. MZ3 with both MESH and SCALAR intensity - StringGrid1.RowCount := gMesh.OpenOverlays+1; - UpdateOverlaySpread; + UpdateLayerBox(true); end; AddMRU(Filename); //if gMesh.isFreeSurferMesh then begin @@ -974,11 +2637,13 @@ procedure TGLForm1.CreateMRU; NewItem.Tag := lPos; NewItem.onclick := OpenMRU; //Lazarus NewItem.Visible := false; - {$IFDEF Darwin} - NewItem.ShortCut := ShortCut(Word('1')+ord(lPos-1), [ssMeta]); - {$ELSE} - NewItem.ShortCut := ShortCut(Word('1')+ord(lPos-1), [ssCtrl]); - {$ENDIF} + if lPos < 10 then begin + {$IFDEF Darwin} + NewItem.ShortCut := ShortCut(Word('1')+ord(lPos-1), [ssMeta]); + {$ELSE} + NewItem.ShortCut := ShortCut(Word('1')+ord(lPos-1), [ssCtrl]); + {$ENDIF} + end; FileMenu.Add(NewItem); end;//for each MRU end; @@ -1066,6 +2731,25 @@ procedure TGLForm1.SetOverlayTransparency(Sender: TObject); OverlayTimerStart; end; +(*procedure TGLForm1.SetOverlayTransparency(Sender: TObject); +var + i, n, v: integer; +begin + n := gMesh.OpenOverlays; + if n < 1 then exit; + v := (sender as TMenuItem).tag; + if (v > 95) then + v := kLUTopaque + else if (v > 0) then + v := kLUTtranslucent + else + v := kLUTinvisible; + for i := 1 to n do + gMesh.Overlay[i].LUTvisible := v; + //gMesh.OverlayTransparency := (sender as TMenuItem).tag; + OverlayTimerStart; +end;*) + procedure TGLForm1.ShaderBoxResize(Sender: TObject); const kMinMemoSz= 32; @@ -1280,6 +2964,64 @@ procedure TGLForm1.SaveTrack (var lTrack: TTrack); lTrack.SaveVtk(SaveMeshDialog.Filename); end; +(*86function SimplifyPref(out Tol, minLength: single): boolean; +var + PrefForm: TForm; + OkBtn: TButton; + TolLabel, minLengthLabel: TLabel; + TolEdit, minLengthEdit: TEdit; +begin + Tol := 0.5; + minLength := 10; + PrefForm:=TForm.Create(nil); + PrefForm.SetBounds(100, 100, 520, 112); + PrefForm.Caption:='Track simplification preferences'; + PrefForm.Position := poScreenCenter; + PrefForm.BorderStyle := bsDialog; + //Tolerance + TolLabel:=TLabel.create(PrefForm); + TolLabel.Caption:= 'Tolerance ("1" will allow track to deviate 1mm from original)'; + TolLabel.Left := 8; + TolLabel.Top := 12; + TolLabel.Parent:=PrefForm; + TolEdit:=TEdit.create(PrefForm); + TolEdit.Caption := FloatToStrF(Tol, ffGeneral, 8, 4); + TolEdit.Top := 12; + TolEdit.Width := 92; + TolEdit.Left := PrefForm.Width - TolEdit.Width - 8; + TolEdit.Parent:=PrefForm; + //minLength + minLengthLabel:=TLabel.create(PrefForm); + minLengthLabel.Caption:= 'Enter minimum fiber length'; + minLengthLabel.Left := 8; + minLengthLabel.Top := 42; + minLengthLabel.Parent:=PrefForm; + minLengthEdit:=TEdit.create(PrefForm); + minLengthEdit.Caption := FloatToStr(minLength); + minLengthEdit.Top := 42; + minLengthEdit.Width := 92; + minLengthEdit.Left := PrefForm.Width - minLengthEdit.Width - 8; + minLengthEdit.Parent:=PrefForm; + //OK button + OkBtn:=TButton.create(PrefForm); + OkBtn.Caption:='OK'; + OkBtn.Top := 72; + OkBtn.Width := 128; + OkBtn.Left := PrefForm.Width - OkBtn.Width - 8; + OkBtn.Parent:=PrefForm; + OkBtn.ModalResult:= mrOK; + {$IFNDEF Darwin} + ScaleDPI(PrefForm, 96); + {$ENDIF} + {$IFDEF LCLCocoa} + if gPrefs.DarkMode then SetFormDarkMode(PrefForm); + {$ENDIF} + PrefForm.ShowModal; + Tol := StrToFloatDef(TolEdit.Caption, Tol); + minLength := StrToFloatDef(minLengthEdit.Caption, minLength); + result := PrefForm.ModalResult = mrOK; + FreeAndNil(PrefForm); +end;*) function SimplifyPref(out Tol, minLength: single): boolean; var PrefForm: TForm; @@ -1290,46 +3032,82 @@ function SimplifyPref(out Tol, minLength: single): boolean; Tol := 0.5; minLength := 10; PrefForm:=TForm.Create(nil); - PrefForm.SetBounds(100, 100, 520, 112); + PrefForm.AutoSize := True; + PrefForm.BorderWidth := 8; + //PrefForm.SetBounds(100, 100, 520, 112); PrefForm.Caption:='Track simplification preferences'; PrefForm.Position := poScreenCenter; PrefForm.BorderStyle := bsDialog; //Tolerance TolLabel:=TLabel.create(PrefForm); TolLabel.Caption:= 'Tolerance ("1" will allow track to deviate 1mm from original)'; - TolLabel.Left := 8; - TolLabel.Top := 12; + //TolLabel.Left := 8; + //TolLabel.Top := 12; + TolLabel.AutoSize := true; + TolLabel.AnchorSide[akTop].Side := asrTop; + TolLabel.AnchorSide[akTop].Control := PrefForm; + TolLabel.BorderSpacing.Top := 6; + TolLabel.AnchorSide[akLeft].Side := asrLeft; + TolLabel.AnchorSide[akLeft].Control := PrefForm; + TolLabel.BorderSpacing.Left := 6; TolLabel.Parent:=PrefForm; TolEdit:=TEdit.create(PrefForm); TolEdit.Caption := FloatToStrF(Tol, ffGeneral, 8, 4); - TolEdit.Top := 12; - TolEdit.Width := 92; - TolEdit.Left := PrefForm.Width - TolEdit.Width - 8; + //TolEdit.Top := 12; + //TolEdit.Width := 92; + //TolEdit.Left := PrefForm.Width - TolEdit.Width - 8; + TolEdit.Constraints.MinWidth:= 128; + TolEdit.AutoSize := true; + TolEdit.AnchorSide[akTop].Side := asrTop; + TolEdit.AnchorSide[akTop].Control := PrefForm; + TolEdit.BorderSpacing.Top := 4; + TolEdit.AnchorSide[akLeft].Side := asrRight; + TolEdit.AnchorSide[akLeft].Control := TolLabel; + TolEdit.BorderSpacing.Left := 6; TolEdit.Parent:=PrefForm; //minLength minLengthLabel:=TLabel.create(PrefForm); minLengthLabel.Caption:= 'Enter minimum fiber length'; - minLengthLabel.Left := 8; - minLengthLabel.Top := 42; + //minLengthLabel.Left := 8; + //minLengthLabel.Top := 42; + minLengthLabel.AutoSize := true; + minLengthLabel.AnchorSide[akTop].Side := asrBottom; + minLengthLabel.AnchorSide[akTop].Control := TolEdit; + minLengthLabel.BorderSpacing.Top := 6; + minLengthLabel.AnchorSide[akLeft].Side := asrLeft; + minLengthLabel.AnchorSide[akLeft].Control := PrefForm; + minLengthLabel.BorderSpacing.Left := 6; minLengthLabel.Parent:=PrefForm; minLengthEdit:=TEdit.create(PrefForm); minLengthEdit.Caption := FloatToStr(minLength); - minLengthEdit.Top := 42; - minLengthEdit.Width := 92; - minLengthEdit.Left := PrefForm.Width - minLengthEdit.Width - 8; + //minLengthEdit.Top := 42; + //minLengthEdit.Width := 92; + //minLengthEdit.Left := PrefForm.Width - minLengthEdit.Width - 8; + minLengthEdit.Constraints.MinWidth:= 128; + minLengthEdit.AutoSize := true; + minLengthEdit.AnchorSide[akTop].Side := asrBottom; + minLengthEdit.AnchorSide[akTop].Control := TolEdit; + minLengthEdit.BorderSpacing.Top := 4; + minLengthEdit.AnchorSide[akLeft].Side := asrRight; + minLengthEdit.AnchorSide[akLeft].Control := minLengthLabel; + minLengthEdit.BorderSpacing.Left := 6; minLengthEdit.Parent:=PrefForm; //OK button OkBtn:=TButton.create(PrefForm); OkBtn.Caption:='OK'; - OkBtn.Top := 72; - OkBtn.Width := 128; - OkBtn.Left := PrefForm.Width - OkBtn.Width - 8; + //OkBtn.Top := 72; + //OkBtn.Width := 128; + //OkBtn.Left := PrefForm.Width - OkBtn.Width - 8; + OkBtn.AutoSize := true; + OkBtn.AnchorSide[akTop].Side := asrBottom; + OkBtn.AnchorSide[akTop].Control := minLengthEdit; + OkBtn.BorderSpacing.Top := 6; + OkBtn.AnchorSide[akLeft].Side := asrCenter; + OkBtn.AnchorSide[akLeft].Control := PrefForm; + OkBtn.Constraints.MinWidth:= 64; OkBtn.Parent:=PrefForm; OkBtn.ModalResult:= mrOK; - {$IFNDEF Darwin} - ScaleDPI(PrefForm, 96); - {$ENDIF} - {$IFDEF LCLCocoa} + {$IFDEF LCLCocoa} if gPrefs.DarkMode then SetFormDarkMode(PrefForm); {$ENDIF} PrefForm.ShowModal; @@ -1339,6 +3117,7 @@ function SimplifyPref(out Tol, minLength: single): boolean; FreeAndNil(PrefForm); end; + procedure TGLForm1.SimplifyTracksMenuClick(Sender: TObject); var tol, minLength: single; @@ -1404,7 +3183,7 @@ procedure TGLForm1.ScalarDropChange(Sender: TObject); ELSE RESULT := x END {Defuzz}; *) -function ScalarPref(var min, max: single; var ColorBarPrecedenceTracksNotOverlays: boolean): boolean; +(*86 function ScalarPref(var min, max: single; var ColorBarPrecedenceTracksNotOverlays: boolean): boolean; var PrefForm: TForm; OkBtn: TButton; @@ -1466,8 +3245,120 @@ function ScalarPref(var min, max: single; var ColorBarPrecedenceTracksNotOverla ColorBarPrecedenceTracksNotOverlays := ColorBarCheck.Checked; result := PrefForm.ModalResult = mrOK; FreeAndNil(PrefForm); + end;*) +function ScalarPref(var min, max: single; var ColorBarPrecedenceTracksNotOverlays: boolean): boolean; +var + PrefForm: TForm; + OkBtn: TButton; + minLabel, maxLabel: TLabel; + minEdit, maxEdit: TEdit; + ColorBarCheck: TCheckBox; +begin + PrefForm:=TForm.Create(nil); + //PrefForm.SetBounds(100, 100, 520, 142); + PrefForm.AutoSize := True; + PrefForm.BorderWidth := 8; + PrefForm.Caption:='Track simplification preferences'; + PrefForm.Position := poScreenCenter; + PrefForm.BorderStyle := bsDialog; + //Tolerance + minLabel:=TLabel.create(PrefForm); + minLabel.Caption:= 'Minimum intensity'; + //minLabel.Left := 8; + //minLabel.Top := 12; + minLabel.AutoSize := true; + minLabel.AnchorSide[akTop].Side := asrTop; + minLabel.AnchorSide[akTop].Control := PrefForm; + minLabel.BorderSpacing.Top := 6; + minLabel.AnchorSide[akLeft].Side := asrLeft; + minLabel.AnchorSide[akLeft].Control := PrefForm; + minLabel.BorderSpacing.Left := 6; + minLabel.Parent:=PrefForm; + minEdit:=TEdit.create(PrefForm); + minEdit.Caption := FloatToStrF(min, ffGeneral, 8, 4); + //minEdit.Top := 12; + //minEdit.Width := 92; + minEdit.Constraints.MinWidth:= 128; + minEdit.AutoSize := true; + minEdit.AnchorSide[akTop].Side := asrTop; + minEdit.AnchorSide[akTop].Control := PrefForm; + minEdit.BorderSpacing.Top := 4; + minEdit.AnchorSide[akLeft].Side := asrRight; + minEdit.AnchorSide[akLeft].Control := minLabel; + minEdit.BorderSpacing.Left := 6; + minEdit.Left := PrefForm.Width - minEdit.Width - 8; + minEdit.Parent:=PrefForm; + //minLength + maxLabel:=TLabel.create(PrefForm); + maxLabel.Caption:= 'Maximum intensity'; + //maxLabel.Left := 8; + //maxLabel.Top := 42; + maxLabel.AutoSize := true; + maxLabel.AnchorSide[akTop].Side := asrBottom; + maxLabel.AnchorSide[akTop].Control := minEdit; + maxLabel.BorderSpacing.Top := 6; + maxLabel.AnchorSide[akLeft].Side := asrLeft; + maxLabel.AnchorSide[akLeft].Control := PrefForm; + maxLabel.BorderSpacing.Left := 6; + + maxLabel.Parent:=PrefForm; + maxEdit:=TEdit.create(PrefForm); + maxEdit.Caption := FloatToStrF(max, ffGeneral, 8, 4); + //maxEdit.Top := 42; + //maxEdit.Width := 92; + //maxEdit.Left := PrefForm.Width - maxEdit.Width - 8; + maxEdit.Constraints.MinWidth:= 128; + maxEdit.AutoSize := true; + maxEdit.AnchorSide[akTop].Side := asrBottom; + maxEdit.AnchorSide[akTop].Control := minEdit; + maxEdit.BorderSpacing.Top := 4; + maxEdit.AnchorSide[akLeft].Side := asrRight; + maxEdit.AnchorSide[akLeft].Control := maxLabel; + maxEdit.BorderSpacing.Left := 6; + maxEdit.Parent:=PrefForm; + //Precedence ColorBarPrecedenceTracksNotOverlays + ColorBarCheck:=TCheckBox.create(PrefForm); + ColorBarCheck.Checked := ColorBarPrecedenceTracksNotOverlays; + ColorBarCheck.Caption:='Colorbar for tracks, even if overlay loaded'; + //ColorBarCheck.Left := 8; + //ColorBarCheck.Top := 72; + ColorBarCheck.AutoSize := true; + ColorBarCheck.AnchorSide[akTop].Side := asrBottom; + ColorBarCheck.AnchorSide[akTop].Control := maxEdit; + ColorBarCheck.BorderSpacing.Top := 6; + ColorBarCheck.AnchorSide[akLeft].Side := asrLeft; + ColorBarCheck.AnchorSide[akLeft].Control := PrefForm; + ColorBarCheck.BorderSpacing.Left := 6; + + ColorBarCheck.Parent:=PrefForm; + //OK button + OkBtn:=TButton.create(PrefForm); + OkBtn.Caption:='OK'; + //OkBtn.Top := 102; + //OkBtn.Width := 128; + //OkBtn.Left := PrefForm.Width - OkBtn.Width - 8; + OkBtn.AutoSize := true; + OkBtn.AnchorSide[akTop].Side := asrBottom; + OkBtn.AnchorSide[akTop].Control := ColorBarCheck; + OkBtn.BorderSpacing.Top := 6; + OkBtn.AnchorSide[akLeft].Side := asrCenter; + OkBtn.AnchorSide[akLeft].Control := PrefForm; + OkBtn.Constraints.MinWidth:= 64; + + OkBtn.Parent:=PrefForm; + OkBtn.ModalResult:= mrOK; + {$IFDEF LCLCocoa} + if gPrefs.DarkMode then SetFormDarkMode(PrefForm); + {$ENDIF} + PrefForm.ShowModal; + min := StrToFloatDef(minEdit.Caption, min); + max := StrToFloatDef(maxEdit.Caption, max); + ColorBarPrecedenceTracksNotOverlays := ColorBarCheck.Checked; + result := PrefForm.ModalResult = mrOK; + FreeAndNil(PrefForm); end; + procedure TGLForm1.TrackScalarRangeBtnClick(Sender: TObject); begin if (gTrack.scalarSelected < 0) or (gTrack.scalarSelected >= length(gTrack.scalars)) then exit; @@ -1492,55 +3383,6 @@ procedure TGLForm1.SurfaceAppearanceChange(Sender: TObject); end; -procedure TGLForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer; - aRect: TRect; aState: TGridDrawState); -begin - if aRow < 1 then exit; - if (gMesh.Overlay[aRow].LUTinvert) then - TStringGrid(Sender).Canvas.Font.Style:= [fsItalic] - else - TStringGrid(Sender).Canvas.Font.Style:= []; - if (gMesh.Overlay[aRow].LUTvisible = kLUTinvisible) then - TStringGrid(Sender).Canvas.Font.Color := clRed - else if (gMesh.Overlay[aRow].LUTvisible = kLUTtranslucent) then - TStringGrid(Sender).Canvas.Font.Color := clBlue - else begin - {$IFDEF LCLCocoa} - if gPrefs.DarkMode then - TStringGrid(Sender).Canvas.Font.Color := clWhite - else - {$ENDIF} - TStringGrid(Sender).Canvas.Font.Color := clBlack; - end; - (*if (gMesh.Overlay[aRow].LUTvisible <> kLUTinvisible) then begin - if (gMesh.Overlay[aRow].LUTinvert) then begin - TStringGrid(Sender).Canvas.Font.Color := clBlue; - TStringGrid(Sender).Canvas.Font.Style:= [fsItalic]; - TStringGrid(Sender).Canvas.TextOut(aRect.Left+2,aRect.Top+2, TStringGrid(Sender).Cells[ACol, ARow]); - end; - exit; - end; - //make rows of invisible overlays red - TStringGrid(Sender).Canvas.Font.Color := clRed;*) - // TH fixed on Jan 22,2018 - //TStringGrid(Sender).Canvas.TextOut(aRect.Left+2,aRect.Top+2, TStringGrid(Sender).Cells[ACol, ARow]); - //TStringGrid(Sender).Canvas.TextOut(aRect.Left,aRect.Top, TStringGrid(Sender).Cells[ACol, ARow]); - {$IFDEF LCLCocoa} - if gPrefs.DarkMode then - TStringGrid(Sender).Canvas.Brush.Color := clGray - else - {$ENDIF} - TStringGrid(Sender).Canvas.Brush.Color := clWindow; - TStringGrid(Sender).Canvas.FillRect(aRect); - InflateRect(aRect, -2, -2); - TStringGrid(Sender).Canvas.TextRect(aRect,aRect.Left,aRect.Top, stringgrid1.Cells[aCol,aRow]); -end; - -procedure TGLForm1.StringGrid1Exit(Sender: TObject); -begin - //ReadCell(gPrevCol,gPrevRow, true); -end; - function IsDigit (letter : char) : boolean; begin result := ((letter <= '9') and (letter >= '0')); @@ -1563,104 +3405,6 @@ function HasDigit (var lS: string): boolean; end; end; -procedure TGLForm1.StringGrid1Enter(Sender: TObject); -//var -// ACol, ARow: integer; -begin - //ACol := abs(GLForm1.StringGrid1.Selection.Right); - //ARow := abs(GLForm1.StringGrid1.Selection.Top); - //StringGrid1.Cells[ACol,ARow] := ''; -end; - -procedure TGLForm1.StringGrid1EditingDone(Sender: TObject); -var - lIndex: integer; -begin - for lIndex := 1 to gMesh.OpenOverlays do begin - gMesh.Overlay[lIndex].WindowScaledMin := strtofloatDef(StringGrid1.Cells[kMin,lIndex], gMesh.Overlay[lIndex].WindowScaledMin); - gMesh.Overlay[lIndex].WindowScaledMax := strtofloatDef(StringGrid1.Cells[kMax,lIndex], gMesh.Overlay[lIndex].WindowScaledMax); - - //StringGrid1.Cells[kMin,lIndex] := FloatToStrF(gMesh.Overlay[lIndex].WindowScaledMin, ffGeneral, 8, 4); - //StringGrid1.Cells[kMax,lIndex] := FloatToStrF(gMesh.Overlay[lIndex].WindowScaledMax, ffGeneral, 8, 4); - end; - UpdateImageIntensity; - OverlayTimerStart; -end; - -procedure TGLForm1.StringGrid1KeyPress(Sender: TObject; var Key: char); -begin -(*const - EnterKey = #13; - BackspaceKey = #8; - ControlC = #3; // Copy - ControlV = #22; // Paste -var - ACol,ARow: integer; - S: string; -begin -ACol := abs(GLForm1.StringGrid1.Selection.Right); - ARow := abs(GLForm1.StringGrid1.Selection.Top); - //if ((ACol <> gPrevCol) or (ACol <> gPrevCol)) and ChangeOverlayUpdate; - gPrevCol := ACol; - gPrevRow := ARow; - if (not (IsDigit (Key) or (Key = DefaultFormatSettings.DecimalSeparator) or (Key = '+') or (Key = '-') or - (Key = ControlC) or (Key = ControlV) or (Key = BackspaceKey) or - (Key = EnterKey))) then begin - Key := #0; - exit; - end; - if (Key = kTab) then begin - OverlayTimerStart; - exit; - end; - if (Key = kTab) or (Key = kCR) then begin - ReadCell(gPrevCol,gPrevRow, true); - OverlayTimerStart; - exit; - end; - gTypeInCell := true; - exit;// - - OverlayTimerStart; - if(( GLForm1.StringGrid1.Selection.Top = GLForm1.StringGrid1.Selection.Bottom ) and - ( GLForm1.StringGrid1.Selection.Left = GLForm1.StringGrid1.Selection.Right )) then begin - if gEnterCell then - S := '' - else - S := GLForm1.StringGrid1.Cells[ GLForm1.StringGrid1.Selection.Left,GLForm1.StringGrid1.Selection.Top ] ; - gEnterCell := false; - if ( ( Key = kDEL ) or ( Key = kBS ) )then begin - if( length( S ) > 0 ) then begin - setlength( S, length( S ) - 1 ) ; - end; - end else - S := S + Key ; - {$IFDEF FPC} GLForm1.StringGrid1.Cells[ GLForm1.StringGrid1.Selection.Left,GLForm1.StringGrid1.Selection.Top ] := S; - {$ENDIF} - end ; - ReadCell(gPrevCol,gPrevRow, false); *) -end; - -procedure TGLForm1.UpdateOverlaySpread;// (lIndex: integer); -var - lIndex: integer; -begin - GLForm1.LUTdrop.visible := false; - if gMesh.OpenOverlays < 1 then exit; - for lIndex := 1 to gMesh.OpenOverlays do begin - GLForm1.StringGrid1.Cells[kFName, lIndex] := gMesh.Overlay[lIndex].FileName; - GLForm1.StringGrid1.Cells[kLUT, lIndex] := GLForm1.LutDrop.Items[gMesh.Overlay[lIndex].LUTindex]; - if (gMesh.Overlay[lIndex].atlasMaxIndex > 0) then - GLForm1.StringGrid1.Cells[kLUT, lIndex] := 'Atlas'; - //caption := inttostr(gMesh.OpenOverlays); - //OverlayBox.Height := 2+ ( (1+gMesh.OpenOverlays)*(StringGrid1.RowHeights[1]+1)); - OverlayBox.Height := 2+ ( (2+gMesh.OpenOverlays)*(StringGrid1.DefaultRowHeight+1)); - StringGrid1.Cells[kMin,lIndex] := float2str(gMesh.Overlay[lIndex].WindowScaledMin,3);//FloatToStrF(gMesh.Overlay[lIndex].WindowScaledMin, ffGeneral, 8, 4); - StringGrid1.Cells[kMax,lIndex] := float2str(gMesh.Overlay[lIndex].WindowScaledMax,3);//FloatToStrF(gMesh.Overlay[lIndex].WindowScaledMax, ffGeneral, 8, 4); - end; - UpdateImageIntensity; -end; - procedure TGLForm1.OverlayVisible(lOverlay: integer; lVisible: integer); begin if (lOverlay > gMesh.OpenOverlays) or (lOverlay < 1) then @@ -1669,7 +3413,7 @@ procedure TGLForm1.OverlayVisible(lOverlay: integer; lVisible: integer); gMesh.Overlay[lOverlay].LUTvisible := kLUTopaque else gMesh.Overlay[lOverlay].LUTvisible := lVisible; - UpdateOverlaySpread; + UpdateLayerBox(false); end; procedure TGLForm1.OverlayInvert(lOverlay: integer; lInvert: boolean); @@ -1677,7 +3421,7 @@ procedure TGLForm1.OverlayInvert(lOverlay: integer; lInvert: boolean); if (lOverlay > gMesh.OpenOverlays) or (lOverlay < 1) then exit; gMesh.Overlay[lOverlay].LUTinvert := lInvert; - UpdateOverlaySpread; + UpdateLayerBox(false); gMesh.overlay[lOverlay].LUT := UpdateTransferFunction (gMesh.Overlay[lOverlay].LUTindex, gMesh.Overlay[lOverlay].LUTinvert); OverlayTimerStart; end; @@ -1777,7 +3521,7 @@ procedure TGLForm1.CheckForUpdates(Sender: TObject); procedure TGLForm1.PrefMenuClick(Sender: TObject); var PrefForm: TForm; - UpdateBtn, OkBtn, AdvancedBtn: TButton; + OkBtn, AdvancedBtn: TButton; {$IFDEF LCLCocoa} DarkModeCheck, RetinaCheck,{$ENDIF} BlackDefaultBackgroundCheck, BitmapAlphaCheck, SmoothVoxelwiseDataCheck, TracksAreTubesCheck: TCheckBox; bmpEdit: TEdit; @@ -1789,7 +3533,9 @@ procedure TGLForm1.PrefMenuClick(Sender: TObject); isFontChanged, isAdvancedPrefs {$IFDEF LCLCocoa}, isDarkModeChanged, isRetinaChanged {$ENDIF} : boolean; begin PrefForm:=TForm.Create(nil); - PrefForm.SetBounds(100, 100, 520, 422); + //PrefForm.SetBounds(100, 100, 520, 422); + PrefForm.AutoSize := True; + PrefForm.BorderWidth := 8; PrefForm.Caption:='Preferences'; PrefForm.Position := poScreenCenter; PrefForm.BorderStyle := bsDialog; @@ -1797,22 +3543,43 @@ procedure TGLForm1.PrefMenuClick(Sender: TObject); BitmapAlphaCheck:=TCheckBox.create(PrefForm); BitmapAlphaCheck.Checked := gPrefs.ScreenCaptureTransparentBackground; BitmapAlphaCheck.Caption:='Background transparent in bitmaps'; - BitmapAlphaCheck.Left := 8; - BitmapAlphaCheck.Top := 8; + //BitmapAlphaCheck.Left := 8; + //BitmapAlphaCheck.Top := 8; + BitmapAlphaCheck.AutoSize := true; + BitmapAlphaCheck.AnchorSide[akTop].Side := asrTop; + BitmapAlphaCheck.AnchorSide[akTop].Control := PrefForm; + BitmapAlphaCheck.BorderSpacing.Top := 6; + BitmapAlphaCheck.AnchorSide[akLeft].Side := asrLeft; + BitmapAlphaCheck.AnchorSide[akLeft].Control := PrefForm; + BitmapAlphaCheck.BorderSpacing.Left := 6; BitmapAlphaCheck.Parent:=PrefForm; //SmoothVoxelwiseData SmoothVoxelwiseDataCheck:=TCheckBox.create(PrefForm); SmoothVoxelwiseDataCheck.Checked := gPrefs.SmoothVoxelwiseData; SmoothVoxelwiseDataCheck.Caption:='Smooth voxel-based images'; - SmoothVoxelwiseDataCheck.Left := 8; - SmoothVoxelwiseDataCheck.Top := 38; + //SmoothVoxelwiseDataCheck.Left := 8; + //SmoothVoxelwiseDataCheck.Top := 38; + SmoothVoxelwiseDataCheck.AutoSize := true; + SmoothVoxelwiseDataCheck.AnchorSide[akTop].Side := asrBottom; + SmoothVoxelwiseDataCheck.AnchorSide[akTop].Control := BitmapAlphaCheck; + SmoothVoxelwiseDataCheck.BorderSpacing.Top := 6; + SmoothVoxelwiseDataCheck.AnchorSide[akLeft].Side := asrLeft; + SmoothVoxelwiseDataCheck.AnchorSide[akLeft].Control := PrefForm; + SmoothVoxelwiseDataCheck.BorderSpacing.Left := 6; SmoothVoxelwiseDataCheck.Parent:=PrefForm; //TracksAreTubes TracksAreTubesCheck:=TCheckBox.create(PrefForm); TracksAreTubesCheck.Checked := gPrefs.TracksAreTubes; TracksAreTubesCheck.Caption:='Better (but slower) tracks'; - TracksAreTubesCheck.Left := 8; - TracksAreTubesCheck.Top := 68; + //TracksAreTubesCheck.Left := 8; + //TracksAreTubesCheck.Top := 68; + TracksAreTubesCheck.AutoSize := true; + TracksAreTubesCheck.AnchorSide[akTop].Side := asrBottom; + TracksAreTubesCheck.AnchorSide[akTop].Control := SmoothVoxelwiseDataCheck; + TracksAreTubesCheck.BorderSpacing.Top := 6; + TracksAreTubesCheck.AnchorSide[akLeft].Side := asrLeft; + TracksAreTubesCheck.AnchorSide[akLeft].Control := PrefForm; + TracksAreTubesCheck.BorderSpacing.Left := 6; TracksAreTubesCheck.Parent:=PrefForm; //ShaderForBackgroundOnly (*ShaderForBackgroundOnlyCombo := TComboBox.create(PrefForm); @@ -1835,10 +3602,18 @@ procedure TGLForm1.PrefMenuClick(Sender: TObject); ZDimIsUpCombo.ItemIndex := 0 else ZDimIsUpCombo.ItemIndex := 1; - ZDimIsUpCombo.Left := 8; - ZDimIsUpCombo.Top := 128; - ZDimIsUpCombo.Width := PrefForm.Width -16; + //ZDimIsUpCombo.Left := 8; + //ZDimIsUpCombo.Top := 128; + //ZDimIsUpCombo.Width := PrefForm.Width -16; ZDimIsUpCombo.Style := csDropDownList; + ZDimIsUpCombo.Constraints.MinWidth:= 320; + ZDimIsUpCombo.AutoSize := true; + ZDimIsUpCombo.AnchorSide[akTop].Side := asrBottom; + ZDimIsUpCombo.AnchorSide[akTop].Control := TracksAreTubesCheck; + ZDimIsUpCombo.BorderSpacing.Top := 6; + ZDimIsUpCombo.AnchorSide[akLeft].Side := asrLeft; + ZDimIsUpCombo.AnchorSide[akLeft].Control := PrefForm; + ZDimIsUpCombo.BorderSpacing.Left := 6; ZDimIsUpCombo.Parent:=PrefForm; //SinglePass (*MultiPassRenderingCheck:=TCheckBox.create(PrefForm); @@ -1852,44 +3627,78 @@ procedure TGLForm1.PrefMenuClick(Sender: TObject); if (Quality = kRenderBetter) and (gPrefs.OcclusionAmount > 0) then Quality := Quality + 1; //0=Poor, 1=Better, 2=Better+Occlusion QualityCombo:=TComboBox.create(PrefForm); - QualityCombo.Left := 8; - QualityCombo.Top := 158; - QualityCombo.Width := PrefForm.Width -16; + //QualityCombo.Left := 8; + //QualityCombo.Top := 158; + //QualityCombo.Width := PrefForm.Width -16; QualityCombo.Items.Add('Quality: Poor (old hardware)'); QualityCombo.Items.Add('Quality: Fair (no ambient occlusion by default)'); QualityCombo.Items.Add('Quality: Better'); //QualityCombo.Items.Add('Quality: Best'); QualityCombo.ItemIndex:= Quality; QualityCombo.Style := csDropDownList; + QualityCombo.Constraints.MinWidth:= 320; + QualityCombo.AutoSize := true; + QualityCombo.AnchorSide[akTop].Side := asrBottom; + QualityCombo.AnchorSide[akTop].Control := ZDimIsUpCombo; + QualityCombo.BorderSpacing.Top := 6; + QualityCombo.AnchorSide[akLeft].Side := asrLeft; + QualityCombo.AnchorSide[akLeft].Control := PrefForm; + QualityCombo.BorderSpacing.Left := 6; QualityCombo.Parent:=PrefForm; + //gPrefs.SupportBetterRenderQuality := true; if not gPrefs.SupportBetterRenderQuality then begin QualityCombo.Visible := false; QualityLabel:=TLabel.create(PrefForm); - QualityLabel.Left := 8; - QualityLabel.Top := 158; - QualityLabel.Width := PrefForm.Width -16; + //QualityLabel.Left := 8; + //QualityLabel.Top := 158; + //QualityLabel.Width := PrefForm.Width -16; + QualityLabel.AutoSize := true; + QualityLabel.AnchorSide[akTop].Side := asrBottom; + QualityLabel.AnchorSide[akTop].Control := ZDimIsUpCombo; + QualityLabel.BorderSpacing.Top := 6; + QualityLabel.AnchorSide[akLeft].Side := asrLeft; + QualityLabel.AnchorSide[akLeft].Control := PrefForm; + QualityLabel.BorderSpacing.Left := 6; QualityLabel.Caption := 'NOTE: Hardware only supports poor rendering.'; QualityLabel.Parent:=PrefForm; end; //SingleShader bmpLabel:=TLabel.create(PrefForm); - bmpLabel.Left := 8; - bmpLabel.Top := 188; - bmpLabel.Width := PrefForm.Width - 86; + //bmpLabel.Left := 8; + //bmpLabel.Top := 188; + //bmpLabel.Width := PrefForm.Width - 86; bmpLabel.Caption := 'Bitmap zoom (large values create huge images)'; + bmpLabel.AutoSize := true; + bmpLabel.AnchorSide[akTop].Side := asrBottom; + if not gPrefs.SupportBetterRenderQuality then + bmpLabel.AnchorSide[akTop].Control := QualityLabel + else + bmpLabel.AnchorSide[akTop].Control := QualityCombo; + bmpLabel.BorderSpacing.Top := 6; + bmpLabel.AnchorSide[akLeft].Side := asrLeft; + bmpLabel.AnchorSide[akLeft].Control := PrefForm; + bmpLabel.BorderSpacing.Left := 6; bmpLabel.Parent:=PrefForm; //bmp edit bmpEdit := TEdit.Create(PrefForm); - bmpEdit.Left := PrefForm.Width - 76; - bmpEdit.Top := 188; - bmpEdit.Width := 60; + //bmpEdit.Left := PrefForm.Width - 76; + //bmpEdit.Top := 188; + //bmpEdit.Width := 60; bmpEdit.Text := inttostr(gPrefs.ScreenCaptureZoom); + bmpEdit.Constraints.MinWidth:= 128; + bmpEdit.AutoSize := true; + bmpEdit.AnchorSide[akTop].Side := asrCenter; + bmpEdit.AnchorSide[akTop].Control := bmpLabel; + bmpEdit.BorderSpacing.Top := 4; + bmpEdit.AnchorSide[akLeft].Side := asrRight; + bmpEdit.AnchorSide[akLeft].Control := bmpLabel; + bmpEdit.BorderSpacing.Left := 6; bmpEdit.Parent:=PrefForm; //Select Font FontCombo:=TComboBox.create(PrefForm); - FontCombo.Left := 8; - FontCombo.Top := 218; - FontCombo.Width := PrefForm.Width -16; + //FontCombo.Left := 8; + //FontCombo.Top := 218; + //FontCombo.Width := PrefForm.Width -16; FontCombo.Items.Add('Default Font'); FontCombo.ItemIndex:= 0; if FindFirst(ClutDir+pathdelim+'*.json', faAnyFile, searchRec) = 0 then begin @@ -1904,70 +3713,119 @@ procedure TGLForm1.PrefMenuClick(Sender: TObject); end; //find fonts FindClose(searchRec); FontCombo.Style := csDropDownList; + FontCombo.AutoSize := true; + FontCombo.Constraints.MinWidth:= 320; + FontCombo.AnchorSide[akTop].Side := asrBottom; + FontCombo.AnchorSide[akTop].Control := bmpEdit; + FontCombo.BorderSpacing.Top := 6; + FontCombo.AnchorSide[akLeft].Side := asrLeft; + FontCombo.AnchorSide[akLeft].Control := PrefForm; + FontCombo.BorderSpacing.Left := 6; FontCombo.Parent:=PrefForm; //SaveAsFormatCombo SaveAsFormatCombo:=TComboBox.create(PrefForm); - SaveAsFormatCombo.Left := 8; - SaveAsFormatCombo.Top := 248; - SaveAsFormatCombo.Width := PrefForm.Width -16; + //SaveAsFormatCombo.Left := 8; + //SaveAsFormatCombo.Top := 248; + //SaveAsFormatCombo.Width := PrefForm.Width -16; SaveAsFormatCombo.Items.Add('Save mesh as: OBJ (Widely supported)'); SaveAsFormatCombo.Items.Add('Save mesh as: GIfTI (Neuroimaging)'); SaveAsFormatCombo.Items.Add('MZ3 (Small and fast)'); SaveAsFormatCombo.Items.Add('PLY (Widely supported)'); //QualityCombo.Items.Add('Quality: Best'); SaveAsFormatCombo.ItemIndex:= gPrefs.SaveAsFormat; + SaveAsFormatCombo.Constraints.MinWidth:= 320; SaveAsFormatCombo.Style := csDropDownList; + SaveAsFormatCombo.AutoSize := true; + SaveAsFormatCombo.AnchorSide[akTop].Side := asrBottom; + SaveAsFormatCombo.AnchorSide[akTop].Control := FontCombo; + SaveAsFormatCombo.BorderSpacing.Top := 6; + SaveAsFormatCombo.AnchorSide[akLeft].Side := asrLeft; + SaveAsFormatCombo.AnchorSide[akLeft].Control := PrefForm; + SaveAsFormatCombo.BorderSpacing.Left := 6; SaveAsFormatCombo.Parent:=PrefForm; // BlackDefaultBackgroundCheck:=TCheckBox.create(PrefForm); BlackDefaultBackgroundCheck.Checked := gPrefs.BlackDefaultBackground; BlackDefaultBackgroundCheck.Caption:='Black Default Background'; - BlackDefaultBackgroundCheck.Left := 8; - BlackDefaultBackgroundCheck.Top := 278; + //BlackDefaultBackgroundCheck.Left := 8; + //BlackDefaultBackgroundCheck.Top := 278; + BlackDefaultBackgroundCheck.AutoSize := true; + BlackDefaultBackgroundCheck.AnchorSide[akTop].Side := asrBottom; + BlackDefaultBackgroundCheck.AnchorSide[akTop].Control := SaveAsFormatCombo; + BlackDefaultBackgroundCheck.BorderSpacing.Top := 6; + BlackDefaultBackgroundCheck.AnchorSide[akLeft].Side := asrLeft; + BlackDefaultBackgroundCheck.AnchorSide[akLeft].Control := PrefForm; + BlackDefaultBackgroundCheck.BorderSpacing.Left := 6; + BlackDefaultBackgroundCheck.Parent:=PrefForm; {$IFDEF LCLCocoa} RetinaCheck:=TCheckBox.create(PrefForm); RetinaCheck.Checked := gPrefs.RetinaDisplay; RetinaCheck.Caption:='Retina display (better but slower)'; - RetinaCheck.Left := 8; - RetinaCheck.Top := 308; + //RetinaCheck.Left := 8; + //RetinaCheck.Top := 308; + RetinaCheck.AutoSize := true; + RetinaCheck.AnchorSide[akTop].Side := asrBottom; + RetinaCheck.AnchorSide[akTop].Control := BlackDefaultBackgroundCheck; + RetinaCheck.BorderSpacing.Top := 6; + RetinaCheck.AnchorSide[akLeft].Side := asrLeft; + RetinaCheck.AnchorSide[akLeft].Control := PrefForm; + RetinaCheck.BorderSpacing.Left := 6; RetinaCheck.Parent:=PrefForm; //DarkMode DarkModeCheck:=TCheckBox.create(PrefForm); DarkModeCheck.Checked := gPrefs.DarkMode; DarkModeCheck.Caption:='Dark Mode'; - DarkModeCheck.Left := 8; - DarkModeCheck.Top := 338; + //DarkModeCheck.Left := 8; + //DarkModeCheck.Top := 338; + DarkModeCheck.AutoSize := true; + DarkModeCheck.AnchorSide[akTop].Side := asrBottom; + DarkModeCheck.AnchorSide[akTop].Control := RetinaCheck; + DarkModeCheck.BorderSpacing.Top := 6; + DarkModeCheck.AnchorSide[akLeft].Side := asrLeft; + DarkModeCheck.AnchorSide[akLeft].Control := PrefForm; + DarkModeCheck.BorderSpacing.Left := 6; DarkModeCheck.Parent:=PrefForm; if gPrefs.DarkMode then SetFormDarkMode(PrefForm); {$ENDIF} - //UpdateBtn - {$IFDEF FPC} - (*UpdateBtn:=TButton.create(PrefForm); - UpdateBtn.Caption:='Check for updates'; - UpdateBtn.Left := 28; - UpdateBtn.Width:= 168; - UpdateBtn.Top := 378; - UpdateBtn.Parent:=PrefForm; - UpdateBtn.OnClick:= GLForm1.CheckForUpdates;*) + AdvancedBtn:=TButton.create(PrefForm); + AdvancedBtn.Caption:='Advanced'; + //AdvancedBtn.Left := PrefForm.Width - 256; + //AdvancedBtn.Width:= 100; + //AdvancedBtn.Top := 378; + AdvancedBtn.Constraints.MinWidth:= 128; + AdvancedBtn.AutoSize := true; + AdvancedBtn.AnchorSide[akTop].Side := asrBottom; + {$IFDEF LCLCocoa} + AdvancedBtn.AnchorSide[akTop].Control := DarkModeCheck; + {$ELSE} + AdvancedBtn.AnchorSide[akTop].Control := BlackDefaultBackgroundCheck; {$ENDIF} + AdvancedBtn.BorderSpacing.Top := 4; + AdvancedBtn.AnchorSide[akLeft].Side := asrLeft; + AdvancedBtn.AnchorSide[akLeft].Control := PrefForm; + AdvancedBtn.BorderSpacing.Left := 120; + AdvancedBtn.Parent:=PrefForm; + AdvancedBtn.ModalResult:= mrYesToAll; + //OK button OkBtn:=TButton.create(PrefForm); OkBtn.Caption:='OK'; - OkBtn.Left := PrefForm.Width - 128; - OkBtn.Width:= 100; - OkBtn.Top := 378; + //OkBtn.Left := PrefForm.Width - 128; + //OkBtn.Width:= 100; + //OkBtn.Top := 378; + OkBtn.AutoSize := true; + OkBtn.Constraints.MinWidth:= 128; + OkBtn.AnchorSide[akTop].Side := asrTop; + OkBtn.AnchorSide[akTop].Control := AdvancedBtn; + OkBtn.BorderSpacing.Top := 0; + OkBtn.AnchorSide[akLeft].Side := asrRight; + OkBtn.AnchorSide[akLeft].Control := AdvancedBtn; + OkBtn.BorderSpacing.Left := 60; OkBtn.Parent:=PrefForm; OkBtn.ModalResult:= mrOK; - AdvancedBtn:=TButton.create(PrefForm); - AdvancedBtn.Caption:='Advanced'; - AdvancedBtn.Left := PrefForm.Width - 256; - AdvancedBtn.Width:= 100; - AdvancedBtn.Top := 378; - AdvancedBtn.Parent:=PrefForm; - AdvancedBtn.ModalResult:= mrYesToAll; - {$IFNDEF Darwin} ScaleDPI(PrefForm, 96); {$ENDIF} + PrefForm.ShowModal; if (PrefForm.ModalResult <> mrOK) and (PrefForm.ModalResult <> mrYesToAll) then begin FreeAndNil(PrefForm); @@ -2033,7 +3891,6 @@ procedure TGLForm1.PrefMenuClick(Sender: TObject); if isAdvancedPrefs then Quit2TextEditor; end; // PrefMenuClick() - procedure TGLForm1.QuickColorClick(Sender: TObject); begin case (sender as TMenuItem).tag of @@ -2127,7 +3984,7 @@ procedure TGLForm1.RestrictMenuClick(Sender: TObject); gNode.isRebuildList := true; GLBoxRequestUpdate(Sender); end; - +(*86 function GetFloat(prompt: string; min,def,max: extended): extended; var PrefForm: TForm; @@ -2177,6 +4034,93 @@ function GetFloat(prompt: string; min,def,max: extended): extended; result := max; end; FreeAndNil(PrefForm); +end; //GetFloat()*) + +function GetFloat(prompt: string; min,def,max: double): double; +var + PrefForm: TForm; + CancelBtn,OkBtn: TButton; + promptLabel: TLabel; + valEdit: TEdit; +begin + PrefForm:=TForm.Create(nil); + //PrefForm.SetBounds(100, 100, 512, 212); + PrefForm.AutoSize := True; + PrefForm.BorderWidth := 8; + PrefForm.Caption:='Value required'; + PrefForm.Position := poScreenCenter; + PrefForm.BorderStyle := bsDialog; + //label + promptLabel:=TLabel.create(PrefForm); + promptLabel.Caption:= prompt; + if (min < max) then + promptLabel.Caption:= format('%s (range %0.3g..%0.3g)', [prompt, min, max]); + //promptLabel.Left := 8; + //promptLabel.Top := 12; + promptLabel.AutoSize := true; + promptLabel.AnchorSide[akTop].Side := asrTop; + promptLabel.AnchorSide[akTop].Control := PrefForm; + promptLabel.BorderSpacing.Top := 6; + promptLabel.AnchorSide[akLeft].Side := asrLeft; + promptLabel.AnchorSide[akLeft].Control := PrefForm; + promptLabel.BorderSpacing.Left := 6; + promptLabel.Parent:=PrefForm; + //edit + valEdit:=TEdit.create(PrefForm); + valEdit.Caption := FloatToStrF(def, ffGeneral, 8, 4); + //valEdit.Top := 42; + //valEdit.Width := PrefForm.Width - 16; + valEdit.Constraints.MinWidth:= 300; + valEdit.AutoSize := true; + valEdit.AnchorSide[akTop].Side := asrBottom; + valEdit.AnchorSide[akTop].Control := promptLabel; + valEdit.BorderSpacing.Top := 6; + valEdit.AnchorSide[akLeft].Side := asrLeft; + valEdit.AnchorSide[akLeft].Control := PrefForm; + valEdit.BorderSpacing.Left := 6; + valEdit.Parent:=PrefForm; + //Cancel Btn + CancelBtn:=TButton.create(PrefForm); + CancelBtn.Caption:='Cancel'; + CancelBtn.AutoSize := true; + CancelBtn.AnchorSide[akTop].Side := asrBottom; + CancelBtn.AnchorSide[akTop].Control := valEdit; + CancelBtn.BorderSpacing.Top := 6; + CancelBtn.AnchorSide[akLeft].Side := asrLeft; + CancelBtn.AnchorSide[akLeft].Control := PrefForm; + CancelBtn.BorderSpacing.Left := 200; + CancelBtn.Parent:=PrefForm; + CancelBtn.ModalResult:= mrCancel; + + //OK button + OkBtn:=TButton.create(PrefForm); + OkBtn.Caption:='OK'; + OkBtn.AutoSize := true; + OkBtn.AnchorSide[akTop].Side := asrBottom; + OkBtn.AnchorSide[akTop].Control := valEdit; + OkBtn.BorderSpacing.Top := 6; + OkBtn.AnchorSide[akLeft].Side := asrRight; + OkBtn.AnchorSide[akLeft].Control := CancelBtn; + OkBtn.BorderSpacing.Left := 6; + OkBtn.Parent:=PrefForm; + OkBtn.ModalResult:= mrOK; + //OK button + //86 + //{$IFDEF Windows} ScaleDPI(PrefForm, 96); {$ENDIF} + //{$IFDEF Linux} ScaleDPIX(PrefForm, 96); {$ENDIF} + {$IFDEF LCLCocoa} + if gPrefs.DarkMode then SetFormDarkMode(PrefForm); + {$ENDIF} + PrefForm.ShowModal; + result := def; + if (PrefForm.ModalResult = mrOK) then begin + result := StrToFloatDef(valEdit.Caption, def); + if (min < max) and (result < min) then + result := min; + if (min < max) and (result > max) then + result := max; + end; + FreeAndNil(PrefForm); end; //GetFloat() procedure TGLForm1.SimplifyMeshMenuClick(Sender: TObject); @@ -2218,58 +4162,6 @@ procedure TGLForm1.ReverseFacesMenuClick(Sender: TObject); GLBoxRequestUpdate(Sender); end; -procedure TGLForm1.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); -var - Row, Col: integer; - CanSelect: boolean; -begin - if (gMesh.OpenOverlays < 1) then exit; - Row := GLForm1.StringGrid1.DefaultRowHeight div 2; - Row := round((Y-Row)/GLForm1.StringGrid1.DefaultRowHeight); - if (Row > 0) and (Row <= gMesh.OpenOverlays) then - // TH needs to hide hint here to cells can have their own hints - //StringGrid1.Hint := 'Click on name to hide, control+click to reverse palette for '+GLForm1.StringGrid1.Cells[0, Row] - else begin - //StringGrid1.Hint := 'Click on name to hide, control+click to reverse palette'; - exit; - end; - //StringGrid1.Hint := format('%s %g..%g',[GLForm1.StringGrid1.Cells[0, Row], gMesh.overlay[Row].minIntensity, gMesh.overlay[Row].maxIntensity]); - if (X > (GLForm1.StringGrid1.DefaultColWidth *2)) then - exit; //not one of the first two colums - Col := X div GLForm1.StringGrid1.DefaultColWidth; - If (Col = kLUT) then begin //hide overlay - StringGrid1SelectCell(Sender, Col, Row, CanSelect); - exit; - end; - GLForm1.LUTdrop.visible := false; - if (Row < 1) or (Row > gMesh.OpenOverlays) then exit; - if (ssCtrl in Shift) then begin - (*gMesh.Overlay[Row].LUTreverse := not gMesh.Overlay[Row].LUTreverse; - UpdateOverlaySpread; - gMesh.overlay[Row].LUT := UpdateTransferFunction (gMesh.Overlay[Row].LUTindex, gMesh.Overlay[Row].LUTreverse); - xxx - OverlayTimerStart;*) - OverlayInvert(Row, not gMesh.Overlay[Row].LUTinvert); - exit; - end; - If (Col = kFname) or ((ssRight in Shift) or (ssShift in Shift)) then begin //toggle overlay from opaque, translucent, and invisible - if gMesh.Overlay[Row].LUTvisible = kLUTOpaque then - gMesh.Overlay[Row].LUTvisible := kLUTTranslucent - else if gMesh.Overlay[Row].LUTvisible = kLUTTranslucent then - gMesh.Overlay[Row].LUTvisible := kLUTinvisible - else - gMesh.Overlay[Row].LUTvisible := kLUTOpaque; - OverlayVisible(Row, gMesh.Overlay[Row].LUTvisible ); - OverlayTimerStart; - exit; - end; - - if (gMesh.OpenOverlays < 2) then - exit; //can not shuffle order of a single item! - //DemoteOrder(Row); //TO DO -end; - procedure TGLForm1.UpdateImageIntensity; var i: integer; @@ -2286,41 +4178,6 @@ procedure TGLForm1.UpdateImageIntensity; OverlayTimerStart; end; -procedure TGLForm1.LUTdropChange(Sender: TObject); -var intRow: Integer; -begin - inherited; - if GLForm1.Lutdrop.Tag < 1 then - exit; - //intRow := GLForm1.StringGrid1.Row; - //if intRow < 0 then - intRow := GLForm1.Lutdrop.Tag; - if (intRow < 1) or (intRow > kMaxOverlays) then - exit; - UpdateLUT(intRow,GLForm1.LUTdrop.ItemIndex,true); - OverlayTimerStart; - GLForm1.StringGrid1.Selection:=TGridRect(Rect(-1,-1,-1,-1)); - LutDrop.visible := false; -end; - -procedure TGLForm1.UpdateLUT(lOverlay,lLUTIndex: integer; lChangeDrop: boolean); -begin - if (gMesh.OpenOverlays > kMaxOverlays) then - exit; - if lLUTIndex >= LUTdrop.Items.Count then - gMesh.Overlay[lOverlay].LUTindex:= 0 - else - gMesh.Overlay[lOverlay].LUTindex:= lLUTIndex; - if lChangeDrop then begin - StringGrid1.Cells[kLUT, lOverlay] := LUTdrop.Items[gMesh.Overlay[lOverlay].LUTindex]; - if length(gMesh.Overlay[lOverlay].vertexRGBA) > 0 then - StringGrid1.Cells[kLUT, lOverlay] := 'Atlas'; - //LUTdrop.ItemIndex := gOverlayImg[lOverlay].LUTindex; - end; - gMesh.overlay[lOverlay].LUT := UpdateTransferFunction (gMesh.Overlay[lOverlay].LUTindex, gMesh.Overlay[lOverlay].LUTinvert); - //LUTdropLoad(gMesh.Overlay[lOverlay].LUTindex, gMesh.Overlay[lOverlay].LUT, LUTdrop.Items[lLUTindex], gOverlayCLUTrec[lOverlay]); -end; - procedure TGLForm1.SetColorBarPosition; begin if (gPrefs.ColorBarPosition < 1) or (gPrefs.ColorBarPosition > 4) then gPrefs.ColorBarPosition := 1; @@ -2334,47 +4191,6 @@ procedure TGLForm1.SetColorBarPosition; //gClrbar.isTopOrRight := true; gClrbar.isVertical:=false; end; -procedure TGLForm1.StringGrid1SelectCell(Sender: TObject; aCol, aRow: Integer; - var CanSelect: Boolean); -var R: TRect; -begin - //if (gTypeInCell) then UpdateImageIntensity; - if (ACol < kLUT) or (ACol > kMax) or (ARow < 1) or (ARow > gMesh.OpenOverlays) then - exit; - //ReadCell(gPrevCol,gPrevRow, false); - if (ACol = kLUT) and (ARow <> 0) then begin - //Size and position the combo box to fit the cell - R := StringGrid1.CellRect(ACol, ARow); - R.Left := R.Left + GLForm1.StringGrid1.Left; - R.Right := R.Right + GLForm1.StringGrid1.Left; - R.Top := R.Top + GLForm1.StringGrid1.Top; - R.Bottom := R.Bottom + GLForm1.StringGrid1.Top; - //Show the combobox - with GLForm1.LUTdrop do begin - Left := R.Left + 1; - Top := R.Top + 1; - Width := (R.Right + 1) - R.Left; - Height := (R.Bottom + 1) - R.Top; - {$IFDEF LCLcocoa} - Left := R.Left-1; - Top := R.Top-1; - Width := (R.Right + 3) - R.Left; - Height := (R.Bottom + 3) - R.Top; - {$ENDIF} - Visible := True; - Tag := ARow; - SetFocus; - ItemIndex := Items.IndexOf(GLForm1.StringGrid1.Cells[ACol, ARow]); - exit; - end; - end else begin - GLForm1.LUTdrop.visible := false; - //ReadCell(ACol,ARow, false); - //gEnterCell := true; - end; - CanSelect := True; -end; - procedure TGLForm1.TrackBoxChange(Sender: TObject); begin gTrack.minFiberLength := TrackLengthTrack.position; @@ -2388,36 +4204,12 @@ procedure TGLForm1.TrackBoxChange(Sender: TObject); GLBoxRequestUpdate(Sender); end; -procedure TGLForm1.ReadCell (ACol,ARow: integer; Update: boolean); -var - lF: single; - lS: string; -begin - if (ARow < GLForm1.StringGrid1.FixedRows) or (ARow > kMaxOverlays) or (ARow >= GLForm1.StringGrid1.RowCount) then //2015 - exit; - if (ACol <> kMin) and (ACol <> kMax) then - exit; - lS := StringGrid1.Cells[ACol,ARow]; - if not HasDigit(lS) then - exit; - try - lF := strtofloatDef(lS, 0); - except - exit; - end; {except} - if ACol = kMin then - gMesh.Overlay[ARow].WindowScaledMin := lF - else - gMesh.Overlay[ARow].WindowScaledMax := lF; - if Update then UpdateImageIntensity; -end; - procedure TGLForm1.OVERLAYMINMAX (lOverlay: integer; lMin,lMax: single); begin if (gMesh.OpenOverlays < 1) or (lOverlay > gMesh.OpenOverlays) then exit; gMesh.Overlay[lOverlay].WindowScaledMin := lMin; gMesh.Overlay[lOverlay].WindowScaledMax := lMax; - UpdateOverlaySpread; + UpdateLayerBox(false);; end; function TGLForm1.UpdateClrBar: integer; @@ -2439,8 +4231,7 @@ function TGLForm1.UpdateClrBar: integer; for lI := 1 to gMesh.OpenOverlays do if (length(gMesh.overlay[lI].intensity) > 0) and(gMesh.overlay[lI].LUTvisible <> kLUTinvisible) and (not isFreeSurferLUT(gMesh.overlay[lI].LUTindex)) then begin inc(nLUT); - gClrbar.SetLUT(nLUT, UpdateTransferFunction(gMesh.overlay[lI].LUTindex,false), gMesh.overlay[lI].windowScaledMin,gMesh.overlay[lI].windowScaledMax); - + gClrbar.SetLUT(nLUT, UpdateTransferFunction(gMesh.overlay[lI].LUTindex,gMesh.overlay[lI].LUTinvert), gMesh.overlay[lI].windowScaledMin,gMesh.overlay[lI].windowScaledMax); end; result := nLUT; if (length(gNode.nodes) < 1) then exit; @@ -2455,7 +4246,6 @@ function TGLForm1.UpdateClrBar: integer; if mn <> mx then begin nLUT := nLUT + 1; gClrbar.SetLUT(nLUT, UpdateTransferFunction(gNode.nodePrefs.NodeLUTindex,false), mn,mx); - end; end; //nodes if (gNode.nodePrefs.isEdgeColorVaries) and (gNode.nodePrefs.maxEdge <> gNode.nodePrefs.minEdge) then begin @@ -2476,6 +4266,9 @@ procedure TGLForm1.FormDestroy(Sender: TObject); begin //Showmessage(gPrefs.FontName); //IniFile(false,IniName,gPrefs); + gMesh.Free; + gNode.Free; + gTrack.Free; gCube.Free; gClrBar.Free; end; @@ -2529,16 +4322,7 @@ procedure TGLForm1.ROImeshMenuClick(Sender: TObject); lMesh.SaveOverlay(SaveMeshDialog.Filename, 1); 123: lMesh.Free; - -end; - -procedure TGLForm1.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, - Y: Integer); -var - ACol, ARow : integer; -begin - StringGrid1.MouseToCell(X, Y, ACol, ARow); - StringGrid1.hint := stringgrid1.Cells[0, ARow]; + GLBoxRequestUpdate(nil); end; {$IFDEF COREGL} @@ -3004,12 +4788,6 @@ procedure TGLForm1.AdjustFormPos (var lForm: TForm); end; end; -procedure TGLForm1.ScriptMenuClick(Sender: TObject); -begin - AdjustFormPos(TForm(ScriptForm)); - ScriptForm.Show; - //doScript; -end; procedure TGLForm1.Quit2TextEditor; {$IFDEF UNIX} @@ -3216,7 +4994,7 @@ procedure TGLForm1.AboutMenuClick(Sender: TObject); scale: single; origin: TPoint3f; begin - MeshStr := ''; + MeshStr := ''; if length(gMesh.vertices) > 0 then begin MeshStr := LineEnding + format(' %.4f..%.4f %.4f..%.4f %.4f..%.4f',[gMesh.mnV.X, gMesh.mxV.X, gMesh.mnV.Y, gMesh.mxV.Y, gMesh.mnV.Z, gMesh.mxV.Z]); end; @@ -3374,13 +5152,6 @@ procedure TGLForm1.BackColorMenuClick(Sender: TObject); GLBoxRequestUpdate(Sender); end; -procedure TGLForm1.CollapseToolPanelBtnClick(Sender: TObject); -begin - ToolPanel.Visible := not ToolPanel.Visible; - CollapsedToolPanel.Visible := not CollapsedToolPanel.Visible; - Self.ActiveControl := nil; -end; - procedure TGLForm1.CopyMenuClick(Sender: TObject); var bmp: TBitmap; @@ -3465,22 +5236,15 @@ function TGLForm1.ComboBoxName2Index(var lCombo: TComboBox; lName: string): inte end; procedure TGLForm1.OVERLAYCOLORNAME(lOverlay: integer; lFilename: string); -//var - //lLUTIndex, i: integer; +var + lLUTIndex: integer; //lName, lItem : string; begin if (gMesh.OpenOverlays < 1) or (lOverlay > gMesh.OpenOverlays) then exit; - - (*if GLForm1.LUTdrop.Items.Count < 2 then exit; - lLUTIndex := 0; - lName := uppercase(lFilename); - for i := 0 to (GLForm1.LUTdrop.Items.Count-1) do begin - lItem := uppercase (GLForm1.LUTdrop.Items[i]); - if (lItem = lName) then - lLUTindex := i; - end;//for each shader - UpdateLUT(lOverlay,lLUTIndex,true); *) - UpdateLUT(lOverlay,ComboBoxName2Index(LUTdrop, lFilename),true); + lLUTIndex := ComboBoxName2Index(LayerColorDrop, lFilename); + UpdateLUT(lOverlay,lLUTIndex); + //LayerWidgetChange(nil); + UpdateLayerBox(false); end; procedure TGLForm1.NodePrefChange(Sender: TObject); @@ -3579,55 +5343,43 @@ procedure TGLForm1.OverlayBoxCreate; lSearchRec: TSearchRec; lStr: string; begin - StringGrid1.Selection := TGridRect(Rect(-1, -1, -1, -1)); - StringGrid1.DefaultRowHeight := LUTdrop.Height+1; - //StringGrid1.DefaultColWidth := (StringGrid1.width div 4)-2; - {$IFDEF FPC} {$IFNDEF UNIX} - //StringGrid1.DefaultRowHeight := LUTdrop.height + 1;; - if Screen.PixelsPerInch <> 96 then begin - StringGrid1.DefaultColWidth := round(StringGrid1.width* (Screen.PixelsPerInch/96) * 0.25) - 2; - end; -{$ENDIF}{$ENDIF} -StringGrid1.Cells[kFname, 0] := 'Name'; - StringGrid1.Cells[kLUT, 0] := 'Color'; - StringGrid1.Cells[kMin, 0] := 'Min'; - StringGrid1.Cells[kMax, 0] := 'Max'; - LUTdrop.Items.Clear; - LUTdrop.Items.Add('Grayscale'); - LUTdrop.Items.Add('Red-Yellow'); - LUTdrop.Items.Add('Blue-Green'); - LUTdrop.Items.Add('Red'); - LUTdrop.Items.Add('Green'); - LUTdrop.Items.Add('Blue'); - LUTdrop.Items.Add('Violet [r+b]'); - LUTdrop.Items.Add('Yellow [r+g]'); - LUTdrop.Items.Add('Cyan [g+b]'); - LUTdrop.Items.Add('Hot'); - LUTdrop.Items.Add('Bone'); - LUTdrop.Items.Add('Winter'); - LUTdrop.Items.Add('GE'); - LUTdrop.Items.Add('ACTC'); - LUTdrop.Items.Add('X-Rain'); - LUTdrop.Items.Add('FreeSurfer1'); - LUTdrop.Items.Add('FreeSurfer2'); - LUTdrop.Items.Add('FreeSurfer3'); - LUTdrop.Items.Add('FreeSurfer4'); + LUTdropNode.Items.Clear; + LUTdropNode.Items.Add('Grayscale'); + LUTdropNode.Items.Add('Red-Yellow'); + LUTdropNode.Items.Add('Blue-Green'); + LUTdropNode.Items.Add('Red'); + LUTdropNode.Items.Add('Green'); + LUTdropNode.Items.Add('Blue'); + LUTdropNode.Items.Add('Violet [r+b]'); + LUTdropNode.Items.Add('Yellow [r+g]'); + LUTdropNode.Items.Add('Cyan [g+b]'); + LUTdropNode.Items.Add('Hot'); + LUTdropNode.Items.Add('Bone'); + LUTdropNode.Items.Add('Winter'); + LUTdropNode.Items.Add('GE'); + LUTdropNode.Items.Add('ACTC'); + LUTdropNode.Items.Add('X-Rain'); + LUTdropNode.Items.Add('FreeSurfer1'); + LUTdropNode.Items.Add('FreeSurfer2'); + LUTdropNode.Items.Add('FreeSurfer3'); + LUTdropNode.Items.Add('FreeSurfer4'); if DirectoryExists(ClutDir) then begin if FindFirst(CLUTdir+pathdelim+'*.clut', faAnyFile, lSearchRec) = 0 then repeat lStr := ChangeFileExt (ExtractFileName (lSearchRec.Name), ''); if (length(lStr) > 0) and (lStr[1] <> '.') then - LUTdrop.Items.Add(lStr); + LUTdropNode.Items.Add(lStr); until (FindNext(lSearchRec) <> 0); FindClose(lSearchRec); end; - LUTdropNode.Items := LUTdrop.Items; - LUTdropEdge.Items := LUTdrop.Items; + LUTdropEdge.Items := LUTdropNode.Items; + LayerColorDrop.Items.Clear; + LayerColorDrop.Items := LUTdropNode.Items; LUTdropNode.ItemIndex := 3; LUTdropEdge.ItemIndex := 1; //Copy names for tracks TrackScalarLUTdrop.Items.Clear; - TrackScalarLUTdrop.Items := LUTdrop.Items; + TrackScalarLUTdrop.Items := LUTdropNode.Items; TrackScalarLUTdrop.ItemIndex := 1; //TrackScalarLUTdrop.Items.AddStrings := LUTdrop.Items; end; @@ -3638,12 +5390,13 @@ procedure TGLForm1.OverlayTimerTimer(Sender: TObject); gMesh.isRebuildList:= true; gMesh.isAdditiveOverlay := gPrefs.AdditiveOverlay; {$IFDEF FPC}{$IFDEF Windows} - StringGrid1.Refresh; + //StringGrid1.Refresh; {$ENDIF}{$ENDIF} gnLUT := -1; //refresh colorbar GLbox.Invalidate; end; +{$IFDEF JPG} {$IFDEF FPC} procedure SaveImgAsJPGCore (lImage: TBitmap; lFilename: string); var @@ -3663,6 +5416,7 @@ procedure SaveImgAsJPGCore (lImage: TBitmap; lFilename: string); lImage.SaveToFile(ChangeFileExt(lFilename,'.bmp')); end; {$ENDIF} +{$ENDIF} procedure TGLForm1.SaveBitmap(FilenameIn: string; lX, lY: integer); overload; var bmp: TBitmap; @@ -3702,12 +5456,14 @@ procedure TGLForm1.SaveBitmap(FilenameIn: string; lX, lY: integer); overload; {$ENDIF} GLBox.Invalidate; gPrefs.ScreenCaptureZoom := z; + {$IFDEF JPG} //JPEG ext := upcase(x); if (ext = '.JPEG') or (ext = '.JPG') then begin SaveImgAsJPGCore (bmp, Filename); exit; end; + {$ENDIF} //PNG png := TPortableNetworkGraphic.Create; try @@ -3733,12 +5489,14 @@ procedure TGLForm1.SaveBitmap(FilenameIn: string); overload; if (x = '') then x := '.png'; Filename := p+n+x; bmp := ScreenShot; + {$IFDEF JPG} //JPEG ext := upcase(x); if (ext = '.JPEG') or (ext = '.JPG') then begin SaveImgAsJPGCore (bmp, Filename); exit; end; + {$ENDIF} //PNG png := TPortableNetworkGraphic.Create; try @@ -3931,8 +5689,21 @@ procedure TGLForm1.UpdateTimerTimer(Sender: TObject); begin if isBusy or gMesh.isBusy then exit; //defer Updatetimer.enabled := false; - if ( gPrefs.initScript <> '') then - ScriptForm.OpenStartupScript; + if ( gPrefs.initScript <> '') then begin + if (gPrefs.initScript = ('-')) and FileExists(ParamStr(ParamCount)) then begin + gPrefs.initScript := ParamStr(ParamCount); + if (upcase(ExtractFileExt(gPrefs.initScript)) <> '.PY') and (upcase(ExtractFileExt(gPrefs.initScript )) <> '.TXT') then begin + {$IFDEF UNIX}writeln('Assuming file is image not script (not .py or .txt) '+gPrefs.initScript);{$ENDIF} + gPrefs.initScript := ''; + OpenMesh(ParamStr(ParamCount)); + exit; + end; + end; + OpenScript(gPrefs.initScript); + gPrefs.initScript := ''; + Updatetimer.enabled := true; //On MacOS the panels may need to be re-drawn, force a refresh + end; + ToolPanel.Refresh; GLbox.Invalidate; end; @@ -3956,7 +5727,7 @@ procedure TGLForm1.FormShow(Sender: TObject); MultiPassRenderingToolsUpdate; ShaderDropChange(sender); {$IFDEF LCLCocoa} SetDarkMode; {$ENDIF} - {$IFDEF Windows}UpdateOverlaySpread;{$ENDIF}//July2017 - scripting on High-dpi, reset scaling + //{$IFDEF Windows}UpdateOverlaySpread;{$ENDIF}//July2017 - scripting on High-dpi, reset scaling if (gPrefs.initScript <> '' ) then UpdateTimer.enabled := true; end; @@ -3984,8 +5755,8 @@ procedure TGLForm1.FormCreate(Sender: TObject); inc(i); gPrefs.InitScript := ParamStr(i); end; - end else if fileexists(ParamStr(i)) then //length > 1 char - gPrefs.InitScript := ParamStr(i); + end;// else if fileexists(ParamStr(i)) then //length > 1 char + //gPrefs.InitScript := ParamStr(i); inc(i); end; //for each parameter //launch program @@ -3999,6 +5770,19 @@ procedure TGLForm1.FormCreate(Sender: TObject); if MessageDlg('Use advanced graphics? Press "Yes" for better quality. Press "Cancel" for old hardware.', mtConfirmation, [mbYes, mbCancel], 0) = mrCancel then gPrefs.RenderQuality:= kRenderPoor; end; + //initscript: + if (not forceReset) and (gPrefs.InitScript = '') and (gPrefs.StartupScript) then begin + s := ScriptDir + pathdelim + 'startup.py'; + if (fileexists(s)) then + gPrefs.InitScript := s; + s := ScriptDir + pathdelim + 'startup.gls'; + if (gPrefs.InitScript = '') and (fileexists(s)) then + gPrefs.InitScript := s; + if (gPrefs.InitScript = '') and (fileexists(gPrefs.PrevScriptName[1])) then + gPrefs.InitScript := gPrefs.PrevScriptName[1]; + end; + if (gPrefs.InitScript = '') and (ParamCount >= 1) and (not forceReset) and (fileexists(ParamStr(ParamCount))) then + gPrefs.initScript := '-'; //not sure if the user is passing script or file? OverlayBoxCreate;//after we read defaults {$IFDEF Darwin} Application.OnDropFiles:= AppDropFiles; {$ENDIF} //{$IFDEF Windows} //July 2017 - see overlay box create @@ -4018,7 +5802,7 @@ procedure TGLForm1.FormCreate(Sender: TObject); gTrack.TrackTubeSlices := gPrefs.TrackTubeSlices; gTrack.isTubes := gPrefs.TracksAreTubes; Application.ShowButtonGlyphs:= sbgNever; - GLbox:= TOpenGLControl.Create(GLForm1); + GLbox:= TOpenGLControl.Create(CenterPanel); //GLBox.DepthBits:=16; GLBox.Parent := GLForm1; {$IFDEF COREGL} @@ -4085,15 +5869,21 @@ procedure TGLForm1.FormCreate(Sender: TObject); else gMesh.MakePyramid; end; + ScriptingGenerateTemplateMenu(true); + ScriptingGenerateTemplateMenu(false); + gMesh.isBusy := false; isBusy := false; + {$IFDEF Darwin} //CopyMenu.enabled := false; //https://bugs.freepascal.org/view.php?id=33632 - CurvMenuTemp.ShortCut:= ShortCut(Word('K'), [ssMeta]); ; + ScriptingNewMenu.ShortCut := ShortCut(Word('N'), [ssMeta]); + ScriptingRunMenu.ShortCut := ShortCut(Word('R'), [ssMeta]); + CurvMenuTemp.ShortCut:= ShortCut(Word('K'), [ssMeta]); CloseMenu.ShortCut := ShortCut(Word('W'), [ssMeta]); SwapYZMenu.ShortCut := ShortCut(Word('X'), [ssMeta]); //ScriptMenu.ShortCut := ShortCut(Word('Z'), [ssMeta]); - ScriptMenu.ShortCut := ShortCut(Word('J'), [ssMeta]); + //ScriptMenu.ShortCut := ShortCut(Word('J'), [ssMeta]); OpenMenu.ShortCut := ShortCut(Word('O'), [ssMeta]); SaveMenu.ShortCut := ShortCut(Word('S'), [ssMeta]); diff --git a/mainunit_OLD.pas b/mainunit_OLD.pas new file mode 100755 index 0000000..8443b50 --- /dev/null +++ b/mainunit_OLD.pas @@ -0,0 +1,5837 @@ +unit mainunit; + {$Include opts.inc} //optiosn: DGL, CoreGL or legacy GL +{$mode delphi}{$H+} +{$DEFINE MYPY} +interface +uses + {$IFDEF DGL} dglOpenGL, {$ELSE DGL} {$IFDEF COREGL}glcorearb, {$ELSE} gl, {$ENDIF} {$ENDIF DGL} + fphttpclient, strutils, + {$IFDEF MYPY}PythonEngine, {$ENDIF} + //{$IFDEF SCRIPTING} + //{$ENDIF} + {$IFNDEF UNIX} shellapi, {$ELSE} Process, {$ENDIF} + {$IFDEF COREGL} gl_core_3d, {$ELSE} gl_legacy_3d, {$ENDIF} + uPSComponent,Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, + math, ExtCtrls, OpenGLContext, mesh, LCLintf, ComCtrls, Menus, graphtype, + curv, ClipBrd, shaderui, shaderu, prefs, userdir, LCLtype, Grids, Spin, + Buttons, matmath, colorTable, Track, types, glcube, glclrbar, define_types, + meshify, zstream, gl_core_matrix, meshify_simplify, CheckLst; + +type + { TGLForm1 } + TGLForm1 = class(TForm) +LayerList: TCheckListBox; +LayerDarkLabel: TLabel; +LayerDarkEdit: TEdit; +LayerBrightEdit: TEdit; +LayerBrightLabel: TLabel; +LayerColorDrop: TComboBox; +LayerAlphaLabel: TLabel; +LayerAlphaTrack: TTrackBar; +LayerOptionsBtn: TButton; + LeftSplitter: TSplitter; + CenterPanel: TPanel; + overlayload1: TMenuItem; + overlayvisible1: TMenuItem; + PSScript1: TPSScript; + S3Label: TLabel; + SaveScriptDialog: TSaveDialog; + ScriptingInsertMenu: TMenuItem; +mesh1: TMenuItem; +meshload1: TMenuItem; +meshcolor1: TMenuItem; +meshcurv1: TMenuItem; +meshcreate1: TMenuItem; +meshreversefaces1: TMenuItem; +meshsave1: TMenuItem; +overlays1: TMenuItem; +overlayadditive1: TMenuItem; +overlaycloseall1: TMenuItem; +overlaycolorname1: TMenuItem; +overlayminmax1: TMenuItem; +overlaytransparencyonbackground1: TMenuItem; +overlaycolorfromzero1: TMenuItem; +overlaytranslucent1: TMenuItem; +overlayinvert1: TMenuItem; +overlaysmoothvoxelwisedata1: TMenuItem; +meshoverlayorder1: TMenuItem; +Nodes1: TMenuItem; +edgeload1: TMenuItem; +edgecolor1: TMenuItem; +edgecreate1: TMenuItem; +edgesize1: TMenuItem; +edgethresh1: TMenuItem; +nodeload1: TMenuItem; +nodecolor1: TMenuItem; +nodecreate1: TMenuItem; +nodehemisphere1: TMenuItem; +ndepolarity1: TMenuItem; +nodesize1: TMenuItem; +nodethresh1: TMenuItem; +nodethreshbysizenotcolor1: TMenuItem; +Tracks1: TMenuItem; +trackload1: TMenuItem; +trackprefs1: TMenuItem; +Atlas1: TMenuItem; +atlasgray1: TMenuItem; +atlashide1: TMenuItem; +atlasmaxindex1: TMenuItem; +atlassaturationalpha1: TMenuItem; +atlasstatmap1: TMenuItem; +Dialogs1: TMenuItem; +modalmessage1: TMenuItem; +modelessmessage1: TMenuItem; +Shaders1: TMenuItem; +shaderadjust1: TMenuItem; +shaderambientocclusion1: TMenuItem; +shadername1: TMenuItem; +shaderlightazimuthelevation1: TMenuItem; +shaderxray1: TMenuItem; +MenuItem1: TMenuItem; +Render1: TMenuItem; +azimuth1: TMenuItem; +azimuthelevation1: TMenuItem; +backcolor1: TMenuItem; +cameradistance1: TMenuItem; +camerapan1: TMenuItem; +MenuItem2: TMenuItem; +colorbarvisible1: TMenuItem; +clip1: TMenuItem; +clipazimuthelevation1: TMenuItem; +elevation1: TMenuItem; +orientcubevisible1: TMenuItem; +viewaxial1: TMenuItem; +viewcoronal1: TMenuItem; +viewsagittal1: TMenuItem; +Advanced1: TMenuItem; +bmpzoom1: TMenuItem; +exists1: TMenuItem; +fontname1: TMenuItem; +savebmp1: TMenuItem; +savebmpxy1: TMenuItem; +scriptformvisible1: TMenuItem; +version1: TMenuItem; +quit1: TMenuItem; +Close1: TMenuItem; +resetdefaults1: TMenuItem; +wait1: TMenuItem; + + + ScriptingPascalMenu: TMenuItem; + ScriptPanel: TPanel; + ScriptBox: TGroupBox; + ScriptMemo: TMemo; + ScriptOutputMemo: TMemo; + ScriptSplitter: TSplitter; + RightSplitter: TSplitter; + AOLabel: TLabel; + CurvMenu: TMenuItem; + CurvMenuTemp: TMenuItem; + ShaderForBackgroundOnlyCheck: TCheckBox; + GoldColorMenu: TMenuItem; + ConvertAtlas: TMenuItem; + ColorBarMenu: TMenuItem; + BlackClrbarMenu: TMenuItem; + ColorbarSep: TMenuItem; + meshAlphaTrack: TTrackBar; + MeshBlendTrack: TTrackBar; + BGShader: TLabel; + ROImeshMenu: TMenuItem; + XRayLabel: TLabel; + TransBlackClrbarMenu: TMenuItem; + ColorBarVisibleMenu: TMenuItem; + WhiteClrbarMenu: TMenuItem; + TransWhiteClrBarMenu: TMenuItem; + NewWindow1: TMenuItem; + S1Check: TCheckBox; + S6Label: TLabel; + S6Track: TTrackBar; + S1Label: TLabel; + S7Label: TLabel; + S7Track: TTrackBar; + S2Label: TLabel; + S1Track: TTrackBar; + RestrictSep2Menu: TMenuItem; + RestrictHideNodesWithoutEdges: TMenuItem; + S8Label: TLabel; + S8Track: TTrackBar; + S2Track: TTrackBar; + S9Label: TLabel; + S9Track: TTrackBar; + S4Label: TLabel; + S3Track: TTrackBar; + S5Label: TLabel; + S4Track: TTrackBar; + S10Label: TLabel; + S5Track: TTrackBar; + S10Track: TTrackBar; + TrackScalarRangeBtn: TButton; + HelpMenu: TMenuItem; + DisplaySepMenu: TMenuItem; + AdvancedMenu: TMenuItem; + AdditiveOverlayMenu: TMenuItem; + CenterMeshMenu: TMenuItem; + TrackScalarLUTdrop: TComboBox; + TrackScalarNameDrop: TComboBox; + SimplifyMeshMenu: TMenuItem; + SimplifyTracksMenu: TMenuItem; + TransparencySepMenu: TMenuItem; + ReverseFacesMenu: TMenuItem; + SwapYZMenu: TMenuItem; + SaveMeshMenu: TMenuItem; + VolumeToMeshMenu: TMenuItem; + ResetMenu: TMenuItem; + OrientCubeMenu: TMenuItem; + Pref2Menu: TMenuItem; + About2Menu: TMenuItem; + EdgeSizeVariesCheck: TCheckBox; + FileSepMenu: TMenuItem; + occlusionTrack: TTrackBar; + SaveTracksMenu: TMenuItem; + NodeSizeVariesCheck: TCheckBox; + PrefMenu: TMenuItem; + NodeMaxEdit: TFloatSpinEdit; + NodeMinEdit: TFloatSpinEdit; + NodeThreshLabel: TLabel; + NodeThreshDrop: TComboBox; + EdgeSizeLabel: TLabel; + NodeScaleTrack: TTrackBar; + EdgeMinEdit: TFloatSpinEdit; + EdgeMaxEdit: TFloatSpinEdit; + LUTdropEdge: TComboBox; + EdgeBox: TGroupBox; + EdgeColorVariesCheck: TCheckBox; + NodeScaleLabel: TLabel; + EdgeThreshLabel: TLabel; + edgeScaleTrack: TTrackBar; + RestrictSepMenu: TMenuItem; + RestrictAnyEdgeMenu: TMenuItem; + RestrictPosEdgeMenu: TMenuItem; + RestrictNegEdgeMenu: TMenuItem; + RestrictRightMenu: TMenuItem; + RestrictLeftMenu: TMenuItem; + RestrictNoMenu: TMenuItem; + RestrictMenu: TMenuItem; + NodeColorVariesCheck: TCheckBox; + GrayColorMenu: TMenuItem; + BlueColorMenu: TMenuItem; + GreenColorMenu: TMenuItem; + ExitMenu: TMenuItem; + DisplayMenu: TMenuItem; + AnteriorMenu: TMenuItem; + LeftMenu: TMenuItem; + CloseMenu: TMenuItem; + AddNodesMenu: TMenuItem; + CloseNodesMenu: TMenuItem; + LUTdropNode: TComboBox; + SaveMeshDialog: TSaveDialog; + NodeMenu: TMenuItem; + RightMenu: TMenuItem; + InferiorMenu: TMenuItem; + SuperiorMenu: TMenuItem; + PosteriorMenu: TMenuItem; + RedColorItem: TMenuItem; + QuickColorMenu: TMenuItem; + NodeBox: TGroupBox; + MeshColorBox: TGroupBox; + SatLabel: TLabel; + MeshSaturationTrack: TTrackBar; + TrackWidthLabel: TLabel; + TrackLengthTrack: TTrackBar; + TrackLengthLabel: TLabel; + LightAziTrack: TTrackBar; + ClipAziTrack: TTrackBar; + ClipBox: TGroupBox; + ClipTrack: TTrackBar; + ColorDialog1: TColorDialog; + LightElevTrack: TTrackBar; + ClipElevTrack: TTrackBar; + TrackBox: TGroupBox; + Label2: TLabel; + DepthLabel: TLabel; + AzimuthLabel: TLabel; + ElevationLabel: TLabel; + MainMenu1: TMainMenu; + AppleMenu: TMenuItem; + FileMenu: TMenuItem; + ColorMenu: TMenuItem; + BackColorMenu: TMenuItem; + AboutMenu: TMenuItem; + EditMenu: TMenuItem; + CopyMenu: TMenuItem; + Memo1: TMemo; + AddOverlayMenu: TMenuItem; + CloseOverlaysMenu: TMenuItem; + AddTracksMenu: TMenuItem; + CloseTracksMenu: TMenuItem; + NodeColorLabel: TLabel; + EdgeColorLabel: TLabel; + TransLabel: TLabel; + TrackDitherLabel: TLabel; + TrackWidthTrack: TTrackBar; + TracksMenu: TMenuItem; + MeshTransparencyTrack: TTrackBar; + TrackDitherTrack: TTrackBar; + Transparency75: TMenuItem; + Transparency25: TMenuItem; + Transparency50: TMenuItem; + Transparency0: TMenuItem; + TransparencyMenu: TMenuItem; + OverlaysMenu: TMenuItem; + OpenDialog: TOpenDialog; + OverlayBox: TGroupBox; + ShaderBox: TGroupBox; + ShaderDrop: TComboBox; + ErrorTimer: TTimer; + OverlayTimer: TTimer; + UpdateTimer: TTimer; + ToolPanel: TScrollBox; + SaveBitmapDialog: TSaveDialog; + SaveMenu: TMenuItem; + ObjectColorMenu: TMenuItem; + OpenMenu: TMenuItem; + BackgroundBox: TGroupBox; + ScriptingMenu: TMenuItem; + ScriptingNewMenu: TMenuItem; + ScriptingOpenMenu: TMenuItem; + ScriptingTemplatesMenu: TMenuItem; + ScriptingRunMenu: TMenuItem; + ScriptingSaveMenu: TMenuItem; +ScriptOpenDialog: TOpenDialog; +LayerPopup: TPopupMenu; +LayerInvertColorsMenu: TMenuItem; +LayerShowHeaderMenu: TMenuItem; +procedure LayerPopupPopup(Sender: TObject); +procedure LayerInvertColorsMenuClick(Sender: TObject); +procedure LayerShowHeaderMenuClick(Sender: TObject); +procedure LayerWidgetChange(Sender: TObject); +procedure LayerOptionsBtnClick(Sender: TObject); +procedure LayerContrastKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); +procedure LayerListSelectionChange(Sender: TObject; User: boolean); +procedure LayerAlphaTrackMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure LayerListShowHint(Sender: TObject; HintInfo: PHintInfo); + procedure LeftSplitterCanOffset(Sender: TObject; var NewOffset: Integer; + var Accept: Boolean); + procedure LeftSplitterCanResize(Sender: TObject; var NewSize: Integer; + var Accept: Boolean); + procedure LeftSplitterChangeBounds(Sender: TObject); + procedure LeftSplitterMoved(Sender: TObject); + procedure UpdateLayerBox(NewLayers: boolean); + + procedure ScriptingNewMenuClick(Sender: TObject); + procedure ScriptingOpenMenuClick(Sender: TObject); + procedure ScriptingTemplatesMenuClick(Sender: TObject); + procedure ScriptingPascalMenuClick(Sender: TObject); + + procedure ScriptingRunMenuClick(Sender: TObject); + procedure ScriptingSaveMenuClick(Sender: TObject); + procedure ScriptingGenerateTemplateMenu(isPython: boolean); + procedure ScriptFormVisible(vis: boolean); + procedure OpenScript(scriptname: string; isShowScriptPanel: boolean = true); + + procedure FormDestroy(Sender: TObject); + procedure NodeThreshDropChange(Sender: TObject); + procedure ROImeshMenuClick(Sender: TObject); + function UpdateClrbar: integer; + procedure ClrbarClr(i: integer); + procedure UpdateFont(initialSetup: boolean); + procedure ClrbarMenuClick(Sender: TObject); + procedure ColorBarVisibleMenuClick(Sender: TObject); + procedure SetColorBarPosition; + procedure FormChangeBounds(Sender: TObject); + procedure FormShow(Sender: TObject); + function GLBoxBackingWidth: integer; + function GLBoxBackingHeight: integer; + procedure GLboxDblClick(Sender: TObject); + procedure CurvMenuClick(Sender: TObject); + procedure DepthLabelDblClick(Sender: TObject); + procedure NewWindow1Click(Sender: TObject); + procedure Quit2TextEditor; + procedure CenterMeshMenuClick(Sender: TObject); + procedure AdditiveOverlayMenuClick(Sender: TObject); + procedure FormDropFiles(Sender: TObject; const FileNames: array of String); + procedure GLBoxClick(Sender: TObject); + procedure MeshColorBoxChange(Sender: TObject); + function OpenNode(FilenameIn: string): boolean; + function OpenTrack(FilenameIn: string): boolean; + function OpenOverlay(FilenameIn: string): boolean; + function OpenEdge(FilenameIn: string): boolean; + function OpenMesh(FilenameIn: string): boolean; + procedure CheckForUpdates(Sender: TObject); + procedure AboutMenuClick(Sender: TObject); + procedure AddNodesMenuClick(Sender: TObject); + procedure AddOverlayMenuClick(Sender: TObject); + procedure AddTracksMenuClick(Sender: TObject); + procedure AzimuthLabelClick(Sender: TObject); + procedure BackColorMenuClick(Sender: TObject); + procedure ClipTrackChange(Sender: TObject); + procedure CloseMenuClick(Sender: TObject); + procedure CloseNodesMenuClick(Sender: TObject); + procedure CloseOverlaysMenuClick(Sender: TObject); + procedure CloseTracksMenuClick(Sender: TObject); + procedure CopyMenuClick(Sender: TObject); + procedure DepthLabelClick(Sender: TObject); + procedure DisplayMenuClick(Sender: TObject); + procedure ElevationLabelClick(Sender: TObject); + procedure ErrorTimerTimer(Sender: TObject); + procedure GLBoxMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); + procedure UpdateLUT(lOverlay,lLUTIndex: integer); + procedure NodePrefChange(Sender: TObject); + procedure OrientCubeMenuClick(Sender: TObject); + procedure OverlayTimerStart; + procedure AdjustFormPos (var lForm: TForm); + procedure OverlayBoxCreate; + procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); + procedure FormCreate(Sender: TObject); + procedure AppDropFiles(Sender: TObject; const FileNames: array of String); + procedure CreateRender(w,h: integer; isToScreen: boolean); + procedure GLboxPaint(Sender: TObject); + procedure GLboxMouseMove(Sender: TObject; Shift: TShiftState; lX, lY: Integer); + procedure GLboxMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; lX, lY: Integer); + procedure GLboxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; lX, lY: Integer); + procedure ObjectColorMenuClick(Sender: TObject); + procedure OpenMenuClick(Sender: TObject); + procedure OverlayTimerTimer(Sender: TObject); + procedure OverlayVisible(lOverlay: integer; lVisible: integer); + procedure OverlayInvert(lOverlay: integer; lInvert: boolean); + procedure PrefMenuClick(Sender: TObject); + {$IFDEF LCLCocoa} + procedure SetRetina; + procedure SetDarkMode; + {$ENDIF} + procedure QuickColorClick(Sender: TObject); + procedure ExitMenuClick(Sender: TObject); + procedure ResetMenuClick(Sender: TObject); + procedure RestrictEdgeMenuClick(Sender: TObject); + procedure RestrictHideNodesWithoutEdgesClick(Sender: TObject); + procedure RestrictMenuClick(Sender: TObject); + procedure ReverseFacesMenuClick(Sender: TObject); + procedure SaveBitmap(FilenameIn: string); overload; + procedure SaveBitmap(FilenameIn: string; lX, lY: integer); overload; + procedure SaveMenuClick(Sender: TObject); + procedure SaveMz3(var mesh: TMesh; isSaveOverlays: boolean); + procedure SaveTrack (var lTrack: TTrack); + function SaveMeshCore(lFilename: string): boolean; + procedure SaveMesh(var mesh: TMesh; isSaveOverlays: boolean); + procedure SaveMeshMenuClick(Sender: TObject); + procedure SaveTracksMenuClick(Sender: TObject); + procedure ScalarDropChange(Sender: TObject); + function ScreenShot(lForceRedraw: boolean = false): TBitmap; + function ScreenShotX1: TBitmap; + procedure ScriptPanelDblClick(Sender: TObject); + procedure SetOverlayTransparency(Sender: TObject); + procedure ShaderBoxResize(Sender: TObject); + procedure ShaderDropChange(Sender: TObject); + procedure ShowmessageError(s: string); + procedure GLboxRequestUpdate(Sender: TObject); + procedure SimplifyMeshMenuClick(Sender: TObject); + procedure SimplifyTracksMenuClick(Sender: TObject); + procedure SurfaceAppearanceChange(Sender: TObject); + procedure SwapYZMenuClick(Sender: TObject); + procedure TrackBoxChange(Sender: TObject); + procedure TrackScalarRangeBtnClick(Sender: TObject); + procedure UniformChange(Sender: TObject); + procedure UpdateTimerTimer(Sender: TObject); + procedure UpdateImageIntensity; + function ComboBoxName2Index(var lCombo: TComboBox; lName: string): integer; + procedure SetDistance(Distance: single); + procedure OVERLAYMINMAX (lOverlay: integer; lMin,lMax: single); + procedure OVERLAYCOLORNAME(lOverlay: integer; lFilename: string); + //procedure SetOrtho (w,h: integer; isMultiSample: boolean); + procedure AddMRU(lFilename: string); + procedure UpdateMRU; + procedure CreateMRU; + procedure OpenMRU(Sender: TObject);//open template or MRU + procedure UpdateToolbar; + procedure MultiPassRenderingToolsUpdate; + procedure VolumeToMeshMenuClick(Sender: TObject); + procedure ShaderForBackgroundOnlyClick(Sender: TObject); + procedure GLInvalidate; + procedure InsertCommand(Sender: TObject); + procedure CompileMainClick(Sender: TObject); + procedure PyIOSendData(Sender: TObject; const Data: AnsiString); + procedure PyIOSendUniData(Sender: TObject; const Data: UnicodeString); + + function PyIsPythonScriptMain(): boolean; + function PyExecMain(): boolean; + function PyCreate: boolean; + procedure PyModInitialization(Sender: TObject); + procedure PSScript1Compile(Sender: TPSScript); + + private + { private declarations } + public + { public declarations } + end; + +var + GLForm1: TGLForm1; + gCube : TGLCube; + gClrbar: TGLClrbar; + gPrefs : TPrefs; + gElevation : integer =20; + gAzimuth : integer = 250; + gMesh: TMesh; +implementation +//{$IFDEF COREGL} +{$IFDEF LCLcarbon} + This program does not support Carbon + Please choose Project/ProjectOptions, go to the CompilerOptions/Additions&Overrides and set the BuildMode pull-down to "MacOS" +{$ENDIF} +//{$ENDIF} + +{$R *.lfm} +{$IFDEF LCLCocoa} +uses + commandsu,UserNotification, nsappkitext, glcocoanscontext; +{$ELSE} +uses + commandsu; + +{$ENDIF} +var + PythonIO : TPythonInputOutput; + PyMod: TPythonModule; + PyEngine: TPythonEngine = nil; + + gNode: TMesh; + gTrack: TTrack; + gnLUT: integer = 0; + isBusy: boolean = true; + {$IFDEF Darwin}gRetinaScale : single = 1;{$ENDIF} + gDistance : single = 1; + gMouseX : integer = -1; + gMouseY : integer = -1; + GLerror : string = ''; + clipPlane : TPoint4f; //clipping bottom + GLbox: TOpenGLControl; +const + kFname=0; + kLUT=1; + kMin=2; + kMax=3; + kTrackFilter = 'Camino, VTK, MRTrix, Quench, TrakVis, DTIstudio|*.Bfloat;*.Bfloat.gz;*.trk.gz;*.trk;*.tck;*.pdb;*.fib;*.vtk;*.dat|Any file|*.*'; + +procedure CleanStr (var lStr: string); +//remove symbols, set lower case... +var + lLen,lPos: integer; + lS: string; +begin + lLen := length(lStr); + if lLen < 1 then + exit; + lS := ''; + for lPos := 1 to lLen do + if lStr[lPos] in ['0'..'9','a'..'z','A'..'Z'] then + lS := lS + AnsiLowerCase(lStr[lPos]); + lStr := lS; +end; + +function IsPythonCompatible(lType: integer): boolean; +//current Python can not handle passing array types +var + lTstr: string; + i, len, n, t: integer; +begin + result := true; + lTStr := inttostr(lType); + len := length(lTStr); + i := 1; + while i <= len do begin + if i = len then + n := 1 + else begin + n := strtoint(lTStr[i]); + inc(i); + end; + t := strtoint(lTStr[i]); + if (t = 8) or (t = 9) then + result := false; + inc(i); + end; +end; + +function TypeStr (lType: integer; isPy: boolean = false): string; +var + lTStr,lStr : string; + i,n,len,lLoop,lT: integer;//1=boolean,2=integer,3=float,4=string[filename] +begin + result := ''; + if (lType = 0) and (isPy) then + result := '()'; + if lType = 0 then + exit; + lTStr := inttostr(lType); + lStr := '('; + len := length(lTStr); + i := 1; + while i <= len do begin + if i = len then + n := 1 + else begin + n := strtoint(lTStr[i]); + inc(i); + end; + lT := strtoint(lTStr[i]); + inc(i); + for lLoop := 1 to n do begin + case lT of + 1: begin + if isPy then + lStr := lStr +'1' + else + lStr := lStr +'true'; + + end; + 2: lStr := lStr +'1'; + 3: begin + if lLoop <= 3 then //for Cutout view, we need six values - make them different so this is a sensible cutout + lStr := lStr +'0.5' + else + lStr := lStr +'1.0'; + end; + 4: lStr := lStr +'''filename'''; + 5: lStr := lStr + '''0.2 0.4 0.6; 0.8 S 0.5'''; + 6: begin //byte + if lLoop <= 3 then //for Cutout view, we need six values - make them different so this is a sensible cutout + lStr := lStr +'1' + else + lStr := lStr +'255'; + end; + 7: lStr := lStr +'5';//kludge - make integer where 1 is not a good default, e.g. shaderquality + 8: lStr := lStr +'[1, 2, 4]'; + 9: lStr := lStr +'[1.1, 2.5, 4.2]'; + else lStr := lStr + '''?'''; + end;//case + if lLoop < n then + lStr := lStr+', '; + end;//for each loop + if i < len then + lStr := lStr+', '; + end; + lStr := lStr + ')'; + result := lStr; +end; + +procedure MyWriteln(const s: string); +begin + GLForm1.ScriptOutputMemo.lines.add(S); + {$IFDEF Unix}writeln(s);{$ENDIF} +end; + +procedure TGLForm1.PSScript1Compile(Sender: TPSScript); +var + i: integer; +begin + //Sender.AddFunction( @TScriptForm.MyWriteln,'procedure Writeln(const s: string);'); + Sender.AddFunction(@MyWriteln, 'procedure Writeln(s: string);'); + for i := 1 to knFunc do + Sender.AddFunction(kFuncRA[i].Ptr,'function '+kFuncRA[i].Decl+kFuncRA[i].Vars+';'); + for i := 1 to knProc do + Sender.AddFunction(kProcRA[i].Ptr,'procedure '+kProcRA[i].Decl+kProcRA[i].Vars+':'); +end; + +procedure TGLForm1.InsertCommand(Sender: TObject); +var + lStr: string; + isPy: boolean; +begin + {$IFDEF MYPY} + isPy := PyIsPythonScriptMain(); + {$ELSE} + isPy := false; + {$ENDIF} + lStr := (Sender as TMenuItem).Hint; + if lStr <> '' then begin + ScriptOutputMemo.Lines.Clear; + ScriptOutputMemo.Lines.Add(lStr); + end; + lStr := (Sender as TMenuItem).Caption; + CleanStr(lStr); + if isPy then begin + if IsPythonCompatible((Sender as TMenuItem).Tag) then + lStr := 'gl.'+lStr+TypeStr((Sender as TMenuItem).Tag, isPy) + else + lStr := '#not yet Python Compatible: gl.'+lStr+TypeStr((Sender as TMenuItem).Tag, isPy) + end else + lStr := lStr+TypeStr((Sender as TMenuItem).Tag)+ ';'; + Clipboard.AsText := lStr; + {$IFDEF UNIX} + ScriptMemo.SelText := (lStr)+ kUNIXeoln; + {$ELSE} + ScriptMemo.SelText := (lStr)+ #13#10; + {$ENDIF} +end; + +function ScriptDir: string; +begin + result := AppDir+'script'; + {$IFDEF UNIX} + if fileexists(result) then exit; + result := '/usr/share/mricrogl/script'; + if fileexists(result) then exit; + result := AppDir+'script' + {$ENDIF} +end; + + {$IFDEF Darwin} + function searchPy(pth: string): string; +var + searchResult : TSearchRec; +begin + result := ''; + {$IFDEF Darwin} + if FindFirst(IncludeTrailingPathDelimiter(pth)+'libpython*.dylib', faDirectory, searchResult) = 0 then + {$ELSE} + if FindFirst(IncludeTrailingPathDelimiter(pth)+'libpython*.so', faDirectory, searchResult) = 0 then + {$ENDIF} + result := IncludeTrailingPathDelimiter(pth)+(searchResult.Name); + FindClose(searchResult); +end; + + const + kBasePath = '/Library/Frameworks/Python.framework/Versions/'; + {$ENDIF} + + function findPythonLib(def: string): string; + {$IFDEF WINDOWS} + var + fnm: string; + begin + result := def; + if fileexists(def) then exit; + result :=''; //assume failure + fnm := ScriptDir + pathdelim + 'python35.dll'; + if not FileExists(fnm) then exit; + if not FileExists(changefileext(fnm,'.zip')) then exit; + result := fnm; + end; + {$ELSE} + {$IFDEF Linux} + const + knPaths = 6; + kBasePaths : array [1..knPaths] of string = ('/lib64/','/usr/lib64/','/usr/lib/x86_64-linux-gnu/','/usr/lib/','/usr/local/lib/','/usr/lib/python2.7/config-x86_64-linux-gnu/'); + kBaseName = 'libpython'; + + {$ENDIF} + {$IFDEF Darwin} + const + knPaths = 2; + kBasePaths : array [1..knPaths] of string = (kBasePath, '/System'+kBasePath); + + {$ENDIF} + var + searchResult : TSearchRec; + pth, fnm: string; + vers : TStringList; + n: integer; + begin + result := def; + if DirectoryExists(def) then begin //in case the user supplies libdir not the library name + result := ''; + {$IFDEF Darwin} + if FindFirst(IncludeTrailingPathDelimiter(def)+'libpython*.dylib', faDirectory, searchResult) = 0 then + {$ELSE} + if FindFirst(IncludeTrailingPathDelimiter(def)+'libpython*.so', faDirectory, searchResult) = 0 then + {$ENDIF} + result := IncludeTrailingPathDelimiter(def)+(searchResult.Name); + FindClose(searchResult); + if length(result) > 0 then exit; + end; + if fileexists(result) then exit; + {$IFDEF LCLCocoa} + result := searchPy('/System/Library/Frameworks/Python.framework/Versions/Current/lib'); + if fileexists(result) then exit; + {$ENDIF} + result :=''; //assume failure + vers := TStringList.Create; + n := 1; + while (n <= knPaths) and (vers.Count < 1) do begin + pth := kBasePaths[n]; + n := n + 1; + if not DirectoryExists(pth) then continue; + if FindFirst(pth+'*', faDirectory, searchResult) = 0 then begin + repeat + //showmessage('?'+searchResult.Name); + if (length(searchResult.Name) < 1) or (searchResult.Name[1] = '.') then continue; + {$IFDEF LINUX} + if (pos(kBaseName,searchResult.Name) < 1) then continue; + {$ELSE} + if (not (searchResult.Name[1] in ['0'..'9'])) then continue; + {$ENDIF} + vers.Add(searchResult.Name); + until findnext(searchResult) <> 0; + end; + FindClose(searchResult); + end; + if vers.Count < 1 then begin + vers.Free; + exit; + end; + vers.Sort; + fnm := vers.Strings[vers.Count-1]; //newest version? what if 3.10 vs 3.9? + vers.Free; + {$IFDEF Darwin} + fnm := kBasePath+fnm+'/lib/libpython'+fnm+'.dylib'; + {$ENDIF} + {$IFDEF LINUX} + fnm := pth+ fnm; + {$ENDIF} + if fileexists(fnm) then + result := fnm; + end; + {$ENDIF} +function PyVERSION(Self, Args : PPyObject): PPyObject; cdecl; +begin + with GetPythonEngine do + Result:= PyString_FromString(kVers); +end; + +function PyRESETDEFAULTS(Self, Args : PPyObject): PPyObject; cdecl; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + RESETDEFAULTS; +end; + +function PyMESHCURV(Self, Args : PPyObject): PPyObject; cdecl; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + MESHCURV; + //GLForm1.Caption := inttostr(random(888)); +end; + +function PyMESHREVERSEFACES(Self, Args : PPyObject): PPyObject; cdecl; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + MESHREVERSEFACES; +end; + + +function BOOL(i: integer): boolean; +begin + result := i <> 0; +end; + +function PySAVEBMP(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:savebmp', @PtrName)) then + begin + StrName:= string(PtrName); + SAVEBMP(StrName); + end; +end; + +function PySAVEBMPXY(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; + x,y: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'sii:savebmpxy', @PtrName, @x, @y)) then + begin + StrName:= string(PtrName); + SAVEBMPXY(StrName, x, y); + end; +end; +function PyBACKCOLOR(Self, Args : PPyObject): PPyObject; cdecl; +var + R,G,B: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'iii:backcolor', @R,@G,@B)) then + BACKCOLOR(R,G,B); +end; + +function PyMESHCOLOR(Self, Args : PPyObject): PPyObject; cdecl; +var + R,G,B: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'iii:meshcolor', @R,@G,@B)) then + MESHCOLOR(R,G,B); +end; + +function PyATLASMAXINDEX(Self, Args : PPyObject): PPyObject; cdecl; +var + i: integer; +begin + Result:= GetPythonEngine.PyInt_FromLong(-1); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:atlasmaxindex', @I)) then + Result:= GetPythonEngine.PyInt_FromLong(ATLASMAXINDEX(I)); +end; + +function PyEXISTS(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:exists', @PtrName)) then + begin + StrName:= string(PtrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(EXISTS(StrName))); + end; +end; + +function PyAZIMUTH(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:azimuth', @A)) then + AZIMUTH(A); +end; + +function PyAZIMUTHELEVATION(Self, Args : PPyObject): PPyObject; cdecl; +var + A,E: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ii:azimuthelevation', @A, @E)) then + AZIMUTHELEVATION(A,E); +end; + +function PyBMPZOOM(Self, Args : PPyObject): PPyObject; cdecl; +var + Z: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:bmpzoom', @Z)) then + bmpzoom(Z); +end; + +function PyCAMERADISTANCE(Self, Args : PPyObject): PPyObject; cdecl; +var + Z: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'f:cameradistance', @Z)) then + CAMERADISTANCE(Z); +end; + +function PySHADERAMBIENTOCCLUSION(Self, Args : PPyObject): PPyObject; cdecl; +var + Z: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'f:shaderambientocclusion', @Z)) then + SHADERAMBIENTOCCLUSION(Z); +end; + +function PyCLIP(Self, Args : PPyObject): PPyObject; cdecl; +var + D: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'f:clip', @D)) then + CLIP(D); +end; + +function PyCLIPAZIMUTHELEVATION(Self, Args : PPyObject): PPyObject; cdecl; +var + D,A,E: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'fff:clipazimuthelevation', @D,@A,@E)) then + CLIPAZIMUTHELEVATION(D,A,E); +end; + +function PyTRACKPREFS(Self, Args : PPyObject): PPyObject; cdecl; +var + D,A,E: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'fff:trackprefs', @D,@A,@E)) then + TRACKPREFS(D,A,E); +end; + +function PyATLASSATURATIONALPHA(Self, Args : PPyObject): PPyObject; cdecl; +var + A,B: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ff:atlassaturationalpha', @A,@B)) then + ATLASSATURATIONALPHA(A,B); +end; + +function PyCAMERAPAN(Self, Args : PPyObject): PPyObject; cdecl; +var + A,B: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ff:camerapan', @A,@B)) then + CAMERAPAN(A,B); +end; + +function PyNODESIZE(Self, Args : PPyObject): PPyObject; cdecl; +var + A: single; + I: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'fi:nodesize', @A,@I)) then + NODESIZE(A,Bool(I)); +end; + +function PyEDGESIZE(Self, Args : PPyObject): PPyObject; cdecl; +var + A: single; + I: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'fi:edgesize', @A,@I)) then + EDGESIZE(A,Bool(I)); +end; + +function PyOVERLAYINVERT(Self, Args : PPyObject): PPyObject; cdecl; +var + B,I: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ii:overlayinvert', @I,@B)) then + OVERLAYINVERT(I,Bool(B)); +end; + +function PyOVERLAYTRANSLUCENT(Self, Args : PPyObject): PPyObject; cdecl; +var + B,I: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ii:overlaytranslucent', @I,@B)) then + OVERLAYTRANSLUCENT(I,Bool(B)); +end; + +function PyEDGETHRESH(Self, Args : PPyObject): PPyObject; cdecl; +var + A,B: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ff:edgethresh', @A,@B)) then + EDGETHRESH(A,B); +end; + +function PySHADERXRAY(Self, Args : PPyObject): PPyObject; cdecl; +var + A,B: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ff:shaderxray', @A,@B)) then + SHADERXRAY(A,B); +end; + +function PyNODETHRESH(Self, Args : PPyObject): PPyObject; cdecl; +var + A,B: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ff:nodethresh', @A,@B)) then + NODETHRESH(A,B); +end; + +function PyCOLORBARPOSITION(Self, Args : PPyObject): PPyObject; cdecl; +var + P: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:colorbarposition', @P)) then + COLORBARPOSITION (P); +end; + +function PyMESHOVERLAYORDER(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:meshoverlayorder', @A)) then + MESHOVERLAYORDER(BOOL(A)); +end; + +function PyORIENTCUBEVISIBLE(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:orientcubevisible', @A)) then + ORIENTCUBEVISIBLE(BOOL(A)); +end; + +function PyOVERLAYADDITIVE(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:overlayadditive', @A)) then + OVERLAYADDITIVE(BOOL(A)); +end; + +function PyOVERLAYSMOOTHVOXELWISEDATA(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:overlaysmoothvoxelwisedata', @A)) then + OVERLAYSMOOTHVOXELWISEDATA(BOOL(A)); +end; + +function PySHADERFORBACKGROUNDONLY(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:shaderforbackgroundonly', @A)) then + SHADERFORBACKGROUNDONLY(BOOL(A)); +end; + +function PyNODETHRESHBYSIZENOTCOLOR(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:nodethreshbysizenotcolor', @A)) then + NODETHRESHBYSIZENOTCOLOR(BOOL(A)); +end; + +function PyCOLORBARVISIBLE(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:colorbarvisible', @A)) then + COLORBARVISIBLE(BOOL(A)); +end; + +function PyFONTNAME(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:fontname', @PtrName)) then + begin + StrName:= string(PtrName); + FONTNAME(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyELEVATION(Self, Args : PPyObject): PPyObject; cdecl; +var + E: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:elevation', @E)) then + ELEVATION(E); +end; + +function PyNODEHEMISPHERE(Self, Args : PPyObject): PPyObject; cdecl; +var + E: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:nodehemisphere', @E)) then + NODEHEMISPHERE(E); +end; + +function PyNODEPOLARITY(Self, Args : PPyObject): PPyObject; cdecl; +var + E: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:nodepolarity', @E)) then + NODEPOLARITY(E); +end; + +function PyMESHLOAD(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:meshload', @PtrName)) then + begin + StrName:= string(PtrName); + MESHLOAD(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyTRACKLOAD(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:trackload', @PtrName)) then + begin + StrName:= string(PtrName); + TRACKLOAD(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyMESHSAVE(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:meshsave', @PtrName)) then + begin + StrName:= string(PtrName); + MESHSAVE(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyNODELOAD(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:nodeload', @PtrName)) then + begin + StrName:= string(PtrName); + NODELOAD(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyOVERLAYLOAD(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:overlayload', @PtrName)) then + begin + StrName:= string(PtrName); + OVERLAYLOAD(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyEDGELOAD(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:edgeload', @PtrName)) then + begin + StrName:= string(PtrName); + EDGELOAD(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyMODALMESSAGE(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:modalmessage', @PtrName)) then + begin + StrName:= string(PtrName); + MODALMESSAGE(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyMODELESSMESSAGE(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:modelessmessage', @PtrName)) then + begin + StrName:= string(PtrName); + MODELESSMESSAGE(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyOVERLAYCLOSEALL(Self, Args : PPyObject): PPyObject; cdecl; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(TRUE)); + OVERLAYCLOSEALL; +end; + +function PyQUIT(Self, Args : PPyObject): PPyObject; cdecl; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(TRUE)); + QUIT; +end; + +function PyOVERLAYCOLORNAME(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; + V: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'is:overlaycolorname', @V, @PtrName)) then + begin + StrName:= string(PtrName); + OVERLAYCOLORNAME(V, StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PySHADERNAME(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; + V: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 's:shadername', @PtrName)) then + begin + StrName:= string(PtrName); + SHADERNAME(StrName); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PySHADERADJUST(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; + f: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'sf:shaderadjust', @PtrName, @f)) then + begin + StrName:= string(PtrName); + SHADERADJUST(StrName, f); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyEDGECOLOR(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; + i: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'si:edgecolor', @PtrName, @i)) then + begin + StrName:= string(PtrName); + EDGECOLOR(StrName, bool(i)); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyNODECOLOR(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName: PChar; + StrName: string; + i: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'si:nodecolor', @PtrName, @i)) then + begin + StrName:= string(PtrName); + NODECOLOR(StrName, bool(i)); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PyMESHCREATE(Self, Args : PPyObject): PPyObject; cdecl; +var + PtrName,PtrName2: PChar; + StrName,StrName2: string; + f,f2: single; + i,i2: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(FALSE)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ssffii:meshcreate', @PtrName, @PtrName2, @f, @f2, @i, @i2)) then + begin + StrName:= string(PtrName); + StrName2:= string(PtrName2); + MESHCREATE(StrName, StrName2, f, f2, i, i2); + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + end; +end; + +function PySCRIPTFORMVISIBLE(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:scriptformvisible', @A)) then + SCRIPTFORMVISIBLE(BOOL(A)); +end; + +function PyVIEWAXIAL(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:viewaxial', @A)) then + VIEWAXIAL(BOOL(A)); +end; + +function PyVIEWCORONAL(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:viewcoronal', @A)) then + VIEWCORONAL(BOOL(A)); +end; + +function PyOVERLAYTRANSPARENCYONBACKGROUND(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:overlaytransparencyonbackground', @A)) then + OVERLAYTRANSPARENCYONBACKGROUND(A); +end; + +function PyWAIT(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:wait', @A)) then + WAIT(A); +end; + +function PySHADERLIGHTAZIMUTHELEVATION(Self, Args : PPyObject): PPyObject; cdecl; +var + A,B: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ii:shaderlightazimuthelevation', @A, @B)) then + SHADERLIGHTAZIMUTHELEVATION(A,B); +end; + +function PyOVERLAYMINMAX(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; + B,C: single; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'iff:overlayminmax', @A, @B, @C)) then + OVERLAYMINMAX(A,B,C); +end; + +function PyOVERLAYVISIBLE(Self, Args : PPyObject): PPyObject; cdecl; +var + A,B: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'ii:overlayvisible', @A, @B)) then + OVERLAYVISIBLE(A,BOOL(B)); +end; + + + +function PyVIEWSAGITTAL(Self, Args : PPyObject): PPyObject; cdecl; +var + A: integer; +begin + Result:= GetPythonEngine.PyBool_FromLong(Ord(True)); + with GetPythonEngine do + if Bool(PyArg_ParseTuple(Args, 'i:viewsagittal', @A)) then + VIEWSAGITTAL(BOOL(A)); +end; + +(*function pyAbort(Self, Args : PPyObject): PPyObject; cdecl; +begin + Result := nil; + Abort; +end;*) + + +procedure TGLForm1.PyModInitialization(Sender: TObject); +begin + with Sender as TPythonModule do begin + //AddMethod('atlasgraybg', @PyATLASGRAYBG, ''); + AddMethod('atlasmaxindex', @PyATLASMAXINDEX, ' atlasmaxindex(overlayNum) -> Returns maximum region humber in specified atlas. For example, if you load the CIT168 atlas (which has 15 regions) as your background image, then atlasmaxindex(0) will return 15.'); + AddMethod('atlassaturationalpha', @PyATLASSATURATIONALPHA, ' atlassaturationalpha(saturation, transparency) -> Set saturation and transparency of atlas. A desaturated atlas will appear gray, a transparent atlas will reveal the background color.'); + AddMethod('azimuth', @PyAZIMUTH, ' azimuthe(azi) -> Rotate image by specified degrees.'); + AddMethod('azimuthelevation', @PyAZIMUTHELEVATION, ' azimuthelevation(azi, elev) -> Sets the camera location.'); + AddMethod('backcolor', @PyBACKCOLOR, ' backcolor(r, g, b) -> changes the background color, for example backcolor(255, 0, 0) will set a bright red background'); + AddMethod('bmpzoom', @PyBMPZOOM, ' bmpzoom(z) -> changes resolution of savebmp(), for example bmpzoom(2) will save bitmaps at twice screen resolution'); + AddMethod('cameradistance', @PyCAMERADISTANCE, ' cameradistance(z) -> Sets the viewing distance from the object.'); + AddMethod('camerapan', @PyCAMERAPAN, ' camerapan(x, y) -> Translate image horizontally (x) and vertically (y). range -1..+1, where 0 is centered.'); + AddMethod('clip', @PyCLIP, ' clip(depth) -> Creates a clip plane that hides information close to the viewer.'); + AddMethod('clipazimuthelevation', @PyCLIPAZIMUTHELEVATION, ' clipazimuthelevation(depth, azi, elev) -> Set a view-point independent clip plane.'); + AddMethod('colorbarposition', @PyCOLORBARPOSITION, ' colorbarposition(p) -> Set colorbar position (1=bottom, 2=left, 3=top, 4=right).'); + AddMethod('colorbarvisible', @PyCOLORBARVISIBLE, ' colorbarvisible(v) -> Show (1) or hide (0) the color bar.'); + AddMethod('edgecolor', @PyEDGECOLOR, ' edgecolor(name, varies) -> Select color scheme for connectome edge map. If varies=1 then edge color depends on strength of connection.'); + AddMethod('edgeload', @PyEDGELOAD, ' edgeload(filename) -> Loads a BrainNet Viewer format Edge file, e.g. connectome map.'); + AddMethod('edgesize', @PyEDGESIZE, ' edgesize (size, varies) -> Set the diameters of the cylinders of the connectome. If varies=1 then edge diameter depends on strength of connection.'); + AddMethod('edgethresh', @PyEDGETHRESH, ' edgethresh (lo, hi) -> Set minimum and maximum values for connectome edge diameters.'); + AddMethod('elevation', @PyELEVATION, ' elevation(degrees) -> Rotates volume rendering relative to camera.'); + AddMethod('exists', @PyEXISTS, ' exists(filename) -> Returns true if filename is found.'); + AddMethod('fontname', @PyFONTNAME, ' fontname(name) -> Set typeface for display.'); + AddMethod('meshcolor', @PyMESHCOLOR, ' meshcolor(r, g, b) -> Set red/green/blue components of main image. Each component is an integer 0..255.'); + AddMethod('meshcreate', @PyMESHCREATE, ' meshcreate(niiname, meshname, threshold, decimateFrac, minimumClusterVox, smoothStyle) -> Convert a NIfTI voxel-based image into a mesh.'); + AddMethod('meshcurv', @PyMESHCURV, ' meshcurv() -> Displays mesh curvature, so crevices appear dark.'); + AddMethod('meshload', @PyMESHLOAD, ' meshload(imageName) -> Close all open images and load new background image.'); + AddMethod('meshoverlayorder', @PyMESHOVERLAYORDER, ' meshoverlayorder (flip) -> If flip=1, the mesh will be drawn after the overlay, and xray sliders will influence overlay not mesh.'); + AddMethod('meshreversefaces', @PyMESHREVERSEFACES, ' meshreversefaces() -> reverse triangle winding to reverse front/back faces.'); + AddMethod('meshsave', @PyMESHSAVE, ' meshsave(filename) -> Saves currently open mesh to disk.'); + AddMethod('modalmessage', @PyMODALMESSAGE, ' modalmessage(msg) -> Shows a modal dialog, script stops until user presses ''OK'' button to dismiss dialog.'); + AddMethod('modelessmessage', @PyMODELESSMESSAGE, ' modelessmessage(msg) -> Prints text in the bottom status region of the scripting window.'); + AddMethod('nodecolor', @PyNODECOLOR, ' nodecolor(name, varies) -> set colorscheme used for nodes. If varies=1, the color of nodes will differ depending on size or intensity.'); + AddMethod('nodehemisphere', @PyNODEHEMISPHERE, ' nodehemisphere (val) -> Set -1 for left hemipshere, 0 for both, 1 for right'); + AddMethod('nodeload', @PyNODELOAD, ' nodeload(filename) -> Loads BrainNet viewer format node file.'); + AddMethod('nodepolarity', @PyNODEPOLARITY, ' nodepolarity(val) -> Set -1 for negative only, 0 for either, 1 for positive only.'); + AddMethod('nodesize', @PyNODESIZE, ' nodesize(size, varies) -> Determine size scaling factor for nodes.'); + AddMethod('nodethresh', @PyNODETHRESH, ' nodethresh(lo, hi) -> Set the minimum and maximum range for nodes.'); + AddMethod('nodethreshbysizenotcolor', @PyNODETHRESHBYSIZENOTCOLOR, ' nodethreshbysizenotcolor(NodeThresholdBySize) -> If true (1) then nodes will be hidden if they are smaller than the provided threshold. If false (0), they will be hidden if their color intensity is below the provided threshold.'); + AddMethod('orientcubevisible', @PyORIENTCUBEVISIBLE, ' orientcubevisible (visible) -> Show (1) or hide (0) cube that indicates object rotation'); + AddMethod('overlayadditive', @PyOVERLAYADDITIVE, ' overlayadditive (add) -> Determines whether overlay colors are combined by adding or mixing the colors. For example, overlap of red and green overlays will appear yellow if additive is true (1)'); + AddMethod('overlaycloseall', @PyOVERLAYCLOSEALL, ' overlaycloseall() -> Close all open overlays.'); + AddMethod('overlaycolorname', @PyOVERLAYCOLORNAME, ' overlaycolorname(overlayLayer, filename) -> Set the colorscheme for the target overlay to a specified name.'); + AddMethod('overlayinvert', @PyOVERLAYINVERT, ' overlayinvert(overlaLayer, invert) -> Toggle whether overlay color scheme is inverted.'); + AddMethod('overlayload', @PyOVERLAYLOAD, ' overlayload(filename) -> Load an image on top of prior images.'); + AddMethod('overlayminmax', @PyOVERLAYMINMAX, ' overlayminmax(layer, min, max) -> Sets the color range for the overlay (layer 0 = background).'); + AddMethod('overlaysmoothvoxelwisedata', @PyOVERLAYSMOOTHVOXELWISEDATA, ' overlaysmoothvoxelwisedata(smooth) -> Determines if overlays are loaded using interpolation (smooth, 1) or nearest neighbor (un-smoothed, 0) interpolation.'); + AddMethod('overlaytranslucent', @PyOVERLAYTRANSLUCENT, ' overlaytranslucent(overlayLayer, translucent) -> This feature allows you to make individual overlays translucent or opaque.'); + AddMethod('overlaytransparencyonbackground', @PyOVERLAYTRANSPARENCYONBACKGROUND, ' overlaytransparencyonbackground(percent) -> Controls the opacity of the overlays on the background.'); + AddMethod('overlayvisible', @PyOVERLAYVISIBLE, ' overlayvisible(overlayLayer, visible) -> This feature allows you to make individual overlays visible or invisible.'); + AddMethod('quit', @PyQUIT, ' quit() -> Terminate the application.'); + AddMethod('resetdefaults', @PyRESETDEFAULTS, ' resetdefaults() -> Revert settings to sensible values.'); + AddMethod('savebmp', @PySAVEBMP, ' savebmp(pngName) -> Save screen display as bitmap. For example "savebmp(''test.png'')"'); + AddMethod('savebmpxy', @PySAVEBMPXY, ' savebmpxy(pngName, x, y) -> Saves the currently viewed image as a PNG bitmap image. Specify the image width (x) and height (y).'); + AddMethod('scriptformvisible', @PySCRIPTFORMVISIBLE, ' scriptformvisible (visible) -> Show (1) or hide (0) the scripting window.'); + AddMethod('shaderadjust', @PySHADERADJUST, ' shaderadjust(sliderName, sliderValue) -> Set level of shader property. Example "gl.shaderadjust(''Diffuse'', 0.6)"'); + AddMethod('shaderambientocclusion', @PySHADERAMBIENTOCCLUSION, ' shaderambientocclusion(amount) -> Specify a value in the range 0..1 to set the strength of the crevice shadows'); + AddMethod('shaderforbackgroundonly', @PySHADERFORBACKGROUNDONLY, ' shaderforbackgroundonly(onlybg) -> If true (1) selected shader only influeces background image, otherwise shader influences background, overlays, tracks and nodes.'); + AddMethod('shaderlightazimuthelevation', @PySHADERLIGHTAZIMUTHELEVATION, ' shaderlightazimuthelevation (azimuth, elevation) -> Changes location of light source.'); + AddMethod('shadername', @PySHADERNAME, ' shadername(name) -> Choose rendering shader function. For example, "shadername(''phong'')" renders using Phong shading.'); + AddMethod('shaderxray', @PySHADERXRAY, ' shaderxray (object, overlay) -> See occluded overlays/tracks/nodes by making either object transparent (0..1) or overlay/tracks/nodes emphasized (0..1)'); + AddMethod('trackload', @PyTRACKLOAD, ' trackload (filename) -> Load fiber steam lines from a file.'); + AddMethod('trackprefs', @PyTRACKPREFS, ' trackprefs(length, width, dither) -> Set the size and properties for streamlines.'); + AddMethod('version', @PyVERSION, ' version() -> Return the version of Surfice.'); + AddMethod('viewaxial', @PyVIEWAXIAL, ' viewaxial(SI) -> Show rendering with camera superior (1) or inferior (0) of volume.'); + AddMethod('viewcoronal', @PyVIEWCORONAL, ' viewcoronal(AP) -> Show rendering with camera posterior (1) or anterior (0) of volume.'); + AddMethod('viewsagittal', @PyVIEWSAGITTAL, ' viewsagittal(LR) -> Show rendering with camera left (1) or right (0) of volume.'); + AddMethod('wait', @PyWAIT, ' wait(ms) -> Pause script for (at least) the desired milliseconds.'); + end; +end; + + +procedure TGLForm1.PyIOSendData(Sender: TObject; + const Data: AnsiString); +begin + ScriptOutputMemo.Lines.Add(Data); +end; + +procedure TGLForm1.PyIOSendUniData(Sender: TObject; + const Data: UnicodeString); +begin + ScriptOutputMemo.Lines.Add(Data); +end; +function TGLForm1.PyCreate: boolean; +//const +// cPyLibraryMac = '/Library/Frameworks/Python.framework/Versions/2.7/lib/libpython2.7.dylib'; +var + S: string; +begin + result := false; + S:= findPythonLib(gPrefs.PyLib); + if (S = '') then exit; + gPrefs.PyLib := S; + result := true; + PythonIO := TPythonInputOutput.Create(GLForm1); + PyMod := TPythonModule.Create(GLForm1); + PyEngine := TPythonEngine.Create(GLForm1); + PyEngine.IO := PythonIO; + PyEngine.PyFlags:=[pfIgnoreEnvironmentFlag]; + PyEngine.UseLastKnownVersion:=false; + PyMod.Engine := PyEngine; + PyMod.ModuleName := 'gl'; + PyMod.OnInitialization:=PyModInitialization; + PythonIO.OnSendData := PyIOSendData; + PythonIO.OnSendUniData:= PyIOSendUniData; + PyEngine.DllPath:= ExtractFileDir(S); + PyEngine.DllName:= ExtractFileName(S); + PyEngine.LoadDll +end; + + +function TGLForm1.PyIsPythonScriptMain(): boolean; +begin + result := ( Pos('import gl', GLForm1.ScriptMemo.Lines.Text) > 0); //any python project must import gl +end; + +function TGLForm1.PyExecMain(): boolean; +begin + result := false; //assume code is not Python + if not (PyIsPythonScriptMain) then exit; + GLForm1.ScriptOutputMemo.lines.Clear; + result := true; + if PyEngine = nil then begin + if not PyCreate then begin //do this the first time + {$IFDEF Windows} + GLForm1.ScriptOutputMemo.lines.Add('Unable to find Python library [place Python .dll and .zip in Script folder]'); + {$ENDIF} + {$IFDEF Unix} + GLForm1.ScriptOutputMemo.lines.Add('Unable to find Python library'); + {$IFDEF Darwin} + GLForm1.ScriptOutputMemo.lines.Add(' For MacOS this is typically in: '+kBasePath+''); + {$ELSE} + GLForm1.ScriptOutputMemo.lines.Add(' run ''find -name "*libpython*"'' to find the library'); + GLForm1.ScriptOutputMemo.lines.Add(' if it does not exist, install it (e.g. ''apt-get install libpython2.7'')'); + {$ENDIF} + GLForm1.ScriptOutputMemo.lines.Add(' if it does exist, set use the Preferences/Advanced to set ''PyLib'''); + {$IFDEF Darwin} + GLForm1.ScriptOutputMemo.lines.Add(' PyLib should be the complete path and filename of libpython*.dylib'); + {$ELSE} + GLForm1.ScriptOutputMemo.lines.Add(' PyLib should be the complete path and filename of libpython*.so'); + {$ENDIF} + GLForm1.ScriptOutputMemo.lines.Add(' This file should be in your LIBDIR, which you can detect by running Python from the terminal:'); + GLForm1.ScriptOutputMemo.lines.Add(' ''import sysconfig; print(sysconfig.get_config_var("LIBDIR"))'''); + {$ENDIF} + result := true; + exit; + + end; + end; + GLForm1.ScriptOutputMemo.lines.Add('Running Python script'); + try + PyEngine.ExecStrings(GLForm1.ScriptMemo.Lines); + except + caption := 'Python Engine Failed'; + end; + GLForm1.ScriptOutputMemo.lines.Add('Python Succesfully Executed'); + result := true; + ToolPanel.refresh; + + ToolPanel.refresh; +end; + + +procedure TGLForm1.CompileMainClick(Sender: TObject); +var + i: integer; + compiled: boolean; +begin + {$IFDEF MYPY} + if PyExecMain() then exit; + if (not (AnsiContainsText(GLForm1.ScriptMemo.Lines.Text, 'begin'))) then begin + GLForm1.ScriptOutputMemo.Lines.Clear; + GLForm1.ScriptOutputMemo.Lines.Add('Error: script must contain "import gl" (for Python) or "begin" (for Pascal).'); + exit; + end; + {$ENDIF} + GLForm1.ScriptOutputMemo.Lines.Clear; + PSScript1.Script.Text := GLForm1.ScriptMemo.Lines.Text; + //PSScript1.Script.Text := Memo1.Lines.GetText; //<- this will leak! requires StrDispose + Compiled := PSScript1.Compile; + for i := 0 to PSScript1.CompilerMessageCount -1 do + MyWriteln( PSScript1.CompilerMessages[i].MessageToString); + if Compiled then + MyWriteln('Successfully Compiled Script'); + if Compiled then begin + if PSScript1.Execute then + MyWriteln('Succesfully Executed') + else + MyWriteln('Error while executing script: '+ + PSScript1.ExecErrorToString); + end; + GLForm1.Refresh; + ToolPanel.refresh; +end; + +procedure TGLForm1.ScriptingGenerateTemplateMenu(isPython: boolean); +var + i: integer; + scriptPath, scriptName: string; + scriptNames : TStringList; + newMenu: TMenuItem; + begin + //auto generate template script + scriptPath := ScriptDir; + if not DirectoryExists(scriptPath) then showmessage('Unable to find scripts "'+scriptPath+'"'); + if isPython then + scriptNames := FindAllFiles(scriptPath, '*.py', false) + else + scriptNames := FindAllFiles(scriptPath, '*.gls', false); + //showmessage(inttostr(scriptNames.Count)); + if scriptNames.Count > 0 then begin + scriptNames.Sort; + for i := 0 to (scriptNames.Count-1) do begin + scriptName := ChangeFileExt(ExtractFileName(scriptNames[i]),''); + if (length(scriptName) < 1) or (scriptName[1] = '_') or (scriptName[1] = '.') then + continue; + newMenu := TMenuItem.Create(MainMenu1); + newMenu.Caption := scriptName; + //newMenu.AutoCheck := true; + //newMenu.RadioItem := true; + if isPython then begin + newMenu.OnClick := ScriptingTemplatesMenuClick; + //newMenu.GroupIndex := 132; + ScriptingTemplatesMenu.Add(newMenu) + end else begin + newMenu.OnClick := ScriptingPascalMenuClick; + //newMenu.GroupIndex := 133; + ScriptingPascalMenu.Add(newMenu); + end; + end; + end; + scriptNames.Free; +end; + +procedure TGLForm1.ScriptFormVisible(vis: boolean); +begin + if (vis) and (GLForm1.ScriptPanel.Width < GLForm1.ToolPanel.Constraints.MaxWidth) then + GLForm1.ScriptPanel.Width := GLForm1.ToolPanel.Constraints.MaxWidth + else if (not vis) then + GLForm1.ScriptPanel.width := 0; + //{$IFDEF METALAPI} + //ViewGPU1.Invalidate; + //{$ENDIF} +end; + +procedure TGLForm1.ScriptPanelDblClick(Sender: TObject); +begin + ScriptPanel.Width := 4; +end; + +procedure TGLForm1.ScriptingNewMenuClick(Sender: TObject); +begin + ScriptFormVisible(true); + ScriptMemo.Lines.Clear; + ScriptMemo.Lines.Add('import gl'); + ScriptMemo.Lines.Add('gl.resetdefaults()'); +end; + +procedure TGLForm1.OpenScript(scriptname: string; isShowScriptPanel: boolean = true); +begin + if not fileexists(scriptname) then exit; + if (ScriptPanel.Width < 24) and (isShowScriptPanel) then + ScriptPanel.Width := 240; + ScriptMemo.Lines.LoadFromFile(scriptname); + gPrefs.InitScript:=''; + ScriptingRunMenuClick(nil); +end; + +procedure TGLForm1.ScriptingOpenMenuClick(Sender: TObject); +begin + if not ScriptOpenDialog.execute then exit; + OpenScript(ScriptOpenDialog.Filename); +end; + +procedure TGLForm1.ScriptingTemplatesMenuClick(Sender: TObject); +var + scriptName: string; +begin + //shaderName := ResourceDir+pathdelim+'script' + pathdelim + (Sender as TMenuItem).caption+'.py'; + scriptName := ScriptDir + pathdelim + (Sender as TMenuItem).caption+'.py'; + if not fileexists(scriptName) then + showmessage('Unable to find '+scriptName); + OpenScript(scriptName); +end; + +procedure TGLForm1.ScriptingPascalMenuClick(Sender: TObject); +var + scriptName: string; +begin + //shaderName := ResourceDir+pathdelim+'script' + pathdelim + (Sender as TMenuItem).caption+'.py'; + scriptName := ScriptDir + pathdelim + (Sender as TMenuItem).caption+'.gls'; + if not fileexists(scriptName) then + showmessage('Unable to find '+scriptName); + OpenScript(scriptName); +end; +procedure TGLForm1.ScriptingRunMenuClick(Sender: TObject); +begin + CompileMainClick(Sender);// PyExecMain(); +end; + +procedure TGLForm1.ScriptingSaveMenuClick(Sender: TObject); +begin + SaveScriptDialog.InitialDir:= ScriptDir; + if PyIsPythonScriptMain() then + SaveScriptDialog.DefaultExt := '.py' + else + SaveScriptDialog.DefaultExt := '.gls'; + if PyIsPythonScriptMain() then + SaveScriptDialog.Filter := 'Python script|*.py' + else + SaveScriptDialog.Filter := 'Pascal script|*.gls'; + SaveScriptDialog.FileName := ''; + if not SaveScriptDialog.Execute then + exit; + ScriptMemo.Lines.SaveToFile(SaveScriptDialog.Filename); +end; + +procedure TGLForm1.UpdateLUT(lOverlay,lLUTIndex: integer); +begin + if (gMesh.OpenOverlays > kMaxOverlays) then + exit; + if lLUTIndex >= LayerColorDrop.Items.Count then + gMesh.Overlay[lOverlay].LUTindex:= 0 + else + gMesh.Overlay[lOverlay].LUTindex:= lLUTIndex; + gMesh.overlay[lOverlay].LUT := UpdateTransferFunction (gMesh.Overlay[lOverlay].LUTindex, gMesh.Overlay[lOverlay].LUTinvert); + //LUTdropLoad(gMesh.Overlay[lOverlay].LUTindex, gMesh.Overlay[lOverlay].LUT, LUTdrop.Items[lLUTindex], gOverlayCLUTrec[lOverlay]); +end; + +procedure TGLForm1.LayerInvertColorsMenuClick(Sender: TObject); +var + i: integer; + //s: string; + //mn, mx: single; +begin + i := LayerList.ItemIndex+ 1; + if (i < 1) or (i > gMesh.OpenOverlays) then exit; + OverlayInvert(i, not gMesh.Overlay[i].LUTinvert); + gnLUT := -1; +end; + +procedure TGLForm1.LayerPopupPopup(Sender: TObject); +var + i: integer; +begin + i := LayerList.ItemIndex+ 1; + if (i < 1) or (i > gMesh.OpenOverlays) then exit; + LayerInvertColorsMenu.Checked := gMesh.Overlay[i].LUTinvert; +end; +procedure TGLForm1.LayerShowHeaderMenuClick(Sender: TObject); +var + i: integer; + s: string; +begin + i := LayerList.ItemIndex+ 1; + if (i < 1) or (i > gMesh.OpenOverlays) then exit; + s :=''; + if (gMesh.Overlay[i].atlasMaxIndex > 0) then + s := 'Atlas'; + showmessage(format('%s Layer %d, range %.6g..%.6g, Name: %s', [s, i, gMesh.Overlay[i].minIntensity, gMesh.Overlay[i].maxIntensity, gMesh.Overlay[i].Filename])); +end; + +procedure TGLForm1.LayerWidgetChange(Sender: TObject); +var + i: integer; + //mn,mx: single; + //lutName: string; + //isChange: boolean = false; +begin + i := LayerList.ItemIndex+ 1; + if (i < 1) or (i > gMesh.OpenOverlays) then exit; + gMesh.Overlay[i].WindowScaledMin := strtofloatdef(LayerDarkEdit.Caption, gMesh.Overlay[i].WindowScaledMin); + gMesh.Overlay[i].WindowScaledMax := strtofloatdef(LayerBrightEdit.Caption, gMesh.Overlay[i].WindowScaledMax); + gMesh.Overlay[i].LUTvisible := LayerAlphaTrack.position; + if (gMesh.Overlay[i].LUTindex <> LayerColorDrop.ItemIndex) then begin + //gMesh.Overlay[i].LUTindex := LayerColorDrop.ItemIndex; + //UpdateLUT(intRow,GLForm1.LUTdrop.ItemIndex,true); + UpdateLUT(i, LayerColorDrop.ItemIndex); + + end; + UpdateImageIntensity; + OverlayTimerStart; +end; + +procedure TGLForm1.LayerOptionsBtnClick(Sender: TObject); +begin + LayerPopup.PopUp; + +end; + +(**) +procedure TGLForm1.LayerContrastKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + LayerWidgetChange(Sender); +end; + +procedure TGLForm1.LayerListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateLayerBox(false); +end; + +procedure TGLForm1.LayerListShowHint(Sender: TObject; HintInfo: PHintInfo); +begin + +end; + +procedure TGLForm1.LeftSplitterCanOffset(Sender: TObject; + var NewOffset: Integer; var Accept: Boolean); +begin + //caption := inttostr(random(888)); +end; + +procedure TGLForm1.LeftSplitterCanResize(Sender: TObject; var NewSize: Integer; + var Accept: Boolean); +begin + (*caption := inttostr(random(888)); + ToolPanel.AutoSize := not ToolPanel.AutoSize; + if not ToolPanel.AutoSize then + ToolPanel.Width := 2;*) + //ToolPanel.Visible := not ToolPanel.Visible; +end; + +procedure TGLForm1.LeftSplitterChangeBounds(Sender: TObject); +begin +end; + +procedure TGLForm1.LeftSplitterMoved(Sender: TObject); +begin + + //caption := inttostr(random(888)); +end; + +procedure TGLForm1.LayerAlphaTrackMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + //caption := format('%d %d', [ViewGPU1.width, ViewGPU1.clientWidth]); + LayerWidgetChange(sender); +end; + +procedure TGLForm1.UpdateLayerBox(NewLayers: boolean); +var + i: integer; + s: string; + isAtlas: boolean; +begin + if (NewLayers) then begin + LayerList.Items.Clear; + if gMesh.OpenOverlays < 1 then exit; + for i := 1 to gMesh.OpenOverlays do begin + s := gMesh.Overlay[i].FileName; + LayerList.Items.add(s); + LayerList.Checked[i-1] := true; + end; + LayerList.ItemIndex := gMesh.OpenOverlays - 1; + end; + if (LayerList.ItemIndex < 0) then + LayerList.ItemIndex := LayerList.Items.Count -1; + if (gMesh.OpenOverlays < 1) then exit; + i := LayerList.ItemIndex + 1; + if (i < 1) or (i > gMesh.OpenOverlays) then exit; + isAtlas := (gMesh.Overlay[i].atlasMaxIndex > 0); + LayerDarkEdit.Enabled := not isAtlas; + LayerBrightEdit.Enabled := not isAtlas; + LayerColorDrop.Enabled := not isAtlas; + LayerDarkEdit.Text := format('%.6g', [gMesh.Overlay[i].WindowScaledMin]); + LayerBrightEdit.Text := format('%.6g', [gMesh.Overlay[i].WindowScaledMax]); + LayerColorDrop.ItemIndex := gMesh.Overlay[i].LUTindex; + LayerAlphaTrack.Position := gMesh.Overlay[i].LUTvisible; +end; + +{$IFDEF LCLCocoa} +procedure TGLForm1.SetDarkMode; +begin + setThemeMode(Self.Handle, gPrefs.DarkMode); + if gPrefs.DarkMode then + Memo1.Color := clGray + else + Memo1.Color := Graphics.clDefault; + ScriptMemo.Color := Memo1.Color; + ScriptOutputMemo.Color := Memo1.Color; +end; + +procedure TGLForm1.SetRetina; +begin + (*if gPrefs.RetinaDisplay then + GLBox.Options := [ocoMacRetinaMode] + else + GLBox.Options := []; + GLBox.MultiSampling:=GLBox.MultiSampling; + *) + LSetWantsBestResolutionOpenGLSurface(gPrefs.RetinaDisplay, GLBox.Handle); + //GLBox.WantsBestResolutionOpenGLSurface:=gPrefs.RetinaDisplay; + if (GLbox.Height < 1) or (GLBoxBackingHeight <= GLbox.Height) then + gRetinaScale := 1 + else + gRetinaScale := GLBoxBackingHeight/GLbox.Height; +end; + +procedure SetFormDarkMode(var f: TForm); +begin + f.PopupMode:= pmAuto; + f.HandleNeeded; + setThemeMode(f.Handle, true); +end; + +procedure Mouse2Retina(var X,Y: integer); +begin + if not gPrefs.RetinaDisplay then exit; + X := round(X * gRetinaScale); + Y := round(Y * gRetinaScale); +end; +{$ELSE} +procedure Mouse2Retina(var X,Y: integer); +begin + //Retina display is MacOS feature +end; +{$ENDIF} + +function FindFileExt(Filename: string): string; +var + p,n,x: string; + i : integer; + searchResult : TSearchRec; +begin + result := Filename; + if FileExistsF(result) then exit; + FilenameParts (Filename, p,n,x); + //try location of last meshes + for i := 1 to knMRU do begin + p := ExtractFilePath(gPrefs.PrevFilename[i]); + if p = '' then continue; + result := p+n+x; + if FileExistsF(result) then exit; + end; + //try location of last overlay + p := ExtractFilePath(gPrefs.PrevOverlayname); + result := p+n+x; + if FileExistsF(result) then exit; + //try location of last track + p := ExtractFilePath(gPrefs.PrevTrackname); + result := p+n+x; + if FileExistsF(result) then exit; + //try location of last node + p := ExtractFilePath(gPrefs.PrevNodename); + result := p+n+x; + if FileExistsF(result) then exit; + //try location of last script + p := ExtractFilePath(gPrefs.PrevScript); + result := p+n+x; + if FileExistsF(result) then exit; + //try application directory + p := AppDir2; + result := p+n+x; + if FileExistsF(result) then exit; + result := DefaultToHomeDir(n+x); //set path to home if not provided + if FileExistsF(result) then exit; + SetCurrentDir(p); + if findfirst('*', faDirectory, searchResult) = 0 then begin + repeat + // Only show directories + if (searchResult.attr and faDirectory) = faDirectory then begin + //ShowMessage('Directory = '+searchResult.Name); + result := p+ searchResult.Name + pathdelim+n+x; + if FileExistsF(result) then begin + FindClose(searchResult); + exit; + end; + end; + until FindNext(searchResult) <> 0; + // Must free up resources used by these successful finds + FindClose(searchResult); + end; + result := ''; //failed! +end; + +function FindFile(Filename: string): string; +var + p,n,x: string; +begin + result := FindFileExt(Filename); + if result <> '' then exit; + FilenameParts (Filename, p,n,x); // if user selects 'jhu' then open 'jhu.mz3' + if x <> '' then exit; + result := FindFileExt(ChangeFileExt(Filename,'.mz3')); + if result <> '' then exit; + result := FindFileExt(ChangeFileExt(Filename,'.gii')); + if result <> '' then exit; + result := FindFileExt(ChangeFileExt(Filename,'.ply')); + if result <> '' then exit; + result := FindFileExt(ChangeFileExt(Filename,'.obj')); + //if result <> '' then exit;*) +end; + +procedure TGLForm1.GLInvalidate; +begin + GLBox.Invalidate; +end; + +function TGLForm1.GLBoxBackingWidth: integer; +begin + {$IFDEF LCLCocoa} + result := Round(GLBox.Width * LBackingScaleFactor(GLBox.Handle)); + {$ELSE} + result := GLBox.Width; + {$ENDIF} +end; + +procedure TGLForm1.FormChangeBounds(Sender: TObject); +{$IFDEF LCLCocoa} var lprev: single; {$ENDIF} +begin + {$IFDEF LCLCocoa} + if (gPrefs.RetinaDisplay) then begin //detect if window moved between retina and non-retina display + lprev := gRetinaScale; + SetRetina; + if (lprev <> gRetinaScale) then + GLBox.Invalidate; + //GLboxResize(Sender); + end; + {$ENDIF} +end; + +procedure TGLForm1.ClrbarClr(i: integer); +begin + if (i < 1) or (i > 4) then i := 4; + gPrefs.ColorbarColor:= i; + Case i of + 1: begin + gClrbar.BackColor := (RGBA(255,255,255,255)); + gClrbar.FontColor := (RGBA(0,0,0,255)); + end; + 2: begin + gClrbar.BackColor := (RGBA(255,255,255,168)); + gClrbar.FontColor := (RGBA(0,0,0,255)); + end; + 3: begin + gClrbar.BackColor := (RGBA(0,0,0,255)); + gClrbar.FontColor := (RGBA(255,255,255,255)); + end; + else begin + gClrbar.BackColor := (RGBA(0,0,0,168)); + gClrbar.FontColor := (RGBA(255,255,255,255)); + end; + end; + +end; + +procedure TGLForm1.ClrbarMenuClick(Sender: TObject); +begin + ClrbarClr((sender as TMenuItem).Tag); + GLBox.Invalidate; +end; + +procedure TGLForm1.GLboxDblClick(Sender: TObject); +begin + gPrefs.ColorBarPosition := gPrefs.ColorBarPosition + 1; + SetColorbarPosition; + GLbox.invalidate; + //caption := 'doubleclick'+inttostr(random(888)); //1/2018: Cocoa generates dblClicks for single clicks +end; + +procedure TGLForm1.ColorBarVisibleMenuClick(Sender: TObject); +begin + gPrefs.Colorbar := not gPrefs.Colorbar; + ColorBarVisibleMenu.Checked := gPrefs.Colorbar; + GLBox.Invalidate; +end; + +function TGLForm1.GLBoxBackingHeight: integer; +begin + {$IFDEF LCLCocoa} + result := Round(GLBox.Height * LBackingScaleFactor(GLBox.Handle)); + {$ELSE} + result := GLBox.Height; + {$ENDIF} +end; + +procedure TGLForm1.MultiPassRenderingToolsUpdate; +var + lBetter: boolean; +begin + lBetter := (gPrefs.RenderQuality <> kRenderPoor) and (gPrefs.SupportBetterRenderQuality); + AOLabel.Visible:= lBetter; + occlusionTrack.Visible:= lBetter; + ShaderForBackgroundOnlyCheck.Visible:= lBetter; + MeshBlendTrack.Visible:= lBetter; + meshAlphaTrack.visible := lBetter; +end; + +procedure TGLForm1.VolumeToMeshMenuClick(Sender: TObject); +const +{$IFDEF FOREIGNVOL} + //kVolFilter = 'NIfTI volume|*.hdr;*.nii;*nii.gz'; + kVolFilter = 'Neuroimaging (*.nii)|*.hdr;*.nii;*.nii.gz;*.voi;*.HEAD;*.mgh;*.mgz;*.mha;*.mhd;*.nhdr;*.nrrd'; +{$ELSE} + kVolFilter = 'NIfTI volume|*.hdr;*.nii;*nii.gz'; +{$ENDIF} +begin + OpenDialog.Filter := kVolFilter; + OpenDialog.Title := 'Select volume to convert'; + if not OpenDialog.Execute then exit; + if (sender as TMenuItem).tag = 1 then + Atlas2Mesh(OpenDialog.FileName) + else + Nii2Mesh(OpenDialog.FileName); +end; + +procedure TGLForm1.ShaderForBackgroundOnlyClick(Sender: TObject); +begin + gPrefs.ShaderForBackgroundOnly := ShaderForBackgroundOnlyCheck.Checked; + //ShaderForBackgroundOnlyCheck.Checked := gPrefs.ShaderForBackgroundOnly ; + GLBoxRequestUpdate(nil); +end; + +function meshBackgroundOpen: boolean; +//returns true if a mesh is open as an overlay +// returns false if there are no overlays or if they are vertex colors +var lI: integer; +begin + result := false; + if (gMesh.OpenOverlays < 1) then exit; + for lI := 1 to gMesh.OpenOverlays do + if length(gMesh.overlay[lI].faces) > 1 then + result := true; +end; + +procedure TGLForm1.UpdateToolbar; +begin + OverlayBox.Visible := (gMesh.OpenOverlays > 0); + //OverlayBox.Top := 0; + BackgroundBox.Visible := (length(gNode.nodes) > 0) or (gTrack.n_count > 0) or ((gMesh.OpenOverlays > 0) and (meshBackgroundOpen)); + NodeBox.Visible:= (length(gNode.nodes) > 0) ; + if (length(gNode.edges) > 0) and (EdgeBox.Visible = false) and (BackgroundBox.Visible) then begin + //this keeps node and edge boxes next to each other + // executed when node is opened (which displays the background) and then edge is opened + BackgroundBox.Visible := false; + EdgeBox.Visible := true; + BackgroundBox.Visible := true; + end; + EdgeBox.Visible:= (length(gNode.edges) > 0) ; + TrackBox.Visible:= (gTrack.n_count > 0); + MeshColorBox.Visible := (length(gMesh.vertexRGBA) > 0); + gnLUT := -1; //refresh colorbar + Memo1.Lines.clear; + ToolPanel.Refresh; +end; //UpdateToolbar() + +function TGLForm1.OpenNode(FilenameIn: string): boolean; +var + FileName, edgename: string; +begin + result := false; + Filename := FindFile(FileNameIn); + if Filename = '' then exit; + if not gNode.LoadFromFile(FileName) then exit; + result := true; + gPrefs.PrevNodename := FileName; + NodeBox.Visible:= true; + if gNode.NodePrefs.isNodeThresholdBySize then begin + NodeThreshDrop.ItemIndex := 0; //threshold by size + NodeMinEdit.Value:=gNode.NodePrefs.minNodeSize; + NodeMaxEdit.Value:=gNode.NodePrefs.maxNodeSize; + end else begin + NodeThreshDrop.ItemIndex := 1; //threshold by color + NodeMinEdit.Value:=gNode.NodePrefs.minNodeColor; + NodeMaxEdit.Value:=gNode.NodePrefs.maxNodeColor; + end; + gNode.nodePrefs.minNodeThresh := NodeMinEdit.value; + gNode.nodePrefs.maxNodeThresh := NodeMaxEdit.value; + edgename := ChangeFileExt(FileName, '.edge'); + if fileexists(edgename) then + OpenEdge(edgename); + OpenDialog.InitialDir:= ExtractFileDir(FileName); + UpdateToolbar; + GLBoxRequestUpdate(nil); +end; + +procedure TGLForm1.MeshColorBoxChange(Sender: TObject); +begin + gMesh.vertexRgbaAlpha := MeshTransparencyTrack.Position / MeshTransparencyTrack.Max; + gMesh.vertexRgbaSaturation := MeshSaturationTrack.Position / MeshSaturationTrack.Max; + gMesh.isRebuildList:= true; + GLBoxRequestUpdate(nil); +end; + +procedure TGLForm1.AdditiveOverlayMenuClick(Sender: TObject); +var + i: integer; + isIntensityOverlay: boolean; +begin + gPrefs.AdditiveOverlay := AdditiveOverlayMenu.Checked; + if gMesh.OpenOverlays < 1 then exit; + isIntensityOverlay := false; + for i := gMesh.OpenOverlays downto 1 do + if length(gMesh.overlay[i].intensity) > 1 then + isIntensityOverlay := true; + if (not isIntensityOverlay) and (gPrefs.AdditiveOverlay) then begin + Memo1.Lines.Clear; + Memo1.lines.add('Hint: Additive effect only influences painted surfaces, not meshes'); + end; + OverlayTimerStart; +end; + +function TGLForm1.OpenEdge(FilenameIn: string): boolean; +var + Filename, ext, nodename: string; +begin + result := false; + Filename := FindFile(FilenameIn); + if Filename = '' then exit; + result := true; + ext := UpperCase(ExtractFileExt(Filename)); + setlength(gNode.edges,0); //clear edges array + if (ext = '.NODEZ') or (ext = '.NODE') or (length(gNode.nodes) < 1) then begin + nodename := ChangeFileExt(FileName, '.node'); + if fileexists(nodename) then begin + OpenNode(nodename); + UpdateToolbar; + exit; + end; + end; + if length(gNode.edges) < 1 then //only if edges not loaded by openNode + if not gNode.LoadEdge(Filename, false) then exit; + UpdateToolbar; + edgeMinEdit.Value := 0; + edgeMaxEdit.Value := gNode.nodePrefs.maxEdgeAbs; + OpenDialog.InitialDir:= ExtractFileDir(FileName); + GLBoxRequestUpdate(nil); +end; + +function TGLForm1.OpenOverlay(FilenameIn: string): boolean; +var + Filename: string; +begin + result := false; + Filename := FindFile(FilenameIn); + if Filename = '' then exit; + if not gMesh.LoadOverlay(FileName, gPrefs.SmoothVoxelwiseData) then begin //gPrefs.SmoothVoxelwiseData + GLBoxRequestUpdate(nil); + UpdateToolbar; + exit; + end; + result := true; + gPrefs.PrevOverlayname := FileName; + OpenDialog.InitialDir:= ExtractFileDir(FileName); + UpdateToolbar; + UpdateLayerBox(true); +end; + +function TGLForm1.OpenTrack(FilenameIN: string): boolean; +var + Filename: string; + i: integer; +begin + result := false; + Filename := FindFile(FilenameIN); + if Filename = '' then exit; + if (gTrack.LoadFromFile(FileName)) and (gTrack.n_count > 0) then begin + result := true; + OpenDialog.InitialDir:= ExtractFileDir(FileName); + gPrefs.PrevTrackname := FileName; + if (gTrack.maxObservedFiberLength * 0.5) < TrackLengthTrack.Position then + TrackLengthTrack.Position := round(gTrack.maxObservedFiberLength * 0.5); + end; + if (length(gTrack.scalars) > 0) then begin + {$IFDEF LCLcocoa} + TrackBox.Height := 135; + {$ELSE} + TrackBox.ClientHeight := TrackScalarNameDrop.Top + TrackScalarNameDrop.Height + 2; + {$ENDIF} + + TrackScalarNameDrop.Items.Clear; + TrackScalarNameDrop.Items.Add('Direction'); + for i := 0 to (length(gTrack.scalars) -1) do + TrackScalarNameDrop.Items.Add(gTrack.scalars[i].name); + TrackScalarNameDrop.ItemIndex := 0; + TrackScalarLUTdrop.ItemIndex := 1; + TrackScalarLUTdrop.Enabled := false; + TrackScalarRangeBtn.Enabled := false; + end else + {$IFDEF LCLcocoa} + TrackBox.Height := 105; + {$ELSE} + TrackBox.ClientHeight := TrackDitherTrack.Top + TrackDitherTrack.Height; + {$ENDIF} + UpdateToolbar; + GLBoxRequestUpdate(nil); +end; + +function isVtkMesh (filename: string): boolean; //vtk files can be tracks (" LINES" ->Tracks/Open) or meshes ("POLYGONS " -> File/Open, Overlay/Open) +var + f: file; + Str: string; + szRead: integer; +begin + result := false; + if not fileexistsF(filename) then exit; + FileMode := fmOpenRead; + AssignFile(f, FileName); + Reset(f,1); + FileMode := fmOpenRead; + szRead := FileSize(f); + SetLength(Str, szRead); + BlockRead(f, Str[1],szRead); + CloseFile(f); + if (pos('POLYGONS ', Str) > 0) then result := true; //faces + if (pos('TRIANGLE_STRIPS ', Str) > 0) then result := true; //faces +end; + +function isGiiMesh (filename: string): boolean; +//returns true if file is a valid mesh (faces+vertices), returns false if overlay map +var + f: file; + Str: string; + szRead: integer; +begin + result := false; + if not fileexistsF(filename) then exit; + result := true; + AssignFile(f, FileName); + Reset(f,1); + FileMode := fmOpenRead; + szRead := FileSize(f); + SetLength(Str, szRead); + BlockRead(f, Str[1],szRead); + CloseFile(f); + if (pos('Intent="NIFTI_INTENT_TRIANGLE"', Str) > 0) then exit; //faces + if (pos('Intent="NIFTI_INTENT_POINTSET"', Str) > 0) then exit; //vertices + result := false; +end; + +function isMz3Mesh (filename: string): boolean; +//returns true if file is a valid mesh (faces+vertices), returns false if overlay map +const + kMagic = 23117; //"MZ" + kChunkSize = 16; +label 666; +var + i: integer; + Magic, Attr: uint16; + nFace, nVert: uint32; + isFace, isVert: boolean; + mStream : TMemoryStream; + zStream: TGZFileStream; + bytes : array of byte; +begin + result := false; + if not fileexistsF(Filename) then exit; + mStream := TMemoryStream.Create; + zStream := TGZFileStream.create(FileName, gzopenread); + setlength(bytes, kChunkSize); + i := zStream.read(bytes[0],kChunkSize); + mStream.Write(bytes[0],i) ; + if i < kChunkSize then goto 666; + mStream.Position := 0; + mStream.Read(Magic,2); + mStream.Read(Attr,2); + mStream.Read(nFace,4); + mStream.Read(nVert,4); + if (magic <> kMagic) then goto 666; + isFace := (Attr and 1) > 0; + isVert := (Attr and 2) > 0; + result := (nFace > 0) and (nVert > 0) and (isFace) and (isVert); + 666 : + zStream.Free; + mStream.Free; +end; //isMz3Mesh + +function TGLForm1.OpenMesh(FilenameIN: string): boolean; +var + Filename, curvname, ext: string; +begin + result := false; + if FilenameIN <> '-' then + Filename := FindFile(FilenameIN) + else + Filename := FilenameIN; + if Filename = '' then exit; + result := true; + ext := ExtractFileExtGzUpper(Filename); + if (ext = '.GLS') then begin + OpenScript(Filename); + exit; + end; + //ext := UpperCase(ExtractFileExt(Filename)); + if (ext = '.NII') or (ext = '.HDR') or (ext = '.NII.GZ') or (ext = '.DPV') or (ext = '.ANNOT') or (ext = '.W') or (ext = '.CURV') then begin + OpenOverlay(Filename); + exit; + end else if (ext = '.VTK') and (not isVtkMesh (Filename)) then begin + OpenTrack(Filename); //.vtk files can be either meshes or tracks - autodetect + exit; + end else if (length(gMesh.Faces) > 0) and (ext = '.MZ3') and (not isMz3Mesh (Filename)) then begin + OpenOverlay(Filename); //GIfTI files can be meshes or overlays - autodetect + exit; + end else if (length(gMesh.Faces) > 0) and (ext = '.GII') and (not isGiiMesh (Filename)) then begin + OpenOverlay(Filename); //GIfTI files can be meshes or overlays - autodetect + exit; + end else if (ext = '.DAT') or (ext = '.TRK') or (ext = '.TRK.GZ') or (ext = '.FIB') or (ext = '.PDB') or (ext = '.TCK') or (ext = '.BFLOAT') or (ext = '.BFLOAT.GZ') then begin + OpenTrack(Filename); + exit; + end else if (ext = '.EDGE') then begin + OpenEdge(Filename); + exit; + end else if (ext = '.NODE') or (ext = '.NODZ') then begin + OpenNode(Filename); + exit; + end; + if (ssShift in KeyDataToShiftState(vk_Shift)) then begin + OpenOverlay(Filename); + exit; + end; + CloseOverlaysMenuClick(nil); + CloseTracksMenuClick(nil); + CloseNodesMenuClick(nil); + if not gMesh.LoadFromFile(Filename) then begin //only add successful loads to MRU + UpdateToolbar; + GLBoxRequestUpdate(nil); + exit; + end; + OpenDialog.InitialDir:= ExtractFileDir(Filename); + UpdateToolbar; + if gMesh.OpenOverlays > 0 then begin //e.g. MZ3 with both MESH and SCALAR intensity + UpdateLayerBox(true); + end; + AddMRU(Filename); + //if gMesh.isFreeSurferMesh then begin + curvname := changefileext(Filename, '.curv'); + if fileexistsF(curvname) then + OpenOverlay(curvname); + //end; + + GLBoxRequestUpdate(nil); +end; + +procedure TGLForm1.OpenMRU(Sender: TObject);//open template or MRU +begin + OpenMesh(gPrefs.PrevFilename[(sender as TMenuItem).tag]); +end; + +procedure TGLForm1.CreateMRU; +var + lPos : integer; + NewItem: TMenuItem; +begin + for lPos := 1 to knMRU do begin + NewItem := TMenuItem.Create(FileMenu); + NewItem.Caption :='';//(ParseFileName(ExtractFileName(lFName))); + NewItem.Tag := lPos; + NewItem.onclick := OpenMRU; //Lazarus + NewItem.Visible := false; + if lPos < 10 then begin + {$IFDEF Darwin} + NewItem.ShortCut := ShortCut(Word('1')+ord(lPos-1), [ssMeta]); + {$ELSE} + NewItem.ShortCut := ShortCut(Word('1')+ord(lPos-1), [ssCtrl]); + {$ENDIF} + end; + FileMenu.Add(NewItem); + end;//for each MRU +end; + +procedure TGLForm1.UpdateMRU;//most-recently-used RestrictMenu +var + lCount, lPos : integer; +begin + lCount := FileMenu.IndexOf(FileSepMenu); + for lPos := 1 to knMRU do begin + if gPrefs.PrevFilename[lPos] <> '' then begin + FileMenu.Items[lCount + lPos].Visible:= true; + FileMenu.Items[lCount + lPos].Caption:= ExtractFileName(gPrefs.PrevFilename[lPos]); + end else + FileMenu.Items[lCount + lPos].Visible:= false; + end;//for each MRU +end; //UpdateMRU + +procedure TGLForm1.AddMRU(lFilename: string); +var + i, rep: integer; + prev: TMRU; +begin + rep := 1024; + for i := 1 to knMRU do begin + prev[i] := gPrefs.PrevFilename[i]; + if prev[i] = lFilename then + rep := i; + end; + gPrefs.PrevFilename[1] := lFilename; + for i := 1 to (knMRU-1) do begin + if i >= rep then + gPrefs.PrevFilename[i+1] := prev[i+1] + else + gPrefs.PrevFilename[i+1] := prev[i]; + end; + UpdateMRU; +end; + +function GetOrigin(out scale: single): TPoint3f; +begin + result := ptf(0,0,0); + scale := 0.0; + if (length(gMesh.faces) > 0) then begin + scale := gMesh.Scale; + result := ptf(gMesh.Origin.X,gMesh.Origin.Y,gMesh.Origin.Z) ; + end; + if (length(gNode.faces) > 0) and (gNode.Scale > scale) then begin + scale := gNode.Scale; + result := ptf(gNode.Origin.X, gNode.Origin.Y, gNode.Origin.Z) ; + end; + if (gTrack.n_count > 0) and (gTrack.Scale > scale) then begin + scale := gTrack.Scale; + result := ptf(gTrack.Origin.X, gTrack.Origin.Y, gTrack.Origin.Z) ; + end; +end; + +procedure IncTrackBar (T: TTrackBar; isDepthTrack: boolean); +var + i: integer; +begin + i := (T.Max div 4); + i := ((i+T.Position) div i) * i; + if i >= T.Max then i := T.Min; + T.position := i; + if not(isDepthTrack) and (T.position <> 0) and (GLForm1.ClipTrack.position = 0) then + GLForm1.ClipTrack.Position := GLForm1.ClipTrack.Max div 2; +end; + +procedure TGLForm1.OverlayTimerStart; +begin + OverlayTimer.enabled := true; +end; + +procedure TGLForm1.ShowmessageError(s: string); +begin + if GLerror <> '' then exit; + GLerror := s; + ErrorTimer.Enabled := true; +end; + +procedure TGLForm1.SetOverlayTransparency(Sender: TObject); +begin + gMesh.OverlayTransparency := (sender as TMenuItem).tag; + OverlayTimerStart; +end; + +procedure TGLForm1.ShaderBoxResize(Sender: TObject); +const +kMinMemoSz= 32; +var + lDesiredControlSz: integer; +begin + if not ShaderBox.Visible then exit; + lDesiredControlSz := ShaderPanelHeight; + if ShaderBox.ClientHeight > (lDesiredControlSz+kMinMemoSz) then begin + //if ShaderBox.Height > (lDesiredControlSz+kMinMemoSz) then begin + //Memo1.Height := ShaderBox.Height - lDesiredControlSz; + Memo1.Height := ShaderBox.ClientHeight - lDesiredControlSz; + {$IFDEF LCLCocoa} + //Memo1.Height := ShaderBox.ClientHeight - lDesiredControlSz + 22; + + {$ENDIF} + Memo1.visible := true; + end + else + Memo1.visible := false; + ShaderBox.Refresh; +end; + +function ResetIniDefaults : boolean; +begin + if ParamCount > 0 then begin //e.g. Matlab users often launch system commands using keyboard shortcuts. These uses should use -R to force reset + result := false; + exit; + end; + //result := ( GetKeyState(VK_MENU)<> 0) or (GetKeyState(VK_LWIN) <> 0) or (GetKeyState(VK_CONTROL) <> 0) or (ssShift in KeyDataToShiftState(VK_SHIFT)) ; + {$IFDEF Windows} + result := (ssShift in KeyDataToShiftState(VK_SHIFT)) ; + {$ELSE} + result := ( GetKeyState(VK_MENU)<> 0) or (GetKeyState(VK_LWIN) <> 0) or (ssShift in KeyDataToShiftState(VK_SHIFT)) ; + {$ENDIF} +end; + +procedure TGLForm1.ShaderDropChange(Sender: TObject); +begin + SetShader(ShaderDir+pathdelim+ShaderDrop.Items[ShaderDrop.ItemIndex]+'.txt'); + ShaderBoxResize(Sender); + GLBoxRequestUpdate(Sender); +end; + +procedure TGLForm1.GLboxMouseMove(Sender: TObject; Shift: TShiftState; lX, lY: Integer); +var + X,Y:integer; +begin + if gMouseX < 0 then exit; //mouse is not down + X := lX; Y := lY; Mouse2Retina(X,Y); + if (ssShift in Shift) then begin + //Pan image + gPrefs.ScreenPan.X := gPrefs.ScreenPan.X + (1/GLBoxBackingWidth * (X - gMouseX)); + if (gPrefs.ScreenPan.X > 1) then gPrefs.ScreenPan.X := 1; + if (gPrefs.ScreenPan.X < -1) then gPrefs.ScreenPan.X := -1; + gPrefs.ScreenPan.Y := gPrefs.ScreenPan.Y - (1/GLboxBackingHeight * (Y - gMouseY)); + if (gPrefs.ScreenPan.Y > 1) then gPrefs.ScreenPan.Y := 1; + if (gPrefs.ScreenPan.Y < -1) then gPrefs.ScreenPan.Y := -1; + + end else begin + gElevation := gElevation + (Y - gMouseY); + gAzimuth := gAzimuth - (X - gMouseX); + while gAzimuth > 360 do + gAzimuth := gAzimuth -360; + while gAzimuth < -360 do + gAzimuth := gAzimuth + 360; + end; + gMouseX := X; + gMouseY := Y; + GLBox.invalidate;//GLBoxRequestUpdate(Sender); +end; + +procedure TGLForm1.GLboxMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; lX, lY: Integer); +begin + gMouseX := -1; //released +end; + +procedure TGLForm1.GLboxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; lX, lY: Integer); +var + X,Y: integer; +begin + X := lX; Y := lY; Mouse2Retina(X,Y); + gMouseX := X; + gMouseY := Y; +end; + +procedure sph2cartDeg90x(Azimuth,Elevation,R: single; var lX,lY,lZ: single); +//convert spherical AZIMUTH,ELEVATION,RANGE to Cartesion +var + n: integer; + E,Phi,Theta: single; +begin + Theta := DegToRad(Azimuth-90); + E := Elevation; + if (E > 360) or (E < -360) then begin + n := trunc(E / 360) ; + E := E - (n * 360); + end; + if ((E > 89) and (E < 91)) or (E < -269) and (E > -271) then + E := 90; + if ((E > 269) and (E < 271)) or (E < -89) and (E > -91) then + E := -90; + Phi := DegToRad(E); + lX := r * cos(Phi)*cos(Theta); + lY := r * cos(Phi)*sin(Theta); + lZ := r * sin(Phi); +end; + +procedure TGLForm1.ClipTrackChange(Sender: TObject); +var + scale: single; +begin + GetOrigin(scale); + sph2cartDeg90x(ClipAziTrack.Position,ClipElevTrack.Position,1,clipPlane.X,clipPlane.Y,clipPlane.Z); + if ClipTrack.Position < 1 then + clipPlane.X := 2 //tell GLSL that plane is disabled: normalized value must be <= 1.0 + else + clipPlane.W := ((ClipTrack.Position/ClipTrack.Max) - 0.5) * scale * 2.0; + Memo1.Lines.clear; + Memo1.Lines.Add(format('Clipping Amount %d',[ClipTrack.Position])); + Memo1.Lines.Add(format('Clipping Azimuth %d',[ClipAziTrack.Position])); + Memo1.Lines.Add(format('Clipping Elevation %d',[ClipElevTrack.Position])); + GLBox.invalidate; //show change immediately!, for delay: GLBoxRequestUpdate(Sender); +end; + +procedure TGLForm1.CloseMenuClick(Sender: TObject); +begin + gMesh.Close; + gNode.Close; + gTrack.Close; + UpdateToolbar; + GLboxRequestUpdate(Sender); +end; + +procedure TGLForm1.CloseNodesMenuClick(Sender: TObject); +begin + gNode.Close; + UpdateToolbar; + GLboxRequestUpdate(sender); +end; + +procedure TGLForm1.CloseOverlaysMenuClick(Sender: TObject); +begin + (*if (Sender <> nil) and (gMesh.OpenOverlays > 0) then begin + if isFreeSurferLUT(gMesh.Overlay[1].LUTindex) then + if MessageDlg('Curvature overlay open', 'Close the FreeSurfer CURV file?', mtConfirmation, [mbYes, mbNo],0) = mrNo then + exit; + end;*) + gMesh.CloseOverlays; + GLForm1.SetFocusedControl(nil); //GLForm1.ActiveControl := nil; + UpdateToolbar; + GLboxRequestUpdate(sender); +end; + +procedure TGLForm1.CloseTracksMenuClick(Sender: TObject); +begin + gTrack.Close; + UpdateToolbar; + GLboxRequestUpdate(sender); +end; + +procedure TGLForm1.GLboxRequestUpdate(Sender: TObject); +var + scale: single; +begin + GetOrigin(scale); + sph2cartDeg90x(LightAziTrack.position,LightElevTrack.position, scale * 2, gShader.lightPos.X, gShader.lightPos.Z,gShader.lightPos.Y); + gShader.lightPos.Z := -gShader.lightPos.Z; + gShader.lightPos.X := gShader.lightPos.X * scale; + gShader.lightPos.Y := gShader.lightPos.Y * scale; + gShader.lightPos.Z := gShader.lightPos.Z * scale; + UpdateTimer.Enabled := true; +end; + +procedure TGLForm1.SaveTrack (var lTrack: TTrack); +const + kTrackFilter = 'VTK (.vtk)|*.vtk|Camino (.Bfloat)|*.Bfloat|CaminoGZ (.Bfloat.gz)|*.Bfloat.gz|TrackVis (.trk)|*.trk|TrackVisGZ (.trk.gz)|*.trk.gz'; +var + nam: string; +begin + if (lTrack.n_count < 1) then begin + showmessage('Unable to save tracks: no tracks open (use Tracks/AddTracks)'); + exit; + end; + SaveMeshDialog.Filter := kTrackFilter; + SaveMeshDialog.Title := 'Save track file'; + nam := gPrefs.PrevTrackname; + SaveMeshDialog.InitialDir:= ExtractFileDir(nam); + if not fileexists(nam) then + nam := 'Track.vtk'; + nam := extractfilename (nam); + if gPrefs.SaveAsFormatTrack = kSaveAsTrackTrk then begin + SaveMeshDialog.DefaultExt:= '.trk'; + SaveMeshDialog.FileName := changeFileExt(nam, '.trk'); + SaveMeshDialog.FilterIndex := 4; + end else if gPrefs.SaveAsFormatTrack = kSaveAsTrackBfloat then begin + SaveMeshDialog.DefaultExt:= '.BFloat'; + SaveMeshDialog.FileName := changeFileExt(nam, '.BFloat'); + SaveMeshDialog.FilterIndex := 2; + end else begin + SaveMeshDialog.DefaultExt:= '.vtk'; + SaveMeshDialog.FileName := changeFileExt(nam, '.vtk'); + SaveMeshDialog.FilterIndex := 1; + end; + if not SaveMeshDialog.Execute then exit; + nam := UpperCase(ExtractFileExt(SaveMeshDialog.Filename)); + if (SaveMeshDialog.FilterIndex = 4) or (SaveMeshDialog.FilterIndex = 5) or (nam = '.TRK') or (nam = '.TRK.GZ') then + lTrack.SaveTrk(SaveMeshDialog.Filename) + else if (SaveMeshDialog.FilterIndex = 2) or (SaveMeshDialog.FilterIndex = 3) or (nam = '.BFLOAT') or (nam = '.BFLOAT.GZ') then + lTrack.SaveBfloat(SaveMeshDialog.Filename) + else + lTrack.SaveVtk(SaveMeshDialog.Filename); +end; + +(*86function SimplifyPref(out Tol, minLength: single): boolean; +var + PrefForm: TForm; + OkBtn: TButton; + TolLabel, minLengthLabel: TLabel; + TolEdit, minLengthEdit: TEdit; +begin + Tol := 0.5; + minLength := 10; + PrefForm:=TForm.Create(nil); + PrefForm.SetBounds(100, 100, 520, 112); + PrefForm.Caption:='Track simplification preferences'; + PrefForm.Position := poScreenCenter; + PrefForm.BorderStyle := bsDialog; + //Tolerance + TolLabel:=TLabel.create(PrefForm); + TolLabel.Caption:= 'Tolerance ("1" will allow track to deviate 1mm from original)'; + TolLabel.Left := 8; + TolLabel.Top := 12; + TolLabel.Parent:=PrefForm; + TolEdit:=TEdit.create(PrefForm); + TolEdit.Caption := FloatToStrF(Tol, ffGeneral, 8, 4); + TolEdit.Top := 12; + TolEdit.Width := 92; + TolEdit.Left := PrefForm.Width - TolEdit.Width - 8; + TolEdit.Parent:=PrefForm; + //minLength + minLengthLabel:=TLabel.create(PrefForm); + minLengthLabel.Caption:= 'Enter minimum fiber length'; + minLengthLabel.Left := 8; + minLengthLabel.Top := 42; + minLengthLabel.Parent:=PrefForm; + minLengthEdit:=TEdit.create(PrefForm); + minLengthEdit.Caption := FloatToStr(minLength); + minLengthEdit.Top := 42; + minLengthEdit.Width := 92; + minLengthEdit.Left := PrefForm.Width - minLengthEdit.Width - 8; + minLengthEdit.Parent:=PrefForm; + //OK button + OkBtn:=TButton.create(PrefForm); + OkBtn.Caption:='OK'; + OkBtn.Top := 72; + OkBtn.Width := 128; + OkBtn.Left := PrefForm.Width - OkBtn.Width - 8; + OkBtn.Parent:=PrefForm; + OkBtn.ModalResult:= mrOK; + {$IFNDEF Darwin} + ScaleDPI(PrefForm, 96); + {$ENDIF} + {$IFDEF LCLCocoa} + if gPrefs.DarkMode then SetFormDarkMode(PrefForm); + {$ENDIF} + PrefForm.ShowModal; + Tol := StrToFloatDef(TolEdit.Caption, Tol); + minLength := StrToFloatDef(minLengthEdit.Caption, minLength); + result := PrefForm.ModalResult = mrOK; + FreeAndNil(PrefForm); +end;*) +function SimplifyPref(out Tol, minLength: single): boolean; +var + PrefForm: TForm; + OkBtn: TButton; + TolLabel, minLengthLabel: TLabel; + TolEdit, minLengthEdit: TEdit; +begin + Tol := 0.5; + minLength := 10; + PrefForm:=TForm.Create(nil); + PrefForm.AutoSize := True; + PrefForm.BorderWidth := 8; + //PrefForm.SetBounds(100, 100, 520, 112); + PrefForm.Caption:='Track simplification preferences'; + PrefForm.Position := poScreenCenter; + PrefForm.BorderStyle := bsDialog; + //Tolerance + TolLabel:=TLabel.create(PrefForm); + TolLabel.Caption:= 'Tolerance ("1" will allow track to deviate 1mm from original)'; + //TolLabel.Left := 8; + //TolLabel.Top := 12; + TolLabel.AutoSize := true; + TolLabel.AnchorSide[akTop].Side := asrTop; + TolLabel.AnchorSide[akTop].Control := PrefForm; + TolLabel.BorderSpacing.Top := 6; + TolLabel.AnchorSide[akLeft].Side := asrLeft; + TolLabel.AnchorSide[akLeft].Control := PrefForm; + TolLabel.BorderSpacing.Left := 6; + TolLabel.Parent:=PrefForm; + TolEdit:=TEdit.create(PrefForm); + TolEdit.Caption := FloatToStrF(Tol, ffGeneral, 8, 4); + //TolEdit.Top := 12; + //TolEdit.Width := 92; + //TolEdit.Left := PrefForm.Width - TolEdit.Width - 8; + TolEdit.Constraints.MinWidth:= 128; + TolEdit.AutoSize := true; + TolEdit.AnchorSide[akTop].Side := asrTop; + TolEdit.AnchorSide[akTop].Control := PrefForm; + TolEdit.BorderSpacing.Top := 4; + TolEdit.AnchorSide[akLeft].Side := asrRight; + TolEdit.AnchorSide[akLeft].Control := TolLabel; + TolEdit.BorderSpacing.Left := 6; + TolEdit.Parent:=PrefForm; + //minLength + minLengthLabel:=TLabel.create(PrefForm); + minLengthLabel.Caption:= 'Enter minimum fiber length'; + //minLengthLabel.Left := 8; + //minLengthLabel.Top := 42; + minLengthLabel.AutoSize := true; + minLengthLabel.AnchorSide[akTop].Side := asrBottom; + minLengthLabel.AnchorSide[akTop].Control := TolEdit; + minLengthLabel.BorderSpacing.Top := 6; + minLengthLabel.AnchorSide[akLeft].Side := asrLeft; + minLengthLabel.AnchorSide[akLeft].Control := PrefForm; + minLengthLabel.BorderSpacing.Left := 6; + minLengthLabel.Parent:=PrefForm; + minLengthEdit:=TEdit.create(PrefForm); + minLengthEdit.Caption := FloatToStr(minLength); + //minLengthEdit.Top := 42; + //minLengthEdit.Width := 92; + //minLengthEdit.Left := PrefForm.Width - minLengthEdit.Width - 8; + minLengthEdit.Constraints.MinWidth:= 128; + minLengthEdit.AutoSize := true; + minLengthEdit.AnchorSide[akTop].Side := asrBottom; + minLengthEdit.AnchorSide[akTop].Control := TolEdit; + minLengthEdit.BorderSpacing.Top := 4; + minLengthEdit.AnchorSide[akLeft].Side := asrRight; + minLengthEdit.AnchorSide[akLeft].Control := minLengthLabel; + minLengthEdit.BorderSpacing.Left := 6; + minLengthEdit.Parent:=PrefForm; + //OK button + OkBtn:=TButton.create(PrefForm); + OkBtn.Caption:='OK'; + //OkBtn.Top := 72; + //OkBtn.Width := 128; + //OkBtn.Left := PrefForm.Width - OkBtn.Width - 8; + OkBtn.AutoSize := true; + OkBtn.AnchorSide[akTop].Side := asrBottom; + OkBtn.AnchorSide[akTop].Control := minLengthEdit; + OkBtn.BorderSpacing.Top := 6; + OkBtn.AnchorSide[akLeft].Side := asrCenter; + OkBtn.AnchorSide[akLeft].Control := PrefForm; + OkBtn.Constraints.MinWidth:= 64; + OkBtn.Parent:=PrefForm; + OkBtn.ModalResult:= mrOK; + {$IFDEF LCLCocoa} + if gPrefs.DarkMode then SetFormDarkMode(PrefForm); + {$ENDIF} + PrefForm.ShowModal; + Tol := StrToFloatDef(TolEdit.Caption, Tol); + minLength := StrToFloatDef(minLengthEdit.Caption, minLength); + result := PrefForm.ModalResult = mrOK; + FreeAndNil(PrefForm); +end; + + +procedure TGLForm1.SimplifyTracksMenuClick(Sender: TObject); +var + tol, minLength: single; + lTrack: TTrack; +begin + //showmessage(gPrefs.PrevTrackname); + (*if DefaultFormatSettings.DecimalSeparator = '.' then + s := '0.1' + else + s := '0,1'; + if not inputquery('Track simplify', 'Enter tolerance (e.g. "1" will allow track to deviate 1mm from original)', s) then exit; + if not TryStrToFloat(s, tol) then begin + showmessage('Unable convert value to a number'); + exit; + end; *) + if not SimplifyPref(Tol, minLength) then exit; + OpenDialog.Filter := kTrackFilter; + OpenDialog.Title := 'Select track file'; + if Fileexists(gPrefs.PrevTrackname) then begin + OpenDialog.InitialDir := ExtractFileDir(gPrefs.PrevTrackname); + OpenDialog.FileName:= gPrefs.PrevTrackname; + end; + if not OpenDialog.Execute then exit; + lTrack := TTrack.Create; + if lTrack.LoadFromFile(OpenDialog.FileName) then begin + gPrefs.PrevTrackname := OpenDialog.FileName; + if lTrack.SimplifyMM(Tol, minLength) then begin + SaveTrack(lTrack); + end; + end; + lTrack.Close; + lTrack.Free; +end; + +procedure TGLForm1.SaveTracksMenuClick(Sender: TObject); +begin + SaveTrack(gTrack); +end; + +procedure TGLForm1.ScalarDropChange(Sender: TObject); +var + i: integer; +begin + gTrack.scalarSelected := TrackScalarNameDrop.ItemIndex -1;//-1 for direction color, 0 for first scalar, etc. + TrackScalarLUTdrop.Enabled := (gTrack.scalarSelected >= 0); //disable if color based on direction not scalar + TrackScalarRangeBtn.Enabled := TrackScalarLUTdrop.Enabled; + i := TrackScalarLUTdrop.ItemIndex; + gTrack.scalarLUT := UpdateTransferFunction(i, false); + gTrack.isRebuildList:= true; + gnLUT := -1; //refresh colorbar + GLBoxRequestUpdate(Sender); +end; + +// 'Defuzz' is used for comparisons and to avoid propagation of 'fuzzy', +// nearly-zero values. DOUBLE calculations often result in 'fuzzy' values. +// The term 'fuzz' was adapted from the APL language. +(*FUNCTION Defuzz(CONST x: DOUBLE): DOUBLE; +const + fuzz = 1.0E-6; +BEGIN + IF ABS(x) < fuzz + THEN RESULT := 0.0 + ELSE RESULT := x +END {Defuzz}; + *) +(*86 function ScalarPref(var min, max: single; var ColorBarPrecedenceTracksNotOverlays: boolean): boolean; +var + PrefForm: TForm; + OkBtn: TButton; + minLabel, maxLabel: TLabel; + minEdit, maxEdit: TEdit; + ColorBarCheck: TCheckBox; +begin + PrefForm:=TForm.Create(nil); + PrefForm.SetBounds(100, 100, 520, 142); + PrefForm.Caption:='Track simplification preferences'; + PrefForm.Position := poScreenCenter; + PrefForm.BorderStyle := bsDialog; + //Tolerance + minLabel:=TLabel.create(PrefForm); + minLabel.Caption:= 'Minimum intensity'; + minLabel.Left := 8; + minLabel.Top := 12; + minLabel.Parent:=PrefForm; + minEdit:=TEdit.create(PrefForm); + minEdit.Caption := FloatToStrF(min, ffGeneral, 8, 4); + minEdit.Top := 12; + minEdit.Width := 92; + minEdit.Left := PrefForm.Width - minEdit.Width - 8; + minEdit.Parent:=PrefForm; + //minLength + maxLabel:=TLabel.create(PrefForm); + maxLabel.Caption:= 'Maximum intensity'; + maxLabel.Left := 8; + maxLabel.Top := 42; + maxLabel.Parent:=PrefForm; + maxEdit:=TEdit.create(PrefForm); + maxEdit.Caption := FloatToStrF(max, ffGeneral, 8, 4); + maxEdit.Top := 42; + maxEdit.Width := 92; + maxEdit.Left := PrefForm.Width - maxEdit.Width - 8; + maxEdit.Parent:=PrefForm; + //Precedence ColorBarPrecedenceTracksNotOverlays + ColorBarCheck:=TCheckBox.create(PrefForm); + ColorBarCheck.Checked := ColorBarPrecedenceTracksNotOverlays; + ColorBarCheck.Caption:='Colorbar for tracks, even if overlay loaded'; + ColorBarCheck.Left := 8; + ColorBarCheck.Top := 72; + ColorBarCheck.Parent:=PrefForm; + //OK button + OkBtn:=TButton.create(PrefForm); + OkBtn.Caption:='OK'; + OkBtn.Top := 102; + OkBtn.Width := 128; + OkBtn.Left := PrefForm.Width - OkBtn.Width - 8; + OkBtn.Parent:=PrefForm; + OkBtn.ModalResult:= mrOK; + {$IFNDEF Darwin} ScaleDPI(PrefForm, 96);{$ENDIF} + {$IFDEF LCLCocoa} + if gPrefs.DarkMode then SetFormDarkMode(PrefForm); + {$ENDIF} + PrefForm.ShowModal; + min := StrToFloatDef(minEdit.Caption, min); + max := StrToFloatDef(maxEdit.Caption, max); + ColorBarPrecedenceTracksNotOverlays := ColorBarCheck.Checked; + result := PrefForm.ModalResult = mrOK; + FreeAndNil(PrefForm); + end;*) +function ScalarPref(var min, max: single; var ColorBarPrecedenceTracksNotOverlays: boolean): boolean; +var + PrefForm: TForm; + OkBtn: TButton; + minLabel, maxLabel: TLabel; + minEdit, maxEdit: TEdit; + ColorBarCheck: TCheckBox; +begin + PrefForm:=TForm.Create(nil); + //PrefForm.SetBounds(100, 100, 520, 142); + PrefForm.AutoSize := True; + PrefForm.BorderWidth := 8; + PrefForm.Caption:='Track simplification preferences'; + PrefForm.Position := poScreenCenter; + PrefForm.BorderStyle := bsDialog; + //Tolerance + minLabel:=TLabel.create(PrefForm); + minLabel.Caption:= 'Minimum intensity'; + //minLabel.Left := 8; + //minLabel.Top := 12; + minLabel.AutoSize := true; + minLabel.AnchorSide[akTop].Side := asrTop; + minLabel.AnchorSide[akTop].Control := PrefForm; + minLabel.BorderSpacing.Top := 6; + minLabel.AnchorSide[akLeft].Side := asrLeft; + minLabel.AnchorSide[akLeft].Control := PrefForm; + minLabel.BorderSpacing.Left := 6; + minLabel.Parent:=PrefForm; + minEdit:=TEdit.create(PrefForm); + minEdit.Caption := FloatToStrF(min, ffGeneral, 8, 4); + //minEdit.Top := 12; + //minEdit.Width := 92; + minEdit.Constraints.MinWidth:= 128; + minEdit.AutoSize := true; + minEdit.AnchorSide[akTop].Side := asrTop; + minEdit.AnchorSide[akTop].Control := PrefForm; + minEdit.BorderSpacing.Top := 4; + minEdit.AnchorSide[akLeft].Side := asrRight; + minEdit.AnchorSide[akLeft].Control := minLabel; + minEdit.BorderSpacing.Left := 6; + minEdit.Left := PrefForm.Width - minEdit.Width - 8; + minEdit.Parent:=PrefForm; + //minLength + maxLabel:=TLabel.create(PrefForm); + maxLabel.Caption:= 'Maximum intensity'; + //maxLabel.Left := 8; + //maxLabel.Top := 42; + maxLabel.AutoSize := true; + maxLabel.AnchorSide[akTop].Side := asrBottom; + maxLabel.AnchorSide[akTop].Control := minEdit; + maxLabel.BorderSpacing.Top := 6; + maxLabel.AnchorSide[akLeft].Side := asrLeft; + maxLabel.AnchorSide[akLeft].Control := PrefForm; + maxLabel.BorderSpacing.Left := 6; + + maxLabel.Parent:=PrefForm; + maxEdit:=TEdit.create(PrefForm); + maxEdit.Caption := FloatToStrF(max, ffGeneral, 8, 4); + //maxEdit.Top := 42; + //maxEdit.Width := 92; + //maxEdit.Left := PrefForm.Width - maxEdit.Width - 8; + maxEdit.Constraints.MinWidth:= 128; + maxEdit.AutoSize := true; + maxEdit.AnchorSide[akTop].Side := asrBottom; + maxEdit.AnchorSide[akTop].Control := minEdit; + maxEdit.BorderSpacing.Top := 4; + maxEdit.AnchorSide[akLeft].Side := asrRight; + maxEdit.AnchorSide[akLeft].Control := maxLabel; + maxEdit.BorderSpacing.Left := 6; + maxEdit.Parent:=PrefForm; + //Precedence ColorBarPrecedenceTracksNotOverlays + ColorBarCheck:=TCheckBox.create(PrefForm); + ColorBarCheck.Checked := ColorBarPrecedenceTracksNotOverlays; + ColorBarCheck.Caption:='Colorbar for tracks, even if overlay loaded'; + //ColorBarCheck.Left := 8; + //ColorBarCheck.Top := 72; + ColorBarCheck.AutoSize := true; + ColorBarCheck.AnchorSide[akTop].Side := asrBottom; + ColorBarCheck.AnchorSide[akTop].Control := maxEdit; + ColorBarCheck.BorderSpacing.Top := 6; + ColorBarCheck.AnchorSide[akLeft].Side := asrLeft; + ColorBarCheck.AnchorSide[akLeft].Control := PrefForm; + ColorBarCheck.BorderSpacing.Left := 6; + + ColorBarCheck.Parent:=PrefForm; + //OK button + OkBtn:=TButton.create(PrefForm); + OkBtn.Caption:='OK'; + //OkBtn.Top := 102; + //OkBtn.Width := 128; + //OkBtn.Left := PrefForm.Width - OkBtn.Width - 8; + OkBtn.AutoSize := true; + OkBtn.AnchorSide[akTop].Side := asrBottom; + OkBtn.AnchorSide[akTop].Control := ColorBarCheck; + OkBtn.BorderSpacing.Top := 6; + OkBtn.AnchorSide[akLeft].Side := asrCenter; + OkBtn.AnchorSide[akLeft].Control := PrefForm; + OkBtn.Constraints.MinWidth:= 64; + + OkBtn.Parent:=PrefForm; + OkBtn.ModalResult:= mrOK; + {$IFDEF LCLCocoa} + if gPrefs.DarkMode then SetFormDarkMode(PrefForm); + {$ENDIF} + PrefForm.ShowModal; + min := StrToFloatDef(minEdit.Caption, min); + max := StrToFloatDef(maxEdit.Caption, max); + ColorBarPrecedenceTracksNotOverlays := ColorBarCheck.Checked; + result := PrefForm.ModalResult = mrOK; + FreeAndNil(PrefForm); + end; + + +procedure TGLForm1.TrackScalarRangeBtnClick(Sender: TObject); +begin + if (gTrack.scalarSelected < 0) or (gTrack.scalarSelected >= length(gTrack.scalars)) then exit; + ScalarPref(gTrack.scalars[gTrack.scalarSelected].mnView, gTrack.scalars[gTrack.scalarSelected].mxView, gPrefs.ColorBarPrecedenceTracksNotOverlays); + gTrack.isRebuildList:= true; + gnLUT := -1; //refresh colorbar + GLBoxRequestUpdate(Sender); +end; + +procedure TGLForm1.SurfaceAppearanceChange(Sender: TObject); +begin + Memo1.Lines.Clear; + GLForm1.Memo1.Lines.Add(gShader.note); + if OcclusionTrack.Visible then begin + Memo1.Lines.Add(format('Ambient Occlusion %d',[OcclusionTrack.position])); + Memo1.Lines.Add(format('XRay Background %d Overlay %d',[meshAlphaTrack.position, MeshBlendTrack.position])); + end; + Memo1.Lines.Add(format('Light Elevation %d Azimuth %d',[LightElevTrack.position, LightAziTrack.position])); + ReportUniformChange(Sender); + GLboxRequestUpdate(Sender); //++ 2018 : required for dynamic light position change + //GLbox.Invalidate; //-- 2017 + +end; + +function IsDigit (letter : char) : boolean; +begin + result := ((letter <= '9') and (letter >= '0')); +end; + +function HasDigit (var lS: string): boolean; +//do not attempt to convert '-', '.', or '-.' as a number... +var + lI,lLen: integer; +begin + result := false; + lLen := length (lS); + if lLen < 1 then + exit; + for lI := 1 to lLen do begin + if lS[lI] in ['0'..'9'] then begin + result := true; + exit; + end; + end; +end; + +procedure TGLForm1.OverlayVisible(lOverlay: integer; lVisible: integer); +begin + if (lOverlay > gMesh.OpenOverlays) or (lOverlay < 1) then + exit; + if (lVisible < kLUTinvisible) or (lVisible > kLUTopaque) then + gMesh.Overlay[lOverlay].LUTvisible := kLUTopaque + else + gMesh.Overlay[lOverlay].LUTvisible := lVisible; + UpdateLayerBox(false); +end; + +procedure TGLForm1.OverlayInvert(lOverlay: integer; lInvert: boolean); +begin + if (lOverlay > gMesh.OpenOverlays) or (lOverlay < 1) then + exit; + gMesh.Overlay[lOverlay].LUTinvert := lInvert; + UpdateLayerBox(false); + gMesh.overlay[lOverlay].LUT := UpdateTransferFunction (gMesh.Overlay[lOverlay].LUTindex, gMesh.Overlay[lOverlay].LUTinvert); + OverlayTimerStart; +end; + +procedure TGLForm1.UpdateFont(initialSetup: boolean); +var + p,f: string; +begin + p := (ClutDir+pathdelim+gPrefs.FontName+'.png'); + f := (ClutDir+pathdelim+gPrefs.FontName+'.json'); + if (gPrefs.FontName = '') or (not fileexistsf(p)) or (not fileexistsf(f)) then begin + gPrefs.FontName := ''; + p := ''; + end; + if initialSetup then begin + gClrbar:= TGLClrbar.Create(p, GLBox); + if (gPrefs.ColorbarSize < 0.01) or (gPrefs.ColorbarSize > 0.3) then + gPrefs.ColorbarSize := gClrbar.SizeFraction; + gClrbar.SizeFraction := gPrefs.ColorbarSize; + end else begin + gClrBar.ChangeFontName(p, GLBox); + end; +end; + +{$IFDEF FPC} +function latestGitRelease(url: string): string; +//Returns string for latest release (error will return empty string) +//example +// latestGitRelease('https://api.github.com/repos/rordenlab/dcm2niix/releases/latest'); +//will return +// "v1.0.20171204" +const + key = '"tag_name":"'; +var + s, e: integer; + cli: TFPHTTPClient; //uses fphttpclient +begin + result := ''; + cli := TFPHTTPClient.Create(nil); + cli.AddHeader('User-Agent','Mozilla/5.0 (compatible; fpweb)'); + try + try + result := Cli.Get(url); + except + result := ''; + end; + finally + cli.free + end; + if length(result) < 1 then exit; + s := posex(key, result); + if s < 1 then begin + result := ''; + exit; + end; + s := s+length(key); + e:= posex('"', result, s); + if e < 1 then begin + result := ''; + exit; + end; + result := copy(result, s, e-s); +end; + +procedure TGLForm1.CheckForUpdates(Sender: TObject); +const + kBase = '/neurolabusc/surf-ice/releases/latest'; + kUrl = 'https://github.com' + kBase; + kApi = 'https://api.github.com/repos' + kBase; +var + s: string; + latest, current: integer; +begin + s := latestGitRelease(kApi); + if length(s) < 8 then begin //last 8 digits are date: v.1.0.20170101 + showmessage('Unable to detect latest version: are you connected to the web and do you have libssl installed? '+kApi); + exit; + end; + if CompareText(s, kVers) = 0 then begin + showmessage('You are running the latest release '+kVers); + exit; + end; + latest := strtointdef(RightStr(s,8),0); + current := strtointdef(RightStr(kVers,8),0); + if current > latest then + showmessage('You are running a beta release '+kVers+', the latest stable release is '+s) + else + showmessage('You are running an old release '+kVers+', the latest stable release is '+s+'. Visit '+kUrl ); +end; +{$ELSE} +procedure TGLForm1.CheckForUpdates(Sender: TObject); +begin + //not used in Windows +end; +{$ENDIF} + +procedure TGLForm1.PrefMenuClick(Sender: TObject); +var + PrefForm: TForm; + OkBtn, AdvancedBtn: TButton; + {$IFDEF LCLCocoa} DarkModeCheck, RetinaCheck,{$ENDIF} + BlackDefaultBackgroundCheck, BitmapAlphaCheck, SmoothVoxelwiseDataCheck, TracksAreTubesCheck: TCheckBox; + bmpEdit: TEdit; + s: string; + Quality: integer; + searchRec: TSearchRec; + FontCombo, ZDimIsUpCombo, QualityCombo, SaveAsFormatCombo: TComboBox; + bmpLabel, QualityLabel: TLabel; + isFontChanged, isAdvancedPrefs {$IFDEF LCLCocoa}, isDarkModeChanged, isRetinaChanged {$ENDIF} : boolean; +begin + PrefForm:=TForm.Create(nil); + //PrefForm.SetBounds(100, 100, 520, 422); + PrefForm.AutoSize := True; + PrefForm.BorderWidth := 8; + PrefForm.Caption:='Preferences'; + PrefForm.Position := poScreenCenter; + PrefForm.BorderStyle := bsDialog; + //Bitmap Alpha + BitmapAlphaCheck:=TCheckBox.create(PrefForm); + BitmapAlphaCheck.Checked := gPrefs.ScreenCaptureTransparentBackground; + BitmapAlphaCheck.Caption:='Background transparent in bitmaps'; + //BitmapAlphaCheck.Left := 8; + //BitmapAlphaCheck.Top := 8; + BitmapAlphaCheck.AutoSize := true; + BitmapAlphaCheck.AnchorSide[akTop].Side := asrTop; + BitmapAlphaCheck.AnchorSide[akTop].Control := PrefForm; + BitmapAlphaCheck.BorderSpacing.Top := 6; + BitmapAlphaCheck.AnchorSide[akLeft].Side := asrLeft; + BitmapAlphaCheck.AnchorSide[akLeft].Control := PrefForm; + BitmapAlphaCheck.BorderSpacing.Left := 6; + BitmapAlphaCheck.Parent:=PrefForm; + //SmoothVoxelwiseData + SmoothVoxelwiseDataCheck:=TCheckBox.create(PrefForm); + SmoothVoxelwiseDataCheck.Checked := gPrefs.SmoothVoxelwiseData; + SmoothVoxelwiseDataCheck.Caption:='Smooth voxel-based images'; + //SmoothVoxelwiseDataCheck.Left := 8; + //SmoothVoxelwiseDataCheck.Top := 38; + SmoothVoxelwiseDataCheck.AutoSize := true; + SmoothVoxelwiseDataCheck.AnchorSide[akTop].Side := asrBottom; + SmoothVoxelwiseDataCheck.AnchorSide[akTop].Control := BitmapAlphaCheck; + SmoothVoxelwiseDataCheck.BorderSpacing.Top := 6; + SmoothVoxelwiseDataCheck.AnchorSide[akLeft].Side := asrLeft; + SmoothVoxelwiseDataCheck.AnchorSide[akLeft].Control := PrefForm; + SmoothVoxelwiseDataCheck.BorderSpacing.Left := 6; + SmoothVoxelwiseDataCheck.Parent:=PrefForm; + //TracksAreTubes + TracksAreTubesCheck:=TCheckBox.create(PrefForm); + TracksAreTubesCheck.Checked := gPrefs.TracksAreTubes; + TracksAreTubesCheck.Caption:='Better (but slower) tracks'; + //TracksAreTubesCheck.Left := 8; + //TracksAreTubesCheck.Top := 68; + TracksAreTubesCheck.AutoSize := true; + TracksAreTubesCheck.AnchorSide[akTop].Side := asrBottom; + TracksAreTubesCheck.AnchorSide[akTop].Control := SmoothVoxelwiseDataCheck; + TracksAreTubesCheck.BorderSpacing.Top := 6; + TracksAreTubesCheck.AnchorSide[akLeft].Side := asrLeft; + TracksAreTubesCheck.AnchorSide[akLeft].Control := PrefForm; + TracksAreTubesCheck.BorderSpacing.Left := 6; + TracksAreTubesCheck.Parent:=PrefForm; + //ShaderForBackgroundOnly + (*ShaderForBackgroundOnlyCombo := TComboBox.create(PrefForm); + ShaderForBackgroundOnlyCombo.Items.Add('Tracks, nodes and overlays use fixed shader'); + ShaderForBackgroundOnlyCombo.Items.Add('Tracks, nodes and overlays use background shader'); + if (gPrefs.ShaderForBackgroundOnly) then + ShaderForBackgroundOnlyCombo.ItemIndex := 0 + else + ShaderForBackgroundOnlyCombo.ItemIndex := 1; + ShaderForBackgroundOnlyCombo.Left := 8; + ShaderForBackgroundOnlyCombo.Top := 98; + ShaderForBackgroundOnlyCombo.Width := PrefForm.Width -16; + ShaderForBackgroundOnlyCombo.Style := csDropDownList; + ShaderForBackgroundOnlyCombo.Parent:=PrefForm; *) + //ZDimIsUp + ZDimIsUpCombo := TComboBox.create(PrefForm); + ZDimIsUpCombo.Items.Add('Z-dimension is up (Neuroimaging/Talairach)'); + ZDimIsUpCombo.Items.Add('Y-dimension is up (Blender/OpenGL)'); + if (gPrefs.ZDimIsUp) then + ZDimIsUpCombo.ItemIndex := 0 + else + ZDimIsUpCombo.ItemIndex := 1; + //ZDimIsUpCombo.Left := 8; + //ZDimIsUpCombo.Top := 128; + //ZDimIsUpCombo.Width := PrefForm.Width -16; + ZDimIsUpCombo.Style := csDropDownList; + ZDimIsUpCombo.Constraints.MinWidth:= 320; + ZDimIsUpCombo.AutoSize := true; + ZDimIsUpCombo.AnchorSide[akTop].Side := asrBottom; + ZDimIsUpCombo.AnchorSide[akTop].Control := TracksAreTubesCheck; + ZDimIsUpCombo.BorderSpacing.Top := 6; + ZDimIsUpCombo.AnchorSide[akLeft].Side := asrLeft; + ZDimIsUpCombo.AnchorSide[akLeft].Control := PrefForm; + ZDimIsUpCombo.BorderSpacing.Left := 6; + ZDimIsUpCombo.Parent:=PrefForm; + //SinglePass + (*MultiPassRenderingCheck:=TCheckBox.create(PrefForm); + MultiPassRenderingCheck.Checked := gPrefs.MultiPassRendering; + MultiPassRenderingCheck.Caption:='Better rendering (slower)'; + MultiPassRenderingCheck.Left := 8; + MultiPassRenderingCheck.Top := 128; + MultiPassRenderingCheck.Parent:=PrefForm; *) + //Smooth + Quality := gPrefs.RenderQuality; + if (Quality = kRenderBetter) and (gPrefs.OcclusionAmount > 0) then + Quality := Quality + 1; //0=Poor, 1=Better, 2=Better+Occlusion + QualityCombo:=TComboBox.create(PrefForm); + //QualityCombo.Left := 8; + //QualityCombo.Top := 158; + //QualityCombo.Width := PrefForm.Width -16; + QualityCombo.Items.Add('Quality: Poor (old hardware)'); + QualityCombo.Items.Add('Quality: Fair (no ambient occlusion by default)'); + QualityCombo.Items.Add('Quality: Better'); + //QualityCombo.Items.Add('Quality: Best'); + QualityCombo.ItemIndex:= Quality; + QualityCombo.Style := csDropDownList; + QualityCombo.Constraints.MinWidth:= 320; + QualityCombo.AutoSize := true; + QualityCombo.AnchorSide[akTop].Side := asrBottom; + QualityCombo.AnchorSide[akTop].Control := ZDimIsUpCombo; + QualityCombo.BorderSpacing.Top := 6; + QualityCombo.AnchorSide[akLeft].Side := asrLeft; + QualityCombo.AnchorSide[akLeft].Control := PrefForm; + QualityCombo.BorderSpacing.Left := 6; + QualityCombo.Parent:=PrefForm; + //gPrefs.SupportBetterRenderQuality := true; + if not gPrefs.SupportBetterRenderQuality then begin + QualityCombo.Visible := false; + QualityLabel:=TLabel.create(PrefForm); + //QualityLabel.Left := 8; + //QualityLabel.Top := 158; + //QualityLabel.Width := PrefForm.Width -16; + QualityLabel.AutoSize := true; + QualityLabel.AnchorSide[akTop].Side := asrBottom; + QualityLabel.AnchorSide[akTop].Control := ZDimIsUpCombo; + QualityLabel.BorderSpacing.Top := 6; + QualityLabel.AnchorSide[akLeft].Side := asrLeft; + QualityLabel.AnchorSide[akLeft].Control := PrefForm; + QualityLabel.BorderSpacing.Left := 6; + QualityLabel.Caption := 'NOTE: Hardware only supports poor rendering.'; + QualityLabel.Parent:=PrefForm; + end; + //SingleShader + bmpLabel:=TLabel.create(PrefForm); + //bmpLabel.Left := 8; + //bmpLabel.Top := 188; + //bmpLabel.Width := PrefForm.Width - 86; + bmpLabel.Caption := 'Bitmap zoom (large values create huge images)'; + bmpLabel.AutoSize := true; + bmpLabel.AnchorSide[akTop].Side := asrBottom; + if not gPrefs.SupportBetterRenderQuality then + bmpLabel.AnchorSide[akTop].Control := QualityLabel + else + bmpLabel.AnchorSide[akTop].Control := QualityCombo; + bmpLabel.BorderSpacing.Top := 6; + bmpLabel.AnchorSide[akLeft].Side := asrLeft; + bmpLabel.AnchorSide[akLeft].Control := PrefForm; + bmpLabel.BorderSpacing.Left := 6; + bmpLabel.Parent:=PrefForm; + //bmp edit + bmpEdit := TEdit.Create(PrefForm); + //bmpEdit.Left := PrefForm.Width - 76; + //bmpEdit.Top := 188; + //bmpEdit.Width := 60; + bmpEdit.Text := inttostr(gPrefs.ScreenCaptureZoom); + bmpEdit.Constraints.MinWidth:= 128; + bmpEdit.AutoSize := true; + bmpEdit.AnchorSide[akTop].Side := asrCenter; + bmpEdit.AnchorSide[akTop].Control := bmpLabel; + bmpEdit.BorderSpacing.Top := 4; + bmpEdit.AnchorSide[akLeft].Side := asrRight; + bmpEdit.AnchorSide[akLeft].Control := bmpLabel; + bmpEdit.BorderSpacing.Left := 6; + bmpEdit.Parent:=PrefForm; + //Select Font + FontCombo:=TComboBox.create(PrefForm); + //FontCombo.Left := 8; + //FontCombo.Top := 218; + //FontCombo.Width := PrefForm.Width -16; + FontCombo.Items.Add('Default Font'); + FontCombo.ItemIndex:= 0; + if FindFirst(ClutDir+pathdelim+'*.json', faAnyFile, searchRec) = 0 then begin + repeat + s :=ParseFileName(ExtractFileName(searchRec.Name)); + if (length(s) > 1) and (s[1] <> '.') and (fileexists(ClutDir+pathdelim+s+'.png')) then begin + FontCombo.Items.Add(s); + if (s = gPrefs.FontName) then + FontCombo.ItemIndex := FontCombo.Items.Count-1; + end; + until (FindNext(searchRec) <> 0); + end; //find fonts + FindClose(searchRec); + FontCombo.Style := csDropDownList; + FontCombo.AutoSize := true; + FontCombo.Constraints.MinWidth:= 320; + FontCombo.AnchorSide[akTop].Side := asrBottom; + FontCombo.AnchorSide[akTop].Control := bmpEdit; + FontCombo.BorderSpacing.Top := 6; + FontCombo.AnchorSide[akLeft].Side := asrLeft; + FontCombo.AnchorSide[akLeft].Control := PrefForm; + FontCombo.BorderSpacing.Left := 6; + FontCombo.Parent:=PrefForm; + //SaveAsFormatCombo + SaveAsFormatCombo:=TComboBox.create(PrefForm); + //SaveAsFormatCombo.Left := 8; + //SaveAsFormatCombo.Top := 248; + //SaveAsFormatCombo.Width := PrefForm.Width -16; + SaveAsFormatCombo.Items.Add('Save mesh as: OBJ (Widely supported)'); + SaveAsFormatCombo.Items.Add('Save mesh as: GIfTI (Neuroimaging)'); + SaveAsFormatCombo.Items.Add('MZ3 (Small and fast)'); + SaveAsFormatCombo.Items.Add('PLY (Widely supported)'); + //QualityCombo.Items.Add('Quality: Best'); + SaveAsFormatCombo.ItemIndex:= gPrefs.SaveAsFormat; + SaveAsFormatCombo.Constraints.MinWidth:= 320; + SaveAsFormatCombo.Style := csDropDownList; + SaveAsFormatCombo.AutoSize := true; + SaveAsFormatCombo.AnchorSide[akTop].Side := asrBottom; + SaveAsFormatCombo.AnchorSide[akTop].Control := FontCombo; + SaveAsFormatCombo.BorderSpacing.Top := 6; + SaveAsFormatCombo.AnchorSide[akLeft].Side := asrLeft; + SaveAsFormatCombo.AnchorSide[akLeft].Control := PrefForm; + SaveAsFormatCombo.BorderSpacing.Left := 6; + SaveAsFormatCombo.Parent:=PrefForm; + // + BlackDefaultBackgroundCheck:=TCheckBox.create(PrefForm); + BlackDefaultBackgroundCheck.Checked := gPrefs.BlackDefaultBackground; + BlackDefaultBackgroundCheck.Caption:='Black Default Background'; + //BlackDefaultBackgroundCheck.Left := 8; + //BlackDefaultBackgroundCheck.Top := 278; + BlackDefaultBackgroundCheck.AutoSize := true; + BlackDefaultBackgroundCheck.AnchorSide[akTop].Side := asrBottom; + BlackDefaultBackgroundCheck.AnchorSide[akTop].Control := SaveAsFormatCombo; + BlackDefaultBackgroundCheck.BorderSpacing.Top := 6; + BlackDefaultBackgroundCheck.AnchorSide[akLeft].Side := asrLeft; + BlackDefaultBackgroundCheck.AnchorSide[akLeft].Control := PrefForm; + BlackDefaultBackgroundCheck.BorderSpacing.Left := 6; + + BlackDefaultBackgroundCheck.Parent:=PrefForm; + {$IFDEF LCLCocoa} + RetinaCheck:=TCheckBox.create(PrefForm); + RetinaCheck.Checked := gPrefs.RetinaDisplay; + RetinaCheck.Caption:='Retina display (better but slower)'; + //RetinaCheck.Left := 8; + //RetinaCheck.Top := 308; + RetinaCheck.AutoSize := true; + RetinaCheck.AnchorSide[akTop].Side := asrBottom; + RetinaCheck.AnchorSide[akTop].Control := BlackDefaultBackgroundCheck; + RetinaCheck.BorderSpacing.Top := 6; + RetinaCheck.AnchorSide[akLeft].Side := asrLeft; + RetinaCheck.AnchorSide[akLeft].Control := PrefForm; + RetinaCheck.BorderSpacing.Left := 6; + RetinaCheck.Parent:=PrefForm; + //DarkMode + DarkModeCheck:=TCheckBox.create(PrefForm); + DarkModeCheck.Checked := gPrefs.DarkMode; + DarkModeCheck.Caption:='Dark Mode'; + //DarkModeCheck.Left := 8; + //DarkModeCheck.Top := 338; + DarkModeCheck.AutoSize := true; + DarkModeCheck.AnchorSide[akTop].Side := asrBottom; + DarkModeCheck.AnchorSide[akTop].Control := RetinaCheck; + DarkModeCheck.BorderSpacing.Top := 6; + DarkModeCheck.AnchorSide[akLeft].Side := asrLeft; + DarkModeCheck.AnchorSide[akLeft].Control := PrefForm; + DarkModeCheck.BorderSpacing.Left := 6; + DarkModeCheck.Parent:=PrefForm; + if gPrefs.DarkMode then SetFormDarkMode(PrefForm); + {$ENDIF} + AdvancedBtn:=TButton.create(PrefForm); + AdvancedBtn.Caption:='Advanced'; + //AdvancedBtn.Left := PrefForm.Width - 256; + //AdvancedBtn.Width:= 100; + //AdvancedBtn.Top := 378; + AdvancedBtn.Constraints.MinWidth:= 128; + AdvancedBtn.AutoSize := true; + AdvancedBtn.AnchorSide[akTop].Side := asrBottom; + {$IFDEF LCLCocoa} + AdvancedBtn.AnchorSide[akTop].Control := DarkModeCheck; + {$ELSE} + AdvancedBtn.AnchorSide[akTop].Control := BlackDefaultBackgroundCheck; + {$ENDIF} + AdvancedBtn.BorderSpacing.Top := 4; + AdvancedBtn.AnchorSide[akLeft].Side := asrLeft; + AdvancedBtn.AnchorSide[akLeft].Control := PrefForm; + AdvancedBtn.BorderSpacing.Left := 120; + AdvancedBtn.Parent:=PrefForm; + AdvancedBtn.ModalResult:= mrYesToAll; + + //OK button + OkBtn:=TButton.create(PrefForm); + OkBtn.Caption:='OK'; + //OkBtn.Left := PrefForm.Width - 128; + //OkBtn.Width:= 100; + //OkBtn.Top := 378; + OkBtn.AutoSize := true; + OkBtn.Constraints.MinWidth:= 128; + OkBtn.AnchorSide[akTop].Side := asrTop; + OkBtn.AnchorSide[akTop].Control := AdvancedBtn; + OkBtn.BorderSpacing.Top := 0; + OkBtn.AnchorSide[akLeft].Side := asrRight; + OkBtn.AnchorSide[akLeft].Control := AdvancedBtn; + OkBtn.BorderSpacing.Left := 60; + OkBtn.Parent:=PrefForm; + OkBtn.ModalResult:= mrOK; + + + PrefForm.ShowModal; + if (PrefForm.ModalResult <> mrOK) and (PrefForm.ModalResult <> mrYesToAll) then begin + FreeAndNil(PrefForm); + exit; //if user closes window with out pressing "OK" + end; + {$IFDEF LCLCocoa} + isRetinaChanged := gPrefs.RetinaDisplay <> RetinaCheck.Checked; + gPrefs.RetinaDisplay := RetinaCheck.Checked; + isDarkModeChanged := gPrefs.DarkMode <> DarkModeCheck.Checked; + gPrefs.DarkMode := DarkModeCheck.Checked; + {$ENDIF} + s := ''; + if FontCombo.ItemIndex > 0 then + s := FontCombo.Items[FontCombo.ItemIndex]; + isFontChanged := (s <> gPrefs.FontName); + gPrefs.FontName := s; + gPrefs.ScreenCaptureTransparentBackground := BitmapAlphaCheck.Checked; + gPrefs.SmoothVoxelwiseData := SmoothVoxelwiseDataCheck.Checked; + gPrefs.BlackDefaultBackground := BlackDefaultBackgroundCheck.Checked; + gPrefs.ScreenCaptureZoom:= strtointdef(bmpEdit.Text,1); + (*if ShaderForBackgroundOnlyCombo.ItemIndex = 1 then + gPrefs.ShaderForBackgroundOnly := false + else + gPrefs.ShaderForBackgroundOnly := true; *) + if ZDimIsUpCombo.ItemIndex = 1 then + gPrefs.ZDimIsUp := false + else + gPrefs.ZDimIsUp := true; + gMesh.isZDimIsUp := gPrefs.ZDimIsUp; + gNode.isZDimIsUp := gPrefs.ZDimIsUp; + if isFontChanged then + GLForm1.UpdateFont(false); + //gPrefs.SaveAsFormat := SaveAsCombo.ItemIndex; + gPrefs.SaveAsFormat := SaveAsFormatCombo.ItemIndex; + if (QualityCombo.ItemIndex) <> Quality then begin + if QualityCombo.ItemIndex = 0 then + gPrefs.RenderQuality := kRenderPoor + else + gPrefs.RenderQuality := kRenderBetter; + if QualityCombo.ItemIndex = 2 then //only for best quality + gPrefs.OcclusionAmount := 25 + else + gPrefs.OcclusionAmount := 0; + MultiPassRenderingToolsUpdate; + GLForm1.ResetMenuClick(nil); + GLBoxRequestUpdate(Sender); + end; + if (gPrefs.TracksAreTubes <> TracksAreTubesCheck.Checked) then begin + gPrefs.TracksAreTubes := TracksAreTubesCheck.Checked; + gTrack.isTubes:= gPrefs.TracksAreTubes; + gTrack.isRebuildList:= true; + + end; + isAdvancedPrefs := (PrefForm.ModalResult = mrYesToAll); + FreeAndNil(PrefForm); + {$IFDEF LCLCocoa} + if isRetinaChanged then + SetRetina;//GLBox.WantsBestResolutionOpenGLSurface:=gPrefs.RetinaDisplay; + if isDarkModeChanged then + SetDarkMode; + {$ENDIF} + GLBoxRequestUpdate(Sender); + if isAdvancedPrefs then + Quit2TextEditor; +end; // PrefMenuClick() +procedure TGLForm1.QuickColorClick(Sender: TObject); +begin + case (sender as TMenuItem).tag of + 1: gPrefs.ObjColor:= RGBToColor(210,148,148); //red + 2: gPrefs.ObjColor:= RGBToColor(128,162,128); //green + 3: gPrefs.ObjColor:= RGBToColor(167,171,253); //blue + 4: gPrefs.ObjColor:= RGBToColor(226,171,0); //gold + else gPrefs.ObjColor:= RGBToColor(192,192,192); //gray + end; + //{$IFDEF COREGL} + gMesh.isRebuildList := true; + //{$ENDIF} + GLBoxRequestUpdate(Sender); +end; + +procedure TGLForm1.ResetMenuClick(Sender: TObject); +begin + if gPrefs.BlackDefaultBackground then + gPrefs.BackColor := RGBToColor(0,0,0) + else + gPrefs.BackColor := RGBToColor(255,255,255); + //gPrefs.Colorbar := true; + TransBlackClrbarMenu.Checked:=true; + gPrefs.ScreenPan.X := 0; gPrefs.ScreenPan.Y := 0; gPrefs.ScreenPan.Z := 0; + gDistance := 1; + gElevation := 20; + gAzimuth := 250; + Transparency0.Click; + gPrefs.ShaderForBackgroundOnly:= true; + ShaderForBackgroundOnlyCheck.Checked := gPrefs.ShaderForBackgroundOnly; + gPrefs.isFlipMeshOverlay:= false; + gPrefs.AdditiveOverlay:= false; + gMesh.isAdditiveOverlay:= gPrefs.AdditiveOverlay; + setlength(gMesh.atlasHideFilter,0); + setlength(gMesh.atlasTransparentFilter,0); + AdditiveOverlayMenu.Checked:= gPrefs.AdditiveOverlay; + gPrefs.ObjColor:= RGBToColor(192,192,192); + //set nodes/edges + NodeScaleTrack.Position := 20; + EdgeScaleTrack.Position:= 37; + //set tracks + TrackLengthTrack.Position:= 20; + TrackWidthTrack.Position := 2; ; //12 for 666Demo + TrackDitherTrack.Position := 3; + //mesh colors + MeshSaturationTrack.Position := 100; + MeshTransparencyTrack.Position:= 100; + //clipping + ClipTrack.Position := 0; + ClipAziTrack.Position := 180; + ClipElevTrack.Position := 0; + //set shaders + OcclusionTrack.Position := gPrefs.OcclusionAmount; + MeshAlphaTrack.Position := 100; + MeshBlendTrack.Position:= 0; + LightElevTrack.Position:= 25; + LightAziTrack.Position := 0; + ShaderDrop.ItemIndex:= 0; + ShaderDropChange(Sender); +end; + +procedure TGLForm1.RestrictEdgeMenuClick(Sender: TObject); +begin + gNode.nodePrefs.isNoPosEdge:=false; + gNode.nodePrefs.isNoNegEdge:=false; + if (sender as TMenuItem).tag = 1 then + gNode.nodePrefs.isNoNegEdge:=true; + if (sender as TMenuItem).tag = 2 then + gNode.nodePrefs.isNoPosEdge:=true; + gNode.isRebuildList := true; + GLBoxRequestUpdate(Sender); +end; + +procedure TGLForm1.RestrictHideNodesWithoutEdgesClick(Sender: TObject); +begin + gNode.nodePrefs.isNoNodeWithoutEdge := RestrictHideNodesWithoutEdges.checked; + if length(gNode.nodes) < 1 then exit; + gNode.isRebuildList := true; + GLBoxRequestUpdate(Sender); +end; + +procedure TGLForm1.RestrictMenuClick(Sender: TObject); +begin + gNode.nodePrefs.isNoLeftNodes:=false; + gNode.nodePrefs.isNoRightNodes:=false; + if (sender as TMenuItem).tag = 1 then + gNode.nodePrefs.isNoRightNodes:=true; + if (sender as TMenuItem).tag = 2 then + gNode.nodePrefs.isNoLeftNodes:=true; + if length(gNode.nodes) < 1 then exit; + gNode.isRebuildList := true; + GLBoxRequestUpdate(Sender); +end; +(*86 +function GetFloat(prompt: string; min,def,max: extended): extended; +var + PrefForm: TForm; + OkBtn: TButton; + promptLabel: TLabel; + valEdit: TEdit; +begin + PrefForm:=TForm.Create(nil); + PrefForm.SetBounds(100, 100, 640, 112); + PrefForm.Caption:='Value required'; + PrefForm.Position := poScreenCenter; + PrefForm.BorderStyle := bsDialog; + //label + promptLabel:=TLabel.create(PrefForm); + promptLabel.Caption:= prompt; + if (min < max) then + promptLabel.Caption:= format('%s (range %g..%g)', [prompt, min, max]); + promptLabel.Left := 8; + promptLabel.Top := 12; + promptLabel.Parent:=PrefForm; + //edit + valEdit:=TEdit.create(PrefForm); + valEdit.Caption := FloatToStrF(def, ffGeneral, 8, 4); + valEdit.Top := 42; + valEdit.Width := PrefForm.Width - 16; + valEdit.Left := 8; + valEdit.Parent:=PrefForm; + //OK button + OkBtn:=TButton.create(PrefForm); + OkBtn.Caption:='OK'; + OkBtn.Top := 78; + OkBtn.Width := 128; + OkBtn.Left := PrefForm.Width - OkBtn.Width - 8; + OkBtn.Parent:=PrefForm; + OkBtn.ModalResult:= mrOK; + {$IFNDEF Darwin} ScaleDPI(PrefForm, 96);{$ENDIF} + {$IFDEF LCLCocoa} + if gPrefs.DarkMode then SetFormDarkMode(PrefForm); + {$ENDIF} + PrefForm.ShowModal; + result := def; + if (PrefForm.ModalResult = mrOK) then begin + result := StrToFloatDef(valEdit.Caption, def); + if (min < max) and (result < min) then + result := min; + if (min < max) and (result > max) then + result := max; + end; + FreeAndNil(PrefForm); +end; //GetFloat()*) + +function GetFloat(prompt: string; min,def,max: double): double; +var + PrefForm: TForm; + CancelBtn,OkBtn: TButton; + promptLabel: TLabel; + valEdit: TEdit; +begin + PrefForm:=TForm.Create(nil); + //PrefForm.SetBounds(100, 100, 512, 212); + PrefForm.AutoSize := True; + PrefForm.BorderWidth := 8; + PrefForm.Caption:='Value required'; + PrefForm.Position := poScreenCenter; + PrefForm.BorderStyle := bsDialog; + //label + promptLabel:=TLabel.create(PrefForm); + promptLabel.Caption:= prompt; + if (min < max) then + promptLabel.Caption:= format('%s (range %0.3g..%0.3g)', [prompt, min, max]); + //promptLabel.Left := 8; + //promptLabel.Top := 12; + promptLabel.AutoSize := true; + promptLabel.AnchorSide[akTop].Side := asrTop; + promptLabel.AnchorSide[akTop].Control := PrefForm; + promptLabel.BorderSpacing.Top := 6; + promptLabel.AnchorSide[akLeft].Side := asrLeft; + promptLabel.AnchorSide[akLeft].Control := PrefForm; + promptLabel.BorderSpacing.Left := 6; + promptLabel.Parent:=PrefForm; + //edit + valEdit:=TEdit.create(PrefForm); + valEdit.Caption := FloatToStrF(def, ffGeneral, 8, 4); + //valEdit.Top := 42; + //valEdit.Width := PrefForm.Width - 16; + valEdit.Constraints.MinWidth:= 300; + valEdit.AutoSize := true; + valEdit.AnchorSide[akTop].Side := asrBottom; + valEdit.AnchorSide[akTop].Control := promptLabel; + valEdit.BorderSpacing.Top := 6; + valEdit.AnchorSide[akLeft].Side := asrLeft; + valEdit.AnchorSide[akLeft].Control := PrefForm; + valEdit.BorderSpacing.Left := 6; + valEdit.Parent:=PrefForm; + //Cancel Btn + CancelBtn:=TButton.create(PrefForm); + CancelBtn.Caption:='Cancel'; + CancelBtn.AutoSize := true; + CancelBtn.AnchorSide[akTop].Side := asrBottom; + CancelBtn.AnchorSide[akTop].Control := valEdit; + CancelBtn.BorderSpacing.Top := 6; + CancelBtn.AnchorSide[akLeft].Side := asrLeft; + CancelBtn.AnchorSide[akLeft].Control := PrefForm; + CancelBtn.BorderSpacing.Left := 200; + CancelBtn.Parent:=PrefForm; + CancelBtn.ModalResult:= mrCancel; + + //OK button + OkBtn:=TButton.create(PrefForm); + OkBtn.Caption:='OK'; + OkBtn.AutoSize := true; + OkBtn.AnchorSide[akTop].Side := asrBottom; + OkBtn.AnchorSide[akTop].Control := valEdit; + OkBtn.BorderSpacing.Top := 6; + OkBtn.AnchorSide[akLeft].Side := asrRight; + OkBtn.AnchorSide[akLeft].Control := CancelBtn; + OkBtn.BorderSpacing.Left := 6; + OkBtn.Parent:=PrefForm; + OkBtn.ModalResult:= mrOK; + //OK button + //86 + //{$IFDEF Windows} ScaleDPI(PrefForm, 96); {$ENDIF} + //{$IFDEF Linux} ScaleDPIX(PrefForm, 96); {$ENDIF} + {$IFDEF LCLCocoa} + if gPrefs.DarkMode then SetFormDarkMode(PrefForm); + {$ENDIF} + PrefForm.ShowModal; + result := def; + if (PrefForm.ModalResult = mrOK) then begin + result := StrToFloatDef(valEdit.Caption, def); + if (min < max) and (result < min) then + result := min; + if (min < max) and (result > max) then + result := max; + end; + FreeAndNil(PrefForm); +end; //GetFloat() + +procedure TGLForm1.SimplifyMeshMenuClick(Sender: TObject); + +var + nTri: integer; + msStart: Dword; + s: string; + r: single; +begin + msStart := gettickcount(); + nTri := length(gMesh.Faces); + r := GetFloat('Enter reduction factor (e.g. 0.2 will decimate 80% of all triangles)', 0.001,0.3,0.999); + //s := '.3'; + //if not inputquery('Track simplify', 'Enter reduction factor (e.g. 0.2 will decimate 80% of all triangles)', s) then exit; + //r := StrToFloatDef(s, 0.5); + if (r <= 0.0) or (r > 1.0) then begin + showmessage('Error: reduction factor should be BETWEEN 0 and 1'); + exit; + end; + if not ReducePatch(gMesh.faces, gMesh.vertices, r) then exit; + caption := format('Faces %d -> %d (%.3f, %d ms)', [ nTri, length(gMesh.Faces), length(gMesh.Faces)/nTri , gettickcount() - msStart]) ; + gMesh.isRebuildList:=true; + GLBoxRequestUpdate(Sender); +end; + +procedure TGLForm1.SwapYZMenuClick(Sender: TObject); +begin + if gPrefs.ZDimIsUp then + gMesh.SwapYZ + else + gMesh.SwapZY; + GLBoxRequestUpdate(Sender); +end; + +procedure TGLForm1.ReverseFacesMenuClick(Sender: TObject); +begin + gMesh.ReverseFaces; + GLBoxRequestUpdate(Sender); +end; + +procedure TGLForm1.UpdateImageIntensity; +var + i: integer; +begin + //gTypeInCell := false; + if gMesh.OpenOverlays > 0 then begin + Memo1.Lines.clear; + for i := 1 to gMesh.OpenOverlays do begin + Memo1.Lines.Add(format('Overlay %d: %s',[i, extractfilename(gMesh.overlay[i].filename)])); + Memo1.Lines.Add(format(' range min..max %.4g..%.4g',[gMesh.overlay[i].minIntensity, gMesh.overlay[i].maxIntensity])); + Memo1.Lines.Add(format(' view min..max %.4g..%.4g',[gMesh.overlay[i].windowScaledMin, gMesh.overlay[i].windowScaledMax])); + end; + end; + OverlayTimerStart; +end; + +procedure TGLForm1.SetColorBarPosition; +begin + if (gPrefs.ColorBarPosition < 1) or (gPrefs.ColorBarPosition > 4) then gPrefs.ColorBarPosition := 1; + case gPrefs.ColorBarPosition of + 3: begin gClrbar.isTopOrRight := true; gClrbar.isVertical:=false; end; //top row + 4: begin gClrbar.isTopOrRight := true; gClrbar.isVertical:=true; end; //right column + 1: begin gClrbar.isTopOrRight := false; gClrbar.isVertical:=false; end;//bottom row + 2: begin gClrbar.isTopOrRight := false; gClrbar.isVertical:=true; end;//left column + end; + gCube.TopLeft := (gPrefs.ColorBarPosition = 1) or (gPrefs.ColorBarPosition = 2); + //gClrbar.isTopOrRight := true; gClrbar.isVertical:=false; +end; + +procedure TGLForm1.TrackBoxChange(Sender: TObject); +begin + gTrack.minFiberLength := TrackLengthTrack.position; + gTrack.LineWidth := TrackWidthTrack.Position; + gTrack.ditherColorFrac := TrackDitherTrack.Position / TrackDitherTrack.Max; + Memo1.Lines.clear; + Memo1.Lines.Add(format('Track min length %d',[TrackLengthTrack.position])); + Memo1.Lines.Add(format('Track line width %d',[TrackWidthTrack.Position])); + Memo1.Lines.Add(format('Track dither %.2g',[gTrack.ditherColorFrac])); + gTrack.isRebuildList:= true; + GLBoxRequestUpdate(Sender); +end; + +procedure TGLForm1.OVERLAYMINMAX (lOverlay: integer; lMin,lMax: single); +begin + if (gMesh.OpenOverlays < 1) or (lOverlay > gMesh.OpenOverlays) then exit; + gMesh.Overlay[lOverlay].WindowScaledMin := lMin; + gMesh.Overlay[lOverlay].WindowScaledMax := lMax; + UpdateLayerBox(false);; +end; + +function TGLForm1.UpdateClrBar: integer; +var + nLUT, lI, lJ: integer; + mn, mx: single; +begin + nLUT := 0; + result := 0; + if (gTrack.n_count > 0) and (gTrack.scalarSelected >= 0) and (gTrack.scalarSelected < length(gTrack.scalars)) then begin + inc(nLUT); + lJ := TrackScalarLUTdrop.ItemIndex; + gClrbar.SetLUT(nLUT, UpdateTransferFunction(lJ,false), gTrack.scalars[gTrack.scalarSelected].mnView,gTrack.scalars[gTrack.scalarSelected].mxView); + end; + result := nLUT; + if ((gMesh.OpenOverlays < 1) and ((length(gNode.nodes) < 1))) then exit; + + if (gMesh.OpenOverlays > 0) then + for lI := 1 to gMesh.OpenOverlays do + if (length(gMesh.overlay[lI].intensity) > 0) and(gMesh.overlay[lI].LUTvisible <> kLUTinvisible) and (not isFreeSurferLUT(gMesh.overlay[lI].LUTindex)) then begin + inc(nLUT); + gClrbar.SetLUT(nLUT, UpdateTransferFunction(gMesh.overlay[lI].LUTindex,gMesh.overlay[lI].LUTinvert), gMesh.overlay[lI].windowScaledMin,gMesh.overlay[lI].windowScaledMax); + + end; + result := nLUT; + if (length(gNode.nodes) < 1) then exit; + if (gNode.nodePrefs.isNodeColorVaries) then begin + if (gNode.nodePrefs.isNodeThresholdBySize) then begin + mn := gNode.nodePrefs.minNodeColor; + mx := gNode.nodePrefs.maxNodeColor; + end else begin + mn := gNode.nodePrefs.minNodeThresh; + mx := gNode.nodePrefs.maxNodeThresh; + end; + if mn <> mx then begin + nLUT := nLUT + 1; + gClrbar.SetLUT(nLUT, UpdateTransferFunction(gNode.nodePrefs.NodeLUTindex,false), mn,mx); + + end; + end; //nodes + if (gNode.nodePrefs.isEdgeColorVaries) and (gNode.nodePrefs.maxEdge <> gNode.nodePrefs.minEdge) then begin + if (gNode.nodePrefs.maxEdge > 0) and (not gNode.nodePrefs.isNoPosEdge) and (gNode.nodePrefs.minEdgeThresh <> gNode.nodePrefs.maxEdgeThresh) then begin + nLUT := nLUT + 1; + gClrbar.SetLUT(nLUT, UpdateTransferFunction(gNode.nodePrefs.edgeLUTindex,false), gNode.nodePrefs.minEdgeThresh,gNode.nodePrefs.maxEdgeThresh); + end; //positive edges + if (gNode.nodePrefs.minEdge < 0) and (not gNode.nodePrefs.isNoNegEdge) and (gNode.nodePrefs.minEdgeThresh <> gNode.nodePrefs.maxEdgeThresh) then begin + nLUT := nLUT + 1; + lJ := 1+gNode.nodePrefs.edgeLUTindex; + gClrbar.SetLUT(nLUT, UpdateTransferFunction(lJ ,false), -gNode.nodePrefs.minEdgeThresh,-gNode.nodePrefs.maxEdgeThresh); + end; //negative edges + end; //edges + result := nLUT; +end; + +procedure TGLForm1.FormDestroy(Sender: TObject); +begin + //Showmessage(gPrefs.FontName); + //IniFile(false,IniName,gPrefs); + gMesh.Free; + gNode.Free; + gTrack.Free; + gCube.Free; + gClrBar.Free; +end; + +procedure TGLForm1.NodeThreshDropChange(Sender: TObject); +begin + if NodeThreshDrop.ItemIndex = 0 then begin + NodeMinEdit.Value:=gNode.NodePrefs.minNodeSize; + NodeMaxEdit.Value:=gNode.NodePrefs.maxNodeSize; + end else begin + NodeMinEdit.Value:=gNode.NodePrefs.minNodeColor; + NodeMaxEdit.Value:=gNode.NodePrefs.maxNodeColor; + end; + NodePrefChange(Sender); +end; + + +procedure TGLForm1.ROImeshMenuClick(Sender: TObject); +const + kRoiIntensityFilter = 'ROX Intensities|*.rox'; + kAtlasFilter = 'mz3 Atlas|*.mz3'; + kMeshFilter = 'mz3 Mesh|*.mz3'; +label + 123; +var + lMesh: TMesh; + lRoiIntensityFilename: string; +begin + showmessage('You will be asked to select a *.rox file. Next you will select a *.mz3 template. Finally, provide the name for your mesh. Each line of the rox file lists the region number followed by the region intensity. An example of a ROX file with two regions would be:'+kCR+'17 0.5'+kCR+'32 1.5'); + OpenDialog.Filter := kRoiIntensityFilter; + OpenDialog.Title := 'Select ROX intensities'; + if not OpenDialog.Execute then exit; + lRoiIntensityFilename := OpenDialog.FileName; + OpenDialog.Filter := kAtlasFilter; + OpenDialog.Title := 'Select Atlas Template'; + if not OpenDialog.Execute then exit; + SaveMeshDialog.Filter := kMeshFilter; + if not SaveMeshDialog.execute then exit; + //convert + lMesh := TMesh.Create; + if not lMesh.LoadFromFile(OpenDialog.Filename) then + goto 123; + if (lMesh.AtlasMaxIndex < 1) then begin + showmessage('This is not a template '+OpenDialog.Filename); + goto 123; + end; + if not lMesh.LoadOverlay(lRoiIntensityFilename, false) then + goto 123; + if lMesh.OpenOverlays < 1 then + goto 123; + lMesh.SaveOverlay(SaveMeshDialog.Filename, 1); + 123: + lMesh.Free; + +end; + +{$IFDEF COREGL} +procedure Set2DDraw (w,h: integer; r,g,b: byte); +begin + glDepthMask(kGL_TRUE); // enable writes to Z-buffer + glEnable(GL_DEPTH_TEST); + glDisable(GL_CULL_FACE); // glEnable(GL_CULL_FACE); //check on pyramid + glEnable(GL_BLEND); + {$IFNDEF COREGL}glEnable(GL_NORMALIZE); {$ENDIF} + glClearColor(r/255, g/255, b/255, 0.0); //Set background + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT or GL_STENCIL_BUFFER_BIT); + glViewport( 0, 0, w, h); //required when bitmap zoom <> 1 +end; +{$ELSE} +procedure Set2DDraw (w,h: integer; r,g,b: byte); +begin +glMatrixMode(GL_PROJECTION); +glLoadIdentity(); +glOrtho (0, 1, 0, 1, -6, 12); +glMatrixMode (GL_MODELVIEW); +glLoadIdentity (); +{$IFDEF DGL} +glDepthMask(BYTEBOOL(1)); // enable writes to Z-buffer +{$ELSE} +glDepthMask(GL_TRUE); // enable writes to Z-buffer +{$ENDIF} +glEnable(GL_DEPTH_TEST); +glDisable(GL_CULL_FACE); // glEnable(GL_CULL_FACE); //check on pyramid +glEnable(GL_BLEND); +glEnable(GL_NORMALIZE); +glClearColor(r/255, g/255, b/255, 0.0); //Set background +glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT or GL_STENCIL_BUFFER_BIT); +glViewport( 0, 0, w, h); //required when bitmap zoom <> 1 +end; +{$ENDIF} + +procedure TGLForm1.CreateRender(w,h: integer; isToScreen: boolean); +var + origin: TPoint3f; + isMultiPass, isMultiSample, isOK, useMultiSample: boolean; + meshAlpha, meshBlend, ambientOcclusionFrac, scale: single; +begin + if (h < 1) or (w < 1) then exit; + if gNode.isBusy or gMesh.isBusy or isBusy then begin //come back later + UpdateTimer.enabled := true; + exit; + end; + if (length(gShader.VertexProgram) > 0) then gTrack.isRebuildList:= true; + InitGLSL(false); + origin := GetOrigin(scale); + //glUseProgram(gShader.program3d); + {$IFNDEF COREGL} + SetLighting(gPrefs); + {$ENDIF} + isMultiPass := true; + if (gPrefs.RenderQuality = kRenderPoor) then isMultiPass := false; + if not (gPrefs.SupportBetterRenderQuality) then isMultiPass := false; + if (gPrefs.OcclusionAmount = 0) and (occlusionTrack.Position = 0) and (meshAlphaTrack.position = meshAlphaTrack.max ) and (MeshBlendTrack.position = 0) then isMultiPass := false; + //nDrawScene(w, h, true, false, gPrefs, origin, lightPos, ClipPlane, scale, gShader.Distance, gelevation, gazimuth, gMesh,gNode, gTrack); + if (isMultiPass) then begin + meshAlpha := meshAlphaTrack.position/meshAlphaTrack.max; + meshBlend := MeshBlendTrack.position/MeshBlendTrack.max; + ambientOcclusionFrac := occlusionTrack.Position/occlusionTrack.max; + //first pass: 3D draw all items: framebuffer f1 + useMultiSample := isToScreen; //the screenshot is explicitly supersampling everything (inlcuding text), the screen just supersamples the objects + isMultiSample := setFrame (w, h, gShader.f1, useMultiSample, isOK); + if not isOK then exit; + DrawScene(w,h, gPrefs.isFlipMeshOverlay, gPrefs.OverlayClip, true,isMultiSample, gPrefs, origin, ClipPlane, scale, gDistance, gElevation, gAzimuth, gMesh,gNode, gTrack); + //second pass: 3D draw overlay items only: framebuffer f2 + isMultiSample := setFrame (w, h, gShader.f2, useMultiSample, isOK ); + if not isOK then exit; + //isFlipOverlayBackground := not isFlipOverlayBackground; + DrawScene(w,h, gPrefs.isFlipMeshOverlay, gPrefs.OverlayClip, false,isMultiSample, gPrefs, origin, ClipPlane, scale, gDistance, gElevation, gAzimuth, gMesh,gNode, gTrack); + if (isToScreen) then begin + releaseFrame; //GOOD: multipass, multisampling + Set2DDraw (w,h, red(gPrefs.BackColor) ,green(gPrefs.BackColor), blue(gPrefs.BackColor)); + RunAoGLSL( gShader.f1, gShader.f2, 1, meshAlpha, meshBlend, ambientOcclusionFrac, gDistance); + end else begin //SCREENSHOT - multipass, multisampling, supersampled + //isMultiSample := setFrameMS (w, h, gShader.fScreenShot, false, isOK ); + isMultiSample := setFrame (w, h, gShader.fScreenShot, false, isOK ); + if (not isOK) then exit; + Set2DDraw (w,h, red(gPrefs.BackColor) ,green(gPrefs.BackColor), blue(gPrefs.BackColor)); + RunAoGLSL( gShader.f1, gShader.f2, gPrefs.ScreenCaptureZoom, meshAlpha,meshBlend,ambientOcclusionFrac,gDistance); + end; + end else begin //else POOR quality : do not use framebuffers (single pass) + //if isToScreen then + releaseFrame; + //else + // setFrame (w, h, gShader.fScreenShot, true ); //SCREENSHOT - supersampled + DrawScene(w, h, gPrefs.isFlipMeshOverlay, gPrefs.OverlayClip, true, false, gPrefs, origin, ClipPlane, scale, gDistance, gelevation, gazimuth, gMesh,gNode, gTrack); + end; + + if gPrefs.OrientCube then begin + //DrawCube (w, h, gAzimuth, gElevation); + gCube.Azimuth:=gAzimuth; + gCube.Elevation:=gElevation; + if (gPrefs.ColorbarPosition = 1) or (gPrefs.ColorbarPosition = 2) then + gCube.TopLeft:= true + else + gCube.TopLeft:= false; + gCube.Draw(w,h); + //DrawCube (w, h, gAzimuth, gElevation); + end; + + if gPrefs.Colorbar then begin + //RunOffGLSL; //turn off shading + if gnLUT < 0 then //refresh + gnLUT := UpdateClrBar(); + if gnLUT > 0 then + gClrbar.Draw(gnLUT, w, h); + (*vbm if (gMesh.OpenOverlays > 0) and ((gTrack.n_count < 1) or (not gPrefs.ColorBarPrecedenceTracksNotOverlays)) then + DrawCLUT( gPrefs.ColorBarPos, 0.01, gPrefs, gMesh, w, h) //color bar based on overlays + else if (gTrack.n_count > 0) and (gTrack.scalarSelected >= 0) and (gTrack.scalarSelected < length(gTrack.scalars)) then + DrawCLUTtrk(gPrefs.ColorBarPos, 0.01, gTrack.scalars[gTrack.scalarSelected].mnView, gTrack.scalars[gTrack.scalarSelected].mxView, gPrefs, gTrack.scalarLUT, w, h) //color bar based on overlays + //DrawCLUTtrk ( lU: TUnitRect; lBorder, lMin, lMax: single; var lPrefs: TPrefs; LUT: TLUT;window_width, window_height: integer ); + else + DrawCLUT( gPrefs.ColorBarPos, 0.01, gPrefs, gNode, w, h); //color bar based on nodes*) + end; + + //if (gTrack.scalarSelected < 0) or (gTrack.scalarSelected >= length(gTrack.scalars)) then exit; + //ScalarPref(gTrack.scalars[gTrack.scalarSelected].mnView, gTrack.scalars[gTrack.scalarSelected].mxView); + //TestColorBar(gPrefs, w, h); + //DrawText (gPrefs, w, h); + if (isToScreen) then + GLbox.SwapBuffers; + //nDraw; + isBusy := false; +end; + +procedure TGLForm1.GLboxPaint(Sender: TObject); +begin + CreateRender(GLBoxBackingWidth, GLboxBackingHeight, true); + if UpdateTimer.enabled then + UpdateTimerTimer(Sender); +end; + +function TGLForm1.ScreenShotX1: TBitmap; +var + RawImage: TRawImage; + p: array of byte; + w, h, x, y, BytePerPixel: integer; + z: int64; + DestPtr: PInteger; + maxXY : array[0..1] of GLuint; +begin + + GLBox.MakeCurrent; + glGetIntegerv(GL_MAX_VIEWPORT_DIMS, @maxXY); //GL_MAX_TEXTURE_SIZE + w := GLBoxBackingWidth * gPrefs.ScreenCaptureZoom; + h := GLboxBackingHeight * gPrefs.ScreenCaptureZoom; + Result:=TBitmap.Create; + Result.Width:=w; + Result.Height:=h; + if gPrefs.ScreenCaptureTransparentBackground then + Result.PixelFormat := pf32bit + else + Result.PixelFormat := pf24bit; //if pf32bit the background color is wrong, e.g. when alpha = 0 + RawImage := Result.RawImage; + BytePerPixel := RawImage.Description.BitsPerPixel div 8; + setlength(p, 4*w* h); + glFlush; + glFinish;//<-this would pause until all jobs finished: generally a bad idea! required here + // GLbox.SwapBuffers; + + {$IFDEF Darwin} //http://lists.apple.com/archives/mac-opengl/2006/Nov/msg00196.html + glReadPixels(0, 0, w, h, $80E1, $8035, @p[0]); //OSX-Darwin GL_BGRA = $80E1; GL_UNSIGNED_INT_8_8_8_8_EXT = $8035; + {$ELSE} + {$IFDEF Linux} + glReadPixels(0, 0, w, h, GL_RGBA, GL_UNSIGNED_BYTE, @p[0]); //Linux-Windows GL_RGBA = $1908; GL_UNSIGNED_BYTE + {$ELSE} + glReadPixels(0, 0, w, h, $80E1, GL_UNSIGNED_BYTE, @p[0]); //Linux-Windows GL_RGBA = $1908; GL_UNSIGNED_BYTE + {$ENDIF} + {$ENDIF} + GLbox.ReleaseContext; + z := 0; + if BytePerPixel <> 4 then begin + for y:= h-1 downto 0 do begin + DestPtr := PInteger(RawImage.Data); + Inc(PByte(DestPtr), y * RawImage.Description.BytesPerLine ); + for x := 1 to w do begin + DestPtr^ := p[z] + (p[z+1] shl 8) + (p[z+2] shl 16); + Inc(PByte(DestPtr), BytePerPixel); + z := z + 4; + end; + end; //for y : each line in image + end else begin + for y:= h-1 downto 0 do begin + DestPtr := PInteger(RawImage.Data); + Inc(PByte(DestPtr), y * RawImage.Description.BytesPerLine ); + System.Move(p[z], DestPtr^, w * BytePerPixel ); + z := z + ( w * 4 ); + end; //for y : each line in image + end; + setlength(p, 0); + GLbox.ReleaseContext; +end; + +{$IFDEF COREGL} +function textureSizeOK(w,h: integer): boolean; +begin + glBindTexture(GL_TEXTURE_2D, 0); + glTexImage2D(GL_PROXY_TEXTURE_2D, 0,GL_RGBA8, w, h, 0,GL_RGBA, GL_UNSIGNED_BYTE, nil); + //glGetTexLevelParameteriv(GL_PROXY_TEXTURE_2D, 0, GL_TEXTURE_WIDTH, @i); + //glTexImage2D(GL_PROXY_TEXTURE_2D, 0, 4, mTextureWidth, mTextureHeight, 0, mTexFormat, mTexType, NULL); + result := GL_NO_ERROR = glGetError(); + +end; + +function TGLForm1.ScreenShot(lForceRedraw: boolean = false): TBitmap; +var + RawImage: TRawImage; + p: array of byte; + isOK: boolean; + zoom, w2, h2, w, h, x, y, BytePerPixel,trackLineWidth: integer; + z: int64; + DestPtr: PInteger; + maxXY : array[0..1] of GLuint; + fbo : TFrameBuffer; +begin + if (gPrefs.ScreenCaptureZoom < 2) and (not lForceRedraw) then begin //special case: no super sampling + result := ScreenShotX1; + exit; + end; + GLBox.MakeCurrent; + glGetIntegerv(GL_MAX_VIEWPORT_DIMS, @maxXY); //GL_MAX_TEXTURE_SIZE + zoom := gPrefs.ScreenCaptureZoom; + w := GLBox.Width * zoom; + h := GLbox.Height * zoom; + w2 := w*2; + h2 := h*2; + if (w2 > maxXY[0]) or (h2 > maxXY[1]) or (gPrefs.RenderQuality = kRenderPoor) or (not (gPrefs.SupportBetterRenderQuality)) then begin + result := ScreenShotX1; + exit; + end; + trackLineWidth := gTrack.LineWidth; + if (gTrack.n_count > 0) and (not gTrack.isTubes) then begin //tracks are drawn in pixels, so zoom appropriately! + gTrack.LineWidth := 2 * gTrack.LineWidth * zoom; + gTrack.isRebuildList:= true; + end; + Result:=TBitmap.Create; + Result.Width:=w; + Result.Height:=h; + if gPrefs.ScreenCaptureTransparentBackground then + Result.PixelFormat := pf32bit + else + Result.PixelFormat := pf24bit; //if pf32bit the background color is wrong, e.g. when alpha = 0 + RawImage := Result.RawImage; + BytePerPixel := RawImage.Description.BitsPerPixel div 8; + setlength(p, 4*w* h); + CreateRender(w2, h2, false); //draw to framebuffer fScreenShot + //setFrame (w, h, gShader.fScreenShot, false, isOK ); // <- release huge framebuffer + //if not isOK then + initFrame(fbo); + if w2 <> w then begin + setFrame (w, h, fbo, false,isOK ); + glBindFramebuffer(GL_READ_FRAMEBUFFER, gShader.fScreenShot.frameBuf); + glBindFramebuffer(GL_DRAW_FRAMEBUFFER, fbo.frameBuf); + glBlitFramebuffer(0,0,w2 {x2},h2{x2},0,0,w,h,GL_COLOR_BUFFER_BIT,GL_LINEAR); + glBindFramebuffer(GL_READ_FRAMEBUFFER, fbo.frameBuf); + end; + {$IFDEF Darwin} //http://lists.apple.com/archives/mac-opengl/2006/Nov/msg00196.html + glReadPixels(0, 0, w, h, $80E1, $8035, @p[0]); //OSX-Darwin GL_BGRA = $80E1; GL_UNSIGNED_INT_8_8_8_8_EXT = $8035; + {$ELSE} + {$IFDEF Linux} + glReadPixels(0, 0, w, h, GL_RGBA, GL_UNSIGNED_BYTE, @p[0]); //Linux-Windows GL_RGBA = $1908; GL_UNSIGNED_BYTE + {$ELSE} + glReadPixels(0, 0, w, h, $80E1, GL_UNSIGNED_BYTE, @p[0]); //Linux-Windows GL_RGBA = $1908; GL_UNSIGNED_BYTE + {$ENDIF} + {$ENDIF} + freeFrame(fbo); + setFrame (2, 2, gShader.fScreenShot, false,isOK ); // <- release huge framebuffer + GLbox.ReleaseContext; + z := 0; + if BytePerPixel <> 4 then begin + for y:= h-1 downto 0 do begin + DestPtr := PInteger(RawImage.Data); + Inc(PByte(DestPtr), y * RawImage.Description.BytesPerLine ); + for x := 1 to w do begin + DestPtr^ := p[z] + (p[z+1] shl 8) + (p[z+2] shl 16); + Inc(PByte(DestPtr), BytePerPixel); + z := z + 4; + end; + end; //for y : each line in image + end else begin + for y:= h-1 downto 0 do begin + DestPtr := PInteger(RawImage.Data); + Inc(PByte(DestPtr), y * RawImage.Description.BytesPerLine ); + System.Move(p[z], DestPtr^, w * BytePerPixel ); + z := z + ( w * 4 ); + end; //for y : each line in image + end; + setlength(p, 0); + if (gTrack.n_count > 0) and (not gTrack.isTubes) then begin //reset for un-zoomed tracks + gTrack.LineWidth := trackLineWidth; + gTrack.isRebuildList:= true; + end; + GLboxRequestUpdate(GLForm1); +end; +{$ELSE} +function TGLForm1.ScreenShot(lForceRedraw: boolean = false): TBitmap; +var + RawImage: TRawImage; + p: array of byte; + isOK: boolean; + zoom, w, h, x, y, BytePerPixel,trackLineWidth: integer; + z: int64; + DestPtr: PInteger; + maxXY : array[0..1] of GLuint; +begin + if (gPrefs.ScreenCaptureZoom < 2) and (not lForceRedraw) then begin //special case: no super sampling + result := ScreenShotX1; + exit; + end; + GLBox.MakeCurrent; + glGetIntegerv(GL_MAX_VIEWPORT_DIMS, @maxXY); //GL_MAX_TEXTURE_SIZE + w := GLBoxBackingWidth * gPrefs.ScreenCaptureZoom; + h := GLboxBackingHeight * gPrefs.ScreenCaptureZoom; + if (w > maxXY[0]) or (h > maxXY[1]) or (gPrefs.RenderQuality = kRenderPoor) or (not (gPrefs.SupportBetterRenderQuality)) then begin + result := ScreenShotX1; + exit; + (*w := GLBoxBackingWidth; + h := GLboxBackingHeight; + zoom := 1*) + end else + zoom := gPrefs.ScreenCaptureZoom; + trackLineWidth := gTrack.LineWidth; + if (gTrack.n_count > 0) and (not gTrack.isTubes) then begin //tracks are drawn in pixels, so zoom appropriately! + gTrack.LineWidth := 2 * gTrack.LineWidth * zoom; + gTrack.isRebuildList:= true; + end; + Result:=TBitmap.Create; + Result.Width:=w; + Result.Height:=h; + if gPrefs.ScreenCaptureTransparentBackground then + Result.PixelFormat := pf32bit + else + Result.PixelFormat := pf24bit; //if pf32bit the background color is wrong, e.g. when alpha = 0 + RawImage := Result.RawImage; + BytePerPixel := RawImage.Description.BitsPerPixel div 8; + setlength(p, 4*w* h); + if lForceRedraw then + CreateRender(w, h, true) //use screen due to Intel multisampling weirdness + else + CreateRender(w, h, false); //draw to framebuffer fScreenShot + glFlush; + glFinish;//<-this would pause until all jobs finished: generally a bad idea! required here + //GLbox.SwapBuffers; + + {$IFDEF Darwin} //http://lists.apple.com/archives/mac-opengl/2006/Nov/msg00196.html + glReadPixels(0, 0, w, h, $80E1, $8035, @p[0]); //OSX-Darwin GL_BGRA = $80E1; GL_UNSIGNED_INT_8_8_8_8_EXT = $8035; + {$ELSE} + {$IFDEF Linux} + glReadPixels(0, 0, w, h, GL_RGBA, GL_UNSIGNED_BYTE, @p[0]); //Linux-Windows GL_RGBA = $1908; GL_UNSIGNED_BYTE + {$ELSE} + glReadPixels(0, 0, w, h, $80E1, GL_UNSIGNED_BYTE, @p[0]); //Linux-Windows GL_RGBA = $1908; GL_UNSIGNED_BYTE + {$ENDIF} + {$ENDIF} + setFrame (2, 2, gShader.fScreenShot, false,isOK ); // <- release huge framebuffer + GLbox.ReleaseContext; + z := 0; + if BytePerPixel <> 4 then begin + for y:= h-1 downto 0 do begin + DestPtr := PInteger(RawImage.Data); + Inc(PByte(DestPtr), y * RawImage.Description.BytesPerLine ); + for x := 1 to w do begin + DestPtr^ := p[z] + (p[z+1] shl 8) + (p[z+2] shl 16); + Inc(PByte(DestPtr), BytePerPixel); + z := z + 4; + end; + end; //for y : each line in image + end else begin + for y:= h-1 downto 0 do begin + DestPtr := PInteger(RawImage.Data); + Inc(PByte(DestPtr), y * RawImage.Description.BytesPerLine ); + System.Move(p[z], DestPtr^, w * BytePerPixel ); + z := z + ( w * 4 ); + end; //for y : each line in image + end; + setlength(p, 0); + if (gTrack.n_count > 0) and (not gTrack.isTubes) then begin //reset for un-zoomed tracks + gTrack.LineWidth := trackLineWidth; + gTrack.isRebuildList:= true; + end; + GLboxRequestUpdate(GLForm1); +end; +{$ENDIF} +procedure ScreenRes(var lVidX,lVidY: integer); +{$IFDEF FPC} +begin + lVidX := Screen.Width; + lVidY := Screen.Height; +end; +{$ELSE} +var + DC: HDC; +begin + DC := GetDC(0); + try + lVidX :=(GetDeviceCaps(DC, HORZRES)); + lVidY :=(GetDeviceCaps(DC, VERTRES)); + finally + ReleaseDC(0, DC); + end; // of try/finally +end;//screenres +{$ENDIF} + +procedure TGLForm1.AdjustFormPos (var lForm: TForm); +{$IFDEF FPC} +const + kBorderHt = 30; + kBorderWid = 10; +{$ELSE} +const + kBorderHt = 0; + kBorderWid = 0; +{$ENDIF} +const +{$IFDEF FPC} +kExtra = 8; +{$ELSE} +kExtra = 0; +{$ENDIF} +var + lPos: integer; + lVidX,lVidY,lLeft,lTop: integer; +begin + ScreenRes(lVidX,lVidY); + lPos := lForm.Tag; + if odd(lPos) then begin//form on left + lLeft := GLForm1.Left-lForm.Width-kBorderWid; + if lLeft < 0 then //try putting the form on the right + lLeft := GLForm1.Left+GLForm1.Width+kExtra; //form on right + end else begin + lLeft := GLForm1.Left+GLForm1.Width+kExtra;//-default: right + if ((lLeft+ lForm.Width) > lVidX) then + lLeft := GLForm1.Left-lForm.Width-kBorderWid; //try on right + end; + if lPos < 3 then begin //align with top + lTop := GLForm1.Top; //default - align with top + if lTop < 0 then //backup - top of screen + lTop := 0; + end else if lPos > 4 then begin //align with vertical middle + lTop := GLForm1.Top+(GLForm1.Height div 2)-(lForm.Height div 2)+kBorderHt; //default - align with bottom + if ((lTop+lForm.Height) > lVidY) then + lTop := GLForm1.Top; //backup - align with top + if lTop < 0 then + lTop := 0; + end else begin //align with bottom + lTop := GLForm1.Top+GLForm1.Height-lForm.Height+kBorderHt; //default - align with bottom + if ((lTop+lForm.Height) > lVidY) then + lTop := GLForm1.Top; //backup - align with top + if lTop < 0 then + lTop := 0; + end; + if (lPos = 0) or ((lLeft+ lForm.Width) > lVidX) or (lLeft < 0) + or (lTop < 0) or ((lTop+lForm.Height) > lVidY) then + lForm.Position := poScreenCenter + else begin + lForm.Position := poDesigned; + lForm.Left := lLeft; + lForm.Top := lTop; + end; +end; + + +procedure TGLForm1.Quit2TextEditor; +{$IFDEF UNIX} +var + AProcess: TProcess; + {$IFDEF LINUX} I: integer; EditorFName : string; {$ENDIF} +begin + {$IFDEF LINUX} + EditorFName := FindDefaultExecutablePath('gedit'); + if EditorFName = '' then + EditorFName := FindDefaultExecutablePath('tea'); + if EditorFName = '' then + EditorFName := FindDefaultExecutablePath('nano'); + if EditorFName = '' then + EditorFName := FindDefaultExecutablePath('pico'); + if EditorFName = '' then begin + Showmessage(ExtractFilename(paramstr(0))+' will now quit. You can then use a text editor to modify the file '+IniName); + Clipboard.AsText := EditorFName; + end else begin + EditorFName := '"'+EditorFName +'" "'+IniName+'"'; + Showmessage(ExtractFilename(paramstr(0))+' will now quit. Modify the settings with the command "'+EditorFName+'"'); + AProcess := TProcess.Create(nil); + AProcess.InheritHandles := False; + AProcess.Options := [poNewProcessGroup, poNewConsole]; + AProcess.ShowWindow := swoShow; + for I := 1 to GetEnvironmentVariableCount do + AProcess.Environment.Add(GetEnvironmentString(I)); + AProcess.Executable := EditorFName; + AProcess.Execute; + AProcess.Free; + end; + Clipboard.AsText := EditorFName; + GLForm1.close; + exit; + {$ENDIF} + Showmessage('Preferences will be opened in a text editor. The program '+ExtractFilename(paramstr(0))+' will now quit, so that the file will not be overwritten.'); + AProcess := TProcess.Create(nil); + {$IFDEF UNIX} + //AProcess.CommandLine := 'open -a TextEdit '+IniName; + AProcess.Executable := 'open'; + AProcess.Parameters.Add('-e'); + AProcess.Parameters.Add(IniName); + {$ELSE} + AProcess.CommandLine := 'notepad '+IniName; + {$ENDIF} + Clipboard.AsText := AProcess.CommandLine; + //AProcess.Options := AProcess.Options + [poWaitOnExit]; + AProcess.Execute; + AProcess.Free; + GLForm1.close; +end; + +{$ELSE} //ShellExecute(Handle,'open', 'c:\windows\notepad.exe','c:\SomeText.txt', nil, SW_SHOWNORMAL) ; +begin + gPrefs.SkipPrefWriting := true; + Showmessage('Preferences will be opened in a text editor. The program '+ExtractFilename(paramstr(0))+' will now quit, so that the file will not be overwritten.'); + //GLForm1.SavePrefs; + ShellExecute(Handle,'open', 'notepad.exe',PAnsiChar(AnsiString(IniName)), nil, SW_SHOWNORMAL) ; + //WritePrefsOnQuit.checked := false; + GLForm1.close; +end; +{$ENDIF} + +procedure TGLForm1.DepthLabelDblClick(Sender: TObject); +begin + gPrefs.OverlayClip := not gPrefs.OverlayClip; + GLBoxRequestUpdate(Sender); +end; + +procedure TGLForm1.CurvMenuClick(Sender: TObject); +var + fnm: string; + isTemp: boolean; +begin + if length(gMesh.Faces) < 1 then begin + showmessage('Unable to compute curvature: no mesh is loaded (use File/Open).'); + exit; + end; + isTemp := (Sender as TMenuItem).Tag = 1; + fnm := changefileext(gPrefs.PrevFilename[1],'.curv'); + if isTemp then begin + //fnm := DesktopFolder + ExtractFileName(fnm); + fnm := DefaultToHomeDir(fnm, true); + end; + if fileexists(fnm) then begin + showmessage('File already exists '+fnm); + exit; + end; + if (length(gMesh.vertexRGBA) > 0) then + GenerateCurvRGB(fnm, gMesh.vertexRGBA, length(gMesh.faces)) + else + GenerateCurv(fnm, gMesh.faces, gMesh.vertices, gPrefs.GenerateSmoothCurves); + OpenOverlay(fnm); + if isTemp then + deletefile(fnm); +end; + +procedure TGLForm1.NewWindow1Click(Sender: TObject); +{$IFNDEF UNIX} +begin + ShellExecute(handle,'open',PChar(paramstr(0)), '','',SW_SHOWNORMAL); //uses ShellApi; +end; +{$ELSE} +var + AProcess: TProcess; + i : integer; + //http://wiki.freepascal.org/Executing_External_Programs +begin + IniFile(false,IniName,gPrefs); //load new window with latest settings + AProcess := TProcess.Create(nil); + AProcess.InheritHandles := False; + //AProcess.Options := [poNoConsole]; //poNoConsole is Windows only! http://lazarus-ccr.sourceforge.net/docs/fcl/process/tprocess.options.html + //AProcess.ShowWindow := swoShow; //Windows only http://www.freepascal.org/docs-html/fcl/process/tprocess.showwindow.html + for I := 1 to GetEnvironmentVariableCount do + AProcess.Environment.Add(GetEnvironmentString(I)); + {$IFDEF Darwin} + AProcess.Executable := 'open'; + AProcess.Parameters.Add('-n'); + AProcess.Parameters.Add('-a'); + AProcess.Parameters.Add(paramstr(0)); + {$ELSE} + AProcess.Executable := paramstr(0); + {$ENDIF} + //AProcess.Parameters.Add('/Users/rorden/Documents/osx/MRIcroGL.app/Contents/MacOS/MRIcroGL'); + AProcess.Execute; + AProcess.Free; +end; +{$ENDIF} + +procedure TGLForm1.CenterMeshMenuClick(Sender: TObject); +begin + gMesh.CenterOrigin; + GLBoxRequestUpdate(Sender); +end; + +{$IFDEF Darwin} +function GetHardwareVersion: string; +//returns number of CPUs for MacOSX computer +//example - will return 4 if the computer has two dual core CPUs +//requires Process in Uses Clause +//see http://wiki.lazarus.freepascal.org/Executing_External_Programs +var + lProcess: TProcess; + lStringList: TStringList; +begin + Result := ''; + lProcess := TProcess.Create(nil); + lStringList := TStringList.Create; + lProcess.CommandLine := 'sysctl hw.model'; + lProcess.Options := lProcess.Options + [poWaitOnExit, poUsePipes]; + lProcess.Execute; + lStringList.LoadFromStream(lProcess.Output); + if lStringList.Count > 0 then + result := lStringList.Strings[0]; + lStringList.Free; + lProcess.Free; +end; + +function GetOSVersion: string; +//returns number of CPUs for MacOSX computer +//example - will return 4 if the computer has two dual core CPUs +//requires Process in Uses Clause +//see http://wiki.lazarus.freepascal.org/Executing_External_Programs +var + lProcess: TProcess; + lStringList: TStringList; +begin + Result := ''; + lProcess := TProcess.Create(nil); + lStringList := TStringList.Create; + lProcess.CommandLine := 'sw_vers'; + lProcess.Options := lProcess.Options + [poWaitOnExit, poUsePipes]; + lProcess.Execute; + lStringList.LoadFromStream(lProcess.Output); + if lStringList.Count > 1 then + result := lStringList.Strings[1]; + lStringList.Free; + lProcess.Free; +end; +{$ENDIF} + +{$IFDEF Darwin} +function isExeReadOnly: string; +var + attr : Longint; +begin + result := ' missing'; + if not fileexists(paramstr(0)) then exit; + attr:=FileGetAttr(paramstr(0)); + If (attr and faReadOnly)<>0 then + result := ' read only' + else + result := ' writeable'; +end; +{$ENDIF} + +procedure TGLForm1.AboutMenuClick(Sender: TObject); +const + kSamp = 36; +var + fpsStr, titleStr, isAtlasStr, TrackStr, MeshStr, str: string; + s: dword; + i: integer; + scale: single; + origin: TPoint3f; +begin + MeshStr := ''; + if length(gMesh.vertices) > 0 then begin + MeshStr := LineEnding + format(' %.4f..%.4f %.4f..%.4f %.4f..%.4f',[gMesh.mnV.X, gMesh.mxV.X, gMesh.mnV.Y, gMesh.mxV.Y, gMesh.mnV.Z, gMesh.mxV.Z]); + end; + TrackStr := ''; + if (gTrack.n_count > 0) then begin + if not gTrack.isWorldSpaceMM then + TrackStr := 'Spatial Properties Underspecified'; + TrackStr := LineEnding + format(' %s %.4f..%.4f %.4f..%.4f %.4f..%.4f',[TrackStr, gTrack.mnV.X, gTrack.mxV.X, gTrack.mnV.Y, gTrack.mxV.Y, gTrack.mnV.Z, gTrack.mxV.Z]); + end; + s := gettickcount(); + for i := 1 to kSamp do begin + gAzimuth := (gAzimuth + 10) mod 360; + GLbox.Repaint; + end; + fpsStr := ''; + if (gettickcount<> s) then + fpsStr := LineEnding+' FPS ' +inttostr(round( (kSamp*1000)/(gettickcount-s))); + origin := GetOrigin(scale); + isAtlasStr := ''; + if (length(gMesh.vertexAtlas) > 0) then isAtlasStr := ' Indexed Atlas '; + str := 'Surf Ice '+kVers+' ' + {$IFDEF CPU64} + '64-bit' + {$ELSE} + '32-bit' + {$ENDIF} + {$IFDEF LCLCarbon} + ' Carbon'{$ENDIF} + {$IFDEF LCLCocoa} + ' Cocoa'{$ENDIF} + {$IFDEF Linux} + ' Linux'{$ENDIF} + {$IFDEF Windows} + ' Windows'{$ENDIF} + {$IFDEF DGL} + ' DGL'{$ENDIF} + {$IFNDEF COREGL}+' (Legacy OpenGL)'{$ENDIF} + {$IFDEF Darwin} + {$IFDEF LCLCocoa} + +''; titleStr := Str; str := ' '+GetHardwareVersion + +LineEnding+' '+ GetOSVersion + {$ELSE} + +LineEnding+' @: '+ AppDir2 + +LineEnding+' '+ isExeReadOnly + +LineEnding+' '+GetHardwareVersion + +LineEnding+' '+ GetOSVersion + {$ENDIF} + {$ENDIF} + +LineEnding+' www.mricro.com :: BSD 2-Clause License (opensource.org/licenses/BSD-2-Clause)' + +FPSstr + +LineEnding+format(' Scale %.4f',[scale]) + +LineEnding+format(' Origin %.4fx%.4fx%.4f',[origin.X, origin.Y, origin.Z]) + +LineEnding+' Mesh Vertices '+inttostr(length(gMesh.vertices))+' Faces '+ inttostr(length(gMesh.faces)) +' Colors '+ inttostr(length(gMesh.vertexRGBA)) + +isAtlasStr + +MeshStr + +LineEnding+' Track Vertices '+inttostr(gTrack.n_vertices)+' Faces '+ inttostr(gTrack.n_faces) +' Count ' +inttostr(gTrack.n_count) + +TrackStr + +LineEnding+' Node Vertices '+inttostr(length(gNode.vertices))+' Faces '+ inttostr(length(gNode.faces)) + +LineEnding+' GPU '+gShader.Vendor; + {$IFDEF LCLCocoa} + ClipBoard.AsText:= titleStr + LineEnding + str; + //ShowAlertSheet(GLForm1.Handle,titleStr, str); //<- limited string length! + MessageDlg(titleStr,str,mtInformation,[mbOK],0); + {$ELSE} + ClipBoard.AsText:= str; + MessageDlg(str,mtInformation,[mbOK],0); + {$ENDIF} + //i := MessageDlg(str,mtInformation,[mbAbort, mbOK],0); + //if i = mrAbort then Quit2TextEditor; +end; + +procedure TGLForm1.AddNodesMenuClick(Sender: TObject); +const + kNodeFilter = 'BrainNet Node/Edge|*.node;*.nodz;*.edge|Any file|*.*'; +var + ext, f2: string; +begin + if Fileexists(gPrefs.PrevNodename) then begin + OpenDialog.InitialDir := ExtractFileDir(gPrefs.PrevNodename); + OpenDialog.Filename := gPrefs.PrevNodename; + end; + OpenDialog.Filter := kNodeFilter; + OpenDialog.Title := 'Select Node/Edge file'; + if not OpenDialog.Execute then exit; + if FSize(OpenDialog.Filename) < 1 then + showmessage('Unable to open file (check permissions) '+ OpenDialog.Filename); + //OpenDialog.FileName := '/Users/rorden/Desktop/obj/myNodes.node'; + ext := UpperCase(ExtractFileExt(OpenDialog.Filename)); + if (ext = '.EDGE') and (length(gNode.nodes) < 1) then begin + f2 := changefileext(OpenDialog.FileName, '.node'); + if fileexists(f2) then + OpenNode(f2) + else begin + showmessage('Please load your NODE file before loading an edge file'); + exit; + end; + end; + if (ext = '.EDGE') then + OpenEdge(OpenDialog.FileName) + else + OpenNode(OpenDialog.FileName); + //OpenEdge('/Users/rorden/Desktop/obj/Edge_Brodmann82.edge'); + UpdateToolbar; +end; + +procedure TGLForm1.AddOverlayMenuClick(Sender: TObject); +const +{$IFDEF FOREIGNVOL} + //kVolFilter = 'Neuroimaging (*.nii)|*.hdr;*.nii;*.nii.gz;*.voi;*.HEAD;*.mgh;*.mgz;*.mha;*.mhd;*.nhdr;*.nrrd'; + kOverlayFilter = 'Mesh (e.g. GIfTI) or Volume (e.g. NIfTI) |*.*'; +{$ELSE} +kOverlayFilter = 'Mesh or NIfTI|*.*'; +{$ENDIF} +begin + OpenDialog.Filter := kOverlayFilter; + OpenDialog.Title := 'Select overlay file'; + if Fileexists(gPrefs.PrevOverlayname) then begin + OpenDialog.InitialDir := ExtractFileDir(gPrefs.PrevOverlayname); + OpenDialog.FileName := gPrefs.PrevOverlayname; + end; + if not OpenDialog.Execute then exit; + if FSize(OpenDialog.Filename) < 1 then + showmessage('Unable to open file (check permissions) '+ OpenDialog.Filename); + //OpenDialog.FileName := ('/Users/rorden/Desktop/Surf_Ice/other/motor_4t95vol.nii.gz'); + //OpenDialog.FileName := ('/Users/rorden/Desktop/Surf_Ice/other/motor_4t95mesh.gii'); + OpenOverlay(OpenDialog.FileName); +end; + +procedure TGLForm1.AddTracksMenuClick(Sender: TObject); +begin + OpenDialog.Filter := kTrackFilter; + OpenDialog.Title := 'Select track file'; + if Fileexists(gPrefs.PrevTrackname) then begin + OpenDialog.InitialDir := ExtractFileDir(gPrefs.PrevTrackname); + OpenDialog.Filename := gPrefs.PrevTrackname; + end; + if not OpenDialog.Execute then exit; + if FSize(OpenDialog.Filename) < 1 then + showmessage('Unable to open file (check permissions) '+ OpenDialog.Filename); + //OpenDialog.Filename := '/Users/rorden/Desktop/Surf_Ice/sample/stroke.trk'; + OpenTrack(OpenDialog.FileName); +end; + +procedure TGLForm1.AzimuthLabelClick(Sender: TObject); +begin + IncTrackBar(ClipAziTrack, false); +end; + +procedure TGLForm1.BackColorMenuClick(Sender: TObject); +begin + If (ssShift in KeyDataToShiftState(vk_Shift)) then begin + if green(gPrefs.BackColor) > 128 then + gPrefs.BackColor := RGBToColor(0,0,0) + else + gPrefs.BackColor := RGBToColor(255,255,255); + GLBoxRequestUpdate(Sender); + exit; + end; + ColorDialog1.color := gPrefs.BackColor; + if not ColorDialog1.Execute then exit; + gPrefs.BackColor := ColorDialog1.Color; + GLBoxRequestUpdate(Sender); +end; + +procedure TGLForm1.CopyMenuClick(Sender: TObject); +var + bmp: TBitmap; +begin + bmp := ScreenShot(); + Clipboard.Assign(bmp); + bmp.Free; +end; + +procedure TGLForm1.DepthLabelClick(Sender: TObject); +begin + if ClipTrack.Position > 900 then + ClipTrack.Position := 0 + else + ClipTrack.Position := 100 * ((ClipTrack.Position +100) div 100); +end; + +procedure TGLForm1.DisplayMenuClick(Sender: TObject); +begin + case (Sender as TMenuItem).tag of + 0: gAzimuth := 270; //left + 1: gAzimuth := 90; //right + 3: gAzimuth := 180;//anterior + 4: gAzimuth := 180;//inferior + else gAzimuth := 0; //posterior, inferior, superior + end; + case (Sender as TMenuItem).tag of + 4: gElevation := -90; //inferior + 5: gElevation := 90;//superior + else gElevation := 0; //other + end; + GLBox.Invalidate; +end; + +procedure TGLForm1.ElevationLabelClick(Sender: TObject); +begin + IncTrackBar(ClipElevTrack, false); +end; + +procedure TGLForm1.ErrorTimerTimer(Sender: TObject); +begin + ErrorTimer.Enabled := false; + Showmessage(GLError); + GLerror := ''; +end; + +procedure TGLForm1.SetDistance(Distance: single); +begin + gDistance := Distance; + if gDistance > kMaxDistance then gDistance := kMaxDistance; + if gDistance < kMinDistance then gDistance := kMinDistance; + GLBox.Invalidate; +end; + +procedure TGLForm1.GLBoxMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); +begin + if abs(WheelDelta) < 5 then exit; + if WheelDelta < 0 then + SetDistance(gDistance * 0.9) + else + SetDistance(gDistance * 1.1); +end; + +function TGLForm1.ComboBoxName2Index(var lCombo: TComboBox; lName: string): integer; +var + lNameU, lItem : string; + i: integer; +begin + result := 0; + if lCombo.Items.Count < 2 then exit; + lNameU := uppercase(lName); + i := 0; + while i < lCombo.Items.Count do begin + lItem := uppercase (lCombo.Items[i]); + if (lItem = lNameU) then begin + result := i; + i := maxint-1; + end; + i := i + 1; + end;//for each shader +end; + +procedure TGLForm1.OVERLAYCOLORNAME(lOverlay: integer; lFilename: string); +var + lLUTIndex: integer; + //lName, lItem : string; +begin + if (gMesh.OpenOverlays < 1) or (lOverlay > gMesh.OpenOverlays) then exit; + lLUTIndex := ComboBoxName2Index(LayerColorDrop, lFilename); + UpdateLUT(lOverlay,lLUTIndex); + //LayerWidgetChange(nil); + UpdateLayerBox(false); +end; + +procedure TGLForm1.NodePrefChange(Sender: TObject); +var + lo, hi: single; +begin + gNode.nodePrefs.scaleNodeSize := NodeScaleTrack.Position / 10; + gNode.nodePrefs.nodeLUTindex := LUTdropNode.itemIndex; + gNode.nodePrefs.isEdgeSizeVaries := EdgeSizeVariesCheck.checked; + gNode.nodePrefs.isNodeColorVaries := NodeColorVariesCheck.checked; + gNode.nodePrefs.isEdgeColorVaries := EdgeColorVariesCheck.checked; + lo := nodeMinEdit.Value; + hi := nodeMaxEdit.value; + sortsingle(lo, hi); + gNode.nodePrefs.minNodeThresh := lo; + gNode.nodePrefs.maxNodeThresh := hi; + gNode.nodePrefs.edgeLUTindex:= LUTdropEdge.itemIndex; + gNode.nodePrefs.scaleEdgeSize:= edgeScaleTrack.Position / 10; + lo := edgeMinEdit.Value; + hi := edgeMaxEdit.value; + sortsingle(lo, hi); + gNode.nodePrefs.minEdgeThresh := lo; + gNode.nodePrefs.maxEdgeThresh := hi; + Memo1.Lines.clear; + Memo1.Lines.Add(format('Node size range min..max %.4g..%.4g',[gNode.NodePrefs.minNodeSize, gNode.nodePrefs.maxNodeSize])); + Memo1.Lines.Add(format('Node color range min..max %.4g..%.4g',[gNode.NodePrefs.minNodeColor, gNode.nodePrefs.maxNodeColor])); + Memo1.Lines.Add(format('Node scale %.2g',[gNode.nodePrefs.scaleNodeSize])); + Memo1.Lines.Add(format('Node color table %d',[gNode.nodePrefs.nodeLUTindex]) ); + if NodeThreshDrop.ItemIndex = 0 then begin + gNode.nodePrefs.isNodeThresholdBySize := true; + Memo1.Lines.Add(format('Node size threshold min..max %.4g..%.4g',[gNode.NodePrefs.minNodeThresh, gNode.nodePrefs.maxNodeThresh])); + end else begin + gNode.nodePrefs.isNodeThresholdBySize := false; + Memo1.Lines.Add(format('Node color threshold min..max %.4g..%.4g',[gNode.NodePrefs.minNodeThresh, gNode.nodePrefs.maxNodeThresh])); + end; + Memo1.Lines.Add(format('Edge range min..max %.4g..%.4g',[gNode.NodePrefs.minEdge, gNode.nodePrefs.maxEdge])); + Memo1.Lines.Add(format('Edge threshold min..max %.4g..%.4g',[gNode.NodePrefs.minEdgeThresh, gNode.nodePrefs.maxEdgeThresh])); + Memo1.Lines.Add(format('Edge color table %d',[gNode.nodePrefs.edgeLUTindex]) ); + Memo1.Lines.Add(format('Edge scale %.2g',[gNode.nodePrefs.scaleEdgeSize]) ); + gNode.isRebuildList := true; + gnLUT := -1; //refresh colorbar + GLBoxRequestUpdate(Sender); +end; + +procedure TGLForm1.OrientCubeMenuClick(Sender: TObject); +begin + gPrefs.OrientCube := OrientCubeMenu.Checked; + GLBoxRequestUpdate(Sender); +end; + +procedure TGLForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction); +begin + IniFile(false,IniName,gPrefs); +end; + +procedure TGLForm1.ExitMenuClick(Sender: TObject); +begin + //GLForm1.Close; + Self.Close; + //Application.Terminate; +end; + +procedure TGLForm1.ObjectColorMenuClick(Sender: TObject); +begin + ColorDialog1.color := gPrefs.ObjColor; + if not ColorDialog1.Execute then exit; + gPrefs.objColor := ColorDialog1.Color; + {$IFDEF COREGL} + gMesh.isRebuildList := true; + {$ENDIF} + GLBoxRequestUpdate(Sender); +end; + +procedure TGLForm1.OpenMenuClick(Sender: TObject); +const + kMeshFilter = 'Mesh (GIfTI, PLY, FreeSurfer, etc)|*.*'; +begin + if (ssCtrl in KeyDataToShiftState(vk_Shift)) then begin + OpenMesh('-'); + exit; + end; + OpenDialog.Filter := kMeshFilter; + OpenDialog.Title := 'Select mesh file'; + if Fileexists(gPrefs.PrevFilename[1]) then begin + OpenDialog.InitialDir := ExtractFileDir(gPrefs.PrevFilename[1]); + OpenDialog.Filename := gPrefs.PrevFilename[1]; + end; + if not OpenDialog.Execute then exit; + if FSize(OpenDialog.Filename) < 1 then + showmessage('Unable to open file (check permissions) '+ OpenDialog.Filename); + OpenMesh(OpenDialog.Filename); +end; + +procedure TGLForm1.OverlayBoxCreate; +var + lSearchRec: TSearchRec; + lStr: string; +begin + LUTdropNode.Items.Clear; + LUTdropNode.Items.Add('Grayscale'); + LUTdropNode.Items.Add('Red-Yellow'); + LUTdropNode.Items.Add('Blue-Green'); + LUTdropNode.Items.Add('Red'); + LUTdropNode.Items.Add('Green'); + LUTdropNode.Items.Add('Blue'); + LUTdropNode.Items.Add('Violet [r+b]'); + LUTdropNode.Items.Add('Yellow [r+g]'); + LUTdropNode.Items.Add('Cyan [g+b]'); + LUTdropNode.Items.Add('Hot'); + LUTdropNode.Items.Add('Bone'); + LUTdropNode.Items.Add('Winter'); + LUTdropNode.Items.Add('GE'); + LUTdropNode.Items.Add('ACTC'); + LUTdropNode.Items.Add('X-Rain'); + LUTdropNode.Items.Add('FreeSurfer1'); + LUTdropNode.Items.Add('FreeSurfer2'); + LUTdropNode.Items.Add('FreeSurfer3'); + LUTdropNode.Items.Add('FreeSurfer4'); + if DirectoryExists(ClutDir) then begin + if FindFirst(CLUTdir+pathdelim+'*.clut', faAnyFile, lSearchRec) = 0 then + repeat + lStr := ChangeFileExt (ExtractFileName (lSearchRec.Name), ''); + if (length(lStr) > 0) and (lStr[1] <> '.') then + LUTdropNode.Items.Add(lStr); + until (FindNext(lSearchRec) <> 0); + FindClose(lSearchRec); + end; + LUTdropEdge.Items := LUTdropNode.Items; + LayerColorDrop.Items.Clear; + LayerColorDrop.Items := LUTdropNode.Items; + LUTdropNode.ItemIndex := 3; + LUTdropEdge.ItemIndex := 1; + //Copy names for tracks + TrackScalarLUTdrop.Items.Clear; + TrackScalarLUTdrop.Items := LUTdropNode.Items; + TrackScalarLUTdrop.ItemIndex := 1; + //TrackScalarLUTdrop.Items.AddStrings := LUTdrop.Items; +end; + +procedure TGLForm1.OverlayTimerTimer(Sender: TObject); +begin + OverlayTimer.Enabled := false; + gMesh.isRebuildList:= true; + gMesh.isAdditiveOverlay := gPrefs.AdditiveOverlay; + {$IFDEF FPC}{$IFDEF Windows} + //StringGrid1.Refresh; + {$ENDIF}{$ENDIF} + gnLUT := -1; //refresh colorbar + GLbox.Invalidate; +end; + +{$IFDEF JPG} +{$IFDEF FPC} +procedure SaveImgAsJPGCore (lImage: TBitmap; lFilename: string); +var + JpegImg : TJpegImage; +begin + JpegImg := TJpegImage.Create; + try + JpegImg.Assign(lImage) ; + JpegImg.SaveToFile(ChangeFileExt(lFilename,'.jpg')) ; + finally + JpegImg.Free + end; +end; +{$ELSE} +procedure SaveImgAsJPGCore (lImage: TBitmap; lFilename: string); +begin + lImage.SaveToFile(ChangeFileExt(lFilename,'.bmp')); +end; +{$ENDIF} +{$ENDIF} +procedure TGLForm1.SaveBitmap(FilenameIn: string; lX, lY: integer); overload; + var + bmp: TBitmap; + png: TPortableNetworkGraphic; + p,n,x,ext, filename: string; + z: integer; + {$IFDEF LCLCocoa}retina: boolean; {$ENDIF} + begin + FilenameParts (FilenameIn,p,n,x); + if (p ='') or (not directoryexists(p)) then + p := DesktopFolder; + if (n = '') then n := 'SurfIce'; + if (x = '') then x := '.png'; + Filename := p+n+x; + z := gPrefs.ScreenCaptureZoom; + GLBox.Align := alNone; + GLBox.Width:=lX; + GLBox.Height:=lY; + {$IFDEF LCLCocoa} + if (gPrefs.RetinaDisplay) then begin + retina := gPrefs.RetinaDisplay; + gPrefs.RetinaDisplay := false; + setRetina; + end; + {$ENDIF} + GLBox.ClientWidth:=lX; + GLBox.ClientHeight:=lY; + gPrefs.ScreenCaptureZoom:=1; + GLBox.Invalidate; + bmp := ScreenShot(true); + GLBox.Align := alClient; + {$IFDEF LCLCocoa} + if (retina) then begin + gPrefs.RetinaDisplay := true; + setRetina; + end; + {$ENDIF} + GLBox.Invalidate; + gPrefs.ScreenCaptureZoom := z; + {$IFDEF JPG} + //JPEG + ext := upcase(x); + if (ext = '.JPEG') or (ext = '.JPG') then begin + SaveImgAsJPGCore (bmp, Filename); + exit; + end; + {$ENDIF} + //PNG + png := TPortableNetworkGraphic.Create; + try + png.Assign(bmp); //Convert data into png + png.SaveToFile(changefileext(Filename,'.png')); + finally + png.Free; + end; + bmp.Free; +end; + + +procedure TGLForm1.SaveBitmap(FilenameIn: string); overload; + var + bmp: TBitmap; + png: TPortableNetworkGraphic; + p,n,x,ext, filename: string; + begin + FilenameParts (FilenameIn,p,n,x); + if (p ='') or (not directoryexists(p)) then + p := DesktopFolder; + if (n = '') then n := 'SurfIce'; + if (x = '') then x := '.png'; + Filename := p+n+x; + bmp := ScreenShot; + {$IFDEF JPG} + //JPEG + ext := upcase(x); + if (ext = '.JPEG') or (ext = '.JPG') then begin + SaveImgAsJPGCore (bmp, Filename); + exit; + end; + {$ENDIF} + //PNG + png := TPortableNetworkGraphic.Create; + try + png.Assign(bmp); //Convert data into png + png.SaveToFile(changefileext(Filename,'.png')); + finally + png.Free; + end; + bmp.Free; +end; + +procedure TGLForm1.SaveMenuClick(Sender: TObject); +begin + if not SaveBitmapDialog.execute then exit; + SaveBitmap(SaveBitmapDialog.Filename); +end; + +procedure TGLForm1.SaveMz3(var mesh: TMesh; isSaveOverlays: boolean); +var + i : integer; + nam: string; +begin + //showmessage(inttostr(gMesh.OpenOverlays)); exit; + Mesh.SaveMz3(SaveMeshDialog.Filename); + if not isSaveOverlays then exit; + for i := 1 to gMesh.OpenOverlays do begin + nam := changefileext(SaveMeshDialog.Filename, '_'+inttostr(i)+extractfileext(SaveMeshDialog.Filename)); + gMesh.SaveOverlay(nam, i); + end; +end; + +//{$DEFINE XL} +{$IFDEF XL} +procedure TGLForm1.SaveMesh(var mesh: TMesh; isSaveOverlays: boolean); +var + xSaveMeshDialog: TSaveDialog; +begin + xSaveMeshDialog := TSaveDialog.Create(self); + xSaveMeshDialog.Filter := '';//'gz|*.gz|nii.gz|*.nii.gz|nii|*.nii|roi|*.roi'; + xSaveMeshDialog.Filename := 'SaveName'; + //xSaveMeshDialog.FilterIndex:= 2; + xSaveMeshDialog.DefaultExt := ''; + if not xSaveMeshDialog.Execute then exit; + Caption := xSaveMeshDialog.Filename; + xSaveMeshDialog.Free; +end; +(*procedure TGLForm1.SaveMesh(var mesh: TMesh; isSaveOverlays: boolean); +begin + SaveMeshDialog.Filter := 'gz|*.gz|nii.gz|*.nii.gz|nii|*.nii|roi|*.roi'; + SaveMeshDialog.Filename := 'SaveName'; + SaveMeshDialog.FilterIndex:= 2; + SaveMeshDialog.DefaultExt := '.roi'; + if not SaveMeshDialog.Execute then exit; + Caption := SaveMeshDialog.Filename; +end; *) +{$ELSE} +procedure TGLForm1.SaveMesh(var mesh: TMesh; isSaveOverlays: boolean); +const + kMeshFilter = 'OBJ (Widely supported)|*.obj|GIfTI (Neuroimaging)|*.gii|MZ3 (Small and fast)|*.mz3|PLY (Widely supported)|*.ply'; +var + nam, ext, x: string; +begin + if length(mesh.Faces) < 1 then begin + showmessage('Unable to save: no mesh is loaded (use File/Open).'); + exit; + end; + SaveMeshDialog.Filter := kMeshFilter; + SaveMeshDialog.FilterIndex := gPrefs.SaveAsFormat + 1; + if gPrefs.SaveAsFormat = 4 then + ext := '.ply' + else if gPrefs.SaveAsFormat = 0 then + ext := '.obj' + else if gPrefs.SaveAsFormat = 1 then + ext := '.gii' + else + ext := '.mz3'; + SaveMeshDialog.DefaultExt := ext; + if (fileexists(gPrefs.PrevFilename[1])) or (not isSaveOverlays) then begin + if isSaveOverlays then + nam := gPrefs.PrevFilename[1] + else + nam := SaveMeshDialog.Filename; + SaveMeshDialog.InitialDir:= ExtractFileDir(nam); + //nam := ChangeFileExtX(extractfilename (nam), ext); + nam := ChangeFileExtX(extractfilename (nam), ''); + SaveMeshDialog.Filename := nam; + end else + SaveMeshDialog.Filename := ''; + if not SaveMeshDialog.Execute then exit; + if length(SaveMeshDialog.Filename) < 1 then exit; + //caption := inttostr(SaveMeshDialog.FilterIndex)+' '+SaveMeshDialog.Filename; exit; //666 + x := UpperCase(ExtractFileExt(SaveMeshDialog.Filename)); + if (x <> '.MZ3') and (x <> '.PLY') and (x <> '.OBJ') and (x <> '.GII') then begin + x := ext; + SaveMeshDialog.Filename := SaveMeshDialog.Filename + x; + end; + if (x = '.MZ3') then + SaveMz3(mesh, isSaveOverlays) + else if (x = '.GII') then + mesh.SaveGii(SaveMeshDialog.Filename) + else if (x = '.PLY') then + mesh.SavePly(SaveMeshDialog.Filename) + else + mesh.SaveObj(SaveMeshDialog.Filename); +end; +{$ENDIF} + +function TGLForm1.SaveMeshCore(lFilename: string): boolean; +var + x: string; +begin + result := false; + if (lFilename = '') or (length(gMesh.Faces) < 1) then begin + exit; + end; + result := true; + x := UpperCase(ExtractFileExt(lFilename)); + if (x <> '.MZ3') and (x <> '.PLY') and (x <> '.OBJ') and (x <> '.GII') then begin + x := '.MZ3'; + lFilename := lFilename + x; + end; + if (x = '.MZ3') then + gMesh.SaveMz3(lFilename) + else if (x = '.GII') then + gMesh.SaveGii(lFilename) + else if (x = '.PLY') then + gMesh.SavePly(lFilename) + else + gMesh.SaveObj(lFilename); +end; + + +procedure TGLForm1.SaveMeshMenuClick(Sender: TObject); +begin + SaveMesh(gMesh, true); +end; + +(*procedure TGLForm1.SaveMeshMenuClick(Sender: TObject); +const + kMeshFilter = 'OBJ (Widely supported)|*.obj|GIfTI (Neuroimaging)|*.gii|MZ3 (Small and fast)|*.mz3|PLY (Widely supported)|*.ply'; +var + nam, ext, x: string; +begin + if length(gMesh.Faces) < 1 then begin + showmessage('Unable to save: no mesh is loaded (use File/Open).'); + exit; + end; + SaveMeshDialog.Filter := kMeshFilter; + SaveMeshDialog.FilterIndex := gPrefs.SaveAsFormat + 1; + if gPrefs.SaveAsFormat = 4 then + ext := '.ply' + else if gPrefs.SaveAsFormat = 0 then + ext := '.obj' + else if gPrefs.SaveAsFormat = 1 then + ext := '.gii' + else + ext := '.mz3'; + SaveMeshDialog.DefaultExt := ext; + if fileexists(gPrefs.PrevFilename[1]) then begin + nam := gPrefs.PrevFilename[1]; + nam := changeFileExt(nam, ext); + SaveMeshDialog.Filename := nam; + end else + SaveMeshDialog.Filename := ''; + if not SaveMeshDialog.Execute then exit; + if length(SaveMeshDialog.Filename) < 1 then exit; + x := UpperCase(ExtractFileExt(SaveMeshDialog.Filename)); + if (x <> '.MZ3') and (x <> '.PLY') and (x <> '.OBJ') and (x <> '.GII') then begin + x := ext; + SaveMeshDialog.Filename := SaveMeshDialog.Filename + x; + end; + if (x = '.MZ3') then + SaveMz3 + else if (x = '.GII') then + gMesh.SaveGii(SaveMeshDialog.Filename) + else if (x = '.PLY') then + gMesh.SavePly(SaveMeshDialog.Filename) + else + gMesh.SaveObj(SaveMeshDialog.Filename); +end; *) + +procedure TGLForm1.UniformChange(Sender: TObject); +begin + SurfaceAppearanceChange(Sender); + //ZUniformChange(Sender); + //Updatetimer.enabled := true; +end; + +procedure TGLForm1.UpdateTimerTimer(Sender: TObject); +begin + if isBusy or gMesh.isBusy then exit; //defer + Updatetimer.enabled := false; + if ( gPrefs.initScript <> '') then begin + if (gPrefs.initScript = ('-')) and FileExists(ParamStr(ParamCount)) then begin + gPrefs.initScript := ParamStr(ParamCount); + if (upcase(ExtractFileExt(gPrefs.initScript)) <> '.PY') and (upcase(ExtractFileExt(gPrefs.initScript )) <> '.TXT') then begin + {$IFDEF UNIX}writeln('Assuming file is image not script (not .py or .txt) '+gPrefs.initScript);{$ENDIF} + gPrefs.initScript := ''; + OpenMesh(ParamStr(ParamCount)); + exit; + end; + end; + OpenScript(gPrefs.initScript); + gPrefs.initScript := ''; + Updatetimer.enabled := true; //On MacOS the panels may need to be re-drawn, force a refresh + end; + ToolPanel.Refresh; + GLbox.Invalidate; +end; + +//{$DEFINE RELOADTRACK} + +procedure TGLForm1.FormShow(Sender: TObject); +begin + GLBox.MakeCurrent(false); + gPrefs.SupportBetterRenderQuality := InitGLSL(true); + gCube := TGLCube.Create(GLBox); + //gClrbar:= TGLClrbar.Create(GLBox); + UpdateFont(true); + ClrbarClr(gPrefs.ColorbarColor); + if (gPrefs.ColorbarColor = WhiteClrbarMenu.tag) then WhiteClrbarMenu.checked := true; + if (gPrefs.ColorbarColor = TransWhiteClrbarMenu.tag) then TransWhiteClrbarMenu.checked := true; + if (gPrefs.ColorbarColor = BlackClrbarMenu.tag) then BlackClrbarMenu.checked := true; + if (gPrefs.ColorbarColor = TransBlackClrbarMenu.tag) then TransBlackClrbarMenu.checked := true; + SetColorbarPosition; + GLFinish; + GLBox.ReleaseContext; + MultiPassRenderingToolsUpdate; + ShaderDropChange(sender); + {$IFDEF LCLCocoa} SetDarkMode; {$ENDIF} + //{$IFDEF Windows}UpdateOverlaySpread;{$ENDIF}//July2017 - scripting on High-dpi, reset scaling + if (gPrefs.initScript <> '' ) then + UpdateTimer.enabled := true; +end; + +procedure TGLForm1.FormCreate(Sender: TObject); +var + i: integer; + s : string; + c: char; + forceReset: boolean = false; +begin + DefaultFormatSettings.DecimalSeparator := '.'; //OBJ/GII/Etc write real numbers as 1.23 not 1,23 + FileMode := fmOpenRead; //in case files set with read-only permissions + //check if user includes parameters + gPrefs.initScript := ''; //e.g. 'c:\dir\script.gls' + i := 1; + + while i <= ParamCount do begin + s := ParamStr(i); + if (length(s)> 1) and (s[1]='-') then begin + c := upcase(s[2]); + if c='R' then + forceReset := true + else if (i < paramcount) and (c='S') then begin + inc(i); + gPrefs.InitScript := ParamStr(i); + end; + end;// else if fileexists(ParamStr(i)) then //length > 1 char + //gPrefs.InitScript := ParamStr(i); + inc(i); + end; //for each parameter + //launch program + CreateMRU; + FormCreateShaders; + gPrefs.RenderQuality:= kRenderBetter;// kRenderPoor; ; + if (not ResetIniDefaults) and (not forceReset) then + IniFile(true,IniName,gPrefs) + else begin + SetDefaultPrefs(gPrefs,true, true);//reset everything to defaults! + if MessageDlg('Use advanced graphics? Press "Yes" for better quality. Press "Cancel" for old hardware.', mtConfirmation, [mbYes, mbCancel], 0) = mrCancel then + gPrefs.RenderQuality:= kRenderPoor; + end; + //initscript: + if (not forceReset) and (gPrefs.InitScript = '') and (gPrefs.StartupScript) then begin + s := ScriptDir + pathdelim + 'startup.py'; + if (fileexists(s)) then + gPrefs.InitScript := s; + s := ScriptDir + pathdelim + 'startup.gls'; + if (gPrefs.InitScript = '') and (fileexists(s)) then + gPrefs.InitScript := s; + if (gPrefs.InitScript = '') and (fileexists(gPrefs.PrevScriptName[1])) then + gPrefs.InitScript := gPrefs.PrevScriptName[1]; + end; + if (gPrefs.InitScript = '') and (ParamCount >= 1) and (not forceReset) and (fileexists(ParamStr(ParamCount))) then + gPrefs.initScript := '-'; //not sure if the user is passing script or file? + OverlayBoxCreate;//after we read defaults + {$IFDEF Darwin} Application.OnDropFiles:= AppDropFiles; {$ENDIF} + //{$IFDEF Windows} //July 2017 - see overlay box create + //StringGrid1.DefaultRowHeight := ScaleY(28,96); + //{$ENDIF} + {$IFDEF LCLCarbon} + GLForm1.OnDropFiles:= nil; //avoid drop for form and application + {$ENDIF} + clipPlane.X := 2; + gMesh := TMesh.Create; + gMesh.isBusy := true; + gNode := TMesh.Create; + gMesh.isZDimIsUp := gPrefs.ZDimIsUp; + gNode.isZDimIsUp := gPrefs.ZDimIsUp; + gTrack := TTrack.Create; + if (gPrefs.TrackTubeSlices > 2) and (gPrefs.TrackTubeSlices < 22) then + gTrack.TrackTubeSlices := gPrefs.TrackTubeSlices; + gTrack.isTubes := gPrefs.TracksAreTubes; + Application.ShowButtonGlyphs:= sbgNever; + GLbox:= TOpenGLControl.Create(CenterPanel); + //GLBox.DepthBits:=16; + GLBox.Parent := GLForm1; + {$IFDEF COREGL} + GLbox.OpenGLMajorVersion:= 3; + GLbox.OpenGLMinorVersion:= 3; + {$IFDEF Linux} + writeln('OpenGL 3.3 with 8/8/8/24 bits of R/G/B/Dpth required. Use glxinfo to test capabilities.'); + {$ENDIF} + {$ELSE} + GLbox.OpenGLMajorVersion:= 2; + GLbox.OpenGLMinorVersion:= 1; + {$IFDEF Linux} + writeln('OpenGL 2.1 with 8/8/8/24 bits of R/G/B/Dpth required. Use glxinfo to test capabilities.'); + {$ENDIF} + {$ENDIF} + GLbox.AutoResizeViewport:= true; // http://www.delphigl.com/forum/viewtopic.php?f=10&t=11311 + if gPrefs.MultiSample then + GLBox.MultiSampling:= 4; + GLBox.OnDblClick := GLboxDblClick; + GLBox.OnMouseDown := GLboxMouseDown; + GLBox.OnMouseMove := GLboxMouseMove; + GLBox.OnMouseUp := GLboxMouseUp; + GLBox.OnClick:= GLBoxClick; + GLBox.OnMouseWheel := GLboxMouseWheel; + GLBox.OnPaint := GLboxPaint; + GLBox.Align := alClient; + {$IFDEF LCLCocoa} + SetRetina;//GLBox.WantsBestResolutionOpenGLSurface:=gPrefs.RetinaDisplay; + {$ENDIF} + + (*{$IFDEF COREGL} + GLbox.OpenGLMajorVersion:= 3; + GLbox.OpenGLMinorVersion:= 3; + {$ELSE} + GLbox.OpenGLMajorVersion:= 2; + GLbox.OpenGLMinorVersion:= 1; + {$ENDIF} + GLbox.AutoResizeViewport:= true; // http://www.delphigl.com/forum/viewtopic.php?f=10&t=11311 + if gPrefs.MultiSample then + GLBox.MultiSampling:= 4; + GLBox.OnMouseDown := GLboxMouseDown; + GLBox.OnMouseMove := GLboxMouseMove; + GLBox.OnMouseUp := GLboxMouseUp; + {$IFDEF LCLCocoa} + SetRetina;//GLBox.WantsBestResolutionOpenGLSurface:=gPrefs.RetinaDisplay; + {$ENDIF} + //GLBox.OnMouseWheel := GLboxMouseWheel; + GLBox.OnPaint := GLboxPaint; + FormCreateShaders;*) + UpdateMRU; + if (gPrefs.OcclusionAmount <> occlusionTrack.Position) and (gPrefs.OcclusionAmount >= 0) and (gPrefs.OcclusionAmount <= 100) then + occlusionTrack.Position:= gPrefs.OcclusionAmount; + ColorBarVisibleMenu.Checked := gPrefs.Colorbar; + + AdditiveOverlayMenu.Checked := gPrefs.AdditiveOverlay; + gMesh.isAdditiveOverlay := gPrefs.AdditiveOverlay; + if gPrefs.InitScript <> '' then + gMesh.MakePyramid + else begin + if (gPrefs.LoadTrackOnLaunch) and fileexists(gPrefs.PrevTrackname) then + OpenTrack(gPrefs.PrevTrackname) + else if fileexists(gPrefs.PrevFilename[1]) then + OpenMesh(gPrefs.PrevFilename[1]) + else + gMesh.MakePyramid; + end; + ScriptingGenerateTemplateMenu(true); + ScriptingGenerateTemplateMenu(false); + + gMesh.isBusy := false; + isBusy := false; + + {$IFDEF Darwin} + //CopyMenu.enabled := false; //https://bugs.freepascal.org/view.php?id=33632 + ScriptingNewMenu.ShortCut := ShortCut(Word('N'), [ssMeta]); + ScriptingRunMenu.ShortCut := ShortCut(Word('R'), [ssMeta]); + CurvMenuTemp.ShortCut:= ShortCut(Word('K'), [ssMeta]); + CloseMenu.ShortCut := ShortCut(Word('W'), [ssMeta]); + SwapYZMenu.ShortCut := ShortCut(Word('X'), [ssMeta]); + //ScriptMenu.ShortCut := ShortCut(Word('Z'), [ssMeta]); + //ScriptMenu.ShortCut := ShortCut(Word('J'), [ssMeta]); + + OpenMenu.ShortCut := ShortCut(Word('O'), [ssMeta]); + SaveMenu.ShortCut := ShortCut(Word('S'), [ssMeta]); + CopyMenu.ShortCut := ShortCut(Word('C'), [ssMeta]); + LeftMenu.ShortCut := ShortCut(Word('L'), [ssCtrl]); + RightMenu.ShortCut := ShortCut(Word('R'), [ssCtrl]); + AnteriorMenu.ShortCut := ShortCut(Word('A'), [ssCtrl]); + PosteriorMenu.ShortCut := ShortCut(Word('P'), [ssCtrl]); + SuperiorMenu.ShortCut := ShortCut(Word('S'), [ssCtrl]); + InferiorMenu.ShortCut := ShortCut(Word('I'), [ssCtrl]); + //HelpMenu.Visible := false; //bizarre Cocoa behavior: crash with overlay box changes?!? + {$ELSE} + HelpMenu.Visible := true; + LeftMenu.ShortCut := ShortCut(Word('L'), [ssAlt]); + RightMenu.ShortCut := ShortCut(Word('R'), [ssAlt]); + AnteriorMenu.ShortCut := ShortCut(Word('A'), [ssAlt]); + PosteriorMenu.ShortCut := ShortCut(Word('P'), [ssAlt]); + SuperiorMenu.ShortCut := ShortCut(Word('S'), [ssAlt]); + InferiorMenu.ShortCut := ShortCut(Word('I'), [ssAlt]); + AppleMenu.Visible := false; + {$ENDIF} + {$IFDEF COREGL} {$IFDEF LCLCarbon} ERROR - Carbon does not support OpenGL core profile: either switch to Cocoa or comment out "COREGL" in opts.inc{$ENDIF} {$ENDIF} + OrientCubeMenu.Checked := gPrefs.OrientCube; + +end; + +procedure TGLForm1.FormDropFiles(Sender: TObject; + const FileNames: array of String); +begin + OpenMesh(Filenames[0]); +end; + +procedure TGLForm1.GLBoxClick(Sender: TObject); +begin + +end; + +procedure TGLForm1.AppDropFiles(Sender: TObject; const FileNames: array of String); +begin + //With MacOS and Lazarus 1.9, thee following code caused OpenMesh to be called twice + //OpenMesh(Filenames[0]); +end; + +end. + diff --git a/mesh.pas b/mesh.pas index 8391190..7315b20 100755 --- a/mesh.pas +++ b/mesh.pas @@ -5083,6 +5083,7 @@ procedure TMesh.LoadVtk(const FileName: string); strlst:=TStringList.Create; FileMode := fmOpenRead; AssignFile(f, FileName); + num_f := 0; Reset(f,1); ReadLnBin(f, str); //signature: '# vtk DataFile' if pos('VTK', UpperCase(str)) <> 3 then begin @@ -5302,8 +5303,18 @@ procedure TMesh.LoadVtk(const FileName: string); end; end; //if binary else ASCII 666: - closefile(f); - strlst.free; + {$DEFINE FSLvtk} //FSL first - triangle winding reversed? + {$IFDEF FSLvtk} + if num_f > 0 then begin + for i := 0 to (num_f -1) do begin + j := faces[i].Y; + faces[i].Y := faces[i].X; + faces[i].X := j; + end; + end; + {$ENDIF} + closefile(f); + strlst.free; end; // LoadVtk() function TMesh.CheckMesh: boolean; @@ -5440,7 +5451,7 @@ function TMesh.LoadFromFile(const FileName: string): boolean; if (ext = '.TRI') then LoadTri(Filename); if (ext = '.ASC') then //https://brainder.org/category/neuroinformatics/file-types/ - LoadAsc_Srf(Filename); + LoadAsc_Srf(Filename); if (ext = '.OBJ') then LoadObj(Filename); if (ext = '.WFR') then @@ -5822,21 +5833,28 @@ function TMesh.LoadAtlasMap(const FileName: string; lOverlayIndex: integer): boo end; function TMesh.LoadDpv(const FileName: string; lOverlayIndex: integer): boolean; +//https://brainder.org/2011/09/25/braindering-with-ascii-files/ label 666; var - num_v: integer; + num_v, iMax, iMin: integer; f: TextFile; + idxMaxInten: single; idxf, v1, v2, v3, inten: single; idx: integer; begin result := false; + idxMaxInten := 0; if (lOverlayIndex < kMinOverlayIndex) or (lOverlayIndex > kMaxOverlays) then exit; num_v := length(vertices); setlength(overlay[lOverlayIndex].intensity, num_v); //vertices = zeros(num_f, 9); FileMode := fmOpenRead; AssignFile(f, FileName); Reset(f); + iMax := -1; + iMin := maxint; + for idx := 0 to (num_v-1) do + overlay[lOverlayIndex].intensity[idx] := 0; idx := 0; while not EOF(f) do begin try @@ -5845,18 +5863,64 @@ function TMesh.LoadDpv(const FileName: string; lOverlayIndex: integer): boolean; continue; end; idx := round(idxf); - if (idx < 1) or (idx > num_v) then begin + if (idx < 0) or (idx > num_v) then begin //when more vertices than background image showmessage('DPV file does not appear to match background mesh: expected indices 1..'+inttostr(num_v)+' not '+inttostr(idx)); goto 666; end; - overlay[lOverlayIndex].intensity[idx-1] := inten; - + if idx > iMax then iMax := idx; + if idx < iMin then iMin := idx; + if idx >= num_v then begin + idxMaxInten := inten; + end else + overlay[lOverlayIndex].intensity[idx] := inten; + end; + if iMax = num_v then begin //prior to 11/2018 PALM indexed from 0 not 1 + for idx := 1 to (num_v-1) do + overlay[lOverlayIndex].intensity[idx-1] := overlay[lOverlayIndex].intensity[idx]; + overlay[lOverlayIndex].intensity[num_v-1] := idxMaxInten; end; + idx := iMax-iMin+1; + if (idx <> num_v) then //when fewer vertices than background image + showmessage(format('DPV file reports %d vertices but background mesh has %d (%d..%d)',[idx, num_v, iMin, iMax])); + result := true; 666: CloseFile(f); end; +function IsCurv(const FileName: string): boolean; +var + sig : array [1..3] of byte; + f: File; + aValsPerVertex, anum_v, anum_f: LongWord; + sz: integer; +begin + result := false; + AssignFile(f, FileName); + FileMode := fmOpenRead; + Reset(f,1); + sz := FileSize(f); + if (sz < 20) then begin + CloseFile(f); + exit; + end; + blockread(f, sig, 3 ); //since these files do not have a file extension, check first 3 bytes "0xFFFFFF" + blockread(f, anum_v, 4 ); //uint32 + blockread(f, anum_f, 4 ); //uint32 + blockread(f, aValsPerVertex, 4 ); //uint32 + {$IFDEF ENDIAN_LITTLE} + SwapLongWord(anum_v); + SwapLongWord(anum_f); + SwapLongWord(aValsPerVertex); + {$ENDIF} + CloseFile(f); + if aValsPerVertex <> 1 then exit; + if (sig[1] <> $FF) or (sig[2] <> $FF) or (sig[3] <> $FF) then //not CURV format + exit; + if (sz <> (15 + (anum_v * 4))) then exit; + result := true; +end; + procedure TMesh.LoadCurv(const FileName: string; lOverlayIndex: integer); //simple format used by Freesurfer BIG-ENDIAN // https://github.com/bonilhamusclab/MRIcroS/blob/master/%2BfileUtils/%2Bpial/readPial.m @@ -6240,12 +6304,13 @@ function TMesh.LoadOverlay(const FileName: string; lLoadSmooth: boolean): boolea exit; end; end; - if (ext = '.DPV') then begin + if (ext = '.DPV') or (ext = '.ASC') then begin if not LoadDPV(FileName, OpenOverlays) then begin OpenOverlays := OpenOverlays - 1; exit; end; end; + if (ext = '.GII') or isCiftiNii then begin if isCiftiNii then begin nOverlays := loadCifti(FileName, OpenOverlays, 1, (origin.X < 0)); @@ -6294,9 +6359,12 @@ function TMesh.LoadOverlay(const FileName: string; lLoadSmooth: boolean): boolea {$ENDIF} LoadNii(FileName, OpenOverlays, lLoadSmooth); end; + if (length(overlay[OpenOverlays].intensity) < 1 ) and (PosEx('.thickness.',FileName) > 1) and (IsCurv(FileName)) then begin + LoadCurv(FileName, OpenOverlays); //CAT12: "rh.thickness.cr" if CURV format file for "rh.central.cr.gii" http://www.neuro.uni-jena.de/cat/ + end; if (length(overlay[OpenOverlays].intensity) < 1 ) then LoadW(FileName, OpenOverlays); - if (length(overlay[OpenOverlays].intensity) < 1 ) then begin + if (length(overlay[OpenOverlays].intensity) < 1 ) and (IsCurv(FileName)) then begin LoadCurv(FileName, OpenOverlays); if (length(overlay[OpenOverlays].intensity) > 0 ) then Overlay[OpenOverlays].LUTindex := 15;//CURV file diff --git a/meshify.pas b/meshify.pas index fbdfb0c..2c35eb3 100755 --- a/meshify.pas +++ b/meshify.pas @@ -5,7 +5,6 @@ interface uses - {$IFNDEF Darwin}uscaledpi, {$ENDIF} meshify_simplify, LCLintf, Classes, SysUtils, mesh, nifti_loader, meshify_marchingcubes, dialogs, define_types, matmath, Forms, StdCtrls, Controls, Spin, clustering, nifti_types; @@ -18,6 +17,7 @@ implementation uses mainunit, prefs; +(*86 function MeshPref(min, max: single; out Thresh, Decim: single; out SmoothStyle, MinClusterVox: integer): boolean; var PrefForm: TForm; @@ -129,6 +129,199 @@ function MeshPref(min, max: single; out Thresh, Decim: single; out SmoothStyle, if (Decim <= 0.0) then Decim := 0.01; end; +*) +function MeshPref(min, max: single; out Thresh, Decim: single; out SmoothStyle, MinClusterVox: integer): boolean; +var + PrefForm: TForm; + OkBtn: TButton; + MinClusterVoxLabel, NoteLabel, ThreshLabel, DecimateLabel: TLabel; + {$IFDEF USEFLOATSPIN} + ThreshEdit: TFloatSpinEdit; //Cocoa TFloatSpinEdit is a bit wonky + {$ELSE} + MinClusterVoxEdit, ThreshEdit: TEdit; + {$ENDIF} + DecimateEdit: TSpinEdit; + SmoothCombo: TComboBox; +begin + PrefForm:=TForm.Create(nil); + //PrefForm.SetBounds(100, 100, 510, 212); + PrefForm.AutoSize := True; + PrefForm.BorderWidth := 8; + + PrefForm.Caption:='Volume to mesh preferences'; + PrefForm.Position := poScreenCenter; + PrefForm.BorderStyle := bsDialog; + //Note + NoteLabel:=TLabel.create(PrefForm); + NoteLabel.Caption:='See NITRC Surf Ice MediaWiki for usage notes'; + //NoteLabel.Left := 8; + //NoteLabel.Top := 8; + NoteLabel.AutoSize := true; + NoteLabel.AnchorSide[akTop].Side := asrTop; + NoteLabel.AnchorSide[akTop].Control := PrefForm; + NoteLabel.BorderSpacing.Top := 6; + NoteLabel.AnchorSide[akLeft].Side := asrLeft; + NoteLabel.AnchorSide[akLeft].Control := PrefForm; + NoteLabel.BorderSpacing.Left := 6; + NoteLabel.Parent:=PrefForm; + //Threshold + ThreshLabel:=TLabel.create(PrefForm); + ThreshLabel.Caption:=format('Threshold (%.4f..%.4f)',[min, max]); + //ThreshLabel.Left := 8; + //ThreshLabel.Top := 42; + ThreshLabel.AutoSize := true; + ThreshLabel.AnchorSide[akTop].Side := asrBottom; + ThreshLabel.AnchorSide[akTop].Control := NoteLabel; + ThreshLabel.BorderSpacing.Top := 6; + ThreshLabel.AnchorSide[akLeft].Side := asrLeft; + ThreshLabel.AnchorSide[akLeft].Control := PrefForm; + ThreshLabel.BorderSpacing.Left := 6; + + ThreshLabel.Parent:=PrefForm; + Thresh := min + ((max - min) * 0.5); + if (min < 1) and (max > 3) then + Thresh := 2 + else if (min < -3) and (max > 0) then + Thresh := -2; + {$IFDEF USEFLOATSPIN} + ThreshEdit:=TFloatSpinEdit.create(PrefForm); + ThreshEdit.MaxValue := max; + ThreshEdit.MinValue := min; + ThreshEdit.Value:= Thresh; + ThreshEdit.DecimalPlaces:= 3; + {$ELSE} + ThreshEdit:=TEdit.create(PrefForm); + //ThreshEdit.Caption := FloatToStr(Thresh); + ThreshEdit.Caption := FloatToStrF(Thresh, ffGeneral, 4, 4); + {$ENDIF} + //ThreshEdit.Top := 42; + //ThreshEdit.Width := 92; + //ThreshEdit.Left := PrefForm.Width - ThreshEdit.Width - 8; + ThreshEdit.Constraints.MinWidth:= 128; + ThreshEdit.AutoSize := true; + ThreshEdit.AnchorSide[akTop].Side := asrBottom; + ThreshEdit.AnchorSide[akTop].Control := NoteLabel; + ThreshEdit.BorderSpacing.Top := 4; + ThreshEdit.AnchorSide[akLeft].Side := asrRight; + ThreshEdit.AnchorSide[akLeft].Control := ThreshLabel; + ThreshEdit.BorderSpacing.Left := 6; + + + ThreshEdit.Parent:=PrefForm; + // + MinClusterVoxLabel:=TLabel.create(PrefForm); + MinClusterVoxLabel.Caption:='Minimum Cluster Size (vox)'; + //MinClusterVoxLabel.Left := 8; + //MinClusterVoxLabel.Top := 72; + MinClusterVoxLabel.AutoSize := true; + MinClusterVoxLabel.AnchorSide[akTop].Side := asrBottom; + MinClusterVoxLabel.AnchorSide[akTop].Control := ThreshEdit; + MinClusterVoxLabel.BorderSpacing.Top := 6; + MinClusterVoxLabel.AnchorSide[akLeft].Side := asrLeft; + MinClusterVoxLabel.AnchorSide[akLeft].Control := PrefForm; + MinClusterVoxLabel.BorderSpacing.Left := 6; + MinClusterVoxLabel.Parent:=PrefForm; + MinClusterVoxEdit:=TEdit.create(PrefForm); + MinClusterVoxEdit.Caption := FloatToStrF(1, ffGeneral, 4, 4); + //MinClusterVoxEdit.Top := 72; + //MinClusterVoxEdit.Width := 92; + //MinClusterVoxEdit.Left := PrefForm.Width - ThreshEdit.Width - 8; + MinClusterVoxEdit.Constraints.MinWidth:= 128; + MinClusterVoxEdit.AutoSize := true; + MinClusterVoxEdit.AnchorSide[akTop].Side := asrBottom; + MinClusterVoxEdit.AnchorSide[akTop].Control := ThreshEdit; + MinClusterVoxEdit.BorderSpacing.Top := 4; + MinClusterVoxEdit.AnchorSide[akLeft].Side := asrRight; + MinClusterVoxEdit.AnchorSide[akLeft].Control := MinClusterVoxLabel; + MinClusterVoxEdit.BorderSpacing.Left := 6; + + MinClusterVoxEdit.Parent:=PrefForm; + //Decimate + DecimateLabel:=TLabel.create(PrefForm); + DecimateLabel.Caption:='Decimation (100=large files, 10=degraded/small) '; + //DecimateLabel.Left := 8; + //DecimateLabel.Top := 102; + DecimateLabel.AutoSize := true; + DecimateLabel.AnchorSide[akTop].Side := asrBottom; + DecimateLabel.AnchorSide[akTop].Control := MinClusterVoxEdit; + DecimateLabel.BorderSpacing.Top := 6; + DecimateLabel.AnchorSide[akLeft].Side := asrLeft; + DecimateLabel.AnchorSide[akLeft].Control := PrefForm; + DecimateLabel.BorderSpacing.Left := 6; + DecimateLabel.Parent:=PrefForm; + + DecimateLabel.Parent:=PrefForm; + DecimateEdit:=TSpinEdit.create(PrefForm); + //DecimateEdit.Top := 102; + //DecimateEdit.Width := 92; + //DecimateEdit.Left := PrefForm.Width - DecimateEdit.Width - 8; + DecimateEdit.MaxValue := 100; + DecimateEdit.MinValue := 1; + DecimateEdit.Value:= 25; + + DecimateEdit.Constraints.MinWidth:= 128; + DecimateEdit.AutoSize := true; + DecimateEdit.AnchorSide[akTop].Side := asrBottom; + DecimateEdit.AnchorSide[akTop].Control := MinClusterVoxEdit; + DecimateEdit.BorderSpacing.Top := 4; + DecimateEdit.AnchorSide[akLeft].Side := asrRight; + DecimateEdit.AnchorSide[akLeft].Control := DecimateLabel; + DecimateEdit.BorderSpacing.Left := 6; + + DecimateEdit.Parent:=PrefForm; + //Smooth + SmoothCombo:=TComboBox.create(PrefForm); + //SmoothCombo.Left := 8; + //SmoothCombo.Top := 132; + //SmoothCombo.Width := PrefForm.Width -16; + SmoothCombo.Items.Add('Raw (Jagged)'); + SmoothCombo.Items.Add('Masked smooth (Smooth except at brain mask)'); + SmoothCombo.Items.Add('Smooth (Eroded by brain mask)'); + SmoothCombo.ItemIndex:= 2; + SmoothCombo.Style := csDropDownList; + SmoothCombo.AutoSize := true; + SmoothCombo.Constraints.MinWidth:= 400; + SmoothCombo.AnchorSide[akTop].Side := asrBottom; + SmoothCombo.AnchorSide[akTop].Control := DecimateEdit; + SmoothCombo.BorderSpacing.Top := 6; + SmoothCombo.AnchorSide[akLeft].Side := asrLeft; + SmoothCombo.AnchorSide[akLeft].Control := PrefForm; + SmoothCombo.BorderSpacing.Left := 6; + SmoothCombo.AnchorSide[akRight].Side := asrRight; + SmoothCombo.AnchorSide[akRight].Control := PrefForm; + SmoothCombo.BorderSpacing.Right := 6; + SmoothCombo.Parent:=PrefForm; + SmoothCombo.Parent:=PrefForm; + //OK button + OkBtn:=TButton.create(PrefForm); + OkBtn.Caption:='OK'; + //OkBtn.Top := 162; + //OkBtn.Width := 128; + //OkBtn.Left := PrefForm.Width - OkBtn.Width - 8; + OkBtn.AutoSize := true; + OkBtn.AnchorSide[akTop].Side := asrBottom; + OkBtn.AnchorSide[akTop].Control := SmoothCombo; + OkBtn.BorderSpacing.Top := 6; + OkBtn.AnchorSide[akLeft].Side := asrCenter; + OkBtn.AnchorSide[akLeft].Control := PrefForm; + //OkBtn.BorderSpacing.Left := 200; + OkBtn.Constraints.MinWidth:= 64; + OkBtn.Parent:=PrefForm; + OkBtn.ModalResult:= mrOK; + PrefForm.ShowModal; + {$IFDEF USEFLOATSPIN} + Thresh := ThreshEdit.value; + {$ELSE} + Thresh := StrToFloatDef(ThreshEdit.Caption, Thresh); + {$ENDIF} + MinClusterVox := StrToIntDef(MinClusterVoxEdit.Caption, 1); + Decim := DecimateEdit.value/100.0; + SmoothStyle := SmoothCombo.ItemIndex; + result := PrefForm.ModalResult = mrOK; + FreeAndNil(PrefForm); + if (Decim <= 0.0) then + Decim := 0.01; + end; function Nii2MeshCore(niiname, meshname: string; threshold, decimateFrac: single; minimumClusterVox, smoothStyle: integer): integer; var diff --git a/nsappkitext.pas b/nsappkitext.pas index 9dc4612..21629a0 100644 --- a/nsappkitext.pas +++ b/nsappkitext.pas @@ -6,92 +6,70 @@ interface uses - CocoaAll, LCLType; - -type - NSAppearance = objcclass external (NSObject, NSCodingProtocol) - private - _name : NSString; - _bundle : NSBundle; - _private : Pointer; - _reserved : id; - _auxilary : id; - {$ifdef CPU32} - _extra : array [0..1] of id; - {$endif} - - public - procedure encodeWithCoder(aCoder: NSCoder); message 'encodeWithCoder:'; - function initWithCoder(aDecoder: NSCoder): id; message 'initWithCoder:'; - - function name: NSString; message 'name'; - - // Setting and identifying the current appearance in the thread. - class function currentAppearance: NSAppearance; message 'currentAppearance'; - // nil is valid and indicates the default appearance. - class procedure setCurrentAppearance(appearance: NSAppearance); message 'setCurrentAppearance:'; - - // Finds and returns an NSAppearance based on the name. - // For standard appearances such as NSAppearanceNameAqua, a built-in appearance is returned. - // For other names, the main bundle is searched. - class function appearanceNamed(aname: NSString): NSAppearance; message 'appearanceNamed:'; - - {/* Creates an NSAppearance by searching the specified bundle for a file with the specified name (without path extension). - If bundle is nil, the main bundle is assumed. - */ - #if NS_APPEARANCE_DECLARES_DESIGNATED_INITIALIZERS - - (nullable instancetype)initWithAppearanceNamed:(NSString *)name bundle:(nullable NSBundle *)bundle NS_DESIGNATED_INITIALIZER; - - (nullable instancetype)initWithCoder:(NSCoder *)aDecoder NS_DESIGNATED_INITIALIZER; - #endif} - - // Query allowsVibrancy to see if the given appearance actually needs vibrant drawing. - // You may want to draw differently if the current apperance is vibrant. - function allowsVibrancy: Boolean; message 'allowsVibrancy'; - end; - procedure setThemeMode(FormHandle: HWND; isDarkMode: boolean); + CocoaAll, LCLType,Classes, SysUtils, Controls, LCLClasses; + + procedure setThemeMode(Owner: TComponent; isDarkMode: boolean); +implementation +function ComponentToNSWindow(Owner: TComponent): NSWindow; var - NSAppearanceNameAqua: NSString; cvar; external; - // Light content should use the default Aqua apppearance. - NSAppearanceNameLightContent: NSString; cvar; external; // deprecated - - // The following two Vibrant appearances should only be set on an NSVisualEffectView, or one of its container subviews. - NSAppearanceNameVibrantDark : NSString; cvar; external; - NSAppearanceNameVibrantLight: NSString; cvar; external; - -type - //it's actually a protocol! - NSAppearanceCustomization = objccategory external (NSObject) - procedure setAppearance(aappearance: NSAppearance); message 'setAppearance:'; - function appearance: NSAppearance; message 'appearance'; - - // This returns the appearance that would be used when drawing the receiver, taking inherited appearances into account. - // - function effectiveAppearance: NSAppearance; message 'effectiveAppearance'; - end; + obj : NSObject; +begin + Result := nil; + if not Assigned(Owner) or not (Owner is TWinControl) then Exit; + obj := NSObject(TWinControl(Owner).Handle); + if not Assigned(obj) then Exit; + + if obj.respondsToSelector(ObjCSelector('window')) then + Result := objc_msgSend(obj, ObjCSelector('window')); +end; + +const + macOSNSAppearanceNameAqua = 'NSAppearanceNameAqua'; + DefaultAppearance = macOSNSAppearanceNameAqua; + macOSNSAppearanceNameVibrantDark = 'NSAppearanceNameVibrantDark'; + macOSNSAppearanceNameVibrantLight = 'NSAppearanceNameVibrantLight'; -implementation -procedure setThemeMode(FormHandle: HWND; isDarkMode: boolean); +function UpdateAppearance(Owner: TComponent; const AAppearance: String): Boolean; var - theWindow : CocoaAll.NSWindow; + cls : id; + ap : string; + apr : id; + win : NSWindow; begin - theWindow := NSView(FormHandle).window; - if isDarkMode then - theWindow.setAppearance (NSAppearance.appearanceNamed(NSAppearanceNameVibrantDark)) - else - theWindow.setAppearance (NSAppearance.appearanceNamed(NSAppearanceNameAqua)); - theWindow.invalidateShadow; - //window.invalidateShadow() + Result := false; + + win := ComponentToNSWindow(Owner); + if not Assigned(win) then Exit; + if AAppearance = '' + then ap := DefaultAppearance + else ap := AAppearance; + + cls := NSClassFromString( NSSTR('NSAppearance')); + if not Assigned(cls) then Exit; // not suppored in OSX version + + apr := objc_msgSend(cls, ObjCSelector('appearanceNamed:'), NSSTR(@ap[1])); + if not Assigned(apr) then Exit; + + if win.respondsToSelector(ObjCSelector('setAppearance:')) then + begin + objc_msgSend(win, ObjCSelector('setAppearance:'), apr); + Result := true; + end; end; -(*{$IFDEF LCLCocoa} -{$mode objfpc}{$H+} -{$modeswitch objectivec2} -{$ENDIF} *) + +procedure setThemeMode(Owner: TComponent; isDarkMode: boolean); +begin + if (isDarkMode) then + UpdateAppearance(Owner, macOSNSAppearanceNameVibrantDark) + else + UpdateAppearance(Owner, DefaultAppearance); +end; end. diff --git a/nsappkitext_old.pas b/nsappkitext_old.pas new file mode 100644 index 0000000..9dc4612 --- /dev/null +++ b/nsappkitext_old.pas @@ -0,0 +1,97 @@ +unit nsappkitext; + +{$mode objfpc}{$H+} +{$modeswitch objectivec2} + +interface + +uses + CocoaAll, LCLType; + +type + NSAppearance = objcclass external (NSObject, NSCodingProtocol) + private + _name : NSString; + _bundle : NSBundle; + _private : Pointer; + _reserved : id; + _auxilary : id; + {$ifdef CPU32} + _extra : array [0..1] of id; + {$endif} + + public + procedure encodeWithCoder(aCoder: NSCoder); message 'encodeWithCoder:'; + function initWithCoder(aDecoder: NSCoder): id; message 'initWithCoder:'; + + function name: NSString; message 'name'; + + // Setting and identifying the current appearance in the thread. + class function currentAppearance: NSAppearance; message 'currentAppearance'; + // nil is valid and indicates the default appearance. + class procedure setCurrentAppearance(appearance: NSAppearance); message 'setCurrentAppearance:'; + + // Finds and returns an NSAppearance based on the name. + // For standard appearances such as NSAppearanceNameAqua, a built-in appearance is returned. + // For other names, the main bundle is searched. + class function appearanceNamed(aname: NSString): NSAppearance; message 'appearanceNamed:'; + + {/* Creates an NSAppearance by searching the specified bundle for a file with the specified name (without path extension). + If bundle is nil, the main bundle is assumed. + */ + #if NS_APPEARANCE_DECLARES_DESIGNATED_INITIALIZERS + - (nullable instancetype)initWithAppearanceNamed:(NSString *)name bundle:(nullable NSBundle *)bundle NS_DESIGNATED_INITIALIZER; + - (nullable instancetype)initWithCoder:(NSCoder *)aDecoder NS_DESIGNATED_INITIALIZER; + #endif} + + // Query allowsVibrancy to see if the given appearance actually needs vibrant drawing. + // You may want to draw differently if the current apperance is vibrant. + function allowsVibrancy: Boolean; message 'allowsVibrancy'; + end; + procedure setThemeMode(FormHandle: HWND; isDarkMode: boolean); + + +var + NSAppearanceNameAqua: NSString; cvar; external; + // Light content should use the default Aqua apppearance. + NSAppearanceNameLightContent: NSString; cvar; external; // deprecated + + // The following two Vibrant appearances should only be set on an NSVisualEffectView, or one of its container subviews. + NSAppearanceNameVibrantDark : NSString; cvar; external; + NSAppearanceNameVibrantLight: NSString; cvar; external; + +type + //it's actually a protocol! + NSAppearanceCustomization = objccategory external (NSObject) + procedure setAppearance(aappearance: NSAppearance); message 'setAppearance:'; + function appearance: NSAppearance; message 'appearance'; + + // This returns the appearance that would be used when drawing the receiver, taking inherited appearances into account. + // + function effectiveAppearance: NSAppearance; message 'effectiveAppearance'; + end; + + +implementation + +procedure setThemeMode(FormHandle: HWND; isDarkMode: boolean); +var + theWindow : CocoaAll.NSWindow; +begin + theWindow := NSView(FormHandle).window; + if isDarkMode then + theWindow.setAppearance (NSAppearance.appearanceNamed(NSAppearanceNameVibrantDark)) + else + theWindow.setAppearance (NSAppearance.appearanceNamed(NSAppearanceNameAqua)); + theWindow.invalidateShadow; + //window.invalidateShadow() + +end; + +(*{$IFDEF LCLCocoa} +{$mode objfpc}{$H+} +{$modeswitch objectivec2} +{$ENDIF} *) + +end. + diff --git a/prefs.pas b/prefs.pas index 9d20c5f..2bb33a1 100755 --- a/prefs.pas +++ b/prefs.pas @@ -598,58 +598,66 @@ function IniFile(lRead: boolean; lFilename: string; var lPrefs: TPrefs): boolean if not lRead then FileMode := fmOpenWrite; if (lRead) and (not FileexistsF(lFilename)) then exit; - lIniFile := TIniFile.Create(lFilename); - IniBool(lRead,lIniFile, 'MultiSample',lPrefs.MultiSample); - IniBool(lRead,lIniFile, 'OrientCube',lPrefs.OrientCube); - IniBool(lRead,lIniFile, 'Perspective',lPrefs.Perspective); - IniBool(lRead,lIniFile, 'AdditiveOverlay',lPrefs.AdditiveOverlay); - IniBool(lRead,lIniFile, 'StartupScript',lPrefs.StartupScript); - {$IFDEF LCLCocoa} - IniBool(lRead,lIniFile, 'RetinaDisplay',lPrefs.RetinaDisplay); - IniBool(lRead,lIniFile, 'DarkMode',lPrefs.DarkMode); + {$IFDEF UNIX} + if not lRead then + writeln('writing preferences "'+lFilename+'"'); {$ENDIF} - IniBool(lRead,lIniFile, 'BlackDefaultBackground',lPrefs.BlackDefaultBackground); - //IniBool(lRead,lIniFile, 'MultiPassRendering',lPrefs.MultiPassRendering); - //IniBool(lRead,lIniFile, 'SaveAsObj',lPrefs.SaveAsObj); - IniBool(lRead,lIniFile, 'TracksAreTubes',lPrefs.TracksAreTubes); - IniBool(lRead,lIniFile, 'ZDimIsUp',lPrefs.ZDimIsUp); - IniBool(lRead,lIniFile,'GenerateSmoothCurves',lPrefs.GenerateSmoothCurves); - //IniBool(lRead,lIniFile, 'ShaderForBackgroundOnly',lPrefs.ShaderForBackgroundOnly); - IniBool(lRead,lIniFile, 'CoreTrackDisableDepth',lPrefs.CoreTrackDisableDepth); - IniBool(lRead,lIniFile, 'LoadTrackOnLaunch',lPrefs.LoadTrackOnLaunch); - IniBool(lRead,lIniFile, 'Colorbar',lPrefs.Colorbar); - IniBool(lRead,lIniFile, 'SmoothVoxelwiseData',lPrefs.SmoothVoxelwiseData); - IniBool(lRead,lIniFile, 'ScreenCaptureTransparentBackground',lPrefs.ScreenCaptureTransparentBackground); - IniColor(lRead,lIniFile, 'ObjColor',lPrefs.ObjColor); - IniColor(lRead,lIniFile, 'BackColor',lPrefs.BackColor); - IniStr(lRead, lIniFile, 'PrevTrackname', lPrefs.PrevTrackname); - IniStr(lRead, lIniFile, 'PrevNodename', lPrefs.PrevNodename); - IniStr(lRead, lIniFile, 'PrevOverlayname', lPrefs.PrevOverlayname); - IniStr(lRead,lIniFile,'PrevScript',lPrefs.PrevScript); - IniStrX(lRead,lIniFile,'FontName',lPrefs.FontName); - IniStrX(lRead,lIniFile,'PyLib',lPrefs.PyLib); - IniMRU(lRead,lIniFile,'PrevFilename',lPrefs.PrevFilename, lPrefs); - //IniMRU(lRead,lIniFile,'PrevScriptName',lPrefs.PrevScriptName); - IniRGBA(lRead,lIniFile, 'TextColor',lPrefs.TextColor); - IniRGBA(lRead,lIniFile, 'TextBorder',lPrefs.TextBorder); - IniRGBA(lRead,lIniFile, 'GridAndBorder',lPrefs.GridAndBorder); - //IniUnitRect(lRead,lIniFile, 'ColorBarPos',lPrefs.ColorBarPos); - IniInt(lRead,lIniFile,'TrackTubeSlices',lPrefs.TrackTubeSlices); - IntBound(lPrefs.TrackTubeSlices, 3,13); - IniInt(lRead,lIniFile,'ScreenCaptureZoom',lPrefs.ScreenCaptureZoom); - IntBound(lPrefs.ScreenCaptureZoom, 1,7); - IniInt(lRead,lIniFile,'ColorbarColor',lPrefs.ColorbarColor); - IntBound(lPrefs.ColorbarColor, 0,4); - IniInt(lRead,lIniFile,'ColorBarPosition',lPrefs.ColorBarPosition); - //IniInt(lRead,lIniFile,'ColorbarPosition',lPrefs.ColorbarPosition); - //IntBound(lPrefs.ColorbarPosition, 0,4); - IniInt(lRead,lIniFile,'RenderQuality',lPrefs.RenderQuality); - IniInt(lRead,lIniFile,'SaveAsFormat',lPrefs.SaveAsFormat); - IniInt(lRead,lIniFile,'SaveAsFormatTrack',lPrefs.SaveAsFormatTrack); - IniInt(lRead,lIniFile,'OcclusionAmount',lPrefs.OcclusionAmount); - IniFloat(lRead,lIniFile,'ColorbarSize',lPrefs.ColorbarSize); - if (lPrefs.RenderQuality < kRenderPoor) then lPrefs.RenderQuality:= kRenderPoor; - if (lPrefs.RenderQuality > kRenderBetter) then lPrefs.RenderQuality:= kRenderBetter; + lIniFile := TIniFile.Create(lFilename); + try + IniBool(lRead,lIniFile, 'MultiSample',lPrefs.MultiSample); + IniBool(lRead,lIniFile, 'OrientCube',lPrefs.OrientCube); + IniBool(lRead,lIniFile, 'Perspective',lPrefs.Perspective); + IniBool(lRead,lIniFile, 'AdditiveOverlay',lPrefs.AdditiveOverlay); + IniBool(lRead,lIniFile, 'StartupScript',lPrefs.StartupScript); + {$IFDEF LCLCocoa} + IniBool(lRead,lIniFile, 'RetinaDisplay',lPrefs.RetinaDisplay); + IniBool(lRead,lIniFile, 'DarkMode',lPrefs.DarkMode); + {$ENDIF} + IniBool(lRead,lIniFile, 'BlackDefaultBackground',lPrefs.BlackDefaultBackground); + //IniBool(lRead,lIniFile, 'MultiPassRendering',lPrefs.MultiPassRendering); + //IniBool(lRead,lIniFile, 'SaveAsObj',lPrefs.SaveAsObj); + IniBool(lRead,lIniFile, 'TracksAreTubes',lPrefs.TracksAreTubes); + IniBool(lRead,lIniFile, 'ZDimIsUp',lPrefs.ZDimIsUp); + IniBool(lRead,lIniFile,'GenerateSmoothCurves',lPrefs.GenerateSmoothCurves); + //IniBool(lRead,lIniFile, 'ShaderForBackgroundOnly',lPrefs.ShaderForBackgroundOnly); + IniBool(lRead,lIniFile, 'CoreTrackDisableDepth',lPrefs.CoreTrackDisableDepth); + IniBool(lRead,lIniFile, 'LoadTrackOnLaunch',lPrefs.LoadTrackOnLaunch); + IniBool(lRead,lIniFile, 'Colorbar',lPrefs.Colorbar); + IniBool(lRead,lIniFile, 'SmoothVoxelwiseData',lPrefs.SmoothVoxelwiseData); + IniBool(lRead,lIniFile, 'ScreenCaptureTransparentBackground',lPrefs.ScreenCaptureTransparentBackground); + IniColor(lRead,lIniFile, 'ObjColor',lPrefs.ObjColor); + IniColor(lRead,lIniFile, 'BackColor',lPrefs.BackColor); + IniStr(lRead, lIniFile, 'PrevTrackname', lPrefs.PrevTrackname); + IniStr(lRead, lIniFile, 'PrevNodename', lPrefs.PrevNodename); + IniStr(lRead, lIniFile, 'PrevOverlayname', lPrefs.PrevOverlayname); + IniStr(lRead,lIniFile,'PrevScript',lPrefs.PrevScript); + IniStrX(lRead,lIniFile,'FontName',lPrefs.FontName); + IniStrX(lRead,lIniFile,'PyLib',lPrefs.PyLib); + IniMRU(lRead,lIniFile,'PrevFilename',lPrefs.PrevFilename, lPrefs); + //IniMRU(lRead,lIniFile,'PrevScriptName',lPrefs.PrevScriptName); + IniRGBA(lRead,lIniFile, 'TextColor',lPrefs.TextColor); + IniRGBA(lRead,lIniFile, 'TextBorder',lPrefs.TextBorder); + IniRGBA(lRead,lIniFile, 'GridAndBorder',lPrefs.GridAndBorder); + //IniUnitRect(lRead,lIniFile, 'ColorBarPos',lPrefs.ColorBarPos); + IniInt(lRead,lIniFile,'TrackTubeSlices',lPrefs.TrackTubeSlices); + IntBound(lPrefs.TrackTubeSlices, 3,13); + IniInt(lRead,lIniFile,'ScreenCaptureZoom',lPrefs.ScreenCaptureZoom); + IntBound(lPrefs.ScreenCaptureZoom, 1,7); + IniInt(lRead,lIniFile,'ColorbarColor',lPrefs.ColorbarColor); + IntBound(lPrefs.ColorbarColor, 0,4); + IniInt(lRead,lIniFile,'ColorBarPosition',lPrefs.ColorBarPosition); + //IniInt(lRead,lIniFile,'ColorbarPosition',lPrefs.ColorbarPosition); + //IntBound(lPrefs.ColorbarPosition, 0,4); + IniInt(lRead,lIniFile,'RenderQuality',lPrefs.RenderQuality); + IniInt(lRead,lIniFile,'SaveAsFormat',lPrefs.SaveAsFormat); + IniInt(lRead,lIniFile,'SaveAsFormatTrack',lPrefs.SaveAsFormatTrack); + IniInt(lRead,lIniFile,'OcclusionAmount',lPrefs.OcclusionAmount); + IniFloat(lRead,lIniFile,'ColorbarSize',lPrefs.ColorbarSize); + if (lPrefs.RenderQuality < kRenderPoor) then lPrefs.RenderQuality:= kRenderPoor; + if (lPrefs.RenderQuality > kRenderBetter) then lPrefs.RenderQuality:= kRenderBetter; + except + {$IFDEF Unix}writeln('File permission error: unable to write preferences "'+lFilename+'"'); {$ENDIF} + end; lIniFile.Free; FileMode := fmOpenRead; end; diff --git a/shaderui.pas b/shaderui.pas index 85cbf48..01ccdc1 100755 --- a/shaderui.pas +++ b/shaderui.pas @@ -27,7 +27,6 @@ implementation var sLabel: array [1..kMaxUniform] of integer; //control count for Labels - sCheck: array [1..kMaxUniform] of integer; //control count for CheckBoxes sTrack: array [1..kMaxUniform] of integer; //control count for TrackBars gUpdateGLSL: boolean = false; @@ -60,15 +59,12 @@ procedure CreateAllControls; i, t: integer; begin for t := 1 to kMaxUniform do begin //assume we can not find control - sCheck[t] := 0; sLabel[t] := 0; sTrack[t] := 0; end; for i := 0 to GLForm1.ShaderBox.ControlCount - 1 do begin t := GLForm1.ShaderBox.Controls[i].tag; if (t < 1) or (t > kMaxUniform) then continue; - if (GLForm1.ShaderBox.Controls[i] is TCheckBox) then - sCheck[t] := i; if (GLForm1.ShaderBox.Controls[i] is TLabel) then sLabel[t] := i; if (GLForm1.ShaderBox.Controls[i] is TTrackBar) then @@ -78,24 +74,30 @@ procedure CreateAllControls; procedure ShowUniform(N: integer; U: TUniform); var - aCheck: TCheckBox; aLabel: TLabel; aTrack: TTrackBar; begin if (n > kMaxUniform) or (n < 1) then exit; - aCheck := (GLForm1.ShaderBox.Controls[sCheck[n]] as TCheckBox); aLabel := (GLForm1.ShaderBox.Controls[sLabel[n]] as TLabel); aTrack := (GLForm1.ShaderBox.Controls[sTrack[n]] as TTrackBar); aLabel.Caption := U.Name; aLabel.Visible := true; if U.Widget = kBool then begin - aCheck.Visible := true; - aCheck.Checked := U.Bool; - end else - aCheck.visible := false; - if (U.Widget = kInt) or (U.Widget = kFloat) then begin aTrack.Visible := true; + aTrack.Min:=0; + aTrack.Max:=1; + if (U.Bool) then + aTrack.Position := 1 + else + aTrack.Position := 0; + //aTrack.Position:=; + //aTrack.Visible := true; + end else if (U.Widget = kInt) or (U.Widget = kFloat) then begin + aTrack.Visible := true; + aTrack.Max := 100; + aTrack.Min := 0; + aTrack.position := Val2Percent(U.Min, U.DefaultV,U.Max); end else aTrack.visible := false; @@ -105,7 +107,6 @@ procedure ShowUniform(N: integer; U: TUniform); var UpperName: string; i: integer; - aCheck: TCheckBox; aLabel: TLabel; aTrack: TTrackBar; begin @@ -113,14 +114,10 @@ procedure ShowUniform(N: integer; U: TUniform); exit; UpperName := UpperCase(lProperty); for i := 1 to gShader.nUniform do begin - aCheck := (GLForm1.ShaderBox.Controls[sCheck[i]] as TCheckBox); aLabel := (GLForm1.ShaderBox.Controls[sLabel[i]] as TLabel); aTrack := (GLForm1.ShaderBox.Controls[sTrack[i]] as TTrackBar); if UpperName = upperCase(aLabel.Caption) then begin - if aCheck.visible then - aCheck.Checked := not (lVal = 0.0) - else - aTrack.position := Val2Percent(gShader.Uniform[i].Min, lVal,gShader.Uniform[i].Max); + aTrack.position := Val2Percent(gShader.Uniform[i].Min, lVal,gShader.Uniform[i].Max); GLForm1.UniformChange(nil); end;//if property matches shader's caption end; //for each uniform @@ -174,8 +171,7 @@ procedure SetShader(lFilename: string); for i := 1 to gShader.nUniform do ShowUniform(i, gShader.Uniform[i]); if gShader.nUniform < kMaxUniform then begin - for i := (gShader.nUniform+1) to kMaxUniform do begin - (GLForm1.ShaderBox.Controls[sCheck[i]] as TCheckBox).Visible := false; + for i := (gShader.nUniform+1) to kMaxUniform do begin (GLForm1.ShaderBox.Controls[sLabel[i]] as TLabel).Visible := false; (GLForm1.ShaderBox.Controls[sTrack[i]] as TTrackBar).Visible := false; end;//for all unused @@ -276,20 +272,19 @@ function Track2I(Pct,Min,Max: single): integer; procedure ReportUniformChange(Sender: TObject); var i: integer; - aCheck: TCheckBox; aTrack: TTrackBar; begin if gUpdateGLSL then exit; //GLForm1.updatetimer.enabled := true; if gShader.nUniform > 0 then for i := 1 to gShader.nUniform do begin - aCheck := (GLForm1.ShaderBox.Controls[sCheck[i]] as TCheckBox); aTrack := (GLForm1.ShaderBox.Controls[sTrack[i]] as TTrackBar); case gShader.Uniform[i].Widget of kBool: begin - if ACheck.visible then - gShader.Uniform[i].Bool := ACheck.checked; - GLForm1.memo1.lines.add('Bool '+ gShader.Uniform[i].name+' '+boolstr(gShader.Uniform[i].Bool) ); + + if aTrack.visible then + gShader.Uniform[i].Bool:= (aTrack.Position >0) ; + GLForm1.memo1.lines.add('Bool '+ gShader.Uniform[i].name+' '+ inttostr(aTrack.Position )); end; kInt:begin diff --git a/simple.edge b/simple.edge new file mode 100755 index 0000000..0d88178 --- /dev/null +++ b/simple.edge @@ -0,0 +1,4 @@ +1.0 0.0 0.1 0.0 +0.0 1.0 0.3 0.7 +0.0 0.0 1.0 0.0 +0.0 0.0 0.0 1.0 \ No newline at end of file diff --git a/simple.node b/simple.node new file mode 100755 index 0000000..e5971f6 --- /dev/null +++ b/simple.node @@ -0,0 +1,4 @@ +-9.631 28.620 33.320 1 1 L.superior.frontal.gyrus +0 0 0 2 1 Anterior Cingulate +-30.468 35.927 26.576 3 1 L.middle.frontal.gyrus +0 -70 0 4 1 Posterior \ No newline at end of file diff --git a/surfice.app/Contents/Resources/script/a1.gls b/surfice.app/Contents/Resources/script/a1.gls index f417270..2a16d5b 100644 --- a/surfice.app/Contents/Resources/script/a1.gls +++ b/surfice.app/Contents/Resources/script/a1.gls @@ -1,7 +1,3 @@ import gl -import sys -print(sys.version) -print(gl.version()) -# Note that resetdefaults() closes open meshes, overlays, track nodes -gl.savebmpxy('ao.png', 640, 480) - +gl.resetdefaults() +gl.meshload('~/am/scalpx.mz3') diff --git a/surfice.app/Contents/Resources/script/a2.gls b/surfice.app/Contents/Resources/script/a2.gls new file mode 100644 index 0000000..f417270 --- /dev/null +++ b/surfice.app/Contents/Resources/script/a2.gls @@ -0,0 +1,7 @@ +import gl +import sys +print(sys.version) +print(gl.version()) +# Note that resetdefaults() closes open meshes, overlays, track nodes +gl.savebmpxy('ao.png', 640, 480) + diff --git a/surfice.app/Contents/Resources/script/fmri_mesh.py b/surfice.app/Contents/Resources/script/fmri_mesh.py new file mode 100755 index 0000000..09afb44 --- /dev/null +++ b/surfice.app/Contents/Resources/script/fmri_mesh.py @@ -0,0 +1,8 @@ +import gl +gl.resetdefaults() +gl.meshload('BrainMesh_ICBM152Right.mz3') +gl.overlayload('motor_4t95mesh.mz3') +gl.overlaycolorname(1, 'red') +gl.shaderxray(1.0, 0.3) +gl.azimuthelevation(110, 15) +gl.meshcurv() \ No newline at end of file diff --git a/surfice.app/Contents/Resources/script/help.py b/surfice.app/Contents/Resources/script/help.py new file mode 100755 index 0000000..9286334 --- /dev/null +++ b/surfice.app/Contents/Resources/script/help.py @@ -0,0 +1,7 @@ +import gl +print(gl.__doc__) +for key in dir( gl ): + if not key.startswith('_'): + x = getattr( gl, key ).__doc__ + print(key+' (built-in function): ') + print(x) \ No newline at end of file diff --git a/surfice.app/Contents/Resources/script/hide_curves.py b/surfice.app/Contents/Resources/script/hide_curves.py new file mode 100755 index 0000000..98f4716 --- /dev/null +++ b/surfice.app/Contents/Resources/script/hide_curves.py @@ -0,0 +1,8 @@ +import gl +gl.resetdefaults() +gl.meshload('BrainMesh_ICBM152Left_smoothed.mz3') +gl.meshcurv() +gl.shadername('hidecurves') +gl.overlayload('CIT168.mz3') +gl.shaderforbackgroundonly(1) +gl.shaderadjust('curvthreshhi', 0.44) diff --git a/surfice.app/Contents/Resources/script/purge.gls b/surfice.app/Contents/Resources/script/purge.gls new file mode 100644 index 0000000..424cd2a --- /dev/null +++ b/surfice.app/Contents/Resources/script/purge.gls @@ -0,0 +1,13 @@ +begin + resetdefaults(); + azimuthelevation(70, 15); + meshload('BrainMesh_ICBM152Right.mz3'); + overlayload('motor_4t95vol.nii.gz'); + overlayminmax(1,2,12); + overlayload('motor_4t95vol.nii.gz'); + overlayminmax(2,-1,-2); + colorbarvisible(true); + overlaytransparencyonbackground(25); + meshcurv(); +end. + diff --git a/surfice.app/Contents/Resources/script/startup.gls b/surfice.app/Contents/Resources/script/startup.gls new file mode 100755 index 0000000..039c688 --- /dev/null +++ b/surfice.app/Contents/Resources/script/startup.gls @@ -0,0 +1,14 @@ +begin + resetdefaults(); + azimuthelevation(70, 15); + meshload('BrainMesh_ICBM152Right.mz3'); + overlayload('motor_4t95vol.nii.gz'); + overlayminmax(1,2,12); + overlayload('motor_4t95vol.nii.gz'); + overlayminmax(2,-1,-2); + colorbarvisible(true); + overlaytransparencyonbackground(25); + meshcurv(); +wait(0); +end. + diff --git a/surfice.app/Contents/Resources/script/startup.py b/surfice.app/Contents/Resources/script/startup.py new file mode 100755 index 0000000..9b8d381 --- /dev/null +++ b/surfice.app/Contents/Resources/script/startup.py @@ -0,0 +1,6 @@ +import gl +gl.resetdefaults() +gl.azimuthelevation(70, 15) +gl.meshload('BrainMesh_ICBM152Right.mz3') +gl.overlayload('motor_4t95vol.nii.gz') +gl.overlaycolorname(1, 'Gold') diff --git a/surfice.app/Contents/Resources/script/teff b/surfice.app/Contents/Resources/script/teff new file mode 100644 index 0000000..424cd2a --- /dev/null +++ b/surfice.app/Contents/Resources/script/teff @@ -0,0 +1,13 @@ +begin + resetdefaults(); + azimuthelevation(70, 15); + meshload('BrainMesh_ICBM152Right.mz3'); + overlayload('motor_4t95vol.nii.gz'); + overlayminmax(1,2,12); + overlayload('motor_4t95vol.nii.gz'); + overlayminmax(2,-1,-2); + colorbarvisible(true); + overlaytransparencyonbackground(25); + meshcurv(); +end. + diff --git a/surfice.lpi b/surfice.lpi index 084abab..45e6f70 100644 --- a/surfice.lpi +++ b/surfice.lpi @@ -6,6 +6,7 @@ + <Scaled Value="True"/> <ResourceType Value="res"/> <UseXPManifest Value="True"/> <XPManifest> @@ -75,7 +76,7 @@ <PackageName Value="LCL"/> </Item4> </RequiredPackages> - <Units Count="3"> + <Units Count="2"> <Unit0> <Filename Value="surfice.lpr"/> <IsPartOfProject Value="True"/> @@ -87,13 +88,6 @@ <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> </Unit1> - <Unit2> - <Filename Value="scriptengine.pas"/> - <IsPartOfProject Value="True"/> - <ComponentName Value="ScriptForm"/> - <HasResources Value="True"/> - <ResourceBaseClass Value="Form"/> - </Unit2> </Units> </ProjectOptions> <CompilerOptions> @@ -111,9 +105,15 @@ <SyntaxMode Value="Delphi"/> </SyntaxOptions> </Parsing> + <CodeGeneration> + <Optimizations> + <OptimizationLevel Value="3"/> + </Optimizations> + </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> + <StripSymbols Value="True"/> </Debugging> <Options> <Win32> diff --git a/surfice.lpr b/surfice.lpr index 494ac3a..fd261f1 100755 --- a/surfice.lpr +++ b/surfice.lpr @@ -5,22 +5,19 @@ uses {$IFDEF FPC}Graphics, {$ENDIF} {$IFDEF UNIX}{$IFDEF UseCThreads}cthreads,{$ENDIF}{$ENDIF} -{$IFNDEF Darwin}uscaledpi,{$ENDIF} Interfaces, Forms, lazopenglcontext, pascalscript, mainunit, Shaderu, prefs, nifti_loader, - colorTable, track, scriptengine; + uscale, colorTable, track; {$R *.res} begin + Application.Scaled:=True; //RequireDerivedFormResource:=True; Application.Title:='Surf Ice'; Application.Initialize; Application.CreateForm(TGLForm1, GLForm1); - Application.CreateForm(TScriptForm, ScriptForm); - //{$IFDEF FPC}{$IFNDEF Darwin}HighDPI(96);{$ENDIF}{$ENDIF} - {$IFDEF FPC}{$IFDEF LINUX} HighDPILinux(GetFontData(GLForm1.Font.Reference.Handle).Height); {$ENDIF} {$ENDIF} - {$IFDEF FPC}{$IFNDEF UNIX}HighDPI(96);{$ENDIF}{$ENDIF} + ConstrainTrackBars(); Application.Run; end. diff --git a/surfice.lps b/surfice.lps index 35b2825..c0c3e35 100644 --- a/surfice.lps +++ b/surfice.lps @@ -3,13 +3,14 @@ <ProjectSession> <Version Value="11"/> <BuildModes Active="Default"/> - <Units Count="37"> + <Units Count="39"> <Unit0> <Filename Value="surfice.lpr"/> <IsPartOfProject Value="True"/> <EditorIndex Value="-1"/> <CursorPos X="57" Y="16"/> <UsageCount Value="212"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit0> <Unit1> <Filename Value="mainunit.pas"/> @@ -17,9 +18,8 @@ <ComponentName Value="GLForm1"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> - <IsVisibleTab Value="True"/> - <TopLine Value="3226"/> - <CursorPos X="83" Y="3236"/> + <TopLine Value="3478"/> + <CursorPos X="25" Y="3503"/> <UsageCount Value="200"/> <Loaded Value="True"/> <LoadedDesigner Value="True"/> @@ -27,23 +27,19 @@ </Unit1> <Unit2> <Filename Value="scriptengine.pas"/> - <IsPartOfProject Value="True"/> <ComponentName Value="ScriptForm"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> - <EditorIndex Value="5"/> - <TopLine Value="1287"/> - <CursorPos X="3" Y="1293"/> - <UsageCount Value="208"/> - <Loaded Value="True"/> - <LoadedDesigner Value="True"/> + <EditorIndex Value="-1"/> + <CursorPos X="14" Y="194"/> + <UsageCount Value="199"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit2> <Unit3> <Filename Value="prefs.pas"/> - <EditorIndex Value="3"/> - <TopLine Value="623"/> - <CursorPos X="32" Y="630"/> + <EditorIndex Value="8"/> + <TopLine Value="18"/> + <CursorPos X="33" Y="29"/> <UsageCount Value="204"/> <Loaded Value="True"/> <DefaultSyntaxHighlighter Value="Delphi"/> @@ -52,87 +48,98 @@ <Filename Value="nifti_loader.pas"/> <EditorIndex Value="-1"/> <CursorPos X="48" Y="8"/> - <UsageCount Value="160"/> + <UsageCount Value="151"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit4> <Unit5> <Filename Value="colorTable.pas"/> - <EditorIndex Value="-1"/> - <TopLine Value="267"/> - <CursorPos X="102" Y="275"/> - <UsageCount Value="191"/> + <EditorIndex Value="2"/> + <TopLine Value="256"/> + <CursorPos X="9" Y="257"/> + <UsageCount Value="183"/> + <Loaded Value="True"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit5> <Unit6> <Filename Value="track.pas"/> <EditorIndex Value="-1"/> <TopLine Value="409"/> <CursorPos X="20" Y="430"/> - <UsageCount Value="160"/> + <UsageCount Value="151"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit6> <Unit7> <Filename Value="glisosurface.pas"/> <EditorIndex Value="-1"/> <TopLine Value="325"/> <CursorPos Y="457"/> - <UsageCount Value="179"/> + <UsageCount Value="170"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit7> <Unit8> <Filename Value="isosurface.pas"/> <EditorIndex Value="-1"/> <TopLine Value="111"/> <CursorPos X="21" Y="131"/> - <UsageCount Value="172"/> + <UsageCount Value="163"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit8> <Unit9> <Filename Value="unifyverticesu.pas"/> <EditorIndex Value="-1"/> <TopLine Value="116"/> <CursorPos X="17" Y="129"/> - <UsageCount Value="173"/> + <UsageCount Value="164"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit9> <Unit10> <Filename Value="progmesh.pas"/> <EditorIndex Value="-1"/> <TopLine Value="520"/> <CursorPos X="78" Y="550"/> - <UsageCount Value="162"/> + <UsageCount Value="153"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit10> <Unit11> <Filename Value="mergevertices.pas"/> <EditorIndex Value="-1"/> <TopLine Value="116"/> <CursorPos X="94" Y="155"/> - <UsageCount Value="160"/> + <UsageCount Value="151"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit11> <Unit12> <Filename Value="meshdisplay.pas"/> <EditorIndex Value="-1"/> <TopLine Value="202"/> <CursorPos X="74" Y="224"/> - <UsageCount Value="178"/> + <UsageCount Value="169"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit12> <Unit13> <Filename Value="mesh.pas"/> - <EditorIndex Value="8"/> - <TopLine Value="5367"/> - <CursorPos X="49" Y="5372"/> + <EditorIndex Value="4"/> + <TopLine Value="6291"/> + <CursorPos X="36" Y="6307"/> <UsageCount Value="108"/> <Loaded Value="True"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit13> <Unit14> <Filename Value="shaderui.pas"/> - <EditorIndex Value="-1"/> - <TopLine Value="53"/> - <CursorPos X="62" Y="68"/> - <UsageCount Value="86"/> + <EditorIndex Value="1"/> + <TopLine Value="270"/> + <CursorPos X="58" Y="286"/> + <UsageCount Value="79"/> + <Loaded Value="True"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit14> <Unit15> <Filename Value="shaderu.pas"/> - <EditorIndex Value="2"/> + <EditorIndex Value="-1"/> <TopLine Value="1288"/> <CursorPos X="20" Y="1290"/> - <UsageCount Value="112"/> - <Loaded Value="True"/> + <UsageCount Value="110"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit15> <Unit16> @@ -140,12 +147,14 @@ <EditorIndex Value="-1"/> <TopLine Value="20"/> <CursorPos X="12" Y="35"/> - <UsageCount Value="63"/> + <UsageCount Value="54"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit16> <Unit17> <Filename Value="define_types.pas"/> - <EditorIndex Value="10"/> - <CursorPos X="25" Y="7"/> + <IsVisibleTab Value="True"/> + <EditorIndex Value="6"/> + <CursorPos X="17" Y="7"/> <UsageCount Value="113"/> <Loaded Value="True"/> <DefaultSyntaxHighlighter Value="Delphi"/> @@ -155,14 +164,16 @@ <EditorIndex Value="-1"/> <TopLine Value="8594"/> <CursorPos X="4" Y="8623"/> - <UsageCount Value="55"/> + <UsageCount Value="46"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit18> <Unit19> <Filename Value="meshify.pas"/> <EditorIndex Value="-1"/> <TopLine Value="158"/> <CursorPos X="3" Y="173"/> - <UsageCount Value="92"/> + <UsageCount Value="83"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit19> <Unit20> <Filename Value="glext.pp"/> @@ -170,13 +181,14 @@ <EditorIndex Value="-1"/> <TopLine Value="4744"/> <CursorPos X="3" Y="4753"/> - <UsageCount Value="58"/> + <UsageCount Value="49"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit20> <Unit21> <Filename Value="opts.inc"/> - <EditorIndex Value="6"/> + <EditorIndex Value="5"/> <CursorPos Y="3"/> - <UsageCount Value="100"/> + <UsageCount Value="94"/> <Loaded Value="True"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit21> @@ -185,238 +197,257 @@ <EditorIndex Value="-1"/> <TopLine Value="339"/> <CursorPos X="44" Y="350"/> - <UsageCount Value="88"/> + <UsageCount Value="79"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit22> <Unit23> <Filename Value="gl_2d.pas"/> <EditorIndex Value="-1"/> <TopLine Value="42"/> <CursorPos X="42" Y="449"/> - <UsageCount Value="61"/> + <UsageCount Value="52"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit23> <Unit24> <Filename Value="gl_core_3d.pas"/> <EditorIndex Value="-1"/> <TopLine Value="487"/> <CursorPos X="27" Y="489"/> - <UsageCount Value="76"/> + <UsageCount Value="67"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit24> <Unit25> - <Filename Value="ctm_loader.pas"/> - <EditorIndex Value="-1"/> - <TopLine Value="246"/> - <CursorPos X="115" Y="246"/> - <UsageCount Value="6"/> - </Unit25> - <Unit26> - <Filename Value="/Developer/lazarus/lcl/lclintf.pas"/> - <EditorIndex Value="-1"/> - <TopLine Value="46"/> - <CursorPos X="31" Y="73"/> - <UsageCount Value="1"/> - </Unit26> - <Unit27> <Filename Value="/usr/local/share/fpcsrc/packages/opengl/src/gl.pp"/> <UnitName Value="GL"/> <EditorIndex Value="-1"/> <TopLine Value="52"/> <CursorPos X="3" Y="75"/> - <UsageCount Value="27"/> - </Unit27> - <Unit28> + <UsageCount Value="18"/> + </Unit25> + <Unit26> <Filename Value="../../../lazarus/lcl/interfaces/carbon/carbonproc.pp"/> <UnitName Value="CarbonProc"/> <EditorIndex Value="-1"/> <TopLine Value="556"/> <CursorPos X="13" Y="563"/> - <UsageCount Value="20"/> - </Unit28> - <Unit29> + <UsageCount Value="11"/> + </Unit26> + <Unit27> <Filename Value="../../../lazarus/ide/lazarus.pp"/> <UnitName Value="Lazarus"/> - <EditorIndex Value="4"/> + <EditorIndex Value="-1"/> <TopLine Value="46"/> <CursorPos X="6" Y="50"/> - <UsageCount Value="67"/> - <Loaded Value="True"/> - </Unit29> - <Unit30> + <UsageCount Value="101"/> + </Unit27> + <Unit28> <Filename Value="commandsu.pas"/> - <EditorIndex Value="7"/> - <CursorPos X="12" Y="680"/> + <EditorIndex Value="3"/> + <TopLine Value="445"/> + <CursorPos X="26" Y="476"/> <UsageCount Value="103"/> <Loaded Value="True"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit30> - <Unit31> + </Unit28> + <Unit29> <Filename Value="../../../lazarus/components/lazutils/fileutil.pas"/> <UnitName Value="FileUtil"/> <EditorIndex Value="-1"/> <TopLine Value="53"/> <CursorPos X="10" Y="60"/> - <UsageCount Value="17"/> - </Unit31> - <Unit32> + <UsageCount Value="8"/> + </Unit29> + <Unit30> <Filename Value="curv.pas"/> - <EditorIndex Value="9"/> + <EditorIndex Value="-1"/> <TopLine Value="76"/> <CursorPos X="98" Y="86"/> - <UsageCount Value="32"/> - <Loaded Value="True"/> + <UsageCount Value="77"/> <DefaultSyntaxHighlighter Value="Delphi"/> + </Unit30> + <Unit31> + <Filename Value="../../../Python4Laz/python4lazarus/Sources/Core/PythonEngine.pas"/> + <EditorIndex Value="-1"/> + <TopLine Value="1651"/> + <CursorPos X="50" Y="1653"/> + <UsageCount Value="11"/> + <DefaultSyntaxHighlighter Value="Delphi"/> + </Unit31> + <Unit32> + <Filename Value="../../../lazarus/components/opengl/openglcontext.pas"/> + <UnitName Value="OpenGLContext"/> + <EditorIndex Value="-1"/> + <TopLine Value="190"/> + <CursorPos X="28" Y="191"/> + <UsageCount Value="45"/> </Unit32> <Unit33> - <Filename Value="/usr/local/share/fpcsrc/packages/paszlib/src/zstream.pp"/> + <Filename Value="../../../lazarus/lcl/interfaces/cocoa/cocoawsfactory.pas"/> + <UnitName Value="CocoaWSFactory"/> <EditorIndex Value="-1"/> - <TopLine Value="21"/> - <CursorPos X="11" Y="34"/> - <UsageCount Value="5"/> + <TopLine Value="8"/> + <CursorPos X="20" Y="21"/> + <UsageCount Value="27"/> </Unit33> <Unit34> - <Filename Value="xr.pas"/> + <Filename Value="../../../lazarus/lcl/interfaces/cocoa/cocoawsdatepicker.pas"/> + <UnitName Value="CocoaWSDatePicker"/> <EditorIndex Value="-1"/> - <TopLine Value="1084"/> - <CursorPos Y="1108"/> - <UsageCount Value="3"/> + <CursorPos X="30" Y="11"/> + <UsageCount Value="10"/> </Unit34> <Unit35> - <Filename Value="../../../Python4Laz/python4lazarus/Sources/Core/PythonEngine.pas"/> + <Filename Value="../../../lazarus/components/opengl/glcocoanscontext.pas"/> + <UnitName Value="GLCocoaNSContext"/> <EditorIndex Value="-1"/> - <TopLine Value="1651"/> - <CursorPos X="50" Y="1653"/> - <UsageCount Value="20"/> - <DefaultSyntaxHighlighter Value="Delphi"/> + <TopLine Value="4"/> + <CursorPos X="31" Y="40"/> + <UsageCount Value="10"/> </Unit35> <Unit36> - <Filename Value="../../../lazarus/components/opengl/openglcontext.pas"/> - <UnitName Value="OpenGLContext"/> - <EditorIndex Value="1"/> - <TopLine Value="190"/> - <CursorPos X="28" Y="191"/> - <UsageCount Value="10"/> + <Filename Value="glclrbar.pas"/> + <EditorIndex Value="7"/> + <TopLine Value="34"/> + <CursorPos X="21" Y="52"/> + <UsageCount Value="14"/> <Loaded Value="True"/> + <DefaultSyntaxHighlighter Value="Delphi"/> </Unit36> + <Unit37> + <Filename Value="/usr/local/share/fpcsrc/rtl/objpas/sysutils/sysutilh.inc"/> + <EditorIndex Value="-1"/> + <TopLine Value="221"/> + <CursorPos X="22" Y="224"/> + <UsageCount Value="10"/> + </Unit37> + <Unit38> + <Filename Value="../../../lazarus/lcl/interfaces/cocoa/cocoawinapi.inc"/> + <EditorIndex Value="-1"/> + <TopLine Value="2600"/> + <CursorPos X="76" Y="2633"/> + <UsageCount Value="11"/> + </Unit38> </Units> <JumpHistory Count="30" HistoryIndex="29"> <Position1> <Filename Value="mesh.pas"/> - <Caret Line="7" Column="92"/> + <Caret Line="5884" Column="32" TopLine="5857"/> </Position1> <Position2> <Filename Value="mesh.pas"/> - <Caret Line="19" Column="10"/> + <Caret Line="6307" Column="18" TopLine="6279"/> </Position2> <Position3> - <Filename Value="mesh.pas"/> - <Caret Line="65" Column="28" TopLine="46"/> + <Filename Value="mainunit.pas"/> + <Caret Line="2702" Column="25" TopLine="2698"/> </Position3> <Position4> <Filename Value="mainunit.pas"/> - <Caret Line="4077" Column="8" TopLine="4063"/> + <Caret Line="4313" Column="27" TopLine="4278"/> </Position4> <Position5> <Filename Value="mainunit.pas"/> - <Caret Line="3559" Column="16" TopLine="3550"/> + <Caret Line="2403" Column="28" TopLine="2385"/> </Position5> <Position6> <Filename Value="mainunit.pas"/> - <Caret Line="208" Column="71" TopLine="198"/> + <Caret Line="2408" Column="30" TopLine="2385"/> </Position6> <Position7> <Filename Value="mainunit.pas"/> - <Caret Line="253" Column="66" TopLine="235"/> + <Caret Line="4305" Column="27" TopLine="4281"/> </Position7> <Position8> <Filename Value="mainunit.pas"/> - <Caret Line="266" Column="65" TopLine="248"/> + <Caret Line="2417" Column="28" TopLine="2389"/> </Position8> <Position9> <Filename Value="mainunit.pas"/> - <Caret Line="267" Column="85" TopLine="249"/> + <Caret Line="1977" Column="6" TopLine="1975"/> </Position9> <Position10> <Filename Value="mainunit.pas"/> - <Caret Line="268" Column="87" TopLine="250"/> + <Caret Line="1929" Column="22" TopLine="1923"/> </Position10> <Position11> <Filename Value="mainunit.pas"/> - <Caret Line="315" Column="25" TopLine="297"/> + <Caret Line="2019" Column="30" TopLine="2016"/> </Position11> <Position12> - <Filename Value="mainunit.pas"/> - <Caret Line="9" Column="68"/> + <Filename Value="mesh.pas"/> + <Caret Line="6242" Column="38" TopLine="6240"/> </Position12> <Position13> - <Filename Value="mainunit.pas"/> - <Caret Line="3556" Column="13" TopLine="3551"/> + <Filename Value="mesh.pas"/> + <Caret Line="6307" Column="38" TopLine="6279"/> </Position13> <Position14> - <Filename Value="mainunit.pas"/> - <Caret Line="2546" Column="71" TopLine="2535"/> + <Filename Value="mesh.pas"/> + <Caret Line="6388" TopLine="6361"/> </Position14> <Position15> <Filename Value="mainunit.pas"/> - <Caret Line="2567" Column="69" TopLine="2548"/> + <Caret Line="15" Column="63"/> </Position15> <Position16> <Filename Value="mainunit.pas"/> - <Caret Line="4073" Column="6" TopLine="4055"/> + <Caret Line="41" Column="9" TopLine="12"/> </Position16> <Position17> <Filename Value="mainunit.pas"/> - <Caret Line="3557" Column="9" TopLine="3550"/> + <Caret Line="1249" Column="10" TopLine="1224"/> </Position17> <Position18> - <Filename Value="mainunit.pas"/> - <Caret Line="244" Column="22" TopLine="235"/> + <Filename Value="commandsu.pas"/> + <Caret Line="33" Column="19" TopLine="13"/> </Position18> <Position19> - <Filename Value="mesh.pas"/> - <Caret Line="5703" Column="11" TopLine="5682"/> + <Filename Value="commandsu.pas"/> + <Caret Line="114" Column="33" TopLine="85"/> </Position19> <Position20> - <Filename Value="mesh.pas"/> - <Caret Line="2240" Column="15" TopLine="2230"/> + <Filename Value="commandsu.pas"/> + <Caret Line="476" Column="26" TopLine="445"/> </Position20> <Position21> - <Filename Value="mesh.pas"/> - <Caret Line="2647" Column="48" TopLine="2628"/> + <Filename Value="mainunit.pas"/> + <Caret Line="360" Column="14" TopLine="343"/> </Position21> <Position22> - <Filename Value="mesh.pas"/> - <Caret Line="2655" Column="13" TopLine="2637"/> + <Filename Value="mainunit.pas"/> + <Caret Line="2557" Column="26" TopLine="2534"/> </Position22> <Position23> - <Filename Value="mesh.pas"/> - <Caret Line="2803" Column="22" TopLine="2784"/> + <Filename Value="mainunit.pas"/> + <Caret Line="2156" Column="60" TopLine="2153"/> </Position23> <Position24> <Filename Value="mainunit.pas"/> - <Caret Line="3557" Column="4" TopLine="3550"/> + <Caret Line="2057" Column="20" TopLine="2041"/> </Position24> <Position25> <Filename Value="mainunit.pas"/> - <Caret Line="234" Column="22" TopLine="224"/> + <Caret Line="2087" Column="9" TopLine="2071"/> </Position25> <Position26> <Filename Value="mainunit.pas"/> - <Caret Line="901" Column="3" TopLine="886"/> + <Caret Line="2247" Column="64" TopLine="2222"/> </Position26> <Position27> <Filename Value="mainunit.pas"/> - <Caret Line="3562" Column="23" TopLine="3554"/> + <Caret Line="3381" Column="40" TopLine="3356"/> </Position27> <Position28> <Filename Value="mainunit.pas"/> - <Caret Line="4058" Column="98" TopLine="4041"/> + <Caret Line="2247" Column="64" TopLine="2232"/> </Position28> <Position29> <Filename Value="mainunit.pas"/> - <Caret Line="3233" Column="15" TopLine="3226"/> + <Caret Line="3381" Column="40" TopLine="3356"/> </Position29> <Position30> <Filename Value="mainunit.pas"/> - <Caret Line="3236" Column="9" TopLine="3217"/> + <Caret Line="3503" Column="25" TopLine="3478"/> </Position30> </JumpHistory> <RunParams> diff --git a/tracktion b/tracktion new file mode 100755 index 0000000..cfb7615 Binary files /dev/null and b/tracktion differ diff --git a/uscaledpi.pas b/unused_uscaledpi.pas similarity index 100% rename from uscaledpi.pas rename to unused_uscaledpi.pas diff --git a/uscale.pas b/uscale.pas new file mode 100755 index 0000000..51132d5 --- /dev/null +++ b/uscale.pas @@ -0,0 +1,59 @@ +unit uscale; + //http://wiki.lazarus.freepascal.org/High_DPI +{$IFDEF FPC}{$mode delphi} {$H+}{$ENDIF} +interface + +uses + {$IFDEF LCLGtk2} Gtk2Def, gtk2, Gtk2Proc, {$ENDIF} + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls, + StdCtrls, Buttons, Menus; + +procedure ConstrainTrackBars; + +implementation + +procedure ConstrainTrackBar(Control: TControl); +var + i: integer; + WinControl: TWinControl; + {$IFDEF LCLGtk2} + Widget: PGtkWidget; + {$ENDIF} +begin + if (Control is TTrackBar) then begin + {$IFDEF Darwin} + (Control as TTrackBar).Constraints.MaxHeight := 22; + (Control as TTrackBar).Height := (Control as TTrackBar).Constraints.MaxHeight; + {$ENDIF} + {$IFDEF LCLQT5} + (Control as TTrackBar).Constraints.MaxHeight := 32; + (Control as TTrackBar).Height := (Control as TTrackBar).Constraints.MaxHeight; + {$ENDIF} + {$IFDEF LCLGtk2} + if ((Control as TTrackBar).TickStyle = tsNone) then begin + Widget:=GetStyleWidget(lgsHScale); + gtk_scale_set_draw_value(GTK_SCALE(Widget), false); + gtk_widget_size_request(Widget,@Widget^.requisition); + (Control as TTrackBar).Constraints.MaxHeight := Widget^.requisition.height; + (Control as TTrackBar).Height := (Control as TTrackBar).Constraints.MaxHeight; + end; + {$ENDIF} + end; + if not (Control is TWinControl) then exit; + WinControl := TWinControl(Control); + if WinControl.ControlCount = 0 then + exit; + for i := 0 to WinControl.ControlCount - 1 do + ConstrainTrackBar(WinControl.Controls[i]); +end; + +procedure ConstrainTrackBars; +var + i: integer; +begin + for i := 0 to Screen.FormCount - 1 do + ConstrainTrackBar(Screen.Forms[i]); +end; + +end. + diff --git a/userdir.pas b/userdir.pas index 6286249..1a3515f 100755 --- a/userdir.pas +++ b/userdir.pas @@ -264,7 +264,9 @@ function AppDir2: string; //e.g. c:\folder\ for c:\folder\myapp.exe, but /folder {$ELSE} function AppDir: string; //e.g. c:\folder\ for c:\folder\myapp.exe, but /folder/myapp.app/ for /folder/myapp.app/app begin - result := extractfilepath(paramstr(0)); + result := extractfilepath(paramstr(0))+'Resources'+pathdelim; + if not DirectoryExists(result) then + result := extractfilepath(paramstr(0)); end; function AppDir2: string; //e.g. c:\folder\ for c:\folder\myapp.exe, but /folder/myapp.app/ for /folder/myapp.app/app diff --git a/scriptengine.lfm b/xscriptengine.lfm similarity index 100% rename from scriptengine.lfm rename to xscriptengine.lfm diff --git a/scriptengine.pas b/xscriptengine.pas similarity index 88% rename from scriptengine.pas rename to xscriptengine.pas index d45755d..962ea81 100755 --- a/scriptengine.pas +++ b/xscriptengine.pas @@ -148,7 +148,9 @@ TScriptForm = class(TForm) PSScript1: TPSScript; azimuthelevation1: TMenuItem; procedure AppleMenuClick(Sender: TObject); + function PyExecMain(): boolean; procedure Compile1Click(Sender: TObject); + procedure CompileMainClick(Sender: TObject); procedure File1Click(Sender: TObject); procedure FormActivate(Sender: TObject); procedure FormDeactivate(Sender: TObject); @@ -185,9 +187,11 @@ TScriptForm = class(TForm) procedure DemoProgram (isPython: boolean = false); procedure ToPascal(s: string); procedure OpenStartupScript; + {$IFDEF MYPY} function PyCreate: boolean; function PyIsPythonScript(): boolean; + function PyIsPythonScriptMain(): boolean; function PyExec(): boolean; procedure PyEngineAfterInit(Sender: TObject); procedure PyIOSendData(Sender: TObject; const Data: AnsiString); @@ -199,8 +203,10 @@ TScriptForm = class(TForm) gchanged: Boolean; function SaveTest: Boolean; public - { Public declarations } end; + + function ScriptDir: string; { Public declarations } + const kScriptExt = '.gls'; {$IFDEF MYPY} @@ -415,6 +421,53 @@ function TScriptForm.PyExec(): boolean; result := true; end; +function TScriptForm.PyIsPythonScriptMain(): boolean; +begin + result := ( Pos('import gl', GLForm1.ScriptMemo.Lines.Text) > 0); //any python project must import gl +end; +function TScriptForm.PyExecMain(): boolean; +begin + result := false; //assume code is not Python + if not (PyIsPythonScriptMain) then exit; + GLForm1.ScriptOutputMemo.lines.Clear; + result := true; + if PyEngine = nil then begin + if not PyCreate then begin //do this the first time + {$IFDEF Windows} + GLForm1.ScriptOutputMemo.lines.Add('Unable to find Python library [place Python .dll and .zip in Script folder]'); + {$ENDIF} + {$IFDEF Unix} + GLForm1.ScriptOutputMemo.lines.Add('Unable to find Python library'); + {$IFDEF Darwin} + GLForm1.ScriptOutputMemo.lines.Add(' For MacOS this is typically in: '+kBasePath+''); + {$ELSE} + GLForm1.ScriptOutputMemo.lines.Add(' run ''find -name "*libpython*"'' to find the library'); + GLForm1.ScriptOutputMemo.lines.Add(' if it does not exist, install it (e.g. ''apt-get install libpython2.7'')'); + {$ENDIF} + GLForm1.ScriptOutputMemo.lines.Add(' if it does exist, set use the Preferences/Advanced to set ''PyLib'''); + {$IFDEF Darwin} + GLForm1.ScriptOutputMemo.lines.Add(' PyLib should be the complete path and filename of libpython*.dylib'); + {$ELSE} + GLForm1.ScriptOutputMemo.lines.Add(' PyLib should be the complete path and filename of libpython*.so'); + {$ENDIF} + GLForm1.ScriptOutputMemo.lines.Add(' This file should be in your LIBDIR, which you can detect by running Python from the terminal:'); + GLForm1.ScriptOutputMemo.lines.Add(' ''import sysconfig; print(sysconfig.get_config_var("LIBDIR"))'''); + {$ENDIF} + result := true; + exit; + + end; + end; + GLForm1.ScriptOutputMemo.lines.Add('Running Python script'); + try + PyEngine.ExecStrings(GLForm1.ScriptMemo.Lines); + except + caption := 'Python Engine Failed'; + end; + GLForm1.ScriptOutputMemo.lines.Add('Python Succesfully Executed'); + result := true; +end; + procedure TScriptForm.PyIOSendData(Sender: TObject; const Data: AnsiString); begin @@ -1167,27 +1220,27 @@ procedure TScriptForm.PyModInitialization(Sender: TObject); //AddMethod('atlasgraybg', @PyATLASGRAYBG, ''); AddMethod('atlasmaxindex', @PyATLASMAXINDEX, ''); AddMethod('atlassaturationalpha', @PyATLASSATURATIONALPHA, ''); - AddMethod('azimuth', @PyAZIMUTH, ''); - AddMethod('azimuthelevation', @PyAZIMUTHELEVATION, ''); - AddMethod('backcolor', @PyBACKCOLOR, ''); - AddMethod('bmpzoom', @PyBMPZOOM, ''); - AddMethod('cameradistance', @PyCAMERADISTANCE, ''); + AddMethod('azimuth', @PyAZIMUTH, ' azimuthe(azi) -> Rotate image by specified degrees.'); + AddMethod('azimuthelevation', @PyAZIMUTHELEVATION, ' azimuthelevation(azi, elev) -> Sets the camera location.'); + AddMethod('backcolor', @PyBACKCOLOR, ' backcolor(r, g, b) -> changes the background color, for example backcolor(255, 0, 0) will set a bright red background'); + AddMethod('bmpzoom', @PyBMPZOOM, ' bmpzoom(z) -> changes resolution of savebmp(), for example bmpzoom(2) will save bitmaps at twice screen resolution'); + AddMethod('cameradistance', @PyCAMERADISTANCE, ' cameradistance(z) -> Sets the viewing distance from the object.'); AddMethod('camerapan', @PyCAMERAPAN, ''); - AddMethod('clip', @PyCLIP, ''); - AddMethod('clipazimuthelevation', @PyCLIPAZIMUTHELEVATION, ''); + AddMethod('clip', @PyCLIP, ' clip(depth) -> Creates a clip plane that hides information close to the viewer.'); + AddMethod('clipazimuthelevation', @PyCLIPAZIMUTHELEVATION, ' clipazimuthelevation(depth, azi, elev) -> Set a view-point independent clip plane.'); AddMethod('colorbarposition', @PyCOLORBARPOSITION, ''); AddMethod('colorbarvisible', @PyCOLORBARVISIBLE, ''); AddMethod('edgecolor', @PyEDGECOLOR, ''); AddMethod('edgeload', @PyEDGELOAD, ''); AddMethod('edgesize', @PyEDGESIZE, ''); AddMethod('edgethresh', @PyEDGETHRESH, ''); - AddMethod('elevation', @PyELEVATION, ''); + AddMethod('elevation', @PyELEVATION, ' elevation(degrees) -> Rotates volume rendering relative to camera.'); AddMethod('exists', @PyEXISTS, ''); AddMethod('fontname', @PyFONTNAME, ''); AddMethod('meshcolor', @PyMESHCOLOR, ''); AddMethod('meshcreate', @PyMESHCREATE, ''); AddMethod('meshcurv', @PyMESHCURV, ''); - AddMethod('meshload', @PyMESHLOAD, ''); + AddMethod('meshload', @PyMESHLOAD, ' meshload(imageName) -> Close all open images and load new background image.'); AddMethod('meshoverlayorder', @PyMESHOVERLAYORDER, ''); AddMethod('meshreversefaces', @PyMESHREVERSEFACES, ''); AddMethod('meshsave', @PyMESHSAVE, ''); @@ -1202,18 +1255,18 @@ procedure TScriptForm.PyModInitialization(Sender: TObject); AddMethod('nodethreshbysizenotcolor', @PyNODETHRESHBYSIZENOTCOLOR, ''); AddMethod('orientcubevisible', @PyORIENTCUBEVISIBLE, ''); AddMethod('overlayadditive', @PyOVERLAYADDITIVE, ''); - AddMethod('overlaycloseall', @PyOVERLAYCLOSEALL, ''); + AddMethod('overlaycloseall', @PyOVERLAYCLOSEALL, ' overlaycloseall() -> Close all open overlays.'); AddMethod('overlaycolorname', @PyOVERLAYCOLORNAME, ''); AddMethod('overlayinvert', @PyOVERLAYINVERT, ''); - AddMethod('overlayload', @PyOVERLAYLOAD, ''); - AddMethod('overlayminmax', @PyOVERLAYMINMAX, ''); + AddMethod('overlayload', @PyOVERLAYLOAD, ' overlayload(filename) -> Load an image on top of prior images.'); + AddMethod('overlayminmax', @PyOVERLAYMINMAX, ' overlayminmax(layer, min, max) -> Sets the color range for the overlay (layer 0 = background).'); AddMethod('overlaysmoothvoxelwisedata', @PyOVERLAYSMOOTHVOXELWISEDATA, ''); AddMethod('overlaytranslucent', @PyOVERLAYTRANSLUCENT, ''); AddMethod('overlaytransparencyonbackground', @PyOVERLAYTRANSPARENCYONBACKGROUND, ''); AddMethod('overlayvisible', @PyOVERLAYVISIBLE, ''); AddMethod('quit', @PyQUIT, ''); - AddMethod('resetdefaults', @PyRESETDEFAULTS, ''); - AddMethod('savebmp', @PySAVEBMP, ''); + AddMethod('resetdefaults', @PyRESETDEFAULTS, ' resetdefaults() -> Revert settings to sensible values.'); + AddMethod('savebmp', @PySAVEBMP, ' savebmp(pngName) -> Save screen display as bitmap. For example "savebmp(''test.png'')"'); AddMethod('savebmpxy', @PySAVEBMPXY, ''); AddMethod('scriptformvisible', @PySCRIPTFORMVISIBLE, ''); AddMethod('shaderadjust', @PySHADERADJUST, ''); @@ -1297,6 +1350,7 @@ procedure TScriptForm.DemoProgram( isPython: boolean = false); procedure MyWriteln(const s: string); begin ScriptForm.Memo2.lines.add(S); + GLForm1.ScriptOutputMemo.lines.add(S); {$IFDEF Unix}writeln(s);{$ENDIF} end; @@ -1346,6 +1400,37 @@ procedure TScriptForm.PSScript1Compile(Sender: TPSScript); Sender.AddFunction(kProcRA[i].Ptr,'procedure '+kProcRA[i].Decl+kProcRA[i].Vars+':'); end; + +procedure TScriptForm.CompileMainClick(Sender: TObject); +var + i: integer; + compiled: boolean; +begin + {$IFDEF MYPY} + if PyExecMain() then exit; + if (not (AnsiContainsText(GLForm1.ScriptMemo.Lines.Text, 'begin'))) then begin + GLForm1.ScriptOutputMemo.Lines.Clear; + GLForm1.ScriptOutputMemo.Lines.Add('Error: script must contain "import gl" (for Python) or "begin" (for Pascal).'); + exit; + end; + {$ENDIF} + GLForm1.ScriptOutputMemo.Lines.Clear; + PSScript1.Script.Text := GLForm1.ScriptMemo.Lines.Text; + //PSScript1.Script.Text := Memo1.Lines.GetText; //<- this will leak! requires StrDispose + Compiled := PSScript1.Compile; + for i := 0 to PSScript1.CompilerMessageCount -1 do + MyWriteln( PSScript1.CompilerMessages[i].MessageToString); + if Compiled then + MyWriteln('Successfully Compiled Script'); + if Compiled then begin + if PSScript1.Execute then + MyWriteln('Succesfully Executed') + else + MyWriteln('Error while executing script: '+ + PSScript1.ExecErrorToString); + end; +end; + procedure TScriptForm.Compile1Click(Sender: TObject); var i: integer;