unit Graphics;

{Graphics routines used by Image program}

interface

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

	procedure DoProfilePlot (event: EventRecord; start, finish: point);
	procedure DrawPlot;
	procedure UpdatePlotWindow;
	procedure ShowResults;
	procedure SetupPlot (var data: LineType; start: point);
	procedure MakePlotWindow (PlotLeft, PlotTop, PlotWidth, PlotHeight: integer);
	procedure DrawObject (obj: ObjectType; p1, p2: point);
	procedure DrawLUT;
	procedure DrawTools;
	function InvertingCalibrationFunction: boolean;
	procedure DrawHistogram;
	procedure DrawGrayMap;
	procedure ResetGrayMap;
	procedure EnableThresholding (level: integer);
	procedure DoMouseDownInGrayMap;
	procedure ShowNextWindow;
	procedure StackWindows;
	procedure TileWindows;
	procedure DrawLabels (xL, yL, zL: str255);
	function Duplicate (name: str255; SavingBlankField: boolean): boolean;
	procedure InvertPic;
	procedure ShowMessage (str: str255);
	procedure ShowTime (StartTicks: LongInt; r: rect);
	procedure ShowFrameRate (str1: str255; StartTicks, nFrames: LongInt);
	function long2str (num: LongInt): str255;
	procedure ConvertHistoToText;
	procedure ConvertPlotToText;
	procedure ConvertCalibrationCurveToText;
	procedure SetupUndoInfoRec;
	procedure ShowProgress (current, total: LongInt);
	procedure DrawScale;
	procedure UpdateGrayMap;
	procedure ScaleAndRotate;
	procedure ActivateWindow;
	procedure UpdateMeasurementsWindow;
	procedure ScrollText;
	procedure UpdateScrollBars;
	procedure InitTextEdit (font, size: integer);
	procedure DoMouseDownInMeasurements (loc: point);
	procedure AppendResults;
	procedure DeleteLines (first, last: integer);
	procedure UpdateList;



