unit Graphics;

{Graphics routines used by NIH Image}

interface

	uses
		Memory, QuickDraw, Packages, Menus, Events, Fonts, Controls, Scrap, ToolUtils, Palettes, Printing, TextEdit, globals, Utilities;

	procedure ShowLineWidth;
	function GetInterpolatedPixel (x, y: extended): extended;
	procedure GetObliqueLine (xstart, ystart, start, angle: extended; count: integer; var line: rLineType);
	procedure GetLengthOrPerimeter (var ulength, clength: extended);
	procedure PlotLineProfile;
	procedure PlotArbitraryLine;
	procedure DrawPlot;
	procedure UpdatePlotWindow;
	procedure ShowInfo;
	procedure ComputePlotMinAndMax;
	procedure SetupPlot (start: point; VerticalPlot: boolean);
	procedure MakePlotWindow (PlotLeft, PlotTop, PlotWidth, PlotHeight: integer);
	procedure DrawObject (obj: ObjectType; p1, p2: point);
	procedure DrawTools;
	function InvertingCalibrationFunction: boolean;
	procedure DrawHistogram;
	procedure DrawLabels (xL, yL, zL: str255);
	procedure ShowNextImage;
	procedure CascadeImages;
	procedure TileImages;
	function Duplicate (name: str255; SavingBlankField: boolean): boolean;
	procedure InvertPic;
	procedure ShowMessage (str: str255);
	procedure ShowTime (StartTicks: LongInt; r: rect; str: str255);
	procedure ShowFrameRate (str1: str255; StartTicks, nFrames: LongInt);
	procedure ConvertHistoToText;
	procedure ConvertPlotToText;
	procedure ConvertCalibrationCurveToText;
	procedure SetupUndoInfoRec;
	procedure ActivateWindow;
	procedure UpdateResultsWindow;
	procedure ScrollResultsText;
	procedure UpdateResultsScrollBars;
	procedure InitResultsTextEdit (font, size: integer);
	procedure DoMouseDownInResults (loc: point);
	procedure AppendResults;
	procedure DeleteLines (first, last: integer);
	procedure UpdateList;
	procedure ShowMeter;
	procedure UpdateMeter (percentdone: integer; str: str255);
	function RgnNotTooBig (Rgn1, Rgn2: RgnHandle): boolean;
	procedure MakeCoordinatesRelative;
	procedure MakeOutline (RoiKind: RoiTypeType);
	procedure ConvertCoordinates;
	function CoordinatesAvailable: boolean;
	function CoordinatesAvailableMsg: boolean;
	procedure DrawDropBox (r: rect);
	function PopUpMenu (theMenu: MenuHandle; left, top, PopUpItem: integer): integer;
	procedure GetDItemRect (d: DialogPtr; item: integer; var r: rect);
	procedure DrawPopUpText (str: str255; r: rect);
	procedure SetUProc (d: DialogPtr; item: integer; pptr: handle);
	procedure RemoveDensityCalibration;
	function isInvertingFunction:boolean;
	function CheckCalibration: boolean;
	procedure PlotTooLongMsg;



implementation


