unit Utilities;

{Miscellaneous utility routines used by Image program}

interface

	uses
		QuickDraw, Palettes, Picker, PrintTraps, globals;{SANE}



	procedure SetDialogItem (TheDialog: DialogPtr; item, value: integer);
	procedure OutlineButton (theDialog: DialogPtr; itemNo, CornerRad: integer);
	function GetDNum (TheDialog: DialogPtr; item: integer): LongInt;
	function GetDString (TheDialog: DialogPtr; item: integer): str255;
	procedure SetDNum (TheDialog: DialogPtr; item: integer; n: LongInt);
	procedure GetWindowRect (w: WindowPtr; var wrect: rect);
	procedure SetDReal (TheDialog: DialogPtr; item: integer; n: extended; fwidth: integer);
	procedure SetDString (TheDialog: DialogPtr; item: integer; str: str255);
	procedure DrawSItem (itemnum, fontrqst, sizerqst: integer; d: dialogptr; s: str255);
	function StringToReal (str: str255): real;
	function GetDReal (TheDialog: DialogPtr; item: integer): extended;
	procedure RealToString (Val: extended; width, fwidth: integer; var Str: Str255);
	procedure DrawReal (Val: extended; width, fwidth: integer);
	procedure DrawLong (i: LongInt);
	function GetInt (message: str255; default: integer): integer;
	function GetReal (message: str255; default: extended): extended;
	function OptionKeyDown: boolean;
	function ShiftKeyDown: boolean;
	function ControlKeyDown: boolean;
	function CommandPeriod: boolean;
	function SpaceBarDown: boolean;

	procedure SysResume;
	procedure beep;
	procedure PutMessage (str: str255);
	procedure UpdateTextMenu;
	procedure RedrawLUTWindow;
	procedure Load256ColorCLUT;
	function LoadCLUTResource (id: integer): boolean;
	procedure UnprotectLUT;
	procedure LoadLUT (table: MyCSpecArray);
	procedure DrawDensitySlice (OptionKey: boolean);
	procedure SelectLutTool;
	procedure EnableDensitySlice;
	procedure DisableDensitySlice;
	procedure UpdateColors;
	procedure LoadInputLookupTable (address: ptr);
	procedure ResetQuickCapture;
	procedure GetLookupTable (var table: LookupTable);
	procedure wait (ticks: LongInt);
	procedure SetGrayScaleLUT;
	procedure CheckColorWidth;
	procedure GetDefaultPalette;
	procedure GetPaletteFromFile (fname: str255; vnum: integer);
	procedure InitColor (fname: str255; vnum: integer);
	function GetScrapCount: integer;
	procedure DisplayText (update: boolean);
	procedure SetForegroundColor (color: integer);
	procedure SetBackgroundColor (color: integer);
	procedure ScreenToOffscreen (var loc: point);
	procedure OffscreenToScreen (var loc: point);
	procedure OffScreenToScreenRect (var r: rect);
	procedure UpdateScreen (MaskRect: rect);
	function GetColorIndex: integer;
	procedure RestoreRoi;
	procedure Undo;
	procedure CheckOnOffItem (MenuH: MenuHandle; item, fst, lst: Integer);
	procedure SetMenuItem (menuh: menuhandle; itemnum: integer; on: boolean);
	function GetFontSize (item: integer): integer;
	function MyGetPixel (h, v: integer): integer;
	procedure PutPixel (h, v, value: integer);
	procedure GetLine (h, v, count: integer; var line: LineType);
	procedure GetColumn (hstart, vstart, count: integer; var data: LineType);
	procedure PutColumn (hstart, vstart, count: integer; var data: LineType);
	procedure PutLine (h, v, count: integer; var line: LineType);
	procedure Show1Value (rvalue, CalibratedValue: extended);
	procedure Show2CalibratedValues (x, y: LongInt; ShowUncalibrated: boolean);
	procedure Show2Values (current, total: LongInt);
	procedure DrawDimension (x: integer);
	procedure Show3Values (hloc, vloc, ivalue: LongInt);
	procedure Show3RealValues (X, Y: LongInt; Z: extended);
	procedure PutChar (c: char);
	procedure PutTab;
	procedure PutString (str: str255);
	procedure PutReal (n: extended; width, fwidth: integer);
	procedure PutLong (n: LongInt; FieldWidth: integer);
	procedure CopyResultsToBuffer (FirstCount, LastCount: integer; Headings: boolean);
	procedure ShowWatch;
	procedure UpdatePicWindow;
	procedure DoOperation (Operation: OpType);
	procedure SaveRoi;
	procedure KillRoi;
	procedure Paste;
	procedure ShowRoi;
	procedure SetupUndo;
	procedure SetupUndoFromClip;
	function NotRectangular: boolean;
	function NotInBounds: boolean;
	function NoSelection: boolean;
	function NoUndo: boolean;
	function NewPicWindow (name: str255; width, height: integer): boolean;
	procedure MakeRegion;
	procedure SelectAll (visible: boolean);
	procedure EraseScreen;
	procedure RestoreScreen;
	procedure ShowMagnification;
	procedure Unzoom;
	function FindMedian (var a: SortArray): integer;
	procedure DrawBString (str: string);
	procedure DrawMyGrowIcon (w: WindowPtr);
	procedure PutMemoryAlert;
	function GetImageMemory (SaveInfo: infoPtr; var PicBaseHandle: handle; double: boolean): ptr;
	procedure UpdateAnalysisMenu;
	procedure ExtendWindowsMenu (fname: str255; size: LongInt; wptr: WindowPtr);
	procedure MakeNewWindow (name: str255);
	procedure PutWarning;
	procedure ScaleToFit;
	procedure SetupRoiRect;
	procedure GetForegroundColor (event: EventRecord);
	procedure GetBackgroundColor (event: EventRecord);
	procedure GenerateValues;
	procedure KillOperation;
	procedure ScaleImageWindow (var trect: rect);
	procedure InvertGrayLevels;
	function TooWide: boolean;
	procedure DrawText (str: str255; loc: point; just: integer);
	procedure IncrementCounter;
	procedure ClearResults (i: integer);
	procedure UpdateFitEllipse;

