unit Edit; {Editing routines used by the Image program} interface uses QuickDraw, OSIntf, PrintTraps, PickerIntf, ToolIntf, globals, Utilities, Graphics, Camera; procedure FlipOrRotate (DoWhat: FlipRotateType); procedure DoCopy; procedure DoCut; procedure DoPaste; procedure DoClear; procedure ScaleSelection; procedure RotateAndScale; procedure DoMouseDownInPasteControl (loc: point); procedure ShowPasteControl; procedure DrawPasteControl; procedure ShowClipboard; procedure DoObject (obj: ObjectType; event: EventRecord); procedure DoAirBrush; procedure DoBrush (event: EventRecord); procedure DoText (loc: point); procedure SetAirbrushSize; procedure SetBrushSize; procedure EditColor; procedure ConvertClipboard; procedure DeZoom; procedure Zoom (event: EventRecord); procedure Scroll (event: EventRecord); procedure DoFill (event: EventRecord); procedure EditThresholdColor; procedure EditExtraColors (entry: integer); procedure DoGrow (WhichWindow: WindowPtr; event: EventRecord); procedure DrawCharacter (ch: char); procedure ConvertSystemClipboard; function RgnNotTooBig (Rgn1, Rgn2: RgnHandle): boolean; procedure SetupOperation (item: integer); procedure FindWhatToCopy; { exported for UpdateEditMenu - moved to Functions.p (Arlo) } implementation procedure PivotSelection (var SelectionRect: rect; WindowRect: rect); var OldWidth, NewWidth, OldHeight, NewHeight, hCenter, vCenter, NewLeft, NewTop: integer; begin with SelectionRect do begin OldWidth := right - left; OldHeight := bottom - top; hCenter := left + OldWidth div 2; vCenter := top + OldHeight div 2; end; NewWidth := OldHeight; NewHeight := OldWidth; NewLeft := hCenter - NewWidth div 2; NewTop := vCenter - NewHeight div 2; with WindowRect do begin if (NewLeft + NewWidth) > right then NewLeft := right - NewWidth; if (NewTop + NewHeight) > bottom then NewTop := bottom - NewHeight; if NewLeft < 0 then NewLeft := 0; if NewTop < 0 then NewTop := 0; end; with SelectionRect do begin left := NewLeft; top := NewTop; right := NewLeft + NewWidth; bottom := NewTop + NewHeight; end; end; procedure FlipLine (var LineBuf: LineType; width: integer); var TempLine: LineType; i, WidthLessOne: integer; begin TempLine := LineBuf; WidthLessOne := width - 1; for i := 0 to width - 1 do LineBuf[i] := TempLine[WidthLessOne - i]; end; procedure FlipOrRotate; {(DoWhat: FlipRotateType)} var SaveInfo: InfoPtr; width, height, hDst, vSrc, vDst, hSrc, i, inc: integer; LineBuf: LineType; srect, drect, MaskRect: rect; PixelCount: LongInt; AutoSelectAll: boolean; begin if NotRectangular or NotInBounds or (UndoBuf = nil) then exit(FlipOrRotate); if Info^.PicSize > ClipBufSize then begin beep; exit(FlipOrRotate) end; StopDigitizing; AutoSelectAll := not Info^.RoiShowing; if AutoSelectAll then SelectAll(true); ShowWatch; if (DoWhat = RotateLeft) or (DoWhat = RotateRight) then WhatToUndo := UndoRotate else WhatToUndo := UndoFlip; SetupUndoFromClip; SetupUndo; SetupUndoInfoRec; SaveInfo := Info; srect := info^.osroirect; PixelCount := 0; case DoWhat of RotateLeft, RotateRight: with srect do begin if OptionKeyDown then DoOperation(EraseOp); drect := srect; with info^ do begin PivotSelection(drect, PicRect); MaskRect := drect; OffscreenToScreenRect(MaskRect); roiRect := MaskRect; osroiRect := drect; RectRgn(osRoiRgn, osRoiRect); end; width := right - left; if DoWhat = RotateLeft then begin hDst := drect.left; inc := 1 end else begin hDst := drect.right - 1; inc := -1 end; for vSrc := top to bottom - 1 do begin Info := UndoInfo; GetLine(left, vSrc, width, LineBuf); if DoWhat = RotateLeft then FlipLine(LineBuf, width); Info := SaveInfo; PutColumn(hDst, drect.top, width, LineBuf); hDst := hDst + inc; PixelCount := PixelCount + width; if PixelCount > 10000 then begin UpdateScreen(MaskRect); PixelCount := 0; end; end; end; FlipVertical: with srect do begin MaskRect := srect; OffscreenToScreenRect(MaskRect); width := right - left; vDst := bottom; for vSrc := top to bottom - 1 do begin Info := UndoInfo; GetLine(left, vSrc, width, LineBuf); Info := SaveInfo; vDst := vDst - 1; PutLine(left, vDst, width, LineBuf); end; end; FlipHorizontal: with srect do begin MaskRect := srect; OffscreenToScreenRect(MaskRect); width := right - left; for vSrc := top to bottom - 1 do begin Info := UndoInfo; GetLine(left, vSrc, width, LineBuf); FlipLine(LineBuf, width); Info := SaveInfo; PutLine(left, vSrc, width, LineBuf); PixelCount := PixelCount + width; if PixelCount > 10000 then begin UpdateScreen(MaskRect); PixelCount := 0; end; end; end; end; {case} Info := SaveInfo; with info^ do begin UpdatePicWindow; changes := true; end; SetupRoiRect; if AutoSelectAll then KillRoi; end; procedure CopyImage; var err: LongInt; line: integer; begin with info^ do begin if PicSize > ClipBufSize then begin beep; WhatsOnClip := Nothing; exit(CopyImage) end; SetupUndo; BlockMove(PicBaseAddr, ClipBuf, PicSize); end; with ClipBufInfo^ do begin PixelsPerLine := info^.PixelsPerLine; BytesPerRow := info^.PixelsPerLine; nLines := Info^.nLines; RoiRect := info^.roiRect; osroiRect := info^.osroiRect; roiType := Info^.roiType; PicRect := Info^.PicRect; with osPort^.portPixMap^^ do begin RowBytes := BitOr(PixelsPerLine, $8000); bounds := PicRect; end; with osPort^ do begin PortRect := PicRect; RectRgn(visRgn, PicRect); end; if RoiType = RectRoi then WhatsOnClip := RectPic else WhatsOnClip := NonRectPic; if (info^.PictureType = QuickCaptureType) and (PasteMode = LiveSelection) then PasteMode := PasteFromCamera else PasteMode := NormalPaste; CopyRgn(info^.osroiRgn, osroiRgn); end; end; procedure CopyWindow; var tPort: GrafPtr; WindowSize: LongInt; WindowRect: rect; WhichWindow: WindowPtr; kind: integer; begin WhichWindow := FrontWindow; WindowRect := WhichWindow^.PortRect; kind := WindowPeek(WhichWindow)^.WindowKind; with WindowRect do WindowSize := LongInt(right) * bottom; if kind = LUTKind then WindowRect.bottom := 256; case kind of ProfilePlotKind: begin ConvertPlotToText; ClipTextInBuffer := true; end; CalibrationPlotKind: begin ConvertCalibrationCurveToText; ClipTextInBuffer := true; end; HistoKind: begin ConvertHistoToText; ClipTextInBuffer := true; end; otherwise end; if (kind = ProfilePlotKind) or (kind = CalibrationPlotKind) then begin Copying := true; DrawPlot; {Draw without grow box} Copying := false; end; if WindowSize > ClipBufSize then begin beep; WhatsOnClip := Nothing; exit(CopyWindow) end; ClipboardConverted := false; with ClipBufInfo^ do begin RoiType := RectRoi; RoiRect := WindowRect; osRoiRect := WindowRect; RectRgn(osroiRgn, osroiRect); PicRect := WindowRect; PixelsPerLine := WindowRect.right; BytesPerRow := PixelsPerLine; nLines := WindowRect.bottom; with osPort^.portPixMap^^ do begin RowBytes := BitOr(WindowRect.right, $8000); bounds := WindowRect; end; with osPort^ do begin PortRect := PicRect; RectRgn(visRgn, PicRect); end; WhatsOnClip := RectPic; PasteMode := NormalPaste; GetPort(tPort); SetPort(GrafPtr(osPort)); RGBForeColor(BlackRGB); RGBBackColor(WhiteRGB); hlock(handle(osPort^.portPixMap)); CopyBits(WhichWindow^.PortBits, BitMapHandle(osPort^.portPixMap)^^, WindowRect, WindowRect, SrcCopy, nil); hunlock(handle(osPort^.portPixMap)); SetPort(tPort); end; {with} end; procedure DoCopy; var err: OSErr; begin err := ZeroScrap; OldScrapCount := GetScrapCount; case WhatToCopy of CopyColor: begin ClipColorIndex := CurrentColorIndex; WhatsOnClip := AColor; ClipTextInBuffer := false; end; CopySelection: begin CopyImage; ClipTextInBuffer := false; ClipboardConverted := false; end; CopyHistogram, CopyPlot, CopyCalibrationPlot, CopyCLUT, CopyGrayMap: CopyWindow; CopyRegions, CopyLengths, CopyPoints: begin CopyResultsToBuffer; ClipTextInBuffer := true; WhatsOnClip := TextOnClip; end; otherwise beep; end; end; procedure DoCut; begin WhatToCopy := CopySelection; DoCopy; DoClear; end; procedure PasteColor; begin with info^ do if (CurrentTool = PickerTool) and (LUTMode = PseudoColor32) then begin RedX[CurrentColorIndex] := RedX[ClipColorIndex]; GreenX[CurrentColorIndex] := GreenX[ClipColorIndex]; BlueX[CurrentColorIndex] := BlueX[ClipColorIndex]; UpdateColors; end else beep; end; procedure CenterRect (inRect, outRect: rect; var ResultRect: rect); var width, height, hcenter, vcenter: integer; begin with inRect do begin width := right - left; height := bottom - top; end; with outRect do begin hcenter := left + (right - left) div 2; vcenter := top + (bottom - top) div 2; end; with ResultRect do begin left := hcenter - width div 2; top := vcenter - height div 2; right := left + width; bottom := top + height; end; end; procedure PastePicture; var loc: point; width, height, osroiHeight, SrcHeight, PicHeight, dh, dv: integer; begin if PasteTransferMode <> SrcCopy then begin PasteTransferMode := SrcCopy; if PasteControl <> nil then DrawPasteControl end; with info^ do begin WhatToUndo := UndoPaste; SetupUndo; if RoiShowing then with RoiRect do {Pasting back into selection of same size?} if ((right - left) = (ClipBufInfo^.RoiRect.right - ClipBufInfo^.RoiRect.left)) and ((bottom - top) = (ClipBufInfo^.RoiRect.bottom - ClipBufInfo^.RoiRect.top)) and (ClipBufInfo^.RoiType = RoiType) then begin OpPending := true; CurrentOp := PasteOp; exit(PastePicture) end; with ClipBufInfo^.osroiRect do {Pasting into same size window?} if (PicRect.right = right - left) and (PicRect.bottom = (bottom - top)) and (ClipBufInfo^.RoiType = RectRoi) then begin SelectAll(true); OpPending := true; CurrentOp := PasteOp; exit(PastePicture) end; if RoiShowing or (roiType <> NoRoi) then KillRoi; CenterRect(ClipBufInfo^.osroiRect, SrcRect, osroiRect); with osroiRect do begin osroiHeight := bottom - top; with srcRect do srcHeight := bottom - top; with PicRect do PicHeight := bottom - top; if (osroiHeight > SrcHeight) and (osroiHeight < PicHeight) and (magnification = 1.0) then begin top := 0; bottom := osroiHeight; end; end; roiRect := osroiRect; OffscreenToScreenRect(roiRect); roiType := ClipBufInfo^.roiType; CopyRgn(ClipBufInfo^.osRoiRgn, osRoiRgn); dh := osRoiRect.left - osRoiRgn^^.rgnbbox.left; dv := osRoiRect.top - osRoiRgn^^.rgnbbox.top; OffsetRgn(osroiRgn, dh, dv); RoiShowing := true; OpPending := true; CurrentOp := PasteOp; if PasteMode = PasteFromCamera then ResetQuickCapture; BinaryPic := false; end;{with} end; procedure ConvertSystemClipboard; {Converts system scrape to local scrape.} var phandle: handle; offset, length, size: LongInt; pframe: rect; width, height: integer; tPort: GrafPtr; ScrapInfo: PScrapStuff; begin ScrapInfo := InfoScrap; if ScrapInfo^.ScrapSize <= 0 then exit(ConvertSystemClipboard); phandle := NewHandle(0); length := GetScrap(phandle, 'PICT', offset); if length > 0 then begin ShowWatch; pframe := PicHandle(phandle)^^.PicFrame; with pframe do begin width := right - left; height := bottom - top; size := LongInt(width) * height; if size > ClipBufSize then begin PutMessage('Sorry, but this image is too large to paste.'); DisposHandle(phandle); exit(ConvertSystemClipboard) end; end; with ClipBufInfo^ do begin PixelsPerLine := width; nlines := height; SetRect(PicRect, 0, 0, width, height); osroiRect := PicRect; RectRgn(osroiRgn, osRoiRect); RoiType := Rectroi; GetPort(tPort); SetPort(GrafPtr(osPort)); BytesPerRow := PixelsPerLine; with osPort^.portPixMap^^ do begin RowBytes := BitOr(PixelsPerLine, $8000); bounds := PicRect; end; with CGrafPort(osPort^) do begin PortRect := PicRect; RectRgn(visRgn, PicRect); SetRectRgn(ClipRgn, 0, 0, 30000, 30000); end; RGBForecolor(WhiteRGB); PaintRect(PicRect); DrawPicture(PicHandle(phandle), PicRect); SetPort(tPort); end; {with} WhatsOnClip := ImportedPic; PasteMode := NormalPaste end else begin length := GetScrap(phandle, 'TEXT', offset); if (length > 0) and (length < MaxTextBufSize) then begin hlock(phandle); BlockMove(phandle^, ptr(TextBufP), length); hunlock(phandle); TextBufSize := length; WhatsOnClip := TextOnClip; PasteMode := NormalPaste end; end; DisposHandle(phandle); end; procedure PasteText; var tPort: GrafPtr; nTextLines, LineWidth, MaxLineWidth, MaxRectWidth, MaxRectHeight: integer; LineStart, LineEnd, height: integer; begin if TextBufSize > 5000 then begin PutMessage('The maximum number of characters that can be pasted is 5000.'); exit(PasteText); end; if info^.PicSize > ClipBufSize then begin beep; exit(PasteText); end; GetPort(tPort); with ClipBufInfo^ do begin SetPort(GrafPtr(osPort)); RGBForeColor(BlackRGB); RGBBackColor(WhiteRGB); TextFont(CurrentFontID); TextFace(CurrentStyle); TextSize(CurrentSize); end; with info^ do begin if not RoiShowing then begin nTextLines := 1; MaxLineWidth := 10; LineStart := 1; LineEnd := 0; repeat LineEnd := LineEnd + 1; if TextBufP^[LineEnd] = CR then begin nTextLines := nTextLines + 1; LineWidth := TextWidth(ptr(TextBufP), LineStart - 1, LineEnd - LineStart); if LineWidth > MaxLineWidth then MaxLineWidth := LineWidth; LineStart := LineEnd; end; until LineEnd >= TextBufSize; if LineEnd > LineStart then begin LineWidth := TextWidth(ptr(TextBufP), LineStart - 1, LineEnd - LineStart); if LineWidth > MaxLineWidth then MaxLineWidth := LineWidth; end; height := nTextLines * CurrentSize + CurrentSize div 4; MaxRectHeight := (PicRect.bottom * 2) div 3; if height > MaxRectHeight then height := MaxRectHeight; MaxLineWidth := MaxLineWidth + CurrentSize div 2; MaxRectWidth := (PicRect.right * 2) div 3; if MaxLineWidth > MaxRectWidth then begin MaxLineWidth := MaxRectWidth; height := MaxRectHeight; end; with osroiRect do begin left := 0; top := 0; right := MaxLineWidth; bottom := height; end; roiRect := osroiRect; RoiType := RectRoi; OffscreenToScreenRect(roiRect); MakeRegion; end; CopyImage; WhatsOnClip := TextOnClip; end; SetRectRgn(ClipBufInfo^.osPort^.ClipRgn, 0, 0, 30000, 30000); {Why is this needed?} TextBox(ptr(TextBufP), TextBufSize, ClipBufInfo^.osroiRect, TextJust); SetPort(tPort); PastePicture; end; procedure DoPaste; var NewScrapCount: integer; begin if (info = NoInfo) and (WhatsOnClip <> aColor) then begin PutMessage('You must have an image window open in order to paste.'); exit(DoPaste); end; RoiUpdateTime := 0; NewScrapCount := GetScrapCount; if NewScrapCount <> OldScrapCount then begin WhatsOnClip := Nothing; OldScrapCount := NewScrapCount; end; case WhatsOnClip of AColor: PasteColor; RectPic, NonRectPic, ImportedPic: PastePicture; TextOnClip: PasteText; Nothing: begin ConvertSystemClipboard; if WhatsOnClip = ImportedPic then PastePicture else if WhatsOnClip = textOnClip then PasteText else beep; end; end; end; procedure EditExtraColors; {(entry: integer)} var where: point; inRGBColor, OutRGBColor: RGBColor; begin if (entry <> WhiteIndex) and (entry <> BlackIndex) then begin inRGBColor := ExtraColors[entry]; outRGBColor := inRGBColor; where.h := 0; where.v := 0; InitCursor; if GetColor(where, 'Pick a color, any color...', inRGBColor, outRGBColor) then with info^ do begin ExtraColors[entry] := OutRGBColor; changes := true; LoadLUT(cTable); end end else PutMessage('Sorry, but you can not edit white or black.'); end; procedure DoClear; begin if not NoSelection then begin WhatToUndo := UndoClear; SetupUndo; CurrentOp := EraseOp; OpPending := true; RoiUpdateTime := 0; end; end; procedure ScaleSelection; var percent, i, j, NewWidth, NewHeight: integer; scale: extended; begin if NoSelection or NotRectangular or NotInBounds then exit(ScaleSelection); if OpPending then begin OpPending := false; DoOperation(CurrentOp); end; WhatToCopy := CopySelection; DoCopy; percent := GetInt('Percent Magnification(10-1000):', 50); if (percent >= 10) and (percent <= 1000) then begin scale := percent / 100.0; DoOperation(EraseOp); UpdatePicWindow; info^.RoiShowing := true; PasteTransferMode := SrcCopy; if PasteControl <> nil then DrawPasteControl; DoPaste; with info^.osroiRect do begin NewWidth := round((right - left) * scale); NewHeight := round((bottom - top) * scale); left := left + (right - left - NewWidth) div 2; top := top + (bottom - top - NewHeight) div 2; right := left + NewWidth; bottom := top + NewHeight; end; with info^ do begin RectRgn(osroiRgn, osroiRect); RoiRect := osroiRect; OffscreenToScreenRect(RoiRect); end; UndoFromClip := true; WhatsOnClip := nothing; WhatToUndo := UndoScale; end; end; procedure GetAngleAndScale (var angle, hscale, vscale: extended); const AngleID = 3; hScaleID = 4; vScaleID = 5; var mylog: DialogPtr; item, i: integer; begin InitCursor; mylog := GetNewDialog(50, nil, pointer(-1)); angle := 45.0; hscale := 1.0; vscale := 1.0; SetDReal(MyLog, AngleID, angle, 1); SelIText(MyLog, AngleID, 0, 32767); SetDReal(MyLog, hScaleID, hscale, 1); SetDReal(MyLog, vScaleID, vscale, 1); OutlineButton(MyLog, ok, 16); repeat ModalDialog(nil, item); if item = AngleID then begin angle := GetDReal(MyLog, AngleID); if angle > 180.0 then angle := 180.0; if angle < -180.0 then angle := -180.0; end; if item = hScaleID then begin hscale := GetDReal(MyLog, hScaleID); if hscale > 10.0 then hscale := 100.0; if hscale < 0.1 then hscale := 0.1; end; if item = vScaleID then begin vscale := GetDReal(MyLog, vScaleID); if vscale > 10.0 then vscale := 10.0; if vscale < 0.1 then vscale := 0.1; end; until (item = ok) or (item = cancel); DisposDialog(mylog); if item = cancel then hscale := 0; end; procedure RotateAndScale; const pi = 3.14159; type radians = real; EraseType = (Erase, DontErase); var angle, CosAngle, SinAngle, htemp, vtemp, h, v, hscale, vscale: extended; hloc, vloc, value, width, height, hstart, vstart, hend, vend: integer; hfraction, vfraction, UpperAverage, LowerAverage: extended; LowerLeft, LowerRight, UpperLeft, UpperRight, hCenter, vCenter: integer; hRel, vRel, hbase, vbase, OldWidth, OldHeight: integer; SaveInfo: InfoPtr; AutoSelectAll, UseNearestNeighbor, DoScaling: boolean; MaskRect: rect; StartTicks: LongInt; begin if NotRectangular or NotInBounds then exit(RotateAndScale); with info^ do if (PicSize > ClipBufSize) or (PicSize > UndoBufSize) then begin beep; exit(RotateAndScale) end; StopDigitizing; with info^ do UseNearestNeighbor := OptionKeyDown or (LutMode = custom) or (LutMode = AppleDefault); GetAngleAndScale(angle, hscale, vscale); if hscale = 0.0 then exit(RotateAndScale); UpdatePicWindow; DrawTools; AutoSelectAll := not Info^.RoiShowing; if AutoSelectAll then SelectAll(true); ShowWatch; WhatToUndo := UndoRotate; SetupUndoFromClip; SetupUndo; SetupUndoInfoRec; SaveInfo := Info; angle := -((angle + 270.0) / 360.0) * 2.0 * pi; CosAngle := cos(angle); SinAngle := sin(angle); with info^.osroiRect, info^ do begin width := right - left; height := bottom - top; hCenter := left + (width div 2); vCenter := top + (height div 2); if hscale <> 1.0 then begin OldWidth := width; width := round(width * hscale); if width > PicRect.right then width := PicRect.right; left := left - (width - OldWidth) div 2; if left < 0 then left := 0; if (left + width) > PicRect.right then width := PicRect.right - left; right := left + width; roiRect := osRoiRect; OffscreenToScreenRect(roiRect); RectRgn(osRoiRgn, osRoiRect); end; if vscale <> 1.0 then begin OldHeight := height; height := round(height * vscale); if height > PicRect.bottom then height := PicRect.bottom; top := top - (height - OldHeight) div 2; if top < 0 then top := 0; if (top + height) > PicRect.bottom then height := PicRect.bottom - top; bottom := top + height; roiRect := osRoiRect; OffscreenToScreenRect(roiRect); RectRgn(osRoiRgn, osRoiRect); end; hStart := left; vStart := top; hend := hstart + width - 1; vend := vstart + height - 1; end; DoScaling := (hscale <> 0.0) or (vscale <> 0.0); ShowMessage('Command-Period to cancel'); StartTicks := TickCount; for vloc := vStart to vEnd do begin for hloc := hStart to hEnd do begin hrel := hloc - hCenter; vrel := vloc - vCenter; htemp := hrel * SinAngle + vrel * CosAngle; vtemp := vrel * SinAngle - hrel * CosAngle; if DoScaling then begin htemp := htemp / hscale; vtemp := vtemp / vscale; end; h := htemp + hCenter; v := vtemp + vCenter; info := UndoInfo; if UseNearestNeighbor then value := MyGetPixel(round(h), round(v)) else begin {Use bilinear interpolation} hbase := trunc(h); vbase := trunc(v); hFraction := h - hbase; vFraction := v - vbase; LowerLeft := MyGetPixel(hbase, vbase); LowerRight := MyGetPixel(hbase + 1, vbase); UpperRight := MyGetPixel(hbase + 1, vbase + 1); UpperLeft := MyGetPixel(hbase, vbase + 1); UpperAverage := UpperLeft + hfraction * (UpperRight - UpperLeft); LowerAverage := LowerLeft + hfraction * (LowerRight - LowerLeft); value := round(LowerAverage + vfraction * (UpperAverage - LowerAverage)); end; Info := SaveInfo; PutPixel(hloc, vloc, value); end; SetRect(MaskRect, hstart, vloc, hend, vloc + 1); OffscreenToScreenRect(MaskRect); UpdateScreen(MaskRect); if CommandPeriod then begin UpdateScreen(info^.roiRect); beep; SetupRoiRect; if AutoSelectAll then KillRoi; exit(RotateAndScale) end; end; with info^ do begin ShowTime(StartTicks, osroiRect); changes := true; end; SetupRoiRect; if AutoSelectAll then KillRoi; end; procedure DoMath; const PixelsPerUpdate = 15000; var nrows, ncols, hSrcStart, vSrcStart, hDstStart, vDstStart: integer; SaveInfo: InfoPtr; h, v, vDst, PixelCount, offset: integer; Src, Dst: LineType; tmp, range, min, max, StartTicks: LongInt; x, xmax, xmin, xrange, xscale: extended; begin ShowWatch; OpPending := false; WhatToUndo := UndoPaste; KillRoi; with info^.osroiRect do begin ncols := right - left; nrows := bottom - top; hDstStart := left; vDstStart := top; end; with ClipBufInfo^.osroiRect do begin hSrcStart := left; vSrcStart := top; end; if hDstStart < 0 then begin offset := -hDstStart; hDstStart := 0; hSrcStart := hSrcStart + offset; ncols := ncols - offset; end; if vDstStart < 0 then begin offset := -vDstStart; vDstStart := 0; vSrcStart := vSrcStart + offset; nrows := nrows - offset; end; with info^.PicRect do begin if hDstStart + ncols > right then ncols := right - hDstStart; if vDstStart + nrows > bottom then nrows := bottom - vDstStart; end; SaveInfo := info; vDst := vDstStart; min := 999999; max := -999999; xmin := 999999.0; xmax := -999999.0; StartTicks := TickCount; {First pass to find result range} if ScaleArithmetic then begin for v := vSrcStart to vSrcStart + nRows - 1 do begin Info := ClipBufInfo; GetLine(hSrcStart, v, nCols, Src); Info := SaveInfo; GetLine(hDstStart, vDst, nCols, Dst); case CurrentOp of AddOp: begin for h := 0 to nCols - 1 do begin tmp := Src[h] + Dst[h]; if tmp > max then max := tmp; if tmp < Min then min := tmp; end; end; SubtractOp: begin for h := 0 to nCols - 1 do begin tmp := Dst[h] - Src[h]; if tmp > max then max := tmp; if tmp < Min then min := tmp; end; end; MultiplyOp: begin for h := 0 to nCols - 1 do begin tmp := LongInt(Dst[h]) * Src[h]; if tmp > max then max := tmp; if tmp < min then min := tmp; end; end; DivideOp: begin for h := 0 to nCols - 1 do begin tmp := Src[h]; if tmp = 0 then tmp := 1; x := Dst[h] / tmp; if x > xmax then begin xmax := x; end; if x < xmin then xmin := x; end; end; end; vDst := vDst + 1; end; vDst := vDstStart; if CurrentOp = DivideOp then begin xrange := xmax - xmin; if xrange <> 0.0 then xscale := 256.0 / xrange else xscale := 1; end else range := max - min; end; {if ScaleArithmetic=true} PixelCount := 0; {Second pass to do arithmetic and scaling} for v := vSrcStart to vSrcStart + nRows - 1 do begin Info := ClipBufInfo; GetLine(hSrcStart, v, nCols, Src); Info := SaveInfo; GetLine(hDstStart, vDst, nCols, Dst); case CurrentOp of AddOp: if ScaleArithmetic then for h := 0 to nCols - 1 do begin tmp := Dst[h] + Src[h] - min; if range <> 0 then tmp := tmp * 256 div range else tmp := BackgroundIndex; if tmp > 255 then dst[h] := 255 else dst[h] := tmp; end else for h := 0 to nCols - 1 do begin tmp := Dst[h] + Src[h]; if tmp > 255 then dst[h] := 255 else dst[h] := tmp; end; SubtractOp: if ScaleArithmetic then for h := 0 to nCols - 1 do begin tmp := Dst[h] - Src[h] - min; if range <> 0 then tmp := tmp * 256 div range else tmp := BackgroundIndex; if tmp > 255 then dst[h] := 255 else dst[h] := tmp; end else for h := 0 to nCols - 1 do begin tmp := Dst[h] - Src[h]; if tmp < 0 then dst[h] := 0 else dst[h] := tmp; end; MultiplyOp: if ScaleArithmetic then for h := 0 to nCols - 1 do begin tmp := LongInt(Dst[h]) * Src[h] - min; if range <> 0 then tmp := tmp * 256 div range else tmp := BackgroundIndex; if tmp > 255 then dst[h] := 255 else dst[h] := tmp; end else for h := 0 to nCols - 1 do begin tmp := LongInt(Dst[h]) * Src[h]; if tmp > 255 then dst[h] := 255 else dst[h] := tmp; end; DivideOp: if ScaleArithmetic then for h := 0 to nCols - 1 do begin tmp := Src[h]; if tmp = 0 then tmp := 1; x := Dst[h] / tmp - xmin; if xrange <> 0.0 then tmp := trunc(x * xscale) else tmp := BackgroundIndex; if tmp > 255 then tmp := 255; if tmp < 0 then tmp := 0; dst[h] := tmp; end else for h := 0 to nCols - 1 do begin tmp := Src[h]; if tmp = 0 then tmp := 1; dst[h] := Dst[h] div tmp; end; end; PutLine(hDstStart, vDst, nCols, Dst); vDst := vDst + 1; PixelCount := PixelCount + ncols; if PixelCount > PixelsPerUpdate then begin UpdateScreen(info^.roiRect); if CommandPeriod then begin UpdateScreen(info^.roiRect); beep; exit(DoMath) end; PixelCount := 0; end; end; with info^ do begin ShowTime(StartTicks, osroiRect); UpdateScreen(RoiRect); end; end; procedure DoMouseDownInPasteControl; {(loc:point)} var tPort, tPort2: GrafPtr; nItem, i: integer; BlendColor: rgbColor; procedure InvertItem; begin with pcItem[nitem] do if iType = pcButton then InvertRoundRect(r, 6, 6) else InvertOval(r); end; begin if not (OpPending and (CurrentOp = PasteOp)) then begin PutMessage('Paste Control is only available during paste operations.'); exit(DoMouseDownInPasteControl); end; GetPort(tPort); SetPort(PasteControl); GlobalToLocal(loc); nItem := 0; for i := 1 to npcItems do if PtInRect(loc, pcItem[i].r) then nitem := i; if nItem > 0 then begin InvertItem; while Button and (nitem > 0) do begin GetMouse(loc); if not PtInRect(loc, pcItem[nitem].r) then begin InvertItem; nItem := 0; end; end; end; repeat until not button; if nItem > 0 then with pcItem[nitem] do begin InvertItem; if (nItem > 1) and (nItem < 5) then begin SetForegroundColor(BlackIndex); SetBackGroundColor(WhiteIndex); end; case nItem of 1: PasteTransferMode := SrcCopy; 2: PasteTransferMode := NotSrcBic; {And} 3: if OptionKeyDown then PasteTransferMode := SrcXor else PasteTransferMode := SrcOr; 4: if OptionKeyDown then begin GetPort(tPort2); with BlendColor do begin red := 32767; blue := 32767; green := 32767; end; SetPort(GrafPtr(info^.osPort)); OpColor(BlendColor); SetPort(tPort2); PasteTransferMode := blend; end else PasteTransferMode := Transparent; 5, 6, 7, 8: if info^.RoiType = RectRoi then begin case nitem of 5: CurrentOp := AddOp; 6: CurrentOp := SubtractOp; 7: CurrentOp := MultiplyOp; 8: CurrentOp := DivideOp; end; DoMath; end; end; end; SetPort(tPort); DrawPasteControl; end; procedure DrawPasteControl; const bWidth = 64; bHeight = 14; rbWidth = 12; rbInnerWidth = 5; rbhloc = 6; rbvloc = 6; vinc = 17; bhloc = 78; bvloc = 6; var tPort: GrafPtr; i, hloc, vloc, SetItem: integer; tType: pcItemType; tRect: rect; begin GetPort(tPort); SetPort(PasteControl); hloc := rbhloc; vloc := rbvloc; tType := pcRadioButton; with PcItem[1] do begin SetRect(r, hloc, vloc, hloc + rbWidth, vloc + rbWidth); itype := tType; str := 'Copy'; end; vloc := vloc + vinc; with pcItem[2] do begin SetRect(r, hloc, vloc, hloc + rbWidth, vloc + rbWidth); itype := tType; str := 'And'; end; vloc := vloc + vinc; with pcItem[3] do begin SetRect(r, hloc, vloc, hloc + rbWidth, vloc + rbWidth); itype := tType; str := 'Or'; end; vloc := vloc + vinc; with pcItem[4] do begin SetRect(r, hloc, vloc, hloc + rbWidth, vloc + rbWidth); itype := tType; str := 'Replace'; end; hloc := bhloc; vloc := bvloc; tType := pcButton; with pcItem[5] do begin SetRect(r, hloc, vloc, hloc + bWidth, vloc + bHeight); itype := tType; str := 'Add'; end; vloc := vloc + vinc; with pcItem[6] do begin SetRect(r, hloc, vloc, hloc + bWidth, vloc + bHeight); itype := tType; str := 'Subtract'; end; vloc := vloc + vinc; with pcItem[7] do begin SetRect(r, hloc, vloc, hloc + bWidth, vloc + bHeight); itype := tType; str := 'Multiply'; end; vloc := vloc + vinc; with pcItem[8] do begin SetRect(r, hloc, vloc, hloc + bWidth, vloc + bHeight); itype := tType; str := 'Divide'; end; TextFont(SystemFont); TextSize(12); case PasteTransferMode of SrcCopy: SetItem := 1; NotSrcBic: SetItem := 2; SrcOr, SrcXor: SetItem := 3; Transparent, Blend: SetItem := 4; end; for i := 1 to npcItems do with pcItem[i] do if iType = pcRadioButton then begin EraseOval(r); FrameOval(r); if i = SetItem then begin tRect := r; InsetRect(tRect, 3, 3); PaintOval(tRect); end; MoveTo(r.left + rbWidth + 4, r.top + rbWidth - 2); DrawString(str); end else begin FrameRoundRect(r, 6, 6); with r do MoveTo(left + ((right - left) - StringWidth(str)) div 2, bottom - 3); DrawString(str); end; SetPort(tPort); end; procedure ShowPasteControl; const pcwidth = 148; pcheight = 75; var tPort: GrafPtr; blend: RGBColor; trect: rect; wp: ^WindowPtr; begin SetRect(trect, ScreenWidth - pcwidth - 10, ScreenHeight - pcheight - 10, ScreenWidth - 10, ScreenHeight - 10); PasteControl := NewWindow(nil, trect, 'Paste Control', true, rDocProc, nil, true, 0); WindowPeek(PasteControl)^.WindowKind := PasteControlKind; wp := pointer(GhostWindow); wp^ := PasteControl; SetMenuItem(GetMHandle(WindowsMenu), 9, true); end; procedure ShowClipboard; var width, height, hstart, vstart, i, NewScrapCount: integer; begin NewScrapCount := GetScrapCount; if NewScrapCount <> OldScrapCount then begin WhatsOnClip := Nothing; OldScrapCount := NewScrapCount; end; if WhatsOnClip = Nothing then ConvertSystemClipboard; if (WhatsOnClip = RectPic) or (WhatsOnClip = NonRectPic) or (WhatsOnClip = ImportedPic) then with ClipBufinfo^.osroiRect do begin width := right - left; if odd(width) then width := Width + 1; height := bottom - top; if NewPicWindow('Clipboard', width, height) then begin PastePicture; KillRoi; SetupUndo; WhatToUndo := NothingToUndo; info^.changes := false; end; end; end; function RgnNotTooBig; {(Rgn1, Rgn2: RgnHandle): boolean} begin RgnNotTooBig := GetHandleSize(handle(Rgn1)) + GetHandleSize(handle(Rgn2)) < 30000 end; procedure DoSelection (obj: ObjectType; start, finish: point); var tRect: rect; temp: integer; TempRgn: RgnHandle; begin WhatToUndo := NothingToUndo; Info^.RoiShowing := false; RoiUpdateTime := 0; if (start.h = finish.h) or (start.v = finish.v) then exit(DoSelection); if start.h > finish.h then begin temp := start.h; start.h := finish.h; finish.h := temp; end; if start.v > finish.v then begin temp := start.v; start.v := finish.v; finish.v := temp; end; Pt2Rect(start, finish, tRect); ScreenToOffscreenRect(tRect); with info^ do begin RoiShowing := true; if SelectionMode <> NewSelection then TempRgn := NewRgn; PenNormal; OpenRgn; case obj of SelectionOval: begin FrameOval(tRect); roiType := OvalRoi; end; RoundedRect: begin FrameRoundRect(tRect, OvalSize, OvalSize); roiType := RoundRectRoi; end; SelectionRect: begin FrameRect(tRect); roiType := RectRoi; end; end; if SelectionMode = NewSelection then CloseRgn(osroiRgn) else begin CloseRgn(TempRgn); if RgnNotTooBig(osroiRgn, TempRgn) then begin if SelectionMode = AddSelection then UnionRgn(osroiRgn, TempRgn, osroiRgn) else begin DiffRgn(osroiRgn, TempRgn, osroiRgn); UpdatePicWindow; end; end; DisposeRgn(TempRgn); if GetHandleSize(handle(osroiRgn)) = 10 then roiType := RectRoi else roiType := RgnRoi; end; osroiRect := osroiRgn^^.rgnBBox; roiRect := osroiRect; OffscreenToScreenRect(roiRect); end;{with} measuring := false; end; procedure FindLength (start, finish: point); var length, h1, h2, v1, v2: extended; begin DrawObject(LineObj, start, finish); ScreenToOffscreen(start); ScreenToOffscreen(finish); h1 := start.h; h2 := finish.h; v1 := start.v; v2 := finish.v; if nLengths < MaxLengths then begin nLengths := nLengths + 1; UnsavedLengths := UnsavedLengths + 1 end else beep; length := sqrt(sqr(h2 - h1) + sqr(v2 - v1)); PixelLength := length; with info^ do if SpatialScale <> 0.0 then length := length / SpatialScale; lengths[nLengths] := length; ShowResults; measuring := true; end; {$IFC Arlo } procedure DoObject; {(obj: ObjectType; event: EventRecord)} const MinPOf2Size = 64; { Minimum Power Of 2 selection Size } var Start, Finish, ScreenStart, ScreenFinish, osStart, osFinish: point; r: rect; ff, DeltaX, DeltaY, switch, imag, selectDim: integer; PowerOf2Size, PowerOf2OK, Constrained: boolean; function sign (x: integer): integer; { sign returns 1 if x >= 0 and -1 if x < 0. } inline $0817, $0007, { BTST.B #7, (SP) ; } $6608, { BNE.S Negative ; } $3F7C, $0001, $0002, { MOVE.W #1, 2(SP) ; } $6006, { BRA.S exit ; } $3F7C, $FFFF, $0002, { Negative MOVE.W #-1, 2(SP) ; } $544F; { exit ADDQ.W #2, SP ; } begin { DoObject } if (obj = LengthObj) or (obj = PlotLine) or (obj = LineObj) then DrawLabels('DX:', 'DY:', 'Length:') else DrawLabels('Width:', 'Height:', ''); start := event.where; osStart := start; ScreenToOffscreen(osStart); finish := start; PenNormal; PenMode(PatXor); with info^ do begin imag := trunc(magnification + 0.5); ff := imag div 2; if (obj = SelectionRect) or (obj = SelectionOval) or (obj = RoundedRect) then PenSize(imag, imag) else PenSize(imag * LineWidth, imag * LineWidth); end; PowerOf2OK := (not Info^.ScaleToFitWindow) and not (imag = 3); while button do begin PowerOf2Size := CommandKeyDown and (obj = SelectionRect); Constrained := ShiftKeyDown; GetMouse(finish); with finish, Info^ do begin if h > wrect.right then h := wrect.right; if v > wrect.bottom then v := wrect.bottom; if h < 0 then h := 0; if v < 0 then v := 0; end; { with } if Constrained or PowerOf2Size then begin { constrained or discrete sized selection } DeltaX := finish.h - start.h; DeltaY := finish.v - start.v; if ((DeltaX > 0) and (DeltaY < 0)) or ((DeltaX < 0) and (DeltaY > 0)) then switch := -1 else switch := 1; if (obj = lineObj) or (obj = PlotLine) or (obj = LengthObj) then { linear obj } begin if abs(DeltaX) > abs(DeltaY) then finish.v := start.v { constrain to horizontal line } else finish.h := start.h { constrain to vertical line } end else if PowerOf2Size then { Discrete Sized Object } if not PowerOf2OK then begin { discrete OK? } PutMessage('Power of 2 size selection does not work in "Scale to Fit Window" mode or with magnification of 3.'); exit(DoObject); end else begin if abs(DeltaX) > abs(DeltaY) then begin selectDim := pOf2(DeltaY); if (abs(selectDim) div imag) < MinPOf2Size then selectDim := BSL(sign(selectDim), 6) * imag; finish.h := start.h + switch * selectDim; finish.v := start.v + selectDim; end else begin selectDim := pOf2(DeltaX); if (abs(selectDim) div imag) < MinPOf2Size then { Minimum Power Of 2 selection Size } selectDim := BSL(sign(selectDim), 6) * imag; finish.v := start.v + switch * selectDim; finish.h := start.h + selectDim; end end else if abs(DeltaX) > abs(DeltaY) then {b. continuous size } finish.h := start.h + switch * DeltaY else finish.v := start.v + switch * DeltaX; end; { if ConstrainedÉ } osFinish := finish; ScreenToOffscreen(osfinish); case obj of LineObj, PlotLine, LengthObj: begin MoveTo(start.h - ff, start.v - ff); LineTo(finish.h - ff, finish.v - ff); Show3RealValues(abs(osfinish.h - osstart.h), abs(osfinish.v - osstart.v), sqrt(sqr(LongInt(osfinish.h - osstart.h)) + sqr(LongInt(osfinish.v - osstart.v)))); MoveTo(start.h - ff, start.v - ff); LineTo(finish.h - ff, finish.v - ff); end; Rectangle, SelectionRect: begin if obj = SelectionRect then begin PatIndex := (PatIndex + 1) mod 8; PenPat(pat[PatIndex]); end; Pt2Rect(start, finish, r); OffsetRect(r, -ff, -ff); FrameRect(r); Show2Values(osfinish.h - osstart.h, osfinish.v - osstart.v); FrameRect(r); end; RoundedRect: begin PatIndex := (PatIndex + 1) mod 8; PenPat(pat[PatIndex]); Pt2Rect(start, finish, r); OffsetRect(r, -ff, -ff); FrameRoundRect(r, OvalSize, OvalSize); Show2Values(osfinish.h - osstart.h, osfinish.v - osstart.v); FrameRoundRect(r, OvalSize, OvalSize); end; SelectionOval: begin PatIndex := (PatIndex + 1) mod 8; PenPat(pat[PatIndex]); Pt2Rect(start, finish, r); OffsetRect(r, -ff, -ff); FrameOval(r); Show2Values(osfinish.h - osstart.h, osfinish.v - osstart.v); FrameOval(r); end; end; { case } end; { while buttonÉ } if obj = PlotLine then begin DoProfilePlot(event, start, finish); exit(DoObject) end; case obj of SelectionRect, SelectionOval, RoundedRect: DoSelection(obj, start, finish); LengthObj: FindLength(start, finish); otherwise DrawObject(obj, start, finish); end; { case } end; { DoObject } {$ELSEC } procedure DoObject; {(obj: ObjectType; event: EventRecord)} var Start, Finish, ScreenStart, ScreenFinish, osStart, osFinish: point; r: rect; tPort: GrafPtr; ff, DeltaX, DeltaY, switch, imag: integer; Constrain: boolean; begin if (obj = LengthObj) or (obj = PlotLine) or (obj = LineObj) then DrawLabels('DX:', 'DY:', 'Length:') else DrawLabels('Width:', 'Height:', ''); start := event.where; osStart := start; ScreenToOffscreen(osStart); finish := start; PenNormal; PenMode(PatXor); with info^ do begin imag := trunc(magnification + 0.5); ff := imag div 2; if (obj = SelectionRect) or (obj = SelectionOval) or (obj = RoundedRect) then PenSize(imag, imag) else PenSize(imag * LineWidth, imag * LineWidth); end; while button do begin GetMouse(finish); with finish, Info^ do begin if h > wrect.right then h := wrect.right; if v > wrect.bottom then v := wrect.bottom; if h < 0 then h := 0; if v < 0 then v := 0; end; if ShiftKeyDown then begin DeltaX := finish.h - start.h; DeltaY := finish.v - start.v; if (obj = lineObj) or (obj = PlotLine) or (obj = LengthObj) then begin if abs(DeltaX) > abs(DeltaY) then finish.v := start.v else finish.h := start.h end else begin if ((DeltaX > 0) and (DeltaY < 0)) or ((DeltaX < 0) and (DeltaY > 0)) then switch := -1 else switch := 1; if abs(DeltaX) > abs(DeltaY) then finish.h := start.h + switch * DeltaY else finish.v := start.v + switch * DeltaX; end; end; osFinish := finish; ScreenToOffscreen(osfinish); case obj of LineObj, PlotLine, LengthObj: begin MoveTo(start.h - ff, start.v - ff); LineTo(finish.h - ff, finish.v - ff); Show3RealValues(abs(osfinish.h - osstart.h), abs(osfinish.v - osstart.v), sqrt(sqr(LongInt(osfinish.h - osstart.h)) + sqr(LongInt(osfinish.v - osstart.v)))); MoveTo(start.h - ff, start.v - ff); LineTo(finish.h - ff, finish.v - ff); end; Rectangle, SelectionRect: begin if obj = SelectionRect then begin PatIndex := (PatIndex + 1) mod 8; PenPat(pat[PatIndex]); end; Pt2Rect(start, finish, r); OffsetRect(r, -ff, -ff); FrameRect(r); Show3Values(osfinish.h - osstart.h, osfinish.v - osstart.v, -1); Pt2Rect(start, finish, r); OffsetRect(r, -ff, -ff); FrameRect(r); end; RoundedRect: begin PatIndex := (PatIndex + 1) mod 8; PenPat(pat[PatIndex]); Pt2Rect(start, finish, r); OffsetRect(r, -ff, -ff); FrameRoundRect(r, OvalSize, OvalSize); Show3Values(osfinish.h - osstart.h, osfinish.v - osstart.v, -1); Pt2Rect(start, finish, r); OffsetRect(r, -ff, -ff); FrameRoundRect(r, OvalSize, OvalSize); end; SelectionOval: begin PatIndex := (PatIndex + 1) mod 8; PenPat(pat[PatIndex]); Pt2Rect(start, finish, r); OffsetRect(r, -ff, -ff); FrameOval(r); Show3Values(osfinish.h - osstart.h, osfinish.v - osstart.v, -1); Pt2Rect(start, finish, r); OffsetRect(r, -ff, -ff); FrameOval(r); end; end; end; if obj = PlotLine then begin DoProfilePlot(event, start, finish); exit(DoObject) end; case obj of SelectionRect, SelectionOval, RoundedRect: DoSelection(obj, start, finish); LengthObj: FindLength(start, finish); otherwise DrawObject(obj, start, finish); end; end; {$ENDC } procedure DrawAirBrush (xcenter, ycenter: integer); var i, xoffset, yoffset, nDots: integer; begin nDots := AirBrushDiameter div 4; if nDots < 15 then nDots := 15; for i := 1 to nDots do begin repeat xoffset := random mod AirBrushRadius; yoffset := random mod AirBrushRadius; until xoffset * xoffset + yoffset * yoffset <= AirBrushRadius2; PutPixel(xcenter + xoffset, ycenter + yoffset, ForegroundIndex); end; end; procedure DoAirBrush; {Reference: "Spaying and Smudging", Dick Pountain, Byte, November 1987} var xcenter, ycenter, off: integer; MaskRect: rect; pt: point; begin with info^ do begin changes := true; off := AirbrushRadius * trunc(magnification + 0.5); end; repeat GetMouse(pt); with MaskRect, pt do begin left := h - off; top := v - off; right := h + off; bottom := v + off; end; ScreenToOffscreen(pt); with pt do begin xcenter := h; ycenter := v end; DrawAirbrush(xcenter, ycenter); UpdateScreen(MaskRect); until not button; end; procedure DoBrush; {(event: EventRecord)} var r, ScreenRect: rect; tPort: GrafPtr; p1, p2, p2x, start: point; WhichWindow: WindowPtr; SaveLineWidth, SaveForegroundColor: integer; Constrained, MoreHorizontal, FirstTime: boolean; offset, width: integer; begin SaveLineWidth := LineWidth; p1 := event.where; start := p1; if OptionKeyDown then begin case CurrentTool of Brush, Pencil: GetForegroundColor(event); Eraser: GetBackgroundColor(event); end; if (CurrentTool = Brush) or (CurrentTool = Eraser) then exit(DoBrush); end; case CurrentTool of Pencil: LineWidth := 1; Brush, Eraser: begin if CurrentTool = Brush then width := BrushWidth else width := 16; LineWidth := round(width / info^.magnification); if LineWidth < 1 then LineWidth := 1; end; end; with info^ do offset := round((LineWidth - 1) * info^.magnification / 2.0); if CurrentTool <> Pencil then with p1 do begin h := h - offset; v := v - offset end; Constrained := ShiftKeyDown; FirstTime := true; if CurrentTool = eraser then begin SaveForegroundColor := ForegroundIndex; SetForegroundColor(BackgroundIndex) end; repeat GetMouse(p2); if CurrentTool <> Pencil then with p2 do begin h := h - offset; v := v - offset end; if FirstTime then if not EqualPt(p1, p2) then begin MoreHorizontal := abs(p2.h - p1.h) >= abs(p2.v - p1.v); FirstTime := false; end; if Constrained then if MoreHorizontal then p2.v := p1.v else p2.h := p1.h; if CurrentTool = brush then DrawObject(BrushObj, p1, p2) else DrawObject(LineObj, p1, p2); p1 := p2; until not button; if CurrentTool = Eraser then SetForegroundColor(SaveForegroundColor); LineWidth := SaveLineWidth; end; procedure DrawCharacter; {(ch: char)} var tPort: GrafPtr; p1, p2: point; width: integer; MaskRect: rect; ScreenLoc: point; str: str255; begin if (not IsInsertionPoint) or (Info = NoInfo) then begin beep; exit(DrawCharacter) end; if ch = cr then with InsertionPoint do begin h := TextStart.h; v := v + CurrentSize; SetupUndo; TextStr := ''; TextStart := InsertionPoint; exit(DrawCharacter) end; GetPort(tPort); SetPort(GrafPtr(Info^.osPort)); TextFont(CurrentFontID); TextFace(CurrentStyle); TextSize(CurrentSize); if ch = BackSpace then with InsertionPoint do begin if length(TextStr) > 0 then begin delete(TextStr, length(TextStr), 1); DisplayText; end; SetPort(tPort); exit(DrawCharacter) end; str := ' '; {Needed for MPW} str[1] := ch; TextStr := Concat(TextStr, str); DisplayText; SetPort(tPort); end; procedure DoText; {(loc: point)} var str: str255; i: integer; len, area: extended; begin ScreenToOffscreen(loc); with loc do begin InsertionPoint.h := h; InsertionPoint.v := v + 4; end; IsInsertionPoint := true; TextStart := InsertionPoint; TextStr := ''; if OptionKeyDown then with info^ do begin str := ''; if (PreviousTool = ruler) and (nLengths2 > 0) then begin len := lengths[nLengths2]; RealToString(len, 1, -1, str); for i := 1 to length(str) do DrawCharacter(str[i]); if nLengths2 > 0 then nLengths2 := nLengths2 - 1; exit(DoText); end; if nRegions2 > 0 then with MeasurementsP^ do begin if AreaM in Measurements then begin area := PixelCount[nRegions2]; if SpatialScale <> 0.0 then area := area / sqr(SpatialScale); RealToString(area, 1, -1, str); end else if MeanM in Measurements then RealToString(Mean[nRegions2], 1, 2, str); if str <> '' then begin if nRegions2 > 0 then nRegions2 := nRegions2 - 1; for i := 1 to length(str) do DrawCharacter(str[i]); end; end; end; end; procedure DoFill (event: EventRecord); var loc: point; MaskBits: BitMap; BitMapSize: LongInt; tPort: GrafPtr; trect: rect; begin ShowWatch; loc := event.where; ScreenToOffscreen(loc); with info^ do begin tRect := PicRect; with tRect do if right mod 16 <> 0 then {Workaround for SeedCFill bug that results in garbage along right edge.} right := (right div 16) * 16 + 16; with MaskBits do begin RowBytes := PixelsPerLine div 8 + 1; if odd(RowBytes) then RowBytes := RowBytes + 1; bounds := tRect; BitMapSize := LongInt(rowBytes) * nLines; baseAddr := NewPtr(BitMapSize); if baseAddr = nil then begin beep; exit(DoFill) end; end; GetPort(tPort); SetPort(GrafPtr(osPort)); SeedCFill(BitMapHandle(osPort^.PortPixMap)^^, MaskBits, tRect, tRect, loc.h, loc.v, nil, 0); CopyBits(MaskBits, BitMapHandle(osPort^.PortPixMap)^^, tRect, tRect, SrcOr, nil); DisposPtr(MaskBits.baseAddr); changes := true; end; {with} SetPort(tPort); UpdatePicWindow; end; procedure SetAirbrushSize; var TempSize: integer; begin TempSize := GetInt('Airbrush diameter in pixels(2-362):', AirbrushDiameter); if TempSize = -MaxInt then exit(SetAirBrushSize); if (TempSize > 1) and (TempSize <= 362) then begin AirbrushDiameter := TempSize; AirbrushRadius := AirbrushDiameter div 2; AirbrushRadius2 := AirbrushRadius * AirBrushRadius end else beep; end; procedure SetBrushSize; var TempSize: integer; begin TempSize := GetInt('Brush Size in pixels(1..99):', BrushWidth); if TempSize = -MaxInt then exit(SetBrushSize); if (TempSize > 0) and (TempSize < 100) then begin BrushWidth := TempSize; BrushHeight := BrushWidth end else beep; end; procedure EditColor; var where: point; inRGBColor, OutRGBColor: RGBColor; index: integer; begin with info^ do begin index := GetColorIndex; if index = NoColor then exit(EditColor); with inRGBColor do begin red := RedX[index]; green := GreenX[index]; blue := BlueX[index]; end; outRGBColor := inRGBColor; where.h := 0; where.v := 0; InitCursor; if GetColor(where, 'Pick a color, any color...', inRGBColor, outRGBColor) then begin with outRGBColor do begin RedX[index] := red; GreenX[index] := green; BlueX[index] := blue; end; info^.changes := true; end; UpdateColors; end; {with} end; procedure EditThresholdColor; var where: point; inRGBColor, OutRGBColor: RGBColor; begin inRGBColor := ThresholdColor; outRGBColor := inRGBColor; where.h := 0; where.v := 0; InitCursor; if GetColor(where, 'Pick a new color...', inRGBColor, outRGBColor) then ThresholdColor := outRGBColor; DrawThreshold(false); end; procedure FindWhatToCopy; var kind: integer; WhichWindow: WindowPtr; rightKind: boolean; begin WhatToCopy := NothingToCopy; if CurrentTool = PickerTool then WhatToCopy := CopyColor else begin WhichWindow := FrontWindow; kind := WindowPeek(WhichWindow)^.WindowKind; rightKind := (kind = PicKind); {$IFC Arlo } rightKind := rightKind or (kind = FFTKind); {$ENDC } if rightKind and measuring then kind := ResultsKind; case kind of {$IFC Arlo } PicKind, FFTKind: {$ELSEC } PicKind: {$ENDC } with info^, info^.osroirect do if RoiShowing and (left >= 0) and (top >= 0) and (right <= PicRect.right) and (bottom <= PicRect.bottom) then WhatToCopy := CopySelection; HistoKind: WhatToCopy := CopyHistogram; ProfilePlotKind: WhatToCopy := CopyPlot; CalibrationPlotKind: WhatToCopy := CopyCalibrationPlot; LUTKind: if info <> NoInfo then WhatToCopy := CopyCLUT; GrayMapKind: if info <> NoInfo then WhatToCopy := CopyGrayMap; ResultsKind: if (CurrentTool = ruler) and (nLengths > 0) then WhatToCopy := CopyLengths else if (CurrentTool = PointingTool) and (nPoints > 0) then WhatToCopy := CopyPoints else if nRegions > 0 then WhatToCopy := CopyRegions; otherwise end; end; end; procedure DeZoom; var Width, Height, divisor: integer; OldMagnification: extended; begin with Info^ do begin if (wrect.right > PicRect.right) or (wrect.bottom > PicRect.bottom) then begin UnZoom; Exit(DeZoom) end; if magnification < 2.0 then begin beep; exit(DeZoom) end; OldMagnification := magnification; if magnification = 2.0 then begin magnification := 1.0; divisor := 4 end else if magnification = 3.0 then begin magnification := 2.0; divisor := 6 end else if magnification = 4.0 then begin magnification := 3.0; divisor := 8 end else begin magnification := magnification / 2.0; divisor := 4 end; end; with Info^.SrcRect, info^ do begin if magnification = 1.0 then begin width := wrect.right; height := wrect.bottom; end else begin width := round((right - left) * OldMagnification / Magnification); height := round((bottom - top) * OldMagnification / Magnification); end; left := left - (width div divisor); if left < 0 then left := 0; if (left + width) > Info^.PicRect.right then left := Info^.PicRect.right - round(width); top := top - (height div divisor); if top < 0 then top := 0; if (top + height) > Info^.PicRect.bottom then top := Info^.picRect.bottom - round(height); right := left + width; bottom := top + height; RoiShowing := false; UpdatePicWindow; DrawMyGrowIcon(wptr); ShowMagnification; end; ShowRoi; end; procedure DoGrow; {(WhichWindow: WindowPtr; event: EventRecord)} var NewSize: LongInt; tPort: GrafPtr; trect, WinRect: rect; ZoomCenterH, ZoomCenterV, width, height, imag, kind: integer; WasDigitizing, rightKind: boolean; begin kind := WindowPeek(WhichWindow)^.WindowKind; rightKind := (kind = PicKind); {$IFC Arlo } rightKind := rightKind or (kind = FFTKind); {$ENDC } if rightKind and (info^.PictureType = ScionType) then exit(DoGrow); NewSize := GrowWindow(WhichWindow, event.where, ScreenBits.bounds); if newSize = 0 then exit(DoGrow); if WindowPeek(WhichWindow)^.WindowKind = PicKind then with Info^ do begin WasDigitizing := digitizing; StopDigitizing; InvalRect(wrect); with trect do begin top := 0; left := 0; right := LoWord(NewSize); bottom := HiWord(NewSize); end; if ScaleToFitWindow then begin ScaleImageWindow(trect); wrect := trect; end else begin imag := trunc(magnification); if imag < 1 then imag := 1; if trect.right > PicRect.right * imag then trect.right := PicRect.right * imag; if trect.bottom > PicRect.bottom * imag then trect.bottom := PicRect.bottom * imag; wrect := trect; savewrect := wrect; with SrcRect do begin ZoomCenterH := left + round((wrect.right div 2) / magnification); ZoomCenterV := top + round((wrect.bottom div 2) / magnification); width := wrect.right div imag; height := wrect.bottom div imag; left := ZoomCenterH - width div 2; if left < 0 then left := 0; if (left + width) > PicRect.right then left := PicRect.right - width; top := ZoomCenterV - height div 2; if top < 0 then top := 0; if (top + height) > PicRect.bottom then top := picRect.bottom - height; right := left + width; bottom := top + height; end; end; SizeWindow(WhichWindow, trect.right, trect.bottom, true); WindowState := NormalWindow; if WasDigitizing then StartDigitizing; exit(DoGrow) end; {with info^} if WhichWindow = PlotWindow then begin PlotWidth := LoWord(NewSize); PlotHeight := hiWord(NewSize); SizeWindow(PlotWindow, PlotWidth, Plotheight, true); GetPort(tPort); SetPort(PlotWindow); InvalRect(PlotWindow^.PortRect); SetPort(tPort); end; end; procedure Zoom; {(event: EventRecord)} var width, height, OldMagnification: extended; PicCenterH, PicCenterV: integer; begin if Info = NoInfo then begin beep; exit(Zoom) end; if Info^.ScaleToFitWindow then begin PutMessage('The magnifying glass does not work in "Scale to Fit Window" mode.'); exit(Zoom) end; if BitAnd(Event.modifiers, OptionKey) = OptionKey then begin DeZoom; WhatToUndo := NothingToUndo; exit(Zoom) end; with Info^ do begin OldMagnification := magnification; if magnification = 1.0 then magnification := 2.0 else if magnification = 2.0 then magnification := 3.0 else if magnification = 3.0 then magnification := 4.0 else begin magnification := magnification * 2.0; if magnification > 64.0 then begin magnification := 64.0; exit(Zoom) end; end; end; {with} with Info^.SrcRect, Info^ do begin PicCenterH := left + round(event.where.h / OldMagnification); PicCenterV := top + round(event.where.v / OldMagnification); width := wrect.right / magnification; height := wrect.bottom / magnification; left := PicCenterH - round(width / 2); if left < 0 then left := 0; if (left + width) > PicRect.right then left := PicRect.right - round(width); top := PicCenterV - round(height / 2); if top < 0 then top := 0; if (top + height) > PicRect.bottom then top := picRect.bottom - round(height); right := left + round(width); bottom := top + round(height); RoiShowing := false; UpdatePicWindow; DrawMyGrowIcon(wptr); ShowMagnification; end; WhatToUndo := UndoZoom; ShowRoi; end; procedure SynchScroll; var AllSameSize: boolean; n: integer; TempInfo, TempInfo2, SaveInfo: InfoPtr; begin AllSameSize := true; for n := 2 to nPics do begin TempInfo := pointer(WindowPeek(PicWindow[n - 1])^.RefCon); TempInfo2 := pointer(WindowPeek(PicWindow[n])^.RefCon); AllSameSize := AllSameSize and EqualRect(TempInfo^.PicRect, TempInfo2^.PicRect) and EqualRect(TempInfo^.wrect, TempInfo2^.wrect); end; SaveInfo := info; if allsamesize then for n := 1 to nPics do begin TempInfo := pointer(WindowPeek(PicWindow[n])^.RefCon); TempInfo^.SrcRect := info^.SrcRect; TempInfo^.magnification := Info^.magnification; info := TempInfo; UpdatePicWindow; Info := SaveInfo; end else PutMessage('Synchronized scrolling requires all images and all windows to be the same size.'); end; procedure Scroll; {(event: EventRecord)} var hstart, vstart, DeltaH, DeltaV, width, height: integer; loc: point; SaveSR: rect; WasDigitizing: boolean; begin if info^.ScaleToFitWindow then begin PutMessage('Scrolling does not work in "Scale to Fit Window" mode.'); exit(Scroll) end; WasDigitizing := digitizing; StopDigitizing; with event.where do begin hstart := h; vstart := v end; with Info^.SrcRect do begin width := right - left; height := bottom - top end; SaveSR := Info^.SrcRect; while StillDown do begin GetMouse(loc); DeltaH := hstart - loc.h; DeltaV := vstart - loc.v; with Info^ do begin with SrcRect do begin left := SaveSR.left + DeltaH; if left < 0 then left := 0; if (left + width) > PicRect.right then left := PicRect.right - width; right := left + width; top := SaveSR.top + DeltaV; if top < 0 then top := 0; if (top + height) > PicRect.bottom then top := PicRect.bottom - height; bottom := top + height; end; UpdatePicWindow; DrawMyGrowIcon(wptr); end; end; WhatToUndo := NothingToUndo; ShowRoi; if WasDigitizing then StartDigitizing; if OptionKeyDown and (nPics > 1) then SynchScroll; end; procedure ConvertClipboard; {Converts local scrape to system scrape. Used when quiting or} {switching to other programs or DAs . } var PicH: PicHandle; frect: rect; tPort: GrafPtr; err: LongInt; begin PicH := nil; if (WhatsOnClip = RectPic) and (ClipBuf <> nil) and not ClipboardConverted then with ClipBufInfo^ do begin ShowWatch; GetPort(tPort); SetPort(GrafPtr(osPort)); with osroiRect do SetRect(frect, 0, 0, right - left, bottom - top); ClipRect(frect); LoadLUT(ctable); RGBForeColor(BlackRGB); RGBBackColor(WhiteRGB); PicH := OpenPicture(frect); with osPort^ do begin hlock(handle(portPixMap)); CopyBits(BitMapHandle(portPixMap)^^, BitMapHandle(portPixMap)^^, osroiRect, frect, SrcCopy, nil); hunlock(handle(portPixMap)); end; ClosePicture; SetPort(tPort); end; if (PicH <> nil) and (GetHandleSize(handle(PicH)) <= 10) then beep; if (PicH <> nil) or ClipTextInBuffer then begin err := ZeroScrap; if err = NoErr then begin if PicH <> nil then begin hlock(handle(PicH)); err := PutScrap(GetHandleSize(handle(PicH)), 'PICT', handle(PicH)^); hunlock(handle(PicH)); DisposHandle(handle(PicH)); end; if ClipTextInBuffer and (err = noErr) then err := PutScrap(TextBufSize, 'TEXT', ptr(TextBufP)); end; end; ClipboardConverted := true; end; procedure SetupOperation; {(item: integer)} var AutoSelectAll: boolean; begin if NotinBounds then exit(SetupOperation); if (item = 10) then if NoSelection then exit(SetupOperation); StopDigitizing; AutoSelectAll := not Info^.RoiShowing; if AutoSelectAll then SelectAll(true); SetupUndo; WhatToUndo := UndoEdit; case Item of 8: begin CurrentOp := PaintOp; OpPending := true end; 9: begin CurrentOp := InvertOp; OpPending := true end; 10: begin CurrentOp := FrameOp; OpPending := true end; end; if AutoSelectAll then KillRoi; RoiUpdateTime := 0; {Forces outline to be redrawn in scale-to-fit mode.} end; end.