implementation


	procedure DrawNum (x, y: integer; value: LongInt);
		var
			str: str255;
	begin
		MoveTo(x, y);
		if value < 10 then
			DrawString('0');
		if value < 100 then
			DrawString('0');
		NumToString(value, str);
		DrawString(str);
	end;


	procedure LabelProfilePlot;
		var
			str: str255;
			min, max: extended;
	begin
		if InvertPlots then begin
				min := PlotMax;
				max := PlotMin
			end
		else begin
				min := PlotMin;
				max := PlotMax
			end;
		if info^.Calibrated then begin
				MoveTo(1, PlotHeight - PlotBottomMargin);
				if abs(min) >= 1000.0 then
					DrawReal(min, 1, 0)
				else
					DrawReal(min, 1, 2);
				MoveTo(1, PlotTopMargin + 8);
				if abs(max) >= 1000.0 then
					DrawReal(max, 1, 0)
				else
					DrawReal(max, 1, 2);
			end
		else begin
				DrawNum(2, PlotHeight - PlotBottomMargin, trunc(Min));
				DrawNum(2, PlotTopMargin + 8, trunc(Max));
			end;
		MoveTo(PlotLeftMargin + 15, PlotHeight - PlotBottomMargin + 12);
		DrawString('N=');
		NumToString(PlotCount, str);
		DrawString(str);
		DrawString('     Mean=');
		RealToString(PlotMean, 3, 2, str);
		DrawString(str);
		if PlotAvg > 1 then begin
				DrawString('    Width=');
				NumToString(PlotAvg, str);
				DrawString(str);
			end;
		DrawString('    ');
		if info^.Calibrated then begin
				DrawString('Calibrated(');
				DrawString(info^.UnitOfMeasure);
				DrawString(')');
			end
		else
			DrawString('Uncalibrated');
	end;


	procedure LabelCalibrationPlot;
		var
			pbottom, hloc, vloc, i: integer;
			letter: packed array[1..6] of char;
	begin
		pbottom := PlotHeight - PLotBottomMargin;
		MoveTo(2, PlotTopMargin + 4);
		DrawReal(MaxValue, 4, 2);
		MoveTo(2, pbottom);
		DrawReal(MinValue, 4, 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)');
		end;
		hloc := PlotWidth - PlotRightMargin + 5;
		vloc := PlotTopMargin + 25;
		letter := 'abcdef';
		MoveTo(hloc, vloc);
		with info^ do
			for i := 1 to nCoefficients do begin
					MoveTo(hloc, vloc);
					TextSize(12);
					DrawString(letter[i]);
					DrawString('=');
					TextSize(9);
					DrawReal(Coefficient[i], 1, 8);
					vloc := vloc + 15;
				end;
		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;


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


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


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


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


	procedure SetupPlot; {(var data: LineType; start: point)}
		var
			fRect, trect: rect;
			tPort: GrafPtr;
			i, width, y, fmax, scale, WindowWidth: integer;
			SaveClipRegion: RgnHandle;
			pt: point;
			temp, sum, vscale: extended;
			AutoScale: boolean;
			RealData: array[0..MaxPixelsPerLine] of extended;
			index: UnsignedByte;
	begin
		if info^.calibrated then
			PlotLeftMargin := 35
		else
			PlotLeftMargin := 25;
		PlotTopMargin := 10;
		PlotBottomMargin := 20;
		PlotRightMargin := 10;
		for i := 0 to PlotCount - 1 do
			RealData[i] := cvalue[data[i]];
		if InvertPlots then
			for i := 0 to PlotCount - 1 do
				RealData[i] := MaxValue - RealData[i];
		if FixedSizePlot then begin
				width := ProfilePlotWidth;
				PlotWidth := width;
				PlotHeight := ProfilePlotHeight
			end
		else begin
				Width := PlotCount * trunc(Info^.magnification + 0.5);
				if Width < 50 then
					Width := 100;
				GetWindowRect(info^.wptr, trect);
				with trect do
					WindowWidth := right - left;
				if width > WindowWidth then
					width := WindowWidth;
				PlotHeight := Width div 2;
				if PlotWidth > 300 then
					PlotHeight := width div 3;
				if PlotWidth > 400 then
					PlotHeight := width div 4;
			end;
		PlotWidth := Width + PlotLeftMargin + PlotRightMargin;
		PlotHeight := PlotHeight + PlotTopMargin + PlotBottomMargin;
		pt.h := start.h;
		pt.v := start.v + 40;
		LocalToGlobal(pt);
		PlotLeft := pt.h - PlotLeftMargin;
		PlotTop := pt.v;
		if PlotTop > (ScreenHeight - PlotHeight) then
			PlotTop := PlotTop - PlotHeight - 60;
		if PlotTop < 60 then
			PlotTop := 60;
		MakePlotWindow(PlotLeft, PlotTop, PlotWidth, PlotHeight);
		WindowPeek(PlotWindow)^.WindowKind := ProfilePlotKind;
		PlotMin := MaxValue;
		PlotMax := MinValue;
		sum := 0.0;
		for i := 0 to PlotCount - 1 do begin
				temp := RealData[i];
				sum := sum + temp;
				if AutoscalePlots then begin
						if temp < PlotMin then
							PlotMin := temp;
						if temp > PlotMax then
							PlotMax := temp;
					end;
			end;
		if PlotCount > 0 then
			PlotMean := sum / PlotCount
		else
			PlotMean := 0.0;
		if not AutoscalePlots then begin
				PlotMin := ProfilePlotMin;
				PlotMax := ProfilePlotMax;
			end;
		fmax := PlotCount - 1;
		if (PlotMax - PlotMin) <> 0 then
			vscale := fmax / (PlotMax - PlotMin)
		else
			vscale := 1.0;
		scale := round(1024.0 / PlotCount);  {This scaling needed to get around a 32-bit QD problem}
		if scale < 1 then
			scale := 1;
		fmax := fmax * scale;
		vscale := vscale * scale;
		SetRect(fRect, 0, 0, fmax, fmax);
		GetPort(tPort);
		SetPort(PlotWindow);
		SaveClipRegion := PlotWindow^.ClipRgn;
		RectRgn(PlotWindow^.ClipRgn, fRect);
		PlotPICT := OpenPicture(fRect);
		PenNormal;
		if LinePlot then begin
				MoveTo(0, round(vscale * (PlotMax - RealData[0])));
				for i := 1 to PlotCount - 1 do
					LineTo(i * scale, round(vscale * (PlotMax - RealData[i])))
			end
		else
			for i := 1 to PlotCount - 1 do begin
					y := round(vscale * (PlotMax - RealData[i]));
					MoveTo(i * scale, y);
					LineTo(i * scale, y)
				end;
		ClosePicture;
		PlotWindow^.ClipRgn := SaveClipRegion;
		InvalRect(PlotWindow^.PortRect);
		SetPort(tPort);
		SelectWindow(PlotWindow);
	end;


	procedure GetDiagLine (start, finish: Point; var count: integer; var data: LineType; OptionKey: boolean);
		var
			sum: LongInt;
			p: ptr;
			deltax, deltay, xinc, yinc, accumulator, i: integer;
			xloc, yloc, j: integer;
			average: boolean;
			buf: LineType;
			fline: LineType;
	begin
		average := LineWidth > 1;
		if OptionKey and average then
			for i := 0 to MaxPixelsPerLine 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 then
					deltax := deltax + LineWidth;
				accumulator := deltax div 2;
				i := deltax;
				repeat
					if count < MaxPixelsPerLine 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 then
					deltay := deltay + LineWidth;
				accumulator := deltay div 2;
				i := deltay;
				repeat
					if count < MaxPixelsPerLine then
						count := count + 1;
					accumulator := accumulator + deltax;
					if accumulator >= deltay then begin
							accumulator := accumulator - deltay;
							xloc := xloc + xinc
						end;
					yloc := yloc + yinc;
					if average then begin
							GetLine(xloc, yloc, LineWidth, buf);
							if OptionKey then
								PutLine(xloc, yloc, LineWidth, fline);
							sum := 0;
							for j := 0 to LineWidth - 1 do
								sum := sum + buf[j];
							data[count - 1] := round(sum / LineWidth);
						end
					else begin
							data[count - 1] := MyGetPixel(xloc, yloc);
							if OptionKey then
								PutPixel(xloc, yloc, ForegroundIndex);
						end;
					i := i - 1;
				until i = 0
			end;
	end;


	procedure DoProfilePlot;{ (event: EventRecord; start, finish: point)}
		var
			i, range, width, value: integer;
			p1, p2, pt: point;
			OptionKey: boolean;
	begin
		with Info^.wrect do begin
				if finish.h >= right then
					finish.h := right - 1;
				if finish.v >= bottom then
					finish.v := bottom - 1;
			end;
		if finish.h < start.h then begin {Swap ends}
				pt := start;
				start := finish;
				finish := pt;
			end;
		p1 := start;
		p2 := finish;
		ScreenToOffscreen(p1);
		ScreenToOffscreen(p2);
		OptionKey := OptionKeyDown;
		GetDiagLine(p1, p2, PlotCount, PlotData, OptionKey);
		PlotAvg := LineWidth;
		SetupPlot(PlotData, start);
		if OptionKey then begin
				UpdatePicWindow;
				info^.changes := true;
			end;
	end;


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

		procedure SmoothHistogram;
			var
				i: integer;
		begin
			h2 := h;
			for i := MinLevel to MaxLevel do
				h[i] := (h2[i - 1] + h2[i] + h2[i + 1]) div 3;
		end;

	begin
		with results do begin
				MinLevel := MinIndex;
				if MinLevel < 1 then
					MinLevel := 1;
				MaxLevel := imean;
				if MaxLevel > 254 then
					MaxLevel := 254;
				h := histogram;
				for i := 0 to 255 do
					h[i] := h[i] * 10;
				for i := 1 to 15 do
					SmoothHistogram;
{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 ShowResults;
		var
			vloc, hloc: integer;
			tPort: GrafPtr;
			trect: rect;
			clength, cx, cy, IntDen, BackgroundLevel: extended;

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

	begin
		GetPort(tPort);
		vloc := 35;
		hloc := 4;
		SetPort(ResultsWindow);
		TextFont(ApplFont);
		TextSize(9);
		Setrect(trect, 0, vloc, rwidth, rheight);
		EraseRect(trect);
		if ResultsMessage <> '' then begin
				Setrect(trect, hloc, vloc + 15, rwidth - 10, rheight);
				TextBox(pointer(ord(@ResultsMessage) + 1), length(ResultsMEssage), trect, teJustLeft)
			end
		else
			with results do begin
					NewLine;
					with info^ do begin
							if ShowCount then begin
									DrawBString('Count: ');
									DrawLong(mCount);
									NewLine;
								end;
							DrawBString('N: ');
							DrawLong(PixelCount^[mCount]);
							if SpatialScale <> 0.0 then begin
									NewLine;
									DrawBString('Area: ');
									DrawReal(mArea^[mCount], 1, precision);
									DrawString(' square ');
									DrawString(units);
								end;
							NewLine;
							DrawBString('Mean: ');
							DrawReal(mean^[mCount], 1, precision);
							if calibrated then begin
									DrawString(' ');
									DrawBString(UnitOfMeasure);
									DrawString('   (');
									DrawLong(results.imean);
									DrawString(')');
								end;
							if PixelCount^[mCount] > 1 then begin
									NewLine;
									DrawBString('Std Dev: ');
									DrawReal(sd^[mCount], 1, precision);
									NewLine;
									DrawBString('Min: ');
									DrawReal(mMin^[mCount], 1, precision);
									NewLine;
									DrawBString('Max: ');
									DrawReal(mMax^[mCount], 1, precision);
								end;
							if (xyLocM in measurements) or (nPoints > 0) then begin
									NewLine;
									DrawBString('X: ');
									DrawReal(xcenter^[mCount], 6, precision);
									NewLine;
									DrawBString('Y: ');
									DrawReal(ycenter^[mCount], 6, precision);
								end;
							if ModeM in Measurements then begin
									NewLine;
									DrawBString('Mode: ');
									DrawReal(mode^[mCount], 1, precision);
								end;
							if (LengthM in measurements) or (nLengths > 0) then begin
									NewLine;
									DrawBString('Length: ');
									DrawReal(plength^[mCount], 1, precision);
								end;
							if MajorAxisM in Measurements then begin
									NewLine;
									DrawBString(Concat(MajorLabel, ': '));
									DrawReal(MajorAxis^[mCount], 1, precision);
								end;
							if MinorAxisM in Measurements then begin
									NewLine;
									DrawBString(Concat(MinorLabel, ': '));
									DrawReal(MinorAxis^[mCount], 1, precision);
								end;
							if (AngleM in measurements) or (nAngles > 0) then begin
									NewLine;
									DrawBString('Angle: ');
									DrawReal(orientation^[mCount], 1, precision);
								end;
							if IntDenM in measurements then begin
									NewLine;
									FindIntegratedDensity(IntDen, BackgroundLevel);
									DrawBString('Integrated Density: ');
									DrawReal(IntDen, 1, precision);
									NewLine;
									DrawBString('Background Level: ');
									DrawReal(BackGroundLevel, 1, precision);
								end
							else begin
									IntDen := 0.0;
									BackGroundLevel := 0.0;
								end;
							IntegratedDensity^[mCount] := IntDen;
							idBackground^[mCount] := BackGroundLevel;
						end;
				end; {with}
		SetPort(tPort);
		mCount2 := mCount;
	end;


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


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


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


	procedure DrawLUT;
		var
			tPort: GrafPtr;
			h, v, i: integer;
	begin
		GetPort(tPort);
		SetPort(LUTWindow);
		with LutWindow^ do begin
				for v := 0 to 255 do begin
						pmForeColor(v);
						MoveTo(0, v);
						LineTo(cwidth, v)
					end;
				for i := 1 to nExtraColors + 2 do begin
						pmForeColor(ExtraColorsEntry[i]);
						PaintRect(ExtraColorsRect[i]);
					end;
				TextFont(ApplFont);
				TextSize(9);
				with ExtraColorsRect[1] do
					MoveTo(left + 3, bottom - 1);
				pmForeColor(BlackIndex);
				DrawString('white');
				with ExtraColorsRect[2] do
					MoveTo(left + 4, bottom - 1);
				InvertRect(ExtraColorsRect[2]);
				DrawString('black');
				InvertRect(ExtraColorsRect[2]);
			end;
		SetPort(tPort);
	end;


	procedure DrawTools;
		var
			tPort: GrafPtr;
			v, n, i: integer;
			str: str255;
			tool: ToolType;
	begin
		GetPort(tPort);
		SetPort(ToolWindow);
		TextFont(ToolFont);
		TextSize(12);
		EraseRect(CGrafPort(ToolWindow^).PortPixMap^^.bounds);
		for tool := FirstTool to LastTool do
			with ToolRect[tool] do begin
					MoveTo(left + ho, top + vo);
					DrawChar(ToolChar[tool]);
				end;
		InvertRect(ToolRect[CurrentTool]);
		pmForeColor(ForegroundIndex);
		with ToolRect[brush] do
			MoveTo(left + ho, top + vo);
		DrawChar(chr(80));
		pmForeColor(BackgroundIndex);
		with ToolRect[Eraser] do
			MoveTo(left + ho, top + vo);
		DrawChar(chr(102));
		pmForeColor(BlackIndex);
		for i := 1 to nLineTypes do
			PaintRect(lines[i]);
		MoveTo(0, Lines[LineIndex].top - 9);
		DrawChar(chr(CheckMarkChar));
		SetPort(tPort);
	end;


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


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


	procedure UpdateGrayMap;
		const
			gmRectArea = 4096.0; {64x64}
			max = 4177920;
		var
			tPort: GrafPtr;
			r: rect;
			x, y, i, h1, h2, h3, v1, v2, v3, dx, dy: integer;
			xcenter, ycenter, brightness, islope, thumb: integer;
			table: LookupTable;
			hrect: rect;
			slope: extended;
			area, value, sum: LongInt;
	begin
		GetPort(tPort);
		SetPort(GrayMapWindow);
		PenNormal;
		EraseRect(GrayMapRect2);
		FrameRect(GrayMapRect);
		with info^ do
			if LutMode = CustomGrayscale then begin
					GetLookupTable(table);
					for i := 0 to 63 do begin
							x := gmRectLeft + 63 - i;
							y := gmRectTop + table[i * 4] div 4;
							MoveTo(x, y);
							LineTo(x, y);
						end
				end
			else begin
					h1 := gmRectLeft + p1x div 4;
					v1 := gmRectBottom - 1 - (p1y div 4);
					h2 := gmRectLeft + p2x div 4;
					v2 := gmRectBottom - 1 - (p2y div 4);
					MoveTo(gmRectLeft, gmRectBottom - 1);
					LineTo(h1, v1);
					LineTo(h2, v2);
					LineTo(gmRectRight - 1, gmRectTop);
					SetRect(hrect, h1 - 1, v1 - 1, h1 + 2, v1 + 2);
					PaintRect(hrect); {First handle}
					SetRect(hrect, h2 - 1, v2 - 1, h2 + 2, v2 + 2);
					PaintRect(hrect); {Last handle}
					dx := p2x - p1x;
					dy := p2y - p1y;
					xcenter := p1x + dx div 2;
					ycenter := p1y + dy div 2;
					h3 := gmRectLeft + xcenter div 4;
					v3 := gmRectBottom - 1 - (ycenter div 4);
					SetRect(hrect, h3 - 1, v3 - 1, h3 + 2, v3 + 2);
					PaintRect(hrect); {Center handle}
					thumb := gmSlideHeight - 2;
					i := 0;
					sum := 0;
					repeat
						value := ctable[i].rgb.red;
						value := band(value, 65535);
						sum := sum + value;
						i := i + 4;
					until i > 255;
					brightness := trunc((sum / max) * (gmSlideWidth - thumb - 2.0));
					gmSlide1Loc := brightness;
					with gmSlide1 do
						SetRect(hrect, left + brightness + 1, top + 1, left + brightness + thumb + 1, top + thumb + 1);
					EraseRect(gmSlide1i);
					PaintRect(hrect);  {Thumb for brightness control}
					if dx <> 0 then
						slope := dy / dx
					else
						slope := 1000.0;
					if slope > 1.0 then begin
							if dy <> 0 then
								slope := 2.0 - dx / dy
							else
								slope := 2.0;
						end;
					islope := trunc(slope * 0.5 * (gmSlideWidth - thumb - 2.0));
					with gmSlide2 do
						SetRect(hrect, left + islope + 1, top + 1, left + islope + thumb + 1, top + thumb + 1);
					EraseRect(gmSlide2i);
					PaintRect(hrect);  {Thumb for contrast control}
				end;
		SetPort(tPort);
	end;


	procedure DrawGrayMap;
		var
			tPort: GrafPtr;
			x, y, i: integer;
			table: LookupTable;
	begin
		GetPort(tPort);
		SetPort(GrayMapWindow);
		PenNormal;
		TextFont(ApplFont);
		TextSize(9);
		with gmSlide1 do
			MoveTo(left - 6, bottom);
		DrawChar('B');
		with gmSlide2 do
			MoveTo(left - 6, bottom);
		DrawChar('C');
		FrameRect(gmSlide1);
		FrameRect(gmSlide2);
		FrameRect(gmIcon1);
		FrameRect(gmIcon2);
		with gmIcon1 do begin
				MoveTo(left, top + 10);
				LineTo(left + 5, top + 10);
				LineTo(left + 12, top + 3);
				LineTo(left + gmIconWidth - 1, top + 3);
			end;
		with gmIcon2 do begin
				MoveTo(left, top + 10);
				LineTo(left + gmIconWidth div 2, top + 10);
				LineTo(left + gmIconWidth div 2, top + 3);
				LineTo(left + gmIconWidth - 1, top + 3);
			end;
		UpdateGrayMap;
		GrayMapReady := true;
		SetPort(tPort);
	end;


	procedure ResetGrayMap;
	begin
		with info^ do begin
				DisableDensitySlice;
				p1x := 0;
				p1y := 0;
				p2x := 255;
				p2y := 255;
				DeltaX := 256;
				DeltaY := 256;
				SetGrayScaleLUT;
				LUTMode := Grayscale;
				if GrayMapReady then
					UpdateGrayMap;
				IdentityFunction := true;
				Thresholding := false;
			end;
	end;


	procedure FindEndPoints (x, y: integer);
		var
			xintercept: integer;
	begin
		with info^ do begin
				if DeltaX = 0 then begin
						p1x := x;
						p1y := 0;
						p2x := x;
						p2y := 255;
						exit(FindEndPoints);
					end;
				if DeltaY = 0 then begin
						p1x := 0;
						p1y := y;
						p2x := 255;
						p2y := y;
						exit(FindEndPoints);
					end;
				p1x := x - y * LongInt(DeltaX) div DeltaY;
				xIntercept := p1x;
				p1y := 0;
				if p1x < 0 then begin
						p1y := -(LongInt(DeltaY) * p1x) div DeltaX;
						p1x := 0;
					end;
				p2y := 255;
				p2x := 255 * LongInt(DeltaX) div DeltaY;
				if xIntercept < 0 then
					p2x := p2x + xIntercept
				else
					p2x := p2x + p1x;
				if p2x > 255 then begin
						p2y := 255 - (p2x - 255) * LongInt(DeltaY) div DeltaX;
						p2x := 255;
					end;
				if p2x < 0 then
					p2x := 0;
			end; {with}
	end;


	procedure ChangeBrightness;
		var
			loc, oldloc, max, HalfMax, thumb, xcenter, ycenter, delta: integer;
			hrect: rect;

		function FindLoc: integer;
			var
				p: point;
				loc: integer;
		begin
			GetMouse(p);
			loc := p.h - gmSlide1.left - 2;
			if loc < 0 then
				loc := 0;
			if loc > max + 5 then
				loc := max + 5;
			FindLoc := loc;
		end;

	begin
		with info^ do begin
				thumb := gmSlideHeight - 2;
				max := gmSlideWidth - thumb - 2;
				HalfMax := max div 2;
				OldLoc := FindLoc;
				repeat
					xcenter := p1x + (p2x - p1x) div 2;
					ycenter := p1y + (p2y - p1y) div 2;
					loc := FindLoc;
					delta := gmSlide1Loc + 1 - loc;
					if deltay <> 0 then begin
							xcenter := xcenter + delta;
							if xcenter < 0 then
								xcenter := 0;
							if xcenter > 255 then
								xcenter := 255;
						end;
					if deltax <> 0 then begin
							ycenter := ycenter - delta;
							if ycenter < 0 then
								ycenter := 0;
							if ycenter > 255 then
								ycenter := 255;
						end;
					FindEndPoints(xcenter, ycenter);
					UpdateGrayMap;
					gmFixedSlope := true;
					SetGrayScaleLUT;
					gmFixedSlope := false;
					OldLoc := loc;
				until not button;
				IdentityFunction := false;
			end; {with}
	end;


	procedure ChangeContrast;
		var
			p: point;
			loc, max, HalfMax, thumb, xcenter, ycenter: integer;
			hrect: rect;
			slope: extended;
	begin
		with info^ do begin
				thumb := gmSlideHeight - 2;
				max := gmSlideWidth - thumb - 2;
				HalfMax := max div 2;
				xcenter := p1x + deltax div 2;
				ycenter := p1y + deltay div 2;
				repeat
					GetMouse(p);
					loc := p.h - gmSlide2.left - 2;
					if loc < 0 then
						loc := 0;
					if loc > max then
						loc := max;
					if loc <= HalfMax then
						slope := loc / HalfMax
					else if loc < max then
						slope := HalfMax / (max - loc)
					else
						slope := 1000.0;
					if slope <= 1.0 then begin
							deltax := 255;
							deltay := round(slope * deltax);
						end
					else begin
							deltay := 255;
							deltax := round(deltay / slope);
						end;
					FindEndPoints(xcenter, ycenter);
					UpdateGrayMap;
					SetGrayScaleLUT;
				until not button;
				IdentityFunction := false;
			end; {with}
	end;


	procedure EnableThresholding (level: integer);
	begin
		with info^ do begin
				DeltaX := 1;
				DeltaY := 255;
				p1x := 255 - level;
				p1y := 0;
				p2x := 255 - level;
				p2y := 255;
				SetGrayScaleLUT;
				UpdateGrayMap;
				Thresholding := true;
				SelectLutTool;
			end;
	end;


	procedure ConvertMouseToXY (p: point; var x, y: integer);
	begin
		x := (p.h - gmRectLeft) * 4;
		if x < 0 then
			x := 0;
		if x > 255 then
			x := 255;
		y := (gmRectBottom - p.v) * 4;
		if y < 0 then
			y := 0;
		if y > 255 then
			y := 255;
	end;

	procedure DoMouseDownInGrayMap;
		var
			r: rect;
			tPort: GrafPtr;
			x, y, p1Dist, p2Dist, x1, y1: integer;
			mode: (StartPoint, EndPoint, Brightness);
			p: point;
			pressed: boolean;

		procedure DoFixup;
		begin
			with info^ do
				if ((p1x = 0) and (p2x = 0)) or ((p1x = 255) and (p2x = 255)) then begin
						p1y := 0;
						p2y := 255;
					end;
		end;

	begin
		DisableDensitySlice;
		if info^.LUTMode = CustomGrayscale then
			ResetGrayMap;
		GetPort(tPort);
		SetPort(GrayMapWindow);
		GetMouse(p);
		if PtInRect(p, gmIcon1) then begin
				InvertRect(gmIcon1);
				pressed := true;
				while Button and pressed do begin
						GetMouse(p);
						if not PtInRect(p, gmIcon1) then begin
								InvertRect(gmIcon1);
								pressed := false;
							end;
					end;
				repeat
				until not button;
				if pressed then begin
						InvertRect(gmIcon1);
						ResetGrayMap;
						SetPort(tPort);
						exit(DoMouseDownInGrayMap)
					end;
			end;
		if PtInRect(p, gmIcon2) then begin
				InvertRect(gmIcon2);
				pressed := true;
				while Button and pressed do begin
						GetMouse(p);
						if not PtInRect(p, gmIcon2) then begin
								InvertRect(gmIcon2);
								pressed := false;
							end;
					end;
				repeat
				until not button;
				if pressed then begin
						InvertRect(gmIcon2);
						EnableThresholding(128);
						SetPort(tPort);
						exit(DoMouseDownInGrayMap)
					end;
			end;
		if PtInRect(p, gmSlide1) then
			ChangeBrightness;
		if PtInRect(p, gmSlide2) then
			ChangeContrast;
		if p.v > (gmRectBottom + 4) then begin
				Thresholding := info^.deltax <= 1;
				SetPort(tPort);
				exit(DoMouseDownInGrayMap);
			end;
		GetMouse(p);
		ConvertMouseToXY(p, x, y);
		if (x <= 24) or (y <= 32) then
			mode := StartPoint
		else if (x >= 224) or (y >= 232) then
			mode := EndPoint
		else
			mode := brightness;
		if (mode = brightness) and thresholding then
			DrawLabels('Thresh:', '', '')
		else
			DrawLabels('X:', 'Y:', '');
		repeat
			with info^ do
				case mode of
					StartPoint: 
						begin
							if x > y then
								y := 0
							else
								x := 0;
							p1x := x;
							if p1x > p2x then
								p2x := p1x;
							p1y := y;
							if p1y > p2y then
								p2y := p1y;
							DoFixUp;
							Show2Values(p1x, p1y);
						end;
					EndPoint: 
						begin
							if x > y then
								x := 255
							else
								y := 255;
							p2x := x;
							if p2x < p1x then
								p1x := p2x;
							p2y := y;
							if p2y < p1y then
								p1y := p2y;
							DoFixUp;
							Show2Values(p2x, p2y);
						end;
					Brightness: 
						begin
							FindEndPoints(x, y);
							if thresholding then
								Show1Value(255 - p1x, NoValue);
						end;
				end; {case}
			UpdateGrayMap;
			gmFixedSlope := mode = brightness;
			SetGrayScaleLUT;
			gmFixedSlope := false;
			GetMouse(p);
			ConvertMouseToXY(p, x, y);
		until not Button;
		SetPort(tPort);
		IdentityFunction := false;
		Thresholding := info^.deltax <= 1;
	end;


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


	procedure StackWindows;
		var
			i, hloc, vloc, wwidth, wheight: integer;
			offset: boolean;
	begin
		hloc := PicLeftBase;
		vloc := PicTopBase;
		offset := not OptionKeyDown;
		for i := nPics downto 1 do begin
				Info := pointer(WindowPeek(PicWindow[i])^.RefCon);
				if Info^.PictureType <> ScionType then begin
						with Info^ do begin
								HideWindow(wptr);
								ScaleToFitWindow := false;
								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);
								ShowMagnification;
							end;
						if offset then begin
								hloc := hloc + hPicOffset;
								vloc := vloc + vPicOffset;
								if (vloc + 40) > ScreenHeight then
									vloc := PicTopBase;
							end;
					end;
			end;
		PicLeft := PicLeftBase;
		PicTop := PicTopBase;
		WhatToUndo := NothingToUndo;
	end;


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


	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 Results window.}
		var
			tPort: GrafPtr;
			trect: rect;
	begin
		if xL = XLabel then
			if yL = yLabel then
				if zL = zLabel then
					exit(DrawLabels);
		GetPort(tPort);
		SetPort(ResultsWindow);
		TextSize(9);
		TextFont(Monaco);
		TextFace([bold]);
		if length(xL) > 0 then begin
				xLabel := xL;
				xValueLoc := ValuesHStart + StringWidth(xLabel);
				yLabel := yL;
				yValueLoc := ValuesHStart + StringWidth(yLabel);
				zLabel := zL;
				zValueLoc := ValuesHStart + StringWidth(zLabel);
			end;
		Setrect(trect, 0, 0, rwidth, 32);
		EraseRect(trect);
		MoveTo(ValuesHStart, ValuesVStart);
		DrawString(xLabel);
		MoveTo(ValuesHStart, ValuesVStart + 10);
		DrawString(yLabel);
		MoveTo(ValuesHStart, ValuesVStart + 19);
		DrawString(zLabel);
		TextFace([]);
		SetPort(tPort);
	end;


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


	procedure InvertPic;
		var
			tPort: GrafPtr;
	begin
		GetPort(tPort);
		with Info^ do begin
				SetPort(GrafPtr(osPort));
				InvertRect(PicRect);
			end;
		SetPort(tPort);
	end;


	procedure ShowMessage (str: str255);
	begin
		ResultsMessage := str;
		ShowResults;
	end;


	procedure ShowTime (StartTicks: LongInt; r: rect);
		var
			nPixels: LongInt;
			str1, str2, str3: str255;
			seconds, rate: extended;
	begin
		with r do
			nPixels := LongInt(right - left) * (bottom - top);
		NumToString(nPixels, str1);
		seconds := (TickCount - StartTicks) / 60.0;
		RealToString(seconds, 1, 2, str2);
		if seconds <> 0.0 then
			rate := nPixels / seconds
		else
			rate := 0.0;
		NumToString(round(rate), str3);
		ShowMessage(concat(str1, ' pixels ', cr, str2, ' seconds', cr, str3, ' pixels/second'));
	end;

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


	function long2str (num: LongInt): str255;
		var
			str: str255;
	begin
		NumToString(num, str);
		long2str := str;
	end;


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


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


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


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


	procedure DrawScale;
		var
			hloc, vloc, width, height, SaveIndex, LUTStart, LUTWidth: integer;
			SavePort: GrafPtr;
	begin
		if NotRectangular then
			exit(DrawScale);
		ShowWatch;
		with info^.RoiRect, info^ do begin
				width := right - left;
				height := bottom - top;
				if (width = 0) or (height = 0) then
					exit(DrawScale);
				GetPort(SavePort);
				SetPort(GrafPtr(osPort));
				PenNormal;
				WhatToUndo := UndoEdit;
				SetupUndoFromClip;
				SetupUndo;
				SaveIndex := ForegroundIndex;
				if LUTMode = PseudoColor32 then begin
						LUTWidth := nColors * ColorWidth;
						LUTStart := (255 - ColorStart) - LUTWidth;
					end
				else begin
						LUTStart := 1;
						LUTWidth := 254;
					end;
				if width >= height then
					for hloc := left to right - 1 do begin
							SetForegroundColor(round(((hloc - left) / width) * LUTWidth) + LUTStart);
							MoveTo(hloc, top);
							LineTo(hloc, Bottom - 1);
						end
				else
					for vloc := top to bottom - 1 do begin
							SetForegroundColor(round(((vloc - top) / height) * LUTWidth) + LUTStart);
							MoveTo(left, vloc);
							LineTo(right - 1, vloc);
						end;
				ForegroundIndex := SaveIndex;
				SetPort(SavePort);
				changes := true;
			end;
		SetupRoiRect;
	end;


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


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

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

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


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


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


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


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


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


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


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


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


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


	procedure DeleteLines (first, last: integer);
	begin
		if MeasurementsWindow <> 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 (MeasurementsWindow <> nil) and (mCount > 0) then
			with ListTE^^ do begin
					CopyResultsToBuffer(1, mCount, true);
					TESetSelect(0, teLength, ListTE);
					TEDelete(ListTE);
					TEInsert(ptr(TextBufP), TextBufSize, ListTE);
					UpdateScrollBars;
				end;
	end;

end.