implementation


	type
		KeyPtrType = ^KeyMap;



	procedure MacsBug (str: str255);
	inline
		$abff;


	procedure SetDialogItem;{(TheDialog:DialogPtr; item,value:integer)}
		var
			ItemType: integer;
			ItemBox: rect;
			ItemHdl: handle;
	begin
		GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
		SetCtlValue(ControlHandle(ItemHdl), value)
	end;

	procedure OutlineButton;{(theDialog: DialogPtr; itemNo, CornerRad: integer)}
{ Draws a border around a button. 16 is the normal}
{  cornerRad for small buttons }
		var
			itemType: Integer;
			itemBox: Rect;
			itemHdl: Handle;
			tempPort: GrafPtr;
	begin
		GetPort(tempPort);
		SetPort(theDialog);
		GetDItem(theDialog, itemNo, itemType, itemHdl, itemBox);
		PenSize(3, 3);
		InSetRect(itemBox, -4, -4);
		FrameRoundRect(itemBox, cornerRad, cornerRad);
		PenSize(1, 1);
		SetPort(tempPort);
	end;


	function GetDNum;{(TheDialog:DialogPtr; item:integer):LongInt}
		var
			ItemType: integer;
			ItemBox: rect;
			ItemHdl: handle;
			str: str255;
			n: LongInt;
	begin
		GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
		GetIText(ItemHdl, str);
		StringToNum(str, n);
		GetDNum := n;
	end;


	function GetDString;{(TheDialog:DialogPtr; item:integer):str255}
		var
			ItemType: integer;
			ItemBox: rect;
			ItemHdl: handle;
			str: str255;
	begin
		GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
		GetIText(ItemHdl, str);
		GetDString := str;
	end;


	procedure SetDNum;{(TheDialog:DialogPtr; item:integer; n:LongInt)}
		var
			ItemType: integer;
			ItemBox: rect;
			ItemHdl: handle;
			str: str255;
	begin
		GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
		NumToString(n, str);
		SetIText(ItemHdl, str)
	end;


	procedure GetWindowRect;{(w:WindowPtr; VAR wrect:rect)}
  {Returns global coordinates of specified window.}
	begin
		wrect := WindowPeek(w)^.contRgn^^.rgnBBox;
	end;


	procedure SetDReal;{(TheDialog:DialogPtr; item:integer; n:extended; fwidth:integer)}
		var
			ItemType: integer;
			ItemBox: rect;
			ItemHdl: handle;
			str: str255;
	begin
		GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
		RealToString(n, 1, fwidth, str);
		SetIText(ItemHdl, str)
	end;


	procedure SetDString;{(TheDialog:DialogPtr; item:integer; str:str255)}
		var
			ItemType: integer;
			ItemBox: rect;
			ItemHdl: handle;
	begin
		GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
		SetIText(ItemHdl, str)
	end;


	function StringToReal (str: str255): real;
		var
			i, ndigits, StringLength: integer;
			c: char;
			n, m: real;
			negative, LeftOfPoint: boolean;
	begin
		negative := false;
		n := 0.0;
		LeftOfPoint := true;
		m := 0.1;
		ndigits := 0;
		StringLength := length(str);
		i := 0;
		repeat
			i := i + 1;
		until (str[i] in ['0'..'9', '-', '.']) or (i >= StringLength);
		c := str[i];
		repeat
			if c = '-' then
				negative := true
			else if c = '.' then
				LeftOfPoint := false
			else if (c >= '0') and (c <= '9') then begin
					ndigits := ndigits + 1;
					if LeftOfPoint then
						n := n * 10.0 + ord(c) - ord('0')
					else begin
							n := n + (ord(c) - ord('0')) * m;
							m := m * 0.1;
						end;
				end;
			i := i + 1;
			if i <= StringLength then
				c := str[i];
		until not (c in ['0'..'9', '-', '.']) or (i > StringLength);
		if ndigits = 0 then
			n := BadReal
		else if negative then
			n := -n;
		StringToReal := n;
	end;


	function GetDReal;{(TheDialog:DialogPtr; item:integer):extended}
		var
			str: str255;
	begin
		str := GetDString(TheDialog, item);
		GetDReal := StringToReal(str);
	end;


	procedure DrawLong;{(i:LongInt)}
		var
			str: str255;
	begin
		NumToString(i, str);
		DrawString(str);
	end;


	procedure RealToString;{(Val:extended; width,fwidth:integer; var Str:Str255)}
  {Does number to string conversion equivalent to write(val:width:fwidth).}
{var}
{form: DecForm;}
	begin
		if fwidth < 0 then begin
				if val < 1.0 then
					fwidth := 4
				else if trunc(val) = val then
					fwidth := 0
				else
					fwidth := 2;
			end;
		str := StringOf(val : width : fwidth); {Use LSP StringOf function because SANE Num2Str bombs out under A/UX}
{form.digits := fwidth;}
{form.style := FixedDecimal;}
{Num2Str(form, val, DecStr(str));}
{while length(Str) < width do begin}
{str := concat(' ', Str)}
{end;}
	end;


	procedure DrawReal;{(Val:extended; width,fwidth:integer)}
  {Displays a real(or integer) number at the current location in}
  {a form equivalent to write(val:width:fwidth) }
		var
			str: str255;
	begin
		RealToString(val, width, fwidth, str);
		DrawString(str);
	end;


	function GetInt;{(message:str255; default:integer):integer}
		const
			NumberID = 3;
		var
			mylog: DialogPtr;
			item: integer;
			temp: LongInt;
	begin
		ParamText(message, '', '', '');
		mylog := GetNewDialog(3000, nil, pointer(-1));
		SetDNum(MyLog, NumberID, default);
		SelIText(MyLog, NumberID, 0, 32767);
		OutlineButton(MyLog, ok, 16);
		repeat
			ModalDialog(nil, item);
		until (item = ok) or (item = cancel);
		if item = ok then begin
				temp := GetDNum(MyLog, NumberID);
				if (temp > -MaxInt) and (temp <= MaxInt) then
					GetInt := temp
				else begin
						SysBeep(1);
						temp := -MaxInt
					end;
			end
		else
			GetInt := -MaxInt;
		DisposDialog(mylog);
	end;


	function GetReal (message: str255; default: extended): extended;
		const
			NumberID = 3;
		var
			mylog: DialogPtr;
			item: integer;
	begin
		InitCursor;
		ParamText(message, '', '', '');
		mylog := GetNewDialog(3000, nil, pointer(-1));
		SetDReal(MyLog, NumberID, default, 2);
		SelIText(MyLog, NumberID, 0, 32767);
		OutlineButton(MyLog, ok, 16);
		repeat
			ModalDialog(nil, item);
		until (item = ok) or (item = cancel);
		if item = ok then
			GetReal := GetDReal(MyLog, NumberID)
		else
			GetReal := BadReal;
		DisposDialog(mylog);
	end;


	function OptionKeyDown;{:boolean}
		var
			KeyPtr: KeyPtrType;
			keys: array[0..3] of LongInt;
	begin
		KeyPtr := KeyPtrType(@keys);
		GetKeys(KeyPtr^);
		OptionKeyDown := (BAND(keys[1], 4)) <> 0;
	end;


	function ShiftKeyDown;{:boolean}
		var
			KeyPtr: KeyPtrType;
			keys: array[0..3] of LongInt;
	begin
		KeyPtr := KeyPtrType(@keys);
		GetKeys(KeyPtr^);
		ShiftKeyDown := (BAND(keys[1], 1)) <> 0;
	end;


	function ControlKeyDown;{:boolean}
		type
			KeyPtrType = ^KeyMap;
		var
			KeyPtr: KeyPtrType;
			keys: array[0..3] of LongInt;
	begin
		KeyPtr := KeyPtrType(@keys);
		GetKeys(KeyPtr^);
		ControlKeyDown := (BAND(keys[1], 8)) <> 0;
	end;


	function CommandPeriod;{:boolean}
		type
			KeyPtrType = ^KeyMap;
		var
			KeyPtr: KeyPtrType;
			keys: array[0..3] of LongInt;
	begin
		KeyPtr := KeyPtrType(@keys);
		GetKeys(KeyPtr^);
		CommandPeriod := (BAND(keys[1], $808000)) = $808000;
	end;


	function SpaceBarDown: boolean;
		var
			KeyPtr: KeyPtrType;
			keys: array[0..3] of LongInt;
	begin
		KeyPtr := KeyPtrType(@keys);
		GetKeys(KeyPtr^);
		SpaceBarDown := (BAND(keys[1], 512)) <> 0;
	end;


	procedure DrawSItem; {(itemnum, fontrqst, sizerqst: integer; d: dialogptr; s: str255)}
{Draw a string item in a dialog box.}
		var
			r: rect;
			itype: integer;
			ignore: handle;
	begin
		getditem(d, itemnum, itype, ignore, r);
		textfont(fontrqst);
		textsize(sizerqst);
		textbox(pointer(ord(@s) + 1), length(s), r, TEJustRight);
	end;


	procedure SysResume;
	begin
		FlushEvents(EveryEvent, 0);
		ExitToShell;
	end;


	procedure beep;
	begin
		SysBeep(1)
	end;


	procedure PutMessage;{(str:str255)}
		var
			ignore: integer;
	begin
		InitCursor;
		ParamText(str, '', '', '');
		Ignore := Alert(300, nil);
	end;

	function GetFontSize;{(item:integer):integer}
		var
			TempSize: integer;
	begin
		case item of
			1: 
				GetFontSize := 9;
			2: 
				GetFontSize := 10;
			3: 
				GetFontSize := 12;
			4: 
				GetFontSize := 14;
			5: 
				GetFontSize := 18;
			6: 
				GetFontSize := 24;
			7: 
				GetFontSize := 36;
			8: 
				GetFontSize := 48;
			9: 
				GetFontSize := 56;
			10: 
				GetFontSize := 72;
			12: 
				begin
					TempSize := GetInt('Font Size:', CurrentSize);
					if TempSize < 1 then
						TempSize := 1;
					if TempSize > 1000 then
						TempSize := 1000;
					GetFontSize := TempSize;
				end;
		end;
	end;


	procedure SetMenuItem; {(menuh:menuhandle; itemnum:integer; on:boolean)}
{Enable or disable menuh's itemnum. }
	begin
		if on then
			EnableItem(menuh, itemnum)
		else
			DisableItem(menuh, itemnum);
		if ItemNum = 0 then
			DrawMenuBar;
	end;


	procedure CheckOnOffItem;{(MenuH:MenuHandle; item,fst,lst:Integer)}
		var
			i: integer;
	begin
		for i := fst to lst do
			if i = item then
				CheckItem(MenuH, i, true)
			else
				CheckItem(MenuH, i, false);
	end;


	procedure UpdateTextMenu;
		var
			size, i, MenuItem, FontID, item: integer;
			FontName: str255;
			FontFound, FoundIt: boolean;
			str: str255;
	begin
		FontFound := false;
		for item := 1 to NumFontItems do begin
				GetItem(FontMenuH, Item, FontName);
				GetFNum(FontName, FontID);
				if FontID = CurrentFontID then begin
						FontFound := true;
						CheckItem(FontMenuH, Item, True)
					end
				else
					CheckItem(FontMenuH, Item, false);
			end;
		if not FontFound then begin
				FoundIt := False;
				Item := 1;
				repeat
					GetItem(FontMenuH, Item, FontName);
					GetFNum(FontName, FontID);
					if FontID = Geneva then begin
							CheckItem(FontMenuH, Item, True);
							CurrentFontID := FontID;
							FoundIt := true;
						end;
					Item := Item + 1;
				until (Item > NumFontItems) or FoundIt;
			end;

		for i := 1 to 10 do begin
				size := GetFontSize(i);
				if RealFont(CurrentFontID, size) then
					SetItemStyle(SizeMenuH, i, [OutLine])
				else
					SetItemStyle(SizeMenuH, i, [])
			end;
		NumToString(CurrentSize, str);
		str := concat('Other[', str, ']É');
		SetItem(SizeMenuH, 12, str);

		for i := TxPlain to TxShadow do
			CheckItem(StyleMenuH, i, false);
		if CurrentStyle = [] then
			CheckItem(StyleMenuH, TxPlain, true)
		else begin
				if Bold in CurrentStyle then
					CheckItem(StyleMenuH, TxBold, true);
				if Italic in CurrentStyle then
					CheckItem(StyleMenuH, TxItalic, true);
				if Underline in CurrentStyle then
					CheckItem(StyleMenuH, TxUnderline, true);
				if Outline in CurrentStyle then
					CheckItem(StyleMenuH, TxOutline, true);
				if Shadow in CurrentStyle then
					CheckItem(StyleMenuH, Txshadow, true);
			end;

		case CurrentSize of
			9: 
				MenuItem := 1;
			10: 
				MenuItem := 2;
			12: 
				MenuItem := 3;
			14: 
				MenuItem := 4;
			18: 
				MenuItem := 5;
			24: 
				MenuItem := 6;
			36: 
				MenuItem := 7;
			48: 
				MenuItem := 8;
			56: 
				MenuItem := 9;
			72: 
				MenuItem := 10;
			otherwise
				MenuItem := 12;
		end;
		CheckOnOffItem(SizeMenuH, MenuItem, 1, 12);

		case TextJust of
			teJustLeft: 
				MenuItem := LeftItem;
			teJustCenter: 
				MenuItem := CenterItem;
			teJustRight: 
				MenuItem := RightItem;
		end;
		CheckOnOffItem(TextMenuH, MenuItem, LeftItem, RightItem);

		if TextBack = NoBack then
			MenuItem := NoBackgroundItem
		else
			MenuItem := WithBackgroundItem;
		CheckOnOffItem(TextMenuH, MenuItem, NoBackgroundItem, WithBackgroundItem);
	end;


	procedure LoadLUT (table: MyCSpecArray);
		var
			i, entry, screen: integer;
			cPtr: ^cSpecArray;
			SaveDevice: GDHandle;
	begin
		if nExtraColors > 0 then begin
				entry := FirstExtraColorsEntry;
				for i := 1 to nExtraColors do begin
						table[entry].rgb := ExtraColors[i];
						entry := entry + 1;
					end;
			end;
		for i := 1 to 254 do {Work around needed for 32-bit QuickDraw}
			with table[i].rgb do
				if (red = 0) and (green = 0) and (blue = 0) then begin
						red := 256;
						green := 256;
						blue := 256;
					end;
		cPtr := @table[1];
		SaveDevice := GetGDevice;
		for screen := 1 to nMonitors do begin
				SetGDevice(Monitors[screen]);
				for i := 1 to 254 do begin
						ProtectEntry(i, false);
						ReserveEntry(i, false);
					end;
				SetEntries(1, 253, cPtr^);
			end;
		SetGDevice(SaveDevice);
	end;


	procedure RedrawLUTWindow;
	begin
		LoadLUT(info^.cTable);
		cheight := 256 + (2 + nExtraColors) * ExtraColorsHeight;
		SizeWindow(LUTWindow, cwidth, cheight, true);
	end;


	procedure Load256ColorCLUT;
		const
			Sat = -1;
			Val = -1;
		var
			i: integer;
			color: HSVColor;
	begin
		DisableDensitySlice;
		with info^ do begin
				for i := 0 to 255 do begin
						color.hue := i * 256;
						color.saturation := sat;
						color.value := val;
						HSV2RGB(color, ctable[i].rgb);
					end;
				LoadLUT(ctable);
				LUTMode := spectrum;
			end;
		IdentityFunction := false;
	end;


	function LoadPP2Palette: boolean;
{Loads COLR resource from PixelPaint 2.0 palette file.}
		var
			i: integer;
			size: LongInt;
			h: Handle;
			PPColorTable: record
					ctSize: INTEGER;
					table: array[0..255] of RGBColor;
				end;
	begin
		h := GetResource('COLR', 999);
		size := GetHandleSize(handle(h));
		if (ResError = NoErr) and (size = 1538) then
			with info^ do begin
					BlockMove(handle(h)^, @PPColorTable, SizeOf(PPColorTable));
					with PPColorTable do begin
							for i := 0 to 255 do
								cTable[i].rgb := table[i];
						end;
					LoadLUT(cTable);
					LUTMode := Custom;
					IdentityFunction := false;
					LoadPP2Palette := true;
				end
		else
			LoadPP2Palette := false;
		if h <> nil then
			DisposHandle(h);
	end;


	function LoadCLUTResource;{(id:integer):boolean}
		const
			ExpectedSize = 2056;
		var
			Size: LongInt;
			h: cTabHandle;
			MyColorTable: record
					ctSeed: LONGINT;
					transIndex: INTEGER;
					ctSize: INTEGER;
					ctTable: MyCSpecArray;
				end;
	begin
		DisableDensitySlice;
		h := GetCTable(id);
		size := GetHandleSize(handle(h));
		if (ResError <> NoErr) or (size < ExpectedSize) then begin
				LoadCLUTResource := false;
				if id = PixelpaintID then begin
						if LoadPP2Palette then
							LoadCLUTResource := true;
					end;
				if h <> nil then
					DisposCTable(h);
				exit(LoadCLUTResource)
			end;
		if size > ExpectedSize then
			size := ExpectedSize;
		BlockMove(handle(h)^, @MyColorTable, size);
		DisposCTable(h);
		LoadLUT(MyColorTable.ctTable);
		with info^ do begin
				cTable := MyColorTable.ctTable;
				if id = AppleDefaultCLUT then
					LUTMode := AppleDefault
				else
					LUTMode := Custom;
			end;
		IdentityFunction := false;
		LoadCLUTResource := true;
	end;


	procedure DrawDensitySlice (OptionKey: boolean);
		var
			i, tRed: integer;
	begin
		with info^ do begin
				if OptionKey then begin
						ctable := SaveCTable^;
					end
				else
					for i := 0 to 255 do
						if (i >= SliceStart) and (i <= SliceEnd) then
							cTable[i].rgb := SliceColor
						else
							ctable[i].rgb := SaveCTable^[i].rgb;
				LoadLUT(cTable);
			end;
	end;


	procedure SelectLutTool;
		var
			tPort: GrafPtr;
	begin
		if (CurrentTool <> LutTool) and (CurrentTool <> Wand) then begin
				GetPort(tPort);
				SetPort(ToolWindow);
				InvalRect(ToolRect[CurrentTool]);
				InvalRect(ToolRect[LutTool]);
				CurrentTool := LutTool;
				isSelectionTool := false;
				SetPort(tPort);
			end;
	end;


	procedure EnableDensitySlice;
	begin
		if not DensitySlicing then begin
				new(SaveCTable);
				if SaveCTable <> nil then begin
						SaveCTable^ := info^.ctable;
						DrawDensitySlice(false);
						DensitySlicing := true;
					end;
				SelectLUTTool;
			end;
	end;


	procedure DisableDensitySlice;
	begin
		if DensitySlicing then begin
				DensitySlicing := false;
				with info^ do
					if lutMode = GrayScale then
						SetGrayScaleLUT
					else
						ctable := SaveCTable^;
				dispose(SaveCTable);
				LoadLUT(info^.cTable);
			end;
	end;


	procedure UpdateColors;
		var
			MaxStart, LastColor, i, v: integer;
			index: 0..MaxPseudoColorsLessOne;
			OptionKey: boolean;
	begin
		OptionKey := OptionKeyDown;
		DisableDensitySlice;
		with info^ do begin
				LastColor := ColorStart + nColors * ColorWidth - 1;
				for i := 0 to 255 do
					with cTable[255 - i].rgb do begin
							if (i < ColorStart) or (i > LastColor) then begin
									if OptionKey then begin
											v := bsl(i, 8);
											Red := v;
											Green := v;
											Blue := v;
										end
									else begin
											Red := 0;
											Green := 0;
											Blue := 0;
										end
								end
							else begin
									index := (i - ColorStart) div ColorWidth;
									if index < 0 then
										index := 0;
									if index > nColors - 1 then
										index := nColors - 1;
									Red := RedX[index];
									Green := GreenX[index];
									Blue := BlueX[index];
								end;
						end; {for}
				LoadLUT(cTable);
				LUTMode := PseudoColor32;
			end;
		IdentityFunction := false;
	end;


	procedure LoadInputLoouupTable;{(address:ptr)}
		type
			ilutType = packed array[0..1023] of byte;
			ilutPtr = ^ilutType;
		var
			ilut: ilutPtr;
			i: integer;
	begin
		ilut := ilutPtr(address);
		if InvertVideo then begin
				for i := 0 to 255 do
					ilut^[i * 4] := i;
				ilut^[0] := 1;
				ilut^[255 * 4] := 254
			end
		else begin
				for i := 0 to 255 do
					ilut^[i * 4] := 255 - i;
				ilut^[0] := 254;
				ilut^[255 * 4] := 1
			end;
	end;


	procedure ResetQuickCapture;
		const
			ilutOffset = $90000;
	begin
		ControlReg^ := 1; {reset}
		while ControlReg^ < 0 do
			;
		ChannelReg^ := VideoChannel * 64;
		while ControlReg^ < 0 do
			;
		LoadInputLookupTable(Ptr(DTSlotBase + ilutOffset));
	end;


	procedure GetLookupTable;{(VAR table:LookupTable)}
		var
			i, r, g, b: integer;
			GrayscaleImage: boolean;
	begin
		with info^ do begin
				if DensitySlicing then begin
						for i := 0 to 255 do
							if (i >= SliceStart) and (i <= SliceEnd) then begin
									if ThresholdToForeground then
										table[i] := ForegroundIndex
									else
										table[i] := i
								end
							else begin
									if NonThresholdToBackground then
										table[i] := BackgroundIndex
									else
										table[i] := i
								end;
						DisableDensitySlice;
						exit(GetLookupTable);
					end;
				if (LutMode = GrayScale) or (LutMode = CustomGrayscale) then
					for i := 0 to 255 do
						table[i] := 255 - BSR(cTable[i].RGB.red, 8)
				else begin
						table[0] := 0;
						for i := 1 to 254 do
							with cTable[i].RGB do
								table[i] := 255 - trunc(band(bsr(red, 8), 255) * 0.3 + band(bsr(green, 8), 255) * 0.59 + band(bsr(blue, 8), 255) * 0.11);
						table[255] := 255;
					end;
			end; {with}
	end;


	procedure wait;{(ticks:LongInt)}
		var
			SaveTicks: LongInt;
	begin
		SaveTicks := TickCount + ticks;
		repeat
		until TickCount > SaveTicks;
	end;


	procedure MakeLine (X1, Y1, X2, Y2: integer);
		var
			x: integer;
			v, temp: integer;
	begin
		with info^ do begin
				if not gmFixedSlope then begin
						DeltaX := X2 - X1;
						DeltaY := y2 - y1;
					end;
				if Deltax <> 0 then
					for X := X1 to X2 do
						with info^.cTable[255 - x].rgb do begin
								temp := (LongInt(DeltaY) * (x - x1)) div DeltaX + Y1; {Temporary variable needed to avoid range check}
								v := temp * 256;
								red := v;
								green := v;
								blue := v;
							end;
			end;
	end;


	procedure MakeHorizontalLine (X1, X2, Y: integer);
		var
			x: integer;
			v: integer;
	begin
		for X := X1 to X2 do
			with info^.cTable[255 - x].rgb do begin
					v := y * 256;
					red := v;
					green := v;
					blue := v;
				end;
	end;


	procedure SetGrayScaleLUT;
	begin
		with info^ do begin
				MakeHorizontalLine(0, p1x, 0);
				MakeLine(p1x, p1y, p2x, p2y);
				MakeHorizontalLine(p2x, 255, 255);
				LoadLUT(cTable);
				LUTMode := GrayScale;
			end;
	end;


	procedure CheckColorWidth;
	begin
		with info^ do
			if (ColorStart + ncolors * ColorWidth) > 256 then begin
					ColorWidth := (256 - ColorStart) div ncolors;
					if ColorWidth < 1 then
						ColorWidth := 1;
				end;
	end;


	procedure GetPaletteFromFile;{(fname:str255; vnum:integer)}
		var
			PaletteHeader: ColorArray;
			err, f: integer;
			size: LongInt;
	begin
		err := FSOpen(fname, vnum, f);
		with info^ do begin
				size := SizeOf(ColorArray);
				err := FSRead(f, size, @PaletteHeader);
				nColors := PaletteHeader[0];
				if nColors > MaxPseudocolors then
					nColors := MaxPseudoColors;
				ColorStart := PaletteHeader[1];
				ColorWidth := PaletteHeader[2];
				CheckColorWidth;
				with PaletteRec do begin
						err := FSRead(f, size, @RedData);
						err := FSRead(f, size, @GreenData);
						err := FSRead(f, size, @BlueData);
					end;
			end;
		err := fsclose(f);
		PaletteName := fname;
	end;


	procedure GetDefaultPalette;
		var
			Size: LongInt;
			pHandle: handle;
			i: integer;
	begin
		with info^ do begin
				ncolors := 0;
				pHandle := GetResource('CPAL', 1000);
				if (ResError <> noErr) or (pHandle = nil) then begin
						beep;
						if pHandle <> nil then
							ReleaseResource(pHandle);
						exit(GetDefaultPalette)
					end;
				Size := GetHandleSize(pHandle);
				if size = SizeOF(PaletteRec) then begin
						BlockMove(pHandle^, @PaletteRec, size);
						ncolors := PaletteRec.NumberOfColors;
					end;
				for i := 0 to MaxPseudoColorsLessOne do
					with PaletteRec do begin
							RedX[i] := RedData[i] * 255;
							GreenX[i] := GreenData[i] * 255;
							BlueX[i] := BlueData[i] * 255;
						end;
				LUTMode := PseudoColor32;
			end;
		ReleaseResource(pHandle);
	end;


	procedure InitColor;{(fname:str255; vnum:integer)}
		var
			i: integer;
	begin
		with info^ do begin
				if fname = 'Default' then
					GetDefaultPalette
				else begin
						GetPaletteFromFile(fname, vnum);
						LUTMode := PseudoColor32;
					end;
				for i := 0 to ncolors - 1 do
					with PaletteRec do begin
							RedX[i] := RedData[i] * 255;
							GreenX[i] := GreenData[i] * 255;
							BlueX[i] := BlueData[i] * 255;
						end;
			end;
	end;


	function GetScrapCount;{:integer}
		var
			ScrapInfo: PScrapStuff;
	begin
		ScrapInfo := InfoScrap;
		GetScrapCount := ScrapInfo^.ScrapCount;
	end;


	procedure DisplayText (update: boolean);
		var
			tPort: GrafPtr;
			i, hstart, width, ff: integer;
			MaskRect: rect;
			p1, p2: point;
	begin
		if (info = NoInfo) or (not IsInsertionPoint) then
			exit(DisplayText);
		if update then
			Undo;
		GetPort(tPort);
		SetPort(GrafPtr(Info^.osPort));
		TextFont(CurrentFontID);
		TextFace(CurrentStyle);
		TextSize(CurrentSize);
		if TextBack = NoBack then
			TextMode(SrcOr)
		else
			TextMode(SrcCopy);
		width := StringWidth(TextStr);
		case TextJust of
			teJustLeft: 
				hstart := TextStart.h;
			teJustCenter: 
				hstart := TextStart.h - width div 2;
			teJustRight: 
				hstart := TextStart.h - width;
		end;
		if hstart < 0 then
			hstart := 0;
		MoveTo(hstart, TextStart.v);
		DrawString(TextStr);
		GetPen(InsertionPoint);
		ff := CurrentSize * 2;
		p1.h := hstart - ff;
		p1.v := TextStart.v - CurrentSize;
		p2.h := TextStart.h + width + ff;
		p2.v := TextStart.v + CurrentSize div 3;
		Pt2Rect(p1, p2, MaskRect);
		UpdateScreen(MaskRect);
		SetPort(tPort);
		Info^.changes := true;
	end;


	procedure SetForegroundColor;{(color:integer)}
		var
			tPort: GrafPtr;
	begin
		if (color >= 0) and (color <= 255) then
			with info^ do begin
					ForegroundIndex := color;
					GetPort(tPort);
					SetPort(ToolWindow);
					InvalRect(ToolRect[brush]);
					if LUTMode = PseudoColor32 then
						CurrentColorIndex := GetColorIndex;
					if osPort <> nil then begin
							SetPort(GrafPtr(osPort));
							pmForeColor(ForegroundIndex);
						end;
					SetPort(tPort);
					if isInsertionPoint then
						DisplayText(true);
				end;
	end;


	procedure SetBackgroundColor;{(color:integer)}
		var
			tPort: GrafPtr;
	begin
		if (color >= 0) and (color <= 255) then
			with info^ do begin
					BackgroundIndex := color;
					GetPort(tPort);
					SetPort(ToolWindow);
					InvalRect(ToolRect[eraser]);
					if osPort <> nil then begin
							SetPort(GrafPtr(osPort));
							pmBackColor(BackgroundIndex);
						end;
					SetPort(tPort);
					if isInsertionPoint then
						DisplayText(true);
				end;
	end;


	function GetColorIndex;{:integer}
		var
			CLUTIndex: LongInt;
	begin
		CLUTIndex := 255 - ForegroundIndex;
		with info^ do
			if (CLUTIndex < ColorStart) or (CLUTIndex > (ColorStart + nColors * ColorWidth)) then begin
					GetColorIndex := NoColor
				end
			else
				GetColorIndex := (CLUTIndex - ColorStart) div ColorWidth;
	end;


	procedure OffScreenToScreenRect;{(VAR r:rect)}
		var
			p1, p2: point;
	begin
		with r do begin
				p1.h := left;
				p1.v := top;
				p2.h := right;
				p2.v := bottom;
				OffScreenToScreen(p1);
				OffScreenToScreen(p2);
				Pt2Rect(p1, p2, r);
			end;
	end;


	procedure ScreenToOffscreen;{(VAR loc:point)}
	begin
		with loc, Info^ do begin
				h := SrcRect.left + trunc(h / magnification);
				v := SrcRect.top + trunc(v / magnification);
			end;
	end;


	procedure OffscreenToScreen;{(VAR loc:point)}
	begin
		with loc, Info^ do begin
				h := trunc((h - SrcRect.left) * magnification);
				v := trunc((v - SrcRect.top) * magnification);
			end;
	end;


	procedure UpdateScreen;{(MaskRect:rect)}
{Refreshes the portion of the screen defined by}
{MaskRect, where MaskRect is defined in offscreen coordinates.}
		var
			tPort: GrafPtr;
			imag: integer;
	begin
		OffScreenToScreenRect(MaskRect);
		with Info^ do
			if info <> NoInfo then begin
					getPort(tPort);
					SetPort(wptr);
					pmForeColor(BlackIndex);
					pmBackColor(WhiteIndex);
					imag := trunc(magnification);
					InsetRect(MaskRect, -imag * 2 * LineWidth, -imag * 2 * LineWidth);
					InsetRect(MaskRect, 0, 0);
					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;
	end;


	procedure RestoreRoi;
	begin
		with Info^ do begin
				SetupUndo;
				if RoiShowing then
					UpdateScreen(RoiRect);
				roiType := NoInfo^.roiType;
				RoiRect := NoInfo^.RoiRect;
				CopyRgn(NoInfo^.roiRgn, roiRgn);
				RoiShowing := true;
				measuring := false;
				WhatToUndo := NothingToUndo;
			end;
	end;


	procedure Undo;
		var
			SrcPtr: ptr;
			line: integer;
	begin
		if info^.PixMapSize <> CurrentUndoSize then
			exit(Undo);
		if UndoFromClip then begin
				if info^.PixMapSize > ClipBufSize then
					exit(Undo);
				SrcPtr := ClipBuf;
			end
		else
			SrcPtr := UndoBuf;
		with info^ do
			BlockMove(SrcPtr, PicBaseAddr, PixMapSize);
		if UndoFromClip and RestoreUndoBuf then
			with info^ do
				BlockMove(SrcPtr, UndoBuf, PixMapSize);
		if RedoSelection then
			RestoreRoi;
	end;


	function MyGetPixel;{(h,v:integer):integer}
		var
			offset: LongInt;
			p: ptr;
	begin
		with Info^ do begin
				if (h < 0) or (v < 0) or (h >= PixelsPerLine) or (v >= nlines) then begin
						MyGetPixel := WhiteIndex;
						exit(MyGetPixel);
					end;
				offset := LongInt(v) * BytesPerRow + h;
				if offset >= PixMapSize then
					exit(MyGetPixel);
				p := ptr(ord4(PicBaseAddr) + offset);
				MyGetPixel := BAND(p^, 255);
			end;
	end;


	procedure PutPixel;{(h,v,value:integer)}
		type
			uptr = ^UnsignedByte;
		var
			offset: LongInt;
			p: ptr;
	begin
		with Info^ do begin
				if (h < 0) or (v < 0) or (h >= PixelsPerLine) or (v >= nlines) then
					exit(PutPixel);
				offset := LongInt(v) * BytesPerRow + h;
				p := ptr(ord4(PicBaseAddr) + offset);
				p^ := BAND(value, 255);
			end;
	end;


	procedure GetLine;{(h,v,count:integer; VAR line:LineType)}
		var
			offset: LongInt;
			p: ptr;
	begin
		with Info^ do begin
				if (h < 0) or (v < 0) or ((h + count) > PixelsPerLine) or (v >= nlines) then begin
						line := BlankLine;
						exit(GetLine);
					end;
				offset := LongInt(v) * BytesPerRow + h;
				p := ptr(ord4(PicBaseAddr) + offset);
				BlockMove(p, @line, count);
			end;
	end;


	procedure GetColumn;{(hstart,vstart,count:integer; VAR data:LineType)}
		var
			i, v: integer;
	begin
		if count > MaxPixelsPerLine then
			count := MaxPixelsPerLine;
		v := vstart;
		for i := 0 to count - 1 do begin
				data[i] := MyGetPixel(hstart, v);
				v := v + 1;
			end;
	end;


	procedure PutColumn;{(hstart,vstart,count:integer; VAR data:LineType)}
		var
			i, v: integer;
	begin
		if count > MaxPixelsPerLine then
			count := MaxPixelsPerLine;
		v := vstart;
		for i := 0 to count - 1 do begin
				PutPixel(hstart, v, data[i]);
				v := v + 1;
			end;
	end;


	procedure PutLine;{(h,v,count:integer; VAR line:LineType)}
		var
			offset: LongInt;
			p: ptr;
	begin
		with Info^ do begin
				if (h < 0) or (v < 0) or (v >= nlines) then
					exit(PutLine);
				if (h + count) > PixelsPerLine then
					count := PixelsPerLine - h;
				offset := LongInt(v) * BytesPerRow + h;
				p := ptr(ord4(PicBaseAddr) + offset);
				BlocKMove(@line, p, count);
			end;
	end;


	procedure Show1Value (rvalue, CalibratedValue: extended);
		var
			tPort: GrafPtr;
			hstart, vstart, ivalue: integer;
	begin
		hstart := ValuesHStart;
		vstart := ValuesVStart;
		GetPort(tPort);
		SetPort(ResultsWindow);
		TextSize(9);
		TextFont(Monaco);
		TextMode(SrcCopy);
		MoveTo(xValueLoc, vstart);
		if CalibratedValue <> NoValue then begin
				DrawReal(CalibratedValue, 5, 2);
				DrawString(' (');
				DrawReal(rvalue, 3, 0);
				DrawString(')');
			end
		else
			DrawReal(rvalue, 6, 2);
		DrawString('    ');
		SetPort(tPort);
	end;


	procedure Show2CalibratedValues; {(x, y: LongInt; ShowUncalibrated: boolean)}
		var
			tPort: GrafPtr;
			hstart, vstart, ivalue: integer;
	begin
		hstart := ValuesHStart;
		vstart := ValuesVStart;
		GetPort(tPort);
		SetPort(ResultsWindow);
		TextSize(9);
		TextFont(Monaco);
		TextMode(SrcCopy);
		MoveTo(xValueLoc, vstart);
		DrawLong(x);
		DrawString('     ');
		MoveTo(yValueLoc, vstart + 10);
		if info^.Calibrated then begin
				DrawReal(cvalue[y], 5, 2);
				if ShowUncalibrated then begin
						DrawString(' (');
						DrawLong(y);
						DrawString(')');
					end;
			end
		else
			DrawLong(y);
		DrawString('     ');
		SetPort(tPort);
	end;


	procedure Show2Values (current, total: LongInt);
		var
			tPort: GrafPtr;
			hstart, vstart, ivalue: integer;
	begin
		hstart := ValuesHStart;
		vstart := ValuesVStart;
		GetPort(tPort);
		SetPort(ResultsWindow);
		TextSize(9);
		TextFont(Monaco);
		TextMode(SrcCopy);
		MoveTo(xValueLoc, vstart);
		DrawLong(current);
		DrawString('     ');
		MoveTo(yValueLoc, vstart + 10);
		DrawLong(total);
		DrawString('     ');
		SetPort(tPort);
	end;


	procedure DrawDimension (x: integer);
	begin
		with info^ do begin
				if SpatialScale <> 0.0 then begin
						DrawReal(x / SpatialScale, 5, 2);
						DrawString(units);
						DrawString(' (');
						DrawReal(x, 3, 0);
						DrawString(')')
					end
				else
					DrawLong(x);
				DrawString('      ');
			end;
	end;


	procedure Show3Values;{(hloc,vloc,ivalue:LongInt)}
		var
			tPort: GrafPtr;
			hstart, vstart: integer;
	begin
		with info^ do begin
				hstart := ValuesHStart;
				vstart := ValuesVStart;
				GetPort(tPort);
				SetPort(ResultsWindow);
				TextSize(9);
				TextFont(Monaco);
				TextMode(SrcCopy);
				if hloc < 0 then
					hloc := -hloc;
				MoveTo(xValueLoc, vstart);
				DrawDimension(hloc);
				if InvertYCoordinates and (ivalue >= 0) then
					vloc := PicRect.bottom - vloc - 1;
				if vloc < 0 then
					vloc := -vloc;
				MoveTo(yValueLoc, vstart + 10);
				DrawDimension(vloc);
				DrawString('    ');
				if ivalue >= 0 then begin
						MoveTo(zValueLoc, vstart + 20);
						if Calibrated then begin
								DrawReal(cvalue[ivalue], 5, 2);
								DrawString(' (');
								DrawLong(ivalue);
								DrawString(')');
							end
						else
							DrawLong(ivalue);
					end;
				DrawString('    ');
				SetPort(tPort);
			end;
	end;


	procedure Show3RealValues;{(X,Y:LongInt; Z:extended)}
		var
			tPort: GrafPtr;
			hstart, vstart, ivalue: integer;
	begin
		with info^ do begin
				hstart := ValuesHStart;
				vstart := ValuesVStart;
				GetPort(tPort);
				SetPort(ResultsWindow);
				TextSize(9);
				TextFont(Monaco);
				TextMode(SrcCopy);
				MoveTo(xValueLoc, vstart);
				DrawDimension(x);
				MoveTo(yValueLoc, vstart + 10);
				DrawDimension(y);
				MoveTo(zValueLoc, vstart + 20);
				if SpatialScale <> 0.0 then begin
						DrawReal(z / SpatialScale, 5, 2);
						DrawString(units);
						DrawString(' (');
						DrawReal(z, 1, 2);
						DrawString(')')
					end
				else
					DrawReal(z, 1, 2);
				DrawString('    ');
				SetPort(tPort);
			end;
	end;


	procedure PutChar;{(c:char)}
	begin
		if TextBufSize < MaxTextBufSize then begin
				TextBufSize := TextBufSize + 1;
				TextBufP^[TextBufSize] := c;
				if c = cr then begin
						TextBufColumn := 0;
						TextBufLineCount := TextBufLineCount + 1
					end
				else
					TextBufColumn := TextBufColumn + 1;
			end;
	end;


	procedure PutTab;
	begin
		if not printing then
			PutChar(tab)
	end;


	procedure PutString (str: str255);
		var
			i: integer;
	begin
		for i := 1 to length(str) do begin
				if TextBufSize < MaxTextBufSize then
					TextBufSize := TextBufSize + 1;
				TextBufP^[TextBufSize] := str[i];
				TextBufColumn := TextBufColumn + 1;
			end;
	end;


	procedure PutFString (str: str255; FieldWidth: integer);
		var
			LeadingSpaces: integer;
	begin
		LeadingSpaces := FieldWidth - length(str);
		if LeadingSpaces > 0 then
			str := concat(copy('            ', 1, LeadingSpaces), str);
		PutString(str);
	end;


	procedure PutReal;{(n:extended; width,fwidth:integer)}
		var
			str: str255;
	begin
		RealToString(n, width, fwidth, str);
		PutString(str);
	end;


	procedure PutLong (n: LongInt; FieldWidth: integer);
		var
			str: str255;
			LeadingSpaces: integer;
	begin
		NumToString(n, str);
		LeadingSpaces := FieldWidth - length(str);
		if LeadingSpaces > 0 then
			str := concat(copy('            ', 1, LeadingSpaces), str);
		PutString(str);
	end;


	procedure CopyResultsToBuffer (FirstCount, LastCount: integer; Headings: boolean);
		var
			i, column, fwidth: integer;
			m: MeasurementTypes;

		procedure PutSequenceNumber;
		begin
			PutLong(i, 4);
			PutChar('.');
			PutTab;
		end;

		procedure PutUnits;
		begin
			if info^.SpatialScale <> 0.0 then begin
					PutString('  (');
					PutString(info^.Units);
					PutString(')')
				end
			else
				PutString('(Pixels)');
			PutChar(cr);
			PutChar(cr);
		end;

		procedure PutTabDelimeter;
		begin
			Column := Column + 1;
			if Column <> nListColumns then
				PutTab;
		end;

	begin
		if mCount < 1 then begin
				TextBufSize := 0;
				TextBufLineCount := 0;
				exit(CopyResultsToBuffer);
			end;
		ShowWatch;
		Headings := Headings or OptionKeyWasDown;
		TextBufSize := 0;
		TextBufColumn := 0;
		TextBufLineCount := 0;
		nListColumns := 0;
		for m := AreaM to StdDevM do
			if m in Measurements then
				nListColumns := nListColumns + 1;
		if (xyLocM in measurements) or (nPoints > 0) then
			nListColumns := nListColumns + 2;
		if ModeM in measurements then
			nListColumns := nListColumns + 1;
		if (LengthM in measurements) or (nLengths > 0) then
			nListColumns := nListColumns + 1;
		if MajorAxisM in measurements then
			nListColumns := nListColumns + 1;
		if MinorAxisM in measurements then
			nListColumns := nListColumns + 1;
		if (AngleM in measurements) or (nAngles > 0) then
			nListColumns := nListColumns + 1;
		if IntDenM in measurements then
			nListColumns := nListColumns + 2;
		if MinMaxM in measurements then
			nListColumns := nListColumns + 2;
		with info^ do begin
				fwidth := FieldWidth;
				if Headings and (FirstCount = 1) then begin
						PutFString(' ', 5);
						PutTabDelimeter;
						if AreaM in measurements then begin
								PutFString('Area', fwidth);
								PutTabDelimeter;
							end;
						if MeanM in measurements then begin
								PutFString('Mean', fwidth);
								PutTabDelimeter;
							end;
						if StdDevM in measurements then begin
								PutFString('S.D.', fwidth);
								PutTabDelimeter;
							end;
						if (xyLocM in measurements) or (nPoints > 0) then begin
								PutFString('X', fwidth);
								PutTabDelimeter;
								PutFString('Y', fwidth);
								PutTabDelimeter;
							end;
						if ModeM in measurements then begin
								PutFString('Mode', fwidth);
								PutTabDelimeter;
							end;
						if (LengthM in measurements) or (nLengths > 0) then begin
								PutFString('Length', fwidth);
								PutTabDelimeter;
							end;
						if MajorAxisM in measurements then begin
								PutFString(MajorLabel, fwidth);
								PutTabDelimeter;
							end;
						if MinorAxisM in measurements then begin
								PutFString(MinorLabel, fwidth);
								PutTabDelimeter;
							end;
						if (AngleM in measurements) or (nAngles > 0) then begin
								PutFString('Angle', fwidth);
								PutTabDelimeter;
							end;
						if IntDenM in measurements then begin
								PutFString('Int.Den.', fwidth + 2);
								PutTabDelimeter;
								PutFString('Back.', fwidth);
								PutTabDelimeter;
							end;
						if MinMaxM in measurements then begin
								PutFString('Min', fwidth);
								PutTabDelimeter;
								PutFString('Max', fwidth);
								PutTabDelimeter;
							end;
						PutChar(cr);
						PutChar(cr);
					end;
				for i := FirstCount to LastCount do begin
						column := 0;
						if Headings then
							PutSequenceNumber;
						if AreaM in measurements then begin
								PutReal(mArea^[i], fwidth, precision);
								PutTabDelimeter;
							end;
						if MeanM in measurements then begin
								PutReal(mean^[i], fwidth, precision);
								PutTabDelimeter;
							end;
						if StdDevM in measurements then begin
								PutReal(sd^[i], fwidth, precision);
								PutTabDelimeter;
							end;
						if (xyLocM in measurements) or (nPoints > 0) then begin
								PutReal(xcenter^[i], fwidth, precision);
								PutTab;
								PutReal(ycenter^[i], fwidth, precision);
								PutTabDelimeter;
							end;
						if ModeM in measurements then begin
								PutReal(mode^[i], fwidth, precision);
								PutTabDelimeter;
							end;
						if (LengthM in measurements) or (nLengths > 0) then begin
								PutReal(plength^[i], fwidth, precision);
								PutTabDelimeter;
							end;
						if MajorAxisM in measurements then begin
								PutReal(MajorAxis^[i], fwidth, precision);
								PutTabDelimeter;
							end;
						if MinorAxisM in measurements then begin
								PutReal(MinorAxis^[i], fwidth, precision);
								PutTabDelimeter;
							end;
						if (AngleM in measurements) or (nAngles > 0) then begin
								PutReal(orientation^[i], fwidth, precision);
								PutTabDelimeter;
							end;
						if IntDenM in measurements then begin
								PutReal(IntegratedDensity^[i], fwidth + 2, precision);
								PutTabDelimeter;
								PutReal(idBackground^[i], fwidth, precision);
								PutTabDelimeter;
							end;
						if MinMaxM in measurements then begin
								PutReal(mMin^[i], fwidth, precision);
								PutTabDelimeter;
								PutReal(mMax^[i], fwidth, precision);
								PutTabDelimeter;
							end;
						PutChar(cr);
					end; {for}
			end; {with}
	end;


	procedure ShowWatch;
	begin
		SetCursor(watch);
	end;


	procedure UpdatePicWindow;
		var
			tPort: GrafPtr;
	begin
		if info <> NoInfo then
			with Info^ do begin
					getPort(tPort);
					SetPort(wptr);
					pmForeColor(BlackIndex);
					pmBackColor(WhiteIndex);
					hlock(handle(osPort^.portPixMap));
					hlock(handle(CGrafPort(wptr^).PortPixMap));
					CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPort(wptr^).PortPixMap)^^, SrcRect, wrect, SrcCopy, nil);
					hunlock(handle(osPort^.portPixMap));
					hunlock(handle(CGrafPort(wptr^).PortPixMap));
					SetPort(tPort);
					RoiUpdateTime := 0;
				end;
	end;


	procedure DoOperation;{(Operation:OpType)}
		var
			tPort: GrafPtr;
			loc: point;
			width, height: integer;
			tRect: rect;
	begin
		GetPort(tPort);
		with Info^ do begin
				changes := true;
				SetPort(GrafPtr(osPort));
				PenNormal;
				PenSize(LineWidth, LineWidth);
				case Operation of
					InvertOp: 
						InvertRgn(roiRgn);
					PaintOp: 
						PaintRgn(roiRgn);
					FrameOp: 
						FrameRgn(roiRgn);
					EraseOp: 
						EraseRgn(roiRgn);
					PasteOp: 
						Paste;
					otherwise
				end;
				if not RoiShowing then
					UpdateScreen(RoiRect);
				if PixMapSize > UndoBufSize then
					OpPending := false;
			end;
		SetPort(tPort);
	end;


	procedure SaveRoi;
	begin
		with info^ do
			if RoiType <> noRoi then begin
					NoInfo^.roiType := roiType;
					NoInfo^.RoiRect := RoiRect;
					CopyRgn(roiRgn, NoInfo^.roiRgn);
				end;
	end;


	procedure KillRoi;
	begin
		with info^ do begin
				if RoiShowing then begin
						if OpPending then begin
								OpPending := false;
								DoOperation(CurrentOp);
							end;
						SaveRoi;
						RoiShowing := false;
						UpdateScreen(RoiRect);
					end;
				RoiType := NoRoi;
				RoiUpdateTime := 0;
			end;
	end;


	procedure Paste;
		var
			srcPort: cGrafPtr;
	begin
		if info = NoInfo then begin
				beep;
				exit(Paste)
			end;
		with Info^ do begin
				if not RoiShowing then
					exit(Paste);
				if PasteTransferMode = SrcCopy then begin
						pmForeColor(BlackIndex);
						pmBackColor(WhiteIndex);
					end;
				srcPort := ClipBufInfo^.osPort;
				if LivePasteMode then
					if (WhatsOnClip = CameraPic) and (QuickCaptureInfo <> nil) and (PictureType <> QuickCaptureType) then begin
							ControlReg^ := BitAnd($80, 255); {Start frame capture}
							while ControlReg^ < 0 do
								;       {Wait for it to complete}
							srcPort := qcPort;
						end;
				hlock(handle(srcPort^.portPixMap));
				hlock(handle(osPort^.portPixMap));
				CopyBits(BitMapHandle(srcPort^.portPixMap)^^, BitMapHandle(osPort^.PortPixMap)^^, ClipBufInfo^.RoiRect, RoiRect, PasteTransferMode, roiRgn);
				hunlock(handle(srcPort^.portPixMap));
				hunlock(handle(osPort^.PortPixMap));
				if PasteTransferMode = SrcCopy then begin
						pmForeColor(ForegroundIndex);
						pmBackColor(BackgroundIndex);
					end;
			end;
	end;


	procedure ShowRoi;
	begin
		with info^ do
			if RoiType <> NoRoi then begin
					SetupUndo;
					RoiShowing := true;
				end;
	end;


	procedure SetupUndo;
		var
			line: integer;
	begin
		if info = NoInfo then begin
				CurrentUndoSize := 0;
				exit(SetupUndo)
			end;
		if info^.PixMapSize > UndoBufSize then begin
				CurrentUndoSize := 0;
				WhatToUndo := NothingToUndo;
				exit(SetupUndo)
			end;
		with info^ do begin
				if OpPending then begin
						DoOperation(CurrentOp);
						OpPending := false;
					end;
				CurrentUndoSize := PixMapSize;
				BlockMove(PicBaseAddr, UndoBuf, PixMapSize);
				UndoFromClip := false;
				RedoSelection := false;
			end;
	end;


	procedure SetupUndoFromClip;
		var
			line: integer;
	begin
		if info = NoInfo then begin
				CurrentUndoSize := 0;
				WhatToUndo := NothingToUndo;
				exit(SetupUndoFromClip)
			end;
		if info^.PixMapSize > ClipBufSize then begin
				CurrentUndoSize := 0;
				WhatToUndo := NothingToUndo;
				exit(SetupUndoFromClip)
			end;
		with info^ do begin
				if OpPending then begin
						DoOperation(CurrentOp);
						OpPending := false;
					end;
				CurrentUndoSize := PixMapSize;
				BlockMove(PicBaseAddr, ClipBuf, PixMapSize);
			end;
		WhatsOnClip := nothing;
		UndofromClip := true;
		RedoSelection := false;
	end;


	function NoSelection;{:boolean}
	begin
		if Info = NoInfo then begin
				beep;
				NoSelection := true;
				exit(NoSelection);
			end;
		if not Info^.RoiShowing then begin
				PutMessage('Please use the Selection Tool to make a selection or use the Select All command.');
				macro := false;
			end;
		NoSelection := not Info^.RoiShowing;
	end;


	function NotRectangular;{:boolean}
	begin
		with info^ do
			if RoiShowing and (RoiType <> RectRoi) then begin
					PutMessage('This operation requires a rectangular selection.');
					NotRectangular := true;
					macro := false;
				end
			else
				NotRectangular := false;
	end;


	function NotInBounds;{:boolean}
	begin
		NotInBounds := false;
		with info^, info^.RoiRect do
			if RoiShowing then
				if (left < 0) or (top < 0) or (right > PicRect.right) or (bottom > PicRect.bottom) then begin
						PutMessage('This operation requires the selection to be entirely within the image.');
						NotInBounds := true;
						macro := false;
					end;
	end;


	function NoUndo: boolean;
		var
			ImageTooLarge: boolean;
	begin
		with info^ do
			ImageTooLarge := (PixMapSize > ClipBufSize) or (PixMapSize > UndoBufSize);
		if ImageTooLarge then
			PutMessage('This operation requires that the Undo and Clipboard buffers be at least as large as the image.');
		NoUndo := ImageTooLarge;
	end;


	procedure PutMemoryAlert;
	begin
		PutMessage('Sorry, but there is not enough memory available to open this image. Try closing some windows.');
		macro := false;
	end;


	procedure CompactMemory;
		var
			size: LongInt;
			TempInfo: InfoPtr;
			i: integer;
	begin
		for i := 1 to nPics do begin
				TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
				hunlock(TempInfo^.PicBaseHandle)
			end;
		size := 4000000;
		PurgeMem(size);
		size := CompactMem(size);
		for i := 1 to nPics do begin
				TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
				with TempInfo^ do begin
						hlock(PicBaseHandle);
						PicBaseAddr := StripAddress(PicBaseHandle^);
						osPort^.PortPixMap^^.BaseAddr := PicBaseAddr;
					end;
			end;
	end;


	function GetImageMemory (SaveInfo: infoPtr; var PicBaseHandle: handle; double: boolean): ptr;
{Allocates memory for the PixMap of new image windows. SaveInfo points to the InfoRec of the previous window.}
{A handle is used, rather than a pointer, since NewPtr(particularly on the ci and fx) is rediculously slow.}
{Would you believe up to 10 seconds when many windows are open?}
		const
			MinFree = 100000;
		var
			h: handle;
			FreeMem, NeededSize: LongInt;
	begin
		with info^ do begin
				if odd(PixelsPerLine) then
					BytesPerRow := PixelsPerLine + 1
				else
					BytesPerRow := PixelsPerLine;
				PixMapSize := LongInt(nlines) * BytesPerRow;
				ImageSize := LongInt(nlines) * PixelsPerLine;
				NeededSize := PixMapSize;
				if double then
					NeededSize := NeededSize * 2;
				h := NewHandle(NeededSize);
			end;
		FreeMem := MaxBlock;
		if (h = nil) or (FreeMem < MinFree) then begin
				if h <> nil then
					DisposHandle(h);
				CompactMemory;
				h := NewHandle(NeededSize);
				FreeMem := MaxBlock;
			end;
		if (h = nil) or (FreeMem < MinFree) then begin
				if h <> nil then
					DisposHandle(h);
				PutMemoryAlert;
				DisposPtr(pointer(Info));
				Info := SaveInfo;
				GetImageMemory := nil;
				exit(GetImageMemory);
			end;
		PicBaseHandle := h;
		hlock(PicBaseHandle);
		GetImageMemory := StripAddress(PicBaseHandle^);
	end;


	function OldGetMemory (Size: LongInt; SaveInfo: infoPtr; var PicBaseHandle: handle): ptr;
		const
			MinFree = 100000;
		var
			h1, h2: handle;
	begin
		h1 := NewHandle(size);
		h2 := NewHandle(MinFree);
		if (h1 = nil) or (h2 = nil) then begin
				if h1 <> nil then
					DisposHandle(h1);
				if h2 <> nil then
					DisposHandle(h2);
				CompactMemory;
				h1 := NewHandle(size);
				h2 := NewHandle(MinFree);
			end;
		if (h1 = nil) or (h2 = nil) then begin
				if h1 <> nil then
					DisposHandle(h1);
				if h2 <> nil then
					DisposHandle(h2);
				PutMemoryAlert;
				DisposPtr(pointer(Info));
				Info := SaveInfo;
				OldGetMemory := nil;
				exit(OldGetMemory);
			end;
		DisposHandle(h2);
		PicBaseHandle := h1;
		hlock(PicBaseHandle);
		OldGetMemory := PicBaseHandle^;
	end;


	procedure UpdateAnalysisMenu;
		var
			ShowItems: boolean;
			i: integer;
	begin
		ShowItems := Info <> NoInfo;
		SetMenuItem(AnalyzemenuH, MeasureItem, ShowItems);
		SetMenuItem(AnalyzemenuH, AnalyzeItem, ShowItems);
		SetMenuItem(AnalyzemenuH, HistogramItem, ShowItems);
		SetMenuItem(AnalyzemenuH, PlotItem, ShowItems);
		SetMenuItem(AnalyzemenuH, Plot3DItem, ShowItems);
		SetMenuItem(AnalyzemenuH, RedoItem, mCount > 0);
		SetMenuItem(AnalyzemenuH, DeleteItem, mCount > 0);
		SetMenuItem(AnalyzemenuH, RestoreItem, ShowItems and (NoInfo^.RoiType <> NoRoi));
		SetMenuItem(AnalyzemenuH, MarkItem, info^.RoiShowing);
	end;


	procedure ExtendWindowsMenu;{(fname:str255; size:LongInt; wptr:WindowPtr)}
		var
			str, SizeStr: str255;
	begin
		if nPics < MaxPics then begin
				nPics := nPics + 1;
				PicWindow[nPics] := wptr;
				NumToString(size div 1024, SizeStr);
				str := concat(fname, '  ', SizeStr, 'K');
				AppendMenu(WindowsMenuH, ' ');
				SetItem(WindowsMenuH, nPics + WindowsMenuItems, str);
				InsertMenu(WindowsMenuH, 0);
			end;
	end;


	procedure InvertGrayLevels;
	begin
		with info^ do begin
				calibrated := true;
				nCoefficients := 2;
				fit := StraightLine;
				Coefficient[1] := 255.0;
				Coefficient[2] := -1.0
			end;
	end;


	procedure MakeNewWindow;{(name:str255)}
		var
			wwidth, wheight, wleft, wtop, i: integer;
			tPort: GrafPtr;
			rgb: RGBColor;
			err: OSErr;
	begin
		with Info^ do begin
				wleft := PicLeft;
				wtop := PicTop;
				PicLeft := PicLeft + hPicOffset;
				PicTop := PicTop + vPicOffset;
				if ((PicLeft + round(0.75 * PixelsPerLine)) > ScreenWidth) or ((PicTop + round(0.75 * nlines)) > ScreenHeight) then begin
						PicLeft := PicLeftBase;
						PicTop := PicTopBase;
					end;
				wwidth := PixelsPerLine;
				if (wleft + wwidth) > ScreenWidth then
					wwidth := ScreenWidth - wleft - 5;
				wheight := nlines;
				if (wtop + wheight) > ScreenHeight then
					wheight := ScreenHeight - wtop - 5;
				SetRect(wrect, wleft, wtop, wleft + wwidth, wtop + wheight);
				wptr := NewCWindow(nil, wrect, name, true, DocumentProc + ZoomDocProc, nil, true, 0);
				GetPort(tPort);
				SetPort(wptr);
				SetPalette(wptr, ExplicitPalette, false);
				pmForeColor(BlackIndex);
				pmBackColor(WhiteIndex);
				SetRect(wrect, 0, 0, wwidth, wheight);
				SetRect(PicRect, 0, 0, PixelsPerLine, nlines);
				SelectWindow(wptr);
				WindowPeek(wptr)^.WindowKind := PicKind;
				WindowPeek(wptr)^.RefCon := ord4(Info);
				title := name;
				ExtendWindowsMenu(name, ImageSize, wptr);
				PicNum := nPics;
				new(osPort);
				OpenCPort(osPort);
				with osPort^ do begin
						with PortPixMap^^ do begin
								BaseAddr := PicBaseAddr;
								bounds := PicRect;
							end;
						PortRect := PicRect;
						RectRgn(visRgn, PicRect);
						PortPixMap^^.RowBytes := BitOr(BytesPerRow, $8000);
					end;
				SetPalette(WindowPtr(osPort), ExplicitPalette, false);
				pmForeColor(ForegroundIndex);
				pmBackColor(BackgroundIndex);
				SetPort(tPort);
				SrcRect := wrect;
				magnification := 1.0;
				RoiShowing := false;
				roiType := NoRoi;
				initwrect := wrect;
				savewrect := wrect;
				SaveSrcRect := SrcRect;
				SaveMagnification := magnification;
				savehloc := wleft;
				savevloc := wtop;
				roiRgn := NewRgn;
				NewPic := true;
				ScaleToFitWindow := false;
				OpPending := false;
				Changes := false;
				WindowState := NormalWindow;
				if not Calibrated and UseZeroForBlack then
					InvertGrayLevels;
				Revertable := false;
			end;
		WhatToUndo := NothingToUndo;
	end;


	procedure MakeRegion;
	begin
		with info^ do begin
				OpenRgn;
				case RoiType of
					OvalRoi: 
						FrameOval(RoiRect);
					RoundRectRoi: 
						FrameRoundRect(RoiRect, OvalSize, OvalSize);
					RectRoi: 
						FrameRect(RoiRect);
					otherwise
				end;
				CloseRgn(roiRgn)
			end;
	end;


	procedure SelectAll;{(visible:boolean)}
		var
			loc: point;
			tPort: GrafPtr;
	begin
		KillRoi;
		with Info^ do begin
				RoiType := RectRoi;
				RoiRect := PicRect;
				MakeRegion;
				if visible then begin
						SetupUndo;
						WhatToUndo := NothingToUndo;
						RoiShowing := true;
						if (magnification > 1.0) and not ScaleToFitWindow then
							Unzoom;
						PreviousTool := CurrentTool;
						CurrentTool := SelectionTool;
						isSelectionTool := true;
						GetPort(tPort);
						SetPort(ToolWindow);
						EraseRect(ToolRect[PreviousTool]);
						EraseRect(ToolRect[CurrentTool]);
						InvalRect(ToolRect[PreviousTool]);
						InvalRect(ToolRect[CurrentTool]);
						SetPort(tPort);
					end;
				IsInsertionPoint := false;
				measuring := false;
			end; {with}
	end;


	procedure KillOperation;
	begin
		if OpPending then
			with info^ do
				if info <> NoInfo then begin
						DoOperation(CurrentOp);
						RoiShowing := false;
						UpdateScreen(RoiRect);
						OpPending := false;
					end;
	end;


	function NewPicWindow;{(name:str255; width,height:integer):boolean}
		var
			iptr: ptr;
			lptr: ^LongInt;
			SaveInfo: InfoPtr;
			NeededSize: LongInt;
	begin
		NewPicWindow := false;
		KillOperation;
		DisableDensitySlice;
		SaveInfo := Info;
		iptr := NewPtr(SizeOf(PicInfo));
		if iptr = nil then begin
				DisposPtr(iptr);
				PutMemoryAlert;
				exit(NewPicWindow);
			end;
		Info := pointer(iptr);
		info^ := SaveInfo^;
		with Info^ do begin
				nlines := height;
				PixelsPerLine := width;
				if name = 'Camera' then begin
						PictureType := QuickCaptureType;
						QuickCaptureInfo := info;
					end;
				PicBaseAddr := GetImageMemory(SaveInfo, PicBaseHandle, false);
				if PicBaseAddr = nil then
					exit(NewPicWindow);
				PicLeft := PicLeftBase;
				PicTop := PicTopBase;
				MakeNewWindow(name);
				if name <> 'Camera' then
					PictureType := NewPicture;
				SelectAll(false);
				DoOperation(EraseOp);
				RoiType := NoRoi;
				changes := false;
				BinaryPic := false;
			end;
		NewPicWindow := true;
	end;


	procedure EraseScreen;
	begin
		SetPort(GrafPtr(CScreenPort));
		with CScreenPort^ do begin
				HideCursor;
				pmBackColor(BackgroundIndex);
				EraseRect(portPixMap^^.Bounds);
				pmBackColor(WhiteIndex);
			end;
	end;


	procedure RestoreScreen;
		var
			GrayRgn: RgnHandle;
			rptr: rhptr;
			wp: ^WindowPtr;
	begin
		rptr := rhptr(GrayRgnGlobal);
		GrayRgn := rptr^;
		wp := pointer(GhostWindow);
		wp^ := WindowPtr(nil);
		PaintBehind(WindowPeek(FrontWindow), GrayRgn);
		wp^ := PasteControl;
		DrawMenuBar;
	end;


	procedure ScaleToFit;
		var
			trect: rect;
	begin
		if digitizing then
			exit(ScaleToFit);
		if info <> NoInfo then
			with info^ do begin
					ScaleToFitWindow := not ScaleToFitWindow;
					KillRoi;
					if ScaleToFitWindow then begin
							savewrect := wrect;
							SaveSrcRect := SrcRect;
							SaveMagnification := magnification;
							GetWindowRect(wptr, trect);
							savehloc := trect.left;
							savevloc := trect.top;
							wrect := wptr^.PortRect;
							SrcRect := PicRect;
							ScaleImageWindow(wrect);
							SizeWindow(wptr, wrect.right, wrect.bottom, true);
						end
					else begin
							if WindowState = TiledBigScaled then begin
									wrect := initwrect;
									SrcRect := wrect;
									magnification := 1.0;
									WindowState := NormalWindow;
								end
							else begin
									wrect := savewrect;
									SrcRect := SaveSrcRect;
									magnification := SaveMagnification;
								end;
							HideWindow(wptr);
							SizeWindow(wptr, wrect.right, wrect.bottom, true);
							MoveWindow(wptr, savehloc, savevloc, true);
							ShowWindow(wptr);
							ShowMagnification;
						end;
					SetPort(wptr);
					InvalRect(wrect);
					WindowState := NormalWindow;
				end;
	end;


	procedure DrawMyGrowIcon;{(w:WindowPtr)}
		var
			tPort: GrafPtr;
			tRect: rect;
	begin
		GetPort(tPort);
		SetPort(w);
		PenNormal;
		with w^.PortRect do begin
				SetRect(tRect, right - 12, bottom - 12, right - 5, bottom - 5);
				FrameRect(tRect);
				MoveTo(right - 6, bottom - 10);
				LineTo(right - 2, bottom - 10);
				LineTo(right - 2, bottom - 2);
				LineTo(right - 10, bottom - 2);
				LineTo(right - 10, bottom - 6);
			end;
		SetPort(tPort);
	end;


	procedure ShowMagnification;
    {Updates the window title bar to show the current magnification.}
		var
			str: str255;
	begin
		with info^ do begin
				if (magnification = 1.0) and not ScaleToFitWindow then
					str := title
				else begin
						if ScaleToFitWindow then begin
								RealToString(magnification, 1, 2, str);
								str := concat(title, ' (', str, ')');
							end
						else begin
								RealToString(magnification, 1, 0, str);
								str := concat(title, ' (', str, ':1)');
							end;
					end;
				SetWTitle(wptr, str);
			end;
	end;


	procedure Unzoom;
	begin
		if Info <> NoInfo then
			with Info^ do begin
					if ScaleToFitWindow then
						ScaleToFit
					else begin
							wrect := initwrect;
							SrcRect := wrect;
						end;
					SizeWindow(wptr, wrect.right, wrect.bottom, true);
					LoadLUT(info^.cTable);
					UpdatePicWindow;
					magnification := 1.0;
					DrawMyGrowIcon(wptr);
					ShowMagnification;
					if WhatToUndo = UndoZoom then
						WhatToUndo := NothingToUndo;
					ShowRoi;
				end;
	end;


	function FindMedian;{(VAR a:SortArray):integer}
  {Finds the 5th largest of 9 values}
		var
			i, j, mj, max: integer;
	begin
		for i := 1 to 4 do begin
				max := 0;
				mj := 1;
				for j := 1 to 9 do
					if a[j] > max then begin
							max := a[j];
							mj := j;
						end;
				a[mj] := 0;
			end;
		max := 0;
		for j := 1 to 9 do
			if a[j] > max then
				max := a[j];
		FindMedian := max;
	end;


	procedure DrawBString;{(str:string)}
	begin
		TextFace([bold]);
		DrawString(str);
		TextFace([]);
	end;


	procedure PutWarning;
		var
			BufSizeStr: str255;
	begin
		NumToString(UndoBufSize div 1024, BufSizeStr);
		PutMessage(concat('This image is larger than the ', BufSizeStr, 'K Undo buffer. Many operations may fail or be Undoable.'));
	end;


	procedure SetupRoiRect;
{Copies the current image to Undo buffer so it can be used for drawing}
{the "marching ants". The copy of the previous image in the Clipboard buffer}
{ buffer will be used for Undo.}
	begin
		SetupUndo;
		UndoFromClip := true;
		info^.RoiShowing := true;
	end;


	procedure GetForegroundColor;{(event: EventRecord)}
		var
			loc: point;
			color: integer;
	begin
		loc := event.where;
		ScreenToOffScreen(loc);
		Color := MyGetPixel(loc.h, loc.v);
		SetForegroundColor(color);
	end;


	procedure GetBackgroundColor; {(event: EventRecord)}
		var
			loc: point;
			color: integer;
	begin
		loc := event.where;
		ScreenToOffScreen(loc);
		Color := MyGetPixel(loc.h, loc.v);
		SetBackgroundColor(color);
	end;


	procedure GenerateValues;
		var
			a, b, c, d, e, f, x, y: extended;
			i: integer;
	begin
		with info^ do begin
				if not calibrated then begin
						for i := 0 to 255 do
							cvalue[i] := i;
						MinValue := 0.0;
						MaxValue := 255.0;
						exit(GenerateValues);
					end;
				a := Coefficient[1];
				b := Coefficient[2];
				c := Coefficient[3];
				d := Coefficient[4];
				e := Coefficient[5];
				f := Coefficient[6];
				MinValue := 10e+12;
				MaxValue := -MinValue;
				for i := 0 to 255 do begin
						x := i;
						case fit of
							StraightLine: 
								y := a + b * x;
							Poly2: 
								y := a + b * x + c * x * x;
							Poly3: 
								y := a + b * x + c * x * x + d * x * x * x;
							Poly4: 
								y := a + b * x + c * x * x + d * x * x * x + e * x * x * x * x;
							Poly5: 
								y := a + b * x + c * x * x + d * x * x * x + e * x * x * x * x + f * x * x * x * x * x;
							ExpoFit: 
								y := a * exp(b * x);
							PowerFit: 
								if x = 0.0 then
									y := 0.0
								else
									y := a * exp(b * ln(x)); {y=ax^b}
							LogFit: 
								begin
									if x = 0.0 then
										x := 0.000001;
									y := a * ln(b * x)
								end;
							RodbardFit: 
								begin
									if x <= a then
										y := 0
									else begin
											y := (a - x) / (x - d);
											y := exp(ln(y) * (1 / b));  {y:=y**(1/b)}
											y := y * c;
										end;
								end;
						end;
						cvalue[i] := y;
						if y > MaxValue then
							MaxValue := y;
						if y < MinValue then
							MinValue := y;
					end;
			end;
	end;


	procedure ScaleImageWindow (var trect: rect);
		var
			WindowLeft, WindowTop: integer;
			PicAspectRatio, TempMagnification: extended;
	begin
		with info^ do begin
				SrcRect := PicRect;
				with CGrafPort(wptr^).PortPixMap^^.bounds do begin
						WindowLeft := -left;
						WindowTop := -top;
					end;
				with PicRect do
					PicAspectRatio := right / bottom;
				with trect do begin
						if (WindowLeft + right) > (ScreenWidth - 5) then
							right := ScreenWidth - 5 - WindowLeft;
						bottom := round(right / PicAspectRatio);
						if (WindowTop + bottom) > (ScreenHeight - 5) then
							bottom := ScreenHeight - 5 - WindowTop;
						right := round(bottom * PicAspectRatio);
						magnification := right / PicRect.right;
					end;
				ShowMagnification;
			end; {with}
	end;


	function TooWide: boolean;
		var
			SelectionTooWide: boolean;
			MaxWidth: str255;
	begin
		with info^.RoiRect do
			SelectionTooWide := (right - left) > MaxPixelsPerLine;
		if SelectionTooWide then begin
				NumToString(MaxPixelsPerLine, MaxWidth);
				PutMessage(concat('This operation does not support selections wider than ', MaxWidth, ' pixels.'));
			end;
		TooWide := SelectionTooWide;
	end;


	procedure DrawText (str: str255; loc: point; just: integer);
		var
			SaveJust: integer;
	begin
		TextStr := str;
		IsInsertionPoint := true;
		TextStart := loc;
		SaveJust := TextJust;
		TextJust := just;
		DisplayText(false);
		TextJust := SaveJust;
		IsInsertionPoint := false;
	end;


	procedure IncrementCounter;
	begin
		if mCount < MaxRegions then begin
				mCount := mCount + 1;
				UnsavedResults := true;
			end
		else
			beep;
	end;


	procedure ClearResults (i: integer);
	begin
		mean^[i] := 0.0;
		sd^[i] := 0.0;
		PixelCount^[i] := 0;
		mArea^[i] := 0.0;
		mode^[i] := 0.0;
		IntegratedDensity^[i] := 0.0;
		idBackground^[i] := 0.0;
		xcenter^[i] := 0.0;
		ycenter^[i] := 0.0;
		MajorAxis^[i] := 0.0;
		MinorAxis^[i] := 0.0;
		orientation^[i] := 0.0;
		mMin^[i] := 0.0;
		mMax^[i] := 0.0;
		plength^[i] := 0.0;
	end;

	procedure UpdateFitEllipse;
	begin
		FitEllipse := (xyLocM in measurements) or (MajorAxisM in measurements) or (MinorAxisM in measurements) or (AngleM in measurements);
	end;
end.