Carousel Volume 2 #1/carousel.iso/mactosh/lang/p_image1.sit/LSP Source/Analysis.p

Text File | 1989-07-14 | 44.5 KB | 1,784 lines

unit Analysis;

{Analysis routines used by the Image program}

interface

    uses
        QuickDraw, OSIntf, PickerIntf, PrintTraps, ToolIntf, globals, Utilities, LeastSquares, Graphics, FileUnit;



    procedure DoHistogram;
    procedure GetRectHistogram;
    procedure GetNonRectHistogram;
    procedure ShowContinuousHistogram;
    procedure ComputeResults;
    procedure Measure;
    procedure ComputeLength (nvertices: integer; var xa, ya: xyArray; FindingPerimeterLength: boolean);
    procedure DoProfilePlotOptions;
    procedure ListResults;
    procedure ColumnAveragePlot;
    procedure SetScale;
    procedure Calibrate;
    procedure ResetCounters;
    procedure DoMeasurementOptions;
    procedure DoPoints (event: EventRecord);
    procedure FindAngle (event: EventRecord);
    procedure SaveBlankField;
    procedure UndoLastMeasurement;
    procedure NumberSelection (count: integer);
    procedure AutoOutline (start: point);


implementation

    var
        WandMode: (LUTMode, GrayMapMode, BinaryMode);


    procedure DoHistogramOfLine (data: ptr; var histogram: HistogramType; width: LongInt);
{}
{TYPE}
{  lptr=^LineType;}
{VAR}
{  line:lptr;}
{  i,value:integer;}
{BEGIN}
{  line:=lptr(data);}
{  FOR i:=0 TO width-1 DO BEGIN}
{    value:=line^[i];}
{    histogram[value]:=histogram[value]+1;}
{  END;}
{}
    {a0=data}
    {a1=histogram}
    {d0=width}
    {d1=pixel value}
    inline
        $4E56, $0000, {  link a6,#0}
        $48E7, $C0C0, {  movem.l a0-a1/d0-d1,-(sp)}
        $206E, $000C, {  move.l 12(a6),a0}
        $226E, $0008, {  move.l 8(a6),a1}
        $202E, $0004, {  move.l 4(a6),d0}
        $5380,       {  subq.l #1,d0}
        $4281,       {L clr.l d1}
        $1218,       {  move.b (a0)+,d1}
        $E541,       {  asl.w #2,d1}
        $52B1, $1800, {  addq.l #1,0(a1,d1.l)}
        $51C8, $FFF4, {  dbra d0,L}
        $4CDF, $0303, {  movem.l (sp)+,a0-a1/d0-d1}
        $4E5E,       {  unlk a6}
        $DEFC, $000C; {  add.w #12,sp}
{END;}


    procedure GetRectHistogram;
        var
            width, i, NumberOfLines: integer;
            offset: LongInt;
            p: ptr;
    begin
        ShowWatch;
        for i := 0 to 255 do
            Histogram[i] := 0;
        with info^.osroiRect, info^ do begin
                offset := LongInt(top) * BytesPerRow + left;
                p := ptr(ord4(PicBaseAddr) + offset);
                width := right - left;
                NumberOfLines := bottom - top;
            end;
        if width > 0 then
            for i := 1 to NumberOfLines do begin
                    DoHistogramOfLine(p, histogram, width);
                    p := ptr(ord4(p) + info^.BytesPerRow);
                end
    end;


    procedure GetNonRectHistogram;
        var
            tPort: GrafPtr;
            MaskLine, DataLine: LineType;
            width, i, vloc: integer;
            sum, sum2, count, OverFlows: LongInt;
            SaveInfo: InfoPtr;
            BoundingRect: rect;
            value: LongInt;
    begin
        ShowWatch;
        GetPort(tPort);
        SetupUndo;
        UndoInfoRec := info^;
        UndoInfo := @UndoInfoRec;
        with UndoInfo^ do begin
                PicBaseAddr := UndoBuf;
                BytesPerRow := PixelsPerLine;
            end;
        SaveInfo := Info;
        for i := 0 to 255 do
            Histogram[i] := 0;
        with Info^ do begin
                SetPort(GrafPtr(osPort));
                with osPort^ do
                    if fgcolor = bkcolor then
                        bkColor := 255 - ForegroundColor;
                PenNormal;
                BoundingRect := osroiRect;
                EraseRect(BoundingRect);
                PaintRgn(osroiRgn);
                UpdateScreen(roiRect);
            end;
        with BoundingRect do begin
                width := right - left;
                for vloc := top to bottom - 1 do begin
                        Info := UndoInfo;
                        GetLine(left, vloc, width, DataLine);
                        Info := SaveInfo;
                        GetLine(left, vloc, width, MaskLine);
                        for i := 0 to width - 1 do
                            if MaskLine[i] = ForegroundColor then begin
                                    value := DataLine[i];
                                    histogram[value] := histogram[value] + 1;
                                end;
                    end;
            end;
        undo;
        with info^ do begin
                UpdateScreen(roiRect);
                osPort^.bkColor := BackgroundColor;
            end;
        SetPort(tPort);
    end;


    procedure ComputeResults;
        var
            MaxCount, icount, isum: LongInt;
            i: integer;
            sum, sum2, ri, rcount, UncalibratedMean, tSD, rmode, xc, yc: extended;
    begin
        with results do begin
                if Thresholding then
                    i := ThresholdStart
                else
                    i := 0;
                while (histogram[i] = 0) and (i < 255) do
                    i := i + 1;
                min := value[i];
                imin := i;
                if Thresholding then
                    i := ThresholdEnd
                else
                    i := 255;
                while (histogram[i] = 0) and (i > 0) do
                    i := i - 1;
                max := value[i];
                imax := i;
                MaxCount := 0;
                sum := 0.0;
                isum := 0;
                sum2 := 0.0;
                n := 0;
                for i := imin to imax do begin
                        icount := histogram[i];
                        rcount := icount;
                        sum := sum + rcount * value[i];
                        isum := isum + icount * i;
                        ri := i;
                        sum2 := sum2 + sqr(value[i]) * rcount;
                        n := n + icount;
                        if icount > MaxCount then begin
                                MaxCount := icount;
                                rmode := value[i];
                                imode := i
                            end;
                    end;
                if ContinuousHistoGram then
                    exit(ComputeResults);
                if n > 0 then begin
                        tmean := sum / n;
                        UncalibratedMean := isum / n
                    end
                else begin
                        tmean := 0.0;
                        UncalibratedMean := 0.0
                    end;
                imean := round(UncalibratedMean);
                if nAreas < MaxAreas then begin
                        nAreas := nAreas + 1;
                        UnsavedAreas := UnsavedAreas + 1
                    end
                else
                    beep;
                mean[nAreas] := tmean;
                if nAreas <= MaxStandards then
                    umean[nAreas] := UncalibratedMean;
                if (n > 0) and (tmean > 0.0) then begin
                        rcount := n;
                        tSD := (rcount * Sum2 - sqr(sum)) / rcount;
                        if tSD > 0.0 then
                            tSD := sqrt(tSD / (rcount - 1.0))
                        else
                            tSD := 0.0
                    end
                else
                    tSD := 0.0;
                SD[nAreas] := tSD;
                if xyLocM in measurements then
                    with info^, info^.osRoiRect do begin
                            xc := left + (right - left) / 2;
                            yc := top + (bottom - top) / 2;
                            yc := PicRect.bottom - yc - 1.0;
                            if scale <> 0.0 then begin
                                    xc := xc / scale;
                                    yc := yc / scale;
                                end;
                            xcenter[nAreas] := xc;
                            ycenter[nAreas] := yc;
                        end
                else begin
                        xcenter[nAreas] := 0.0;
                        ycenter[nAreas] := 0.0
                    end;
                PixelCount[nAreas] := n;
                mode[nAreas] := rmode;
                if PerimeterM in measurements then
                    if (CurrentTool = FreehandTool) or (CurrentTool = PolygonTool) then
                        plength[nAreas] := Length
                    else
                        with info^, info^.osroirect do begin
                                case RoiType of
                                    RectRoi, RoundRectRoi:
                                        length := ((right - left) + (bottom - top)) * 2.0;
                                    OvalRoi:
                                        length := pi * ((right - left) + (bottom - top)) / 2.0;
                                    otherwise
                                end;
                                if scale <> 0.0 then
                                    length := length / scale;
                                plength[nAreas] := length;
                            end;
            end; {with}
        measuring := true;
    end;


    procedure Measure;
        var
            AutoSelectAll: boolean;
    begin
        if NotInBounds then
            exit(Measure);
        AutoSelectAll := not info^.RoiShowing;
        if AutoSelectAll then
            SelectAll(false);
        if info^.RoiType = RectRoi then
            GetRectHistogram
        else
            GetNonRectHistogram;
        ComputeResults;
        ShowResults;
        info^.RoiShowing := true;
        WhatToUndo := UndoMeasurement;
        if AutoSelectAll then
            KillRoi;
        UpdateScreen(OldRoiRect);
    end;


    procedure ShowHistogram;
        var
            htop: integer;
            tport: GrafPtr;
            hrect, prect, srect: rect;
    begin
        GetPort(tPort);
        if HistoWindow = nil then begin
                htop := ScreenHeight - hheight - 10;
                SetRect(HistoRect, hleft, htop, hleft + hwidth, htop + hheight);
                HistoWindow := NewWindow(nil, HistoRect, 'Histogram', true, NoGrowDocProc, nil, true, 0);
                WindowPeek(HistoWindow)^.WindowKind := HistoKind;
                SetMenuItem(GetMHandle(WindowsMenu), 7, true);
            end;
        SelectWindow(HistoWindow);
        SetPort(HistoWindow);
        InvalRect(HistoWindow^.PortRect);
        SetPort(tPort);
    end;


    procedure DoHistogram;
        var
            AutoSelectAll: boolean;
    begin
        if digitizing then begin
                if ContinuousHistogram then
                    ContinuousHistogram := false
                else begin
                        ContinuousHistogram := true;
                        if info <> NoInfo then
                            with info^ do begin
                                    RoiType := NoRoi;
                                    osroiRect := SrcRect;
                                end;
                    end;
                exit(DoHistogram)
            end;
        if NotInBounds then
            exit(DoHistogram);
        AutoSelectAll := not info^.RoiShowing;
        if AutoSelectAll then
            SelectAll(false);
        if info^.RoiType = RectRoi then
            GetRectHistogram
        else
            GetNonRectHistogram;
        ComputeResults;
        ShowHistogram;
        ShowResults;
        WhatToUndo := UndoMeasurement;
        if AutoSelectAll then
            KillRoi;
    end;


    procedure ShowContinuousHistogram;
        const
            skip = 10;
        var
            width, i, NumberOfLines: integer;
            offset: LongInt;
            p: ptr;
    begin
        for i := 0 to 255 do
            Histogram[i] := 0;
        with info^.PicRect, info^ do begin
                p := PicBaseAddr;
                width := right - left;
                NumberOfLines := ((bottom - top) div skip) - 1;
                offset := BytesPerRow * skip;
            end;
        for i := 1 to NumberOfLines do begin
                DoHistogramOfLine(p, histogram, width);
                p := ptr(ord4(p) + offset);
            end;
        ComputeResults;
        ShowHistogram;
    end;


    procedure ColumnAveragePlot;
        var
            vloc, value, width, height, i: integer;
            sum: array[0..MaxPixelsPerLine] of LongInt;
            start: point;
            tPort: GrafPtr;
    begin
        if NoSelection or NotRectangular or NotInBounds then
            exit(ColumnAveragePlot);
        ShowWatch;
        with info^.osroiRect do begin
                width := right - left;
                height := bottom - top;
                for i := 0 to width - 1 do
                    sum[i] := 0;
                for vloc := top to bottom - 1 do begin
                        GetLine(left, vloc, width, PlotData);
                        for i := 0 to width - 1 do
                            sum[i] := sum[i] + PlotData[i];
                    end;
                start.h := left;
                start.v := bottom;
                OffscreenToScreen(start);
            end;
        for i := 0 to width - 1 do
            PlotData[i] := sum[i] div height;
        PlotCount := width;
        PlotAvg := height;
        SetupPlot(PlotData, start);
    end;


    procedure SetScale;
        const
            DistanceID = 3;
            ScaleID = 15;
            UnitsTextID = 17;
        var
            mylog: DialogPtr;
            item, i, SaveUnitsID: integer;
            distance, SaveScale: extended;
            ignore: integer;
            str: str255;
            SaveUnits: string[2];
    begin
        if nLengths = 0 then begin
                PutMessage('Before setting the scale you must use the ruler tool to measure a known ', 'distance along a ruler or other scale.', '');
                exit(SetScale)
            end;
        InitCursor;
        with info^ do begin
                SaveUnits := units;
                SaveUnitsID := UnitsID;
                SaveScale := scale;
                distance := 0.0;
                mylog := GetNewDialog(10, nil, pointer(-1));
                SetDReal(MyLog, DistanceID, distance, 1);
                SelIText(MyLog, DistanceID, 0, 32767);
                SetDReal(MyLog, ScaleID, scale, 2);
                SetDString(MyLog, UnitsTextID, units);
                OutlineButton(MyLog, ok, 16);
                SetDialogItem(mylog, UnitsID, 1);
                repeat
                    ModalDialog(nil, item);
                    if item = distanceID then
                        distance := GetDReal(MyLog, DistanceID);
                    if (item >= 5) and (item <= 13) then begin
                            for i := 5 to 13 do
                                SetDialogItem(mylog, i, 0);
                            SetDialogItem(mylog, item, 1);
                            UnitsID := item;
                            case UnitsID of
                                5:
                                    units := 'nm';
                                6:
                                    units := '╡m';
                                7:
                                    units := 'mm';
                                8:
                                    units := 'cm';
                                9:
                                    units := 'm ';
                                10:
                                    units := 'km';
                                11:
                                    units := 'in';
                                12:
                                    units := 'ft';
                                13:
                                    units := 'mi';
                            end;
                        end;
                    if distance > 0.0 then
                        scale := PixelLength / distance;
                    SetDReal(MyLog, ScaleID, scale, 2);
                    SetDString(MyLog, UnitsTextID, units);
                until (item = ok) or (item = cancel);
                DisposDialog(mylog);
                if item = cancel then begin
                        units := SaveUnits;
                        UnitsID := SaveUnitsID;
                        scale := SaveScale;
                    end;
            end; {with info^}
    end;


    procedure SetupCalibrationPlot;
        const
            hrange = 1024;
            hmax = 1023;
            vrange = 600;
            vmax = 599;
            SymbolSize = 11;
        var
            fRect, tRect: rect;
            svalue, range, hscale, vscale, MinV, MaxV: extended;
            tPort: GrafPtr;
            i, hloc, vloc: integer;
            ClipRegion, SaveClipRegion: RgnHandle;
            pt: point;
    begin
        PlotLeftMargin := 35;
        PlotTopMargin := 15;
        PlotBottomMargin := 30;
        PlotRightMargin := 100;
        MinV := MinValue;
        MaxV := MaxValue;
        for i := 1 to nStandards do begin
                svalue := StandardValues[i];
                if svalue < MinV then
                    MinV := svalue;
                if svalue > MaxV then
                    MaxV := svalue;
            end;
        range := MaxV - MinV;
        PlotWidth := hrange div 3 + PlotLeftMargin + PlotRightMargin;
        PlotHeight := vrange div 3 + PlotTopMargin + PlotBottomMargin;
        PlotLeft := 64;
        PlotTop := 64;
        PlotCount := 256;
        MakePlotWindow(PlotLeft, PlotTop, PlotWidth, PlotHeight);
        WindowPeek(PlotWindow)^.WindowKind := CalibrationPlotKind;
        SetRect(fRect, -SymbolSize, -SymbolSize, hmax + SymbolSize, vmax + SymbolSize);
        GetPort(tPort);
        SetPort(PlotWindow);
        SaveClipRegion := PlotWindow^.ClipRgn;
        ClipRegion := NewRgn;
        OpenRgn;
        FrameRect(fRect);
        CloseRgn(ClipRegion);
        PlotWindow^.ClipRgn := ClipRegion;
        hscale := 256 / hrange;
        vscale := range / vrange;
        PlotPICT := OpenPicture(fRect);
        for i := 1 to nStandards do begin
                hloc := round(umean[i] / hscale);
                vloc := vmax - round((StandardValues[i] - MinValue) / vscale);
                SetRect(tRect, hloc - SymbolSize, vloc - SymbolSize, hloc + SymbolSize, vloc + SymbolSize);
                FrameOval(tRect);
            end;
        MoveTo(0, vmax - round((value[0] - MinValue) / vscale));
        for i := 1 to 255 do begin
                hloc := round(i / hscale);
                vloc := vmax - round((value[i] - MinValue) / vscale);
                LineTo(hloc, vloc);
            end;
        ClosePicture;
        PlotWindow^.ClipRgn := SaveClipRegion;
        DisposeRgn(ClipRegion);
        InvalRect(PlotWindow^.PortRect);
        SetPort(tPort);
        SelectWindow(PlotWindow);
    end;


    procedure DoCurveFitting;
        var
            i: integer;
            XData, YData, YFit, Residuals: TNColumnVector;
            Solution: TNRowVector; {Coefficients}
            TypeFit: FitType;
            Variance: extended;
            SumResidualsSqr, SumStandards, mean, SumMeanDiffSqr, DegreesOfFreedom: extended;
            err: byte;
            fil: text;
            str1, str2: str255;
    begin
        with info^ do begin
                ShowWatch;
                for i := 1 to nStandards do begin
                        XData[i] := umean[i];
                        YData[i] := StandardValues[i];
                    end;
                case fit of
                    StrightLine:
                        begin
                            nCoefficients := 2;
                            TypeFit := poly
                        end;
                    Poly2:
                        begin
                            nCoefficients := 3;
                            TypeFit := poly
                        end;
                    Poly3:
                        begin
                            nCoefficients := 4;
                            TypeFit := poly
                        end;
                    Poly4:
                        begin
                            nCoefficients := 5;
                            TypeFit := poly
                        end;
                    Poly5:
                        begin
                            nCoefficients := 6;
                            TypeFit := poly
                        end;
                    ExpoFit:
                        begin
                            nCoefficients := 2;
                            TypeFit := expo
                        end;
                    PowerFit:
                        begin
                            nCoefficients := 2;
                            TypeFit := power
                        end;
                    LogFit:
                        begin
                            nCoefficients := 2;
                            TypeFit := log
                        end;
                end;
                DegreesOfFreedom := nStandards - nCoefficients;
                if DegreesOfFreedom < 0 then begin
                        FitGoodness := 0.0;
                        calibrated := false;
                        NumToString(nCoefficients, str1);
                        case fit of
                            StrightLine:
                                str2 := 'straight line';
                            Poly2:
                                str2 := '2nd degree polynomial';
                            Poly3:
                                str2 := '3rd degree polynomial';
                            Poly4:
                                str2 := '4th degree polynomial';
                            Poly5:
                                str2 := '5th degree polynomial';
                            ExpoFit:
                                str2 := 'exponential';
                            PowerFit:
                                str2 := 'power';
                            LogFit:
                                str2 := 'log';
                        end;
                        str2 := concat(' standards to do ', str2, ' fitting.');
                        PutMessage('You need at least ', str1, str2);
                        exit(DoCurveFitting)
                    end;
                LeastSquares(nStandards, XData, YData, nCoefficients, Solution, YFit, Residuals, FitSD, Variance, err, TypeFit);
                if err = 111 then begin {Borland's curve fitting routine is missing.}
                        beep;
                        exit(DoCurveFitting)
                    end;
                for i := 1 to nCoefficients do
                    Coefficient[i] := solution[i];
                calibrated := true;
                GenerateValues;
                SumResidualsSqr := 0.0;
                SumStandards := 0.0;
                for i := 1 to nStandards do begin
                        SumResidualsSqr := SumResidualsSqr + sqr(residuals[i]);
                        SumStandards := SumStandards + StandardValues[i];
                    end;
                mean := SumStandards / nStandards;
                SumMeanDiffSqr := 0.0;
                for i := 1 to nStandards do
                    SumMeanDiffSqr := SumMeanDiffSqr + sqr(StandardValues[i] - Mean);
                if SumMeanDiffSqr > 0.0 then
                    FitGoodness := 1 - (SumResidualsSqr / DegreesOfFreedom) * ((nStandards - 1) / SumMeanDiffSqr)
                else
                    FitGoodness := 1.0;
            end;
        info^.changes := true;
    end;


    procedure GetLineFromFile (f: integer; var str: string);
        var
            err: osErr;
            a: packed array[1..2] of char;
            c: char;
            ByteCount: LongInt;
            done: boolean;
    begin
        str := '';
        repeat
            ByteCount := 1;
            err := fsRead(f, ByteCount, @a);
            c := a[1];
            done := (c = return) or (err <> NoErr);
            if not done then
                str := concat(str, c);
        until (c = return) or (err <> NoErr);
    end;


    procedure GetStandardsFromFile (mylog: DialogPtr; FirstID: integer);
        var
            where: Point;
            typeList: SFTypeList;
            reply: SFReply;
            err: OSErr;
            str: string;
            f, i: integer;
    begin
        where.v := 120;
        where.h := 120;
        typeList[0] := 'TEXT';
        SFGetFile(Where, '', nil, 1, typeList, nil, reply);
        if reply.good then
            with reply do begin
                    err := FSOpen(fname, vRefNum, f);
                    err := SetFPos(f, fsFromStart, 0);
                    for i := 1 to nStandards do begin
                            GetLineFromFile(f, str);
                            if str <> '' then begin
                                    StandardValues[i] := StringToReal(str);
                                    SetDString(MyLog, FirstID + i - 1, str);
                                end;
                        end;
                    err := fsclose(f);
                end;
    end;


    procedure Calibrate;
        const
            FirstLevelID = 3;
            FirstStandardID = 23;
            FirstFitID = 63;
            LastFitID = 70;
            UnitOfMeasureID = 71;
            UndoID = 73;
            OpenID = 74;
        var
            mylog: DialogPtr;
            ignore, item, i, nBadReals: integer;
            str: str255;
            SaveStandards, temp: StandardsArray;
            OptionKeyWasDown: boolean;
    begin
        OptionKeyWasDown := OptionKeyDown;
        if nAreas < 2 then begin
                PutMessage('Before calibrating you must use the Measure command to read a set of standards.', '', '');
                exit(Calibrate)
            end;
        SaveStandards := StandardValues;
        with info^ do begin
                mylog := GetNewDialog(20, nil, pointer(-1));
                OutlineButton(MyLog, ok, 16);
                nStandards := nAreas;
                if nStandards > MaxStandards then
                    nStandards := MaxStandards;
                for i := 1 to nStandards do begin
                        RealToString(umean[i], 1, 2, str);
                        SetDString(MyLog, FirstLevelID + i - 1, str);
                        if StandardValues[i] <> BadReal then
                            SetDReal(MyLog, FirstStandardID + i - 1, StandardValues[i], 2);
                    end;
                SelIText(MyLog, FirstStandardID, 0, 32767);
                SetDialogItem(mylog, FirstFitID + ord(fit), 1);
                if calibrated then
                    SetDString(MyLog, UnitOfMeasureID, UnitOfMeasure);
                repeat
                    ModalDialog(nil, item);
                    if (item >= FirstStandardID) and (item < (FirstStandardID + nStandards)) then
                        StandardValues[item - FirstStandardID + 1] := GetDReal(MyLog, item);
                    if (item >= FirstLevelID) and (item < (FirstLevelID + nStandards)) then
                        if OptionKeyWasDown then
                            umean[item - FirstLevelID + 1] := GetDReal(MyLog, item)
                        else begin
                                beep;
                                i := item - FirstLevelID + 1;
                                RealToString(umean[i], 1, 2, str);
                                SetDString(MyLog, FirstLevelID + i - 1, str);
                            end;
                    if (item >= FirstFitID) and (item <= LastFitID) then begin
                            for i := FirstFitID to LastFitID do
                                SetDialogItem(mylog, i, 0);
                            SetDialogItem(mylog, item, 1);
                            fit := CurveFitType(item - FirstFitID);
                        end;
                    if item = UnitOfMeasureID then
                        UnitOfMeasure := GetDString(MyLog, item);
                    if item = OpenID then
                        GetStandardsFromFile(mylog, FirstStandardID);
                until (item = ok) or (item = cancel) or (item = UndoID);
                DisposDialog(mylog);
                if item = UndoID then begin
                        calibrated := false;
                        for i := 0 to 255 do
                            value[i] := i;
                        exit(calibrate)
                    end;
                if item = cancel then begin
                        StandardValues := SaveStandards;
                    end
                else begin
                        nBadReals := 0;
                        for i := 1 to nStandards do
                            if StandardValues[i] = BadReal then
                                nBadReals := nBadReals + 1;
                        if nBadReals = 0 then begin
                                DoCurveFitting;
                                if calibrated then
                                    SetupCalibrationPlot
                            end
                        else
                            beep;
                    end;
            end; {with info^}
    end;


    procedure ResetCounters;
        var
            AlertID: Integer;
    begin
        if (UnsavedAreas > 0) or (UnsavedLengths > 0) or (UnsavedPoints > 0) then begin
                InitCursor;
                AlertID := alert(500, nil);
            end;
        if AlertID <> CancelResetID then begin
                nLengths := 0;
                TotalLength := 0.0;
                nAreas := 0;
                nAreas2 := 0;
                results.n := 0;
                nPoints := 0;
                UnsavedAreas := 0;
                UnsavedPoints := 0;
                UnsavedLengths := 0;
                ShowResults;
            end;
        measuring := false;
    end;


    procedure InitTextEdit (font, size: integer);
        var
            maxvalue: integer;
            dRect, vRect: rect;
    begin
        SetPort(ListWindow);
        with ListWindow^.portRect do
            SetRect(dRect, left + 4, top, right - 18, bottom - 24);
        vRect := dRect;
        ListTE := TENew(dRect, vRect);
        ListTE^^.TxFont := font;
        ListTE^^.TxSize := size;
        ListTE^^.TELength := TextBufSize;
        TESetText(ptr(TextBufP), TextBufSize, ListTe);
        TECalText(ListTE);
        TEUpdate(ListWindow^.visRgn^^.rgnBBox, ListTE);
        with ListTE^^ do
            ListPageSize := (viewRect.bottom - viewRect.top) div LineHeight;
        MaxValue := ListTE^^.nLines - ListPageSize;
        if MaxValue < 0 then
            maxvalue := 0;
        SetCtlMax(ScrollBar, MaxValue);
        InitCursor;
    end;


    procedure ScrAction (theCtl: ControlHandle; partCode: integer);
        var
            delta: integer;
            S, dS: Point;
    begin
        case partCode of
            inUpButton:
                delta := -1;
            inDownButton:
                delta := +1;
            inPageUp:
                delta := -ListPageSize;
            inPageDown:
                delta := +ListPageSize;
            otherwise
                exit(ScrAction);
        end;
        SetPt(S, 0, GetCtlValue(theCtl));
        SetCtlValue(theCtl, GetCtlValue(theCtl) + delta);
        SetPt(dS, 0, S.v - GetCtlValue(theCtl));
        TEScroll(0, dS.v * ListTE^^.lineHeight, ListTE);
    end;


    procedure WindowControl (thePt: Point);
        var
            theCtl: ControlHandle;
            S, dS: Point;
    begin
        case FindControl(thePt, ListWindow, theCtl) of
            inUpButton, inDownButton, inPageUp, inPageDown:
                if TrackControl(theCtl, thePt, @ScrAction) <> 0 then
                    ;
            inThumb:
                begin
                    SetPt(S, 0, GetCtlValue(theCtl));
                    if TrackControl(theCtl, thePt, nil) <> 0 then begin
                            SetPt(dS, 0, S.v - GetCtlValue(theCtl));
                            TEScroll(0, dS.v * ListTE^^.lineHeight, ListTE);
                        end;
                end;
        end; {case}
    end;


    procedure TypeMismatch (fname: str255);
        var
            ignore: integer;
    begin
        ParamText('The file "', fname, '" is a different type, and therefore cannot be replaced', '');
        InitCursor;
        ignore := Alert(MessageID, nil);
    end;


    function IOCheck (err: OSerr): integer;
    begin
        if err <> 0 then
            beep;
        IOCheck := err;
    end;


    procedure SaveAsText;
        var
            err, f: integer;
            where: Point;
            reply: SFReply;
            TheInfo: FInfo;
            ByteCount: LongInt;
    begin
        where.v := 50;
        where.h := 50;
        SFPutFile(Where, 'Save Measurements as?', 'Measurements', nil, reply);
        if not reply.good then
            exit(SaveAsText);
        err := GetFInfo(reply.fname, reply.vRefNum, TheInfo);
        case err of
            NoErr:
                if TheInfo.fdType <> 'TEXT' then begin
                        TypeMismatch(reply.fname);
                        exit(SaveAsText)
                    end;
            FNFerr:
                begin
                    err := create(reply.fname, reply.vRefNum, 'MACA', 'TEXT');
                    if IOCheck(err) <> 0 then
                        exit(SaveAsText);
                end;
            otherwise
                if IOCheck(err) <> 0 then
                    exit(SaveAsTExt)
        end;
        CopyResultsToBuffer;
        ShowWatch;
        with reply do
            err := fsopen(fname, vRefNum, f);
        if IOCheck(err) <> 0 then
            exit(SaveAsText);
        ByteCount := TextBufSize;
        err := fswrite(f, ByteCount, ptr(TextBufP));
        if IOCheck(err) <> 0 then
            exit(SaveAsText);
        err := fsclose(f);
        err := FlushVol(nil, reply.vRefNum);
    end;


    procedure DoButton (loc: point; var nbutton: integer);
        var
            i: integer;
            TypeOfResults: ResultsType;
            IgnoreResult: boolean;
    begin
        nbutton := 0;
        for i := 1 to 4 do
            if PtInRect(loc, ListButton[i]) then
                nbutton := i;
        InvertRoundRect(ListButton[nbutton], 6, 6);
        if nbutton > 0 then begin
                while Button do begin
                        GetMouse(loc);
                        if not PtInRect(loc, ListButton[nbutton]) then begin
                                InvertRoundRect(ListButton[nbutton], 6, 6);
                                nbutton := 0;
                            end;
                    end; {while}
                if nbutton > 0 then begin
                        InvertRoundRect(ListButton[nbutton], 6, 6);
                        TypeOfResults := GetResultsType;
                        case nbutton of
                            1:
                                SaveAsText;
                            2:
                                begin
                                    case TypeOfResults of
                                        AreaT:
                                            WhatToPrint := PrintAreas;
                                        LengthT:
                                            WhatToPrint := PrintLengths;
                                        PointT:
                                            WhatToPrint := PrintPoints;
                                    end;
                                    print(true);
                                end;
                            3:
                                begin
                                    CopyResultsToBuffer;
                                    TextOnClip := true;
                                    IgnoreResult := SystemEdit(3); {Fake Copy needed for MultiFinder}
                                end;
                            4:
                                ResetCounters;
                        end;
                    end;
            end;
    end;


    procedure ShowList (title: Str255; font, size, MeasWidth: integer);
        const
            MeasLeft = 15;
            MeasTop = 50;
            ControlWidth = 15;
            ButtonWidth = 50;
        var
            wrect, crect, trect: rect;
            theEvt: EventRecord;
            tPort: GrafPtr;
            i, MeasHeight, ButtonLeft, nbutton: integer;
            loc: point;
            name: str255;
    begin
        GetPort(tPort);
        FlushEvents(everyEvent, 0);
        MeasHeight := ((TextBufLineCount * 2) + 2) * size;
        if (MeasHeight + MeasTop + 50) > ScreenHeight then
            MeasHeight := ScreenHeight - MeasTop - 50;
        SetRect(wrect, MeasLeft, MeasTop, MeasLeft + MeasWidth, MeasTop + MeasHeight);
        ListWindow := NewWindow(nil, wrect, title, true, 0, pointer(-1), true, 0);
        SetRect(crect, MeasWidth - ControlWidth, -1, MeasWidth + 1, MeasHeight - 15);
        ScrollBar := NewControl(ListWindow, crect, '', true, 0, 0, MeasHeight - 16, ScrollBarProc, 0);
        ListDone := false;
        InitTextEdit(font, size);
        DrawControls(ListWindow);
        SetRect(trect, -1, MeasHeight - 16, MeasWidth - 14, MeasHeight + 1);
        FrameRect(tRect);
        ButtonLeft := 4;
        TextFont(SystemFont);
        TextSize(12);
        for i := 1 to 4 do begin
                SetRect(ListButton[i], ButtonLeft, MeasHeight - 14, ButtonLeft + ButtonWidth, MeasHeight - 1);
                FrameRoundRect(ListButton[i], 6, 6);
                case i of
                    1:
                        name := 'Export';
                    2:
                        name := 'Print';
                    3:
                        name := 'Copy';
                    4:
                        name := 'Reset';
                end;
                with ListButton[i] do
                    MoveTo(left + ((right - left) - StringWidth(name)) div 2, bottom - 2);
                DrawString(name);
                ButtonLeft := ButtonLeft + ButtonWidth + 4;
            end;
        repeat
            if GetNextEvent(EveryEvent, theEvt) then
                if theEvt.what = MouseDown then begin
                        if PtInRect(theEvt.where, wrect) then begin
                                loc := theEvt.where;
                                GlobalToLocal(loc);
                                if loc.v > (MeasHeight - 14) then begin
                                        DoButton(loc, nbutton);
                                        ListDone := nbutton > 0
                                    end
                                else
                                    case FindWindow(theEvt.where, ListWindow) of
                                        inContent:
                                            WindowControl(loc);
                                        InGoAway:
                                            if TrackGoAway(ListWindow, TheEvt.where) then
                                                ListDone := true;
                                    end
                            end
                        else
                            ListDone := true
                    end;
            if theEvt.what = KeyDown then
                ListDone := true;
        until ListDone;
        TEDispose(ListTE);
        DisposeWindow(ListWindow);
        FlushEvents(everyEvent, 0);
        SetPort(tPort);
    end;


    procedure ListResults;
        var
            TypeOfResults: ResultsType;
            title: str255;
            width: integer;
    begin
        TypeOfResults := GetResultsType;
        if TypeOfResults = NoResults then
            PutMessage('Sorry, but no measurements are available to display.', '', '')
        else begin
                Printing := true;
                ShowingList := true;
                CopyResultsToBuffer;
                ShowingList := false;
                Printing := false;
                case TypeOfResults of
                    AreaT:
                        begin
                            title := 'Area Measurements';
                            width := 120 + nMeasurements * 72;
                            if width < 250 then
                                width := 250;
                        end;
                    LengthT:
                        begin
                            title := 'Length Measurements';
                            width := 250
                        end;
                    PointT:
                        begin
                            title := 'Point Measurements';
                            width := 275
                        end;
                    NoResults:
                end;
                ShowList(title, Monaco, 9, width);
                nAreas2 := nAreas;
            end;
    end;


    procedure DoMeasurementOptions;
        const
            FirstBoxID = 4;
            LastBoxID = 10;
        var
            mylog: DialogPtr;
            item, i: integer;
            mtype: MeasurementTypes;
    begin
        InitCursor;
        mylog := GetNewDialog(4000, nil, pointer(-1));
        mtype := AreaM;
        for i := FirstBoxID to LastBoxID do begin
                if mtype in measurements then
                    SetDialogItem(mylog, i, 1);
                if i <> LastBoxID then
                    mtype := succ(mtype);
            end;
        OutlineButton(MyLog, ok, 16);
        repeat
            ModalDialog(nil, item);
            if (item >= FirstBoxID) and (item <= LastBoxID) then begin
                    i := item - FirstBoxID;
                    case i of
                        0:
                            mtype := AreaM;
                        1:
                            mtype := MeanM;
                        2:
                            mtype := StdDevM;
                        3:
                            mtype := xyLocM;
                        4:
                            mtype := ModeM;
                        5:
                            mtype := PerimeterM;
                        6:
                            mtype := IntDenM;
                    end;
                    if mtype in measurements then begin
                            measurements := measurements - [mtype];
                            SetDialogItem(mylog, item, 0)
                        end
                    else begin
                            measurements := measurements + [mtype];
                            SetDialogItem(mylog, item, 1)
                        end;
                end;
        until (item = ok) or (item = cancel);
        DisposDialog(mylog);
        if item = cancel then begin
            end;
    end;


    procedure DoProfilePlotOptions;
        const
            AutoScaleID = 3;
            FixedScaleID = 4;
            MinID = 6;
            MaxID = 8;
            LinePlotID = 9;
            ScatterPlotID = 10;
            InvertID = 11;
            LabelsID = 12;
            VariableSizeID = 13;
            FixedSizeID = 14;
            WidthID = 17;
            HeightID = 18;
        var
            mylog: DialogPtr;
            item, i: integer;
            SaveAutoscale, SaveLinePlot, SaveInvert, SaveDrawLabels, SaveFixedSize: boolean;
            SaveWidth, SaveHeight: integer;
            SaveMin, SaveMax: extended;
    begin
        InitCursor;
        SaveAutoscale := AutoscalePlots;
        SaveLinePlot := LinePlot;
        SaveInvert := InvertPlots;
        SaveMin := ProfilePlotMin;
        SaveMax := ProfilePlotMax;
        mylog := GetNewDialog(5000, nil, pointer(-1));
        if AutoScalePlots then
            SetDialogItem(mylog, AutoScaleID, 1)
        else
            SetDialogItem(mylog, FixedScaleID, 1);
        SetDReal(MyLog, MinID, ProfilePlotMin, 2);
        SetDReal(MyLog, MaxID, ProfilePlotMax, 2);
        if FixedSizePlot then
            SetDialogItem(mylog, FixedSizeID, 1)
        else
            SetDialogItem(mylog, VariableSizeID, 1);
        SetDNum(MyLog, WidthID, ProfilePlotWidth);
        SetDNum(MyLog, HeightID, ProfilePlotHeight);
        if LinePlot then
            SetDialogItem(mylog, LinePlotID, 1)
        else
            SetDialogItem(mylog, ScatterPlotID, 1);
        if InvertPlots then
            SetDialogItem(mylog, InvertID, 1);
        if DrawPlotLabels then
            SetDialogItem(mylog, LabelsID, 1);
        OutlineButton(MyLog, ok, 16);
        repeat
            ModalDialog(nil, item);
            if (item = AutoScaleID) or (item = FixedScaleID) then begin
                    SetDialogItem(mylog, AutoScaleID, 0);
                    SetDialogItem(mylog, FixedScaleID, 0);
                    SetDialogItem(mylog, item, 1);
                    AutoscalePlots := item = AutoscaleID;
                end;
            if item = MinID then begin
                    ProfilePlotMin := GetDReal(MyLog, MinID);
                    if (ProfilePlotMin < 0) or (ProfilePlotMin > 255) then begin
                            ProfilePlotMin := SaveMin;
                            SetDReal(MyLog, MinID, ProfilePlotMin, 2);
                        end;
                end;
            if item = MaxID then begin
                    ProfilePlotMax := GetDReal(MyLog, MaxID);
                    if (ProfilePlotMax < 0) or (ProfilePlotMax > 255) then begin
                            ProfilePlotMax := SaveMax;
                            SetDReal(MyLog, MaxID, ProfilePlotMax, 2);
                        end;
                end;
            if (item = FixedSizeID) or (item = VariableSizeID) then begin
                    SetDialogItem(mylog, FixedSizeID, 0);
                    SetDialogItem(mylog, VariableSizeID, 0);
                    SetDialogItem(mylog, item, 1);
                    FixedSizePlot := item = FixedSizeID;
                end;
            if item = WidthID then begin
                    ProfilePlotWidth := GetDNum(MyLog, WidthID);
                    if (ProfilePlotWidth < 0) or (ProfilePlotWidth > 1023) then begin
                            ProfilePlotWidth := SaveWidth;
                            SetDNum(MyLog, WidthID, ProfilePlotWidth);
                        end;
                end;
            if item = HeightID then begin
                    ProfilePlotHEight := GetDNum(MyLog, HeightID);
                    if (ProfilePlotHeight < 0) or (ProfilePlotHeight > 1023) then begin
                            ProfilePlotHeight := SaveHeight;
                            SetDNum(MyLog, HeightID, ProfilePlotHeight);
                        end;
                end;
            if (item = LinePlotID) or (item = ScatterPlotID) then begin
                    SetDialogItem(mylog, LinePlotID, 0);
                    SetDialogItem(mylog, ScatterPlotID, 0);
                    SetDialogItem(mylog, item, 1);
                    LinePlot := item = LinePlotID;
                end;
            if item = InvertID then begin
                    InvertPlots := not InvertPlots;
                    SetDialogItem(mylog, InvertID, ord(InvertPlots));
                end;
            if item = LabelsID then begin
                    DrawPlotLabels := not DrawPlotLabels;
                    SetDialogItem(mylog, LabelsID, ord(DrawPlotLabels));
                end;
        until (item = ok) or (item = cancel);
        DisposDialog(mylog);
        if item = cancel then begin
                AutoscalePlots := SaveAutoscale;
                LinePlot := SaveLinePlot;
                InvertPlots := SaveInvert;
                ProfilePlotMin := SaveMin;
                ProfilePlotMax := SaveMax;
                DrawPlotLabels := SaveDrawLabels;
            end;
    end;


    procedure DoPoints (event: EventRecord);
        var
            loc: point;
            yi: integer;
    begin
        loc := event.where;
        if LineWidth > 1 then
            with loc do begin
                    h := h - LineWidth div 2;
                    v := v - LineWidth div 2;
                end;
        DrawObject(LineObj, loc, loc);
        with results, loc do begin
                if nPoints < MaxLocs then begin
                        nPoints := nPoints + 1;
                        UnsavedPoints := UnsavedPoints + 1
                    end
                else
                    beep;
                ScreenToOffscreen(loc);
                x := h;
                yi := info^.PicRect.bottom - v - 1;
                y := yi;
                xLoc[nPoints] := h;
                yLoc[nPoints] := yi;
                with info^ do
                    if scale <> 0.0 then begin
                            x := x / scale;
                            y := y / scale;
                        end;
            end;
        ShowResults;
        measuring := true;
    end;


    procedure FindAngle (event: EventRecord);
        var
            start, finish, OldFinish, MidPoint: point;
            ticks: LongInt;
            ff, x1, y1, x2, y2, imag: integer;
            angle1, angle2: extended;
            StartRect: rect;
            FirstLineDone: boolean;

        procedure GetAngle (x, y: integer; var angle: extended);
            var
                quadrant: (q1, q2orq3, q4);
        begin
            if x <> 0 then
                angle := arctan(y / x)
            else begin
                    if y >= 0 then
                        angle := pi / 2.0
                    else
                        angle := -pi / 2.0
                end;
            angle := (180.0 / pi) * angle;
            if (x >= 0) and (y >= 0) then
                quadrant := q1
            else if x < 0 then
                quadrant := q2orq3
            else
                quadrant := q4;
            case quadrant of
                q1:
                    ;
                q2orq3:
                    angle := angle + 180.0;
                q4:
                    angle := angle + 360.0;
            end;
        end;

    begin
        ValuesMode := AngleValue;
        DrawLabels;
        FlushEvents(EveryEvent, 0);
        imag := trunc(info^.magnification + 0.5);
        ff := imag div 2;
        if ff < 1 then
            ff := 1;
        start := event.where;
        with start do begin
                h := h - ff;
                v := v - ff
            end;
        Pt2Rect(start, start, StartRect);
        InsetRect(StartRect, -2, -2);
        finish := start;
        PenNormal;
        PenMode(PatXor);
        PenSize(imag * LineWidth, imag * LineWidth);
        MoveTo(start.h, start.v);
        repeat
            repeat
                OldFinish := finish;
                GetMouse(finish);
                with finish do begin
                        h := h - ff;
                        v := v - ff
                    end;
                MoveTo(start.h, start.v);
                LineTo(OldFinish.h, OldFinish.v);
                MoveTo(start.h, start.v);
                LineTo(finish.h, finish.v);
                ticks := TickCount;
                while ticks = TickCount do
                    ;
                x1 := finish.h - start.h;
                y1 := start.v - finish.v;
                GetAngle(x1, y1, angle1);
                Show1Value(angle1, NoValue);
            until GetNextEvent(mUpMask, event);
            FirstLineDone := not PtInRect(finish, StartRect);
            if not FirstLineDone then
                start := finish;
        until FirstLineDone;
        DrawObject(LineObj, start, finish);
        MidPoint := finish;
        x1 := start.h - MidPoint.h;
        y1 := MidPoint.v - start.v;
        GetAngle(x1, y1, angle1);
        start := finish;
        finish := start;
        repeat
            OldFinish := finish;
            GetMouse(finish);
            with finish do begin
                    h := h - ff;
                    v := v - ff
                end;
            MoveTo(start.h, start.v);
            LineTo(OldFinish.h, OldFinish.v);
            MoveTo(start.h, start.v);
            LineTo(finish.h, finish.v);
            ticks := TickCount;
            while ticks = TickCount do
                ;
            x2 := finish.h - MidPoint.h;
            y2 := MidPoint.v - finish.v;
            GetAngle(x2, y2, angle2);
            with results do begin
                    if angle1 >= angle2 then
                        angle := angle1 - angle2
                    else
                        angle := angle2 - angle1;
                    if angle > 180.0 then
                        angle := 360.0 - angle;
                    Show1Value(angle, NoValue);
                end;
        until GetNextEvent(mUpMask, event);
        DrawObject(LineObj, start, finish);
        ShowResults;
        repeat
        until not GetNextEvent(EveryEvent, Event); {FlushEvent doesn't work under A/UX!}
    end;

    procedure ComputeLength; {(nvertices: integer; var xa, ya: xyArray; FindingPerimeterLength: boolean)}
        var
            i: integer;
            xtemp, ytemp: LongInt;
    begin
        with results do begin
                Length := 0.0;
                for i := 2 to nvertices do begin
                        xtemp := xa[i] - xa[i - 1];
                        ytemp := ya[i] - ya[i - 1];
                        Length := Length + sqrt(xtemp * xtemp + ytemp * ytemp);
                    end;
                if FindingPerimeterLength then begin
                        xtemp := xa[1] - xa[nvertices];
                        ytemp := ya[1] - ya[nvertices];
                        Length := Length + sqrt(xtemp * xtemp + ytemp * ytemp);
                    end;
                with info^ do begin
                        Length := Length / magnification;
                        if scale <> 0.0 then
                            Length := Length / scale;
                    end;
            end;
    end;


    procedure SaveBlankField;
        var
            SaveInfo: InfoPtr;
            i, xLines, xPixelsPerLine: integer;
            src, dst: ptr;
            SaveFlag: boolean;
    begin
        if (info^.PictureType = camera) or (info^.PictureType = ScionType) then begin
                SaveInfo := info;
                if BlankFieldInfo = nil then
                    Duplicate(true)
                else
                    with info^ do begin
                            if (PictureType = ScionType) or ((PictureType = camera) and not digitizing) then begin
                                    PutMessage('You must close the current blank field window before you can create a new one.', '', '');
                                    exit(SaveBlankField);
                                end;
                            src := info^.PicBaseAddr;
                            dst := BlankFieldInfo^.PicBaseAddr;
                            with PicRect do begin
                                    xLines := bottom - top;
                                    xPixelsPerLine := right - left;
                                end;
                            for i := 1 to xLines do begin
                                    BlockMove(src, dst, xPixelsPerLine);
                                    src := ptr(ord4(src) + info^.BytesPerRow);
                                    dst := ptr(ord4(dst) + xPixelsPerLine);
                                end;
                        end;
                Info := BlankFieldInfo;
                InvertPic;
                SaveFlag := digitizing;
                digitizing := false;
                SelectAll(false);
                DoHistogram;
                digitizing := SaveFlag;
                BlankFieldMean := results.imean;
                KillRoi;
                UpdatePicWindow;
                info := SaveInfo;
                SelectWindow(Info^.wptr);
            end
        else
            PutMessage('You must be digitizing in order to save a blank field.', '', '');
    end;


    procedure UndoLastMeasurement;
    begin
        if nAreas > 0 then begin
                nAreas := nAreas - 1;
                if UnsavedAreas > 0 then
                    UnsavedAreas := UnsavedAreas - 1
            end
        else
            WhatToUndo := NothingToUndo;
        ShowResults;
    end;

    function PixelInside (p: point): boolean;
        var
            value: integer;
    begin
        with p do
            value := MyGetPixel(h, v);
        case ThresholdingMode of
            LutThresholding:
                PixelInside := (value >= ThresholdStart) and (value <= ThresholdEnd);
            GrayMapThresholding:
                PixelInside := value >= info^.p1x;
            BinaryImage:
                PixelInside := value = BlackC;
        end;
    end;

    function TraceEdge (FirstPoint: point; var circumference: extended): boolean;
        const
            MaxCount = 15000;
        type
            direction = (wasleft, wasright, wasup, wasdown);
        var
            CurrentDirection: direction;
            NewPoint, oldPoint, lastIn: point;
            count: integer;
            hside, vside: extended;
            Saveport: GrafPtr;
            TempRgn: RgnHandle;
            OutOfBounds, FindPerimeter: boolean;
    begin
        GetPort(SavePort);
        SetPort(GrafPtr(info^.osPort));
        oldPoint.h := firstPoint.h;
        oldPoint.v := firstPoint.v;
        newPoint.h := firstPoint.h;
        newPoint.v := firstPoint.v;
        lastIn.h := firstPoint.h;
        lastIn.v := firstPoint.v;
        circumference := 0.0;
        FindPerimeter := PerimeterM in measurements;
        CurrentDirection := wasleft;
        count := 0;
        PenNormal;
        OpenRgn;
        MoveTo(FirstPoint.h, FirstPoint.v);
        repeat
            count := count + 1;
            case CurrentDirection of
                wasright:
                    begin
                        if PixelInside(oldPoint) then begin
                                newPoint.v := oldpoint.v - 1;
                                newPoint.h := oldpoint.h;
                                CurrentDirection := wasup;
                            end
                        else begin
                                newPoint.v := oldpoint.v + 1;
                                newPoint.h := oldpoint.h;
                                CurrentDirection := wasdown;
                            end;
                    end;
                wasleft:
                    begin
                        if PixelInside(oldPoint) then begin
                                newPoint.v := oldpoint.v + 1;
                                newPoint.h := oldpoint.h;
                                CurrentDirection := wasdown;
                            end
                        else begin
                                newPoint.v := oldpoint.v - 1;
                                newPoint.h := oldpoint.h;
                                CurrentDirection := wasup;
                            end;
                    end;
                wasup:
                    begin
                        if PixelInside(oldPoint) then begin
                                newPoint.v := oldpoint.v;
                                newPoint.h := oldpoint.h - 1;
                                CurrentDirection := wasleft;
                            end
                        else begin
                                newPoint.v := oldpoint.v;
                                newPoint.h := oldpoint.h + 1;
                                CurrentDirection := wasright;
                            end;
                    end;
                wasdown:
                    begin
                        if PixelInside(oldPoint) then begin
                                newPoint.v := oldpoint.v;
                                newPoint.h := oldpoint.h + 1;
                                CurrentDirection := wasright;
                            end
                        else begin
                                newPoint.v := oldpoint.v;
                                newPoint.h := oldpoint.h - 1;
                                CurrentDirection := wasleft;
                            end;
                    end;
            end; {case of direction}
            if PixelInside(newPoint) then begin
                    if FindPerimeter then begin
                            hside := lastin.h - newpoint.h;
                            vside := lastin.v - newpoint.v;
                            circumference := circumference + sqrt(sqr(hside) + sqr(vside));
                        end;
                    LineTo(newPoint.h, newPoint.v);
                    lastIn.h := newPoint.h;
                    lastIn.v := newPoint.v;
                end;
            oldPoint.h := newPoint.h;
            oldPoint.v := newPoint.v;
        until ((firstPoint.h = newPoint.h) and (firstPoint.v = newPoint.v) and (count <> 4)) or (count > MaxCount);
        with info^ do begin
                CloseRgn(osroiRgn);
                with osroiRgn^^.rgnBBox do
                    OutOfBounds := (left < 0) or (top < 0) or (right > PicRect.right) or (bottom > PicRect.bottom);
                if (count > MaxCount) or OutOfBounds then begin
                        beep;
                        SetEmptyRgn(osroiRgn);
                        SetPort(SavePort);
                        TraceEdge := false;
                        exit(TraceEdge);
                    end;
                TempRgn := NewRgn;
                CopyRgn(osroiRgn, TempRgn);
                OffsetRgn(TempRgn, 1, 1);
                UnionRgn(TempRgn, osroiRgn, osroiRgn);
                DisposeRgn(TempRgn);
                RoiShowing := true;
                roiType := RgnRoi;
                osroiRect := osroiRgn^^.rgnBBox;
                roiRect := osroiRect;
                OffscreenToScreenRect(roiRect);
            end;
        SetPort(SavePort);
        TraceEdge := true;
    end;


    procedure NumberSelection (count: integer);
        var
            SavePort: GrafPtr;
            NumWidth, NumLeft, NumBottom, SaveForeground: integer;
            str: str255;
            r: rect;
    begin
        with info^ do begin
                KillRoi;
                SetupUndo;
                WhatToUndo := UndoOutline;
                GetPort(SavePort);
                SetPort(GrafPtr(osPort));
                PenNormal;
                TextFont(ApplFont);
                TextSize(9);
                TextMode(SrcOr);
                NumToString(count, str);
                with osRoiRect do begin
                        NumWidth := StringWidth(str);
                        NumLeft := left + ((right - left) - NumWidth) div 2;
                        NumBottom := top + (bottom - top) div 2 + 3;
                        MoveTo(NumLeft, NumBottom);
                    end;
                SaveForeground := ForegroundColor;
                SetForegroundColor(WhiteC);
                FrameRgn(osroiRgn);
                SetRect(r, NumLeft - 1, NumBottom - 9, NumLeft + NumWidth + 1, NumBottom + 1);
                PaintRoundRect(r, 4, 4);
                TextMode(srcXor);
                DrawString(str);
                SetForegroundColor(SaveForeground);
                UpdateScreen(RoiRect);
                SetPort(SavePort);
                changes := true;
            end;
    end;


    procedure AutoOutline (start: point);
        var
            hloc, vloc, counter: integer;
            SaveThresholdingState: boolean;
            circumference: extended;
    begin
        with info^ do begin
                if not thresholding and (deltax > 1) and not BinaryPic then begin
                        PutMessage('Sorry, but you must be thresholding or working with a binary image to use the auto-outlining tool.', '', '');
                        exit(AutoOutline);
                    end;
                ShowWatch;
                KillRoi;
                if thresholding then
                    ThresholdingMode := LutThresholding
                else if BinaryPic then
                    ThresholdingMode := BinaryImage
                else
                    ThresholdingMode := GrayMapThresholding;
                ScreenToOffscreen(start);
                if PixelInside(start) then begin
                        with start do begin
                                repeat
                                    h := h + 1;
                                until not PixelInside(start);
                                h := h - 1;
                            end;
                        if not TraceEdge(start, circumference) then
                            exit(AutoOutline);
                        WhatToUndo := NothingToUndo;
                        if WandAutoMeasure then begin
                                SaveThresholdingState := Thresholding;
                                Thresholding := false;
                                GetNonRectHistogram;
                                ComputeResults;
                                if scale <> 0.0 then
                                    circumference := circumference / scale;
                                plength[nAreas] := circumference;
                                ShowResults;
                                WhatToUndo := UndoMeasurement;
                                Thresholding := SaveThresholdingState;
                            end;
                        RoiShowing := true;
                        UpdateScreen(RoiRect);
                        if WandAutoNumber then begin
                                if WandAutoMeasure then
                                    counter := nAreas
                                else
                                    counter := nAreas + 1;
                                NumberSelection(counter);
                            end;
                    end
                else
                    beep;
            end; {with info}
    end;

end.