home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Applications / NIH Image 1.55 / Source / Init.p < prev    next >
Encoding:
Text File  |  1994-05-02  |  43.0 KB  |  1,576 lines  |  [TEXT/PJMM]

  1. unit Initialization;
  2.  
  3. interface
  4.  
  5.  
  6.     uses
  7.         QuickDraw, Palettes, PrintTraps, Slots, globals, Utilities, Graphics, Lut, Strings;
  8.  
  9.     procedure Init;
  10.     procedure AllocateBuffers;
  11.     procedure AllocateArrays;
  12.     procedure SetupMenus;
  13.     procedure GetSettings;
  14.     procedure FindPlugIns;
  15.  
  16.  
  17.  
  18. implementation
  19.  
  20.  
  21.     procedure MakeCursors;
  22.         var
  23.             TempCurH: CursHandle;
  24.             i, id: integer;
  25.     begin
  26.         TempCurH := GetCursor(PickerCursorID);
  27.         if TempCurH <> nil then begin
  28.                 PickerCursor := TempCurH^^;
  29.                 ToolCursor[PickerTool] := PickerCursor;
  30.                 ReleaseResource(handle(TempCurH));
  31.             end;
  32.  
  33.         TempCurH := GetCursor(CrossCursorPlusID);
  34.         if TempCurH <> nil then begin
  35.                 CrossPlusCursor := TempCurH^^;
  36.                 ReleaseResource(handle(TempCurH));
  37.             end;
  38.  
  39.         TempCurH := GetCursor(CrossCursorMinusID);
  40.         if TempCurH <> nil then begin
  41.                 CrossMinusCursor := TempCurH^^;
  42.                 ReleaseResource(handle(TempCurH));
  43.             end;
  44.  
  45.         TempCurH := GetCursor(WandPlusCursorID);
  46.         if TempCurH <> nil then begin
  47.                 WandPlusCursor := TempCurH^^;
  48.                 ReleaseResource(handle(TempCurH));
  49.             end;
  50.  
  51.         TempCurH := GetCursor(WandMinusCursorID);
  52.         if TempCurH <> nil then begin
  53.                 WandMinusCursor := TempCurH^^;
  54.                 ReleaseResource(handle(TempCurH));
  55.             end;
  56.  
  57.         TempCurH := GetCursor(CrossCursorID);
  58.         if TempCurH <> nil then begin
  59.                 ToolCursor[SelectionTool] := TempCurH^^;
  60.                 ToolCursor[FreehandTool] := TempCurH^^;
  61.                 ToolCursor[PolygonTool] := TempCurH^^;
  62.                 ToolCursor[ruler] := TempCurH^^;
  63.                 ToolCursor[PlotTool] := TempCurH^^;
  64.                 ToolCursor[OvalSelectionTool] := TempCurH^^;
  65.                 ToolCursor[LineTool] := TempCurH^^;
  66.                 ToolCursor[AngleTool] := TempCurH^^;
  67.                 ToolCursor[CrossHairTool] := TempCurH^^;
  68.                 ToolCursor[LUTTool] := TempCurH^^;
  69.                 ReleaseResource(handle(TempCurH));
  70.             end;
  71.  
  72.         TempCurH := GetCursor(LUTCursorID);
  73.         if TempCurH <> nil then begin
  74.                 LUTCursor := TempCurH^^;
  75.                 ReleaseResource(handle(TempCurH));
  76.             end;
  77.  
  78.         TempCurH := GetCursor(gmCursorID);
  79.         if TempCurH <> nil then begin
  80.                 gmCursor := TempCurH^^;
  81.                 ReleaseResource(handle(TempCurH));
  82.             end;
  83.  
  84.         TempCurH := GetCursor(GrabberCursorID);
  85.         if TempCurH <> nil then begin
  86.                 ToolCursor[Grabber] := TempCurH^^;
  87.                 ReleaseResource(handle(TempCurH));
  88.             end;
  89.  
  90.         TempCurH := GetCursor(PencilCursorID);
  91.         if TempCurH <> nil then begin
  92.                 ToolCursor[Pencil] := TempCurH^^;
  93.                 ReleaseResource(handle(TempCurH));
  94.             end;
  95.  
  96.         TempCurH := GetCursor(GlassCursorPlusID);
  97.         if TempCurH <> nil then begin
  98.                 ToolCursor[MagnifyingGlass] := TempCurH^^;
  99.                 ReleaseResource(handle(TempCurH));
  100.             end;
  101.  
  102.         TempCurH := GetCursor(GlassCursorMinusID);
  103.         if TempCurH <> nil then begin
  104.                 GlassMinusCursor := TempCurH^^;
  105.                 ReleaseResource(handle(TempCurH));
  106.             end;
  107.  
  108.         TempCurH := GetCursor(BucketCursorID);
  109.         if TempCurH <> nil then begin
  110.                 ToolCursor[PaintBucket] := TempCurH^^;
  111.                 ReleaseResource(handle(TempCurH));
  112.             end;
  113.  
  114.         TempCurH := GetCursor(WandCursorID);
  115.         if TempCurH <> nil then begin
  116.                 ToolCursor[Wand] := TempCurH^^;
  117.                 ReleaseResource(handle(TempCurH));
  118.             end;
  119.  
  120.         TempCurH := GetCursor(TextCursorID);
  121.         if TempCurH <> nil then begin
  122.                 ToolCursor[TextTool] := TempCurH^^;
  123.                 ReleaseResource(handle(TempCurH));
  124.             end;
  125.  
  126.         TempCurH := GetCursor(EraserCursorID);
  127.         if TempCurH <> nil then begin
  128.                 ToolCursor[eraser] := TempCurH^^;
  129.                 ReleaseResource(handle(TempCurH));
  130.             end;
  131.  
  132.         TempCurH := GetCursor(SprayCursorID);
  133.         if TempCurH <> nil then begin
  134.                 ToolCursor[SprayCanTool] := TempCurH^^;
  135.                 ReleaseResource(handle(TempCurH));
  136.             end;
  137.  
  138.         TempCurH := GetCursor(BrushCursorID);
  139.         if TempCurH <> nil then begin
  140.                 ToolCursor[brush] := TempCurH^^;
  141.                 ReleaseResource(handle(TempCurH));
  142.             end;
  143.  
  144.         TempCurH := GetCursor(WatchCursor);
  145.         if TempCurH <> nil then begin
  146.                 watch := TempCurH^^;
  147.                 ReleaseResource(handle(TempCurH));
  148.             end;
  149.         for i := 1 to 8 do
  150.             AnimatedWatch[i] := watch;
  151.         id := FirstAnimatedWatchID;
  152.         for i := 2 to 8 do begin
  153.                 TempCurH := GetCursor(id);
  154.                 id := id + 1;
  155.                 if TempCurH <> nil then begin
  156.                         AnimatedWatch[i] := TempCurH^^;
  157.                         ReleaseResource(handle(TempCurH));
  158.                     end;
  159.             end;
  160.  
  161.     end;
  162.  
  163.  
  164.     procedure MakeToolsBitMap;
  165.   {Creates the offscreen bitmap used to draw the tool palette.}
  166.         var
  167.             tPort: GrafPtr;
  168.             TempPort: GrafPort;
  169.             PicH: PicHandle;
  170.             FrameRect: rect;
  171.             fwidth, fheight: integer;
  172.     begin
  173.         PicH := GetPicture(130);
  174.         if PicH = nil then
  175.             ExitToShell;
  176.         FrameRect := PicH^^.PicFrame;
  177.         with FrameRect do begin
  178.                 fwidth := right - left;
  179.                 fheight := bottom - top;
  180.             end;
  181.         GetPort(tPort);
  182.         OpenPort(@TempPort);
  183.         with ToolBits, FrameRect do begin
  184.                 baseAddr := NewPtr((fwidth * fheight) div 8);
  185.                 if baseAddr = nil then
  186.                     ExitToShell;
  187.                 rowBytes := fwidth div 8;
  188.                 SetRect(bounds, 0, 0, fwidth, fheight);
  189.             end;
  190.         SetPortBits(ToolBits);
  191.         DrawPicture(PicH, ToolBits.bounds);
  192.         DisposHandle(handle(PicH));
  193.         ClosePort(@TempPort);
  194.         SetPort(tPort);
  195.     end;
  196.  
  197.  
  198.     procedure InitTools;
  199.         var
  200.             ToolTop, LinesTop, i: integer;
  201.             Tool: ToolType;
  202.     begin
  203.         MakeToolsBitmap;
  204.         FirstTool := MagnifyingGlass;
  205.         LastTool := CrossHairTool;
  206.         CurrentTool := SelectionTool;
  207.         isSelectionTool := true;
  208.         PreviousTool := CurrentTool;
  209.         ToolTop := 0;
  210.         for tool := FirstTool to LastTool do
  211.             with ToolRect[tool] do begin
  212.                     top := ToolTop;
  213.                     bottom := top + tmiddle;
  214.                     if odd(ord(tool) + 1) then
  215.                         left := 0
  216.                     else begin
  217.                             left := tmiddle;
  218.                             ToolTop := ToolTop + tmiddle;
  219.                         end;
  220.                     right := left + tmiddle;
  221.                 end;
  222.         ToolTime := 0;
  223.         LutTime := 0;
  224.         StartOfLines := ToolRect[LastTool].bottom - 1;
  225.         LinesTop := StartOfLines + 10;
  226.         for i := 1 to nLineTypes do
  227.             with lines[i] do begin
  228.                     left := LinesLeft;
  229.                     top := LinesTop;
  230.                     right := LinesRight;
  231.                     case i of
  232.                         1, 2, 3, 4: 
  233.                             bottom := top + i;
  234.                         5: 
  235.                             bottom := top + 6;
  236.                         6: 
  237.                             bottom := top + 8
  238.                     end;
  239.                     LinesTop := bottom + 4;
  240.                 end;
  241.         LineWidth := 1;
  242.         LineIndex := 1;
  243.         with CheckRect do begin
  244.                 left := 0;
  245.                 top := StartOfLines;
  246.                 right := LinesLeft;
  247.                 bottom := theight;
  248.             end;
  249.     end;
  250.  
  251.  
  252.     procedure AllocateBuffers;
  253.         var
  254.             tPort: GrafPtr;
  255.             err: OSErr;
  256.             BufSizeStr: str255;
  257.             atemp: integer;
  258.             SaveGDevice: GDHandle;
  259.     begin
  260.         SaveGDevice := GetGDevice;
  261.         SetGDevice(osGDevice);
  262.         GetPort(tPort);
  263.         NumToString(BufferSize div 1024, BufSizeStr);
  264.         BigBufSize := BufferSize * 2;
  265.         if FreeMem > (BigBufSize + 300000) then
  266.             BigBuf := NewPtr(BigBufSize)
  267.         else
  268.             BigBuf := nil;
  269.         if BigBuf = nil then
  270.             BigBufSize := 0;
  271.         if BigBuf <> nil then
  272.             UndoBuf := BigBuf
  273.         else begin
  274.                 if FreeMem > (BufferSize + 200000) then
  275.                     UndoBuf := NewPtr(BufferSize)
  276.                 else
  277.                     UndoBuf := nil;
  278.             end;
  279.         if UndoBuf <> nil then
  280.             UndoBufSize := BufferSize
  281.         else begin
  282.                 PutMessage(concat('There is not enough memory available to allocate the ', BufSizeStr, 'K Undo buffer. Many operations may fail or be Undoable.'));
  283.                 UndoBufSize := 0;
  284.             end;
  285.         if BigBuf <> nil then
  286.             ClipBuf := ptr(ord4(BigBuf) + BufferSize)
  287.         else begin
  288.                 if FreeMem > (BufferSize + 300000) then
  289.                     ClipBuf := NewPtr(BufferSize)
  290.                 else
  291.                     ClipBuf := nil;
  292.             end;
  293.         UndoInfoRec := NoInfo^;
  294.         UndoInfo := @UndoInfoRec;
  295.         if UndoBuf <> nil then
  296.             with UndoInfo^ do begin
  297.                     roiRgn := NewRgn;
  298.                     PicBaseAddr := UndoBuf;
  299.                     osPort := CGrafPtr(NewPtr(SizeOf(CGrafPort)));
  300.                     OpenCPort(osPort);
  301.                     osPort^.portPixMap^^.BaseAddr := PicBaseAddr;
  302.                     SetPalette(WindowPtr(osPort), ExplicitPalette, false);
  303.                 end;
  304.         if ClipBuf <> nil then begin
  305.                 ClipBufSize := BufferSize;
  306.                 ClipBufInfoRec := NoInfo^;
  307.                 ClipBufInfo := @ClipBufInfoRec;
  308.                 with ClipBufInfo^ do begin
  309.                         roiRgn := NewRgn;
  310.                         PicBaseAddr := ClipBuf;
  311.                         osPort := CGrafPtr(NewPtr(SizeOf(CGrafPort)));
  312.                         OpenCPort(osPort);
  313.                         osPort^.portPixMap^^.BaseAddr := PicBaseAddr;
  314.                         BytesPerRow := 0;
  315.                         SetPalette(WindowPtr(osPort), ExplicitPalette, false);
  316.                     end;
  317.             end
  318.         else begin
  319.                 PutMessage(concat('There is not enough memory available to allocate the ', BufSizeStr, 'K Clipboard Buffer. Many operations, including Copy and Paste, may fail.'));
  320.                 ClipBufSize := 0;
  321.             end;
  322.         SetPort(tPort);
  323.         SetGDevice(SaveGDevice);
  324.     end;
  325.  
  326.  
  327.     procedure AllocateArrays;
  328.         var
  329.             nItems: LongInt;
  330.             i: integer;
  331.  
  332.         procedure Abort;
  333.         begin
  334.             PutMessage('Not enough memory available to allocate arrays.');
  335.             ExitToShell;
  336.         end;
  337.  
  338.     begin
  339.         PlotData := rLinePtr(NewPtr(SizeOf(rLineType)));
  340.         if PlotData = nil then
  341.             abort;
  342.         xCoordinates := xCoordinatesPtr(NewPtr(SizeOf(CoordinatesType)));
  343.         if xCoordinates = nil then
  344.             abort;
  345.         yCoordinates := yCoordinatesPtr(NewPtr(SizeOf(CoordinatesType)));
  346.         if yCoordinates = nil then
  347.             abort;
  348.         nItems := MaxMeasurements + 1;
  349.         mean := meanPtr(NewPtr(nItems * SizeOf(real)));
  350.         if mean = nil then
  351.             abort;
  352.         sd := sdPtr(NewPtr(nItems * SizeOf(real)));
  353.         if sd = nil then
  354.             abort;
  355.         PixelCount := PixelCountPtr(NewPtr(nItems * SizeOf(LongInt)));
  356.         if PixelCount = nil then
  357.             abort;
  358.         mArea := AreaPtr(NewPtr(nItems * SizeOf(real)));
  359.         if mArea = nil then
  360.             abort;
  361.         mode := modePtr(NewPtr(nItems * SizeOf(real)));
  362.         if mode = nil then
  363.             abort;
  364.         IntegratedDensity := IntegratedDensityPtr(NewPtr(nItems * SizeOf(real)));
  365.         if IntegratedDensity = nil then
  366.             abort;
  367.         idBackground := idBackgroundPtr(NewPtr(nItems * SizeOf(real)));
  368.         if idBackground = nil then
  369.             abort;
  370.         xcenter := xcenterPtr(NewPtr(nItems * SizeOf(real)));
  371.         if xcenter = nil then
  372.             abort;
  373.         ycenter := ycenterPtr(NewPtr(nItems * SizeOf(real)));
  374.         if ycenter = nil then
  375.             abort;
  376.         MajorAxis := MajorAxisPtr(NewPtr(nItems * SizeOf(real)));
  377.         if MajorAxis = nil then
  378.             abort;
  379.         MinorAxis := MinorAxisPtr(NewPtr(nItems * SizeOf(real)));
  380.         if MinorAxis = nil then
  381.             abort;
  382.         orientation := orientationPtr(NewPtr(nItems * SizeOf(real)));
  383.         if orientation = nil then
  384.             abort;
  385.         mMin := MinPtr(NewPtr(nItems * SizeOf(real)));
  386.         if mMin = nil then
  387.             abort;
  388.         mMax := MaxPtr(NewPtr(nItems * SizeOf(real)));
  389.         if mMax = nil then
  390.             abort;
  391.         plength := plengthPtr(NewPtr(nItems * SizeOf(real)));
  392.         if plength = nil then
  393.             abort;
  394.         User1 := User1Ptr(NewPtr(nItems * SizeOf(real)));
  395.         if User1 = nil then
  396.             abort;
  397.         for i := 0 to MaxMeasurements do
  398.             User1^[i] := 0.0;
  399.         User2 := User2Ptr(NewPtr(nItems * SizeOf(real)));
  400.         if User2 = nil then
  401.             abort;
  402.         for i := 0 to MaxMeasurements do
  403.             User2^[i] := 0.0;
  404.         ClearResults(0);
  405.         if FreeMem < MinFree then
  406.             Abort;
  407.     end;
  408.  
  409.  
  410.     function OpenWD (vRefNum: integer; dirID: LongInt; procID: LongInt; var wdRefNum: integer): OSErr;
  411. {Converts a volume reference number and directory ID into a working directory reference number. See TN 218.}
  412.         var
  413.             theWD: WDPBRec;
  414.             err: OSErr;
  415.     begin
  416.         with theWD do begin
  417.                 ioCompletion := nil;
  418.                 ioNamePtr := nil;
  419.                 ioVRefNum := VRefNum;
  420.                 ioWDProcID := 0;
  421.                 ioWDDirID := DirID;
  422.                 err := PBOpenWD(@theWD, false);
  423.                 if err = NoErr then
  424.                     wdRefNum := ioVRefNum;
  425.                 OpenWD := err;
  426.             end; {with}
  427.     end;
  428.  
  429.  
  430.     procedure GetKernelsWorkingDir (var settings: SettingsType);
  431.         var
  432.             wdRefNum: integer;
  433.             err: OSErr;
  434.     begin
  435.         with settings do
  436.             if sKernelsVRefNum <> 0 then begin
  437.                     err := OpenWD(sKernelsVRefNum, sKernelsDirID, 0, wdRefNum);
  438.                     if err = NoErr then
  439.                         KernelsRefNum := wdRefNum;
  440.           {ShowMessage(concat('KernelsRefNum=', long2str(KernelsRefNum), cr, 'vRefNum=', long2str(sKernelsVRefNum), cr, 'DirID=', long2str(sKernelsDirID)));}
  441.                 end;
  442.     end;
  443.  
  444.  
  445.     procedure GetDefaultWorkingDir (var settings: SettingsType);
  446.         var
  447.             wdRefNum: integer;
  448.             err: OSErr;
  449.     begin
  450.         with settings do
  451.             if sDefaultVRefNum <> 0 then begin
  452.                     err := OpenWD(sDefaultVRefNum, sDefaultDirID, 0, wdRefNum);
  453.                     if err = NoErr then
  454.                         DefaultRefNum := wdRefNum;
  455.                 end;
  456.     end;
  457.  
  458.  
  459.     procedure GetSettings;
  460.         var
  461.             err: OSErr;
  462.             f: integer;
  463.             ByteCount: LongInt;
  464.             ok: boolean;
  465.             size: LongInt;
  466.             settings: SettingsType;
  467.     begin
  468.         err := fsopen(PrefsName, SystemRefNum, f);
  469.         if err <> NoErr then
  470.             exit(GetSettings);
  471.         err := GetEof(f, ByteCount);
  472.         if ByteCount > SizeOf(settings) then
  473.             ByteCount := SizeOf(settings);
  474.         err := fsRead(f, ByteCount, @settings);
  475.         if err <> NoErr then
  476.             exit(GetSettings);
  477.         err := fsClose(f);
  478.         with settings, info^ do begin
  479.                 if sID <> 'IMAG' then begin
  480.                         PutMessage('The "Image Prefs" file in the System folder is corrupted. Please delete it and try again.');
  481.                         exitToShell;
  482.                     end;
  483.                 if (ForegroundIndex <> sForegroundIndex) or (BackgroundIndex <> sBackgroundIndex) then begin
  484.                         SetForegroundColor(sForegroundIndex);
  485.                         SetBackgroundColor(sBackgroundIndex);
  486.                     end;
  487.                 BrushHeight := sBrushHeight;
  488.                 BrushWidth := sBrushWidth;
  489.                 SprayCanDiameter := sSprayCanDiameter;
  490.                 SprayCanRadius := SprayCanDiameter div 2;
  491.                 SprayCanRadius2 := SprayCanRadius * SprayCanRadius;
  492.                 CurrentFontID := sCurrentFontID;
  493.                 CurrentStyle := SCurrentStyle;
  494.                 CurrentSize := sCurrentSize;
  495.                 TextJust := sTextJust;
  496.                 TextBack := sTextBack;
  497.                 nExtraColors := sNExtraColors;
  498.                 ExtraColors := sExtraColors;
  499.                 InvertVideo := sInvertVideo;
  500.                 Measurements := sMeasurements;
  501.                 InvertPlots := sInvertPlots;
  502.                 AutoScalePlots := sAutoScalePlots;
  503.                 LinePlot := sLinePlot;
  504.                 DrawPlotLabels := sDrawPlotLabels;
  505.                 FixedSizePlot := sFixedSizePlot;
  506.                 ProfilePlotWidth := sProfilePlotWidth;
  507.                 ProfilePlotHeight := sProfilePlotHeight;
  508.                 FramesToAverage := sFramesToAverage;
  509.                 NewPicWidth := sNewPicWidth;
  510.                 NewPicHeight := sNewPicHeight;
  511.                 BufferSize := sBufferSize;
  512.                 MaxScionWidth := sMaxScionWidth;
  513.                 ThresholdToForeground := sThresholdToForeground;
  514.                 NonThresholdToBackground := sNonThresholdToBackground;
  515.                 VideoChannel := sVideoChannel;
  516.                 WhatToImport := sWhatToImport;
  517.                 ImportCustomWidth := sImportCustomWidth;
  518.                 ImportCustomHeight := sImportCustomHeight;
  519.                 ImportCustomOffset := sImportCustomOffset;
  520.         {WandAutoMeasure := sWandAutoMeasure;}
  521.                 WandAdjustAreas := sWandAdjustAreas;
  522.                 BinaryIterations := sBinaryIterations;
  523.                 ScaleArithmetic := sScaleArithmetic;
  524.                 InvertPixelValues := sInvertPixelValues;
  525.                 InvertYCoordinates := sInvertYCoordinates;
  526.                 FieldWidth := sFieldWidth;
  527.                 precision := sPrecision;
  528.                 MinParticleSize := sMinParticleSize;
  529.                 MaxParticleSize := sMaxParticleSize;
  530.                 IgnoreParticlesTouchingEdge := sIgnoreParticlesTouchingEdge;
  531.                 LabelParticles := sLabelParticles;
  532.                 OutlineParticles := sOutlineParticles;
  533. {IncludeHoles := sIncludeHoles;}
  534.                 OscillatingMovies := sOscillatingMovies;
  535.                 DriverHalftoning := sDriverHalftoning;
  536.                 MaxMeasurements := sMaxMeasurements;
  537.                 ImportCustomDepth := sImportCustomDepth;
  538.                 ImportSwapBytes := sImportSwapBytes;
  539.                 ImportCalibrate := sImportCalibrate;
  540.                 ImportAutoscale := sImportAutoscale;
  541.                 ShowHeadings := sShowHeadings;
  542.                 if sVersion >= 140 then begin
  543.                         ProfilePlotMin := sProfilePlotMin;
  544.                         ProfilePlotMax := sProfilePlotMax;
  545.                         ImportMin := sImportMin;
  546.                         ImportMax := sImportMax;
  547.                         HighlightSaturatedPixels := sHighlightPixels;
  548.                     end;
  549.                 if sVersion >= 141 then begin
  550.                         BallRadius := sBallRadius;
  551.                         FasterBackgroundSubtraction := sFasterBackgroundSubtraction;
  552.                         ScaleConvolutions := sScaleConvolutions;
  553.                     end;
  554.                 if sVersion >= 142 then begin
  555.                         BinaryCount := sBinaryCount;
  556.                         BinaryThreshold := BinaryCount * 255;
  557.                         if (sLUTMode = Pseudocolor) and (sColorTable <> CustomTable) and (sColorTable <= Spectrum) then begin
  558.                                 SwitchColorTables(GetColorTableItem(sColorTable), false);
  559.                                 ColorStart := sColorStart;
  560.                                 ColorEnd := sColorEnd;
  561.                                 LutMode := Pseudocolor;
  562.                                 if sInvertedTable then
  563.                                     InvertPalette;
  564.                                 UpdateLut;
  565.                             end;
  566.                     end;
  567.                 if sVersion >= 144 then begin
  568.                         HalftoneFrequency := sHalftoneFrequency;
  569.                         HalftoneAngle := sHalftoneAngle;
  570.                         HalftoneDotFunction := sHalftoneDotFunction;
  571.                     end;
  572.                 if sVersion >= 146 then begin
  573.                         LG3DacLow := sLG3DacLow;
  574.                         LG3DacHigh := sLG3DacHigh;
  575.                     end;
  576.                 if (sVersion >= 147) and (FrameGrabber = ScionLG3) then
  577.                     SyncMode := sSyncMode;
  578.                 if sVersion >= 149 then begin
  579.                         SwitchLUTOnSuspend := sSwitchLUTOnSuspend;
  580.                         VideoRateAveraging := sVideoRateAveraging;
  581.                     end;
  582.                 if sVersion >= 150 then begin
  583.                         ImportInvert := sImportInvert;
  584.                     end;
  585.                 if sVersion >= 152 then begin
  586.                         if sTextCreator[1] <> chr(0) then
  587.                             TextCreator := sTextCreator;
  588.                     end;
  589.                 GetKernelsWorkingDir(settings);
  590.                 GetDefaultWorkingDir(settings);
  591.                 UpdateFitEllipse;
  592.             end; {with settings, info^}
  593.         case info^.LUTMode of
  594.             PseudoColor, ColorLut, CustomGrayscale: 
  595.                 UpdateLUT;
  596.             OldAppleDefault: 
  597.                 ok := LoadCLUTResource(AppleDefaultCLUT);
  598.             otherwise
  599.         end;
  600.         if nExtraColors > 0 then
  601.             RedrawLUTWindow;
  602.         if InvertPixelValues then
  603.             InvertGrayLevels;
  604.     end;
  605.  
  606.  
  607.     procedure MakePatterns;
  608. {Creates the patterns used to create the "marching ants". Thanks to}
  609. { Seth Snyder on CompuServe for the example.}
  610.         var
  611.             i, j: Integer;
  612.     begin
  613.         j := 0;
  614.         for i := 0 to 7 do begin
  615.                 pat[i][(j + 0) mod 8] := $1F;
  616.                 pat[i][(j + 1) mod 8] := $3E;
  617.                 pat[i][(j + 2) mod 8] := $7C;
  618.                 pat[i][(j + 3) mod 8] := $F8;
  619.                 pat[i][(j + 4) mod 8] := $F1;
  620.                 pat[i][(j + 5) mod 8] := $E3;
  621.                 pat[i][(j + 6) mod 8] := $C7;
  622.                 pat[i][(j + 7) mod 8] := $8F;
  623.                 j := j + 1;
  624.             end;
  625.         PatIndex := 0;
  626.     end;
  627.  
  628.  
  629.     procedure InitExtraColors;
  630.         var
  631.             i, j, ctop, cbottom, entry: integer;
  632.             tRect: rect;
  633.     begin
  634.         with ExtraColors[1] do begin
  635.                 red := -1;
  636.                 green := 0;
  637.                 blue := 0;
  638.             end;
  639.         with ExtraColors[2] do begin
  640.                 red := 0;
  641.                 green := -1;
  642.                 blue := 0;
  643.             end;
  644.         with ExtraColors[3] do begin
  645.                 red := 0;
  646.                 green := 0;
  647.                 blue := -1;
  648.             end;
  649.         with ExtraColors[4] do begin
  650.                 red := -1;
  651.                 green := -1;
  652.                 blue := 0;
  653.             end;
  654.         with ExtraColors[5] do begin
  655.                 red := 0;
  656.                 green := -1;
  657.                 blue := -1;
  658.             end;
  659.         with ExtraColors[6] do begin
  660.                 red := -1;
  661.                 green := 0;
  662.                 blue := -1;
  663.             end;
  664.         ctop := 256;
  665.         cbottom := ctop + ExtraColorsHeight;
  666.         for i := 1 to MaxExtraPlus2 do begin
  667.                 SetRect(tRect, 0, ctop, cwidth, cbottom);
  668.                 ExtraColorsRect[i] := tRect;
  669.                 ctop := ctop + ExtraColorsHeight;
  670.                 cbottom := cbottom + ExtraColorsHeight;
  671.             end;
  672.         ExtraColorsEntry[1] := WhiteIndex;
  673.         ExtraColorsEntry[2] := BlackIndex;
  674.         entry := FirstExtraColorsEntry;
  675.         j := 3;
  676.         for i := 1 to MaxExtraColors do begin
  677.                 ExtraColorsEntry[j] := entry;
  678.                 j := j + 1;
  679.                 Entry := Entry + 1;
  680.             end;
  681.     end;
  682.  
  683.  
  684.     function GetSlotBase (id: integer): LongInt;
  685.   {Returns the slot base address of the NuBus card with the specified id. The address}
  686.   {returned is in the form $Fss00000, which is valid in both 24 and 32-bit modes.}
  687.   {Returns 0 if a card with the given id is not found.}
  688.         type
  689.             SPRAMRecord = packed record
  690.                     BoardId: integer;
  691.                     VenderUse: packed array[1..6] of SignedByte;
  692.                 end;
  693.         var
  694.             SlotBlock: SpBlock;
  695.             sparm: SPRAMRecord;
  696.             SparmAddr: LongInt;
  697.             i: integer;
  698.             err: OSErr;
  699.     begin
  700.         with SlotBlock do begin
  701.                 SparmAddr := LongInt(@sparm);
  702.                 spResult := SparmAddr;
  703.                 for i := 9 to 15 do begin
  704.                         spSlot := i;
  705.                         err := sReadPRAMRec(@SlotBlock);
  706.                         if sparm.BoardID = id then begin
  707.                                 GetSlotBase := bor($F0000000, spSlot * $100000 + spSlot * $1000000);
  708.                                 exit(GetSlotBase)
  709.                             end;
  710.                     end;
  711.                 GetSlotBase := 0;
  712.             end;
  713.     end;
  714.  
  715.  
  716.     procedure SetupFGPort;
  717. {So we can use CopyBits, this routine sets up a color graf port that}
  718. {uses the memory on the frame grabber board as the PixMap.}
  719.         const
  720.             baseAddr32 = 4;
  721.         var
  722.             tPort: GrafPtr;
  723.             trect: rect;
  724.             SaveGDevice: GDHandle;
  725.     begin
  726.         SaveGDevice := GetGDevice;
  727.         SetGDevice(osGDevice);
  728.         GetPort(tPort);
  729.         fgPort := CGrafPtr(NewPtr(SizeOf(CGrafPort)));
  730.         OpenCPort(fgPort);
  731.         SetRect(trect, 0, 0, fgWidth, fgHeight);
  732.         with fgPort^ do begin
  733.                 with PortPixMap^^ do begin
  734.                         BaseAddr := ptr(fgSlotBase);
  735.                         bounds := trect;
  736.                         RowBytes := BitOr(fgRowBytes, $8000);
  737.                         pmVersion := baseAddr32; {Needed for 8*24 GC card. See TN 275.}
  738.                     end;
  739.                 PortRect := trect;
  740.                 RectRgn(visRgn, trect);
  741.             end;
  742.         SetPort(tPort);
  743.         SetPalette(WindowPtr(fgPort), ExplicitPalette, false);
  744.         SetGDevice(SaveGDevice);
  745.     end;
  746.  
  747.  
  748.     function is50HzLG3: boolean;
  749.         const
  750.             BoardResourceID = 1;
  751.             VendorInfoID = 36;
  752.             PartNumberID = 4;
  753.             PartNumber50Hz = 'LG-3 50Hz';
  754.         var
  755.             SlotBlock: SpBlock;
  756.             err: OSErr;
  757.             PartNumberPtr: StringPtr;
  758.     begin
  759.         is50HzLG3 := false;
  760.         SlotBlock.spSlot := byte(bsr(band(fgSlotBase, $0f000000), 24));
  761.         SlotBlock.spId := BoardResourceID;
  762.         SlotBlock.spExtDev := 0;
  763.         err := SRsrcInfo(@SlotBlock);
  764.         if err <> 0 then
  765.             exit(is50HzLG3);
  766.         SlotBlock.spId := VendorInfoID;
  767.         err := SFindStruct(@SlotBlock);
  768.         if err <> 0 then
  769.             exit(is50HzLG3);
  770.         SlotBlock.spID := PartNumberID;
  771.         err := SGetCString(@SlotBlock);
  772.         if err <> 0 then
  773.             exit(is50HzLG3);
  774.         PartNumberPtr := C2PStr(SlotBlock.spResult);
  775.         if PartNumberPtr^ = PartNumber50Hz then
  776.             is50HzLG3 := true;
  777.     end;
  778.  
  779.  
  780.     procedure CheckLG3Buffer;
  781.         type
  782.             LongintPtr = ^Longint;
  783.         const
  784.             Pattern = $A596A596;
  785.         var
  786.             BufferPtr: LongintPtr;
  787.     begin
  788.         BufferPtr := LongintPtr(fgSlotBase);
  789.         BufferReg^ := 0;
  790.         BufferPtr^ := Pattern;
  791.         if BufferPtr^ <> Pattern then begin
  792.                 MaxLG3Frames := 0;
  793.                 exit(CheckLG3Buffer);
  794.             end;
  795.         BufferReg^ := 2;
  796.         if BufferPtr^ = Pattern then begin
  797.                 MaxLG3Frames := 2;
  798.                 exit(CheckLG3Buffer);
  799.             end;
  800.         BufferReg^ := 8;
  801.         if BufferPtr^ = Pattern then begin
  802.                 MaxLG3Frames := 8;
  803.                 exit(CheckLG3Buffer);
  804.             end;
  805.         BufferReg^ := 32;
  806.         if BufferPtr^ = Pattern then begin
  807.                 MaxLG3Frames := 32;
  808.                 exit(CheckLG3Buffer);
  809.             end;
  810.         MaxLG3Frames := 128;
  811.     end;
  812.  
  813.  
  814.     procedure LookForFrameGrabbers;
  815.         const
  816.             ControlRegOffset = $80000;
  817.             ChannelRegOffset = $80004;
  818.             LG3ControlRegOffset = $C0000;
  819.             LG3ChannelRegOffset = $C0008;
  820.             BufferRegOffset = $C0004;
  821.             DacHighRegOffset = $C000C;
  822.             DacLowRegOffset = $C0010;
  823.             DacARegOffset = $C0014;
  824.             DacBRegOffset = $C0018;
  825.             DT2255id = $11A;
  826.             Scion1000id = $14B;
  827.             Scion1200id = $222;
  828.             ScionLG3id = $48b;
  829.             PalBufferSize = 393216; {768 x 512}
  830.         var
  831.             err: OSErr;
  832.             tPort: GrafPtr;
  833.             OptionKeyIsDown: boolean;
  834.     begin
  835.         OptionKeyIsDown := OptionKeyDown;
  836.         FrameGrabber := NoFrameGrabber;
  837.         fgPort := nil;
  838.         fgSlotBase := GetSlotBase(Scion1000id);
  839.         if (fgSlotBase <> 0) and not OptionKeyIsDown then begin
  840.                 FrameGrabber := Scion;
  841.                 exit(LookForFrameGrabbers);
  842.             end;
  843.         fgSlotBase := GetSlotBase(Scion1200id);
  844.         if (fgSlotBase <> 0) and not OptionKeyIsDown then begin
  845.                 FrameGrabber := Scion;
  846.                 exit(LookForFrameGrabbers);
  847.             end;
  848.         fgSlotBase := GetSlotBase(ScionLG3id);
  849.         if (fgSlotBase <> 0) and not OptionKeyIsDown then begin
  850.                 FrameGrabber := ScionLG3;
  851.                 ControlReg := ptr(fgSlotBase + LG3ControlRegOffset);
  852.                 ChannelReg := ptr(fgSlotBase + LG3ChannelRegOffset);
  853.                 BufferReg := ptr(fgSlotBase + BufferRegOffset);
  854.                 DacHighReg := ptr(fgSlotBase + DacHighRegOffset);
  855.                 DacLowReg := ptr(fgSlotBase + DacLowRegOffset);
  856.                 DacAReg := ptr(fgSlotBase + DacARegOffset);
  857.                 DacBReg := ptr(fgSlotBase + DacBRegOffset);
  858.                 fgWidth := 640;
  859.                 fgHeight := 480;
  860.                 if is50HzLG3 then begin
  861.                         fgWidth := 768;
  862.                         fgHeight := 512;
  863.                         if BufferSize < PalBufferSize then
  864.                             BufferSize := PalBufferSize;
  865.                     end;
  866.                 CheckLG3Buffer;
  867.                 SetupFGPort;
  868.                 ResetScionLG3;
  869.                 exit(LookForFrameGrabbers);
  870.             end;
  871.         fgSlotBase := GetSlotBase(DT2255id);
  872.         if fgSlotBase <> 0 then begin
  873.                 FrameGrabber := QuickCapture;
  874.                 ControlReg := ptr(fgSlotBase + ControlRegOffset);
  875.                 ChannelReg := ptr(fgSlotBase + ControlRegOffset + 4);
  876.                 fgWidth := 640;
  877.                 fgHeight := 480;
  878.                 if band(ChannelReg^, 8) = 8 then begin {Check for 50Hz(PAL) card}
  879.                         fgWidth := 768;
  880.                         fgHeight := 512;
  881.                         if BufferSize < PalBufferSize then
  882.                             BufferSize := PalBufferSize;
  883.                     end;
  884.                 SetupFGPort;
  885.                 ResetQuickCapture;
  886.                 exit(LookForFrameGrabbers);
  887.             end;
  888.     end;
  889.  
  890.  
  891.     procedure CheckBits;
  892.         const
  893.             QD32Trap = $AB03;
  894.             UnimplementedTrap = $A89F;
  895.         var
  896.             MainDevice: GDHandle;
  897.             myEnvRec: SysEnvRec;
  898.             err: OSErr;
  899.     begin
  900.         err := SysEnvirons(1, myEnvRec);
  901.         if err <> envNotPresent then
  902.             with MyEnvRec do begin
  903.                     if not HasColorQD then begin
  904.                             PutMessage('Sorry, NIH Image requires a Macintosh with Color QuickDraw.');
  905.                             ExitToShell;
  906.                         end;
  907.                     if not HasFPU and UsingFPU then begin
  908.                             PutMessage('Use the NonFPU version of NIH Image on Macs without a floating-point coprocessor.');
  909.                             ExitToShell;
  910.                         end;
  911.                     OldSystem := systemVersion < $0605;
  912.                     System7 := systemVersion >= $0700;
  913.                     SystemRefnum := sysVRefNum;
  914.                 end;
  915.         Has32BitQuickDraw := nGetTrapAddress(QD32Trap, ToolTrap) <> nGetTrapAddress(UnimplementedTrap, ToolTrap);
  916.         MainDevice := GetMainDevice;
  917.         ScreenPixMap := MainDevice^^.gdPMap;
  918.         ScreenRowBytes := BitAnd(ScreenPixMap^^.rowBytes, $1fff);
  919.         ScreenBase := ScreenPixMap^^.baseAddr;
  920.         FindMonitors(ScreenPixMap^^.PixelSize);
  921.     end;
  922.  
  923.  
  924.     procedure SetupMenus;
  925.         var
  926.             i: integer;
  927.     begin
  928.         AppleMenuH := GetMenu(AppleMenu);
  929.         InsertMenu(AppleMenuH, 0);
  930.         FileMenuH := GetMenu(FileMenu);
  931.         InsertMenu(FileMenuH, 0);
  932.         EditMenuH := GetMenu(EditMenu);
  933.         InsertMenu(EditMenuH, 0);
  934.         OptionsMenuH := GetMenu(OptionsMenu);
  935.         InsertMenu(OptionsMenuH, 0);
  936.         EnhanceMenuH := GetMenu(EnhanceMenu);
  937.         InsertMenu(EnhanceMenuH, 0);
  938.         AnalyzemenuH := GetMenu(AnalyzeMenu);
  939.         InsertMenu(AnalyzemenuH, 0);
  940.         SpecialMenuH := GetMenu(SpecialMenu);
  941.         InsertMenu(SpecialMenuH, 0);
  942.         StacksMenuH := GetMenu(StacksMenu);
  943.         InsertMenu(StacksMenuH, 0);
  944.         WindowsMenuH := GetMenu(WindowsMenu);
  945.         InsertMenu(WindowsMenuH, 0);
  946.  
  947.         FontMenuH := GetMenu(FontMenu);
  948.         InsertMenu(FontMenuH, -1);
  949.         SizeMenuH := GetMenu(SizeMenu);
  950.         InsertMenu(SizeMenuH, -1);
  951.         StyleMenuH := GetMenu(StyleMenu);
  952.         InsertMenu(StyleMenuH, -1);
  953.         BinaryMenuH := GetMenu(BinaryMenu);
  954.         InsertMenu(BinaryMenuH, -1);
  955.         ArithmeticMenuH := GetMenu(ArithmeticMenu);
  956.         InsertMenu(ArithmeticMenuH, -1);
  957.         BackgroundMenuH := GetMenu(BackgroundMenu);
  958.         InsertMenu(BackgroundMenuH, -1);
  959.         PropagateMenuH := GetMenu(PropagateMenu);
  960.         InsertMenu(PropagateMenuH, -1);
  961.         ColorTablesMenuH := GetMenu(ColorTablesMenu);
  962.         InsertMenu(ColorTablesMenuH, -1);
  963.         AcquireMenuH := GetMenu(AcquireMenu);
  964.         InsertMenu(AcquireMenuH, -1);
  965.         ExportMenuH := GetMenu(ExportMenu);
  966.         InsertMenu(ExportMenuH, -1);
  967.         FilterMenuH := GetMenu(FilterMenu);
  968.         InsertMenu(FilterMenuH, -1);
  969.  
  970.         TransferModeMenuH := GetMenu(TransferModeMenu);
  971.         InsertMenu(TransferModeMenuH, -1);
  972.  
  973.         LineToolMenuH := GetMenu(LineToolMenu);
  974.         InsertMenu(LineToolMenuH, -1);
  975.  
  976.         ImageMathOpsMenuH := GetMenu(ImageMathOpsMenu);
  977.         InsertMenu(ImageMathOpsMenuH, -1);
  978.  
  979.         ImageListMenuH := GetMenu(ImageListMenu);
  980.         InsertMenu(ImageListMenuH, -1);
  981.  
  982.         UnitsMenuH := GetMenu(UnitsMenu);
  983.         InsertMenu(UnitsMenuH, -1);
  984.  
  985.         DrawMenuBar;
  986.         AddResMenu(AppleMenuH, 'DRVR');
  987.         AddResMenu(FontMenuH, 'FONT');
  988.         NumFontItems := CountMItems(FontMenuH);
  989.     end;
  990.  
  991.  
  992.     function GetFolderDirID (parentFolderVRefNum: Integer; parentFolderDirID: LongInt; folderName: Str63; var folderDirID: LongInt): OSErr;
  993.   {Given a folder's name, vRefNum, and parent dirID, find its dirID }
  994.         var
  995.             myCInfoPBRec: CInfoPBRec;
  996.             retCode: OSErr;
  997.     begin
  998.         myCInfoPBRec.ioCompletion := nil;
  999.         myCInfoPBRec.ioNamePtr := @folderName;
  1000.         myCinfoPBRec.ioVRefNum := parentFolderVRefNum;
  1001.         myCInfoPBRec.ioFDirIndex := 0; { use name, vRefNum, dirID }
  1002.         myCInfoPBRec.ioDrDirID := parentFolderDirID; { will be changed }
  1003.         retCode := PBGetCatInfoSync(@myCInfoPBRec); { IM IV-155 }
  1004.         if retCode = noErr then
  1005.             folderDirID := myCInfoPBRec.ioDrDirID;
  1006.         GetFolderDirID := retCode;
  1007.     end;
  1008.  
  1009.  
  1010.     procedure MyAppendMenu (menu: MenuHandle; item: integer; str: str255);
  1011.     begin
  1012.         AppendMenu(menu, ' ');
  1013.         SetItem(menu, item, str);
  1014.     end;
  1015.  
  1016.  
  1017.     procedure FindPlugIns;
  1018.         var
  1019.             err: OSErr;
  1020.             wdRefNum, index, SystemVRefNum: integer;
  1021.             name: Str255;
  1022.             ftype: OSType;
  1023.             PB: HParamBlockRec;
  1024.             ProcID, SystemDirID: LongInt;
  1025.             spec: FSSpec;
  1026.             pb2: WDPBRec;
  1027.             rCount, iFileRef: integer;
  1028.     begin
  1029.         if not System7 then
  1030.             exit(FindPlugIns);
  1031.         err := GetFolderDirID(LaunchVRefNum, LaunchDirID, 'Plug-Ins', PlugInsDirID);
  1032.         if err = NoErr then
  1033.             PlugInsVRefNum := LaunchVRefNum
  1034.         else if GetWDInfo(SystemRefNum, SystemVRefNum, SystemDirID, ProcID) = NoErr then
  1035.             if GetFolderDirID(SystemVRefNum, SystemDirID, 'Plug-Ins', PlugInsDirID) = NoErr then
  1036.                 PlugInsVRefNum := SystemVRefNum
  1037.             else
  1038.                 exit(FindPlugIns);
  1039.         err := OpenWD(PlugInsVRefNum, PlugInsDirID, 0, wdRefNum);
  1040.         if err <> NoErr then
  1041.             exit(FindPlugIns);
  1042.         index := 0;
  1043.         while true do begin
  1044.                 index := index + 1;
  1045.                 with PB do begin
  1046.                         ioCompletion := nil;
  1047.                         ioNamePtr := @name;
  1048.                         ioVRefNUm := wdRefNum;
  1049.                         ioVersNum := 0;
  1050.                         ioFDirIndex := index;
  1051.                         err := PBGetFInfo(@PB, false);
  1052.                         if err = fnfErr then
  1053.                             leave;
  1054.                     end;
  1055.                 spec.vrefnum := PluginsVRefNum;
  1056.                 spec.parID := PlugInsDirID;
  1057.                 spec.name := name;
  1058.                 iFileRef := FSpOpenResFile(spec, fsCurPerm);
  1059.                 if iFileRef <> -1 then begin
  1060.                         UseResFile(iFileRef);
  1061.                         rCount := Count1Resources('8BAM');
  1062.                         if rCount > 0 then begin
  1063.                                 nAcqPlugIns := nAcqPlugIns + 1;
  1064.                                 if nAcqPlugIns = 1 then
  1065.                                     SetItem(AcquireMenuH, 1, name)
  1066.                                 else
  1067.                                     MyAppendMenu(AcquireMenuH, nAcqPlugIns, name);
  1068.                             end;
  1069.                         rCount := Count1Resources('8BEM');
  1070.                         if rCount > 0 then begin
  1071.                                 nExportPlugIns := nExportPlugIns + 1;
  1072.                                 if nExportPlugIns = 1 then
  1073.                                     SetItem(ExportMenuH, 1, name)
  1074.                                 else
  1075.                                     MyAppendMenu(ExportMenuH, nExportPlugIns, name);
  1076.                             end;
  1077.                         rCount := Count1Resources('8BFM');
  1078.                         if rCount > 0 then begin
  1079.                                 nFilterPlugIns := nFilterPlugIns + 1;
  1080.                                 if nFilterPlugIns = 1 then
  1081.                                     SetItem(FilterMenuH, 1, name)
  1082.                                 else
  1083.                                     MyAppendMenu(FilterMenuH, nFilterPlugIns, name);
  1084.                             end;
  1085.                         CloseResFile(iFileRef);
  1086.                     end;
  1087.             end; {while}
  1088.         err := CloseWD(wdRefNum);
  1089.     end;
  1090.  
  1091.  
  1092.     procedure MakeGDevice;
  1093.   {Sets up an offscreen 8-bit graphics environment for use when the screen is not 8-bits.}
  1094.         var
  1095.             DeviceRect: Rect;
  1096.             h: CTabHandle;
  1097.             SaveDevice: GDHandle;
  1098.  
  1099.         procedure Abort;
  1100.         begin
  1101.             PutMessage('Error creating GDevice.');
  1102.             ExitToShell;
  1103.         end;
  1104.  
  1105.     begin
  1106.         SaveDevice := GetGDevice;
  1107.         SetRect(DeviceRect, 0, 0, 64, 64);
  1108.         h := GetCTable(AppleDefaultClut);
  1109.         if h = nil then
  1110.             abort;
  1111.         osGDevice := NewGDevice(0, -1);
  1112.         if osGDevice = nil then
  1113.             abort;
  1114.         with osGDevice^^ do begin
  1115.                 gdId := 0;
  1116.                 gdType := clutType;
  1117.                 gdResPref := 3;                                            { Color matching resolution. }
  1118.                 gdSearchProc := nil;
  1119.                 gdCompProc := nil;
  1120.                 gdFlags := $C401;                                            { 1100 0100 0000 0001 }
  1121.                 gdRect := DeviceRect;
  1122.                 with gdPMap^^ do begin
  1123.                         baseAddr := nil;
  1124.                         bounds := DeviceRect;
  1125.                         rowBytes := 64 + $8000;
  1126.                         pixelSize := 8;
  1127.                         cmpCount := 1;
  1128.                         cmpSize := 8;
  1129.                         DisposCTable(pmTable);
  1130.                         pmTable := h;
  1131.                     end;
  1132.             end;
  1133.         SetGDevice(SaveDevice);
  1134.     end;
  1135.  
  1136.  
  1137.     procedure Init;
  1138.         var
  1139.             i: integer;
  1140.             p: SyspPtr;
  1141.             mbhp: ^integer;
  1142.             str: str255;
  1143.             err: OSErr;
  1144.     begin
  1145.         SetApplLimit(ptr(LongInt(GetApplLimit) - StackSize));
  1146.         MaxApplZone;
  1147.         InitGraf(@ThePort);
  1148.         InitFonts;
  1149.         InitWindows;
  1150.         InitCursor;
  1151.         TEInit;
  1152.         InitDialogs(@SysResume);
  1153.         CheckBits;
  1154.         ScreenPort := GrafPtr(NewPtr(SizeOf(GrafPort)));
  1155.         OpenPort(ScreenPort);
  1156.         NoInfo := @NoInfoRec;
  1157.         Info := NoInfo;
  1158.         InfoWindow := nil;
  1159.         with BlackRGB do begin
  1160.                 red := 0;
  1161.                 blue := 0;
  1162.                 green := 0;
  1163.             end;
  1164.         with WhiteRGB do begin
  1165.                 red := -1;
  1166.                 blue := -1;
  1167.                 green := -1;
  1168.             end;
  1169.         with NoInfo^ do begin
  1170.                 nlines := 0;
  1171.                 PixelsPerLine := 0;
  1172.                 ImageSize := 0;
  1173.                 PixMapSize := 0;
  1174.                 PicBaseAddr := nil;
  1175.                 PicBaseHandle := nil;
  1176.                 osPort := nil;
  1177.                 RoiShowing := false;
  1178.                 RoiType := NoRoi;
  1179.                 RoiRect := SrcRect;
  1180.                 roiRgn := NewRgn;
  1181.                 title := 'NoInfo';
  1182.                 Magnification := 1.0;
  1183.                 PictureType := NullPicture;
  1184.                 wptr := nil;
  1185.                 Changes := false;
  1186.                 BytesPerRow := 0;
  1187.                 SetRect(SrcRect, 0, 0, 0, 0);
  1188.                 PicRect := SrcRect;
  1189.                 wrect := SrcRect;
  1190.                 initwrect := wrect;
  1191.                 savewrect := wrect;
  1192.                 SaveSrcRect := SrcRect;
  1193.                 SaveMagnification := magnification;
  1194.                 savehloc := 0;
  1195.                 savevloc := 0;
  1196.                 ScaleToFitWindow := false;
  1197.                 nColors := 256;
  1198.                 ColorStart := 0;
  1199.                 ColorEnd := 255;
  1200.                 SaveColorStart := 0;
  1201.                 SaveColorEnd := 255;
  1202.                 FillColor1 := BlackRGB;
  1203.                 FillColor2 := BlackRGB;
  1204.                 SaveFill1 := BlackRGB;
  1205.                 SaveFill2 := BlackRGB;
  1206.                 LUTMode := GrayScale;
  1207.                 ColorTable := CustomTable;
  1208.                 InvertedColorTable := false;
  1209.                 xUnit := 'pixel';
  1210.                 xSpatialScale := 0.0;
  1211.                 ySpatialScale := 0.0;
  1212.                 PixelAspectRatio := 1.0;
  1213.                 SpatiallyCalibrated := false;
  1214.                 UnitOfMeasure := '';
  1215.                 PicNum := 1;
  1216.                 PidNum := 0;
  1217.                 HeaderOffset := -1;
  1218.                 ImageDataOffset := -1;
  1219.                 ColorMapOffset := -1;
  1220.                 for i := 0 to 255 do
  1221.                     ctable[i].value := 0;
  1222.                 Fit := Poly3;
  1223.                 DensityCalibrated := false;
  1224.                 ZeroClip := false;
  1225.                 nCoefficients := 0;
  1226.                 for i := 1 to 6 do
  1227.                     Coefficient[i] := 0.0;
  1228.                 BinaryPic := false;
  1229.                 WindowState := NormalWindow;
  1230.                 Revertable := false;
  1231.                 LX1 := -1.0;
  1232.                 LY1 := -1.0;
  1233.                 LX2 := -1.0;
  1234.                 LY2 := -1.0;
  1235.                 LAngle := 0.0;
  1236.                 IdentityFunction := false;
  1237.                 StackInfo := nil;
  1238.                 Thresholding := false;
  1239.                 iVersion := 0;
  1240.                 vref := 0;
  1241.                 DataType := EightBits;
  1242.                 AbsoluteMin := 0;
  1243.                 AbsoluteMax := 0;
  1244.                 CurrentMin := 0;
  1245.                 CurrentMax := 0;
  1246.                 LittleEndian := false;
  1247.                 DataH := nil;
  1248.             end;
  1249.         ExplicitPalette := NewPalette(256, nil, pmExplicit, 0);
  1250.         CScreenPort := CGrafPtr(NewPtr(SizeOf(CGrafPort)));
  1251.         OpenCPort(CScreenPort);
  1252.         SetPalette(WindowPtr(CScreenPort), ExplicitPalette, false);
  1253.         finished := false;
  1254.         FlushEvents(EveryEvent, 0);
  1255.         for i := 1 to 10 do
  1256.             MoreMasters;
  1257.         mbhp := pointer(MBarHeight);
  1258.         MenuBarHeight := mbhp^;
  1259.         SetRect(trect, tleft, ttop, tleft + twidth, ttop + theight);
  1260.         ToolWindow := NewCWindow(nil, trect, 'Tools', true, NoGrowDocProc, nil, false, 0);
  1261.         SetPalette(ToolWindow, ExplicitPalette, false);
  1262.         WindowPeek(ToolWindow)^.WindowKind := ToolKind;
  1263.         BringToFront(ToolWindow);
  1264.         ScreenWidth := ScreenBits.Bounds.right;
  1265.         ScreenHeight := ScreenBits.Bounds.bottom;
  1266.         SliceStart := 100;
  1267.         SliceEnd := 150;
  1268.         with SliceColor do begin
  1269.                 red := -1;
  1270.                 green := 0;
  1271.                 blue := 0;
  1272.             end;
  1273.         DensitySlicing := false;
  1274.         nExtraColors := 0;
  1275.         GrayMapReady := false;
  1276.         MakeGDevice;
  1277.         ResetGrayMap;   {LUT must be setup before InitMenus}
  1278.         InitMenus;
  1279.         SetRect(gmrect, gmleft, gmtop, gmleft + gmwidth, gmtop + gmheight);
  1280.         SetRect(gmSlide1, gmrectleft, gmrectbottom + gmSlide1Offset, gmrectleft + gmSlideWidth, gmrectbottom + gmSlide1Offset + gmSlideHeight);
  1281.         gmSlide1i := gmSlide1;
  1282.         InsetRect(gmSlide1i, 1, 1);
  1283.         SetRect(gmSlide2, gmrectleft, gmrectbottom + gmSlide2Offset, gmrectleft + gmSlideWidth, gmrectbottom + gmSlide2Offset + gmSlideHeight);
  1284.         gmSlide2i := gmSlide2;
  1285.         InsetRect(gmSlide2i, 1, 1);
  1286.         SetRect(gmIcon1, gmIcon1left, gmrectbottom + gmIconOffset, gmIcon1left + gmIconWidth, gmrectbottom + gmIconOffset + gmIconHeight);
  1287.         SetRect(gmIcon2, gmIcon2left, gmrectbottom + gmIconOffset, gmIcon2left + gmIconWidth, gmrectbottom + gmIconOffset + gmIconHeight);
  1288.         MapWindow := NewWindow(nil, gmrect, 'Map', true, NoGrowDocProc, nil, false, 0);
  1289.         WindowPeek(MapWindow)^.WindowKind := MapKind;
  1290.         SetRect(MapRect1, gmRectLeft, gmRectTop, gmRectRight, gmRectBottom);
  1291.         MapRect2 := MapRect1;
  1292.         InsetRect(MapRect2, -2, -2);
  1293.         cheight := 256 + (2 + nExtraColors) * ExtraColorsHeight;
  1294.         SetRect(crect, cleft, ctop, cleft + cwidth, ctop + cheight);
  1295.         LUTWindow := NewCWindow(nil, crect, 'LUT', true, NoGrowDocProc, nil, false, 0);
  1296.         SetPalette(LUTWindow, ExplicitPalette, false);
  1297.         WindowPeek(LUTWindow)^.WindowKind := LUTKind;
  1298.         rleft := 2;
  1299.         if ScreenHeight > 480 then
  1300.             rtop := ScreenHeight - rheight - 5
  1301.         else
  1302.             rtop := 358;
  1303.         SetRect(trect, rleft, rtop, rleft + rwidth, rtop + rheight);
  1304.         InfoWindow := NewWindow(nil, trect, 'Info', true, NoGrowDocProc, nil, false, 0);
  1305.         BringToFront(InfoWindow);
  1306.         WindowPeek(InfoWindow)^.WindowKind := InfoKind;
  1307.         BuggyWatch := GetCursor(WatchCursor);
  1308.         InitTools;
  1309.         MakeCursors;
  1310.         nPics := 0;
  1311.         nextPid := -1;
  1312.         HistoWindow := nil;
  1313.         PlotWindow := nil;
  1314.         IsInsertionPoint := false;
  1315.         MaskRgn := NewRgn;
  1316.         PlotPICT := nil;
  1317.         AutoscalePlots := true;
  1318.         InvertPlots := false;
  1319.         LinePlot := true;
  1320.         DrawPlotLabels := true;
  1321.         FixedSizePlot := false;
  1322.         ProfilePlotMin := 0;
  1323.         ProfilePlotMax := 255;
  1324.         ProfilePlotWidth := 300;
  1325.         ProfilePlotHeight := 150;
  1326.         SprayCanDiameter := 32;
  1327.         SprayCanRadius := 16;
  1328.         SprayCanRadius2 := 256;
  1329.         BrushWidth := 14;
  1330.         BrushHeight := 14;
  1331.         CurrentUndoSize := 0;
  1332.         p := GetSyspPtr;
  1333.         BlinkTime := BitAnd($000F, p^.volclik) * 4;
  1334.         MakePatterns;
  1335.         info^.LUTMode := GrayScale;
  1336.         PicLeftBase := twidth + cwidth + 10;
  1337.         PicTopBase := MenuBarHeight + 20;
  1338.         PicLeft := PicLeftBase;
  1339.         PicTop := PicTopBase;
  1340.         CurrentFontID := Helvetica;
  1341.         CurrentStyle := []; {plain}
  1342.         CurrentSize := 12;
  1343.         TextJust := teJustLeft;
  1344.         TextBack := NoBack;
  1345.         MouseState := NotInRoi;
  1346.         WhatsOnClip := NothingOnClip;
  1347.         InitExtraColors;
  1348.         OldScrapCount := GetScrapCount;
  1349.         ClipboardConverted := false;
  1350.         BufferSize := DefaultBufferSize;
  1351.         LookForFrameGrabbers;
  1352.         VideoChannel := 0;
  1353.         Digitizing := false;
  1354.         debugging := false;
  1355.         BlankFieldInfo := nil;
  1356.         InvertVideo := false;
  1357.         HighlightSaturatedPixels := false;
  1358.         PlotCount := 0;
  1359.         PlotAvg := 1;
  1360.         ActualPlotMin := 0.0;
  1361.         ActualPlotMax := 0.0;
  1362.         ClipTextInBuffer := false;
  1363.         TextBufP := TextBufPtr(NewPtr(SizeOf(TextBufType)));
  1364.         if TextBufP = nil then
  1365.             ExitToShell;
  1366.         MacrosP := MacrosPtr(NewPtr(SizeOf(MacrosRec)));
  1367.         if MacrosP = nil then
  1368.             ExitToShell;
  1369.         mCount := 0;
  1370.         mCount2 := 0;
  1371.         nPoints := 0;
  1372.         nLengths := 0;
  1373.         nAngles := 0;
  1374.         for i := 1 to MaxStandards do
  1375.             StandardValues[i] := BadReal;
  1376.         nStandards := 0;
  1377.         for i := 0 to 255 do
  1378.             cvalue[i] := i;
  1379.         WhatToUndo := NothingToUndo;
  1380.         WhatToCopy := NothingToCopy;
  1381.         PrintRecord := nil;
  1382.         printing := false;
  1383.         HalftoneFrequency := 53;
  1384.         HalftoneAngle := 45;
  1385.         HalftoneDotFunction := true;
  1386.         cr := chr(13);
  1387.         tab := chr(9);
  1388.         BackSpace := chr(8);
  1389.         eof := chr(4);
  1390.         measuring := false;
  1391.         measurements := [AreaM, MeanM];
  1392.         UpdateFitEllipse;
  1393.         nListColumns := 0;
  1394.         FramesToAverage := 16;
  1395.         NewPicWidth := 552;
  1396.         NewPicHeight := 436;
  1397.         RestoreUndoBuf := true;
  1398.         MaxScionWidth := 600;
  1399.         ThresholdToForeground := true;
  1400.         NonThresholdToBackground := true;
  1401.         SelectionMode := NewSelection;
  1402.         RoiMovementState := Unconstrained;
  1403.         PasteControl := nil;
  1404.         PasteTransferMode := SrcCopy;
  1405.         WhatToImport := ImportTIFF;
  1406.         ImportCustomWidth := 512;
  1407.         ImportCustomHeight := 512;
  1408.         ImportCustomSlices := 1;
  1409.         ImportCustomOffset := 0;
  1410.         ImportCustomDepth := EightBits;
  1411.         ImportSwapBytes := false;
  1412.         ImportCalibrate := true;
  1413.         ImportAll := false;
  1414.         ImportInvert := false;
  1415.         RoiNudged := false;
  1416.         ForegroundIndex := BlackIndex;
  1417.         BackgroundIndex := WhiteIndex;
  1418.         OpPending := false;
  1419.         RedoSelection := false;
  1420.         WandAutoMeasure := false;
  1421.         WandAdjustAreas := false;
  1422.         OptionKeyWasDown := false;
  1423.         BinaryIterations := 1;
  1424.         ScaleArithmetic := true;
  1425.         InfoMessage := '';
  1426.         SaveAsWhat := asTIFF;
  1427.         ExportAsWhat := asRaw;
  1428.         AnalyzingParticles := false;
  1429.         RedirectSampling := false;
  1430.         MinParticleSize := 1;
  1431.         MaxParticleSize := 999999;
  1432.         LabelParticles := true;
  1433.         OutlineParticles := false;
  1434.         IgnoreParticlesTouchingEdge := false;
  1435.         IncludeHoles := false;
  1436.         SaveAllState := NoSaveAll;
  1437.         InvertYCoordinates := true;
  1438.         ContinuousHistogram := false;
  1439.         DrawLabels(' ', '', '');
  1440.         HistogramSliceStart := 0;
  1441.         HistogramSliceEnd := 255;
  1442.         RoiUpdateTime := 0;
  1443.         FieldWidth := 9;
  1444.         precision := 2;
  1445.         MeasurementToRedo := 0;
  1446.         nMacros := 0;
  1447.         macro := false;
  1448.         KernelsRefNum := 0;
  1449.         DefaultRefNum := 0;
  1450.         MacrosRefNum := 0;
  1451.         LaunchVRefNum := 0;
  1452.         LaunchDirID := 0;
  1453.         PlugInsVRefNum := 0;
  1454.         PlugInsDirID := 0;
  1455.         DefaultFileName := '';
  1456.         rsHScale := 1.0;
  1457.         rsVScale := 1.0;
  1458.         rsAngle := 0.0;
  1459.         rsMethod := NearestNeighbor;
  1460.         rsCreateNewWindow := true;
  1461.         rsInteractive := false;
  1462.         ImportAutoScale := true;
  1463.         ImportMin := 0.0;
  1464.         ImportMax := 255.0;
  1465.         InvertPixelValues := false;
  1466.         OscillatingMovies := false;
  1467.         DriverHalftoning := true;
  1468.         LivePasteMode := false;
  1469.         ShowCount := true;
  1470.         PasteControlLeft := ScreenWidth - pcwidth - 10;
  1471.         PasteControlTop := trunc(ScreenHeight * 0.2);
  1472.         MaxMeasurements := 256;
  1473.         ResultsLeft := PicLeftBase;
  1474.         ResultsTop := 56;
  1475.         UnsavedResults := false;
  1476.         MajorLabel := 'Major';
  1477.         MinorLabel := 'Minor';
  1478.         User1Label := 'User 1';
  1479.         User2Label := 'User 2';
  1480.         ShowHeadings := false;
  1481.         MakingLOI := false;
  1482.         LOIType := Straight;
  1483.         MakingStack := false;
  1484.         FramesWanted := 20;
  1485.         ScaleConvolutions := true;
  1486.         FasterBackgroundSubtraction := true;
  1487.         BallRadius := 50;
  1488.         DelayTicks := 0;
  1489.         CmdPeriodToStop := 'Type cmd-''.'' to stop.';
  1490.         CommandKey := chr(17);
  1491.         BinaryCount := 4;
  1492.         BinaryThreshold := BinaryCount * 255;
  1493.         ClipboardColor := BlackRGB;
  1494.         InitAngle := 0;                                             {default is one full revolution of volume}
  1495.         TotalAngle := 360;
  1496.         AngleInc := 10;                                           {in ten-degree increments}
  1497.         TransparencyUpper := 254;                      {default has only value 255 transparent}
  1498.         TransparencyLower := 0;
  1499.         DepthCueSurf := 0;                                     {default has full depth-cueing for surface}
  1500.         DepthCueInt := 50;                                     {components and 50% depth-cueing elsewhere}
  1501.         SaveProjections := FALSE;                         {by default, do not save and close projections}
  1502.         AxisOfRotation := xAxis;
  1503.         MinProjSize := TRUE;                                {by default, make all windows just big enough}
  1504.         ProjectionMethod := NearestPoint;
  1505.         MeterWindow := nil;
  1506.         nCoordinates := 0;
  1507.         CoordinatesWidth := 0;
  1508.         CoordinatesHeight := 0;
  1509.         CoordinatesRoiType := NoRoi;
  1510.         SwitchLUTOnSuspend := false;
  1511.         SumFrames := false;
  1512.         ShowIntegratedValues := false;
  1513.         FixIntegrationScale := false;
  1514.         IntegrationMin := 0;
  1515.         IntegrationMax := 4096;
  1516.         ExternalTrigger := false;
  1517.         BlindMovieCapture := false;
  1518.         LG3DacLow := DefaultLG3DacLow;
  1519.         LG3DacHigh := DefaultLG3DacHigh;
  1520.         VideoControl := nil;
  1521.         SyncMode := NormalSync;
  1522.         VideoRateAveraging := false;
  1523.         DitherColor := true;
  1524.         RGBLut := CustomLUT;
  1525.         with Highlight1 do begin
  1526.                 red := -1;
  1527.                 green := 0;
  1528.                 blue := 0;
  1529.             end;
  1530.         with Highlight254 do begin
  1531.                 red := -1;
  1532.                 green := -1;
  1533.                 blue := 0;
  1534.             end;
  1535.         HighlightMode := false;
  1536.         LegalWithoutImage := [UpdateLutC, StartC, ShowResultsC, GetPicSizeC, PutMsgC, ExitC, CaptureC, MoveToC, BeepC, MakeNewC, SetPaletteC, SetBackC, GetRoiC, OpenC, ImportC, SetImportC, SetMinMaxC, SetCustomC, nPicsC, WaitC, SetSizeC, TriggerC, AverageFramesC, SaveStateC, RestoreStateC, SetCounterC, MakeStackC, ShowMsgC, SetUser1C, SetUser2C, SetOptionsC, RequiresC];
  1537.         LegalWithoutImage := LegalWithoutImage + [DisposeAllC, GetTimeC, SetForeC, SetBackC, GetStringC, OpenSerialC, GetSerialC, PutSerialC, SetCursorC, TickCountC, ConcatC, SetVideoC, StringToNumC, ChannelC, AcquireC, UndoSizeC, FilterC, PhotoModeC, DrawTextC, WriteC, WritelnC, NewTextWindowC, UserCodeC, SelectWindowC, BitAndC, BitOrC, WindowTitleC, ScaleConvolutionsC];
  1538.         LegalWithoutImage := LegalWithoutImage + [SaveC, SaveAsC, CloseC, DisposeC, PosC, DeleteC, LengthC];
  1539.         TopOfStack := 0;
  1540.         SerialBufferP := nil;
  1541.         MacroTicks := 0;
  1542.         OpeningPlugInWindow := false;
  1543.         LG3DacA := 0;
  1544.         LG3DacB := 0;
  1545.         LG3DataOut := 0;
  1546.         nAcqPlugIns := 0;
  1547.         nExportPlugIns := 0;
  1548.         nFilterPlugIns := 0;
  1549.         LastAcqPlugIn := '';
  1550.         LastFilterPlugIn := '';
  1551.         LastExportPlugIn := '';
  1552.         TextInfo := nil;
  1553.         nTextWindows := 0;
  1554.         NewTitle := 'Untitled';
  1555.         CurrentWPtr := nil;
  1556.         CurrentKind := 0;
  1557.         SearchString := '';
  1558.         TextCreator := 'Imag';
  1559.         CurrentMathOp := SubMath;
  1560.         MathSrc1 := 1;
  1561.         MathSrc2 := 1;
  1562.         MathGain := 0.5;
  1563.         MathOffset := 128;
  1564.         MathResult := 'Result';
  1565.         PrintOptionsSet := false;
  1566.         APReset := true;
  1567.         ShowPlot := true;
  1568.         FiducialMethod := OnScreen;
  1569.         ConfirmFidClicks := false;
  1570.         WatchIndex := 1;
  1571.         WireframeSurfacePlots := true;
  1572.         GrayscaleSurfacePlots := false;
  1573.     end;
  1574.  
  1575.  
  1576. end.