Otherware/Otherware_1_SB_Development.iso/mac/developm/source/image144.sit/Graphics.p

Text File | 1992-03-30 | 52.8 KB | 2,003 lines

unit Graphics;

{Graphics routines used by Image program}

interface

    uses
        QuickDraw, Palettes, Picker, PrintTraps, globals, Utilities;

    procedure DoProfilePlot (p1, p2: point);
    procedure DrawPlot;
    procedure UpdatePlotWindow;
    procedure ShowValues;
    procedure SetupPlot (var data: LineType; start: point; VerticalPlot: boolean);
    procedure MakePlotWindow (PlotLeft, PlotTop, PlotWidth, PlotHeight: integer);
    procedure DrawObject (obj: ObjectType; p1, p2: point);
    procedure DrawTools;
    function InvertingCalibrationFunction: boolean;
    procedure DrawHistogram;
    procedure DrawLabels (xL, yL, zL: str255);
    procedure ShowNextWindow;
    procedure StackWindows;
    procedure TileWindows;
    function Duplicate (name: str255; SavingBlankField: boolean): boolean;
    procedure InvertPic;
    procedure ShowMessage (str: str255);
    procedure ShowTime (StartTicks: LongInt; r: rect; str: str255);
    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);
    procedure ScaleAndRotate;
    procedure ActivateWindow;
    procedure UpdateResultsWindow;
    procedure ScrollText;
    procedure UpdateScrollBars;
    procedure InitTextEdit (font, size: integer);
    procedure DoMouseDownInResults (loc: point);
    procedure AppendResults;
    procedure DeleteLines (first, last: integer);
    procedure UpdateList;
    procedure SelectSlice (i: integer);
    procedure ShowMeter;
    procedure UpdateMeter (percentdone: integer; str: str255);
    function RgnNotTooBig (Rgn1, Rgn2: RgnHandle): boolean;
    procedure ComputeLength (FindingPerimeterLength: boolean);
    procedure MakeOutline;



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^.DensityCalibrated 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^.DensityCalibrated then begin
                DrawString('DensityCalibrated(');
                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;
        DrawJReal(PlotLeftMargin, PlotTopMargin + 4, MaxValue, 2);
        DrawJReal(PlotLeftMargin, pbottom, MinValue, 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)');
            RodbardFit:
                DrawString('y=c*((a-x)/(x-d))^(1/b)');
            UncalibratedOD:
                DrawString('y=log10(255/(255-x))');
            otherwise
        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;
        if info^.fit <> UncalibratedOD then begin
                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;
    end;


    procedure DoSpecialGelPlot;
        var
            i: integer;
            vscale: extended;
    begin
        beep;
        if (ProfilePlotMax - ProfilePlotMin) = 0 then
            vscale := 1.0
        else
            vscale := ProfilePlotHeight / (ProfilePlotMax - ProfilePlotMin);
        MoveTo(PlotLeftMargin, PlotTopMargin + round(vscale * (ProfilePlotMax - cvalue[PlotData^[i]])) - 2);
        for i := 1 to PlotCount - 1 do
            LineTo(PlotLeftMargin + i, PlotTopMargin + round(vscale * (ProfilePlotMax - cvalue[PlotData^[i]])) - 2)
    end;


    procedure DrawPlot;
        var
            fRect: rect;
    begin
        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;
    end;


    procedure UpdatePlotWindow;
    begin
        SetPort(PlotWindow);
        EraseRect(PlotWindow^.portRect);
        DrawPlot;
        DrawMyGrowIcon(PlotWindow);
    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; VerticalPlot: boolean);
        const
            MinWidth = 100;
        var
            fRect, trect: rect;
            i, y, WindowWidth, fmax: integer;
            SaveClipRegion: RgnHandle;
            pt: point;
            temp, sum, scale, vscale: extended;
            AutoScale: boolean;
            RealData: array[0..MaxLine] of real;
            index: UnsignedByte;
    begin
        with info^ do begin
                if DensityCalibrated then
                    PlotLeftMargin := 35
                else
                    PlotLeftMargin := 25;
                PlotTopMargin := 10;
                PlotBottomMargin := 20;
                PlotRightMargin := 10;
                for i := 0 to PlotCount - 1 do
                    RealData[i] := cvalue[data[i]];
                if InvertPlots then
                    for i := 0 to PlotCount - 1 do
                        RealData[i] := MaxValue - RealData[i];
                if FixedSizePlot then begin
                        PlotWidth := ProfilePlotWidth;
                        PlotHeight := ProfilePlotHeight
                    end
                else begin
                        PlotWidth := PlotCount * trunc(magnification + 0.5);
                        if PlotWidth < MinWidth then
                            PlotWidth := MinWidth;
                        if PlotWidth + PlotRightMargin + PicLeftBase > ScreenWidth then
                            PlotWidth := ScreenWidth - PlotRightMargin - PicLeftBase - 10;
                        PlotHeight := PlotWidth div 2;
                        if PlotWidth > 300 then
                            PlotHeight := PlotWidth div 3;
                        if PlotWidth > 400 then
                            PlotHeight := PlotWidth div 4;
                    end;
                PlotWidth := PlotWidth + PlotLeftMargin + PlotRightMargin;
                PlotHeight := PlotHeight + PlotTopMargin + PlotBottomMargin;
                OffscreenToScreen(start);
                pt.h := start.h;
                pt.v := start.v + 40;
                SetPort(wptr);
                LocalToGlobal(pt);
                if VerticalPlot then
                    PlotLeft := PicLeftBase
                else
                    PlotLeft := pt.h - PlotLeftMargin;
                PlotTop := pt.v;
                if PlotLeft > (ScreenWidth - PlotWidth) then
                    PlotLeft := ScreenWidth - PlotWidth - 10;
                if PlotTop < 60 then
                    PlotTop := 60;
                if PlotTop > (ScreenHeight - PlotHeight) then
                    PlotTop := ScreenHeight - PlotHeight - 10;
                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 := 2048.0 / PlotCount;  {This scaling needed to get around a 32-bit QD problem}
                if scale < 1.0 then
                    scale := 1.0;
                fmax := round(fmax * scale);
                vscale := vscale * scale;
                SetRect(fRect, 0, 0, fmax, fmax);
                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(round(i * scale), round(vscale * (PlotMax - RealData[i])))
                    end
                else
                    for i := 1 to PlotCount - 1 do begin
                            y := round(vscale * (PlotMax - RealData[i]));
                            MoveTo(round(i * scale), y);
                            LineTo(round(i * scale), y)
                        end;
                ClosePicture;
                PlotWindow^.ClipRgn := SaveClipRegion;
                InvalRect(PlotWindow^.PortRect);
                SelectWindow(PlotWindow);
            end;  {wifth}
    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, fline: LineType;
    begin
        average := LineWidth > 1;
        if OptionKey and average then
            for i := 0 to MaxLine 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 := 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 and (CurrentTool <> LineTool) then
                    deltax := deltax + LineWidth;
                accumulator := deltax div 2;
                i := deltax;
                repeat
                    if count < MaxLine then
                        count := count + 1;
                    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 - 1] := round(sum / LineWidth);
                        end
                    else begin
                            data[count - 1] := MyGetPixel(xloc, yloc);
                            if OptionKey then
                                PutPixel(xloc, yloc, ForegroundIndex);
                        end;
                    i := i - 1;
                until i = 0
            end
        else begin          {More vertical}
                if average and (CurrentTool <> LineTool) then
                    deltay := deltay + LineWidth;
                accumulator := deltay div 2;
                i := deltay;
                repeat
                    if count < MaxLine then
                        count := count + 1;
                    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 - 1] := round(sum / LineWidth);
                        end
                    else begin
                            data[count - 1] := MyGetPixel(xloc, yloc);
                            if OptionKey then
                                PutPixel(xloc, yloc, ForegroundIndex);
                        end;
                    i := i - 1;
                until i = 0
            end;
    end;


    procedure DoProfilePlot (p1, p2: point);
        var
            i, range, width, value: integer;
            pt: point;
            OptionKey: boolean;
    begin
        if p2.h < p1.h then begin {Swap ends}
                pt := p1;
                p1 := p2;
                p2 := pt;
            end;
        OptionKey := OptionKeyDown;
        GetDiagLine(p1, p2, PlotCount, PlotData^, OptionKey);
        PlotAvg := LineWidth;
        SetupPlot(PlotData^, p1, false);
        if OptionKey then begin
                KillRoi;
                UpdatePicWindow;
                info^.changes := true;
            end;
    end;


    procedure FindIntegratedDensity (var IntDen, Background: extended);
        var
            i, MinLevel, MaxLevel, iback: integer;
            MaxCount: LongInt;
            h, h2: HistogramType;
            sum, wsum: extended;

        procedure SmoothHistogram;
            var
                i: integer;
        begin
            h2 := h;
            h[0] := (3 * h2[0] + h2[1]) div 5;
            for i := 1 to 254 do
                h[i] := (h2[i - 1] + 2 * h2[i] + h2[i + 1]) div 4;
        end;

    begin
        with results do begin
                MinLevel := MinIndex;
                MaxLevel := imean;
                if MaxLevel > 254 then
                    MaxLevel := 254;
                h := histogram;
                for i := 0 to 255 do
                    h[i] := h[i] * 10;
                for i := 1 to 15 do
                    SmoothHistogram;
                if OptionKeyDown then
                    histogram := h;
                Background := 0.0;
                MaxCount := 0;
                for i := MinLevel to MaxLevel do
                    if h[i] > MaxCount then begin
                            MaxCount := h[i];
                            Background := cvalue[i]
                        end;
                IntDen := mArea^[mCount] * (mean^[mCount] - Background);
            end;
    end;


    procedure ShowValues;
        var
            vloc, hloc: integer;
            tPort: GrafPtr;
            trect: rect;
            clength, cx, cy, IntDen, BackgroundLevel: extended;

        procedure NewLine;
        begin
            vloc := vloc + 12;
            MoveTo(hloc, vloc);
        end;

    begin
        GetPort(tPort);
        vloc := 35;
        hloc := 4;
        SetPort(ValuesWindow);
        TextFont(ApplFont);
        TextSize(9);
        Setrect(trect, 0, vloc, rwidth, rheight);
        EraseRect(trect);
        if ValuesMessage <> '' then begin
                Setrect(trect, hloc, vloc + 15, rwidth - 10, rheight);
                TextBox(pointer(ord(@ValuesMessage) + 1), length(ValuesMessage), trect, teJustLeft)
            end
        else
            with results do begin
                    NewLine;
                    with info^ do begin
                            if ShowCount then begin
                                    DrawBString('Count: ');
                                    DrawLong(mCount);
                                    NewLine;
                                end;
                            DrawBString('Pixels: ');
                            DrawLong(PixelCount^[mCount]);
                            if SpatiallyCalibrated then begin
                                    NewLine;
                                    DrawBString('Area: ');
                                    DrawReal(mArea^[mCount], 1, precision);
                                    DrawString(' square ');
                                    DrawString(units);
                                end;
                            NewLine;
                            DrawBString('Mean: ');
                            DrawReal(mean^[mCount], 1, precision);
                            if DensityCalibrated then begin
                                    DrawString(' ');
                                    DrawBString(UnitOfMeasure);
                                    DrawString('   (');
                                    DrawLong(results.imean);
                                    DrawString(')');
                                end;
                            if PixelCount^[mCount] > 1 then begin
                                    NewLine;
                                    DrawBString('Std Dev: ');
                                    DrawReal(sd^[mCount], 1, precision);
                                    NewLine;
                                    DrawBString('Min: ');
                                    DrawReal(mMin^[mCount], 1, precision);
                                    NewLine;
                                    DrawBString('Max: ');
                                    DrawReal(mMax^[mCount], 1, precision);
                                end;
                            if (xyLocM in measurements) or (nPoints > 0) then begin
                                    NewLine;
                                    DrawBString('X: ');
                                    DrawReal(xcenter^[mCount], 6, precision);
                                    NewLine;
                                    DrawBString('Y: ');
                                    DrawReal(ycenter^[mCount], 6, precision);
                                end;
                            if ModeM in Measurements then begin
                                    NewLine;
                                    DrawBString('Mode: ');
                                    DrawReal(mode^[mCount], 1, precision);
                                end;
                            if (LengthM in measurements) or (nLengths > 0) then begin
                                    NewLine;
                                    DrawBString('Length: ');
                                    DrawReal(plength^[mCount], 1, precision);
                                end;
                            if MajorAxisM in Measurements then begin
                                    NewLine;
                                    DrawBString(Concat(MajorLabel, ': '));
                                    DrawReal(MajorAxis^[mCount], 1, precision);
                                end;
                            if MinorAxisM in Measurements then begin
                                    NewLine;
                                    DrawBString(Concat(MinorLabel, ': '));
                                    DrawReal(MinorAxis^[mCount], 1, precision);
                                end;
                            if (AngleM in measurements) or (nAngles > 0) then begin
                                    NewLine;
                                    DrawBString('Angle: ');
                                    DrawReal(orientation^[mCount], 1, precision);
                                end;
                            if IntDenM in measurements then begin
                                    NewLine;
                                    FindIntegratedDensity(IntDen, BackgroundLevel);
                                    DrawBString('Integrated Density: ');
                                    DrawReal(IntDen, 1, precision);
                                    NewLine;
                                    DrawBString('Background Level: ');
                                    DrawReal(BackGroundLevel, 1, precision);
                                end
                            else begin
                                    IntDen := 0.0;
                                    BackGroundLevel := 0.0;
                                end;
                            IntegratedDensity^[mCount] := IntDen;
                            idBackground^[mCount] := BackGroundLevel;
                            if User1M in Measurements then begin
                                    NewLine;
                                    DrawBString(Concat(User1Label, ': '));
                                    DrawReal(User1^[mCount], 1, precision);
                                end;
                            if User2M in Measurements then begin
                                    NewLine;
                                    DrawBString(Concat(User2Label, ': '));
                                    DrawReal(User2^[mCount], 1, precision);
                                end;
                        end;
                end; {with}
        SetPort(tPort);
        mCount2 := mCount;
    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;
                    oval:  begin
                            Pt2Rect(p1, p2, r);
                            FrameOval(r);
                        end;
                    BrushObj:
                        DrawBrush(p1, p2);
                end;
                SetPort(wptr);
                pmForeColor(BlackIndex);
                pmBackColor(WhiteIndex);
                RectRgn(MaskRgn, MaskRect);
                hlock(handle(osPort^.portPixMap));
                hlock(handle(CGrafPort(wptr^).PortPixMap));
                CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPort(wptr^).PortPixMap)^^, SrcRect, wrect, SrcCopy, MaskRgn);
                hunlock(handle(osPort^.portPixMap));
                hunlock(handle(CGrafPort(wptr^).PortPixMap));
                SetPort(tPort);
            end; {with}
    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]);
        pmForeColor(ForegroundIndex);
        with ToolRect[brush] do
            MoveTo(left + ho, top + vo);
        DrawChar(chr(80));
        pmForeColor(BackgroundIndex);
        with ToolRect[Eraser] do
            MoveTo(left + ho, top + vo);
        DrawChar(chr(102));
        pmForeColor(BlackIndex);
        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 := DensityCalibrated 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;
            ShowSlice: boolean;
    begin
        ShowSlice := (HistogramSliceStart > 0) or (HistogramSliceEnd < 255);
        if not printing then begin
                GetPort(tPort);
                SetPort(HistoWindow);
                EraseRect(HistoWindow^.portRect);
            end;
        with Results do begin
                MaxCount := histogram[imode];
                if MaxCount > (hheight - 2) then begin
                        if MaxCount / PixelCount^[mCount] > 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) or (NextMaxCount = 0) then
                                    NextMaxCount := MaxCount;
                                hscale := NextMaxCount / (hheight - 2);
                            end
                        else
                            hscale := MaxCount / (hheight - 2);
                    end
                else
                    hscale := 1.0;
                if ShowSlice then
                    PenPat(gray);
                if InvertingCalibrationFunction then
                    for h := 0 to 255 do begin
                            if h = HistogramSliceStart then
                                PenPat(black);
                            MoveTo(255 - h, hheight);
                            LineTo(255 - h, hheight - round(histogram[h] / hscale));
                            if h = HistogramSliceEnd then
                                PenPat(gray)
                        end
                else
                    for h := 0 to 255 do begin
                            if h = HistogramSliceStart then
                                PenPat(black);
                            MoveTo(h, hheight);
                            LineTo(h, hheight - round(histogram[h] / hscale));
                            if h = HistogramSliceEnd then
                                PenPat(gray)
                        end;
            end;
        if ShowSlice then
            PenNormal;
        if not Printing then
            SetPort(tPort);
    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 Values window.}
        var
            tPort: GrafPtr;
            trect: rect;
    begin
        if xL = XLabel then
            if yL = yLabel then
                if zL = zLabel then
                    exit(DrawLabels);
        GetPort(tPort);
        SetPort(ValuesWindow);
        TextSize(9);
        TextFont(Monaco);
        TextFace([bold]);
        if length(xL) > 0 then begin
                xLabel := xL;
                xValueLoc := ValuesHStart + StringWidth(xLabel);
                yLabel := yL;
                yValueLoc := ValuesHStart + StringWidth(yLabel);
                zLabel := zL;
                zValueLoc := ValuesHStart + StringWidth(zLabel);
            end;
        Setrect(trect, 0, 0, rwidth, 32);
        EraseRect(trect);
        MoveTo(ValuesHStart, ValuesVStart);
        DrawString(xLabel);
        MoveTo(ValuesHStart, ValuesVStart + 10);
        DrawString(yLabel);
        MoveTo(ValuesHStart, ValuesVStart + 19);
        DrawString(zLabel);
        TextFace([]);
        SetPort(tPort);
    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;
                                WindowState := NormalWindow;
                                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);
                                UpdateTitleBar;
                            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;
                                        UpdateTitleBar;
                                        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;


    function Duplicate (name: str255; SavingBlankField: boolean): boolean;
        var
            width, height, hstart, vstart, i: integer;
            SaveInfo: InfoPtr;
            src, dst: ptr;
            offset: LongInt;
            AutoSelectAll: boolean;
    begin
        Duplicate := false;
        if nPics = MaxPics then
            exit(Duplicate);
        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 name = '' then begin
                        name := concat('Copy of ', title);
                        if length(name) > 32 then
                            delete(name, 33, length(name) - 32);
                    end;
                with RoiRect do begin
                        width := right - left;
                        if odd(width) then begin
                                if (left + width < PicRect.right) then
                                    width := Width + 1
                                else
                                    Width := width - 1;
                            end;
                        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
        ValuesMessage := str;
        ShowValues;
    end;


    procedure ShowTime (StartTicks: LongInt; r: rect; str: str255);
        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', cr, str));
    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^.DensityCalibrated then
                    PutReal(cvalue[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(cvalue[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^.BytesPerRow;
                nLines := Info^.nLines;
                ImageSize := Info^.ImageSize;
                PixMapSize := info^.PixMapSize;
                RoiRect := info^.RoiRect;
                CopyRgn(Info^.roiRgn, roiRgn);
                roiType := Info^.roiType;
                PicRect := Info^.PicRect;
                with osPort^ do begin
                        with portPixMap^^ do begin
                                RowBytes := BitOr(BytesPerRow, $8000);
                                bounds := PicRect;
                            end;
                        PortRect := PicRect;
                        RectRgn(visRgn, PicRect);
                    end;
            end;
    end;


    function GetScaleAndAngle: boolean;
        const
            AngleID = 3;
            hScaleID = 4;
            vScaleID = 5;
            NewWindowID = 9;
            BilinearID = 10;
            NearestNeighborID = 11;
        var
            mylog: DialogPtr;
            item, i: integer;
            vScaleUnchanged: boolean;
            str: str255;
    begin
        vScaleUnchanged := true;
        InitCursor;
        mylog := GetNewDialog(50, nil, pointer(-1));
        SetDReal(MyLog, AngleID, rsAngle, 2);
        SetDReal(MyLog, hScaleID, rsHScale, 2);
        SelIText(MyLog, hScaleID, 0, 32767);
        SetDReal(MyLog, vScaleID, rsVScale, 2);
        SetDialogItem(mylog, NewWindowID, ord(rsCreateNewWindow));
        SetDialogItem(mylog, BilinearID, ord(rsMethod = Bilinear));
        SetDialogItem(mylog, NearestNeighborID, ord(rsMethod = NearestNeighbor));
        OutlineButton(MyLog, ok, 16);
        repeat
            ModalDialog(nil, item);
            if item = AngleID then begin
                    rsAngle := GetDREal(MyLog, AngleID);
                    if rsAngle > 180.0 then
                        rsAngle := 180.0;
                    if rsAngle < -180.0 then
                        rsAngle := -180.0;
                end;
            if item = hScaleID then begin
                    str := GetDString(MyLog, hScaleID);
                    rsHScale := StringToReal(str);
                    if rsHScale = BadReal then
                        rsHScale := 1.0;
                    if vScaleUnchanged then begin
                            rsVScale := rsHScale;
                            SetDString(MyLog, vScaleID, str);
                        end;
                    if rsHScale < 0.05 then
                        rsHScale := 0.05;
                end;
            if item = vScaleID then begin
                    rsVScale := GetDReal(MyLog, vScaleID);
                    if rsVScale = BadReal then
                        rsVScale := 1.0;
                    if rsVScale < 0.05 then
                        rsVScale := 0.05;
                    vScaleUnchanged := false;
                end;
            if item = NewWindowID then begin
                    rsCreateNewWindow := not rsCreateNewWindow;
                    SetDialogItem(mylog, NewWindowID, ord(rsCreateNewWindow));
                end;
            if (item = BilinearID) or (item = NearestNeighborID) then begin
                    if item = BilinearID then
                        rsMethod := Bilinear;
                    if item = NearestNeighborID then
                        rsMethod := NearestNeighbor;
                    SetDialogItem(mylog, BilinearID, ord(rsMethod = Bilinear));
                    SetDialogItem(mylog, NearestNeighborID, ord(rsMethod = NearestNeighbor));
                end;
        until (item = ok) or (item = cancel);
        DisposDialog(mylog);
        GetScaleAndAngle := item <> cancel;
    end;


    procedure ScaleAndRotate;
        const
            pi = 3.14159;
        type
            EraseType = (Erase, DontErase);
        var
            CosAngle, SinAngle, htemp, vtemp, h, v: extended;
            hloc, vloc, value, DstWidth, DstHeight, hstart, vstart, hend, vend: integer;
            hfraction, vfraction, UpperAverage, LowerAverage, AngleInRadians: extended;
            LowerLeft, LowerRight, UpperLeft, UpperRight, SaveWidth, SaveHeight: integer;
            hSrcCenter, vSrcCenter, hDstCenter, vDstCenter: integer;
            hRel, vRel, hbase, vbase, SrcWidth, SrcHeight, ExtraPixel: integer;
            SrcInfo, DstInfo, SaveInfo: InfoPtr;
            AutoSelectAll, UseNearestNeighbor, Rotate: boolean;
            MaskRect, SourceRect, DstRect: rect;
            StartTicks: LongInt;
            UseSameWindow: boolean;

        procedure DoInterpolatedScaling;
    {Does interpolated scaling, but no rotation, using scaled integer arithmetic.}
            const
                CountsPerUpdate = 5;
            var
                SrcLeft, hloc, vloc, vbase, hbase, hrel: integer;
                LineCount, oldvloc, LastLine: integer;
                DstLine, SrcLine1, SrcLine2: LineType;
                MaskRect: rect;
                v, SrcTop: extended;
                h, hFraction, vFraction, UpperAverage, LowerAverage: LongInt;
                scale, scale2, hscale: LongInt;
        begin
            scale := 1000;
            scale2 := scale * scale;
            hscale := round(rsHScale * scale);
            if SrcWidth >= MaxLine then
                exit(DoInterpolatedScaling);
            LastLine := SrcInfo^.PicRect.bottom - 1;
            with SourceRect do begin
                    SrcLeft := left;
                    SrcTop := top;
                end;
            with DstRect do begin
                    oldvloc := top;
                    LineCount := 0;
                    for vloc := top to bottom - 1 do begin
                            v := SrcTop + (vloc - top) / rsVScale;
                            vbase := trunc(v);
                            vFraction := round((v - vbase) * scale);
                            Info := SrcInfo;
                            GetLine(SrcLeft, vbase, SrcWidth, SrcLine1);
                            SrcLine1[SrcWidth] := SrcLine1[SrcWidth - 1];
                            if vbase <> LastLine then begin
                                    GetLine(SrcLeft, vbase + 1, SrcWidth, SrcLine2);
                                    SrcLine2[SrcWidth] := SrcLine2[SrcWidth - 1];
                                end;
                            for hloc := left to right - 1 do begin
                                    hrel := hloc - left;
                                    h := hrel * scale2 div hscale;
                                    hbase := hrel * scale div hscale;
                                    hFraction := h mod scale;
                                    LowerAverage := SrcLine1[hbase] + hFraction * (SrcLine1[hbase + 1] - SrcLine1[hbase]) div scale;
                                    UpperAverage := SrcLine2[hbase] + hFraction * (SrcLine2[hbase + 1] - SrcLine2[hbase]) div scale;
                                    DstLine[hrel] := (LowerAverage + vfraction * (UpperAverage - LowerAverage) div scale);
                                end;
                            Info := DstInfo;
                            PutLine(left, vloc, DstWidth, DstLine);
                            LineCount := LineCount + 1;
                            if LineCount >= CountsPerUpdate then begin
                                    LineCount := 0;
                                    SetRect(MaskRect, left, oldvloc, right, vloc + 1);
                                    UpdateScreen(MaskRect);
                                    oldvloc := vloc;
                                end;
                            if CommandPeriod then begin
                                    beep;
                                    exit(DoInterpolatedScaling)
                                end;
                        end; {for vloc:=}
                    SetRect(MaskRect, left, oldvloc, right, vloc + 1);
                    UpdateScreen(MaskRect);
                end;
        end;

        procedure ScaleUsingCopyBits;
            var
                srcPort: cGrafPtr;
                SavePort: GrafPtr;
                MaskRect: rect;
        begin
            with DstInfo^ do begin
                    GetPort(SavePort);
                    SetPort(GrafPtr(osPort));
                    pmForeColor(BlackIndex);
                    pmBackColor(WhiteIndex);
                    srcPort := SrcInfo^.osPort;
                    hlock(handle(srcPort^.portPixMap));
                    hlock(handle(osPort^.portPixMap));
                    CopyBits(BitMapHandle(srcPort^.portPixMap)^^, BitMapHandle(osPort^.PortPixMap)^^, SourceRect, DstRect, SrcCopy, nil);
                    hunlock(handle(srcPort^.portPixMap));
                    hunlock(handle(osPort^.PortPixMap));
                    pmForeColor(ForegroundIndex);
                    pmBackColor(BackgroundIndex);
                    SetPort(SavePort);
                end;
            if UseSameWindow then begin
                    MaskRect := DstRect;
                    UpdateScreen(MaskRect);
                end;
        end;


    begin
        if NotRectangular or NotInBounds then
            exit(ScaleAndRotate);
        if not (macro and not rsInteractive) then
            if not GetScaleAndAngle then
                exit(ScaleAndRotate);
        UpdatePicWindow;
        UseSameWindow := not rsCreateNewWindow;
        if UseSameWindow then
            with info^ do
                if NoUndo then begin
                        macro := false;
                        exit(ScaleAndRotate)
                    end;
        with info^ do
            UseNearestNeighbor := (rsMethod = NearestNeighbor) or (LutMode = ColorLut);
        DrawTools;
        AutoSelectAll := not Info^.RoiShowing;
        if AutoSelectAll then
            SelectAll(true);
        ShowWatch;
        if UseSameWindow then begin
                SetupUndo;
                WhatToUndo := UndoEdit;
                SetupUndoInfoRec;
                SrcInfo := UndoInfo;
                DstInfo := Info;
                if rsAngle = 0.0 then
                    DoOperation(EraseOp);
            end
        else
            SrcInfo := info;
        AngleInRadians := -((rsAngle + 270.0) / 360.0) * 2.0 * pi;
        CosAngle := cos(AngleInRadians);
        SinAngle := sin(AngleInRadians);
        with info^ do begin
                SourceRect := RoiRect;
                DstRect := RoiRect;
            end;
        with SourceRect do begin
                SrcWidth := right - left;
                SrcHeight := bottom - top;
                hSrcCenter := left + (SrcWidth div 2);
                vSrcCenter := top + (SrcHeight div 2);
                DstWidth := SrcWidth;
                DstHeight := SrcHeight;
            end;
        if UseSameWindow then
            with DstRect, info^ do begin
                    if rsHScale <> 1.0 then begin
                            DstWidth := round(SrcWidth * rsHScale);
                            SaveWidth := DstWidth;
                            left := left - (DstWidth - SrcWidth) div 2;
                            if DstWidth > PicRect.right then
                                DstWidth := PicRect.right;
                            if left < 0 then
                                left := 0;
                            right := left + DstWidth;
                            if DstWidth <> SaveWidth then begin
                                    SrcWidth := round(SrcWidth * (DstWidth / SaveWidth));
                                    SourceRect.left := hSrcCenter - SrcWidth div 2;
                                    SourceRect.right := SourceRect.left + SrcWidth;
                                end;
                        end;
                    if rsVScale <> 1.0 then begin
                            DstHeight := round(SrcHeight * rsVScale);
                            SaveHeight := DstHeight;
                            top := top - (DstHeight - SrcHeight) div 2;
                            if DstHeight > PicRect.bottom then
                                DstHeight := PicRect.bottom;
                            if top < 0 then
                                top := 0;
                            bottom := top + DstHeight;
                            if DstHeight <> SaveHeight then begin
                                    SrcHeight := round(SrcHeight * (DstHeight / SaveHeight));
                                    SourceRect.top := vSrcCenter - SrcHeight div 2;
                                    SourceRect.bottom := SourceRect.top + SrcHeight;
                                end;
                        end
                end {with}
        else begin
                DstWidth := round(SrcWidth * rsHScale);
                DstHeight := round(SrcHeight * rsVScale);
                if not NewPicWindow('Untitled', DstWidth, DstHeight) then begin
                        KillRoi;
                        exit(ScaleAndRotate)
                    end;
                DstInfo := info;
                DstRect := info^.PicRect;
            end;
        with DstRect do begin
                hStart := left;
                vStart := top;
                hDstCenter := left + (DstWidth div 2);
                vDstCenter := top + (DstHeight div 2);
            end;
        hend := hstart + DstWidth - 1;
        vend := vstart + DstHeight - 1;
        rotate := rsAngle <> 0.0;
        ShowMessage(CmdPeriodToStop);
        StartTicks := TickCount;
        if not rotate and (rsMethod = NearestNeighbor) then
            ScaleUsingCopyBits
        else if not rotate and not UseNearestNeighbor then
            DoInterpolatedScaling
        else
            for vloc := vStart to vEnd do begin
                    for hloc := hStart to hEnd do begin
                            hrel := hloc - hDstCenter;
                            vrel := vloc - vDstCenter;
                            htemp := hrel * SinAngle + vrel * CosAngle;
                            vtemp := vrel * SinAngle - hrel * CosAngle;
                            htemp := htemp / rsHScale;
                            vtemp := vtemp / rsVScale;
                            h := htemp + hSrcCenter;
                            v := vtemp + vSrcCenter;
                            info := SrcInfo;
                            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 := DstInfo;
                            PutPixel(hloc, vloc, value);
                        end; {for hloc:=}
                    SetRect(MaskRect, hstart, vloc, hend, vloc + 1);
                    UpdateScreen(MaskRect);
                    if CommandPeriod then begin
                            beep;
                            KillRoi;
                            exit(ScaleAndRotate)
                        end;
                end; {for vloc:=}
        ShowTime(StartTicks, DstRect, '');
        KillRoi;
        with info^ do begin
                changes := true;
                if not UseSameWindow and (PixMapSize > UndoBufSize) then
                    PutWarning;
                if SpatiallyCalibrated and (not UseSameWindow) then begin
                        RawSpatialScale := RawSpatialScale * (DstWidth / SrcWidth);
                        xSpatialScale := RawSpatialScale * ScaleMagnification;
                        PixelAspectRatio := PixelAspectRatio * rsHScale / rsVScale;
                        ySpatialScale := xSpatialScale / PixelAspectRatio;
                    end;
            end;
        if not UseSameWindow and AutoSelectAll then begin
                SaveInfo := Info;
                Info := SrcInfo;
                KillRoi;
                Info := SaveInfo;
            end;
        if UseSameWindow then
            with NoInfo^ do begin
                    roiType := RectRoi;
                    RoiRect := DstRect;
                    RectRgn(roiRgn, DstRect);
                end;
    end;


    procedure ActivateWindow;
    begin
        with info^ do begin
                IsInsertionPoint := false;
                WhatToUndo := NothingToUndo;
                UndoFromClip := false;
                DrawLabels('', '', '');
                MouseState := NotInRoi;
                RoiUpdateTime := 0;
                pmForeColor(ForegroundIndex);
                pmBackColor(BackgroundIndex);
                nCoordinates := 0;
                ShowRoi;
            end;
    end;


    procedure UpdateResultsWindow;
    begin
        SetPort(ResultsWindow);
        DrawControls(ResultsWindow);
        DrawGrowIcon(ResultsWindow);
        if ResultsWindow = FrontWindow then begin
                TEUpdate(ResultsWindow^.visRgn^^.rgnBBox, ListTE);
                ShowControl(hScrollBar);
                ShowControl(vScrollBar);
            end
        else begin
                HideControl(hScrollBar);
                HideControl(vScrollBar);
            end;
    end;


    procedure ScrollText;
        var
            value: INTEGER;
    begin
        with ListTE^^ do
            TEScroll((viewRect.left - destRect.left) - GetCtlValue(hScrollBar), (viewRect.top - destRect.top) - (GetCtlValue(vScrollBar) * LineHeight), ListTE);
    end;


    procedure UpdateScrollBars;
        var
            vMax, vValue, hMax, hValue: integer;
    begin
        with ListTE^^, ListTE^^.viewRect do begin
                vListPageSize := (bottom - top) div LineHeight;
                hListPageSize := right - left;
                vMax := nLines - vListPageSize;
                hMax := (nListColumns + 1) * (FieldWidth + 1) * 6 - hListPageSize;
                vValue := (top - destRect.top) div LineHeight;
                hValue := left - destRect.left
            end;
        if vMax < 0 then
            vMax := 0;
        if vValue < 0 then
            vValue := 0;
        if hMax < 0 then
            hMax := 0;
        if vValue < 0 then
            vValue := 0;
        SetCtlMax(vScrollBar, vMax);
        SetCtlValue(vScrollBar, vValue);
        SetCtlMax(hScrollBar, hMax);
        SetCtlValue(hScrollBar, hValue);
{ShowMessage(concat('nListColumns= ', Long2str(nListColumns), cr, 'hListPageSize= ', long2str(hListPageSize)));}
    end;


    procedure InitTextEdit (font, size: integer);
        var
            dRect, vRect: rect;
    begin
        SetPort(ResultsWindow);
        with ResultsWindow^.portRect do
            SetRect(dRect, left + 4, top, right - 18, bottom - 24);
        vRect := dRect;
        ListTE := TENew(dRect, vRect);
        with ListTE^^ do begin
                TxFont := font;
                TxSize := size;
                crOnly := -1;
            end;
        if TextBufSize > 0 then begin
                TESetText(ptr(TextBufP), TextBufSize, ListTe);
                TECalText(ListTE);
            end;
        UpdateScrollBars;
    end;


    procedure ScrAction (theCtl: ControlHandle; partCode: integer);
        var
            bInc, pInc, delta: integer;
    begin
        if theCtl = vScrollBar then begin
                bInc := 1;
                pInc := vListPageSize
            end
        else begin
                bInc := 4;
                pInc := hListPageSize
            end;
        case partCode of
            inUpButton:
                delta := -bInc;
            inDownButton:
                delta := bInc;
            inPageUp:
                delta := -pInc;
            inPageDown:
                delta := pInc;
            otherwise
                exit(ScrAction);
        end;
        SetCtlValue(theCtl, GetCtlValue(theCtl) + delta);
        ScrollText;
    end;


    procedure DoMouseDownInResults (loc: point);
        var
            theCtl: ControlHandle;
            cValue: integer;
    begin
        SelectWindow(ResultsWindow);
        SetPort(ResultsWindow);
        GlobalToLocal(loc);
        case FindControl(loc, ResultsWindow, theCtl) of
            inUpButton, inDownButton, inPageUp, inPageDown:
                if TrackControl(theCtl, loc, @ScrAction) <> 0 then
                    ;
            inThumb:
                if TrackControl(theCtl, loc, nil) <> 0 then
                    ScrollText;
            otherwise
        end;
    end;


    procedure AppendResults;
        var
            vMax: integer;
    begin
        if ResultsWindow <> nil then
            with ListTE^^ do begin
                    if teLength > 32000 then
                        exit(AppendResults);
                    CopyResultsToBuffer(mCount, mCount, true);
                    TESetSelect(teLength, teLength, ListTE);
                    TEInsert(ptr(TextBufP), TextBufSize, ListTE);
                    with ListTE^^ do begin
                            vListPageSize := (viewRect.bottom - viewRect.top) div LineHeight;
                            vMax := nLines - vListPageSize;
                        end;
                    if vMax < 0 then
                        vMax := 0;
                    SetCtlMax(vScrollBar, vMax);
                    SetCtlValue(vScrollBar, GetCtlMax(vScrollBar));
                    ScrollText;
                end;
    end;


    procedure DeleteLines (first, last: integer);
    begin
        if ResultsWindow <> nil then
            with ListTE^^ do begin
                    first := first + 2; {Accounts for 2 line header}
                    last := last + 2;
                    if (first = 3) and (last = 3) then
                        first := 1; {if deleting first line then delete header too}
                    if (first < 1) or (first > nLines) or (last < 1) or (last > nLines) then
                        exit(DeleteLines);
                    TESetSelect(LineStarts[first - 1], LineStarts[last], ListTE);
                    TEDelete(ListTE);
                end;
    end;


    procedure UpdateList;
    begin
        if (ResultsWindow <> nil) and (mCount > 0) then
            with ListTE^^ do begin
                    CopyResultsToBuffer(1, mCount, true);
                    TESetSelect(0, teLength, ListTE);
                    TEDelete(ListTE);
                    TEInsert(ptr(TextBufP), TextBufSize, ListTE);
                    UpdateScrollBars;
                end;
    end;


    procedure SelectSlice (i: integer);
    begin
        with info^, info^.StackInfo^ do
            if i <= nSlices then begin
                    hunlock(PicBaseHandle);
                    PicBaseHandle := PicBaseH[i];
                    hlock(PicBaseHandle);
                    PicBaseAddr := StripAddress(PicBaseHandle^);
                    osPort^.PortPixMap^^.BaseAddr := PicBaseAddr;
                end;
    end;


    procedure ShowMeter;
        const
            MeterWidth = 264;
            MeterHeight = 64;
        var
            trect: rect;
            hloc, vloc: integer;
    begin
        hloc := ScreenWidth div 2 - MeterWidth div 2;
        vloc := ScreenHeight div 4 - MeterHeight div 2;
        SetRect(trect, hloc, vloc, hloc + MeterWidth, vloc + MeterHeight);
        MeterWindow := NewWindow(nil, trect, '', true, dBoxProc, nil, false, 0);
        BringToFront(MeterWindow);
    end;


    procedure UpdateMeter; {(percentdone: integer; str: str255)}
        const
            left = 16;
            top = 28;
            right = 248;
            bottom = 44;
        var
            r: rect;
    begin
        if MeterWindow = nil then
            ShowMeter;
        if (percentdone >= 0) then begin
                SetPort(MeterWindow);
                TextFont(SystemFont);
                TextSize(12);
                TextMode(SrcCopy);
                MoveTo(left, top div 2);
                DrawString(str);
                SetRect(r, left + StringWidth(str), 0, right, top);
                EraseRect(r);
                SetRect(r, left, top, right, bottom);
                FrameRect(r);
                SetRect(r, left + 1, top + 1, left + (percentdone * (right - left)) div 100 - 1, bottom - 1);
                FillRect(r, gray);
            end     {then}
        else begin
                DisposeWindow(MeterWindow);
                MeterWindow := nil;
            end;     {else}
    end;


    function RgnNotTooBig; {(Rgn1, Rgn2: RgnHandle): boolean}
    begin
        RgnNotTooBig := GetHandleSize(handle(Rgn1)) + GetHandleSize(handle(Rgn2)) < 30000
    end;


    procedure ComputeLength (FindingPerimeterLength: boolean);
        var
            i: integer;
            xtemp, ytemp: LongInt;
            xt, yt: extended;
    begin
        with info^ do begin
                uLength := 0.0;
                cLength := 0.0;
                for i := 2 to nCoordinates do begin
                        xtemp := xCoordinates^[i] - xCoordinates^[i - 1];
                        ytemp := yCoordinates^[i] - yCoordinates^[i - 1];
                        uLength := uLength + sqrt(xtemp * xtemp + ytemp * ytemp);
                        if SpatiallyCalibrated then begin
                                xt := xtemp / xSpatialScale;
                                yt := ytemp / ySpatialScale;
                                cLength := cLength + sqrt(xt * xt + yt * yt);
                            end;
                    end;
                if FindingPerimeterLength then begin
                        xtemp := xCoordinates^[1] - xCoordinates^[nCoordinates];
                        ytemp := yCoordinates^[1] - yCoordinates^[nCoordinates];
                        uLength := uLength + sqrt(xtemp * xtemp + ytemp * ytemp);
                        if SpatiallyCalibrated then begin
                                xt := xtemp / xSpatialScale;
                                yt := ytemp / ySpatialScale;
                                cLength := cLength + sqrt(xt * xt + yt * yt);
                            end;
                    end;
                if not SpatiallyCalibrated then
                    cLength := uLength;
                uLength := uLength / magnification;
                cLength := cLength / magnification;
            end; {with}
    end;


    procedure MakeOutline;
{Creates a "marching ants" outline from a list of offscreen XY coordinates.}
        var
            i: integer;
            TempRgn: RgnHandle;
            spt, pt: point;
    begin
        with Info^ do begin
                if SelectionMode <> NewSelection then
                    TempRgn := NewRgn;
                SetPort(wptr);
                PenNormal;
                OpenRgn;
                spt.h := xCoordinates^[1];
                spt.v := yCoordinates^[1];
                MoveTo(spt.h, spt.v);
                for i := 2 to nCoordinates do begin
                        pt.h := xCoordinates^[i];
                        pt.v := yCoordinates^[i];
                        LineTo(pt.h, pt.v);
                    end;
                LineTo(spt.h, spt.v);
                case SelectionMode of
                    NewSelection:  begin
                            CloseRgn(roiRgn);
                            ComputeLength(true);
                        end;
                    AddSelection:  begin
                            CloseRgn(TempRgn);
                            if RgnNotTooBig(roiRgn, TempRgn) then
                                UnionRgn(roiRgn, TempRgn, roiRgn);
                            uLength := 0.0;
                            cLength := 0.0;
                        end;
                    SubSelection:  begin
                            CloseRgn(TempRgn);
                            if RgnNotTooBig(roiRgn, TempRgn) then
                                DiffRgn(roiRgn, TempRgn, roiRgn);
                            uLength := 0.0;
                            cLength := 0.0;
                        end;
                end;
                RoiShowing := true;
                roiType := RgnRoi;
                RoiRect := roiRgn^^.rgnBBox;
                UpdatePicWindow;
            end;
        if SelectionMode <> NewSelection then
            DisposeRgn(TempRgn);
        WhatToUndo := NothingToUndo;
        measuring := false;
    end;


end.