program Image; {Image is a program for the Macintosh II for acquiring, enhancing, analyzing, editing,} {pseudocoloring, printing, and animating grayscale and color images.} {Version 1.28 , 12 March 1990} {Developed using Think Pascal 2.0} {Author :} {Wayne Rasband} {National Institutes of Health} {Internet: wayne@helix.nih.gov} {BitNet: wayne@helix.nih.gov} {CompuServe: 76067,3454} uses {$IFC Arlo } QuickDraw, OSIntf, ToolIntf, PrintTraps, Globals, Utilities, Initialization, File1, File2, Analysis, Graphics, Edit, Functions, Camera, User, FFTUnit; {$ELSEC } QuickDraw, OSIntf, ToolIntf, PrintTraps, Globals, Utilities, Initialization, File1, File2, Analysis, Graphics, Edit, Functions, Camera, User; {$ENDC } {$I-} {PROCEDURE MacsBug; inline $a9ff;} procedure InvertPalette; var TempRed, TempGreen, TempBlue: ColorArrayX; i, LastColor: integer; TempTable: MyCSpecArray; begin with info^ do begin if LutMode = PseudoColor32 then begin TempRed := RedX; TempGreen := GreenX; TempBlue := BlueX; LastColor := ncolors - 1; for i := 0 to LastColor do begin RedX[i] := TempRed[LastColor - i]; GreenX[i] := TempGreen[LastColor - i]; BlueX[i] := TempBlue[LastColor - i]; end; UpdateColors; end else begin TempTable := cTable; for i := 1 to 254 do cTable[i] := TempTable[255 - i]; LoadLUT(cTable); end; end; {with} end; procedure UpdateOptionsMenu; var CheckIt: boolean; i: integer; begin case info^.LUTMode of GrayScale, CustomGrayscale: CheckOnOffItem(OptionsMenuH, GrayscaleItem, GrayscaleItem, RainbowItem); PseudoColor32: CheckOnOffItem(OptionsMenuH, PseudoColorItem, GrayscaleItem, RainbowItem); AppleDefault: CheckOnOffItem(OptionsMenuH, AppleColorsItem, GrayscaleItem, RainbowItem); Spectrum: CheckOnOffItem(OptionsMenuH, RainbowItem, GrayscaleItem, RainbowItem); Custom: for i := GrayscaleItem to RainbowItem do CheckItem(OptionsMenuH, i, false); end; SetMenuItem(OptionsMenuH, ScaleToFitItem, info <> NoInfo); CheckIt := Info^.ScaleToFitWindow; CheckItem(OptionsMenuH, ScaleToFitItem, CheckIt); CheckItem(OptionsMenuH, ThresholdItem, Thresholding); SetMenuItem(OptionsMenuH, PropagateItem, info <> NoInfo); {$IFC Arlo } SetMenuItem(OptionsMenuH, InvertPaletteItem, not InFrequencyDomain); {$ENDC } end; procedure UpdateEnhanceMenu; var ShowItems: boolean; i: integer; begin ShowItems := Info <> NoInfo; for i := ApplyItem to EqualizeItem do SetMenuItem(EnhanceMenuH, i, ShowItems); {$IFC Arlo } ShowItems := ShowItems and not InFrequencyDomain; {$ENDC } SetMenuItem(EnhanceMenuH, BinaryItem, ShowItems); SetMenuItem(EnhanceMenuH, ArithmeticItem, ShowItems); SetMenuItem(EnhanceMenuH, ChangeItem, ShowItems); for i := SmoothItem to ConvolveItem do SetMenuItem(EnhanceMenuH, i, ShowItems); with info^ do if (LutMode = GrayScale) or (LutMode = CustomGrayscale) or Thresholding then SetItem(EnhanceMenuH, ApplyItem, 'Apply LUT') else SetItem(EnhanceMenuH, ApplyItem, 'Convert to Grayscale'); end; procedure UpdateVideoMenu; var ShowItems: boolean; i: integer; begin ShowItems := Info <> NoInfo; SetMenuItem(VideoMenuH, AnimateItem, ShowItems); SetMenuItem(VideoMenuH, PhotoModeItem, ShowItems); {$IFC Arlo } ShowItems := ShowItems and not InFrequencyDomain; SetMenuItem(VideoMenuH, StartItem, ShowItems); SetMenuItem(VideoMenuH, AverageItem, ShowItems); SetMenuItem(VideoMenuH, SetVideoItem, ShowItems); SetMenuItem(VideoMenuH, MakeMovieItem, ShowItems); {$ENDC } SetMenuItem(VideoMenuH, SaveBlankFieldItem, ShowItems); with info^ do SetMenuItem(VideoMenuH, SortItem, (LutMode = custom) or (LutMode = AppleDefault) or (LutMode = spectrum)); end; procedure SetNumberOfColors; var TempNColors: integer; begin TempNColors := GetInt('Number Of Colors(1..32):', info^.ncolors); if (TempNColors <= 32) and (TempNColors > 0) then begin info^.nColors := TempNColors; CheckColorWidth; UpdateColors; end else if TempNColors <> -MaxInt then beep; end; procedure SetNumberOfExtraColors; var TempNColors: integer; begin TempNColors := GetInt('Number Of ExtraColors(0..6):', nExtraColors); if (TempNColors <= 6) and (TempNColors >= 0) then begin nExtraColors := TempNColors; RedrawCLUTWindow; end else if TempNColors <> -MaxInt then beep; end; function AboutFilter (d: DialogPtr; var event: EventRecord; var ItemHit: integer): boolean; { simple filter proc for about box -- must be at top level! % } begin if (event.what in [MouseDown, KeyDown, AutoKey]) then begin AboutFilter := true; ItemHit := OK; end else begin AboutFilter := false; ItemHit := 0; end; end; procedure AboutUProc (d: DialogPtr; item: integer); { About box user proc -- must be at top level!} var s: str255; saveport: grafptr; VersInfo: str255; begin getport(saveport); setport(d); if (item = MemItem) then begin NumToString(FreeMem div 1024, s); s := concat(s, 'K free'); DrawSItem(MemItem, Geneva, 9, d, s); end else if (item = VersItem) then begin RealToString(version / 100.0, 4, 2, VersInfo); VersInfo := concat('Version ', VersInfo, 'b6'); { Arlo } DrawSItem(VersItem, Geneva, 9, d, VersInfo); end; setport(saveport); end; procedure DoAbout; {About Box by David Powell} var i: integer; d: dialogptr; midscreen: point; saveport: grafptr; r: rect; h: handle; itype: integer; begin getport(saveport); d := getnewdialog(AboutID, nil, pointer(-1)); if (d <> nil) then begin SetPort(d); GetDItem(d, VersItem, itype, h, r); SetDItem(d, VersItem, itype, @AboutUProc, r); GetDItem(d, MemItem, itype, h, r); SetDItem(d, MemItem, itype, @AboutUProc, r); ShowWindow(d); repeat ModalDialog(@aboutfilter, i); until (i = OK); DisposDialog(d); FlushEvents(EveryEvent, 0); end; setport(saveport); end; procedure DoPreferences; const WidthID = 4; HeightID = 6; FramesID = 8; InvertID = 9; BufferSizeID = 10; MaxScionWidthID = 14; WandAutoMeasureID = 16; WandAutoNumberID = 17; ScaleArithmeticID = 18; BlackID = 19; InvertYID = 20; var mylog: DialogPtr; item, i: integer; SaveInvert, SaveWandMeasure, SaveWandNumber, SaveScale: boolean; SaveUseBlack, SaveInvertY: boolean; SaveWidth, SaveHeight, SaveFrames, SaveMaxWidth: integer; SaveBufferSize: LongInt; begin InitCursor; SaveWidth := NewPicWidth; SaveHeight := NewPicHeight; SaveFrames := FramesToAverage; SaveInvert := InvertVideo; SaveBufferSize := BufferSize; SaveMaxWidth := MaxScionWidth; SaveWandMeasure := WandAutoMeasure; SaveWandNumber := WandAutoNumber; SaveScale := ScaleArithmetic; SaveInvertY := InvertYCoordinates; mylog := GetNewDialog(6000, nil, pointer(-1)); SetDNum(MyLog, WidthID, NewPicWidth); SetDNum(MyLog, HeightID, NewPicHeight); SetDNum(MyLog, FramesID, FramesToAverage); SetDNum(MyLog, BufferSizeID, BufferSize div 1024); SetDNum(MyLog, MaxScionWidthID, MaxScionWidth); SetDialogItem(mylog, WandAutoMeasureID, ord(WandAutoMeasure)); SetDialogItem(mylog, WandAutoNumberID, ord(WandAutoNumber)); SetDialogItem(mylog, InvertID, ord(InvertVideo)); SetDialogItem(mylog, ScaleArithmeticID, ord(ScaleArithmetic)); SetDialogItem(mylog, InvertYID, ord(InvertYCoordinates)); UseZeroForBlack := InvertingCalibrationFunction; SaveUseBlack := UseZeroForBlack; if UseZeroForBlack then SetDialogItem(mylog, BlackID, 1); OutlineButton(MyLog, ok, 16); repeat ModalDialog(nil, item); if item = WidthID then begin NewPicWidth := GetDNum(MyLog, WidthID); if (NewPicWidth < 0) or (NewPicWidth > 2048) then begin NewPicWidth := SaveWidth; SetDNum(MyLog, WidthID, NewPicWidth); end; end; if item = HeightID then begin NewPicHeight := GetDNum(MyLog, HeightID); if (NewPicHeight < 0) or (NewPicHeight > 2048) then begin NewPicHeight := SaveHeight; SetDNum(MyLog, HeightID, NewPicHeight); end; end; if item = FramesID then begin FramesToAverage := GetDNum(MyLog, FramesID); if (FramesToAverage < 0) or (FramesToAverage > 128) then begin FramesToAverage := SaveFrames; SetDNum(MyLog, FramesID, FramesToAverage); end; end; if item = InvertID then begin StopDigitizing; InvertVideo := not InvertVideo; SetDialogItem(mylog, InvertID, ord(InvertVideo)); end; if item = WandAutoMeasureID then begin WandAutoMeasure := not WandAutoMeasure; SetDialogItem(mylog, WandAutoMeasureID, ord(WandAutoMeasure)); end; if item = WandAutoNumberID then begin WandAutoNumber := not WandAutoNumber; SetDialogItem(mylog, WandAutoNumberID, ord(WandAutoNumber)); end; if item = BufferSizeID then begin BufferSize := GetDNum(MyLog, BufferSizeID) * 1024; if BufferSize < 1 then begin beep; BufferSize := 1; SetDNum(MyLog, BufferSizeID, BufferSize); end; end; if item = MaxScionWidthID then begin MaxScionWidth := BitAnd(GetDNum(MyLog, MaxScionWidthID), $fffc); if (MaxScionWidth < 0) or (MaxScionWidth > 640) then begin beep; MaxScionWidth := SaveMaxWidth; SetDNum(MyLog, MaxScionWidthID, MaxScionWidth); end; end; if item = ScaleArithmeticID then begin ScaleArithmetic := not ScaleArithmetic; SetDialogItem(mylog, ScaleArithmeticID, ord(ScaleArithmetic)); end; if item = BlackID then begin UseZeroForBlack := not UseZeroForBlack; SetDialogItem(mylog, BlackID, ord(UseZeroForBlack)); end; if item = InvertYID then begin InvertYCoordinates := not InvertYCoordinates; SetDialogItem(mylog, InvertYID, ord(InvertYCoordinates)); end; until (item = ok) or (item = cancel); DisposDialog(mylog); if NewPicWidth < 32 then NewPicWidth := 32; if odd(NewPicWidth) then NewPicWidth := NewPicWidth + 1; if NewPicHeight < 32 then NewPicHeight := 32; if FramesToAverage < 2 then FramesToAverage := 2; if item = cancel then begin NewPicWidth := SaveWidth; NewPicHeight := SaveHeight; FramesToAverage := SaveFrames; InvertVideo := SaveInvert; BufferSize := SaveBufferSize; MaxScionWidth := SaveMaxWidth; WandAutoMeasure := SaveWandMeasure; WandAutoNumber := SaveWandNumber; ScaleArithmetic := SaveScale; InvertYCoordinates := SaveInvertY; end else with info^ do begin if UseZeroForBlack and (SaveUseBlack = false) then InvertgrayLevels else if (UseZeroForBlack = false) and SaveUseBlack then begin calibrated := false; DrawLabels('', '', ''); end; end; if BufferSize <> SaveBufferSIze then PutMessage('You must "Record Preferences" and restart before the Undo and Clipboard buffer size change will take effect.'); end; procedure UpdateWindowsMenu; var i, kind: integer; fwptr: WindowPtr; begin for i := NextWindowItem to TileWindowsItem do SetMenuItem(WindowsMenuH, i, nPics > 1); for i := SelectToolsItem to SelectPlotItem do CheckItem(WindowsMenuH, i, false); SetMenuItem(WindowsMenuH, SelectHistogramItem, HistoWindow <> nil); SetMenuItem(WindowsMenuH, SelectPlotItem, PlotWindow <> nil); for i := 1 to nPics do CheckItem(WindowsMenuH, WindowsMenuItems + i, false); fwptr := FrontWindow; kind := WindowPeek(fwptr)^.WindowKind; if kind < 0 then exit(UpdateWindowsMenu); {System Window} case kind of ToolKind: CheckItem(WindowsMenuH, SelectToolsItem, true); GrayMapKind: CheckItem(WindowsMenuH, SelectGrayMapItem, true); LUTKind: CheckItem(WindowsMenuH, SelectLutItem, true); ResultsKind: CheckItem(WindowsMenuH, SelectResultsItem, true); HistoKind: CheckItem(WindowsMenuH, SelectHistogramItem, true); ProfilePlotKind, CalibrationPLotKind: CheckItem(WindowsMenuH, SelectPlotItem, true); {$IFC Arlo } PicKind, FFTKind: {$ELSEC } PicKind: {$ENDC } CheckItem(WindowsMenuH, WindowsMenuItems + info^.PicNum, true); otherwise end; end; procedure DoClose; var ignore: integer; fwptr: WindowPtr; kind: integer; rightKind: boolean; begin fwptr := FrontWindow; kind := WindowPeek(fwptr)^.WindowKind; rightKind := (kind = PicKind) or (kind = ProfilePlotKind) or (kind = CalibrationPlotKind) or (kind = HistoKind) or (Kind = PasteControlKind); {$IFC Arlo } rightKind := rightKind or (kind = FFTKind); {$ENDC } if rightKind then begin StopDigitizing; ignore := CloseAWindow(fwptr); end; end; procedure CloseAll; FORWARD; procedure DoMenuEvent (MenuChoice: LongInt); var MenuID, MenuItem, i, ignore: integer; name, str: str255; dna: integer; ItemName: str255; FontName: str255; ok, isSelection: boolean; NewStyle: StyleItem; t: FateTable; {Only needed for MakeSkeleton} begin MenuID := HiWord(MenuChoice); MenuItem := LoWord(MenuChoice); case MenuID of AppleMenu: begin if MenuItem = 1 then DoAbout else begin GetItem(GetMHandle(AppleMenu), MenuItem, name); ignore := OpenDeskAcc(name) end; end; FileMenu: begin StopDigitizing; isInsertionPoint := false; case MenuItem of NewItem: begin {$IFC Arlo } InFrequencyDomain := false; {$ENDC } if (LongInt(NewPicWidth) * NewPicHeight) <= UndoBufSize then ok := NewPicWindow('Untitled', NewPicWidth, NewPicHeight) else PutMessage('Sorry, but new windows can''t be larger than the Undo buffer.'); end; OpenItem: begin {$IFC Arlo } InFrequencyDomain := false; {$ENDC } DoOpen; end; ImportItem: ImportFile; CloseItem: if OptionKeyWasDown then CloseAll else DoClose; {-} SaveItem: if OptionKeyDown then SaveAll else DoSave; SaveAsItem: SaveAs; RecordPreferencesItem: SaveSettings; {-} RevertItem: RevertToSaved; DuplicateItem: ok := Duplicate(false); GetInfoItem: GetInfo; {-} SetHalftoneItem: SetHalftone; PageSetupItem: DoPageSetup; PrintItem: Print(true); {-} QuitItem: finished := true; end; end; EditMenu: begin GetItem(GetMHandle(EditMenu), MenuItem, ItemName); if not SystemEdit(MenuItem - 1) then case MenuItem of UndoItem: if info <> NoInfo then begin case WhatToUndo of UndoMeasurement: UndoLastMeasurement; UndoContrastEnhancement, UndoEqualization: begin ResetGrayMap; WhatToUndo := NothingToUndo; end; UndoZoom: begin DeZoom; if info^.magnification < 2 then WhatToUndo := NothingToUndo; end; UndoOutLine: begin undo; if WandAutoMeasure then UndoLastMeasurement; WhatToUndo := NothingToUndo; UpdatePicWindow; end; otherwise begin if UndoFromClip then OpPending := false; if not OpPending then undo; WhatToUndo := NothingToUndo; if IsInsertionPoint then begin InsertionPoint := TextStart; TextStr := ''; end; UpdatePicWindow; if OpPending and (CurrentOp = PasteOp) then begin OpPending := false; KillRoi; end; OpPending := false; end; end; {case} end; {-} CutItem: DoCut; CopyItem: DoCopy; PasteItem: begin StopDigitizing; DoPaste end; ClearItem: DoClear; {-} FillItem, InvertItem, DrawBoundaryItem: SetupOperation(MenuItem); {-} SelectAllItem: with info^ do if RoiShowing and EqualRect(osroiRect, PicRect) then KillRoi else begin StopDigitizing; SelectAll(true) end; ScaleSelectionItem: ScaleSelection; {-} RotateLeftItem: FlipOrRotate(RotateLeft); RotateRightItem: FlipOrRotate(RotateRight); FlipVerticalItem: FlipOrRotate(FlipVertical); FlipHorizontalItem: FlipOrRotate(FlipHorizontal); RotateAndScaleItem: RotateAndScale; {-} UnzoomItem: Unzoom; ShowClipboardItem: ShowClipboard; end; end; OptionsMenu: begin case MenuItem of InvertPaletteItem: InvertPalette; SetNumberItem: SetNumberOfColors; SetExtraColorsItem: SetNumberOfExtraColors; {-} GrayscaleItem: ResetGrayMap; PseudoColorItem: UpdateColors; AppleColorsItem: ok := LoadCLUTResource(AppleDefaultCLUT); RainbowItem: Load256ColorCLUT; {-} PreferencesItem: DoPreferences; PlotOptionsItem: DoProfilePlotOptions; ScaleToFitItem: ScaleToFit; ThresholdItem: if Thresholding then StopThresholding else begin if info^.deltax <= 1 then {Turn of Gray Map thresholding} ResetGrayMap; StartThresholding; end; ShowPasteControlItem: if PasteControl = nil then ShowPasteControl else BringToFront(PasteControl); PropagateItem: PropagateLUT; end; end; EnhanceMenu: begin SetupUndo; case MenuItem of SmoothItem: if OptionKeyDown then Filter(UnweightedAvg, 0, t) else Filter(WeightedAvg, 0, t); SharpenItem: Filter(fsharpen, 0, t); EdgeDetectItem: Filter(EdgeDetect, 0, t); ReduceNoiseItem: Filter(ReduceNoise, 0, t); DitherItem: Filter(Dither, 0, t); ConvolveItem: Convolve; {-} ApplyItem: ApplyLookupTable; EnhanceItem: EnhanceContrast; EqualizeItem: EqualizeHistogram; ChangeItem: ChangeValues; end; end; BinaryMenu: case MenuItem of MakeBinaryItem: MakeBinary; ErosionItem: DoErosion; DilationItem: DoDilation; OpeningItem: DoOpening; ClosingItem: DoClosing; IterationsItem: SetIterations; OutlineItem: filter(OutlineFilter, 0, t); SkeletonizeItem: MakeSkeleton; end; ArithmeticMenu: DoArithmetic(MenuItem); AnalyzeMenu: begin SetupUndo; case MenuItem of MeasureItem: Measure; AnalyzeItem: AnalyzeParticles; ShowItem: ListResults; OptionsItem: DoMeasurementOptions; HistogramItem: DoHistogram; PlotItem: ColumnAveragePlot; Plot3DItem: Do3DPlot; {-} SetScaleItem: SetScale; CalibrateItem: Calibrate; RedoItem: RedoMeasurement; DeleteItem: DeleteMeasurement; ResetItem: ResetCounters; RestoreItem: begin StopDigitizing; RestoreRoi; end; MarkItem: MarkSelection(nRegions, ForegroundIndex); end; end; {$IFC Arlo } FFTMenu: case MenuItem of FFTItem: DoFFT; InverseFFTItem: DoInverseFFT; FFTSettingsItem: ConfigureFFT; DyadicOpsItem: DoDyadicOp; FilterItem, PassItem: ok := DoPassOrFilter(info^.osRoiRgn, MenuItem = FilterItem); ThresholdZeroItem: ok := ThresholdZero; MaskItem: ok := Vignette; MaskNfilterSettingsItem: ConfigureMaskNfilter; UpdatePSItem: UpdatePowerSpectrum; BlockSwapItem: DoBlockSwap; otherwise end; AutoMenu: begin with FFTConfig do case MenuItem of AutoFilterItem: begin autoFilter := not autoFilter; autoPass := false; end; AutoPassItem: begin autoPass := not autoPass; autoFilter := false; end; AutoThreshZeroItem: autoThreshold := not autoThreshold; AutoMaskItem: autoMask := not autoMask; end; UpdateAutoMenu; end; {$ENDC } VideoMenu: begin case MenuItem of StartItem: StartDigitizing; AverageItem: AverageFrames; SaveBlankFieldItem: SaveBlankField; SetVideoItem: SetVideoChannel; {-} MakeMovieItem: MakeMovie; AnimateItem: Animate; {-} PhotoModeItem: PhotoMode; end; end; SortPaletteMenu: SortPalette(MenuItem); TextMenu: begin case MenuItem of LeftItem: TextJust := teJustLeft; CenterItem: TextJust := teJustCenter; RightItem: TextJust := teJustRight; NoBackgroundItem: TextBack := NoBack; WithBackgroundItem: TextBack := WithBack; end; DisplayText; if IsInsertionPoint then UpdatePicWindow; UpdateTextMenu; end; FontMenu: begin GetItem(FontMenuH, MenuItem, FontName); GetFNum(FontName, CurrentFontID); UpdateTextMenu; DisplayText; end; SizeMenu: begin case MenuItem of 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11: CurrentSize := GetFontSize(MenuItem); end; DisplayText; if IsInsertionPoint then UpdatePicWindow; UpdateTextMenu; end; StyleMenu: begin case MenuItem of 1: CurrentStyle := []; 2, 3, 4, 5, 6: begin case MenuItem of TxBold: NewStyle := Bold; TxItalic: NewStyle := Italic; TxUnderLine: NewStyle := Underline; TxOutLine: NewStyle := Outline; TxShadow: NewStyle := Shadow; end; if NewStyle in CurrentStyle then CurrentStyle := CurrentStyle - [NewStyle] else CurrentStyle := CurrentStyle + [NewStyle]; end; {7:--} 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18: CurrentSize := GetFontSize(MenuItem); end; {case} DisplayText; if IsInsertionPoint then UpdatePicWindow; UpdateTextMenu; end; WindowsMenu: begin case MenuItem of NextWindowItem: ShowNextWindow; StackWindowsItem: StackWindows; TileWindowsItem: TileWindows; {-} SelectToolsItem: SelectWindow(ToolWindow); SelectGrayMapItem: SelectWindow(GrayMapWindow); SelectLutItem: SelectWindow(LUTWindow); SelectResultsItem: SelectWindow(ResultsWindow); SelectHistogramItem: if HistoWindow <> nil then SelectWindow(HistoWindow); SelectPlotItem: if PlotWindow <> nil then SelectWindow(PlotWindow); {-} otherwise SelectWindow(PicWindow[MenuItem - WindowsMenuItems]); end; end; UserMenu: DoUserMenuEvent(MenuItem); otherwise end; HiliteMenu(0); RoiUpdateTime := 0; end; procedure DoFreehand (var nVertices: integer; ff: integer; var x, y: xyArray); var finish: point; event: EventRecord; wright, wbottom: integer; begin PenPat(pat[PatIndex]); with info^.wptr^.PortRect do begin wright := right; wbottom := bottom; end; repeat GetMouse(finish); with finish do begin if h < 0 then h := 0; if v < 0 then v := 0; if h > wright then h := wright; if v > wbottom then v := wbottom; end; if nvertices < MaxPolyVertices then nvertices := nvertices + 1 else beep; with finish do begin LineTo(h - ff, v - ff); x[nvertices] := h; y[nvertices] := v; end; until WaitNextEvent(mUpMask, Event, 4, nil); repeat until not WaitNextEvent(EveryEvent, Event, 0, nil); {FlushEvent doesn't work under A/UX!} end; procedure DoPolygon (var nVertices: integer; ff: integer; var x, y: xyArray); var start, Finish, OldFinish: point; finished, DoubleClick: boolean; ticks, MouseUpTime, LastMouseUpTime: LongInt; wright, wbottom: integer; StartRect: rect; Event: EventRecord; begin DrawLabels('DX:', 'DY:', 'Length:'); PenMode(PatXor); with Start do begin h := x[1]; v := y[1]; end; if CurrentTool = PolygonTool then begin Pt2Rect(Start, Start, StartRect); InsetRect(StartRect, -4 * (ff + 1), -4 * (ff + 1)); FrameRect(StartRect); end else SetRect(StartRect, 0, 0, 0, 0); finish := start; finished := false; with info^.wptr^.PortRect do begin wright := right; wbottom := bottom; end; MouseUpTime := 0; repeat Show3RealValues(0, 0, 0.0); repeat OldFinish := finish; GetMouse(finish); with finish do begin if h < 0 then h := 0; if v < 0 then v := 0; if h > wright then h := wright; if v > wbottom then v := wbottom; end; if not EqualPt(finish, OldFinish) then begin ticks := TickCount; repeat until TickCount <> ticks; MoveTo(start.h - ff, start.v - ff); LineTo(OldFinish.h - ff, OldFinish.v - ff); MoveTo(start.h - ff, start.v - ff); LineTo(finish.h - ff, finish.v - ff); Show3RealValues(abs(finish.h - start.h), abs(finish.v - start.v), sqrt(sqr(LongInt(finish.h - start.h)) + sqr(LongInt(finish.v - start.v)))); end; until WaitNextEvent(mUpMask, Event, 0, nil); LastMouseUpTime := MouseUpTime; MouseUpTime := TickCount; DoubleClick := ((MouseUpTime - LastMouseUpTime) < GetDblTime) and EqualPt(start, finish); if nvertices < MaxPolyVertices then nvertices := nvertices + 1 else beep; x[nvertices] := finish.h; y[nvertices] := finish.v; start := finish; Finished := (PtInRect(finish, StartRect) or DoubleClick) and (nvertices > 2); until finished; repeat until not WaitNextEvent(EveryEvent, Event, 0, nil); {FlushEvent doesn't work under A/UX!} end; procedure MakePolygon (event: EventRecord); var Start, pt, spt: point; nvertices, i, ff, imag: integer; x, y: xyArray; TempRgn: RgnHandle; begin if SelectionMode <> NewSelection then TempRgn := NewRgn; start := event.where; with Info^ do begin imag := trunc(magnification + 0.5); ff := imag div 2; if ff < 0 then ff := 0; PenNormal; PenSize(imag, imag); x[1] := Start.h; y[1] := Start.v; nvertices := 1; end; MoveTo(start.h, start.v); if CurrentTool = FreehandTool then begin DoFreehand(nVertices, ff, x, y); with Start do LineTo(h - ff, v - ff); end else DoPolygon(nVertices, ff, x, y); if nvertices > 2 then with Info^ do begin PenNormal; OpenRgn; spt.h := x[1]; spt.v := y[1]; ScreenToOffscreen(spt); MoveTo(spt.h, spt.v); for i := 2 to nvertices do begin pt.h := x[i]; pt.v := y[i]; ScreenToOffscreen(pt); LineTo(pt.h, pt.v); end; LineTo(spt.h, spt.v); case SelectionMode of NewSelection: CloseRgn(osroiRgn); AddSelection: begin CloseRgn(TempRgn); if RgnNotTooBig(osroiRgn, TempRgn) then UnionRgn(osroiRgn, TempRgn, osroiRgn); end; SubSelection: begin CloseRgn(TempRgn); if RgnNotTooBig(osroiRgn, TempRgn) then DiffRgn(osroiRgn, TempRgn, osroiRgn); end; end; RoiShowing := true; roiType := RgnRoi; osroiRect := osroiRgn^^.rgnBBox; roiRect := osroiRect; OffscreenToScreenRect(roiRect); UpdatePicWindow; if PerimeterM in measurements then ComputeLength(nvertices, x, y, true) else results.Length := 0.0; end else with info^ do begin RoiShowing := false; RoiType := NoRoi; UpdatePicWindow; end; if SelectionMode <> NewSelection then DisposeRgn(TempRgn); WhatToUndo := NothingToUndo; measuring := false; end; procedure FindCurveLength (event: EventRecord); var Start, p: point; nvertices, ff, i, imag: integer; x, y: xyArray; tPort: GrafPtr; begin start := event.where; x[1] := start.h; y[1] := start.v; nvertices := 1; PenNormal; with info^ do begin imag := trunc(magnification + 0.5); PenSize(imag, imag); ff := imag div 2 end; if ff < 0 then ff := 0; MoveTo(start.h, start.v); if ControlKeyDown then DoFreehand(nVertices, ff, x, y) else DoPolygon(nVertices, ff, x, y); GetPort(tPort); SetPort(GrafPtr(info^.osPort)); PenNormal; PenSize(LineWidth, LineWidth); p.h := x[1]; p.v := y[1]; ScreenToOffscreen(p); MoveTo(p.h, p.v); for i := 2 to nvertices do begin p.h := x[i] - ff; p.v := y[i] - ff; ScreenToOffscreen(p); LineTo(p.h, p.v); end; SetPort(tPort); UpdatePicWindow; ComputeLength(nvertices, x, y, false); if nLengths < MaxLengths then begin nLengths := nLengths + 1; UnsavedLengths := UnsavedLengths + 1 end else beep; with results do begin PixelLength := length; lengths[nLengths] := length; end; ResultsMessage := ''; ShowResults; measuring := true; end; procedure DoMouseDownInWindow (event: EventRecord; WhichWindow: WindowPtr); var r: rect; str: str255; hloc, vloc: integer; tool: ToolType; rightKind: boolean; begin rightKind := (WindowPeek(WhichWindow)^.WindowKind = PicKind); {$IFC Arlo } rightKind := rightKind or (WindowPeek(WhichWindow)^.WindowKind = FFTKind); {$ENDC } if not rightKind then exit(DoMouseDownInWindow); if digitizing and isSelectionTool then PasteMode := LiveSelection; if Digitizing then if (CurrentTool <> MagnifyingGlass) and (CurrentTool <> Grabber) then StopDigitizing; GlobalToLocal(event.where); IsInsertionPoint := false; with info^ do if RoiShowing then if EqualRect(osroiRect, PicRect) and (SelectionMode = NewSelection) then {if Select All} if not (OpPending and (CurrentOp = PasteOp)) then begin KillRoi; MouseState := NotInRoi; exit(DoMouseDownInWindow); end; if MouseState <> NotInRoi then exit(DoMouseDownInWindow); WhatToUndo := UndoEdit; if (SelectionMode = NewSelection) and not ((CurrentTool = MagnifyingGlass) or (CurrentTool = Grabber)) then KillRoi; SetupUndo; if SpaceBarDown and (CurrentTool <> TextTool) then tool := grabber else tool := CurrentTool; {$IFC Arlo } if InfrequencyDomain then case tool of SelectionTool: DoFreqObject(SelectionRect, event); OvalSelectionTool: DoFreqObject(SelectionOval, event); RoundedRectTool: DoFreqObject(RoundedRect, event); MagnifyingGlass: Zoom(event); Grabber: Scroll(event); {¥ PolygonTool, FreehandTool: { implement this !!!! ¥]} {¥ MakePolygon(event);¥} PlotTool: DoObject(PlotLine, event); PickerTool: if BitAnd(Event.modifiers, OptionKey) = OptionKey then GetBackgroundColor(event) else GetForegroundColor(event); Wand: begin if Digitizing then StopDigitizing; AutoOutline(event.where); end; otherwise PutMessage('Sorry, that tool''s function is not implemented in the Frequency Domain.'); end else case tool of SelectionTool: DoObject(SelectionRect, event); OvalSelectionTool: DoObject(SelectionOval, event); RoundedRectTool: DoObject(RoundedRect, event); MagnifyingGlass: Zoom(event); Grabber: Scroll(event); Pencil, Brush, Eraser: DoBrush(event); AirBrushTool: DoAirBrush; ruler: if OptionKeyDown then FindCurveLength(event) else DoObject(LengthObj, event); PaintBucket: DoFill(event); PolygonTool, FreehandTool: MakePolygon(event); TextTool: DoText(event.where); PlotTool: DoObject(PlotLine, event); PickerTool: if BitAnd(Event.modifiers, OptionKey) = OptionKey then GetBackgroundColor(event) else GetForegroundColor(event); PointingTool: DoPoints(event); AngleTool: FindAngle(event); Wand: begin if Digitizing then StopDigitizing; AutoOutline(event.where); end; otherwise beep; end; {$ELSEC } case tool of SelectionTool: DoObject(SelectionRect, event); OvalSelectionTool: DoObject(SelectionOval, event); RoundedRectTool: DoObject(RoundedRect, event); MagnifyingGlass: Zoom(event); Grabber: Scroll(event); Pencil, Brush, Eraser: DoBrush(event); AirBrushTool: DoAirBrush; ruler: if OptionKeyDown then FindCurveLength(event) else DoObject(LengthObj, event); PaintBucket: DoFill(event); PolygonTool, FreehandTool: MakePolygon(event); TextTool: DoText(event.where); PlotTool: DoObject(PlotLine, event); PickerTool: if BitAnd(Event.modifiers, OptionKey) = OptionKey then GetBackgroundColor(event) else GetForegroundColor(event); PointingTool: DoPoints(event); AngleTool: FindAngle(event); Wand: begin if Digitizing then StopDigitizing; AutoOutline(event.where); end; otherwise beep; end; {$ENDC } end; procedure DoMouseDownInTools (loc: point); var r: rect; tPort: GrafPtr; OddTool, DoubleClick, ok: boolean; ToolNum, i: integer; begin GetPort(tPort); SetPort(ToolWindow); GlobalToLocal(loc); if loc.v <= StartOfLines then begin PreviousTool := CurrentTool; OddTool := loc.h < tmiddle; ToolNum := (loc.v div tmiddle) * 2; if not OddTool then ToolNum := ToolNum + 1; CurrentTool := ToolType(ToolNum); isSelectionTool := (CurrentTool = SelectionTool) or (CurrentTool = OvalSelectionTool) or (CurrentTool = PolygonTool) or (CurrentTool = FreehandTool) or (CurrentTool = RoundedRectTool); DoubleClick := (TickCount - ToolTime) < GetDblTime; ToolTime := TickCount; InvalRect(ToolRect[CurrentTool]); InvalRect(ToolRect[PreviousTool]); IsInsertionPoint := false; if DoubleClick and (CurrentTool = PreviousTool) then case CurrentTool of MagnifyingGlass: Unzoom; SelectionTool: begin StopDigitizing; {$IFC Arlo } if CommandKeyDown then SelectMaxFFT(true) else SelectAll(true); {$ELSEC } SelectAll(true); {$ENDC } end; AirbrushTool: SetAirbrushSize; Brush: SetBrushSize; ruler: SetScale; PolygonTool: DoMeasurementOptions; FreehandTool: Calibrate; PlotTool: DoProfilePlotOptions; eraser: begin ok := info <> NoInfo; {$IFC Arlo } ok := ok and not InFrequencyDomain; {$ENDC } if ok then begin KillRoi; WhatToUndo := UndoClear; SetupUndo; StopDigitizing; SelectAll(false); DoOperation(eraseOp); end; end; LutTool, Wand: if Thresholding then StopThresholding else begin if info^.deltax <= 1 then {Turn of Gray Map thresholding} ResetGrayMap; StartThresholding; end; PickerTool: if info^.LutMode <> PseudoColor32 then begin {Switch to pseudocolor mode} StopThresholding; UpdateColors; CurrentTool := LutTool; isSelectionTool := false; InvalRect(ToolRect[CurrentTool]); end else ResetGrayMap; otherwise end; {case} if (not isSelectionTool) and (CurrentTool <> MagnifyingGlass) and (CurrentTool <> Grabber) then KillRoi; with info^ do if RoiShowing then if EqualRect(osroiRect, PicRect) and not isSelectionTool then {if Select All} KillRoi; if (CurrentTool = SelectionTool) or (CurrentTool = ruler) or (CurrentTool = PointingTool) then begin ResultsMessage := ''; if GetResultsType <> NoResults then ShowResults; end; StretchMode := false; end else begin for i := 1 to nLineTypes do begin r := lines[i]; with r do begin left := left - 13; top := top - 2; right := right + 2; bottom := bottom + 2; end; if i = 1 then with r do top := top - 7; if PtInRect(loc, r) then begin with lines[i] do LineWidth := bottom - top; LineIndex := i; end; end; EraseRect(CheckRect); InvalRect(CheckRect); end; SetPort(tPort); end; procedure RotateColors; var tPort: GrafPtr; vstart, i, j, delta: integer; loc: point; TempTable: MyCSpecArray; begin with info^ do begin getPort(tPort); SetPort(LUTWindow); GetMouse(loc); vstart := loc.v; repeat GetMouse(loc); delta := vstart - loc.v; for i := 1 to 254 do begin {0 is resevred for white and 255 for black} j := i + delta; if j > 254 then j := j - 254; if j > 254 then j := 254; if j < 1 then j := j + 254; if j < 1 then j := 1; TempTable[i] := cTable[j] end; cTable := TempTable; LoadLUT(cTable); vstart := loc.v; until not button; SetPort(tPort); end; end; procedure ShowThresholdValues (tStart, tEnd: integer); var tPort: GrafPtr; begin with info^ do begin GetPort(tPort); SetPort(ResultsWindow); TextSize(9); TextFont(Monaco); TextMode(SrcCopy); MoveTo(xValueLoc, ValuesVStart); if Calibrated then begin DrawReal(value[tStart], 5, 2); DrawString(' ('); DrawReal(tStart, 3, 0); DrawString(')'); end else DrawReal(tStart, 3, 0); DrawString(' '); MoveTo(xValueLoc, ValuesVStart + 10); if Calibrated then begin DrawReal(value[tEnd], 5, 2); DrawString(' ('); DrawReal(tEnd, 3, 0); DrawString(')'); end else DrawReal(tEnd, 3, 0); DrawString(' '); SetPort(tPort); end; end; procedure UpdateThreshold; var tPort: GrafPtr; vloc, ThresholdWidth, SaveVLoc, delta: integer; UpdateStart: boolean; cvalue: extended; procedure GetVLoc; var loc: point; begin GetMouse(loc); vloc := loc.v; if vloc > 255 then vloc := 255; if vloc <= 0 then vloc := 0; end; begin if (CurrentTool = LutTool) or (CurrentTool = Wand) then begin DrawLabels('Lower:', 'Upper:', ''); GetPort(tPort); SetPort(LUTWindow); GetVLoc; savevloc := vloc; ThresholdWidth := ThresholdEnd - ThresholdStart + 1; UpdateStart := vloc <= (ThresholdStart + ThresholdWidth div 3); if vloc > ThresholdEnd then ThresholdEnd := vloc; while button do begin ThresholdWidth := ThresholdEnd - ThresholdStart + 1; GetVloc; delta := vloc - SaveVLoc; SaveVLoc := vloc; if UpdateStart then begin ThresholdStart := vloc; if ThresholdStart < 0 then ThresholdStart := 0 end else begin ThresholdEnd := ThresholdEnd + delta; if ThresholdEnd > 255 then ThresholdEnd := 255; ThresholdStart := ThresholdEnd - ThresholdWidth + 1; if ThresholdStart < 0 then ThresholdStart := 0; end; if ThresholdStart > ThresholdEnd then ThresholdStart := ThresholdEnd; DrawThreshold(OptionKeyDown); if UpdateStart then vloc := ThresholdStart else vloc := ThresholdEnd; if info^.calibrated then cvalue := value[vloc] else cvalue := noValue; ShowThresholdValues(ThresholdStart, ThresholdEnd) end; SetPort(tPort); DrawThreshold(false) end else if CurrentTool = PickerTool then EditThresholdColor; end; function GetColorFromPalette (DoubleClick: boolean): integer; var tPort: GrafPtr; mloc, color, i: integer; loc: point; begin getPort(tPort); SetPort(LUTWindow); GetMouse(loc); if loc.v > 255 then begin color := 0; for i := 1 to nExtraColors + 2 do if PtInRect(loc, ExtraColorsRect[i]) then Color := ExtraColorsEntry[i]; if DoubleClick then EditExtraColors(color); GetColorFromPalette := color; end else GetColorFromPalette := loc.v; SetPort(tPort); end; procedure DoMouseDownInLUT (event: EventRecord); var tPort: GrafPtr; loc: point; MidPoint, mloc, i, color: integer; DoubleClick: boolean; begin with info^ do begin if CurrentTool = PickerTool then DoubleClick := (TickCount - LutTime) < GetDblTime else DoubleClick := false; LutTime := TickCount; if (CurrentTool <> LutTool) and (CurrentTool <> Wand) then begin color := GetColorFromPalette(DoubleClick); if (CurrentTool = eraser) or OptionKeyDown then SetBackgroundColor(color) else SetForegroundColor(color); if not DoubleClick then exit(DoMouseDownInLUT); end; if Thresholding then begin UpdateThreshold; exit(DoMouseDownInLUT) end; if nColors = 0 then exit(DoMouseDownInLUT); if (LUTMode <> PseudoColor32) and not DoubleClick then begin if DeltaX <> 0 then RotateColors; exit(DoMouseDownInLUT) end; if (CurrentTool = PickerTool) and DoubleClick then begin if LUTMode <> PseudoColor32 then exit(DoMouseDownInLUT); EditColor; exit(DoMouseDownInLUT) end; GetPort(tPort); SetPort(LUTWindow); repeat GetMouse(loc); if loc.v <= 255 then begin mloc := 255 - loc.v; MidPoint := ColorStart + (nColors * ColorWidth) div 2; if mloc < MidPoint then begin ColorStart := mloc; if ColorStart < 0 then ColorStart := 0 end else begin ColorWidth := (mloc - ColorStart) div ncolors; if ColorWidth < 1 then ColorWidth := 1; end; UpdateColors; end; until not Button; SetPort(tPort); end; {with} end; procedure ScaleToFitScreen; var trect: rect; ignore: boolean; begin with info^ do begin MoveWindow(wptr, PicLeftBase, PicTopBase, true); SetRect(trect, 0, 0, ScreenWidth, ScreenHeight); ScaleImageWindow(trect); wrect := trect; SizeWindow(wptr, trect.right, trect.bottom, true); end; end; procedure DoDrag (WhichWindow: WindowPtr; loc: point); var WinRect, DragBounds, trect: rect; kind: integer; rightKind: boolean; begin kind := WindowPeek(WhichWindow)^.WindowKind; rightKind := (kind = PicKind); {$IFC Arlo } rightKind := rightKind or (kind = FFTKind); {$ENDC } if rightKind then begin if info^.PictureType = ScionType then exit(DoDrag); with info^ do begin {Save window location} GetWindowRect(wptr, trect); savehloc := trect.left; savevloc := trect.top; end; PicLeft := PicLeftBase; PicTop := PicTopBase; end; DragBounds := ScreenBits.bounds; DragWindow(WhichWindow, loc, DragBounds); if WhichWindow = ResultsWindow then ShowResults; end; procedure UpdateMenus; begin OptionKeyWasDown := OptionKeyDown; UpdateFileMenu; UpdateEditMenu; UpdateOptionsMenu; UpdateEnhanceMenu; UpdateAnalysisMenu; UpdateVideoMenu; UpdateWindowsMenu; {$IFC Arlo } UpdateFFTMenu; UpdateAutoMenu; {$ENDC } end; procedure DoMouseDown (event: EventRecord); var WhichWindow: WindowPtr; ThePart, ignore: integer; trect: rect; rightKind: boolean; begin ThePart := FindWindow(event.where, WhichWindow); case ThePart of InDesk: ; InMenuBar: begin UpdateMenus; DoMenuEvent(MenuSelect(event.where)); end; InSysWindow: SystemClick(Event, WhichWindow); InContent: begin RoiUpdateTime := 0; if WhichWindow = ToolWindow then begin DoMouseDownInTools(event.where); exit(DoMouseDown); end; if WhichWindow = GrayMapWindow then begin DoMouseDownInGrayMap; exit(DoMouseDown) end; if WhichWindow = LUTWindow then begin DoMouseDownInLUT(event); exit(DoMouseDown) end; if WhichWindow = PasteControl then begin DoMouseDownInPasteControl(event.where); exit(DoMouseDown) end; if WhichWindow <> FrontWindow then SelectWindow(WhichWindow) else DoMouseDownInWindow(Event, WhichWindow); end; InDrag: DoDrag(WhichWindow, event.where); InGrow: DoGrow(WhichWindow, event); InGoAway: begin rightKind := (WindowPeek(WhichWindow)^.WindowKind = PicKind); {$IFC Arlo } rightKind := rightKind or (WindowPeek(WhichWindow)^.WindowKind = FFTKind); {$ENDC } if TrackGoAway(WhichWindow, event.where) then if OptionKeyDown and rightKind then CloseAll else begin StopDigitizing; ignore := CloseAWindow(WhichWindow); end; end; InZoomIn, InZoomOut: with info^ do case WindowState of NormalWindow: begin if digitizing then exit(DoMouseDown); ScaleToFit; if ScaleToFitWindow then ScaleToFitScreen; end; TiledSmall, TiledSmallScaled: begin if WindowState = TiledSmall then begin ScaleToFitWindow := true; WindowState := TiledBig; end else WindowState := TiledBigScaled; savewrect := wrect; SaveSrcRect := SrcRect; SaveMagnification := magnification; GetWindowRect(wptr, trect); savehloc := trect.left; savevloc := trect.top; ScaleToFitScreen; UpdatePicWindow; end; TiledBig: begin ScaleToFitWindow := false; WindowState := TiledSmall; wrect := savewrect; SrcRect := SaveSrcRect; magnification := SaveMagnification; HideWindow(wptr); SizeWindow(wptr, wrect.right, wrect.bottom, true); MoveWindow(wptr, savehloc, savevloc, true); ShowWindow(wptr); UpdatePicWindow; magnification := 1.0; ShowMagnification; end; TiledBigScaled: begin WindowState := TiledSmallScaled; wrect := savewrect; SrcRect := PicRect; HideWindow(wptr); SizeWindow(wptr, wrect.right, wrect.bottom, true); MoveWindow(wptr, savehloc, savevloc, true); ShowWindow(wptr); UpdatePicWindow; if PicRect.right <> 0 then magnification := wrect.right / PicRect.right; ShowMagnification; end; end; {case WindowState} end; {case thePart} end; procedure NudgeRoi (key: integer); var dh, dv: integer; begin with info^ do begin if not RoiShowing then exit(NudgeRoi); case key of LeftArrow: begin dh := -1; dv := 0 end; RightArrow: begin dh := 1; dv := 0 end; UpArrow: begin dh := 0; dv := -1 end; DownArrow: begin dh := 0; dv := 1 end; end; if OptionKeyDown then begin if RoiType = RectRoi then with osroiRect do begin right := right + dh; if right < left + 2 then right := left + 2; bottom := bottom + dv; if bottom < top + 2 then bottom := top + 2; MakeRegion; end else beep; end else begin OffsetRgn(osroiRgn, dh, dv); osroiRect := osroiRgn^^.rgnBBox; end; roiRect := osroiRect; OffscreenToScreenRect(roiRect); RoiNudged := true; RoiUpdateTime := 0; end; end; procedure DoKeyDown (event: EventRecord); var Ch: char; ich, KeyCode: integer; begin Ch := chr(band(Event.message, CharCodeMask)); ich := ord(ch); if BitAnd(Event.modifiers, CmdKey) = CmdKey then begin UpdateMenus; if OptionKeyWasDown then begin KeyCode := bsr(band(Event.message, KeyCodeMask), 8); case KeyCode of 1: ch := 'S'; 5: ch := 'G'; 8: ch := 'C'; 13: ch := 'W'; 17: ch := 'T'; {¥ 35: { Arlo: this interferes with the option P power spectrum menu key ¥]} {¥ ch := 'P';¥} end; end; DoMenuEvent(MenuKey(Ch)); exit(DoKeyDown) end; if CurrentTool = TextTool then DrawCharacter(ch) else if (ich >= LeftArrow) and (ich <= DownArrow) then NudgeRoi(ich) else begin {$IFC Arlo } if (ch = BackSpace) and not InFrequencyDomain then DoClear; {$ELSEC } if (ch = BackSpace) then DoClear; {$ENDC } end; end; procedure ActivateWindow; begin with info^ do begin SetPort(info^.wptr); IsInsertionPoint := false; WhatToUndo := NothingToUndo; UndoFromClip := false; DrawLabels('', '', ''); MouseState := NotInRoi; RoiUpdateTime := 0; end; end; procedure DoActivate (event: EventRecord); var WhichWindow: WindowPtr; rightKind, Activating, SwitchingWindows, isOK: boolean; I, kind: integer; NewInfo: InfoPtr; begin WhichWindow := WindowPtr(event.message); kind := WindowPeek(WhichWindow)^.WindowKind; rightKind := (kind = PicKind); {$IFC Arlo } rightKind := rightKind or (kind = FFTKind); {$ENDC } Activating := odd(event.modifiers); if rightKind then begin if Activating then begin NewInfo := pointer(WindowPeek(WhichWindow)^.RefCon); SwitchingWindows := NewInfo <> Info; if SwitchingWindows then begin StopDigitizing; SaveRoi; StopThresholding; {$IFC Arlo } InFrequencyDomain := (kind = FFTKind); {$ENDC } end; Info := NewInfo; if SwitchingWindows then ActivateWindow else SetPort(info^.wptr); with info^ do begin if (LutMode = GrayScale) or (LutMode = CustomGrayscale) then DrawGrayMap; if not UndoFromClip then ShowRoi; LoadLUT(cTable); GenerateValues; if not calibrated then DrawLabels('', '', ''); end; {with} end else KillOperation; {Deactivate} end; if not activating then begin WhichWindow := FrontWindow; kind := WindowPeek(WhichWindow)^.WindowKind; if kind < 0 then ConvertClipboard; {DA has become active} end; end; procedure DoUpdate (event: EventRecord); var WhichWindow: WindowPtr; SaveInfo: InfoPtr; kind: integer; begin WhichWindow := WindowPtr(event.message); kind := WindowPeek(WhichWindow)^.WindowKind; BeginUpdate(WhichWindow); case kind of {$IFC Arlo } Pickind, FFTKind: {$ELSEC } Pickind: {$ENDC } begin SaveInfo := info; Info := pointer(WindowPeek(WhichWindow)^.RefCon); if info <> NoInfo then begin UpdatePicWindow; DrawMyGrowIcon(info^.wptr); end else beep; info := SaveInfo; end; ToolKind: DrawTools; GrayMapKind: DrawGrayMap; LUTKind: DrawLUT; ResultsKind: begin DrawLabels('', '', ''); if (GetResultsType <> NoResults) or (ResultsMessage <> '') then ShowResults; end; HistoKind: DrawHistogram; ProfilePlotKind, CalibrationPlotKind: DrawPlot; PasteControlKind: DrawPasteControl; end; EndUpdate(WhichWindow); end; procedure DoDiskInsert (event: EventRecord); { Process disk insertion event, check for damaged or uninitialized disks. } var p: point; intjunk: integer; begin if (HiWord(event.message) <> NoErr) then begin DiLoad; SetPt(p, 100, 80); intjunk := DiBadMount(p, event.message); DiUnload; end; end; function HandleEvents: boolean; const mousemovedmessage = $FA; SuspendResumeMessage = 1; ResumeMask = 1; var Event: EventRecord; result: boolean; theDialog: DialogPtr; ItemHit: integer; begin if WaitNextEvent(EveryEvent, Event, 2, nil) then begin case Event.what of KeyDown, AutoKey: DoKeyDown(Event); MouseDown: DoMouseDown(Event); ActivateEvt: DoActivate(Event); DiskEvt: DoDiskInsert(Event); UpdateEvt: DoUpdate(Event); app4Evt: case BSR(event.message, 24) of MouseMovedMessage: ; SuspendResumeMessage: if BAND(event.message, ResumeMask) <> 0 then {Resume event} LoadLUT(info^.ctable) else begin {Suspend event} KillOperation; ConvertClipboard; end; end; otherwise {Do nothing} end; HandleEvents := true end else HandleEvents := false; end; procedure ShowInsertionPoint; var tRect: rect; Loc: point; height, imag: integer; begin if not isInsertionPoint then exit(ShowInsertionPoint); if (TickCount mod (BlinkTime * 2)) < BlinkTime then exit(ShowInsertionPoint); if info = NoInfo then exit(ShowInsertionPoint); Loc := InsertionPoint; OffscreenToScreen(loc); with info^, tRect do begin imag := trunc(magnification + 0.5); height := CurrentSize * imag; height := height - height div 4; left := loc.h; bottom := loc.v - imag + 1; top := bottom - height; right := left + 1; PenNormal; PenSize(imag, imag); PenMode(PatXor); FrameRect(tRect); ticks := TickCount + 3; repeat until TickCount > ticks; FrameRect(tRect); end; end; procedure DrawROI; var tPort: GrafPtr; tRect: rect; SaveUndoFromClip: boolean; RoiStretchHandle: rect; psize: integer; StartTicks: LongInt; begin with Info^ do begin StartTicks := TickCount; if OpPending then DoOperation(CurrentOp); GetPort(tPort); SetPort(GrafPtr(Info^.osPort)); PenNormal; if ScaleToFitWindow then if (magnification < 1.0) and (magnification <> 0.0) then begin psize := round(1.0 / magnification + 1.5); PenSize(psize, psize); end; if not ((MouseState = DownInRoi) and OpPending) then if PicSize <= UndoBufSize then begin RGBForeColor(BlackRGB); RGBBackColor(WhiteRGB); if RoiType = RectRoi then begin with osroiRect do begin SetRect(RoiStretchHandle, right - RoiHandleSize, bottom - RoiHandleSize, right, bottom); if ((right - left) > RoiHandleSize) and ((bottom - top) > RoiHandleSize) then PaintRect(RoiStretchHandle); end; end; PatIndex := (PatIndex + 1) mod 8; PenPat(pat[PatIndex]); FrameRgn(osroiRgn); SetRGBForeColor(ForegroundRGB, ForegroundIndex); SetRGBBackColor(BackgroundRGB, BackgroundIndex); end; if PicSize > UndoBufSize then begin if magnification < 1.0 then PenSize(2, 2); PatIndex := (PatIndex + 1) mod 8; PenPat(pat[PatIndex]); PenMode(PatXor); FrameRgn(osroiRgn); if MouseState = DownInRoi then begin UnionRect(RoiRect, OldRoiRect, tRect); UpdateScreen(tRect); end else UpdateScreen(RoiRect); FrameRgn(osroiRgn); end else begin tRect := RoiRect; if MouseState = DownInRoi then UnionRect(RoiRect, OldRoiRect, tRect) else if RoiNudged then begin tRect := osroiRect; InsetRect(tRect, -2, -2); OffscreenToScreenRect(tRect); RoiNudged := false; end; UpdateScreen(tRect); SaveUndoFromClip := UndoFromClip; UndoFromClip := false; Undo; UndoFromClip := SaveUndoFromClip; end; SetPort(tPort); RoiUpdateTime := TickCount - StartTicks; end; {with} end; procedure MoveRoi (loc, osloc: point); var osdh, osdv: integer; begin with info^ do begin osdh := osloc.h - osMouseDownLoc.h; osdv := osloc.v - osMouseDownLoc.v; if RoiMovementState = Constrained then begin if osdv <> 0 then RoiMovementState := ConstrainedV else if osdh <> 0 then RoiMovementState := ConstrainedH end; if RoiMovementState = ConstrainedH then osdv := 0 else if RoiMovementState = ConstrainedV then osdh := 0; if not OpPending then with osroiRect do begin if (left + osdh < 0) and not StretchMode then osdh := -left; if (top + osdv < 0) and not StretchMode then osdv := -top; if right + osdh > PicRect.right then osdh := PicRect.right - right; if bottom + osdv > PicRect.bottom then osdv := PicRect.bottom - bottom; end; OldRoiRect := RoiRect; if StretchMode then begin measuring := false; DrawLabels('Width:', 'Height:', ''); with osroiRect do begin right := right + osdh; if right < left + 2 then right := left + 2; bottom := bottom + osdv; if bottom < top + 2 then bottom := top + 2; Show3Values(right - left, bottom - top, -1); MakeRegion; end end else begin DrawLabels('X:', 'Y:', 'Value:'); OffsetRgn(osroiRgn, osdh, osdv); with osroiRect do Show3Values(left, top, 0); end; osroiRect := osroiRgn^^.rgnBBox; roiRect := osroiRect; OffscreenToScreenRect(roiRect); MouseDownLoc := loc; osMouseDownLoc := osloc; RoiUpdateTime := 0; {Forces ROI outline to be redrawn} end; {with Info} end; procedure ShowHistogramValues (GrayLevel: LongInt); var tPort: GrafPtr; hstart, vstart, ivalue: integer; begin hstart := ValuesHStart; vstart := ValuesVStart; GetPort(tPort); SetPort(ResultsWindow); TextSize(9); TextFont(Monaco); TextMode(SrcCopy); MoveTo(xValueLoc, vstart); with info^ do if calibrated then begin if InvertingCalibrationFunction then DrawReal(value[255 - GrayLevel], 5, 0) else DrawReal(value[GrayLevel], 5, 0) end else DrawLong(GrayLevel); DrawString(' '); MoveTo(yValueLoc, vstart + 10); if InvertingCalibrationFunction then DrawLong(histogram[255 - GrayLevel]) else DrawLong(histogram[GrayLevel]); DrawString(' '); SetPort(tPort); end; procedure SelectCursor; var loc, osloc, gloc: point; where, kind, i, color, x, y, margin: integer; WhichWindow: WindowPtr; MouseInRoi: boolean; tPort: GrafPtr; fwptr: WindowPtr; cvalue, xscale: extended; RoiStretchHandle: rect; MovingRoi: boolean; xvalue, pvalue: integer; begin if PasteControl <> nil then begin fwptr := FrontWindow; if WindowPeek(fwptr)^.WindowKind <> PasteControlKind then BringToFront(PasteControl); end; GetPort(tPort); SetPort(ScreenPort); GetMouse(gloc); loc := gloc; where := FindWindow(gloc, WhichWindow); if WhichWindow = nil then begin SetPort(tPort); InitCursor; exit(SelectCursor) end; kind := WindowPeek(WhichWindow)^.WindowKind; if kind < 0 then begin SetPort(tPort); exit(SelectCursor) end; {System Window} if where <> InContent then begin SetPort(tPort); InitCursor; exit(SelectCursor) end; case kind of {$IFC Arlo } Pickind, FFTKind: {$ELSEC } Pickind: {$ENDC } begin if Info = NoInfo then begin SetPort(tPort); InitCursor; exit(SelectCursor) end; SetPort(info^.wptr); GlobalToLocal(loc); osloc := loc; ScreenToOffscreen(osloc); MovingRoi := false; with info^ do begin SelectionMode := NewSelection; if RoiShowing and isSelectionTool then begin if OptionKeyDown then SelectionMode := SubSelection else if ControlKeyDown then SelectionMode := AddSelection; end; if RoiShowing and (SelectionMode = NewSelection) then MouseInRoi := PtInRgn(osloc, osroiRgn) else MouseInRoi := false; {$IFC Arlo } if InFrequencyDomain then MouseInRoi := false; {$ENDC } end; {with} if MouseInRoi or (MouseState = DownInRoi) then begin if MouseState = NotInRoi then MouseState := InRoi; InitCursor; if button then begin if MouseState = InRoi then begin if OpPending and (CurrentOp <> PasteOp) then SetupUndo; MouseState := DownInRoi; MouseDownLoc := loc; osMouseDownLoc := osloc; with info^ do if RoiType = RectRoi then begin if magnification > 1.0 then margin := 0 else margin := 2; with osroiRect do SetRect(RoiStretchHandle, right - RoiHandleSize - margin, bottom - RoiHandleSize - margin, right, bottom); StretchMode := PtInRect(osloc, RoiStretchHandle); end; if ShiftKeyDown then RoiMovementState := Constrained else RoiMovementState := Unconstrained; end; MoveRoi(loc, osloc); MovingRoi := true; end else MouseState := InRoi end else begin MouseState := NotInRoi; if SpaceBarDown and (CurrentTool <> TextTool) then SetCursor(ToolCursor[Grabber]) else if SelectionMode = AddSelection then SetCursor(CrossPlusCursor) else if SelectionMode = SubSelection then SetCursor(CrossMinusCursor) else if (CurrentTool = MagnifyingGlass) and OptionKeyDown then SetCursor(GlassMinusCursor) else SetCursor(ToolCursor[CurrentTool]); end; if not MovingRoi then begin {$IFC Arlo } case kind of FFTKind: begin DrawLabels('r:', 'theta', 'Value:'); with osloc do ShowFFTValues(h, v, MyGetPixel(h, v)); end; PicKind: begin DrawLabels('X:', 'Y:', 'Value:'); with osloc do begin if Digitizing then pvalue := GetQCPixel(h, v) else pvalue := MyGetPixel(h, v); Show3Values(h, v, pvalue); end; end; end; { case } {$ELSEC } DrawLabels('X:', 'Y:', 'Value:'); with osloc do begin if Digitizing then pvalue := GetQCPixel(h, v) else pvalue := MyGetPixel(h, v); Show3Values(h, v, pvalue); end; {$ENDC } end; end; HistoKind: begin DrawLabels('X:', 'Y:', ''); SetCursor(ToolCursor[SelectionTool]); SetPort(HistoWindow); GlobalToLocal(loc); ShowHistogramValues(loc.h); end; ProfilePlotKind, CalibrationPlotKind: begin DrawLabels('X:', 'Y:', ''); SetCursor(ToolCursor[SelectionTool]); SetPort(PlotWindow); GlobalToLocal(loc); xscale := PlotCount / (PlotWidth - PlotRightMargin - PlotLeftMargin); xvalue := trunc((loc.h - PlotLeftMargin) * xscale); if (xvalue >= 0) and (xvalue < PlotWidth) then if kind = CalibrationPlotKind then Show2CalibratedValues(xvalue, xvalue, false) else Show2CalibratedValues(xvalue, PlotData[xvalue], true); end; LUTKind: begin DrawLabels('Value:', '', ''); SetPort(LUTWindow); GlobalToLocal(loc); if (CurrentTool = LutTool) or (CurrentTool = Wand) then begin if loc.v < 256 then SetCursor(LUTCursor) else InitCursor end else SetCursor(PickerCursor); if loc.v < 256 then begin if info^.calibrated then cvalue := value[loc.v] else cvalue := noValue; Show1Value(loc.v, cvalue); end else begin color := 0; for i := 1 to nExtraColors + 2 do if PtInRect(loc, ExtraColorsRect[i]) then Color := ExtraColorsEntry[i]; if info^.calibrated then cvalue := value[color] else cvalue := noValue; Show1Value(color, cvalue); end; end; GrayMapKind: SetCursor(gmCursor); otherwise InitCursor; end; {case} SetPort(tPort); end; procedure CloseAll; var i, j, result: integer; WPeek, NextWPeek: WindowPeek; ignore, rightKind: boolean; begin InitCursor; WPeek := WindowPeek(FrontWindow); StopDigitizing; while wpeek <> nil do begin NextWPeek := WPeek^.NextWindow; rightKind := (WPeek^.WindowKind = PicKind); {$IFC Arlo } rightKind := rightKind or (WPeek^.WindowKind = FFTKind); {$ENDC } if rightKind then begin Info := pointer(WPeek^.RefCon); result := CloseAWindow(info^.wptr); if not CommandPeriod then for j := 1 to 2 do ignore := HandleEvents; if result = cancel then begin ActivateWindow; finished := false; exit(CloseAll) end; end; wpeek := NextWPeek; end; end; procedure DoStartup; {Process Finder startup information} var message, ndocs, err, i, j: integer; DocInfo: AppFile; DefaultPalette, OpenedOK: boolean; palettename: str255; PaletteFile: boolean; ignore, PrintDocs: boolean; procedure PrintDocument; var i: integer; begin WhatToPrint := PrintImage; Print(false); DoClose; for i := 1 to 10 do ignore := HandleEvents; end; begin for j := 1 to 10 do ignore := HandleEvents; PaletteFile := false; CountAppFiles(message, ndocs); PrintDocs := message = appPrint; if ndocs >= 1 then for i := 1 to ndocs do begin GetAppFiles(i, DocInfo); with DocInfo do begin if ftype = 'ICOL' then begin PaletteFile := true; palettename := docinfo.fname; ClrAppFiles(i) end; if fType = 'IPIC' then begin WhatToOpen := OpenImage; OpenedOK := OpenFile(fName, vRefNum); for j := 1 to 10 do ignore := HandleEvents; ClrAppFiles(i); if not OpenedOK then exit(DoStartup); if PrintDocs then PrintDocument; end; if fType = 'TIFF' then begin WhatToOpen := OpenTIFF; OpenedOK := OpenFile(fName, vRefNum); for j := 1 to 10 do ignore := HandleEvents; ClrAppFiles(i); if not OpenedOK then exit(DoStartup); if PrintDocs then PrintDocument; end; if fType = 'PICT' then begin OpenedOK := OpenPICT(fName, vRefNum, false); for j := 1 to 10 do ignore := HandleEvents; ClrAppFiles(i); if not OpenedOK then exit(DoStartup); if PrintDocs then PrintDocument; end; end; {with} end; if PaletteFile then InitColor(PaletteName, DocInfo.vRefNum); end; procedure Shutdown; var AlertID: integer; begin if (UnsavedAreas > 0) or (UnsavedLengths > 0) or (UnsavedPoints > 0) then begin InitCursor; AlertID := alert(500, nil); if AlertID = CancelResetID then begin finished := false; exit(Shutdown) end; end; CloseAll; ConvertClipboard; end; begin Init; SetupMenus; GetSettings; AllocateBuffers; ConvertSystemClipboard; DoStartup; UnloadSeg(@Init); {InitUser;} repeat if not HandleEvents then if info^.RoiShowing and (RoiUpdateTime < 30) then DrawRoi; ShowInsertionPoint; SelectCursor; if Digitizing then begin CaptureAndDisplayQCFrame; if ContinuousHistogram then ShowContinuousHistogram; end; if Finished then Shutdown; until finished; isOK := LoadCLUTResource(AppleDefaultCLUT); RestoreScreen; {Force Finder to redraw color icons} end.