{$PUSH}
{$D-}

	procedure DrawJustifiedReal (x, y: integer; r: extended);
  {Draws a right justified real number.}
		var
			str: str255;
			digits: integer;
	begin
		if abs(r) >= 1000.0 then
			digits := 0
		else
			digits := 2;
		RealToString(r, 1, digits, str);
		MoveTo(x - StringWidth(str), y);
		DrawString(str);
	end;


	procedure DrawVerticalString (x, y: integer; str: str255);
		var
			i: integer;
	begin
		MoveTo(x, y);
		for i := 1 to length(str) do begin
				MoveTo(x, y);
				DrawChar(str[i]);
				y := y + 9;
			end;
	end;


	procedure LabelProfilePlot;
		var
			str: str255;
			min, max: extended;
			x, y: integer;
	begin
		min := PlotMin;
		max := PlotMax;
		DrawJustifiedReal(PlotLeftMargin - 2, PlotHeight - PlotBottomMargin, min);
		DrawJustifiedReal(PlotLeftMargin - 2, PlotTopMargin + 8, max);
		y := PlotTopMargin + (PlotHeight - (PlotTopMargin + PlotBottomMargin)) div 2 - length(PlotYUnits) * 9 div 2 + 6;
		DrawVerticalString(PlotLeftMargin - 15, y, PlotYUnits);
		MoveTo(PlotLeftMargin, PlotHeight - PlotBottomMargin + 11);
		DrawLong(0);
		if PlotScale <> 0.0 then
			RealToString((PlotCount - 1) * PlotScale, 1, Precision, str)
		else
			NumToString(PlotCount - 1, str);
		MoveTo(PlotWidth - PlotRightMargin - StringWidth(str) + 4, PlotHeight - PlotBottomMargin + 11);
		DrawString(str);
		x := PlotRightMargin + (PlotWidth - (PlotRightMargin + PlotLeftMargin)) div 2 - StringWidth(str) div 2;
		MoveTo(x, PlotHeight - PlotBottomMargin + 13);
		DrawString(PlotXUnits);
	end;


	procedure LabelCalibrationPlot;
		var
			pbottom, hloc, vloc, i: integer;
			letter: packed array[1..6] of char;
			c:char;
	begin
		pbottom := PlotHeight - PLotBottomMargin;
		DrawJReal(PlotLeftMargin, PlotTopMargin + 4, maxCValue, 2);
		DrawJReal(PlotLeftMargin, pbottom, minCValue, 2);
		MoveTo(PlotLeftMargin - 3, pbottom + 10);
		DrawString('0');
		MoveTo(PlotWidth - PlotRightMargin - 14, pbottom + 10);
		DrawString('255');
		MoveTo(PlotLeftMargin + 15, PlotTopMargin + 15);
		TextSize(12);
		case info^.fit of
			StraightLine: 
				DrawString('y=a+bx');
			Poly2: 
				DrawString('y=a+bx+cx^2');
			Poly3: 
				DrawString('y=a+bx+cx^2+dx^3');
			Poly4: 
				DrawString('y=a+bx+cx^2+dx^3+ex^4');
			Poly5: 
				DrawString('y=a+bx+cx^2+dx^3+ex^4+fx^5');
			ExpoFit: 
				DrawString('y=aexp(bx)');
			PowerFit: 
				DrawString('y=ax^b');
			LogFit: 
				DrawString('y=aln(bx)');
			RodbardFit: 
				DrawString('y=c*((a-x)/(x-d))^(1/b)');
			UncalibratedOD: 
				DrawString('y=log10(255/(255-x))');
			otherwise
		end;
		hloc := PlotWidth - PlotRightMargin + 5;
		vloc := PlotTopMargin + 25;
		letter := 'abcdef';
		MoveTo(hloc, vloc);
		with info^ do
			for i := 1 to nCoefficients do begin
					MoveTo(hloc, vloc);
					TextSize(12);
					c:=letter[i];
					DrawString(c);
					DrawString('=');
					TextSize(9);
					DrawReal(Coefficient[i], 1, 8);
					vloc := vloc + 15;
				end;
		if info^.fit <> UncalibratedOD then begin
				vloc := vloc + 25;
				MoveTo(hloc, vloc);
				DrawString('S.D.=');
				DrawReal(FitSD, 1, 4);
				vloc := vloc + 15;
				MoveTo(hloc, vloc);
				DrawString('R^2=');
				DrawReal(FitGoodness, 1, 4);
			end;
	end;


	procedure DrawPlot;
		var
			fRect: rect;
	begin
		SetRect(fRect, PlotLeftMargin, PlotTopMargin, PlotWidth - PlotRightMargin, PlotHeight - PlotBottomMargin);
		PenNormal;
		FrameRect(fRect);
		DrawPicture(PlotPICT, fRect);
		TextFont(Geneva);
		TextSize(9);
		if WindowPeek(PlotWindow)^.WindowKind = ProfilePlotKind then begin
				if DrawPlotLabels then
					LabelProfilePlot
			end
		else
			LabelCalibrationPlot;
	end;


	procedure UpdatePlotWindow;
	begin
		SetPort(PlotWindow);
		EraseRect(PlotWindow^.portRect);
		DrawPlot;
		DrawMyGrowIcon(PlotWindow);
	end;


	procedure MakePlotWindow; {(PlotLeft, PlotTop, PlotWidth, PlotHeight: integer)}
		var
			PLotRect, pwrect, dwrect, srect: rect;
			overlapping: boolean;
	begin
		if PlotWindow = nil then begin
				SetRect(PlotRect, PlotLeft, PlotTop, PlotLeft + PlotWidth, PlotTop + PlotHeight);
				PlotWindow := NewWindow(nil, PlotRect, 'Plot', true, DocumentProc, nil, true, 0);
			end
		else begin
				GetWindowRect(PlotWindow, pwrect);
				GetWindowRect(info^.wptr, dwrect);
				overlapping := SectRect(pwrect, dwrect, srect);
				if overlapping then
					MoveWindow(PlotWindow, PlotLeft, PlotTop, false);
				SizeWindow(PlotWindow, PlotWidth, PlotHeight, false);
			end;
	end;


	procedure GetDiagLine (start, finish: Point; var count: integer; var data: LineType; OptionKey: boolean);
		var
			sum: LongInt;
			p: ptr;
			deltax, deltay, xinc, yinc, accumulator, i: LongInt;
			xloc, yloc, j: LongInt;
			average: boolean;
			buf, fline: LineType;
	begin
		average := LineWidth > 1;
		if OptionKey and average then
			for i := 0 to MaxLine do
				fline[i] := ForegroundIndex;
		count := 0;
		xloc := start.h;
		yloc := start.v;
		deltax := finish.h - xloc;
		deltay := finish.v - yloc;
		if (deltax = 0) and (deltay = 0) then begin
				data[count] := MyGetPixel(xloc, yloc);
				if OptionKey then
					PutPixel(xloc, yloc, ForegroundIndex);
				count := 1;
				exit(GetDiagLine);
			end;
		if deltax < 0 then begin
				xinc := -1;
				deltax := -deltax
			end
		else
			xinc := 1;
		if deltay < 0 then begin
				yinc := -1;
				deltay := -deltay
			end
		else
			yinc := 1;
		if DeltaX > DeltaY then begin {More horizontal}
				if average and (CurrentTool <> LineTool) then
					deltax := deltax + LineWidth;
				accumulator := deltax div 2;
				i := deltax;
				repeat
					if count < MaxLine then
						count := count + 1;
					accumulator := accumulator + deltay;
					if accumulator >= deltax then begin
							accumulator := accumulator - deltax;
							yloc := yloc + yinc
						end;
					xloc := xloc + xinc;
					if average then begin
							GetColumn(xloc, yloc, LineWidth, buf);
							if OptionKey then
								PutColumn(xloc, yloc, LineWidth, fline);
							sum := 0;
							for j := 0 to LineWidth - 1 do
								sum := sum + buf[j];
							data[count - 1] := round(sum / LineWidth);
						end
					else begin
							data[count - 1] := MyGetPixel(xloc, yloc);
							if OptionKey then
								PutPixel(xloc, yloc, ForegroundIndex);
						end;
					i := i - 1;
				until i = 0
			end
		else begin          {More vertical}
				if average and (CurrentTool <> LineTool) then
					deltay := deltay + LineWidth;
				accumulator := deltay div 2;
				i := deltay;
				repeat
					if count < MaxLine then
						count := count + 1;
					accumulator := accumulator + deltax;
					if accumulator >= deltay then begin
							accumulator := accumulator - deltay;
							xloc := xloc + xinc
						end;
					yloc := yloc + yinc;
					if average then begin
							GetLine(xloc, yloc, LineWidth, buf);
							if OptionKey then
								PutLine(xloc, yloc, LineWidth, fline);
							sum := 0;
							for j := 0 to LineWidth - 1 do
								sum := sum + buf[j];
							data[count - 1] := round(sum / LineWidth);
						end
					else begin
							data[count - 1] := MyGetPixel(xloc, yloc);
							if OptionKey then
								PutPixel(xloc, yloc, ForegroundIndex);
						end;
					i := i - 1;
				until i = 0
			end;
	end;


	function GetInterpolatedPixel (x, y: extended): extended;
  {Uses bilinear interpolation to computes the raw pixel value at real coordinates (x,y).}
		var
			i: integer;
			xbase, ybase, offset: LongInt;
			LowerLeft, LowerRight, UpperLeft, UpperRight: integer;
			xfraction, yfraction, UpperAverage, LowerAverage: extended;
	begin
		xbase := trunc(x);
		ybase := trunc(y);
		xFraction := x - xbase;
		yFraction := y - ybase;
		with info^ do
			if (xbase < 0) or (ybase < 0) or (xbase >= (PixelsPerLine - 1)) or (ybase >= (nlines - 1)) then begin
					LowerLeft := 0;
					LowerRight := 0;
					UpperLeft := 0;
					UpperRight := 0;
				end
			else begin
					offset := ybase * BytesPerRow + xbase;
					LowerLeft := ImageP(PicBaseAddr)^[offset];
					LowerRight := ImageP(PicBaseAddr)^[offset + 1];
					UpperLeft := ImageP(PicBaseAddr)^[offset + BytesPerRow];
					UpperRight := ImageP(PicBaseAddr)^[offset + BytesPerRow + 1];
				end;
		UpperAverage := UpperLeft + xfraction * (UpperRight - UpperLeft);
		LowerAverage := LowerLeft + xfraction * (LowerRight - LowerLeft);
		GetInterpolatedPixel := LowerAverage + yfraction * (UpperAverage - LowerAverage);
	end;


	function GetCInterpolatedPixel (x, y: extended): extended;
  {Uses bilinear interpolation to computes the calibrated pixel value at real coordinates (x,y).}
		var
			i, xbase, ybase: LongInt;
			LowerLeft, LowerRight, UpperLeft, UpperRight: extended;
			xfraction, yfraction, UpperAverage, LowerAverage: extended;
	begin
		xbase := trunc(x);
		ybase := trunc(y);
		xFraction := x - xbase;
		yFraction := y - ybase;
		LowerLeft := cvalue[MyGetPixel(xbase, ybase)];
		LowerRight := cvalue[MyGetPixel(xbase + 1, ybase)];
		UpperRight := cvalue[MyGetPixel(xbase + 1, ybase + 1)];
		UpperLeft := cvalue[MyGetPixel(xbase, ybase + 1)];
		UpperAverage := UpperLeft + xfraction * (UpperRight - UpperLeft);
		LowerAverage := LowerLeft + xfraction * (LowerRight - LowerLeft);
		GetCInterpolatedPixel := LowerAverage + yfraction * (UpperAverage - LowerAverage);
	end;


	procedure GetObliqueLine (xstart, ystart, start, angle: extended; count: integer; var line: rLineType);
		var
			i: integer;
			x, y, xinc, yinc: extended;
			IntegerStart: boolean;
			tLine:LineType;
	begin
		IntegerStart := (xstart = trunc(xstart)) and (ystart = trunc(ystart));
		if IntegerStart and (angle = 0.0) then begin
				GetLine(trunc(xstart), trunc(ystart), count, tLine);
				for i := 0 to count - 1 do
					line[i] := cvalue[tLine[i]];
				exit(GetObliqueLine);
			end;
		if IntegerStart and (angle = 270.0) then begin
				GetColumn(trunc(xstart), trunc(ystart), count, tLine);
				for i := 0 to count - 1 do
					line[i] := cvalue[tLine[i]];
				exit(GetObliqueLine);
			end;
		angle := (angle / 180.0) * pi;
		xinc := cos(angle);
		yinc := -sin(angle);
		x := xstart + start * xinc;
		y := ystart + start * yinc;
		if info^.fit <> uncalibrated then
			for i := 0 to count - 1 do begin
					line[i] := GetCInterpolatedPixel(x, y);
					x := x + xinc;
					y := y + yinc;
				end
		else
			for i := 0 to count - 1 do begin
					line[i] := GetInterpolatedPixel(x, y);
					x := x + xinc;
					y := y + yinc;
				end;
	end;


	procedure DrawTools;
		var
			tPort: GrafPtr;
			tool: ToolType;
			tpRect, sRect, dRect: rect;
			hloc, vloc: integer;

		procedure CopyToolBits (src, dst: rect; CopyMode: integer);
		begin
			CopyBits(toolBits, BitMapHandle(CGrafPtr(ToolWindow)^.PortPixMap)^^, src, dst, CopyMode, nil);
		end;

	begin
		GetPort(tPort);
		SetPort(ToolWindow);
		tpRect := CGrafPtr(ToolWindow)^.portRect;
		SetFColor(BlackIndex);
		SetBColor(WhiteIndex);
		CopyToolBits(tpRect, tpRect, srcCopy);
		case LOIType of
			Straight: 
				;
			Freehand:  begin
					SetRect(sRect, 46, 92, 62, 106);
					hloc := 27;
					vloc := 92;
					SetRect(dRect, hloc, vloc, hloc + 16, vloc + 14);
					CopyToolBits(sRect, dRect, SrcCopy);
				end;
			Segmented:  begin
					SetRect(sRect, 46, 108, 62, 122);
					hloc := 27;
					vloc := 92;
					SetRect(dRect, hloc, vloc, hloc + 16, vloc + 14);
					CopyToolBits(sRect, dRect, SrcCopy);
				end;
		end;
		InvertRect(ToolRect[CurrentTool]);
		SetRect(sRect, 46, 226, 55, 233);
		hloc := 2;
		vloc := Lines[LineIndex].top - 4;
		SetRect(dRect, hloc, vloc, hloc + 9, vloc + 7);
		CopyToolBits(sRect, dRect, SrcCopy); {Check mark}
		SetFColor(ForegroundIndex);
		SetRect(sRect, 46, 81, 57, 87);
		hloc := 4;
		vloc := 101;
		SetRect(dRect, hloc, vloc, hloc + 11, vloc + 6);
		CopyToolBits(sRect, dRect, SrcOr); {Brush color}
		SetFColor(BackgroundIndex);
		SetRect(sRect, 46, 65, 61, 76);
		hloc := 3;
		vloc := 73;
		SetRect(dRect, hloc, vloc, hloc + 15, vloc + 11);
		CopyToolBits(sRect, dRect, SrcOr); {Eraser color}
		SetPort(tPort);
	end;


	procedure ShowLineWidth;
	begin
		LineIndex := LineWidth;
		if LineWidth = 6 then
			LineIndex := 5;
		if LineWidth > 6 then
			LineIndex := 6;
		DrawTools;
	end;


	procedure GetFatLine (xstart, ystart, angle: extended; count: integer; var line: rLineType);
		var
			i, j, xbase, ybase: integer;
			x, y, xinc, yinc, pAngle, xinc2, yinc2: extended;
			sum, value: extended;
			add: boolean;
	begin
		add := (angle > 90.0) and (angle <= 270.0);
		angle := (angle / 180.0) * pi;
		xinc := cos(angle);
		yinc := -sin(angle);
		if add then
			pAngle := angle + pi / 2.0
		else
			pAngle := angle - pi / 2.0;
		xinc2 := cos(pAngle);
		yinc2 := -sin(pAngle);
		for i := 0 to count - 1 do begin
				x := xstart;
				y := ystart;
				sum := 0.0;
				for j := 1 to LineWidth do begin
						if info^.fit <> uncalibrated then
							value := GetCInterpolatedPixel(x, y)
						else
							value := GetInterpolatedPixel(x, y);
						sum := sum + value;
						x := x + xinc2;
						y := y + yinc2;
					end;
				line[i] := sum / LineWidth;
				xstart := xstart + xinc;
				ystart := ystart + yinc;
			end;
	end;


	procedure ComputePlotMinAndMax;
		var
			i: integer;
			temp: extended;
	begin
		if InvertPlots then
			for i := 0 to PlotCount - 1 do
				PlotData^[i] := maxCValue - (PlotData^[i] - minCValue);
		ActualPlotMin := 10e12;
		ActualPlotMax := -10e12;
		for i := 0 to PlotCount - 1 do begin
				temp := PlotData^[i];
				if temp < ActualPlotMin then
					ActualPlotMin := temp;
				if temp > ActualPlotMax then
					ActualPlotMax := temp;
			end;
	end;


	procedure SetupPlot (start: point; VerticalPlot: boolean);
		const
			MinWidth = 150;
		var
			fRect, trect: rect;
			i, y, WindowWidth, fmax: integer;
			SaveClipRegion: RgnHandle;
			pt: point;
			scale, vscale: extended;
			AutoScale: boolean;
			index: Byte;
	begin
		with info^ do begin
				PlotLeftMargin := 38;
				PlotTopMargin := 10;
				PlotBottomMargin := 20;
				PlotRightMargin := 20;
				if FixedSizePlot then begin
						PlotWidth := ProfilePlotWidth;
						PlotHeight := ProfilePlotHeight
					end
				else begin
						PlotWidth := PlotCount * trunc(magnification + 0.5);
						if PlotWidth < MinWidth then
							PlotWidth := MinWidth;
						if PlotWidth + PlotRightMargin + PicLeftBase > ScreenWidth then
							PlotWidth := ScreenWidth - PlotRightMargin - PicLeftBase - 10;
						if PlotWidth > PicRect.right then
							PlotWidth := PicRect.right;
						PlotHeight := PlotWidth div 2;
						if PlotWidth > 300 then
							PlotHeight := PlotWidth div 3;
						if PlotWidth > 400 then
							PlotHeight := PlotWidth div 4;
					end;
				PlotWidth := PlotWidth + PlotLeftMargin + PlotRightMargin;
				PlotHeight := PlotHeight + PlotTopMargin + PlotBottomMargin;
				OffscreenToScreen(start);
				pt.h := start.h;
				pt.v := start.v + 40;
				SetPort(wptr);
				LocalToGlobal(pt);
				if VerticalPlot then
					PlotLeft := PicLeftBase
				else
					PlotLeft := pt.h - PlotLeftMargin;
				PlotTop := pt.v;
				if PlotLeft > (ScreenWidth - PlotWidth) then
					PlotLeft := ScreenWidth - PlotWidth - 10;
				if PlotTop < 60 then
					PlotTop := 60;
				if PlotTop > (ScreenHeight - PlotHeight) then
					PlotTop := ScreenHeight - PlotHeight - 10;
				if PlotTop < 60 then
					PlotTop := 60;
				MakePlotWindow(PlotLeft, PlotTop, PlotWidth, PlotHeight);
				if PlotWindow = nil then
					exit(SetupPlot);
				WindowPeek(PlotWindow)^.WindowKind := ProfilePlotKind;
				if SpatiallyCalibrated then begin
						PlotScale := 1 / xScale;
						if xUnit = 'inch' then
							PlotXUnits := 'Inches'
						else if xUnit = 'meter' then
							PlotXUnits := 'meters'
						else if xUnit = 'mile' then
							PlotXUnits := 'miles'
						else
							PlotXUnits := xUnit;
					end
				else begin
						PlotScale := 0.0;
						PlotXUnits := 'Pixels'
					end;
				if fit <> uncalibrated then
					PlotYUnits := UnitOfMeasure
				else
					PlotYUnits := '';
				if AutoScalePlots then begin
						PlotMin := ActualPlotMin;
						PlotMax := ActualPlotMax;
					end
				else begin
						PlotMin := ProfilePlotMin;
						PlotMax := ProfilePlotMax;
					end;
				fmax := PlotCount - 1;
				if (PlotMax - PlotMin) <> 0 then
					vscale := fmax / (PlotMax - PlotMin)
				else
					vscale := 1.0;
				scale := 2048.0 / PlotCount;  {This scaling needed to get around a 32-bit QD problem}
				if scale < 1.0 then
					scale := 1.0;
				fmax := round(fmax * scale);
				vscale := vscale * scale;
				SetRect(fRect, 0, 0, fmax, fmax);
				SetPort(PlotWindow);
				SaveClipRegion := PlotWindow^.ClipRgn;
				RectRgn(PlotWindow^.ClipRgn, fRect);
				PlotPICT := OpenPicture(fRect);
				PenNormal;
				if LinePlot then begin
						MoveTo(0, round(vscale * (PlotMax - PlotData^[0])));
						for i := 1 to PlotCount - 1 do
							LineTo(round(i * scale), round(vscale * (PlotMax - PlotData^[i])))
					end
				else
					for i := 1 to PlotCount - 1 do begin
							y := round(vscale * (PlotMax - PlotData^[i]));
							MoveTo(round(i * scale), y);
							LineTo(round(i * scale), y)
						end;
				ClosePicture;
				PlotWindow^.ClipRgn := SaveClipRegion;
				InvalRect(PlotWindow^.PortRect);
				SelectWindow(PlotWindow);
			end;  {with}
	end;


	procedure PlotLineProfile;
		var
			x1, y1, x2, y2, ulength, clength: extended;
			start: point;
			i, count:integer;
	begin
		GetLengthOrPerimeter(ulength, clength);
		count := round(ulength);
		if count = 0 then begin
				PutError('Line length is zero.');
				AbortMacro;
				exit(PlotLineProfile);
			end;
		if count > MaxLine then begin
			PlotTooLongMsg;
			exit(PlotLineProfile);
		end;
		PlotCount := count;
		GetLoi(x1, y1, x2, y2);
		PlotAngle := info^.LAngle;
		if LineWidth > 1 then
			GetFatLine(x1, y1, PlotAngle, PlotCount, PlotData^)
		else
			GetObliqueLine(x1, y1, 0.0, PlotAngle, PlotCount, PlotData^);
		PlotAvg := LineWidth;
		PlotStart.h := round(x1);
		PlotStart.v := round(y1);
		ComputePlotMinAndMax;
		if ShowPlot then
			SetupPlot(PlotStart, false);
	end;


	function CoordinatesAvailable: boolean;
		var
			available: boolean;
	begin
		with info^.RoiRect do
			available := (nCoordinates > 0) and ((right - left) = CoordinatesWidth) and ((bottom - top) = CoordinatesHeight) and (info^.RoiType = CoordinatesRoiType);
		if AnalyzingParticles and (nCoordinates > 0) then
			available := true;
		CoordinatesAvailable := available;
	end;


	function CoordinatesAvailableMsg: boolean;
		var
			available: boolean;
	begin
		available := CoordinatesAvailable;
		if not available then
			PutError('XY coordinates are not available.');
		CoordinatesAvailableMsg := available;
	end;


	function GetArbitraryLine (var count: integer; var pdata: rLineType): boolean;
		var
			angle, length, leftover: extended;
			i, j, ilength, xbase, ybase: integer;
			x1, y1, x2, y2: LongInt;
			data: rLineType;
	begin
		if not CoordinatesAvailableMsg or (nCoordinates < 2) then begin
				GetArbitraryLine := false;
				exit(GetArbitraryLine);
			end;
		count := 0;
		length := 0.0;
		leftover := 0.0;
		with info^.RoiRect do begin
				xbase := left;
				ybase := top;
			end;
		for i := 2 to nCoordinates do begin
				x1 := xCoordinates^[i - 1] + xbase;
				y1 := yCoordinates^[i - 1] + ybase;
				x2 := xCoordinates^[i] + xbase;
				y2 := yCoordinates^[i] + ybase;
				length := sqrt(sqr(x2 - x1) + sqr(y2 - y1));
				if length > 0.0 then begin
						length := length - LeftOver;
						ilength := round(length);
						if ilength > 0 then begin
								angle:=GetAngle(x2 - x1, y1 - y2);
								GetObliqueLine(x1, y1, leftover, angle, ilength, data);
								for j := 1 to ilength do begin
										pdata[count] := data[j - 1];
										if count < MaxLine then
											count := count + 1;
									end;
							end;
						leftover := length - ilength;
					end;
			end;
		GetArbitraryLine := true;
	end;


	procedure PlotArbitraryLine;
		var
			angle, length, leftover: extended;
			x1, y1, x2, y2, i, j, count: integer;
			data: LineType;
	begin
		if not GetArbitraryLine(PlotCount, PlotData^) then
			exit(PlotArbitraryLine);
		PlotAvg := 1;
		with info^.RoiRect do begin
				PlotStart.h := left;
				PlotStart.v := top;
			end;
		ComputePlotMinAndMax;
		if ShowPlot then
			SetupPlot(PlotStart, false);
	end;


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

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

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

	procedure ShowInfo;
		var
			vloc, hloc: integer;
			tPort: GrafPtr;
			trect: rect;
			clength, cx, cy, IntDen, BackgroundLevel: extended;
			tUnit: UnitType;
			TextStyle:style;

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

	begin
		GetPort(tPort);
		vloc := 35;
		hloc := 4;
		SetPort(InfoWindow);
		TextFont(Geneva);
		TextSize(9);
		Setrect(trect, 0, vloc, rwidth, rheight);
		EraseRect(trect);
		if InfoMessage <> '' then begin
				Setrect(trect, hloc, vloc + 15, rwidth - 10, rheight);
				TETextBox(pointer(ord(@InfoMessage) + 1), length(InfoMessage), trect, teJustLeft)
			end
		else
			with results do begin
					NewLine;
					with info^ do begin
							if ShowCount then begin
									DrawBString('Count: ');
									DrawLong(mCount);
									NewLine;
								end;
							if SpatiallyCalibrated then begin
									DrawBString('Pixels: ');
									DrawLong(PixelCount^[mCount]);
									NewLine;
									DrawBString('Area: ');
									DrawReal(mArea^[mCount], 1, precision);
									DrawString(' square ');
									tUnit := xUnit;
									if tUnit = 'inch' then
										tUnit := 'Inches'
									else if tUnit = 'meter' then
										tUnit := 'meters'
									else if tUnit = 'mile' then
										tUnit := 'miles';
									DrawString(tUnit);
								end
							else begin
									DrawBString('Area: ');
									DrawLong(PixelCount^[mCount]);
									DrawString(' square pixels');
								end;
							NewLine;
							DrawBString('Mean: ');
							DrawReal(mean^[mCount], 1, precision);
							if fit <> uncalibrated then begin
									DrawString(' ');
									DrawBString(UnitOfMeasure);
									DrawString('   (');
									DrawLong(round(results.UncalibratedMean));
									DrawString(')');
								end;
							if PixelCount^[mCount] > 1 then begin
									NewLine;
									DrawBString('Std Dev: ');
									DrawReal(sd^[mCount], 1, precision);
									NewLine;
									DrawBString('Min: ');
									DrawReal(mMin^[mCount], 1, precision);
									NewLine;
									DrawBString('Max: ');
									DrawReal(mMax^[mCount], 1, precision);
								end;
							if (xyLocM in measurements) or (nPoints > 0) then begin
									NewLine;
									DrawBString('X: ');
									DrawReal(xcenter^[mCount], 6, precision);
									NewLine;
									DrawBString('Y: ');
									DrawReal(ycenter^[mCount], 6, precision);
								end;
							if ModeM in Measurements then begin
									NewLine;
									DrawBString('Mode: ');
									DrawReal(mode^[mCount], 1, precision);
								end;
							if (LengthM in measurements) or (nLengths > 0) then begin
									NewLine;
									DrawBString('Length: ');
									DrawReal(plength^[mCount], 1, precision);
								end;
							if MajorAxisM in Measurements then begin
									NewLine;
									DrawBString(Concat(MajorLabel, ': '));
									DrawReal(MajorAxis^[mCount], 1, precision);
								end;
							if MinorAxisM in Measurements then begin
									NewLine;
									DrawBString(Concat(MinorLabel, ': '));
									DrawReal(MinorAxis^[mCount], 1, precision);
								end;
							if (AngleM in measurements) or (nAngles > 0) then begin
									NewLine;
									DrawBString('Angle: ');
									DrawReal(orientation^[mCount], 1, precision);
								end;
							if IntDenM in measurements then begin
									NewLine;
									FindIntegratedDensity(IntDen, BackgroundLevel);
									DrawBString('Integrated Density: ');
									DrawReal(IntDen, 1, precision);
									NewLine;
									DrawBString('Background Level: ');
									DrawReal(BackGroundLevel, 1, precision);
								end
							else begin
									IntDen := 0.0;
									BackGroundLevel := 0.0;
								end;
							IntegratedDensity^[mCount] := IntDen;
							idBackground^[mCount] := BackGroundLevel;
							if User1M in Measurements then begin
									NewLine;
									DrawBString(Concat(User1Label, ': '));
									DrawReal(User1^[mCount], 1, precision);
								end;
							if User2M in Measurements then begin
									NewLine;
									DrawBString(Concat(User2Label, ': '));
									DrawReal(User2^[mCount], 1, precision);
								end;
						end;
				end; {with}
		SetPort(tPort);
		mCount2 := mCount;
	end;


	procedure PaintCircle (hloc, vloc: integer);
		var
			r: rect;
	begin
		SetRect(r, hloc, vloc, hloc + LineWidth, vloc + LineWidth);
		PaintOval(r);
	end;


	procedure DrawBrush (start, finish: point);
  {Thanks to Robert Rimmer for suggesting the use of a line generator to implement the brush.}
		var
			deltax, deltay, xinc, yinc, accumulator, i: integer;
			xloc, yloc, offset, j: integer;
	begin
		xloc := start.h;
		yloc := start.v;
		deltax := finish.h - xloc;
		deltay := finish.v - yloc;
		if (deltax = 0) and (deltay = 0) then begin
				PaintCircle(xloc, yloc);
				exit(DrawBrush)
			end;
		if deltax < 0 then begin
				xinc := -1;
				deltax := -deltax
			end
		else
			xinc := 1;
		if deltay < 0 then begin
				yinc := -1;
				deltay := -deltay
			end
		else
			yinc := 1;
		if DeltaX > DeltaY then begin {More horizontal}
				accumulator := deltax div 2;
				i := deltax;
				repeat
					accumulator := accumulator + deltay;
					if accumulator >= deltax then begin
							accumulator := accumulator - deltax;
							yloc := yloc + yinc
						end;
					xloc := xloc + xinc;
					PaintCircle(xloc, yloc);
					i := i - 1;
				until i = 0
			end
		else begin          {More vertical}
				accumulator := deltay div 2;
				i := deltay;
				repeat
					accumulator := accumulator + deltax;
					if accumulator >= deltay then begin
							accumulator := accumulator - deltay;
							xloc := xloc + xinc
						end;
					yloc := yloc + yinc;
					PaintCircle(xloc, yloc);
					i := i - 1;
				until i = 0
			end;
	end;


	procedure DrawObject;{ (obj: ObjectType; p1, p2: point)}
		var
			MaskRect, r, dstRect, osMaskRect: rect;
			tPort: GrafPtr;
			tmp: integer;
			SaveGDevice: GDHandle;
	begin
		SaveGDevice := GetGDevice;
		GetPort(tPort);
		Pt2Rect(p1, p2, MaskRect);
		with Info^ do begin
				changes := true;
				tmp := trunc(magnification + 0.5) * LineWidth;
				with MaskRect do begin
						if tmp < 32 then
							tmp := 32;
						right := right + tmp;
						bottom := bottom + tmp;
						if magnification > 1.0 then begin
								left := left - tmp;
								top := top - tmp;
							end;
					end;
				ScreenToOffscreen(p1);
				ScreenToOffscreen(p2);
				SetGDevice(osGDevice);
				SetPort(GrafPtr(osPort));
				pmForeColor(ForegroundIndex);
				PenNormal;
				PenSize(LineWidth, LineWidth);
				case obj of
					lineObj:  begin
							MoveTo(p1.h, p1.v);
							LineTo(p2.h, p2.v);
						end;
					Rectangle:  begin
							Pt2Rect(p1, p2, r);
							FrameRect(r);
						end;
					oval:  begin
							Pt2Rect(p1, p2, r);
							FrameOval(r);
						end;
					BrushObj: 
						DrawBrush(p1, p2);
				end;
				SetGDevice(SaveGDevice);
				SetPort(wptr);
				SetFColor(BlackIndex);
				SetBColor(WhiteIndex);
				RectRgn(MaskRgn, MaskRect);
				CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPtr(wptr)^.PortPixMap)^^, SrcRect, wrect, gCopyMode, MaskRgn);
				SetPort(tPort);
			end; {with}
	end;


	function InvertingCalibrationFunction: boolean;
	begin
		with info^ do begin
				InvertingCalibrationFunction := (fit = StraightLine) and (Coefficient[2] < 0.0)
			end;
	end;


	procedure DrawHistogram;
		var
			tPort: GrafPtr;
			i, h: integer;
			MaxCount, count, NextMaxCount: LongInt;
			str: str255;
			hscale: extended;
			ShowSlice: boolean;
	begin
		ShowSlice := (HistogramSliceStart > 0) or (HistogramSliceEnd < 255);
		if not printing then begin
				GetPort(tPort);
				SetPort(HistoWindow);
				EraseRect(HistoWindow^.portRect);
			end;
		with Results do begin
				MaxCount := histogram[imode];
				if MaxCount > (hheight - 2) then begin
						if MaxCount / PixelCount^[mCount] > 0.08 then begin
								NextMaxCount := 0;
								for i := 0 to 255 do begin
										count := histogram[i];
										if (i <> imode) and (count > NextMaxCount) then
											NextMaxCount := count;
									end;
								NextMaxCount := NextMaxCount + NextMaxCount div 2;
								if (NextMaxCount > MaxCount) or (NextMaxCount = 0) then
									NextMaxCount := MaxCount;
								hscale := NextMaxCount / (hheight - 2);
							end
						else
							hscale := MaxCount / (hheight - 2);
					end
				else
					hscale := 1.0;
				if ShowSlice then
					PenPat(qd.gray);
				if InvertingCalibrationFunction then
					for h := 0 to 255 do begin
							if h = HistogramSliceStart then
								PenPat(qd.black);
							MoveTo(255 - h, hheight);
							LineTo(255 - h, hheight - round(histogram[h] / hscale));
							if h = HistogramSliceEnd then
								PenPat(qd.gray)
						end
				else
					for h := 0 to 255 do begin
							if h = HistogramSliceStart then
								PenPat(qd.black);
							MoveTo(h, hheight);
							LineTo(h, hheight - round(histogram[h] / hscale));
							if h = HistogramSliceEnd then
								PenPat(qd.gray)
						end;
			end;
		if ShowSlice then
			PenNormal;
		if not Printing then
			SetPort(tPort);
	end;


	procedure DrawLabels (xL, yL, zL: str255);
   {Draws the labels(e.g.,  X:, Y:, Value:) used for the dynamically}
   {changing values displayed at the top of the Info window.}
		var
			tPort: GrafPtr;
			trect: rect;
			s:style;
	begin
		if xL = XLabel then
			if yL = yLabel then
				if zL = zLabel then
					exit(DrawLabels);
		GetPort(tPort);
		SetPort(InfoWindow);
		TextSize(9);
		TextFont(Monaco);
		TextFace([bold]);
		if length(xL) > 0 then begin
				xLabel := xL;
				xValueLoc := InfoHStart + StringWidth(xLabel);
				yLabel := yL;
				yValueLoc := InfoHStart + StringWidth(yLabel);
				zLabel := zL;
				zValueLoc := InfoHStart + StringWidth(zLabel);
			end;
		Setrect(trect, 0, 0, rwidth, 32);
		EraseRect(trect);
		MoveTo(InfoHStart, InfoVStart);
		DrawString(xLabel);
		MoveTo(InfoHStart, InfoVStart + 10);
		DrawString(yLabel);
		MoveTo(InfoHStart, InfoVStart + 19);
		DrawString(zLabel);
		s:=[];  {ppc-bug}
		TextFace(s);
		SetPort(tPort);
	end;


	procedure ShowNextImage;
		var
			n: integer;
	begin
		n := info^.PicNum + 1;
		if n > nPics then
			n := 1;
		SelectWindow(PicWindow[n]);
	end;


	procedure CascadeImages;
		var
			i, hloc, vloc, wwidth, wheight: integer;
			offset: boolean;
	begin
		DisableDensitySlice;
		hloc := PicLeftBase;
		vloc := PicTopBase;
		offset := not OptionKeyDown;
		for i := nPics downto 1 do begin
				Info := pointer(WindowPeek(PicWindow[i])^.RefCon);
				with Info^ do begin
						HideWindow(wptr);
						ScaleToFitWindow := false;
						WindowState := NormalWindow;
						if offset then
							wrect := initwrect
						else begin
								wwidth := PixelsPerLine;
								if (hloc + wwidth) > ScreenWidth then
									wwidth := ScreenWidth - hloc - 5;
								wheight := nlines;
								if (vloc + wheight) > ScreenHeight then
									wheight := ScreenHeight - vloc - 5;
								SetRect(wrect, 0, 0, wwidth, wheight);
							end;
						SrcRect := wrect;
						KillRoi;
						magnification := 1.0;
						if i = nPics then
							DrawMyGrowIcon(wptr);
						SizeWindow(wptr, wrect.right, wrect.bottom, true);
						MoveWindow(wptr, hloc, vloc, true);
						ShowWindow(wptr);
						UpdateTitleBar;
					end; {with}
				if offset then begin
						hloc := hloc + hPicOffset;
						vloc := vloc + vPicOffset;
						if (vloc + 40) > ScreenHeight then
							vloc := PicTopBase;
					end;
			end; {for}
		PicLeft := PicLeftBase;
		PicTop := PicTopBase;
		WhatToUndo := NothingToUndo;
	end;


	procedure TileImages;
		const
			gap = 2;
			TitleBarHeight = 20;
		var
			i, hloc, vloc, width, height, hspace, vspace, nRows, nColumns: integer;
			MinWidth, MinHeight: integer;
			tInfo: array[1..MaxPics] of InfoPtr;
			trect: rect;
			TheyFit: boolean;
	begin
		DisableDensitySlice;
		PicLeft := PicLeftBase;
		PicTop := PicTopBase;
		width := MaxInt;
		height := MaxInt;
		for i := 1 to nPics do begin
				tInfo[i] := pointer(WindowPeek(PicWindow[i])^.RefCon);
				with tinfo[i]^.PicRect do begin
						if right < width then
							width := right;
						if bottom < height then
							height := bottom;
					end;
			end;
		MinWidth := width;
		MinHeight := height;
		hspace := ScreenWidth - PicLeft - 2 * gap;
		if width > hspace then
			width := hspace;
		vspace := ScreenHeight - PicTop - TitleBarHeight;
		if height > vspace then
			height := vspace;
		repeat
			hloc := PicLeft;
			vloc := PicTop;
			TheyFit := true;
			i := 0;
			repeat
				i := i + 1;
				if (hloc + width) > ScreenWidth then begin
						hloc := PicLeft;
						vloc := vloc + TitleBarHeight + height;
						if (vloc + height) > ScreenHeight then begin
								TheyFit := false;
							end;
					end;
				hloc := hloc + width + gap;
			until (TheyFit = false) or (i = nPics);
			if TheyFit = false then begin
					width := round(width * 0.98);
					height := round(height * 0.98);
				end;
		until TheyFit;
		nColumns := (ScreenWidth - PicLeft) div (width + gap);
		nRows := nPics div nColumns;
		if (nPics mod nColumns) <> 0 then
			nRows := nRows + 1;
{ShowMessage(concat('nRows= ', Long2str(nRows), crStr, 'nColumns= ', long2str(nColumns)));}
		if not OptionKeyWasDown then begin
				width := round((ScreenWidth - PicLeft) / nColumns);
				width := width - gap - 1;
				height := round((ScreenHeight - PicTop) / nRows);
				height := height - TitleBarHeight + 3;
				if width > MinWidth then
					width := MinWidth;
				if height > MinHeight then
					height := MinHeight;
			end;
		hloc := PicLeft;
		vloc := PicTop;
		for i := 1 to nPics do begin
				if (hloc + width) > ScreenWidth then begin
						hloc := PicLeft;
						vloc := vloc + TitleBarHeight + height;
					end;
				Info := tInfo[i];
				with Info^ do begin
						SetRect(wrect, 0, 0, width, height);
						if ScaleToFitWindow then begin
								ScaleToFitWindow := false;
								SrcRect := wrect;
								magnification := 1;
								WindowState := NormalWindow;
							end;
						if OptionKeyWasDown then begin
								ScaleToFitWindow := true;
								SrcRect := PicRect;
								ScaleImageWindow(wrect);
								WindowState := TiledSmallScaled;
							end
						else begin
								SrcRect := wrect;
								magnification := 1.0;
								UpdateTitleBar;
								WindowState := TiledSmall;
							end;
						SizeWindow(wptr, wrect.right, wrect.bottom, true);
						KillRoi;
						UpdatePicWindow;
					end; {with}
				MoveWindow(PicWindow[i], hloc, vloc, true);
				hloc := hloc + width + gap;
		end; {for}
		WhatToUndo := NothingToUndo;
	end;


	function Duplicate (name: str255; SavingBlankField: boolean): boolean;
		var
			width, height, i: integer;
			SaveInfo: InfoPtr;
			src, dst: ptr;
			hstart, vstart, offset: LongInt;
			AutoSelectAll: boolean;
	begin
		Duplicate := false;
		if nPics = MaxPics then
			exit(Duplicate);
		WhatToUndo := NothingToUndo;
		if (not SavingBlankField) and (NotRectangular or NotinBounds) then
			exit(Duplicate);
		AutoSelectAll := (not Info^.RoiShowing) or SavingBlankField;
		if AutoSelectAll then
			SelectAll(false);
		ShowWatch;
		with info^ do begin
				if name = '' then begin
						name := concat('Copy of ', title);
						TruncateString(name, maxTitle);
					end;
				with RoiRect do begin
						width := right - left;
						height := bottom - top;
						hstart := left;
						vstart := top;
					end;
			end;
		if AutoSelectAll then
			KillRoi;
		SaveInfo := Info;
		if NewPicWindow(name, width, height) then
			with SaveInfo^ do begin
					offset := vstart * BytesPerRow + hstart;
					src := ptr(ord4(PicBaseAddr) + offset);
					dst := Info^.PicBaseAddr;
					for i := 0 to height - 1 do begin
							BlockMove(src, dst, width);
							src := ptr(ord4(src) + BytesPerRow);
							dst := ptr(ord4(dst) + Info^.BytesPerRow);
						end;
					if SavingBlankField then begin
							Info^.PIctureType := BlankField;
							BlankFieldInfo := info;
						end;
					Duplicate := true;
				end; {with}
	end;


	procedure InvertPic;
		var
			tPort: GrafPtr;
			SaveGDevice: GDHandle;
	begin
		SaveGDevice := GetGDevice;
		SetGDevice(osGDevice);
		GetPort(tPort);
		with Info^ do begin
				SetPort(GrafPtr(osPort));
				InvertRect(PicRect);
			end;
		SetPort(tPort);
		SetGDevice(SaveGDevice);
	end;


	procedure ShowMessage (str: str255);
	begin
		InfoMessage := str;
		ShowInfo;
	end;


	procedure ShowTime (StartTicks: LongInt; r: rect; str: str255);
		var
			width, height, nPixels: LongInt;
			seconds, rate: extended;
	begin
		with r do begin
				width := right - left;
				height := bottom - top;
				nPixels := width * height;
			end;
		seconds := (TickCount - StartTicks) / 60.0;
		if seconds <> 0.0 then
			rate := nPixels / seconds
		else
			rate := 0.0;
		ShowMessage(StringOf(nPixels:1, ' pixels ', crStr, seconds:1:2, ' seconds', crStr, rate:1:0, ' pixels/second', crStr, str));
	end;
	

	procedure ShowFrameRate (str1: str255; StartTicks, nFrames: LongInt);
		var
			seconds: extended;
			str2: str255;
	begin
		seconds := (TickCount - StartTicks) / 60.0;
		if seconds = 0.0 then
			seconds := 0.167;
		RealToString(nFrames / seconds, 1, 2, str2);
		ShowMessage(concat(str1, str2, ' frames/second'));
	end;


	procedure ConvertHistoToText;
		var
			i: integer;
			ValuesInverted: boolean;
	begin
		ValuesInverted := InvertingCalibrationFunction;
		TextBufSize := 0;
		for i := 0 to 255 do begin
				if ValuesInverted then
					PutLong(Histogram[255 - i], 1)
				else
					PutLong(Histogram[i], 1);
				if i <> 255 then
					PutChar(cr);
			end;
	end;


	procedure ConvertPlotToText;
		var
			i: integer;
	begin
		TextBufSize := 0;
		for i := 0 to PlotCount - 1 do begin
				PutReal(PlotData^[i], 1, precision);
				if i <> PlotCount then
					PutChar(cr);
			end;
	end;


	procedure ConvertCalibrationCurveToText;
		var
			i: integer;
	begin
		TextBufSize := 0;
		for i := 0 to 255 do begin
				PutReal(cvalue[i], 1, 3);
				if i <> 255 then
					PutChar(cr);
			end;
	end;


	procedure SetupUndoInfoRec;
{Initialize the Undo buffer's Info record so we can copy}
{the current image to the Undo buffer and operate on it.}
	begin
		with UndoInfo^ do begin
				PixelsPerLine := info^.PixelsPerLine;
				BytesPerRow := info^.BytesPerRow;
				nLines := Info^.nLines;
				ImageSize := Info^.ImageSize;
				PixMapSize := info^.PixMapSize;
				RoiRect := info^.RoiRect;
				CopyRgn(Info^.roiRgn, roiRgn);
				roiType := Info^.roiType;
				PicRect := Info^.PicRect;
				with osPort^ do begin
						with portPixMap^^ do begin
								RowBytes := BitOr(BytesPerRow, $8000);
								bounds := PicRect;
							end;
						PortRect := PicRect;
						RectRgn(visRgn, PicRect);
					end;
			end;
	end;


{$POP}


	procedure ActivateWindow;
		var
			tPort: GrafPtr;
			SaveGDevice: GDHandle;
	begin
		with info^ do begin
				IsInsertionPoint := false;
				WhatToUndo := NothingToUndo;
				UndoFromClip := false;
				DrawLabels('', '', '');
				MouseState := NotInRoi;
				RoiUpdateTime := 0;
				if osPort <> nil then begin
						SaveGDevice := GetGDevice;
						SetGDevice(osGDevice);
						GetPort(tPort);
						SetPort(GrafPtr(osPort));
						pmForeColor(ForegroundIndex);
						pmBackColor(BackgroundIndex);
						SetPort(tPort);
						SetGDevice(SaveGDevice);
					end;
				ShowRoi;
			end;
	end;


	procedure UpdateResultsWindow;
	begin
		SetPort(ResultsWindow);
		DrawControls(ResultsWindow);
		DrawGrowIcon(ResultsWindow);
		UpdateList;
		if ResultsWindow = FrontWindow then begin
				ShowControl(hScrollBar);
				ShowControl(vScrollBar);
			end
		else begin
				HideControl(hScrollBar);
				HideControl(vScrollBar);
			end;
	end;


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


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


	procedure ScrAction (theCtl: ControlHandle; partCode: integer);
		var
			bInc, pInc, delta: integer;
	begin
		if theCtl = vScrollBar then begin
				bInc := 1;
				pInc := vListPageSize
			end
		else begin
				bInc := 4;
				pInc := hListPageSize
			end;
		case partCode of
			kControlUpButtonPart: 
				delta := -bInc;
			kControlDownButtonPart: 
				delta := bInc;
			kControlPageUpPart: 
				delta := -pInc;
			kControlPageDownPart: 
				delta := pInc;
			otherwise
				exit(ScrAction);
		end;
		SetControlValue(theCtl, GetControlValue(theCtl) + delta);
		ScrollResultsText;
	end;


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


	procedure DoMouseDownInResults (loc: point);
		var
			theCtl: ControlHandle;
			cValue: integer;
	begin
		SelectWindow(ResultsWindow);
		SetPort(ResultsWindow);
		GlobalToLocal(loc);
		case FindControl(loc, ResultsWindow, theCtl) of
			kControlUpButtonPart, kControlDownButtonPart, kControlPageUpPart, kControlPageDownPart: 
				if TrackControl(theCtl, loc, ResultsScrollActionProc) <> 0 then
					;
			kControlIndicatorPart: 
				if TrackControl(theCtl, loc, nil) <> 0 then
					ScrollResultsText;
			otherwise
		end;
	end;


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


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


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


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


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


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


	procedure GetSmoothedLength (var ulength, clength: extended; FindPerimeter: boolean);
  {Finds the length of freehand line selections or perimeter of}
  {freehand area selections using a 3-point moving average.}
		var
			i, n: integer;
			x1, y1, x2, y2, dx, dy: extended;

		procedure AddDelta;
		begin
			with info^ do begin
					dx := x2 - x1;
					dy := y2 - y1;
					uLength := uLength + sqrt(dx * dx + dy * dy);
					if SpatiallyCalibrated then begin
							dx := dx / xScale;
							dy := dy / yScale;
							cLength := cLength + sqrt(dx * dx + dy * dy);
						end;
				end;
		end;

	begin
		with info^ do begin
				uLength := 0.0;
				cLength := 0.0;
				n := nCoordinates;
				if not CoordinatesAvailable then
					exit(GetSmoothedLength);
				if FindPerimeter then begin
						x1 := (xCoordinates^[n] + xCoordinates^[1] + xCoordinates^[2]) / 3.0; {1}
						y1 := (yCoordinates^[n] + yCoordinates^[1] + yCoordinates^[2]) / 3.0;
					end
				else begin
						x1 := (xCoordinates^[1] * 2.0 + xCoordinates^[2]) / 3.0; {1}
						y1 := (yCoordinates^[1] * 2.0 + yCoordinates^[2]) / 3.0;
					end;
				x2 := (xCoordinates^[1] + xCoordinates^[2] + xCoordinates^[3]) / 3.0; {2}
				y2 := (yCoordinates^[1] + yCoordinates^[2] + yCoordinates^[3]) / 3.0;
				AddDelta;
				for i := 2 to n - 2 do begin
						x1 := x2; {i}
						y1 := y2;
						x2 := (xCoordinates^[i] + xCoordinates^[i + 1] + xCoordinates^[i + 2]) / 3.0; {i+1}
						y2 := (yCoordinates^[i] + yCoordinates^[i + 1] + yCoordinates^[i + 2]) / 3.0;
						AddDelta;
					end;
				x1 := x2; {n-1}
				y1 := y2;
				if FindPerimeter then begin
						x2 := (xCoordinates^[n - 1] + xCoordinates^[n] + xCoordinates^[1]) / 3.0; {n}
						y2 := (yCoordinates^[n - 1] + yCoordinates^[n] + yCoordinates^[1]) / 3.0;
						AddDelta;
						x1 := x2; {n}
						y1 := y2;
						x1 := (xCoordinates^[n] + xCoordinates^[1] + xCoordinates^[2]) / 3.0; {1}
						y1 := (yCoordinates^[n] + yCoordinates^[1] + yCoordinates^[2]) / 3.0;
						AddDelta;
					end
				else begin
						x2 := (xCoordinates^[n - 1] + xCoordinates^[n] * 2.0) / 3.0; {n}
						y2 := (yCoordinates^[n - 1] + yCoordinates^[n] * 2.0) / 3.0;
						AddDelta;
					end;
				if not SpatiallyCalibrated then
					cLength := uLength;
			end; {with}
	end;


	procedure GetPerimeter (var uPerimeter, cPerimeter: extended);
  {Finds the perimeter of traced objects.}
	var
	  SideLength1, SideLength2: integer;
	  dx1, dx2, dy1, dy2, i: integer;
	  sumdx, sumdy, nCorners, nexti: integer;
	  corner: boolean;
	begin
		sumdx := 0;
		sumdy := 0;
		nCorners := 0;
		dx1 := xCoordinates^[1] - xCoordinates^[nCoordinates];
		dy1 := yCoordinates^[1] - yCoordinates^[nCoordinates];
		SideLength1 := abs(dx1) + abs(dy1);
		corner := false;
		for i := 1 to nCoordinates do begin
		nexti := i +1;
		if nexti > nCoordinates then
		  nexti := 1;
		dx2 := xCoordinates^[nexti] - xCoordinates^[i];
		dy2 := yCoordinates^[nexti] - yCoordinates^[i];
		sumdx := sumdx + abs(dx1);
		sumdy := sumdy + abs(dy1);
		SideLength2 := abs(dx2) + abs(dy2);
		if (SideLength1 > 1) or (not corner) then begin
		  corner := true;
		  nCorners := nCorners + 1;
		end else
		  corner := false;
		dx1 := dx2;
		dy1 := dy2;
		SideLength1 := SideLength2;
		end;
		uPerimeter := sumdx + sumdy - nCorners * (2.0 - sqrt(2.0));
		{ShowMessage(StringOf(sumdx, '  ', sumdy,' ', nCorners)); wait(120); beep;}		
		with info^ do
			if SpatiallyCalibrated then
				cPerimeter := sumdx/xscale + sumdy/yscale - (nCorners * ((1.0/xscale + 1.0/yscale) - sqrt(sqr(1.0/xscale) + sqr(1.0/yscale))))
			else
				cPerimeter := uPerimeter;
	end;


	procedure GetLength (var ulength, clength: extended; FindPerimeter: boolean);
  {Finds the length of segmented line selections or the perimeter of polygon selections.}
		var
			i: integer;
			xtemp, ytemp: LongInt;
			xt, yt: extended;
	begin
		with info^ do begin
				uLength := 0.0;
				cLength := 0.0;
				if not CoordinatesAvailable then
					exit(GetLength);
				for i := 2 to nCoordinates do begin
						xtemp := xCoordinates^[i] - xCoordinates^[i - 1];
						ytemp := yCoordinates^[i] - yCoordinates^[i - 1];
						uLength := uLength + sqrt(xtemp * xtemp + ytemp * ytemp);
						if SpatiallyCalibrated then begin
								xt := xtemp / xScale;
								yt := ytemp / yScale;
								cLength := cLength + sqrt(xt * xt + yt * yt);
							end;
					end;
				if FindPerimeter then begin
						xtemp := xCoordinates^[1] - xCoordinates^[nCoordinates];
						ytemp := yCoordinates^[1] - yCoordinates^[nCoordinates];
						uLength := uLength + sqrt(xtemp * xtemp + ytemp * ytemp);
						if SpatiallyCalibrated then begin
								xt := xtemp / xScale;
								yt := ytemp / yScale;
								cLength := cLength + sqrt(xt * xt + yt * yt);
							end;
					end;
				if not SpatiallyCalibrated then
					cLength := uLength;
			end; {with}
	end;


	procedure GetStraightLineLength (var ulength, clength: extended);
		var
			dx, dy: extended;
	begin
		with info^ do begin
				dx := LX2 - LX1;
				dy := LY2 - LY1;
				uLength := sqrt(sqr(dx) + sqr(dy));
				if SpatiallyCalibrated then
					cLength := sqrt(sqr(dx / xScale) + sqr(dy / yScale))
				else
					cLength := uLength;
			end;
	end;


	procedure GetLengthOrPerimeter (var ulength, clength: extended);
	var
		t1,t2:extended;
	begin
		t1:=ulength; t2:=clength;
		case info^.RoiType of
			LineRoi: 
				GetStraightLineLength(ulength, clength);
			PolygonRoi:begin 
				GetLength(t1, t2{ulength, clength}, true);  {ppc-bug}
				ulength:=t1;
				clength:=t2;
				end;
			FreehandRoi:begin 
				GetSmoothedLength(t1,t2{ulength, clength}, true);
				ulength:=t1;
				clength:=t2;
				end;
			FreeLineRoi:begin 
				GetSmoothedLength(t1,t2{ulength, clength}, false);
				ulength:=t1;
				clength:=t2;
				end;
			SegLineRoi:begin 
				GetLength(t1, t2{ulength, clength}, false);
				ulength:=t1;
				clength:=t2;
				end;
			TracedRoi:begin 
				GetPerimeter(t1,t2{ulength, clength});
				ulength:=t1;
				clength:=t2;
				end;
			otherwise begin
					ulength := 0.0;
					clength := 0.0;
				end;
		end;
	end;


	procedure MakeCoordinatesRelative;
		var
			i: integer;
	begin
		with info^, info^.RoiRect do begin
				for i := 1 to nCoordinates do begin
						xCoordinates^[i] := xCoordinates^[i] - left;
						yCoordinates^[i] := yCoordinates^[i] - top;
					end;
				CoordinatesWidth := right - left;
				CoordinatesHeight := bottom - top;
				CoordinatesRoiType := RoiType;
			end;
	end;


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


	procedure ConvertCoordinates;
  {Convert from screen to offscreen coordinates}
		var
			i: integer;
	begin
		with info^, info^.SrcRect do begin
				if (magnification <> 1.0) or (left <> 0) or (top <> 0) then begin
						if MakingLOI then
							for i := 1 to nCoordinates do begin
									xCoordinates^[i] := left + trunc(xCoordinates^[i] / magnification);
									yCoordinates^[i] := top + trunc(yCoordinates^[i] / magnification);
								end
						else
							for i := 1 to nCoordinates do begin
									xCoordinates^[i] := left + round(xCoordinates^[i] / magnification);
									yCoordinates^[i] := top + round(yCoordinates^[i] / magnification);
								end;
					end;
			end {with}
	end;


	procedure DrawTriangle (left, top: integer);
		var
			triangle: PolyHandle;
	begin
		triangle := OpenPoly;
		if triangle = nil then
			exit(DrawTriangle);
		MoveTo(left, top);
		LineTo(left + 12, top);
		LineTo(left + 6, top + 7);
		LineTo(left, top);
		ClosePoly;
		PaintPoly(triangle);
		KillPoly(triangle);
	end;


	procedure DrawDropBox (r: rect);
  {Draws the  drop shadow box used for pop-up menus}
	begin
		with r do begin
				EraseRect(r);
				FrameRect(r);
				MoveTo(left + 2, bottom);
				LineTo(right, bottom);
				MoveTo(right, top + 2);
				LineTo(right, bottom);
				DrawTriangle(right - 15, top + 6);
			end;
	end;


	function PopUpMenu (theMenu: MenuHandle; left, top, PopUpItem: integer): integer;
  {Pops up the specified menu and returns item selected by user.}
		var
			PopupResult: LongInt;
			MenuLoc: point;
	begin
		with MenuLoc do begin
				h := left;
				v := top;
				LocalToGlobal(MenuLoc);
				PopUpResult := PopupMenuSelect(theMenu, v, h, PopUpItem);
				PopUpMenu := LoWrd(PopUpResult);
			end;
	end;


	procedure GetDItemRect (d: DialogPtr; item: integer; var r: rect);
		var
			iType: integer;
			ignore: handle;
	begin
		GetDialogItem(d, item, itype, ignore, r)
	end;


	procedure DrawPopUpText (str: str255; r: rect);
		var
			TextRect: rect;
	begin
		with r do begin
				TextFont(SystemFont);
				if (str = '+') or (str = 'Ð') or (str = 'Ö') then begin
						TextSize(24);
						MoveTo(left + 13, bottom - 2);
					end
				else begin
						TextSize(12);
						MoveTo(left + 13, bottom - 5);
					end;
				if length(str) = 1 then
					DrawString(str)
				else begin
						SetRect(TextRect, left + 13, top + 1, right - 15, bottom - 1);
						TETextBox(pointer(ord(@str) + 1), length(str), TextRect, TEJustLeft);
					end;
			end;
		TextSize(12);
	end;

	procedure SetUProc (d: DialogPtr; item: integer; pptr: handle);
		var
			itype: integer;
			r: rect;
			h: handle;
	begin
		GetDialogItem(d, item, itype, h, r);
		SetDialogItem(d, item, itype, pptr, r);
	end;
	
	

	procedure RemoveDensityCalibration;
	var
		i:integer;
	begin
		for i := 0 to 255 do
			cvalue[i] := i;
		info^.fit:=uncalibrated;
		NoInfo^.fit:=uncalibrated;
		InvertPixelValues:=false;
		DrawLabels('', '', '');
		UpdateTitleBar;
	end;
	
	
	function isInvertingFunction:boolean;
	begin
		with info^ do
			isInvertingFunction:=(fit=StraightLine) and (nCoefficients=2)
				and (Coefficient[1]=255.0) and (Coefficient[2]=-1.0)
	end;
	
	
	function CheckCalibration: boolean;
	var
		result: integer;
	begin
		with info^ do begin
			CheckCalibration := true;
			if (fit <> uncalibrated) and (not isInvertingFunction) then begin
				result := PutMessageWithCancel('This operation will result in loss of density calibration.');
				if result = cancel then begin
					CheckCalibration := false;
					AbortMacro
				end else
					RemoveDensityCalibration;
			end;
		end; {with}
	end;


	procedure PlotTooLongMsg;
	begin
		PutError(StringOf('Profile plots are limited to ', MaxLine:1, ' pixels.'));
	end;


end.