unit Utilities;

{Miscellaneous utility routines used by Image program}

interface

	uses
		QuickDraw, PaletteMgr, ToolIntf, OSIntf, PickerIntf, 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 (var str: str255): extended;
	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 CommandKeyDown: boolean;	{ Arlo }
	function ControlKeyDown: boolean;
	function CommandPeriod: boolean;
	function SpaceBarDown: boolean;

	procedure SysResume;
	procedure beep;
	procedure PutMessage (str: str255);
	procedure UpdateTextMenu;
	procedure RedrawCLUTWindow;
	procedure Load256ColorCLUT;
	function LoadCLUTResource (id: integer): boolean;
	procedure UnprotectLUT;
	procedure LoadLUT (table: MyCSpecArray);
	procedure DrawThreshold (OptionKey: boolean);
	procedure StartThresholding;
	procedure StopThresholding;
	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;
	procedure SetRGBForeColor (fRGB: rgbColor; fIndex: integer);
	procedure SetRGBBackColor (bRGB: rgbColor; bIndex: integer);
	procedure SetForegroundColor (color: integer);
	procedure SetBackgroundColor (color: integer);
	procedure ScreenToOffscreen (var loc: point);
	procedure OffscreenToScreen (var loc: point);
	procedure OffScreenToScreenRect (var r: rect);
	procedure ScreenToOffScreenRect (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;
	function GetResultsType: ResultsType;
	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 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 PutOutOfMemMsg;
	function GetMemory (Size: LongInt): ptr;
	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;
{$IFC Arlo }
	function IsPowerOf2 (x: integer): boolean;
	function pOf2 (x: integer): integer;
{ pOf2 takes an integer x and returns the greatest integer less}
{ than or equal to (in absolute value) x that is a power of 2.}
{ i.e. pOf2(-17) = -16 and pOf2(31) = 16 }
	inline
		$4E56, $0000,				{				LINK		A6, #0					;					}
		$48E7, $E000,				{				MOVEM.L	UsedRegs, -(SP)			;					}
		$4242,						{				CLR.W		D2							; D2: sign flag	}
		$302E, $0004,				{  				MOVE.W	x(A6), D0				; D0: x			}
		$6C06,						{				BGE.S		NotNeg					;					}
		$4440, 						{				NEG.W		D0							; D0: abs(x)		}
		$343C, $0001,				{    			MOVE.W	#1, D2					;					}
		$323C, $000F,				{   NotNeg		MOVE.W	#15, D1					;					}
		$0300,						{	logLoop	BTST.L	D1, D0					;					}
		$56C9, $FFFC,				{ 				DBNE.W	D1, logLoop				;					}
		$4240,						{				CLR.W		D0							;					}
		$03C0,						{				BSET.L	D1, D0					;					}
		$4A42,						{				TST.W		D2							;					}
		$6702,						{				BEQ.S		exit						;					}
		$4440,						{				NEG.W		D0							;					}
		$3D40, $0006,				{  exit			MOVE.W	D0, result(A6)			;					}
		$4CDF, $0007,				{     			MOVEM.L	(SP)+, UsedRegs		;					}
		$4E5E,							{				UNLK		A6							;					}
		$544F;						{				ADDQ.W	#2, SP					;					}
{$ENDC }


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 (var str: str255): extended;
		const
			BadReal = 999999.999;
		var
			i, ndigits, StringLength: integer;
			c: char;
			n, m: extended;
			negative, LeftOfPoint, finished: boolean;
	begin
		negative := false;
		n := 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;
		delete(str, 1, i);
		StringToReal := n;
	end;


	function GetDReal;{(TheDialog:DialogPtr; item:integer):extended}
		var
			ItemType: integer;
			ItemBox: rect;
			ItemHdl: handle;
			str: str255;
	begin
		GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
		GetIText(ItemHdl, str);
		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
		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 CommandKeyDown: boolean;	{ Arlo }
		var
			KeyPtr: KeyPtrType;
			keys: array[0..3] of LongInt;
	begin
		KeyPtr := KeyPtrType(@keys);
		GetKeys(KeyPtr^);
		CommandKeyDown := (BAND(keys[1], 32768)) <> 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(MessageID, nil);
	end;

	function GetFontSize;{(item:integer):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 := 42;
			9: 
				GetFontSize := 48;
			10: 
				GetFontSize := 54;
			11: 
				GetFontSize := 72;
		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;
	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 11 do
			begin
				size := GetFontSize(i);
				if RealFont(CurrentFontID, size) then
					SetItemStyle(SizeMenuH, i, [OutLine])
				else
					SetItemStyle(SizeMenuH, i, [])
			end;

		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;
			42: 
				MenuItem := 8;
			48: 
				MenuItem := 9;
			54: 
				MenuItem := 10;
			72: 
				MenuItem := 11;
		end;
		CheckOnOffItem(SizeMenuH, MenuItem, 1, 11);

		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 RedrawCLUTWindow;
	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
		StopThresholding;
		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}
		var
			Size: LongInt;
			h: cTabHandle;
			MyColorTable: record
					ctSeed: LONGINT;
					transIndex: INTEGER;
					ctSize: INTEGER;
					ctTable: MyCSpecArray;
				end;
	begin
		StopThresholding;
		h := GetCTable(id);
		size := GetHandleSize(handle(h));
{ Arlo - klugy fix: the AppleDefaultCLUT IIcx/IIci (512K roms?) is 2068 bytes big }
		if (ResError <> NoErr) or ((size <> 2056) and (id <> AppleDefaultCLUT)) then
			begin
				LoadCLUTResource := false;
				if id = PixelpaintID then
					begin
						if LoadPP2Palette then
							LoadCLUTResource := true;
					end;
				if h <> nil then
					DisposCTable(h);
				exit(LoadCLUTResource)
			end;
		size := 2056; { Arlo }
		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 DrawThreshold (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 >= ThresholdStart) and (i <= ThresholdEnd) then
							cTable[i].rgb := ThresholdColor
						else
							ctable[i].rgb := SaveCTable^[i].rgb;
				LoadLUT(cTable);
			end;
	end;


	procedure StartThresholding;
		var
			tPort: GrafPtr;
	begin
		if not Thresholding then
			begin
				new(SaveCTable);
				if SaveCTable <> nil then
					begin
						SaveCTable^ := info^.ctable;
						DrawThreshold(false);
						Thresholding := true;
					end;
				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;
	end;


	procedure StopThresholding;
	begin
		if Thresholding then
			begin
				Thresholding := 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;
		StopThresholding;
		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 LoadInputLookupTable;{(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 Thresholding then
					begin
						for i := 0 to 255 do
							if (i >= ThresholdStart) and (i <= ThresholdEnd) 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;
						StopThresholding;
						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) > 255 then
				begin
					ColorWidth := (255 - 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;
		var
			tPort: GrafPtr;
			i, hstart, width, ff: integer;
			MaskRect: rect;
			p1, p2: point;
	begin
		if (info = NoInfo) or (CurrentTool <> TextTool) or (not IsInsertionPoint) then
			exit(DisplayText);
		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;
		OffscreenToScreen(p1);
		OffscreenToScreen(p2);
		Pt2Rect(p1, p2, MaskRect);
		UpdateScreen(MaskRect);
		SetPort(tPort);
		Info^.changes := true;
	end;


	procedure SetRGBForeColor (fRGB: rgbColor; fIndex: integer);
	begin
		with info^ do
			if osPort <> nil then
				with osPort^ do
					begin
						rgbFgColor := fRGB;
						fgColor := fIndex;
					end;
	end;


	procedure SetRGBBackColor (bRGB: rgbColor; bIndex: integer);
	begin
		with info^ do
			if osPort <> nil then
				with osPort^ do
					begin
						rgbBkColor := bRGB;
						bkColor := bIndex;
					end;
	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;
					ForegroundRGB := cTable[ForegroundIndex].rgb;
					if ForegroundIndex = 0 then
						ForegroundRGB := WhiteRGB;
					if ForegroundIndex = 255 then
						ForegroundRGB := BlackRGB;
					if nExtraColors > 0 then
						begin
							if (ForegroundIndex >= FirstExtraColorsEntry) and (ForegroundIndex < (FirstExtraColorsEntry + nExtraColors)) then
								ForegroundRGB := ExtraColors[ForegroundIndex - FirstExtraColorsEntry + 1];
						end;
					SetPort(GrafPtr(osPort));
					SetRGBForeColor(ForegroundRGB, ForegroundIndex);
					SetPort(tPort);
					if isInsertionPoint then
						DisplayText;
				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]);
					BackgroundRGB := cTable[BackgroundIndex].rgb;
					if BackgroundIndex = 0 then
						BackgroundRGB := WhiteRGB;
					if BackgroundIndex = 255 then
						BackgroundRGB := BlackRGB;
					if nExtraColors > 0 then
						begin
							if (BackgroundIndex >= FirstExtraColorsEntry) and (BackgroundIndex < (FirstExtraColorsEntry + nExtraColors)) then
								BackgroundRGB := ExtraColors[BackgroundIndex - FirstExtraColorsEntry + 1];
						end;
					SetPort(GrafPtr(osPort));
					SetRGBBackColor(BackgroundRGB, BackgroundIndex);
					SetPort(tPort);
					if isInsertionPoint then
						DisplayText;
				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 ScreenToOffscreenRect (var r: rect);
		var
			p1, p2: point;
	begin
		with r do
			begin
				p1.h := left;
				p1.v := top;
				p2.h := right;
				p2.v := bottom;
				ScreenToOffscreen(p1);
				ScreenToOffscreen(p2);
				Pt2Rect(p1, p2, r);
			end;
	end;


	procedure ScreenToOffscreen;{(VAR loc:point) moved here from Edit.p for consistency - Arlo }
	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. MaskRect is defined in screen coordinates.}
		var
			tPort: GrafPtr;
			imag: integer;
	begin
		with Info^ do
			if info <> NoInfo then
				begin
					getPort(tPort);
					SetPort(wptr);
					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(ThePort^).PortPixMap));
					CopyBits(BitMapHandle(osPort^.PortPixMap)^^, BitMapHandle(CGrafPort(ThePort^).PortPixMap)^^, SrcRect, wrect, SrcCopy, MaskRgn);
					hunlock(handle(osPort^.portPixMap));
					hunlock(handle(CGrafPort(ThePort^).PortPixMap));
					SetPort(tPort);
				end;
	end;


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


	procedure Undo;
		var
			SrcPtr: ptr;
			line: integer;
	begin
		if info^.PicSize <> CurrentUndoSize then
			exit(Undo);
		if UndoFromClip then
			begin
				if info^.PicSize > ClipBufSize then
					exit(Undo);
				SrcPtr := ClipBuf;
			end
		else
			SrcPtr := UndoBuf;
		with info^ do
			BlockMove(SrcPtr, PicBaseAddr, PicSize);
		if UndoFromClip and RestoreUndoBuf then
			with info^ do
				BlockMove(SrcPtr, UndoBuf, PicSize);
		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
		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
		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(value[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(value[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;
		var
			i: integer;
	begin
		if not printing then
			PutChar(tab)
		else
			begin
				for i := 1 to TabSpacing - TextBufColumn mod TabSpacing do
					PutChar(' ');
			end;
	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 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 printing and (LeadingSpaces > 0) then
			str := concat(copy('            ', 1, LeadingSpaces), str);
		PutString(str);
	end;

	procedure CopyResultsToBuffer;
		var
			i, column, nColumns: integer;
			TypeOfResults: ResultsType;
			m: MeasurementTypes;
			DisplayHeadings: boolean;

		procedure PutSequenceNumber;
		begin
			PutLong(i, 8);
			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 <> nColumns then
				PutTab;
		end;

	begin
		DisplayHeadings := printing or OptionKeyDown;
		TypeOfResults := GetResultsType;
		if TypeOfResults <> NoResults then
			begin
				TextBufSize := 0;
				TextBufColumn := 0;
				TextBufLineCount := 0;
				case TypeOfResults of
					LengthT: 
						begin
							if DisplayHeadings then
								begin
									PutTab;
									PutString(' Length');
									PutUnits;
								end;
							for i := 1 to nLengths do
								begin
									if DisplayHeadings then
										PutSequenceNumber;
									PutReal(lengths[i], 9, precision);
									PutChar(cr);
								end;
							if not ShowingLIst then
								UnsavedLengths := 0;
						end;
					AreaT: 
						with info^, MeasurementsP^ do
							begin
								nMeasurements := 0;
								if DisplayHeadings then
									begin
										PutTab;
										if AreaM in measurements then
											begin
												PutString('       Area');
												PutTab;
												nMeasurements := nMeasurements + 1
											end;
										if MeanM in measurements then
											begin
												PutString('       Mean');
												PutTab;
												nMeasurements := nMeasurements + 1
											end;
										if StdDevM in measurements then
											begin
												PutString('       S.D.');
												PutTab;
												nMeasurements := nMeasurements + 1
											end;
										if xyLocM in measurements then
											begin
												PutString('         X');
												PutTab;
												PutString('         Y');
												PutTab;
												nMeasurements := nMeasurements + 2
											end;
										if ModeM in measurements then
											begin
												PutString('       Mode');
												PutTab;
												nMeasurements := nMeasurements + 1
											end;
										if PerimeterM in measurements then
											begin
												PutString('  Perimeter');
												PutTab;
												nMeasurements := nMeasurements + 1
											end;
										if MinorAxisM in measurements then
											begin
												PutString('      Minor');
												PutTab;
												nMeasurements := nMeasurements + 1
											end;
										if MajorAxisM in measurements then
											begin
												PutString('      Major');
												PutTab;
												nMeasurements := nMeasurements + 1
											end;
										if AngleM in measurements then
											begin
												PutString('      Angle');
												PutTab;
												nMeasurements := nMeasurements + 1
											end;
										if IntDenM in measurements then
											begin
												PutString('   Int.Den.');
												PutTab;
												nMeasurements := nMeasurements + 1
											end;
										PutChar(cr);
										PutChar(cr);
									end;
								nColumns := 0;
								for m := AreaM to IntDenM do
									if m in Measurements then
										nColumns := nColumns + 1;
								for i := 1 to nRegions do
									begin
										column := 0;
										if DisplayHeadings then
											PutSequenceNumber;
										if AreaM in measurements then
											begin
												if SpatialScale <> 0.0 then
													PutReal(PixelCount[i] / sqr(SpatialScale), 11, precision)
												else
													PutReal(PixelCount[i], 11, 0);
												PutTabDelimeter;
											end;
										if MeanM in measurements then
											begin
												PutReal(mean[i], 11, precision);
												PutTabDelimeter;
											end;
										if StdDevM in measurements then
											begin
												PutReal(SD[i], 11, precision);
												PutTabDelimeter;
											end;
										if xyLocM in measurements then
											begin
												PutReal(xcenter[i], 11, precision);
												PutTab;
												PutReal(ycenter[i], 11, precision);
												PutTabDelimeter;
											end;
										if ModeM in measurements then
											begin
												PutReal(Mode[i], 11, precision);
												PutTabDelimeter;
											end;
										if PerimeterM in measurements then
											begin
												PutReal(plength[i], 11, precision);
												PutTabDelimeter;
											end;
										if MinorAxisM in measurements then
											begin
												PutReal(MinorAxis[i], 11, precision);
												PutTabDelimeter;
											end;
										if MajorAxisM in measurements then
											begin
												PutReal(MajorAxis[i], 11, precision);
												PutTabDelimeter;
											end;
										if AngleM in measurements then
											begin
												PutReal(orientation[i], 11, precision);
												PutTabDelimeter;
											end;
										if IntDenM in measurements then
											begin
												PutReal(IntegratedDensity[i], 11, precision);
												PutTabDelimeter;
											end;
										PutChar(cr);
									end;
								if not ShowingLIst then
									UnsavedAreas := 0;
							end;
					PointT: 
						begin
							if DisplayHeadings then
								begin
									PutTab;
									PutString('      X');
									PutTab;
									PutString('      Y  ');
									PutUnits;
								end;
							for i := 1 to nPoints do
								with info^ do
									begin
										if DisplayHeadings then
											PutSequenceNumber;
										if SpatialScale = 0.0 then
											begin
												PutLong(xLoc[i], 7);
												PutTab;
												PutLong(yLoc[i], 7);
											end
										else
											begin
												PutReal(xLoc[i] / SpatialScale, 9, precision);
												PutTab;
												PutReal(yLoc[i] / SpatialScale, 9, precision);
											end;
										PutChar(cr);
									end;
							if not ShowingLIst then
								UnsavedPoints := 0;
						end;
					otherwise
						;
				end; {case}
			end;
	end;


	function GetResultsType;{:ResultsType}
	begin
		if (CurrentTool = ruler) and (nLengths > 0) then
			GetResultsType := LengthT
		else if (CurrentTool = PointingTool) and (nPoints > 0) then
			GetResultsType := PointT
		else if nRegions > 0 then
			GetResultsType := AreaT
		else
			GetResultsType := NoResults;
	end;


	procedure ShowWatch;
	begin
		SetCursor(watch);
	end;


	procedure UpdatePicWindow;
		var
			tPort: GrafPtr;
	begin
		with Info^ do
			begin
				getPort(tPort);
				SetPort(wptr);
				hlock(handle(osPort^.portPixMap));
				hlock(handle(CGrafPort(ThePort^).PortPixMap));
				CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPort(ThePort^).PortPixMap)^^, SrcRect, wrect, SrcCopy, nil);
				hunlock(handle(osPort^.portPixMap));
				hunlock(handle(CGrafPort(ThePort^).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(osroiRgn);
					PaintOp: 
						PaintRgn(osroiRgn);
					FrameOp: 
						FrameRgn(osroiRgn);
					EraseOp: 
						EraseRgn(osroiRgn);
					PasteOp: 
						Paste;
					otherwise
				end;
				if not RoiShowing then
					UpdateScreen(RoiRect);
				if PicSize > 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;
					NoInfo^.osRoiRect := osRoiRect;
					CopyRgn(osRoiRgn, NoInfo^.osRoiRgn);
				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
						SetRGBForeColor(BlackRGB, BlackIndex);
						SetRGBBackColor(WhiteRGB, WhiteIndex);
					end;
				srcPort := ClipBufInfo^.osPort;
				if PasteMode = PasteFromCamera then
					if (QuickCaptureInfo = nil) or (PictureType = QuickCaptureType) then
						PasteMode := NormalPaste
					else
						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^.osRoiRect, osRoiRect, PasteTransferMode, osRoiRgn);
				hunlock(handle(srcPort^.portPixMap));
				hunlock(handle(osPort^.PortPixMap));
				if PasteTransferMode = SrcCopy then
					begin
						SetRGBForeColor(ForegroundRGB, ForegroundIndex);
						SetRGBBackColor(BackgroundRGB, BackgroundIndex);
					end;
			end;
	end;


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


	procedure SetupUndo;
		var
			line: integer;
	begin
		if info = NoInfo then
			begin
				CurrentUndoSize := 0;
				exit(SetupUndo)
			end;
		if info^.PicSize > UndoBufSize then
			begin
				CurrentUndoSize := 0;
				WhatToUndo := NothingToUndo;
				exit(SetupUndo)
			end;
		with info^ do
			begin
				if OpPending then
					begin
						DoOperation(CurrentOp);
						OpPending := false;
					end;
				CurrentUndoSize := PicSize;
				BlockMove(PicBaseAddr, UndoBuf, PicSize);
				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^.PicSize > ClipBufSize then
			begin
				CurrentUndoSize := 0;
				WhatToUndo := NothingToUndo;
				exit(SetupUndoFromClip)
			end;
		with info^ do
			begin
				if OpPending then
					begin
						DoOperation(CurrentOp);
						OpPending := false;
					end;
				CurrentUndoSize := PicSize;
				BlockMove(PicBaseAddr, ClipBuf, PicSize);
			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
			PutMessage('Please use the Selection Tool to make a selection or use the Select All command.');
		NoSelection := not Info^.RoiShowing;
	end;


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


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



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


	function GetMemory;{(Size:LongInt):ptr}
		const
			MinFree = 100000;
		var
			p, p2: ptr;

		procedure abort;
		begin
			if p <> nil then
				DisposPtr(p);
			DisposPtr(pointer(Info));
			Info := SaveInfo;
			PutOutOfMemMsg;
			GetMemory := nil;
			exit(GetMemory);
		end;

	begin
		p2 := nil;
		p := NewPtr(Size);
		if p = nil then
			abort;
		p2 := NewPtr(MinFree);
		if p2 = nil then
			abort;
		DisposPtr(p2);
		GetMemory := p;
	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 MakeNewWindow;{(name:str255)}
		const
			FFTDocProc = 32;			{ ID of WDEF 2 - Arlo }
		var
			wwidth, wheight, wleft, wtop, i, myWID: integer; { Arlo }
			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);
{$IFC Arlo }
				if InFrequencyDomain then			{ Flag by which Window Type is determined - a little kludgy }
					myWID := FFTDocProc + ZoomDocProc
				else
					myWID := DocumentProc + ZoomDocProc;
{$ELSEC }
				myWID := DocumentProc + ZoomDocProc;
{$ENDC }
				wptr := NewCWindow(nil, wrect, name, true, myWID, nil, true, 0);
				SetRect(wrect, 0, 0, wwidth, wheight);
				SetRect(PicRect, 0, 0, PixelsPerLine, nlines);
				SelectWindow(wptr);
				WindowPeek(wptr)^.WindowKind := PicKind;
{$IFC Arlo }
				InFrequencyDomain := false;
				if (myWID = FFTDocProc + ZoomDocProc) then
					begin
						WindowPeek(wptr)^.WindowKind := FFTKind;
						InFrequencyDomain := true;
					end;
{$ENDC }
				WindowPeek(wptr)^.RefCon := ord4(Info);
				title := name;
				ExtendWindowsMenu(name, PicSize, wptr);
				PicNum := nPics;
				GetPort(tPort);
				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(PixelsPerLine, $8000);
						BytesPerRow := PixelsPerLine;
						PixMapSize := PicSize
					end;
				SetRGBForeColor(ForegroundRGB, ForegroundIndex);
				SetRGBBackColor(BackgroundRGB, BackgroundIndex);
				SetPort(tPort);
				SrcRect := wrect;
				magnification := 1.0;
				RoiShowing := false;
				roiType := NoRoi;
				initwrect := wrect;
				savewrect := wrect;
				SaveSrcRect := SrcRect;
				SaveMagnification := magnification;
				savehloc := wleft;
				savevloc := wtop;
				osroiRgn := NewRgn;
				NewPic := true;
				ScaleToFitWindow := false;
				OpPending := false;
				Changes := false;
				WindowState := NormalWindow;
			end;
		WhatToUndo := NothingToUndo;
	end;


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


	procedure SelectAll;{(visible:boolean)}
		var
			loc: point;
			tPort: GrafPtr;
	begin
		if Info = NoInfo then
			begin
				beep;
				exit(SelectAll)
			end;
		KillRoi;
		with Info^ do
			begin
				RoiType := RectRoi;
				osroiRect := PicRect;
				roiRect := PicRect;
				OffscreenToScreenRect(roiRect);
				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;
	begin
		NewPicWindow := false;
		KillOperation;
		StopThresholding;
		SaveInfo := Info;
		iptr := NewPtr(SizeOf(PicInfo));
		if iptr = nil then
			begin
				DisposPtr(iptr);
				PutOutOfMemMsg;
				exit(NewPicWindow);
			end;
		Info := pointer(iptr);
		info^ := SaveInfo^;
		with Info^ do
			begin
				nlines := height;
				PixelsPerLine := width;
				PicSize := LongInt(nlines) * PixelsPerLine;
				if name = 'Camera' then
					begin
						PictureType := QuickCaptureType;
						QuickCaptureInfo := info;
					end;
				PicBaseAddr := Getmemory(PicSize);
				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;
		var
			SaveBkColor: RGBColor;
	begin
		SetPort(GrafPtr(CScreenPort));
		with CScreenPort^ do
			begin
				HideCursor;
				GetBackColor(SaveBkColor);
				RGBBackColor(BackgroundRGB);
				EraseRect(portPixMap^^.Bounds);
				RGBBackColor(SaveBkColor);
			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;
					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
							value[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;
						end;
						value[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;
				RoiRect := osroiRect;
				OffscreenToScreenRect(RoiRect);
				ShowMagnification;
			end; {with}
	end;


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

{$IFC Arlo }
	function IsPowerOf2 (x: integer): boolean;
		var
			i, sum: integer;
	begin
		sum := 0;
		x := abs(x);
		for i := 0 to 15 do
			sum := sum + ord(BTST(x, i));
		IsPowerOf2 := (sum <= 1);
	end;
{$ENDC }

end.