unit Graphics; {Graphics routines used by Image program} interface uses QuickDraw, PaletteMgr, ToolIntf, PickerIntf, OSIntf, PrintTraps, globals, Utilities; procedure DoProfilePlot (event: EventRecord; start, finish: point); procedure DrawPlot; procedure ShowResults; procedure SetupPlot (var data: LineType; start: point); procedure MakePlotWindow (PlotLeft, PlotTop, PlotWidth, PlotHeight: integer); procedure DrawObject (obj: ObjectType; p1, p2: point); procedure DrawLUT; procedure DrawTools; function InvertingCalibrationFunction: boolean; procedure DrawHistogram; procedure DrawGrayMap; procedure ResetGrayMap; procedure DoMouseDownInGrayMap; procedure ShowNextWindow; procedure StackWindows; procedure TileWindows; procedure DrawLabels (xL, yL, zL: str255); function Duplicate (SavingBlankField: boolean): boolean; procedure InvertPic; procedure ShowMessage (str: str255); procedure ShowTime (StartTicks: LongInt; r: rect); procedure ShowFrameRate (str1: str255; StartTicks, nFrames: LongInt); function long2str (num: LongInt): str255; procedure ConvertHistoToText; procedure ConvertPlotToText; procedure ConvertCalibrationCurveToText; procedure SetupUndoInfoRec; procedure ShowProgress (current, total: LongInt); implementation procedure DrawNum (x, y: integer; value: LongInt); var str: str255; begin MoveTo(x, y); if value < 10 then DrawString('0'); if value < 100 then DrawString('0'); NumToString(value, str); DrawString(str); end; procedure LabelProfilePlot; var str: str255; min, max: extended; begin if InvertPlots then begin min := PlotMax; max := PlotMin end else begin min := PlotMin; max := PlotMax end; if info^.Calibrated then begin MoveTo(1, PlotHeight - PlotBottomMargin); if abs(min) >= 1000.0 then DrawReal(min, 1, 0) else DrawReal(min, 1, 2); MoveTo(1, PlotTopMargin + 8); if abs(max) >= 1000.0 then DrawReal(max, 1, 0) else DrawReal(max, 1, 2); end else begin DrawNum(2, PlotHeight - PlotBottomMargin, trunc(Min)); DrawNum(2, PlotTopMargin + 8, trunc(Max)); end; MoveTo(PlotLeftMargin + 15, PlotHeight - PlotBottomMargin + 12); DrawString('N='); NumToString(PlotCount, str); DrawString(str); DrawString(' Mean='); RealToString(PlotMean, 3, 2, str); DrawString(str); if PlotAvg > 1 then begin DrawString(' Width='); NumToString(PlotAvg, str); DrawString(str); end; DrawString(' '); if info^.Calibrated then begin DrawString('Calibrated('); DrawString(info^.UnitOfMeasure); DrawString(')'); end else DrawString('Uncalibrated'); end; procedure LabelCalibrationPlot; var pbottom, hloc, vloc, i: integer; letter: packed array[1..6] of char; begin pbottom := PlotHeight - PLotBottomMargin; MoveTo(2, PlotTopMargin + 4); DrawReal(MaxValue, 4, 2); MoveTo(2, pbottom); DrawReal(MinValue, 4, 2); MoveTo(PlotLeftMargin - 3, pbottom + 10); DrawString('0'); MoveTo(PlotWidth - PlotRightMargin - 14, pbottom + 10); DrawString('255'); MoveTo(PlotLeftMargin + 15, PlotTopMargin + 15); TextSize(12); case info^.fit of StraightLine: DrawString('y=a+bx'); Poly2: DrawString('y=a+bx+cx^2'); Poly3: DrawString('y=a+bx+cx^2+dx^3'); Poly4: DrawString('y=a+bx+cx^2+dx^3+ex^4'); Poly5: DrawString('y=a+bx+cx^2+dx^3+ex^4+fx^5'); ExpoFit: DrawString('y=aexp(bx)'); PowerFit: DrawString('y=ax^b'); LogFit: DrawString('y=aln(bx)'); end; hloc := PlotWidth - PlotRightMargin + 5; vloc := PlotTopMargin + 25; letter := 'abcdef'; MoveTo(hloc, vloc); with info^ do for i := 1 to nCoefficients do begin MoveTo(hloc, vloc); TextSize(12); DrawString(letter[i]); DrawString('='); TextSize(9); DrawReal(Coefficient[i], 1, 8); vloc := vloc + 15; end; vloc := vloc + 25; MoveTo(hloc, vloc); DrawString('S.D.='); DrawReal(FitSD, 1, 4); vloc := vloc + 15; MoveTo(hloc, vloc); DrawString('R^2='); DrawReal(FitGoodness, 1, 4); end; procedure DrawPlot; var tPort: GrafPtr; fRect: rect; begin if not Printing then begin GetPort(tPort); SetPort(PlotWindow); EraseRect(PlotWindow^.portRect); end; SetRect(fRect, PlotLeftMargin, PlotTopMargin, PlotWidth - PlotRightMargin, PlotHeight - PlotBottomMargin); PenNormal; FrameRect(fRect); DrawPicture(PlotPICT, fRect); TextFont(ApplFont); TextSize(9); if WindowPeek(PlotWindow)^.WindowKind = ProfilePlotKind then begin if DrawPlotLabels then LabelProfilePlot end else LabelCalibrationPlot; if not printing then begin if not Copying then DrawMyGrowIcon(PlotWindow); SetPort(tPort); end; end; procedure MakePlotWindow; {(PlotLeft, PlotTop, PlotWidth, PlotHeight: integer)} var PLotRect, pwrect, dwrect, srect: rect; overlapping: boolean; begin if PlotWindow = nil then begin SetRect(PlotRect, PlotLeft, PlotTop, PlotLeft + PlotWidth, PlotTop + PlotHeight); PlotWindow := NewWindow(nil, PlotRect, 'Plot', true, DocumentProc, nil, true, 0); end else begin GetWindowRect(PlotWindow, pwrect); GetWindowRect(info^.wptr, dwrect); overlapping := SectRect(pwrect, dwrect, srect); if overlapping then MoveWindow(PlotWindow, PlotLeft, PlotTop, false); SizeWindow(PlotWindow, PlotWidth, PlotHeight, false); end; end; procedure SetupPlot; {(var data: LineType; start: point)} var fRect, trect: rect; tPort: GrafPtr; i, width, y, fmax, scale, WindowWidth: integer; SaveClipRegion: RgnHandle; pt: point; temp, sum, vscale: extended; AutoScale: boolean; RealData: array[0..MaxPixelsPerLine] of extended; index: UnsignedByte; begin if info^.calibrated then PlotLeftMargin := 35 else PlotLeftMargin := 25; PlotTopMargin := 10; PlotBottomMargin := 20; PlotRightMargin := 10; for i := 0 to PlotCount - 1 do RealData[i] := value[data[i]]; if InvertPlots then for i := 0 to PlotCount - 1 do RealData[i] := MaxValue - RealData[i]; if FixedSizePlot then begin width := ProfilePlotWidth; PlotWidth := width; PlotHeight := ProfilePlotHeight end else begin Width := PlotCount * trunc(Info^.magnification + 0.5); if Width < 50 then Width := 100; GetWindowRect(info^.wptr, trect); with trect do WindowWidth := right - left; if width > WindowWidth then width := WindowWidth; PlotHeight := Width div 2; if PlotWidth > 300 then PlotHeight := width div 3; if PlotWidth > 400 then PlotHeight := width div 4; end; PlotWidth := Width + PlotLeftMargin + PlotRightMargin; PlotHeight := PlotHeight + PlotTopMargin + PlotBottomMargin; pt.h := start.h; pt.v := start.v + 40; LocalToGlobal(pt); PlotLeft := pt.h - PlotLeftMargin; PlotTop := pt.v; if PlotTop > (ScreenHeight - PlotHeight) then PlotTop := PlotTop - PlotHeight - 60; if PlotTop < 60 then PlotTop := 60; MakePlotWindow(PlotLeft, PlotTop, PlotWidth, PlotHeight); WindowPeek(PlotWindow)^.WindowKind := ProfilePlotKind; PlotMin := MaxValue; PlotMax := MinValue; sum := 0.0; for i := 0 to PlotCount - 1 do begin temp := RealData[i]; sum := sum + temp; if AutoscalePlots then begin if temp < PlotMin then PlotMin := temp; if temp > PlotMax then PlotMax := temp; end; end; if PlotCount > 0 then PlotMean := sum / PlotCount else PlotMean := 0.0; if not AutoscalePlots then begin PlotMin := ProfilePlotMin; PlotMax := ProfilePlotMax; end; fmax := PlotCount - 1; if (PlotMax - PlotMin) <> 0 then vscale := fmax / (PlotMax - PlotMin) else vscale := 1.0; scale := round(1024.0 / PlotCount); {This scaling needed to get around a 32-bit QD problem} if scale < 1 then scale := 1; fmax := fmax * scale; vscale := vscale * scale; SetRect(fRect, 0, 0, fmax, fmax); GetPort(tPort); SetPort(PlotWindow); SaveClipRegion := PlotWindow^.ClipRgn; RectRgn(PlotWindow^.ClipRgn, fRect); PlotPICT := OpenPicture(fRect); PenNormal; if LinePlot then begin MoveTo(0, round(vscale * (PlotMax - RealData[0]))); for i := 1 to PlotCount - 1 do LineTo(i * scale, round(vscale * (PlotMax - RealData[i]))) end else for i := 1 to PlotCount - 1 do begin y := round(vscale * (PlotMax - RealData[i])); MoveTo(i * scale, y); LineTo(i * scale, y) end; ClosePicture; PlotWindow^.ClipRgn := SaveClipRegion; InvalRect(PlotWindow^.PortRect); SetPort(tPort); SelectWindow(PlotWindow); end; procedure GetDiagLine (start, finish: Point; var count: integer; var data: LineType; OptionKey: boolean); var sum: LongInt; p: ptr; deltax, deltay, xinc, yinc, accumulator, i: integer; xloc, yloc, j: integer; average: boolean; buf: LineType; fline: LineType; begin average := LineWidth > 1; if OptionKey and average then for i := 0 to MaxPixelsPerLine do fline[i] := ForegroundIndex; count := 0; xloc := start.h; yloc := start.v; deltax := finish.h - xloc; deltay := finish.v - yloc; if (deltax = 0) and (deltay = 0) then begin data[count] := MyGetPixel(xloc, yloc); if OptionKey then PutPixel(xloc, yloc, ForegroundIndex); count := count + 1; exit(GetDiagLine); end; if deltax < 0 then begin xinc := -1; deltax := -deltax end else xinc := 1; if deltay < 0 then begin yinc := -1; deltay := -deltay end else yinc := 1; if DeltaX > DeltaY then begin {More horizontal} if average then deltax := deltax + LineWidth; accumulator := deltax div 2; i := deltax; repeat accumulator := accumulator + deltay; if accumulator >= deltax then begin accumulator := accumulator - deltax; yloc := yloc + yinc end; xloc := xloc + xinc; if average then begin GetColumn(xloc, yloc, LineWidth, buf); if OptionKey then PutColumn(xloc, yloc, LineWidth, fline); sum := 0; for j := 0 to LineWidth - 1 do sum := sum + buf[j]; data[count] := round(sum / LineWidth); end else begin data[count] := MyGetPixel(xloc, yloc); if OptionKey then PutPixel(xloc, yloc, ForegroundIndex); end; count := count + 1; i := i - 1; until i = 0 end else begin {More vertical} if average then deltay := deltay + LineWidth; accumulator := deltay div 2; i := deltay; repeat accumulator := accumulator + deltax; if accumulator >= deltay then begin accumulator := accumulator - deltay; xloc := xloc + xinc end; yloc := yloc + yinc; if average then begin GetLine(xloc, yloc, LineWidth, buf); if OptionKey then PutLine(xloc, yloc, LineWidth, fline); sum := 0; for j := 0 to LineWidth - 1 do sum := sum + buf[j]; data[count] := round(sum / LineWidth); end else begin data[count] := MyGetPixel(xloc, yloc); if OptionKey then PutPixel(xloc, yloc, ForegroundIndex); end; count := count + 1; i := i - 1; until i = 0 end; count := count - 1; end; procedure DoProfilePlot;{ (event: EventRecord; start, finish: point)} var i, range, width, value: integer; p1, p2, pt: point; OptionKey: boolean; begin with Info^.wrect do begin if finish.h >= right then finish.h := right - 1; if finish.v >= bottom then finish.v := bottom - 1; end; if finish.h < start.h then begin {Swap ends} pt := start; start := finish; finish := pt; end; p1 := start; p2 := finish; ScreenToOffscreen(p1); ScreenToOffscreen(p2); OptionKey := OptionKeyDown; GetDiagLine(p1, p2, PlotCount, PlotData, OptionKey); PlotAvg := LineWidth; SetupPlot(PlotData, start); if OptionKey then begin UpdatePicWindow; info^.changes := true; end; end; procedure FilterHistogram (var h: HistogramType); var i: integer; begin for i := 1 to 254 do h[i] := (h[i - 1] + h[i] + h[i + 1]) div 3; end; procedure ShowResults; var vloc, hloc, i: integer; tPort: GrafPtr; trect: rect; clength, cx, cy, IntDen, BackgroundLevel: extended; MaxCount: LongInt; h: HistogramType; procedure NewLine; begin vloc := vloc + 12; MoveTo(hloc, vloc); end; begin GetPort(tPort); vloc := 35; hloc := 4; SetPort(ResultsWindow); TextFont(ApplFont); TextSize(9); Setrect(trect, 0, vloc, rwidth, rheight); EraseRect(trect); if ResultsMessage <> '' then begin Setrect(trect, hloc, vloc + 15, rwidth - 10, rheight); TextBox(pointer(ord(@ResultsMessage) + 1), length(ResultsMEssage), trect, teJustLeft) end else with results do begin NewLine; case CurrentTool of ruler: with info^ do begin DrawBString('Count: '); DrawLong(nLengths); NewLine; DrawBString('Length: '); DrawReal(lengths[nLengths], 1, precision); DrawString(' '); if SpatialScale <> 0.0 then DrawString(Units) else DrawString('Pixels'); end; PointingTool: begin DrawBString('Count: '); DrawLong(nPoints); NewLine; DrawBString('X: '); DrawReal(x, 1, precision); NewLine; DrawBString('Y: '); DrawReal(y, 1, precision); end; AngleTool: begin DrawBString('Angle: '); DrawReal(angle, 1, precision); DrawString(' degrees'); NewLine; end; otherwise with info^, MeasurementsP^ do begin DrawBString('Count: '); DrawLong(nRegions); NewLine; DrawBString('N: '); DrawLong(PixelCount[nRegions]); if SpatialScale <> 0.0 then begin NewLine; DrawBString('Area: '); DrawReal(PixelCount[nRegions] / sqr(SpatialScale), 1, precision); DrawString(' square '); DrawString(units); end; NewLine; DrawBString('Mean: '); DrawReal(mean[nRegions], 1, precision); if calibrated then begin DrawString(' '); DrawBString(UnitOfMeasure); DrawString(' ('); DrawLong(results.imean); DrawString(')'); end; if BinaryPic then begin NewLine; DrawBString('Black: '); DrawLong(histogram[255]); NewLine; DrawBString('White: '); DrawLong(histogram[0]); end else begin if (MinIndex = 0) or (MinIndex = 1) or (MaxIndex = 255) or (MaxIndex = 254) then DrawBString(' (Possible Saturation)'); NewLine; DrawBString('Std Dev: '); DrawReal(SD[nRegions], 1, precision); NewLine; DrawBString('Min: '); DrawReal(minCalibratedValue, 1, precision); NewLine; DrawBString('Max: '); DrawReal(maxCalibratedValue, 1, precision); end; if xyLocM in Measurements then begin NewLine; DrawBString('X,Y: '); DrawReal(xcenter[nRegions], 6, precision); DrawString(','); DrawReal(ycenter[nRegions], 6, precision); end; if ModeM in Measurements then begin NewLine; DrawBString('Mode: '); DrawReal(mode[nRegions], 1, precision); end; if FitEllipse then begin if MinorAxisM in Measurements then begin NewLine; DrawBString('Minor: '); DrawReal(MinorAxis[nRegions], 1, precision); end; if MajorAxisM in Measurements then begin NewLine; DrawBString('Major: '); DrawReal(MajorAxis[nRegions], 1, precision); end; if AngleM in Measurements then begin NewLine; DrawBString('Angle: '); DrawReal(orientation[nRegions], 1, precision); end; end; if IntDenM in measurements then begin NewLine; h := histogram; FilterHistogram(h); FilterHistogram(h); FilterHistogram(h); BackgroundLevel := 0.0; MaxCount := 0; for i := 0 to 255 do if h[i] > MaxCount then begin MaxCount := h[i]; BackgroundLevel := value[i] end; IntDen := PixelCount[nRegions] * (mean[nRegions] - BackgroundLevel); DrawBString('Integrated Density: '); DrawReal(IntDen, 1, precision); NewLine; DrawBString('Background Level: '); DrawReal(BackGroundLevel, 1, precision); end else IntDen := 0.0; IntegratedDensity[nRegions] := IntDen; if PerimeterM in measurements then begin NewLine; DrawBString('Perimeter: '); DrawReal(plength[nRegions], 1, precision); end; end; end; {case} end; {with} SetPort(tPort); nRegions2 := nRegions; nLengths2 := nLengths; end; procedure PaintCircle (hloc, vloc: integer); var r: rect; begin SetRect(r, hloc, vloc, hloc + LineWidth, vloc + LineWidth); PaintOval(r); end; procedure DrawBrush (start, finish: point); {Thanks to Robert Rimmer for suggesting the use of a line generator to implement the brush.} var deltax, deltay, xinc, yinc, accumulator, i: integer; xloc, yloc, offset, j: integer; begin xloc := start.h; yloc := start.v; deltax := finish.h - xloc; deltay := finish.v - yloc; if (deltax = 0) and (deltay = 0) then begin PaintCircle(xloc, yloc); exit(DrawBrush) end; if deltax < 0 then begin xinc := -1; deltax := -deltax end else xinc := 1; if deltay < 0 then begin yinc := -1; deltay := -deltay end else yinc := 1; if DeltaX > DeltaY then begin {More horizontal} accumulator := deltax div 2; i := deltax; repeat accumulator := accumulator + deltay; if accumulator >= deltax then begin accumulator := accumulator - deltax; yloc := yloc + yinc end; xloc := xloc + xinc; PaintCircle(xloc, yloc); i := i - 1; until i = 0 end else begin {More vertical} accumulator := deltay div 2; i := deltay; repeat accumulator := accumulator + deltax; if accumulator >= deltay then begin accumulator := accumulator - deltay; xloc := xloc + xinc end; yloc := yloc + yinc; PaintCircle(xloc, yloc); i := i - 1; until i = 0 end; end; procedure DrawObject;{ (obj: ObjectType; p1, p2: point)} var MaskRect, r, dstRect, osMaskRect: rect; tPort: GrafPtr; tmp: integer; begin GetPort(tPort); Pt2Rect(p1, p2, MaskRect); with Info^ do begin changes := true; tmp := trunc(magnification + 0.5) * LineWidth; with MaskRect do begin if tmp < 32 then tmp := 32; right := right + tmp; bottom := bottom + tmp; if magnification > 1.0 then begin left := left - tmp; top := top - tmp; end; end; ScreenToOffscreen(p1); ScreenToOffscreen(p2); SetPort(GrafPtr(osPort)); PenNormal; PenSize(LineWidth, LineWidth); case obj of lineObj: begin MoveTo(p1.h, p1.v); LineTo(p2.h, p2.v); end; Rectangle: begin Pt2Rect(p1, p2, r); FrameRect(r); end; RoundedRect: begin Pt2Rect(p1, p2, r); FrameRoundRect(r, OvalSize, OvalSize); end; oval: begin Pt2Rect(p1, p2, r); FrameOval(r); end; BrushObj: DrawBrush(p1, p2); end; SetPort(tPort); RectRgn(MaskRgn, MaskRect); hlock(handle(osPort^.portPixMap)); hlock(handle(CGrafPort(ThePort^).PortPixMap)); CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPort(ThePort^).PortPixMap)^^, SrcRect, wrect, SrcCopy, MaskRgn); hunlock(handle(osPort^.portPixMap)); hunlock(handle(CGrafPort(ThePort^).PortPixMap)); end; {with} end; procedure DrawLUT; var tPort: GrafPtr; h, v, i: integer; begin GetPort(tPort); SetPort(LUTWindow); with LutWindow^ do begin for v := 0 to 255 do begin fgColor := v; MoveTo(0, v); LineTo(cwidth, v) end; for i := 1 to nExtraColors + 2 do begin fgColor := ExtraColorsEntry[i]; PaintRect(ExtraColorsRect[i]); end; TextFont(ApplFont); TextSize(9); with ExtraColorsRect[1] do MoveTo(left + 3, bottom - 1); fgcolor := BlackIndex; DrawString('white'); with ExtraColorsRect[2] do MoveTo(left + 4, bottom - 1); InvertRect(ExtraColorsRect[2]); DrawString('black'); InvertRect(ExtraColorsRect[2]); end; SetPort(tPort); end; procedure DrawTools; var tPort: GrafPtr; v, n, i: integer; str: str255; tool: ToolType; begin GetPort(tPort); SetPort(ToolWindow); TextFont(ToolFont); TextSize(12); EraseRect(CGrafPort(ToolWindow^).PortPixMap^^.bounds); for tool := FirstTool to LastTool do with ToolRect[tool] do begin MoveTo(left + ho, top + vo); DrawChar(ToolChar[tool]); end; InvertRect(ToolRect[CurrentTool]); RGBForeColor(ForegroundRGB); with ToolRect[brush] do MoveTo(left + ho, top + vo); DrawChar(chr(80)); RGBForeColor(BackgroundRGB); with ToolRect[Eraser] do MoveTo(left + ho, top + vo); DrawChar(chr(102)); RGBForeColor(BlackRGB); for i := 1 to nLineTypes do PaintRect(lines[i]); MoveTo(0, Lines[LineIndex].top - 9); DrawChar(chr(CheckMarkChar)); SetPort(tPort); end; function InvertingCalibrationFunction: boolean; begin with info^ do begin InvertingCalibrationFunction := calibrated and (fit = StraightLine) and (Coefficient[2] < 0.0) end; end; procedure DrawHistogram; var tPort: GrafPtr; i, h: integer; MaxCount, count, NextMaxCount: LongInt; str: str255; hscale: extended; ShowThreshold: boolean; begin ShowThreshold := (HistogramThresholdStart > 0) or (HistogramThresholdEnd < 255); if not printing then begin GetPort(tPort); SetPort(HistoWindow); EraseRect(HistoWindow^.portRect); end; with Results, MeasurementsP^ do begin MaxCount := histogram[imode]; if MaxCount > (hheight - 2) then begin if MaxCount / PixelCount[nRegions] > 0.08 then begin NextMaxCount := 0; for i := 0 to 255 do begin count := histogram[i]; if (i <> imode) and (count > NextMaxCount) then NextMaxCount := count; end; NextMaxCount := NextMaxCount + NextMaxCount div 2; if NextMaxCount > MaxCount then NextMaxCount := MaxCount; hscale := NextMaxCount / (hheight - 2); end else hscale := MaxCount / (hheight - 2); end else hscale := 1.0; if ShowThreshold then PenPat(gray); if InvertingCalibrationFunction then for h := 0 to 255 do begin if h = HistogramThresholdStart then PenPat(black); MoveTo(255 - h, hheight); LineTo(255 - h, hheight - round(histogram[h] / hscale)); if h = HistogramThresholdEnd then PenPat(gray) end else for h := 0 to 255 do begin if h = HistogramThresholdStart then PenPat(black); MoveTo(h, hheight); LineTo(h, hheight - round(histogram[h] / hscale)); if h = HistogramThresholdEnd then PenPat(gray) end; end; if ShowThreshold then PenNormal; if not Printing then SetPort(tPort); end; procedure UpdateGrayMap; const gmRectArea = 4096.0; {64x64} max = 4177920; var tPort: GrafPtr; r: rect; x, y, i, h1, h2, h3, v1, v2, v3, dx, dy: integer; xcenter, ycenter, brightness, islope, thumb: integer; table: LookupTable; hrect: rect; slope: extended; area, value, sum: LongInt; begin GetPort(tPort); SetPort(GrayMapWindow); PenNormal; EraseRect(GrayMapRect2); FrameRect(GrayMapRect); with info^ do if LutMode = CustomGrayscale then begin GetLookupTable(table); for i := 0 to 63 do begin x := gmRectLeft + 63 - i; y := gmRectTop + table[i * 4] div 4; MoveTo(x, y); LineTo(x, y); end end else begin h1 := gmRectLeft + p1x div 4; v1 := gmRectBottom - 1 - (p1y div 4); h2 := gmRectLeft + p2x div 4; v2 := gmRectBottom - 1 - (p2y div 4); MoveTo(gmRectLeft, gmRectBottom - 1); LineTo(h1, v1); LineTo(h2, v2); LineTo(gmRectRight - 1, gmRectTop); SetRect(hrect, h1 - 1, v1 - 1, h1 + 2, v1 + 2); PaintRect(hrect); {First handle} SetRect(hrect, h2 - 1, v2 - 1, h2 + 2, v2 + 2); PaintRect(hrect); {Last handle} dx := p2x - p1x; dy := p2y - p1y; xcenter := p1x + dx div 2; ycenter := p1y + dy div 2; h3 := gmRectLeft + xcenter div 4; v3 := gmRectBottom - 1 - (ycenter div 4); SetRect(hrect, h3 - 1, v3 - 1, h3 + 2, v3 + 2); PaintRect(hrect); {Center handle} thumb := gmSlideHeight - 2; i := 0; sum := 0; repeat value := ctable[i].rgb.red; value := band(value, 65535); sum := sum + value; i := i + 4; until i > 255; brightness := trunc((sum / max) * (gmSlideWidth - thumb - 2.0)); gmSlide1Loc := brightness; with gmSlide1 do SetRect(hrect, left + brightness + 1, top + 1, left + brightness + thumb + 1, top + thumb + 1); EraseRect(gmSlide1i); PaintRect(hrect); {Thumb for brightness control} if dx <> 0 then slope := dy / dx else slope := 1000.0; if slope > 1.0 then begin if dy <> 0 then slope := 2.0 - dx / dy else slope := 2.0; end; islope := trunc(slope * 0.5 * (gmSlideWidth - thumb - 2.0)); with gmSlide2 do SetRect(hrect, left + islope + 1, top + 1, left + islope + thumb + 1, top + thumb + 1); EraseRect(gmSlide2i); PaintRect(hrect); {Thumb for contrast control} end; SetPort(tPort); end; procedure DrawGrayMap; var tPort: GrafPtr; x, y, i: integer; table: LookupTable; begin GetPort(tPort); SetPort(GrayMapWindow); PenNormal; TextFont(ApplFont); TextSize(9); with gmSlide1 do MoveTo(left - 6, bottom); DrawChar('B'); with gmSlide2 do MoveTo(left - 6, bottom); DrawChar('C'); FrameRect(gmSlide1); FrameRect(gmSlide2); FrameRect(gmIcon1); FrameRect(gmIcon2); with gmIcon1 do begin MoveTo(left, top + 10); LineTo(left + 5, top + 10); LineTo(left + 12, top + 3); LineTo(left + gmIconWidth - 1, top + 3); end; with gmIcon2 do begin MoveTo(left, top + 10); LineTo(left + gmIconWidth div 2, top + 10); LineTo(left + gmIconWidth div 2, top + 3); LineTo(left + gmIconWidth - 1, top + 3); end; UpdateGrayMap; GrayMapReady := true; SetPort(tPort); end; procedure ResetGrayMap; begin with info^ do begin StopThresholding; p1x := 0; p1y := 0; p2x := 255; p2y := 255; DeltaX := 256; DeltaY := 256; SetGrayScaleLUT; LUTMode := Grayscale; if GrayMapReady then UpdateGrayMap; IdentityFunction := true; end; end; procedure FindEndPoints (x, y: integer); var xintercept: integer; begin with info^ do begin if DeltaX = 0 then begin p1x := x; p1y := 0; p2x := x; p2y := 255; exit(FindEndPoints); end; if DeltaY = 0 then begin p1x := 0; p1y := y; p2x := 255; p2y := y; exit(FindEndPoints); end; p1x := x - y * LongInt(DeltaX) div DeltaY; xIntercept := p1x; p1y := 0; if p1x < 0 then begin p1y := -(LongInt(DeltaY) * p1x) div DeltaX; p1x := 0; end; p2y := 255; p2x := 255 * LongInt(DeltaX) div DeltaY; if xIntercept < 0 then p2x := p2x + xIntercept else p2x := p2x + p1x; if p2x > 255 then begin p2y := 255 - (p2x - 255) * LongInt(DeltaY) div DeltaX; p2x := 255; end; if p2x < 0 then p2x := 0; end; {with} end; procedure ChangeBrightness; var loc, oldloc, max, HalfMax, thumb, xcenter, ycenter, delta: integer; hrect: rect; function FindLoc: integer; var p: point; loc: integer; begin GetMouse(p); loc := p.h - gmSlide1.left - 2; if loc < 0 then loc := 0; if loc > max + 5 then loc := max + 5; FindLoc := loc; end; begin with info^ do begin thumb := gmSlideHeight - 2; max := gmSlideWidth - thumb - 2; HalfMax := max div 2; OldLoc := FindLoc; repeat xcenter := p1x + (p2x - p1x) div 2; ycenter := p1y + (p2y - p1y) div 2; loc := FindLoc; delta := gmSlide1Loc + 1 - loc; if deltay <> 0 then begin xcenter := xcenter + delta; if xcenter < 0 then xcenter := 0; if xcenter > 255 then xcenter := 255; end; if deltax <> 0 then begin ycenter := ycenter - delta; if ycenter < 0 then ycenter := 0; if ycenter > 255 then ycenter := 255; end; FindEndPoints(xcenter, ycenter); UpdateGrayMap; gmFixedSlope := true; SetGrayScaleLUT; gmFixedSlope := false; OldLoc := loc; until not button; IdentityFunction := false; end; {with} end; procedure ChangeContrast; var p: point; loc, max, HalfMax, thumb, xcenter, ycenter: integer; hrect: rect; slope: extended; begin with info^ do begin thumb := gmSlideHeight - 2; max := gmSlideWidth - thumb - 2; HalfMax := max div 2; xcenter := p1x + deltax div 2; ycenter := p1y + deltay div 2; repeat GetMouse(p); loc := p.h - gmSlide2.left - 2; if loc < 0 then loc := 0; if loc > max then loc := max; if loc <= HalfMax then slope := loc / HalfMax else if loc < max then slope := HalfMax / (max - loc) else slope := 1000.0; if slope <= 1.0 then begin deltax := 255; deltay := round(slope * deltax); end else begin deltay := 255; deltax := round(deltay / slope); end; FindEndPoints(xcenter, ycenter); UpdateGrayMap; SetGrayScaleLUT; until not button; IdentityFunction := false; end; {with} end; procedure ConvertMouseToXY (p: point; var x, y: integer); begin x := (p.h - gmRectLeft) * 4; if x < 0 then x := 0; if x > 255 then x := 255; y := (gmRectBottom - p.v) * 4; if y < 0 then y := 0; if y > 255 then y := 255; end; procedure DoMouseDownInGrayMap; var r: rect; tPort: GrafPtr; x, y, p1Dist, p2Dist, x1, y1: integer; mode: (StartPoint, EndPoint, Brightness); p: point; pressed: boolean; procedure DoFixup; begin with info^ do if ((p1x = 0) and (p2x = 0)) or ((p1x = 255) and (p2x = 255)) then begin p1y := 0; p2y := 255; end; end; begin StopThresholding; DrawLabels('X:', 'Y:', ''); if info^.LUTMode = CustomGrayscale then ResetGrayMap; GetPort(tPort); SetPort(GrayMapWindow); GetMouse(p); if PtInRect(p, gmIcon1) then begin InvertRect(gmIcon1); pressed := true; while Button and pressed do begin GetMouse(p); if not PtInRect(p, gmIcon1) then begin InvertRect(gmIcon1); pressed := false; end; end; repeat until not button; if pressed then begin InvertRect(gmIcon1); ResetGrayMap; SetPort(tPort); exit(DoMouseDownInGrayMap) end; end; if PtInRect(p, gmIcon2) then begin InvertRect(gmIcon2); pressed := true; while Button and pressed do begin GetMouse(p); if not PtInRect(p, gmIcon2) then begin InvertRect(gmIcon2); pressed := false; end; end; repeat until not button; if pressed then begin InvertRect(gmIcon2); with info^ do begin DeltaX := 1; DeltaY := 255; p1x := 128; p1y := 0; p2x := 128; p2y := 255; SetGrayScaleLUT; UpdateGrayMap; end; SetPort(tPort); exit(DoMouseDownInGrayMap) end; end; if PtInRect(p, gmSlide1) then ChangeBrightness; if PtInRect(p, gmSlide2) then ChangeContrast; if p.v > (gmRectBottom + 4) then begin SetPort(tPort); exit(DoMouseDownInGrayMap); end; GetMouse(p); ConvertMouseToXY(p, x, y); if (x <= 24) or (y <= 32) then mode := StartPoint else if (x >= 224) or (y >= 232) then mode := EndPoint else mode := brightness; repeat with info^ do case mode of StartPoint: begin if x > y then y := 0 else x := 0; p1x := x; if p1x > p2x then p2x := p1x; p1y := y; if p1y > p2y then p2y := p1y; DoFixUp; Show2Values(p1x, p1y); end; EndPoint: begin if x > y then x := 255 else y := 255; p2x := x; if p2x < p1x then p1x := p2x; p2y := y; if p2y < p1y then p1y := p2y; DoFixUp; Show2Values(p2x, p2y); end; Brightness: FindEndPoints(x, y); end; {case} UpdateGrayMap; gmFixedSlope := mode = brightness; SetGrayScaleLUT; gmFixedSlope := false; GetMouse(p); ConvertMouseToXY(p, x, y); until not Button; SetPort(tPort); IdentityFunction := false; end; procedure ShowNextWindow; var n: integer; begin n := info^.PicNum + 1; if n > nPics then n := 1; SelectWindow(PicWindow[n]); end; procedure StackWindows; var i, hloc, vloc, wwidth, wheight: integer; offset: boolean; begin hloc := PicLeftBase; vloc := PicTopBase; offset := not OptionKeyDown; for i := nPics downto 1 do begin Info := pointer(WindowPeek(PicWindow[i])^.RefCon); if Info^.PictureType <> ScionType then begin with Info^ do begin HideWindow(wptr); ScaleToFitWindow := false; if offset then wrect := initwrect else begin wwidth := PixelsPerLine; if (hloc + wwidth) > ScreenWidth then wwidth := ScreenWidth - hloc - 5; wheight := nlines; if (vloc + wheight) > ScreenHeight then wheight := ScreenHeight - vloc - 5; SetRect(wrect, 0, 0, wwidth, wheight); end; SrcRect := wrect; KillRoi; magnification := 1.0; if i = nPics then DrawMyGrowIcon(wptr); SizeWindow(wptr, wrect.right, wrect.bottom, true); MoveWindow(wptr, hloc, vloc, true); ShowWindow(wptr); ShowMagnification; end; if offset then begin hloc := hloc + hPicOffset; vloc := vloc + vPicOffset; if (vloc + 40) > ScreenHeight then vloc := PicTopBase; end; end; end; PicLeft := PicLeftBase; PicTop := PicTopBase; WhatToUndo := NothingToUndo; end; procedure TileWindows; const gap = 2; TitleBarHeight = 20; var i, hloc, vloc, width, height, hspace, vspace, nRows, nColumns: integer; MinWidth, MinHeight: integer; tInfo: array[1..MaxPics] of InfoPtr; trect: rect; TheyFit: boolean; begin PicLeft := PicLeftBase; PicTop := PicTopBase; width := MaxInt; height := MaxInt; for i := 1 to nPics do begin tInfo[i] := pointer(WindowPeek(PicWindow[i])^.RefCon); with tinfo[i]^.PicRect do begin if right < width then width := right; if bottom < height then height := bottom; end; end; MinWidth := width; MinHeight := height; hspace := ScreenWidth - PicLeft - 2 * gap; if width > hspace then width := hspace; vspace := ScreenHeight - PicTop - TitleBarHeight; if height > vspace then height := vspace; repeat hloc := PicLeft; vloc := PicTop; TheyFit := true; i := 0; repeat i := i + 1; if (hloc + width) > ScreenWidth then begin hloc := PicLeft; vloc := vloc + TitleBarHeight + height; if (vloc + height) > ScreenHeight then begin TheyFit := false; end; end; hloc := hloc + width + gap; until (TheyFit = false) or (i = nPics); if TheyFit = false then begin width := round(width * 0.98); height := round(height * 0.98); end; until TheyFit; nColumns := (ScreenWidth - PicLeft) div (width + gap); nRows := nPics div nColumns; if (nPics mod nColumns) <> 0 then nRows := nRows + 1; {ShowMessage(concat('nRows= ', Long2str(nRows), cr, 'nColumns= ', long2str(nColumns)));} if not OptionKeyWasDown then begin width := round((ScreenWidth - PicLeft) / nColumns); width := width - gap - 1; height := round((ScreenHeight - PicTop) / nRows); height := height - TitleBarHeight + 3; if width > MinWidth then width := MinWidth; if height > MinHeight then height := MinHeight; end; hloc := PicLeft; vloc := PicTop; for i := 1 to nPics do begin if (hloc + width) > ScreenWidth then begin hloc := PicLeft; vloc := vloc + TitleBarHeight + height; end; Info := tInfo[i]; if Info^.PictureType <> ScionType then begin with Info^ do begin SetRect(wrect, 0, 0, width, height); if ScaleToFitWindow then begin ScaleToFitWindow := false; SrcRect := wrect; magnification := 1; WindowState := NormalWindow; end; if OptionKeyWasDown then begin ScaleToFitWindow := true; SrcRect := PicRect; ScaleImageWindow(wrect); WindowState := TiledSmallScaled; end else begin SrcRect := wrect; magnification := 1.0; ShowMagnification; WindowState := TiledSmall; end; SizeWindow(wptr, wrect.right, wrect.bottom, true); KillRoi; UpdatePicWindow; end; MoveWindow(PicWindow[i], hloc, vloc, true); hloc := hloc + width + gap; end; end; {for} WhatToUndo := NothingToUndo; end; procedure DrawLabels (xL, yL, zL: str255); {Draws the labels(e.g., X:, Y:, Value:) used for the dynamically} {changing values displayed at the top of the Results window.} var tPort: GrafPtr; trect: rect; savePt: point; { Arlo } begin if xL = XLabel then if yL = yLabel then if zL = zLabel then exit(DrawLabels); GetPort(tPort); SetPort(ResultsWindow); TextSize(9); TextFont(Monaco); TextFace([bold]); if length(xL) > 0 then begin xLabel := xL; xValueLoc := ValuesHStart + StringWidth(xLabel); yLabel := yL; {$IFC Arlo } if yLabel = 'theta' then yValueLoc := ValuesHStart + StringWidth('0:') else yValueLoc := ValuesHStart + StringWidth(yLabel); {$ELSEC } yValueLoc := ValuesHStart + StringWidth(yLabel); {$ENDC } zLabel := zL; zValueLoc := ValuesHStart + StringWidth(zLabel); end; Setrect(trect, 0, 0, rwidth, 32); EraseRect(trect); MoveTo(ValuesHStart, ValuesVStart); DrawString(xLabel); MoveTo(ValuesHStart, ValuesVStart + 10); {$IFC Arlo } if yLabel = 'theta' then begin GetPen(savePt); DrawString('0'); TextMode(srcOr); MoveTo(savePt.h, savePt.v); DrawString('-:'); TextMode(srcCopy); end else DrawString(yLabel); {$ELSEC } DrawString(yLabel); {$ENDC } MoveTo(ValuesHStart, ValuesVStart + 19); DrawString(zLabel); TextFace([]); SetPort(tPort); end; function Duplicate (SavingBlankField: boolean): boolean; var name: str255; width, height, hstart, vstart, i: integer; SaveInfo: InfoPtr; src, dst: ptr; offset: LongInt; AutoSelectAll: boolean; begin Duplicate := false; WhatToUndo := NothingToUndo; if (not SavingBlankField) and (NotRectangular or NotinBounds) then exit(Duplicate); AutoSelectAll := (not Info^.RoiShowing) or SavingBlankField; if AutoSelectAll then SelectAll(false); ShowWatch; with info^ do begin if SavingBlankField then name := 'Blank Field' else begin name := concat('Copy of ', title); if length(name) > 32 then delete(name, 33, length(name) - 32); end; with osroiRect do begin width := right - left; if odd(width) and (left + width < PicRect.right) then width := Width + 1; height := bottom - top; hstart := left; vstart := top; end; end; if AutoSelectAll then KillRoi; SaveInfo := Info; if NewPicWindow(name, width, height) then with SaveInfo^ do begin offset := LongInt(vstart) * BytesPerRow + hstart; src := ptr(ord4(PicBaseAddr) + offset); dst := Info^.PicBaseAddr; for i := 0 to height - 1 do begin BlockMove(src, dst, width); src := ptr(ord4(src) + BytesPerRow); dst := ptr(ord4(dst) + width); end; if SavingBlankField then begin Info^.PIctureType := BlankField; BlankFieldInfo := info; end; Duplicate := true; end; {with} end; procedure InvertPic; var tPort: GrafPtr; begin GetPort(tPort); with Info^ do begin SetPort(GrafPtr(osPort)); InvertRect(PicRect); end; SetPort(tPort); end; procedure ShowMessage (str: str255); begin ResultsMessage := str; ShowResults; end; procedure ShowTime (StartTicks: LongInt; r: rect); var nPixels: LongInt; str1, str2, str3: str255; seconds, rate: extended; begin with r do nPixels := LongInt(right - left) * (bottom - top); NumToString(nPixels, str1); seconds := (TickCount - StartTicks) / 60.0; RealToString(seconds, 1, 2, str2); if seconds <> 0.0 then rate := nPixels / seconds else rate := 0.0; NumToString(round(rate), str3); ShowMessage(concat(str1, ' pixels ', cr, str2, ' seconds', cr, str3, ' pixels/second')); end; procedure ShowFrameRate (str1: str255; StartTicks, nFrames: LongInt); var seconds: extended; str2: str255; begin seconds := (TickCount - StartTicks) / 60.0; if seconds = 0.0 then seconds := 0.167; RealToString(nFrames / seconds, 1, 2, str2); ShowMessage(concat(str1, str2, ' frames/second')); end; function long2str (num: LongInt): str255; var str: str255; begin NumToString(num, str); long2str := str; end; procedure ConvertHistoToText; var i: integer; ValuesInverted: boolean; begin ValuesInverted := InvertingCalibrationFunction; TextBufSize := 0; for i := 0 to 255 do begin if ValuesInverted then PutLong(Histogram[255 - i], 1) else PutLong(Histogram[i], 1); if i <> 255 then PutChar(cr); end; end; procedure ConvertPlotToText; var i: integer; begin TextBufSize := 0; for i := 0 to PlotCount - 1 do begin if info^.calibrated then PutReal(value[PlotData[i]], 1, 3) else PutLong(PlotData[i], 1); if i <> PlotCount then PutChar(cr); end; end; procedure ConvertCalibrationCurveToText; var i: integer; begin TextBufSize := 0; for i := 0 to 255 do begin PutReal(value[i], 1, 3); if i <> 255 then PutChar(cr); end; end; procedure SetupUndoInfoRec; {Initialize the Undo buffer's Info record so we can copy} {the current image to the Undo buffer and operate on it.} begin with UndoInfo^ do begin PixelsPerLine := info^.PixelsPerLine; BytesPerRow := info^.PixelsPerLine; nLines := Info^.nLines; PixMapSize := info^.PicSize; RoiRect := info^.roiRect; osroiRect := info^.osroiRect; CopyRgn(Info^.osRoiRgn, osRoiRgn); roiType := Info^.roiType; PicRect := Info^.PicRect; with osPort^ do begin with portPixMap^^ do begin RowBytes := BitOr(PixelsPerLine, $8000); bounds := PicRect; end; PortRect := PicRect; RectRgn(visRgn, PicRect); end; end; end; end.