unit Analysis;

{Analysis routines used by the Image program}

interface

	uses
		QuickDraw, OSIntf, PickerIntf, PrintTraps, ToolIntf, globals, Utilities, LeastSquares, Graphics, file1, file2, Ellipse, camera;



	procedure DoHistogram;
	procedure GetRectHistogram;
	function SetupMask: boolean;
	procedure GetNonRectHistogram;
	procedure ShowContinuousHistogram;
	procedure ComputeResults;
	procedure FindThresholdingMode;
	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 MarkSelection (count, index: integer);
	procedure AutoOutline (start: point);
	procedure RedoMeasurement;
	procedure DeleteMeasurement;
	procedure AnalyzeParticles;
	procedure UpdateAnalysisMenu;		{ moved here from Utilities (unit size limits) - Arlo}


implementation

	var
		WandMode: (LUTMode, GrayMapMode, BinaryMode);
		GrayMapThreshold: integer;
		InfoForRedirect: InfoPtr;



	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;


	function SetupMask: boolean;
{Creates a mask in the undo buffer for operating}
{on non-rectangular selections .}
		var
			tPort: GrafPtr;
			SaveInfo: InfoPtr;
	begin
		if info^.PicSize > UndoBufSize then
			begin
				SetupMask := false;
				exit(SetupMask)
			end;
		SetupUndo; {Copy image to undo buffer.}
		WhatToUndo := NothingToUndo;
		SetupUndoInfoRec;
		SaveInfo := Info;
		Info := UndoInfo;
		GetPort(tPort);
		with Info^ do
			begin
				SetPort(GrafPtr(osPort));
				SetRGBForeColor(BlackRGB, BlackIndex);
				SetRGBBackColor(WhiteRGB, WhiteIndex);
				PenNormal;
				EraseRect(osroiRect);
				PaintRgn(osroiRgn);
			end;
		SetPort(tPort);
		Info := SaveInfo;
		SetupMask := true;
	end;


	procedure SetupRedirectedSampling;
		var
			info1, info2: InfoPtr;
	begin
		InfoForRedirect := nil;
		if nPics <> 2 then
			begin
				PutMessage('There must be exactly two image windows open to do redirected sampling.');
				AnalyzingParticles := false;
				exit(SetupRedirectedSampling);
			end;
		Info1 := pointer(WindowPeek(PicWindow[1])^.RefCon);
		Info2 := pointer(WindowPeek(PicWindow[2])^.RefCon);
		if not EqualRect(info1^.PicRect, info2^.PicRect) then
			begin
				PutMessage('The image windows must be exactly the same size to do redirected sampling.');
				AnalyzingParticles := false;
				exit(SetupRedirectedSampling);
			end;
		if info = info1 then
			InfoForRedirect := info2
		else
			InfoForRedirect := info1;
	end;


	procedure GetNonRectHistogram;
		var
			MaskLine, DataLine: LineType;
			width, i, vloc: integer;
			sum, sum2, count, OverFlows: LongInt;
			SaveInfo: InfoPtr;
			value: LongInt;
			trect: rect;
	begin
		ShowWatch;
		if RedirectSampling then
			SetupRedirectedSampling
		else
			InfoForRedirect := nil;
		if not SetupMask then
			beep;
		SaveInfo := Info;
		for i := 0 to 255 do
			Histogram[i] := 0;
		if FitEllipse then
			ResetSums;
		trect := info^.osroiRect;
		with trect do
			begin
				width := right - left;
				for vloc := top to bottom - 1 do
					begin
						if InfoForRedirect <> nil then
							Info := InfoForRedirect
						else
							Info := SaveInfo;
						GetLine(left, vloc, width, DataLine);
						Info := UndoInfo;
						GetLine(left, vloc, width, MaskLine);
						if FitEllipse then
							ComputeSums(vloc - top, width, MaskLine);
						for i := 0 to width - 1 do
							if MaskLine[i] = BlackIndex then
								begin
									value := DataLine[i];
									histogram[value] := histogram[value] + 1;
								end;
					end;
			end;
		Info := SaveInfo;
		if not AnalyzingParticles then
			begin
				SetupUndo; {Needed for drawing "marching ants".}
				WhatToUndo := NothingToUndo;
			end;
	end;


	procedure ComputeResults;
		var
			MaxCount, icount, isum, n: LongInt;
			i: integer;
			sum, sum2, ri, rcount, UncalibratedMean, tSD, rmode, xc, yc: extended;
			Major, Minor, EllipseAngle, hcenter, vcenter, cvalue: extended;
	begin
		with info^, results, MeasurementsP^ do
			begin
				case ThresholdingMode of
					LutThresholding: 
						MinIndex := ThresholdStart;
					GrayMapThresholding: 
						MinIndex := GrayMapThreshold;
					BinaryImage: 
						MinIndex := BlackIndex;
					NoThresholding: 
						MinIndex := 0;
				end;
				if RedirectSampling then
					MinIndex := 0;
				while (histogram[MinIndex] = 0) and (MinIndex < 255) do
					MinIndex := MinIndex + 1;
				case ThresholdingMode of
					LutThresholding: 
						MaxIndex := ThresholdEnd;
					GrayMapThresholding: 
						MaxIndex := 255;
					BinaryImage: 
						MaxIndex := BlackIndex;
					NoThresholding: 
						MaxIndex := 255;
				end;
				if RedirectSampling then
					MaxIndex := 255;
				while (histogram[MaxIndex] = 0) and (MaxIndex > 0) do
					MaxIndex := MaxIndex - 1;
				MaxCount := 0;
				sum := 0.0;
				isum := 0;
				sum2 := 0.0;
				n := 0;
				minCalibratedValue := 10e100;
				maxCalibratedValue := -10e100;
				for i := MinIndex to MaxIndex do
					begin
						cvalue := value[i];
						icount := histogram[i];
						rcount := icount;
						sum := sum + rcount * cvalue;
						isum := isum + icount * i;
						ri := i;
						sum2 := sum2 + sqr(cvalue) * rcount;
						n := n + icount;
						if icount > MaxCount then
							begin
								MaxCount := icount;
								rmode := value[i];
								imode := i
							end;
						if cvalue < minCalibratedValue then
							minCalibratedValue := cvalue;
						if cvalue > maxCalibratedValue then
							maxCalibratedValue := cvalue;
					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 nRegions < MaxRegions then
					begin
						nRegions := nRegions + 1;
						UnsavedAreas := UnsavedAreas + 1
					end
				else
					beep;
				mean[nRegions] := tmean;
				if nRegions <= MaxStandards then
					umean[nRegions] := 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[nRegions] := tSD;
				with info^.osRoiRect do
					begin
						xc := left + (right - left) / 2;
						yc := top + (bottom - top) / 2;
						if InvertYCoordinates then
							yc := PicRect.bottom - yc;
						if SpatialScale <> 0.0 then
							begin
								xc := xc / SpatialScale;
								yc := yc / SpatialScale;
							end;
						xcenter[nRegions] := xc;
						ycenter[nRegions] := yc;
					end;
				PixelCount[nRegions] := n;
				mode[nRegions] := rmode;
				if PerimeterM in measurements then
					begin
						if (CurrentTool = FreehandTool) or (CurrentTool = PolygonTool) then
							plength[nRegions] := Length
						else
							with 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 SpatialScale <> 0.0 then
										length := length / SpatialScale;
									plength[nRegions] := length;
								end;
					end
				else
					plength[nRegions] := 0.0;
				if FitEllipse then
					begin
						GetEllipseParam(Major, Minor, EllipseAngle, xc, yc);
						if InvertYCoordinates then
							yc := PicRect.bottom - yc;
						if SpatialScale <> 0.0 then
							begin
								Major := Major / SpatialScale;
								Minor := Minor / SpatialScale;
								xc := xc / SpatialScale;
								yc := yc / SpatialScale;
							end;
						MajorAxis[nRegions] := Major;
						MinorAxis[nRegions] := Minor;
						orientation[nRegions] := EllipseAngle;
						xcenter[nRegions] := xc;
						ycenter[nRegions] := yc;
					end
				else
					begin
						MajorAxis[nRegions] := 0.0;
						MinorAxis[nRegions] := 0.0;
						orientation[nRegions] := 0.0;
					end;
			end; {with}
		measuring := true;
		ResultsMessage := '';
	end;


	procedure FindThresholdingMode;
	begin
		with info^ do
			begin
				if thresholding then
					ThresholdingMode := LutThresholding
				else if deltax <= 1 then
					begin
						ThresholdingMode := GrayMapThresholding;
						GrayMapThreshold := 255 - p1x;
					end
				else if BinaryPic then
					ThresholdingMode := BinaryImage
				else
					ThresholdingMode := NoThresholding;
			end;
	end;


	procedure Measure;
		var
			AutoSelectAll: boolean;
			SaveN: integer;
	begin
		if NotInBounds then
			exit(Measure);
		FindThresholdingMode;
		if ThresholdingMode = BinaryImage then
			ThresholdingMode := NoThresholding;
		StopDigitizing;
		AutoSelectAll := not info^.RoiShowing;
		if AutoSelectAll then
			SelectAll(false);
		if info^.RoiType = RectRoi then
			GetRectHistogram
		else
			GetNonRectHistogram;
		if MeasurementToRedo > 0 then
			begin
				SaveN := nRegions;
				nRegions := MeasurementToRedo - 1;
				ComputeResults;
				ShowResults;
				nRegions := SaveN;
				MeasurementToRedo := 0;
			end
		else
			begin
				ComputeResults;
				ShowResults;
			end;
		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;
			end;
		SelectWindow(HistoWindow);
		SetPort(HistoWindow);
		InvalRect(HistoWindow^.PortRect);
		SetPort(tPort);
	end;


	procedure ShowContinuousHistogram;
		const
			skip = 10;
		var
			i, NumberOfLines: integer;
			offset: LongInt;
			p: ptr;
	begin
		for i := 0 to 255 do
			Histogram[i] := 0;
		p := ptr(ptr(DTSlotBase));
		NumberOfLines := ((qcHeight) div skip) - 1;
		offset := qcRowBytes * skip;
		for i := 1 to NumberOfLines do
			begin
				DoHistogramOfLine(p, histogram, qcWidth);
				p := ptr(ord4(p) + offset);
			end;
		ThresholdingMode := NoThresholding;
		HistogramThresholdStart := 0;
		HistogramThresholdEnd := 255;
		ComputeResults;
		ShowHistogram;
	end;


	procedure DoHistogram;
		var
			AutoSelectAll: boolean;
	begin
		if NotInBounds then
			exit(DoHistogram);
		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;
		AutoSelectAll := not info^.RoiShowing;
		if AutoSelectAll then
			SelectAll(false);
		if info^.RoiType = RectRoi then
			GetRectHistogram
		else
			GetNonRectHistogram;
		ThresholdingMode := NoThresholding;
		ComputeResults;
		ShowResults;
		FindThresholdingMode;
		case ThresholdingMode of
			LutThresholding: 
				begin
					HistogramThresholdStart := ThresholdStart;
					HistogramThresholdEnd := ThresholdEnd;
				end;
			GrayMapThresholding: 
				begin
					HistogramThresholdStart := GrayMapThreshold;
					HistogramThresholdEnd := 255;
				end;
			BinaryImage, NoThresholding: 
				begin
					HistogramThresholdStart := 0;
					HistogramThresholdEnd := 255;
				end;
		end;
		ShowHistogram;
		WhatToUndo := UndoMeasurement;
		if AutoSelectAll then
			KillRoi;
	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
			FirstButtonID = 5;
			LastButtonID = 14;
			ActualDistanceID = 3;
			ScaleID = 16;
			UnitsTextID = 18;
			MagnificationID = 20;
			MeasuredDistanceID = 22;
		var
			mylog: DialogPtr;
			item, i: integer;
			SaveUnitsID: UnitsType;
			ActualDistance, MeasuredDistance, SaveScale, TempScale: extended;
			OldUnitsPerCM, OldScale, SaveUnitsPErCM, SaveRawScale, SaveMagnification: extended;
			ignore: integer;
			str: str255;
			SaveUnits: string[2];
	begin
		with info^ do
			begin
				if (RawSpatialScale = 0.0) and (nLengths = 0) then
					begin
						PutMessage('Before using Set Scale you must use the ruler tool to measure a known distance.');
						exit(SetScale)
					end;
				InitCursor;
				if nLengths = 0 then
					MeasuredDistance := 0.0
				else
					MeasuredDistance := PixelLength;
				SaveUnits := units;
				SaveUnitsID := UnitsID;
				SaveRawScale := RawSpatialScale;
				SaveScale := SpatialScale;
				SaveMagnification := ScaleMagnification;
				ActualDistance := 0.0;
				OldScale := 0.0;
				mylog := GetNewDialog(10, nil, pointer(-1));
				SetDReal(MyLog, MeasuredDistanceID, MeasuredDistance, 1);
				SetDReal(MyLog, ActualDistanceID, ActualDistance, 1);
				SelIText(MyLog, ActualDistanceID, 0, 32767);
				SetDReal(MyLog, MagnificationID, ScaleMagnification, 1);
				if UnitsID = pixels then
					TempScale := 1.0
				else
					TempScale := SpatialScale;
				SetDReal(MyLog, ScaleID, TempScale, 2);
				SetDString(MyLog, UnitsTextID, FullUnits);
				OutlineButton(MyLog, ok, 16);
				SetDialogItem(mylog, FirstButtonID + ord(UnitsID), 1);
				repeat
					ModalDialog(nil, item);
					if item = MeasuredDistanceID then
						MeasuredDistance := GetDReal(MyLog, MeasuredDistanceID);
					if item = ActualDistanceID then
						ActualDistance := GetDReal(MyLog, ActualDistanceID);
					if item = MagnificationID then
						begin
							ScaleMagnification := GetDReal(MyLog, MagnificationID);
							if ScaleMagnification < 0.0 then
								begin
									beep;
									ScaleMagnification := 1.0;
								end
							else
								SpatialScale := RawSpatialScale * ScaleMagnification;
						end;
					if (item >= FirstButtonID) and (item <= LastButtonID) then
						begin
							for i := FirstButtonID to LastButtonID do
								SetDialogItem(mylog, i, 0);
							SetDialogItem(mylog, item, 1);
							if (item = LastButtonID) and (UnitsID <> Pixels) then
								begin
									OldScale := RawSpatialScale;
									SaveUnitsPerCM := UnitsPerCM
								end;
							OldUnitsPerCM := UnitsPerCM;
							GetUnits(item);
							if (UnitsID <> Pixels) and (RawSpatialScale = 0.0) and (OldScale <> 0.0) then
								begin
									RawSpatialScale := OldScale;
									SpatialScale := RawSpatialScale * ScaleMagnification;
									OldUnitsPerCM := SaveUnitsPerCM;
									OldScale := 0.0;
								end;
							if (UnitsPerCM <> OldUnitsPerCM) and (UnitsPerCM <> 0.0) then
								begin
									RawSpatialScale := RawSpatialScale * (OldUnitsPerCM / UnitsPerCM);
									SpatialScale := RawSpatialScale * ScaleMagnification;
								end;
							if UnitsID = Pixels then
								ActualDistance := 0.0;
						end;
					if (item = ActualdistanceID) or (item = MeasuredDistanceID) then
						if (UnitsID = Pixels) and (item <> cancel) then
							PutMessage('You must select a measurent unit before setting or changing the scale.')
						else
							begin
								if (MeasuredDistance > 0.0) and (ActualDistance > 0.0) then
									begin
										RawSpatialScale := MeasuredDistance / ActualDistance;
										SpatialScale := RawSpatialScale * ScaleMagnification;
									end;
							end;
					if UnitsID = pixels then
						TempScale := 1.0
					else
						TempScale := SpatialScale;
					SetDReal(MyLog, ScaleID, TempScale, 2);
					SetDString(MyLog, UnitsTextID, FullUnits);
				until (item = ok) or (item = cancel);
				DisposDialog(mylog);
				if item = cancel then
					begin
						units := SaveUnits;
						UnitsID := SaveUnitsID;
						RawSpatialScale := SaveRawScale;
						SpatialScale := SaveScale;
						ScaleMagnification := SaveMagnification;
					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;
			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;
		RectRgn(PlotWindow^.ClipRgn, fRect);
		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;
		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
					StraightLine: 
						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
							StraightLine: 
								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(concat('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 = cr) or (err <> NoErr);
			if not done then
				str := concat(str, c);
		until (c = cr) or (err <> NoErr);
	end;


	procedure GetStandardsFromFile (mylog: DialogPtr; FirstLevelID, FirstStandardID: integer);
		var
			where: Point;
			typeList: SFTypeList;
			reply: SFReply;
			err: OSErr;
			str: str255;
			f, i: integer;
			n1, n2: extended;
			nColumns: integer;
			EmptyString: boolean;
	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);
					GetLineFromFile(f, str);
					n1 := StringToReal(str);
					n2 := StringToReal(str);
					if (n1 <> BadReal) and (n2 <> BadReal) then
						nColumns := 2
					else
						nColumns := 1;
					err := SetFPos(f, fsFromStart, 0);
					if (nStandards = 0) and (nColumns = 2) then
						begin
							i := 0;
							repeat
								GetLineFromFile(f, str);
								EmptyString := str = '';
								if not EmptyString then
									begin
										i := i + 1;
										if i > MaxStandards then
											i := MaxStandards;
										umean[i] := StringToReal(str);
										SetDReal(MyLog, FirstLevelID + i - 1, umean[i], 2);
										StandardValues[i] := StringToReal(str);
										SetDReal(MyLog, FirstStandardID + i - 1, StandardValues[i], 3);
									end;
							until EmptyString;
							nStandards := i;
						end
					else
						for i := 1 to nStandards do
							begin
								GetLineFromFile(f, str);
								if nColumns = 2 then
									n1 := StringToReal(str); {skip measured value}
								if str <> '' then
									begin
										StandardValues[i] := StringToReal(str);
										SetDReal(MyLog, FirststandardID + i - 1, StandardValues[i], 3);
									end;
							end;
					err := fsclose(f);
				end;
	end;


	procedure SaveStandardsToFile (nStandards: integer);
		var
			where: Point;
			reply: SFReply;
			i: integer;
			OptionKeyWasDown: boolean;
	begin
		OptionKeyWasDown := OptionKeyDown;
		where.v := 50;
		where.h := 50;
		SFPutFile(Where, 'Save Calibration as?', 'Standards', nil, reply);
		if reply.good then
			begin
				TextBufSize := 0;
				for i := 1 to nStandards do
					begin
						PutReal(umean[i], 1, 3);
						PutChar(tab);
						if StandardValues[i] >= 100.0 then
							PutReal(StandardValues[i], 1, 3)
						else
							PutReal(StandardValues[i], 1, 5);
						if i <> nStandards then
							PutChar(cr);
					end;
				SaveAsText(reply);
			end;
		InitCursor;
	end;


	procedure Calibrate;
		const
			FirstLevelID = 3;
			FirstStandardID = 23;
			FirstFitID = 63;
			LastFitID = 70;
			UnitOfMeasureID = 71;
			UndoID = 73;
			OpenID = 74;
			SaveID = 75;
		var
			mylog: DialogPtr;
			ignore, item, i, nBadReals: integer;
			str: str255;
			SaveStandards, temp: StandardsArray;
			OptionKeyWasDown: boolean;
	begin
		OptionKeyWasDown := OptionKeyDown;
		SaveStandards := StandardValues;
		with info^ do
			begin
				mylog := GetNewDialog(20, nil, pointer(-1));
				OutlineButton(MyLog, ok, 16);
				nStandards := nRegions;
				if nStandards > MaxStandards then
					nStandards := MaxStandards;
				for i := 1 to nStandards do
					begin
						SetDReal(MyLog, FirstLevelID + i - 1, umean[i], 2);
						if StandardValues[i] <> BadReal then
							SetDReal(MyLog, FirstStandardID + i - 1, StandardValues[i], 3);
					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 + MaxStandards)) then
						begin
							i := item - FirstStandardID + 1;
							if i <= nStandards then
								StandardValues[i] := GetDReal(MyLog, item)
							else
								begin
									PutMessage('Before entering known values you must use the Measure command to read a set of standards.');
									SetDString(MyLog, item, '');
								end;
						end;
					if (item >= FirstLevelID) and (item < (FirstLevelID + MaxStandards)) then
						begin
							i := item - FirstLevelID + 1;
							if OptionKeyWasDown and (i <= nStandards) then
								umean[item - FirstLevelID + 1] := GetDReal(MyLog, item)
							else
								begin
									PutMessage('Use the Measure command to record measured values.');
									if i <= nStandards then
										begin
											RealToString(umean[i], 1, 2, str);
											SetDString(MyLog, item, str)
										end
									else
										SetDString(MyLog, item, '');
								end;
						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, FirstLevelID, FirstStandardID);
					if (item = SaveID) and (nStandards > 1) then
						SaveStandardsToFile(nStandards);
				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;
				nLengths2 := 0;
				nRegions := 0;
				nRegions2 := 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 DoButton (loc: point; var nbutton: integer);
		var
			i: integer;
			TypeOfResults: ResultsType;
			IgnoreResult: boolean;
			where: Point;
			reply: SFReply;
	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: 
								begin
									where.v := 50;
									where.h := 50;
									SFPutFile(Where, 'Save Measurements as?', 'Measurements', nil, reply);
									if reply.good then
										begin
											CopyResultsToBuffer;
											SaveAsText(reply);
										end;
								end;
							2: 
								begin
									case TypeOfResults of
										AreaT: 
											WhatToPrint := PrintAreas;
										LengthT: 
											WhatToPrint := PrintLengths;
										PointT: 
											WhatToPrint := PrintPoints;
									end;
									print(true);
								end;
							3: 
								begin
									CopyResultsToBuffer;
									ClipTextInBuffer := true;
									WhatsOnClip := TextOnClip;
									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;
				ShowMessage('');
				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);
				nRegions2 := nRegions;
				nLengths2 := nLengths;
				WhatToUndo := NothingToUndo;
			end;
	end;


	procedure DoMeasurementOptions;
		const
			FirstID = 3;
			LastID = 12;
			RedirectID = 13;
			MinID = 15;
			MaxID = 18;
			IgnoreID = 20;
			LabelID = 21;
			PrecisionID = 23;
			OutlineID = 24;
		var
			mylog: DialogPtr;
			item, i, SavePrecision: integer;
			mtype: MeasurementTypes;
			SaveMeasurements: set of MeasurementTypes;
			SaveRedirect, SaveIgnore, SaveLabel, SaveOutline: boolean;
			SaveMin, SaveMax: LongInt;
	begin
		InitCursor;
		SaveMeasurements := measurements;
		SaveMin := MinParticleSize;
		SaveMax := MaxParticleSize;
		SaveRedirect := RedirectSampling;
		SaveIgnore := IgnoreParticlesTouchingEdge;
		SaveLabel := LabelParticles;
		SaveOutline := OutlineParticles;
		SavePrecision := precision;
		mylog := GetNewDialog(4000, nil, pointer(-1));
		mtype := AreaM;
		for i := FirstID to LastID do
			begin
				if mtype in measurements then
					SetDialogItem(mylog, i, 1);
				if i <> LastID then
					mtype := succ(mtype);
			end;
		SetDNum(MyLog, MinID, MinParticleSize);
		SetDNum(MyLog, MaxID, MaxParticleSize);
		ParamText('Pixels', 'Pixels', '', '');
		SetDialogItem(mylog, RedirectID, ord(RedirectSampling));
		SetDialogItem(mylog, IgnoreID, ord(IgnoreParticlesTouchingEdge));
		SetDialogItem(mylog, LabelID, ord(LabelParticles));
		SetDialogItem(mylog, OutlineID, ord(OutlineParticles));
		SetDNum(MyLog, PrecisionID, precision);
		OutlineButton(MyLog, ok, 16);
		repeat
			ModalDialog(nil, item);
			if (item >= FirstID) and (item <= LastID) then
				begin
					i := item - FirstID;
					case i of
						0: 
							mtype := AreaM;
						1: 
							mtype := MeanM;
						2: 
							mtype := StdDevM;
						3: 
							mtype := xyLocM;
						4: 
							mtype := ModeM;
						5: 
							mtype := PerimeterM;
						6: 
							mtype := MajorAxisM;
						7: 
							mtype := MinorAxisM;
						8: 
							mtype := AngleM;
						9: 
							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;
			if item = RedirectID then
				begin
					RedirectSampling := not RedirectSampling;
					SetDialogItem(mylog, RedirectID, ord(RedirectSampling));
				end;
			if item = IgnoreID then
				begin
					IgnoreParticlesTouchingEdge := not IgnoreParticlesTouchingEdge;
					SetDialogItem(mylog, IgnoreID, ord(IgnoreParticlesTouchingEdge));
				end;
			if item = LabelID then
				begin
					LabelParticles := not LabelParticles;
					SetDialogItem(mylog, LabelID, ord(LabelParticles));
				end;
			if item = OutlineID then
				begin
					OutlineParticles := not OutlineParticles;
					SetDialogItem(mylog, OutlineID, ord(OutlineParticles));
				end;
			if item = MinID then
				MinParticleSize := GetDNum(MyLog, MinID);
			if item = MaxID then
				MaxParticleSize := GetDNum(MyLog, MaxID);
			if item = PrecisionID then
				precision := GetDNum(MyLog, PrecisionID);
		until (item = ok) or (item = cancel);
		DisposDialog(mylog);
		if (MinParticleSize < 0) or (MinParticleSize >= MaxParticleSize) then
			begin
				MinParticleSize := SaveMin;
				beep;
			end;
		if MaxParticleSize <= MinParticleSize then
			begin
				MaxParticleSize := SaveMax;
				beep;
			end;
		if (precision < 0) or (precision > 12) then
			begin
				precision := SavePrecision;
				beep;
			end;
		if item = cancel then
			begin
				measurements := SaveMeasurements;
				MinParticleSize := SaveMin;
				MaxParticleSize := SaveMax;
				RedirectSampling := SaveRedirect;
				IgnoreParticlesTouchingEdge := SaveIgnore;
				LabelParticles := SaveLabel;
				OutlineParticles := SaveOutline;
				precision := SavePrecision;
			end;
		FitEllipse := (xyLocM in measurements) or (MajorAxisM in measurements) or (MinorAxisM in measurements) or (AngleM in measurements);
	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;
			LineWidthID = 20;
		var
			mylog: DialogPtr;
			item, i: integer;
			SaveAutoscale, SaveLinePlot, SaveInvert, SaveDrawLabels, SaveFixedSize: boolean;
			SaveWidth, SaveHeight, SaveLineWidth, SaveLineIndex: integer;
			SaveMin, SaveMax: extended;
	begin
		InitCursor;
		SaveAutoscale := AutoscalePlots;
		SaveLinePlot := LinePlot;
		SaveInvert := InvertPlots;
		SaveMin := ProfilePlotMin;
		SaveMax := ProfilePlotMax;
		SaveLineWidth := LineWidth;
		SaveLineIndex := LineIndex;
		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);
		SetDNum(MyLog, LineWidthID, LineWidth);
		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;
			if item = LineWidthID then
				begin
					LineWidth := GetDNum(MyLog, LineWidthID);
					if (LineWidth < 1) or (LineWidth > 500) then
						begin
							LineWidth := SaveLineWidth;
							SetDNum(MyLog, LineWidthID, LineWidth);
						end;
					LineIndex := LineWidth;
					if LineWidth = 6 then
						LineIndex := 5;
					if LineWidth > 6 then
						LineIndex := 6;
					DrawTools;
				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;
				LineWidth := SaveLineWidth;
				if LineIndex <> SaveLineIndex then
					begin
						LineIndex := SaveLineIndex;
						DrawTools;
					end;
			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 < MaxPoints then
					begin
						nPoints := nPoints + 1;
						UnsavedPoints := UnsavedPoints + 1
					end
				else
					beep;
				ScreenToOffscreen(loc);
				x := h;
				if InvertYCoordinates then
					yi := info^.PicRect.bottom - v - 1
				else
					yi := v;
				y := yi;
				xLoc[nPoints] := h;
				yLoc[nPoints] := yi;
				with info^ do
					if SpatialScale <> 0.0 then
						begin
							x := x / SpatialScale;
							y := y / SpatialScale;
						end;
			end;
		ResultsMessage := '';
		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
		DrawLabels('Angle:', '', '');
		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);
		ResultsMessage := '';
		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 SpatialScale <> 0.0 then
							Length := Length / SpatialScale;
					end;
			end;
	end;


	procedure SaveBlankField;
		var
			SaveInfo, SaveBFInfo: InfoPtr;
			i, xLines, xPixelsPerLine: integer;
			src, dst: ptr;
			SaveFlag: boolean;
			name: str255;
	begin
		if (info^.PictureType = QuickCaptureType) or (info^.PictureType = ScionType) then
			begin
				GetWTitle(info^.wptr, name);
				if pos('(Corrected)', name) > 0 then
					begin
						PutMessage('To save a blank field the captured image must be uncorrected.');
						exit(SaveBlankField);
					end;
				SaveInfo := info;
				SaveBFInfo := BlankFieldInfo;
				BlankFieldInfo := nil; {Prevents StopDigitizing from doing shading correction.}
				StopDigitizing;
				BlankFieldInfo := SaveBFInfo;
				if BlankFieldInfo = nil then
					begin
						if not Duplicate(true) then
							exit(SaveBlankField);
					end;
				src := info^.PicBaseAddr;
				dst := BlankFieldInfo^.PicBaseAddr;
				with Info^.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;
				Info := BlankFieldInfo;
				InvertPic;
				SaveFlag := digitizing;
				digitizing := false;
				SelectAll(false);
				DoHistogram;
				digitizing := SaveFlag;
				BlankFieldMean := results.imean;
				KillRoi;
				UpdatePicWindow;
				info := SaveInfo;
				SelectWindow(Info^.wptr);
			end;
	end;


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


	function PixelInside (hloc, vloc: integer): boolean;
		var
			value: integer;
	begin
		value := MyGetPixel(hloc, vloc);
		case ThresholdingMode of
			LutThresholding: 
				PixelInside := (value >= ThresholdStart) and (value <= ThresholdEnd);
			GrayMapThresholding: 
				PixelInside := value >= GrayMapThreshold;
			BinaryImage: 
				PixelInside := value = BlackIndex;
		end;
	end;


	function TraceEdge (hstart, vstart: integer; var circumference: extended; StartingDirection: char; var TouchingEdge: boolean): boolean;

   {Traces the points(not pixels) that define the edge of an object using the following}
   {16 entry lookup table and converts the resulting outline to a QuickDraw region.}

      {Index  1234*  Code    Result}

      {0          0000     X      Should never happen}
      {1          000X     R      Go Right}
      {2          00X0     D     Go Down}
      {3          00XX     R     Go Right}
      {4          0X00     U     Go Up}
      {5          0X0X     U     Go Up}
      {6          0XX0     u      Go up or down depending on current direction}
      {7         0XXX     U      Go up}
      {8          X000     L      Go left}
      {9          X00X     l       Go left or right depending on current direction}
      {10       X0X0     D      Go down}
      {11        X0XX    R      Go right}
      {12        XX00     L      Go left}
      {13        XX0X     L      Go left}
      {14        XXX0     D     Go down}
      {15        XXXX     X     Should never happen}

       {*   1=Upper left pixel,  2=Upper right pixel, 3=Lower left pixel, 4=Lower right pixel}

		const
			MaxCount = 10000;
		var
			count, hloc, vloc, hold, vold, index: integer;
			sqrt2: extended;
			Saveport: GrafPtr;
			FindPerimeter: boolean;
			direction, NewDirection: char;
			table: string[16];
			UL, UR, LL, LR, CuttingCorner: boolean;
	begin
		TouchingEdge := false;
		table := 'XRDRUUuULlDRLLDX';
		GetPort(SavePort);
		SetPort(GrafPtr(info^.osPort));
		circumference := 0.0;
		FindPerimeter := PerimeterM in measurements;
		if FindPerimeter then
			begin
				sqrt2 := sqrt(2.0);
				CuttingCorner := false;
			end;
		count := 0;
		PenNormal;
		OpenRgn;
		direction := StartingDirection;
		hloc := hstart;
		vloc := vstart;
		UL := PixelInside(hloc - 1, vloc - 1);
		UR := PixelInside(hloc, vloc - 1);
		LL := PixelInside(hloc - 1, vloc);
		LR := PixelInside(hloc, vloc);
		hold := hstart;
		vold := vstart;
		MoveTo(hstart, vstart);
		repeat
			if IgnoreParticlesTouchingEdge then
				with info^.PicRect do
					TouchingEdge := TouchingEdge or (hloc = left) or (hloc = right) or (vloc = top) or (vloc = bottom);
			count := count + 1;
			index := 0;
			if LR then
				index := bor(index, 1);
			if LL then
				index := bor(index, 2);
			if UR then
				index := bor(index, 4);
			if UL then
				index := bor(index, 8);
			NewDirection := table[index + 1];
			if NewDirection = 'u' then
				begin
					if direction = 'R' then
						NewDirection := 'U'
					else
						NewDirection := 'D'
				end;
			if NewDirection = 'l' then
				begin
					if direction = 'U' then
						NewDirection := 'L'
					else
						NewDirection := 'R'
				end;
			case NewDirection of
				'U': 
					begin
						vloc := vloc - 1;
						LL := UL;
						LR := UR;
						UL := PixelInside(hloc - 1, vloc - 1);
						UR := PixelInside(hloc, vloc - 1);
					end;
				'D': 
					begin
						vloc := vloc + 1;
						UL := LL;
						UR := LR;
						LL := PixelInside(hloc - 1, vloc);
						LR := PixelInside(hloc, vloc);
					end;
				'L': 
					begin
						hloc := hloc - 1;
						UR := UL;
						LR := LL;
						UL := PixelInside(hloc - 1, vloc - 1);
						LL := PixelInside(hloc - 1, vloc);
					end;
				'R': 
					begin
						hloc := hloc + 1;
						UL := UR;
						LL := LR;
						UR := PixelInside(hloc, vloc - 1);
						LR := PixelInside(hloc, vloc);
					end;
			end;
			if FindPerimeter then
				begin
					if CuttingCorner then
						CuttingCorner := false
					else
						begin
							if NewDirection = direction then
								circumference := circumference + 1
							else
								begin
									circumference := circumference + sqrt2;
									CuttingCorner := true;
								end;
						end;
				end;
			LineTo(hloc, vloc);
			hold := hloc;
			vold := vloc;
			direction := NewDirection;
		until ((hloc = hstart) and (vloc = vstart) and (direction = StartingDirection)) or (count > MaxCount);
		with info^ do
			begin
				CloseRgn(osroiRgn);
				if count > MaxCount then
					begin
						SetEmptyRgn(osroiRgn);
						SetPort(SavePort);
						TraceEdge := false;
						exit(TraceEdge);
					end;
				RoiShowing := true;
				roiType := RgnRoi;
				osroiRect := osroiRgn^^.rgnBBox;
				roiRect := osroiRect;
				OffscreenToScreenRect(roiRect);
			end;
		SetPort(SavePort);
		TraceEdge := true;
	end;


	procedure MarkSelection (count, index: integer);
		var
			SavePort: GrafPtr;
			NumWidth, NumLeft, NumBottom, SaveForegroundIndex: integer;
			RoiWidth, inset, hcenter, vcenter: integer;
			str: str255;
			r: rect;
			OutlineWithEllipse: boolean;
	begin
		OutlineWithEllipse := FitEllipse and OptionKeyWasDown;
		with info^ do
			begin
				KillRoi;
				SetupUndo;
				WhatToUndo := UndoOutline;
				GetPort(SavePort);
				SetPort(GrafPtr(osPort));
				SaveForegroundIndex := ForegroundIndex;
				SetForegroundColor(index);
				PenNormal;
				TextFont(ApplFont);
				TextSize(9);
				NumToString(count, str);
				with osRoiRect do
					begin
						NumWidth := StringWidth(str);
						if AnalyzingParticles or OutlineWithEllipse then
							with MeasurementsP^ do
								begin
									hcenter := round(xcenter[count]);
									vcenter := round(ycenter[count]);
									if InvertYCoordinates then
										vcenter := PicRect.bottom - vcenter - 1;
								end
						else
							begin
								hcenter := left + (right - left) div 2;
								vcenter := top + (bottom - top) div 2;
							end;
						NumLeft := hcenter - NumWidth div 2;
						NumBottom := vcenter + 3;
						if not BinaryPic and not AnalyzingParticles then
							begin
								FrameRgn(osroiRgn);
								if OutlineWithEllipse then
									DrawEllipse;
							end;
					end;
				PenNormal;
				SetRect(r, NumLeft - 1, NumBottom - 9, NumLeft + NumWidth + 1, NumBottom + 1);
				PaintRoundRect(r, 4, 4);
				MoveTo(NumLeft, NumBottom);
				TextMode(srcXor);
				DrawString(str);
				SetForegroundColor(SaveForegroundIndex);
				if not analyzingParticles then
					UpdateScreen(roiRect);
				SetPort(SavePort);
				changes := true;
			end;
	end;

	function isBinaryImage: boolean;
		var
			AutoSelect: boolean;
	begin
		with info^ do
			begin
				AutoSelect := not RoiShowing;
				if AutoSelect then
					SelectAll(false);
				GetRectHistogram;
				BinaryPic := (histogram[0] + histogram[255]) = LongInt(PixelsPerLine) * nLines;
				isBinaryImage := BinaryPic;
				if AutoSelect then
					KillRoi;
			end;
	end;


	function SetupAutoOutline: boolean;
	begin
		FindThresholdingMode;
		if ThresholdingMode = NoThresholding then
			if isBinaryImage then
				ThresholdingMode := BinaryImage;
		if ThresholdingMode = NoThresholding then
			begin
				PutMessage('Sorry, but you must be thresholding, or working with a binary image, to use the wand tool or to do particle analysis.');
				SetupAutoOutline := false;
				exit(SetupAutoOutline);
			end;
		ShowWatch;
		SetupAutoOutline := true;
	end;


	procedure AutoOutline (start: point);
		var
			hloc, vloc, counter: integer;
			TouchingEdge: boolean;
			circumference: extended;
			direction: char;
	begin
		if not SetupAutoOutline then
			exit(AutoOutline);
		KillRoi;
		with info^ do
			begin
				ScreenToOffscreen(start);
				with start do
					if PixelInside(h, v) then
						begin
							repeat
								h := h + 1;
							until not PixelInside(h, v);
							if not PixelInside(h - 1, v - 1) then
								direction := 'R'
							else if PixelInside(h, v - 1) then
								direction := 'L'
							else
								direction := 'D';
						end
					else
						begin
							repeat
								h := h + 1;
							until PixelInside(h, v) or (h >= PicRect.right);
							if h >= PicRect.right then
								begin
									beep;
									exit(AutoOutline);
								end;
							direction := 'U';
						end;
				if TraceEdge(start.h, start.v, circumference, direction, TouchingEdge) then
					begin
						WhatToUndo := NothingToUndo;
						if WandAutoMeasure then
							begin
								GetNonRectHistogram;
								ComputeResults;
								if SpatialScale <> 0.0 then
									circumference := circumference / SpatialScale;
								MeasurementsP^.plength[nRegions] := circumference;
								ShowResults;
								WhatToUndo := UndoMeasurement;
							end;
						RoiShowing := true;
						UpdateScreen(RoiRect);
						if WandAutoNumber then
							begin
								if WandAutoMeasure then
									counter := nRegions
								else
									counter := nRegions + 1;
								MarkSelection(counter, WhiteIndex);
							end;
					end; {if}
			end; {with info}
	end;

	procedure RedoMeasurement;
		var
			SaveN: integer;
	begin
		if not isSelectionTool then
			begin
				CurrentTool := SelectionTool;
				isSelectionTool := true;
				DrawTools;
			end;
		MeasurementToRedo := GetInt('Region measurent to redo:', nRegions);
		if (MeasurementToRedo >= 0) and (MeasurementToRedo <= nRegions) then
			begin
				SaveN := nRegions;
				nRegions := MeasurementToRedo;
				ShowResults;
				nRegions := SaveN;
			end
		else
			begin
				beep;
				MeasurementToRedo := 0;
			end;
	end;


	procedure DeleteMeasurement;
		var
			nToDelete, i: integer;
	begin
		nToDelete := GetInt('Region measurent to delete:', nRegions);
		if (nToDelete >= 0) and (nToDelete <= nRegions) then
			with MeasurementsP^ do
				begin
					for i := nToDelete to nRegions - 1 do
						begin
							mean[i] := mean[i + 1];
							sd[i] := sd[i + 1];
							mode[i] := mode[i + 1];
							PixelCount[i] := PixelCount[i + 1];
							IntegratedDensity[i] := IntegratedDensity[i + 1];
							plength[i] := plength[i + 1];
							xcenter[i] := xcenter[i + 1];
							ycenter[i] := ycenter[i + 1];
						end; {for}
					nRegions := nRegions - 1;
					if UnsavedAreas > 0 then
						UnsavedAreas := UnsavedAreas - 1;
				end
		else
			beep;
	end;


	procedure AnalyzeParticles;
		var
			hloc, vloc, AlertID, index, MaxTriesPerLine, nParticles: integer;
			SaveThresholdingState, TouchingEdge, DrawOutlines, AutoSelectAll, finished: boolean;
			circumference: extended;
			SaveForegroundIndex, SaveBackgroundIndex, EraseIndex, OutlineIndex: integer;
			tPort: GrafPtr;
			sRect: rect;
			side: (TopSide, RightSide, BottomSide, LeftSide);

		function PixelInside: boolean;
			var
				value: integer;
				offset: LongInt;
				p: ptr;
		begin
			with info^ do
				begin {MyGetPixel inlined to speed things up.}
					offset := LongInt(vloc) * BytesPerRow + hloc;
					p := ptr(ord4(PicBaseAddr) + offset);
				end;
			value := BAND(p^, 255);
			case ThresholdingMode of
				LutThresholding: 
					PixelInside := (value >= ThresholdStart) and (value <= ThresholdEnd);
				GrayMapThresholding: 
					PixelInside := value >= GrayMapThreshold;
				BinaryImage: 
					PixelInside := value = BlackIndex;
			end;
		end;

		procedure LabelBlobs;
			var
				i: integer;
		begin
			if nParticles <= MaxRegions then
				for i := 1 to nRegions do
					MarkSelection(i, WhiteIndex);
		end;

	begin
		with info^ do
			begin
				if PicSize > UndoBufSize then
					begin
						beep;
						exit(AnalyzeParticles);
					end;
				if NotRectangular or NotInBounds then
					exit(AnalyzeParticles);
				if not SetupAutoOutline then
					exit(AnalyzeParticles);
				if RedirectSampling then
					begin
						SetupRedirectedSampling;
						if InfoForRedirect = nil then
							exit(AnalyzeParticles)
					end;
				if RoiShowing then
					if EqualRect(osroiRect, PicRect) then  {If Select All }
						KillRoi;
				if not RoiShowing then
					SelectAll(false)
				else
					with osroiRect do
						begin
							hloc := left;
							vloc := top;
							finished := false;
							side := TopSide;
							repeat
								if PixelInside then
									begin
										PutMessage('Particle analysis requires that the selection boundary not intersect any particles.');
										exit(AnalyzeParticles);
									end;
								case side of
									TopSide: 
										begin
											hloc := hloc + 1;
											if hloc = (right - 1) then
												side := RightSide;
										end;
									RightSide: 
										begin
											vloc := vloc + 1;
											if vloc = (bottom - 1) then
												side := BottomSide;
										end;
									BottomSide: 
										begin
											hloc := hloc - 1;
											if hloc = left then
												side := LeftSide;
										end;
									LeftSide: 
										begin
											vloc := vloc - 1;
											finished := vloc = top
										end;
								end;
							until finished;
						end;
				sRect := osroiRect;
				KillRoi;
				if UnsavedAreas > 0 then
					begin
						InitCursor;
						AlertID := alert(500, nil);
						if AlertID = CancelResetID then
							exit(AnalyzeParticles);
						nRegions := 0;
						UnsavedAreas := 0;
						UpdatePicWindow;
					end;
				if (CurrentTool = ruler) or (CurrentTool = PointingTool) then
					begin
						CurrentTool := SelectionTool;
						isSelectionTool := true;
						DrawTools;
					end;
				SetupUndoFromClip;
				SaveThresholdingState := Thresholding;
				SaveForegroundIndex := ForegroundIndex;
				SaveBackgroundIndex := BackgroundIndex;
				SetForegroundColor(WhiteIndex);
				Thresholding := false;
				if ThresholdStart = WhiteIndex then
					ThresholdStart := 1;
				DrawOutlines := false;
				case ThresholdingMode of
					LutThresholding: 
						begin
							EraseIndex := ThresholdStart - 1;
							if EraseIndex < 0 then
								EraseIndex := WhiteIndex;
							DrawOutlines := OutlineParticles;
							if ThresholdEnd <> BlackIndex then
								OutLineIndex := BlackIndex
							else
								OutLineIndex := WhiteIndex;
						end;
					GrayMapThresholding: 
						begin
							EraseIndex := GrayMapThreshold - 1;
							if EraseIndex < 0 then
								EraseIndex := WhiteIndex;
						end;
					BinaryImage: 
						begin
							DrawOutlines := OutlineParticles;
							OutLineIndex := 254;
							EraseIndex := 128;
						end;
				end;
				AnalyzingParticles := true;
				nParticles := 0;
				GetPort(tPort);
				SetPort(GrafPtr(osPort));
				ShowWatch;
				with sRect do
					for vloc := top to bottom - 1 do
						for hloc := left to right - 1 do
							begin
								if PixelInside then
									begin
										if TraceEdge(hloc, vloc, circumference, 'U', TouchingEdge) then
											begin
												nParticles := nParticles + 1;
												RoiShowing := false;
												if nRegions < MaxRegions then
													begin
														GetNonRectHistogram;
														ComputeResults;
													end;
												SetBackgroundColor(EraseIndex);
												EraseRgn(osroiRgn);
												with MeasurementsP^ do
													if (PixelCount[nRegions] < MinParticleSize) or (PixelCount[nRegions] > MaxParticleSize) or (TouchingEdge) then
														begin
															nRegions := nRegions - 1;
															nParticles := nParticles - 1;
															UpdateScreen(RoiRect);
														end
													else
														begin
															if DrawOutlines then
																begin
																	SetForegroundColor(OutlineIndex);
																	FrameRgn(osroiRgn);
																end;
															UpdateScreen(RoiRect);
															if nParticles <= MaxRegions then
																begin
																	if SpatialScale <> 0.0 then
																		circumference := circumference / SpatialScale;
																	MeasurementsP^.plength[nRegions] := circumference;
																	ShowResults;
																end
															else
																ShowMessage(long2str(nParticles));
															if nParticles = MaxRegions then
																beep;
															if CommandPeriod or (AnalyzingParticles = false) then
																begin {quit}
																	beep;
																	SetPort(tPort);
																	if LabelParticles then
																		LabelBlobs;
																	Thresholding := SaveThresholdingState;
																	SetForegroundColor(SaveForegroundIndex);
																	SetBackgroundColor(SaveBackgroundIndex);
																	KillRoi;
																	UpdatePicWindow;
																	WhatToUndo := UndoEdit;
																	UndoFromClip := true;
																	AnalyzingParticles := false;
																	exit(AnalyzeParticles);
																end; {quit}
														end;
											end;  {if TraceEdge}
									end; {if PixelInside}
							end; {for}
			end; {with}
		SetPort(tPort);
		if LabelParticles then
			LabelBlobs;
		Thresholding := SaveThresholdingState;
		SetForegroundColor(SaveForegroundIndex);
		SetBackgroundColor(SaveBackgroundIndex);
		KillRoi;
		UpdatePicWindow;
		if ThresholdingMode = GrayMapThresholding then
			ResetGrayMap;
		WhatToUndo := UndoEdit;
		UndoFromClip := true;
		AnalyzingParticles := false;
	end;

	procedure UpdateAnalysisMenu;		{ moved here from Utilities (unit size limits) - Arlo}
		var
			ShowItems: boolean;
			i: integer;
	begin
		ShowItems := Info <> NoInfo;
		SetMenuItem(AnalyzemenuH, MeasureItem, ShowItems);
		SetMenuItem(AnalyzemenuH, HistogramItem, ShowItems);
{$IFC Arlo }
		ShowItems := ShowItems and not InFrequencyDomain;
		SetMenuItem(AnalyzemenuH, SetScaleItem, ShowItems);
		SetMenuItem(AnalyzemenuH, CalibrateItem, ShowItems);
{$ENDC }
		SetMenuItem(AnalyzemenuH, AnalyzeItem, ShowItems);
		SetMenuItem(AnalyzemenuH, DeleteItem, nRegions > 0);
		SetMenuItem(AnalyzemenuH, PlotItem, ShowItems);
		SetMenuItem(AnalyzemenuH, Plot3DItem, ShowItems);
		SetMenuItem(AnalyzemenuH, RestoreItem, ShowItems and (NoInfo^.RoiType <> NoRoi));
		SetMenuItem(AnalyzemenuH, MarkItem, info^.RoiShowing);
	end;

end.