unit File2;

{Routines used by NIH Image for printing plus a few additional File Menu routines.}

interface


	uses
		Types, Memory, QuickDraw, QuickDrawText, Packages, Menus, Events, Fonts, Scrap, ToolUtils, Resources,
		Errors, Palettes, Printing, StandardFile, Folders, TextUtils, Dialogs, Files, Finder, Script,
		globals, Utilities, Graphics, Lut, PictUtils, QDOffscreen, Components, ImageCompression,
		Movies, QuickTimeComponents, Sound, FixMath, GestaltEqu;


	procedure GetInfo;
	procedure DoPageSetup;
	procedure Print (ShowDialog: boolean);
	procedure SetHalftone;
	function OpenMacPaint (fname: str255; vnum: integer): boolean;
	procedure TypeMismatch (fname: str255);
	function GetTextFile (var name: str255; var RefNum: integer): boolean;
	procedure InitTextInput (name: str255; RefNum: integer);
	procedure GetLineFromText (var rLine: RealLine; var count: integer);
	function ImportTextFile (name: str255; RefNum: integer): boolean;
	procedure PlotXYZ;
	procedure SaveSettings;
	procedure ExportAsText (fname: str255; RefNum: integer);
	procedure ExportMeasurements (fname: str255; RefNum: integer);
	function OpenTiffHeader (f: integer; var DirOffset: LongInt): boolean;
	function OpenTiffDirectory (f: integer; DirOffset: LongInt; var TiffInfo: TiffInfoRec; Importing: boolean): boolean;
	procedure SaveTiffColorMap (f: integer; ImageDataSize: LongInt);
	procedure GetTiffColorMap (f: integer);
	function SaveTiffDir (f, slines, sPixelsPerLine: integer; SavingSelection: boolean; ctabSize, ImageDataSize: LongInt): OSErr;
	function RoomForFile (fname: str255; RefNum: integer; slines, sPixelsPerLine: integer; SavingSelection: boolean): boolean;
	function WriteExtraTiffIFDs (f: integer; ImageDataSize, cTabSize: LongInt): integer;
	procedure SaveLUT (fname: str255; RefNum: integer);
	procedure SaveColorTable (fname: str255; RefNum: integer);
	procedure ExportCoordinates (fname: str255; RefNum: integer);
	procedure SaveOutline (fname: str255; RefNum: integer);
	procedure OpenOutline (fname: str255; RefNum: integer);
	function CheckIO (err: OSerr): integer;
	function GetTIFFParameters (name: str255; RefNum: integer; var HasColorMap: boolean): boolean;
	procedure GetXUnits (UnitsKind: UnitsType);
	procedure GetUnitsKInd (var UnitsKind: UnitsType; var UnitsPerCM: extended);
	procedure Swap2Bytes (var i: integer);
	procedure Swap4Bytes (var i: LongInt);
	function OpenQuickTime (name: str255; fRefNum: integer; UseExistingLUT: boolean): boolean;
	procedure SaveAsQuickTime (fname: str255; fRefNum: integer);
	function OpenMovieToolbox:boolean;


implementation

	var
		gstr: str255;
		

{$PUSH}
{$D-}

	procedure PrintErrCheck;
		var
			err: integer;
			ticks: LongInt;
	begin
		err := PrError;
		if err < 0 then
			beep;
	end;


	procedure DoPageSetup;
		var
			result: boolean;
	begin
		PrOpen;
		if PrintRecord = nil then begin
				PrintRecord := THPrint(NewHandle(SizeOF(TPrint)));
				PrintDefault(PrintRecord);
			end;
		if PrError = NoErr then begin
				result := PrValidate(PrintRecord);
				result := PrStlDialog(PrintRecord);
			end;
		PrClose;
	end;


	procedure PrintHalftone;
		const
			PostScriptBegin = 190;
			PostScriptEnd = 191;
			PostScriptHandle = 192;
			TextIsPostScript = 194;
		var
			HexBufH: handle;
			hloc, vloc, HexCount, iheight, iwidth, hstart, vstart: integer;
			Height, Width, eofStr, angle, freq: str255;
			aLine: LineType;
			HexBuf: packed array[0..4200] of char;
			err: OSErr;
			table: LookupTable;

		procedure PutHEX (byt: integer);
			var
				i, LowByte, HighByte, tmp: integer;
				h: char;
		begin
			if not info^.IdentityFunction then
				byt := table[byt];
			byt := 255 - byt;
			LowByte := byt mod 16;
			byt := byt div 16;
			HighByte := byt mod 16;
			for i := 1 to 2 do begin
					if i = 1 then
						tmp := HighByte
					else
						tmp := LowByte;
					case tmp of
						0: 
							h := '0';
						1: 
							h := '1';
						2: 
							h := '2';
						3: 
							h := '3';
						4: 
							h := '4';
						5: 
							h := '5';
						6: 
							h := '6';
						7: 
							h := '7';
						8: 
							h := '8';
						9: 
							h := '9';
						10: 
							h := 'a';
						11: 
							h := 'b';
						12: 
							h := 'c';
						13: 
							h := 'd';
						14: 
							h := 'e';
						15: 
							h := 'f';
					end;
					hexbuf[HexCount] := h;
					HexCount := HexCount + 1;
					if HexCount mod 80 = 0 then begin
							HexBuf[HexCount] := cr;
							HexCount := HexCount + 1
						end;
				end;
		end;

	begin
		with info^ do begin
				if not IdentityFunction then
					GetLookupTable(table);
				MoveTo(-1, -1);
				LineTo(-1, -1); {Nothing prints without this dummy dot!}
				PicComment(PostScriptBegin, 0, nil); {See Tech Note #91}
				PicComment(TextIsPostScript, 0, nil);
				NumToString(HalftoneFrequency, freq);
				NumToString(HalftoneAngle, angle);
				if HalftoneDotFunction then
					DrawString(concat(freq, ' ', angle, ' {dup mul exch dup mul add 1 exch sub} setscreen'))
				else
					DrawString(concat(freq, ' ', angle, ' {pop} setscreen'));
				DrawString('0 0 translate');
				with RoiRect do begin
						iwidth := right - left;
						if iwidth > MaxLine then
							iwidth := MaxLine;
						iheight := bottom - top;
						hstart := left;
						vstart := top;
					end;
				NumToString(iwidth, width);
				NumToString(iheight, height);
				DrawString(concat(width, ' ', height, ' scale'));
				DrawString(concat('/PicStr ', width, ' string def'));
				DrawString(concat(width, ' ', height, ' 8 [', width, ' 0 0 ', height, ' 0 0]'));
				DrawString('{currentfile PicStr readhexstring pop} image');
				for vloc := vstart to vstart + iheight - 1 do begin
						GetLine(hstart, vloc, iwidth, aline);
						HexCount := 0;
						for hloc := 0 to iwidth - 1 do
							PutHex(aline[hloc]);
						HexBuf[HexCount] := cr;
						HexCount := HexCount + 1;
						err := PtrToHand(@HexBuf, HexBufH, HexCount);
						if err <> noErr then
							exit(PrintHalftone);
						PicComment(PostScriptHandle, HexCount, HexBufH);
						DisposeHandle(HexBufH);
						Show2Values(vloc - vstart, iheight);
						if CommandPeriod then begin
								beep;
								eofStr := chr(4);
								DrawString(eofStr);
								exit(PrintHalftone)
							end;
					end;
			end;
	end;


	procedure PrintTheImage (PageWidth, PageHeight: integer);
		var
			PrintRect: rect;
			Width, Height: integer;

		procedure ScaleToFitPage;
			var
				hscale, vscale, scale: extended;
		begin
			hscale := PageWidth / width;
			vscale := PageHeight / height;
			if hscale <= vscale then
				scale := hscale
			else
				scale := vscale;
			width := trunc(scale * width);
			height := trunc(scale * height);
		end;

		procedure CenterOnPage;
		begin
			with PrintRect do begin
					left := 0;
					top := 0;
					if width < PageWidth then
						left := (PageWidth - width) div 2;
					if height < PageHeight then
						top := (Pageheight - height) div 2;
					right := left + width;
					bottom := top + height;
				end;
		end;

	begin
		if isLaserWriter and (not DriverHalftoning) then
			PrintHalftone
		else
			with info^ do begin
					LoadLUT(cTable);
					hlock(handle(osPort^.portPixMap));
					with RoiRect do begin
							width := right - left;
							height := bottom - top;
						end;
					if (width > PageWidth) or (height > PageHeight) then
						ScaleToFitPage;
					CenterOnPage;
					if BitAnd(qd.thePort^.portBits.rowBytes, $8000) = $8000 then begin
               {Assume driver understands Color QD}
							CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPtr(qd.thePort)^.PortPixMap)^^, RoiRect, PrintRect, SrcCopy, nil);
						end
					else
						CopyBits(BitMapHandle(osPort^.portPixMap)^^, qd.thePort^.PortBits, RoiRect, PrintRect, SrcCopy, nil);
				end;
	end;


	procedure PrintTextBuffer (PageHeight: integer; var PrintPort: TPPrPort);
		const
			LineInc = 13;
		var
			vloc, i, LineCount, CharCount, LinesPerPage, MaxCount: integer;
			aLine: str255;
	begin
		ClipTextInBuffer := false;
		LinesPerPage := PageHeight div LineInc;
		vloc := LineInc;
		LineCount := 0;
		CharCount := 0;
		TextFont(Monaco);
		TextSize(9);
		if WhatToPrint = PrintText then
			MaxCount := 85
		else
			MaxCount := 255;
		i := 1;
		repeat
			CharCount := 0;
			while (TextBufP^[i] <> cr) and (CharCount < MaxCount) and (i <= TextBufSize) do begin
					CharCount := CharCount + 1;
					aLine[CharCount] := TextBufP^[i];
					i := i + 1;
				end;
			if TextBufP^[i] = cr then
				i := i + 1
			else if CharCount = MaxCount then begin
					while (aLine[CharCount] <> ' ') and (CharCount > (MaxCount - 15)) do begin
							CharCount := CharCount - 1;
							i := i - 1;
						end;
					if TextBufP^[i] = ' ' then
						i := i + 1;
				end;
			aLine[0] := chr(CharCount);
			MoveTo(0, vloc);
			DrawString(aLine);
			vLoc := vLoc + LineInc;
			LineCount := LineCount + 1;
			if LineCount >= LinesPerPage then begin
					LineCount := 0;
					if i < TextBufSize then begin
							PrClosePage(PrintPort);
							PrintErrCheck;
							PrOpenPage(PrintPort, nil);
							vloc := LineInc
						end;
				end;
		until i > TextBufSize;
	end;


	procedure DoPrintText (PageHeight: integer; var PrintPort: TPPrPort);
		var
			ByteCount: LongInt;
	begin
		if TextInfo <> nil then
			with TextInfo^.TextTE^^ do begin
					ByteCount := TELength;
					BlockMove(hText^, ptr(TextBufP), ByteCount);
					TextBufSize := ByteCount;
					PrintTextBuffer(PageHeight, PrintPort);
				end;
	end;


	procedure Print (ShowDialog: boolean);
		var
			err, i, LinesToPrint: Integer;
			tPort: GrafPtr;
			PrintPort: TPPrPort;
			PrintStatusRec: TPrStatus;
			prect: rect;
			result: boolean;
	begin
		if WhatToPrint = PrintImage then
			SelectAll(false);
		if (WhatToPrint = PrintImage) or (WhatToPrint = PrintSelection) then begin
				if OpPending then
					KillRoi;
				with info^.RoiRect do
					LinesToPrint := bottom - top;
				if not DriverHalftoning then begin
						DrawLabels('Line:', 'Total:', '');
						Show2Values(0, LinesToPrint);
					end;
			end;
		GetPort(tPort);
		PrOpen;
		if PrintRecord = nil then begin
				PrintRecord := THPrint(NewHandle(SizeOF(TPrint)));
				PrintDefault(PrintRecord);
			end;
		if PrError = NoErr then begin
				InitCursor;
				result := PrValidate(PrintRecord);
				isLaserWriter := BSR(PrintRecord^^.prStl.wDev, 8) = 3;
				prect := PrintRecord^^.prInfo.rPage;
				if ShowDialog then
					result := PrJobDialog(PrintRecord)
				else
					result := true;
				if not DriverHalftoning then
					ShowMessage(CmdPeriodToStop);
				ShowWatch;
				if result then
					for i := 1 to PrintRecord^^.PrJob.icopies do begin
							PrintPort := PrOpenDoc(PrintRecord, nil, nil);
							PrintErrCheck;
							Printing := true;
							PrOpenPage(PrintPort, nil);
							if PrError = NoErr then
								case WhatToPrint of
									PrintImage, PrintSelection: 
										PrintTheImage(prect.right, prect.bottom);
									PrintMeasurements:  begin
											CopyResultsToBuffer(1, mCount, true);
											PrintTextBuffer(prect.Bottom, PrintPort);
											UnsavedResults := false;
										end;
									PrintPlot: 
										DrawPlot;
									PrintHistogram: 
										DrawHistogram;
									PrintText: 
										DoPrintText(prect.Bottom, PrintPort);
								end;
							Printing := false;
							PrClosePage(PrintPort);
							PrintErrCheck;
							PrCloseDoc(PrintPort);
							PrintErrCheck;
							if PrintRecord^^.prJob.bJDocLoop = bSpoolLoop then
								PrPicFile(PrintRecord, nil, nil, nil, PrintStatusRec);
						end;
			end;
		PrClose;
		SetPort(tPort);
		if WhatToPrint = PrintImage then
			KillRoi;
		ShowMessage(' ');
	end;


	procedure SetHalftone;
		const
			FrequencyID = 8;
			AngleID = 10;
			DotID = 4;
			LineID = 5;
			CustomID = 13;
		var
			mylog: DialogPtr;
			item, i, ignore, SaveFrequency, SaveAngle: integer;
			SaveFunction, SaveCustom: boolean;
			str: str255;
	begin
		SaveFrequency := HalftoneFrequency;
		SaveAngle := HalftoneAngle;
		SaveFunction := HalftoneDotFunction;
		SaveCustom := DriverHalftoning;
		mylog := GetNewDialog(30, nil, pointer(-1));
		SetDNum(MyLog, FrequencyID, HalftoneFrequency);
		SelectdialogItemText(MyLog, FrequencyID, 0, 32767);
		SetDNum(MyLog, AngleID, HalftoneAngle);
		SetDlogItem(mylog, CustomID, ord(not DriverHalftoning));
		OutlineButton(MyLog, ok, 16);
		if HalftoneDotFunction then
			SetDlogItem(mylog, DotID, 1)
		else
			SetDlogItem(mylog, LineID, 1);
		repeat
			ModalDialog(nil, item);
			if item = FrequencyID then begin
					HalftoneFrequency := GetDNum(MyLog, FrequencyID);
					DriverHalftoning := false;
					SetDlogItem(mylog, CustomID, ord(not DriverHalftoning));
				end;
			if item = AngleID then begin
					HalftoneAngle := GetDNum(MyLog, AngleID);
					if (HalftoneAngle < 0) or (HalftoneAngle > 180) then begin
							beep;
							HalftoneAngle := SaveAngle;
						end;
					DriverHalftoning := false;
					SetDlogItem(mylog, CustomID, ord(not DriverHalftoning));
				end;
			if (item >= DotID) and (item <= LineID) then begin
					for i := DotID to LineID do
						SetDlogItem(mylog, i, 0);
					SetDlogItem(mylog, item, 1);
					HalftoneDotFunction := item = DotID;
					DriverHalftoning := false;
					SetDlogItem(mylog, CustomID, ord(not DriverHalftoning));
				end;
			if item = CustomID then begin
					DriverHalftoning := not DriverHalftoning;
					SetDlogItem(mylog, CustomID, ord(not DriverHalftoning));
				end;
		until (item = ok) or (item = cancel);
		DisposeDialog(mylog);
		if item = cancel then begin
				HalftoneFrequency := SaveFrequency;
				HalftoneAngle := SaveAngle;
				HalftoneDotFunction := SaveFunction;
				DriverHalftoning := SaveCustom;
			end;
	end;


{$POP}

	procedure GetFileInfo (name: str255; vnum: integer; var DateCreated, LastModified: str255);
		var
			FileParmBlock: CInfoPBRec;
			theErr: OSErr;
			DateVar, TimeVar: str255;
			Secs: LongInt;
	begin
		DateCreated := '';
			with FileParmBlock do begin
					ioCompletion := nil;
					ioNamePtr := @name;
					ioVRefNum := vnum;
					ioFVersNum := 0;
					ioFDirIndex := 0;
					theErr := PBGetCatInfoSync(@FileParmBlock); {ppc-bug}
					if theErr = NoErr then begin
							Secs := ioFlCrDat;
							IUDateString(Secs, abbrevDate, DateVar);
							IUTimeString(Secs, true, TimeVar);
							DateCreated := concat(DateVar, '  ', TimeVar);
							Secs := ioFlMDDat;
							IUDateString(Secs, abbrevDate, DateVar);
							IUTimeString(Secs, true, TimeVar);
							LastModified := concat(DateVar, '  ', TimeVar);
						end;
				end;
	end;


	procedure GetVolumnInfo (vnum: integer; var VolumnName: str255; var FreeSpace: LongInt);
		var
			theErr: OSErr;
			str: str255;
			VolParmBlock: ParamBlockRec;
	begin
		VolumnName := '';
			with VolParmBlock do begin
					str := '';
					ioVRefNum := vnum;
					ioNamePtr := @str;
					ioCompletion := nil;
					ioVolIndex := -1;
					theErr := PBGetVInfoSync(@VolParmBlock); {ppc-bug}
					VolumnName := ioNamePtr^;
					FreeSpace := ioVAlBlkSiz * ioVFrBlk;
				end;
	end;


	function RoomForFile (fname: str255; RefNum: integer; slines, sPixelsPerLine: integer; SavingSelection: boolean): boolean;
		var
			err: OSErr;
			f: integer;
			VolumnName: str255;
			FreeSpace, ExistingFileSize, NeededSize: LongInt;
	begin
		with info^ do begin
				ExistingFileSize := 0;
				RoomForFile := true;
				err := fsopen(fname, RefNum, f);
				if err = 0 then begin
						err := GetEOF(f, ExistingFileSize);
						err := fsClose(f);
					end;
				if ExistingFileSize <> 0 then begin
						if SavingSelection then begin
								NeededSize := sLines;
								NeededSize := NeededSize * sPixelsPerLine
							end
						else
							NeededSize := ImageSize;
						if StackInfo <> nil then
							with StackInfo^ do
								NeededSize := NeededSize * nSlices + nSlices * SizeOf(StackIFDType);
						GetVolumnInfo(RefNum, VolumnName, FreeSpace);
						if (NeededSize - ExistingFileSize + 8192) > FreeSpace then begin
								PutError('There is not enough free space on this disk to save this image.');
								RoomForFile := false;
							end;
					end;
			end;
	end;


	procedure GetInfo;
		var
			name, str, DateCreated, LastModified, VolumnName, str2: str255;
			hloc, vloc, InfoWidth, InfoHeight: integer;
			SaveRoiShowing: boolean;
			FreeSpace, DataSize: LongInt;
			SaveForeIndex, SaveBackIndex: integer;
			ImageInfo, InfoWindowInfo: InfoPtr;
			x1, y1, x2, y2, ulength, clength: extended;
			SaveGDevice: GDHandle;

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

		procedure NewParagraph;
		begin
			vloc := vloc + 18;
			MoveTo(hloc, vloc);
		end;

	begin
		InfoWidth := 260;
		InfoHeight := 260;
		with info^ do begin
				if RoiShowing then
					InfoHeight := InfoHeight + 50;
				if RoiShowing and (RoiType = LineRoi) then
					InfoHeight := InfoHeight + 20;
				if vref <> 0 then
					InfoHeight := InfoHeight + 60;
				name := concat('Info About ', title);
				SaveRoiShowing := RoiShowing;
			end;
		SaveForeIndex := ForegroundIndex;
		SaveBackIndex := BackgroundIndex;
		SetForegroundColor(BlackIndex);
		SetBackgroundColor(WhiteIndex);
		ImageInfo := info;
		if NewPicWindow(name, InfoWidth, InfoHeight) then
			with ImageInfo^ do begin
					InfoWindowInfo := Info;
					SaveGDevice := GetGDevice;
					SetGDevice(osGDevice);
					SetPort(GrafPtr(info^.osPort));
					TextFont(Geneva);
					TextSize(9);
					hloc := 15;
					vloc := 10;
					NewLine;
					DrawBString('Name: ');
					DrawString(title);
					NewParagraph;
					DrawBString('Width: ');
					DrawXDimension(PixelsPerLine, 0);
					NewLine;
					DrawBString('Height: ');
					DrawYDimension(nlines, 0);
					if StackInfo <> nil then begin
							NewLine;
							DrawBString('Depth: ');
							DrawLong(StackInfo^.nSlices);
						end;
					NewLine;
					DrawBString('Size: ');
					if StackInfo <> nil then
						DataSize := PixMapSize * StackInfo^.nSlices
					else if DataH <> nil then
						DataSize := PixMapSize + PixMapSize * SizeOf(real)
					else
						DataSize := PixMapSize;
					DrawLong((DataSize + 511) div 1024);
					DrawString('K');
					NewParagraph;
					GetFileInfo(title, vref, DateCreated, LastModified); {DateCreated:='';}
					if DateCreated <> '' then begin
							DrawBString('Creation Date: ');
							DrawString(DateCreated);
							NewLine;
							DrawBString('Last Modified: ');
							DrawString(LastModified);
							NewLine;
						end;
					if fileVersion > 0 then begin
							DrawBString('Version: ');
							DrawString('Created by NIH Image ');
							DrawReal(fileVersion / 100.0, 1, 2);
							NewParagraph;
						end;
					DrawBString('Type: ');
					if StackInfo <> nil then case StackInfo^.StackType of
						VolumeStack, MovieStack:
							str := concat('Stack (', long2str(StackInfo^.nSlices), '  slices)');
						rgbStack:
							str := 'RGB color stack';
						else
						;
					end else begin
							case PictureType of
								NewPicture: 
									str := 'New';
								Normal: 
									str := 'Normal';
								PictFile: 
									str := 'PICT';
								TiffFile: 
									str := 'TIFF';
								Leftover: 
									str := 'Left Over';
								Imported:  begin
										if DataType = EightBits then
											str := 'Imported 8-bit image'
										else
											str := 'Imported 16-bit image';
									end;
								FrameGrabberType: 
									str := 'Camera';
								BlankField: 
									str := 'Blank Field';
								otherwise
									;
							end;
							if BinaryPic then
								str := concat(str, ' (Binary)');
						end;
					DrawString(str);
					if StackInfo <> nil then
						with StackInfo^ do
							if SliceSpacing <> 0.0 then begin
									NewLine;
									DrawBString('Slice Spacing: ');
									if SpatiallyCalibrated then
										DrawString(StringOf(SliceSpacing / xScale:1:2, ' ', xunit, ' (', SliceSpacing:1:2, ' pixels)'))
									else
										DrawString(StringOf(SliceSpacing:1:2, ' pixels'));
								end;
					NewLine;
					DrawBString('Lookup Table: ');
					case LutMode of
						PseudoColor: 
							str := concat('Pseudocolor (', long2str(ncolors), ', ', long2str(ColorStart), '-', long2str(ColorEnd), ')');
						GrayScale: 
							str := concat('Grayscale (', long2str(ncolors), ', ', long2str(ColorStart), '-', long2str(ColorEnd), ')');
						ColorLut: 
							str := 'Color';
						CustomGrayscale: 
							str := 'Custom Grayscale';
						otherwise
					end;
					DrawString(str);
					NewLine;
					DrawBString('Magnification: ');
					if ScaleToFitWindow then begin
							DrawReal(magnification, 1, 2);
							DrawString(' (Scale to Window Mode)')
						end
					else begin
							DrawReal(magnification, 1, 0);
							DrawString(':1')
						end;
					NewLine;
					DrawBString('Scale: ');
					if SpatiallyCalibrated then begin
							DrawReal(xScale, 1, 3);
							DrawString(' pixels per ');
							DrawString(xUnit);
							if PixelAspectRatio <> 1.0 then begin
									NewLine;
									DrawBString('Pixel Aspect Ratio: ');
									DrawReal(PixelAspectRatio, 1, 4);
								end;
						end
					else
						DrawString('None');
					if fit <> uncalibrated then begin
							NewLine;
							DrawBString('Unit of Measure: ');
							if UnitOfMEasure = '' then
								DrawString('None')
							else
								DrawString(UnitOfMeasure)
						end;
					NewParagraph;
					DrawBString('Free RAM: ');
					DrawLong(FreeMem div 1024);
					DrawString('K');
					NewLine;
					DrawBString('Largest Free Block: ');
					DrawLong(MaxBlock div 1024);
					DrawString('K');
					if FrameGrabber <> NoFrameGrabber then begin
							NewLine;
							DrawBString('Frame Grabber: ');
							case FrameGrabber of
								QuickCapture:  begin
										if fgWidth = 768 then
											DrawString('50Hz')
										else
											DrawString('60Hz');
										DrawString(' Data Translation QuickCapture');
									end;
								ScionLG3:  begin
										if fgWidth = 768 then
											DrawString('50Hz')
										else
											DrawString('60Hz');
										DrawString(' Scion LG-3 (');
										DrawLong(MaxLG3Frames div 2);
										DrawString(' MB)');
									end;
								ScionAG5:  begin
									if fgWidth = 768 then
										DrawString('50Hz')
									else
										DrawString('60Hz');
									DrawString(' Scion AG-5');
								end;
								ScionVG5f:  begin
									if fgWidth = 768 then
										DrawString('50Hz')
									else
										DrawString('60Hz');
									DrawString(' Scion VG-5');
								end
								QTvdig:
									DrawString('QuickTime Video Digitizer');
							end;
						end;
					NewParagraph;
					if RoiType <> NoRoi then begin
							DrawBString('Selection Type: ');
							case RoiType of
								PolygonRoi: 
									DrawString('Polygon');
								FreehandRoi: 
									DrawString('Freehand');
								RectRoi: 
									DrawString('Rectangle');
								OvalRoi: 
									DrawString('Oval');
								LineRoi: 
									DrawString('Straight Line');
								FreeLineRoi: 
									DrawString('Freehand Line');
								SegLineRoi: 
									DrawString('Segmented Line');
								TracedRoi:
									DrawString('Traced');
							end;
							NewLine;
							case RoiType of
								PolygonRoi, FreehandRoi, RectRoi, OvalRoi, TracedRoi: 
									with RoiRect do begin
											DrawBString('    Left: ');
											DrawXDimension(left, 0);
											NewLine;
											DrawBString('    Top: ');
											if InvertYCoordinates then
												DrawYDimension(PicRect.bottom - top - 1, 0)
											else
												DrawYDimension(top, 0);
											NewLine;
											DrawBString('    Width: ');
											DrawXDimension(right - left, 0);
											NewLine;
											DrawBString('    Height: ');
											DrawYDimension(bottom - top, 0);
										end;
								LineRoi:  begin
										info := ImageInfo;
										GetLengthOrPerimeter(ulength, clength);
										GetLoi(x1, y1, x2, y2);
										Info := InfoWindowInfo;
										DrawBString('    Length: ');
										if SpatiallyCalibrated then begin
												DrawReal(cLength, 1, 2);
												DrawString(xUnit);
											end
										else
											DrawReal(uLength, 1, 2);
										NewLine;
										DrawBString('    Angle: ');
										DrawReal(LAngle, 1, 2);
										DrawString('¡');
										NewLine;
										DrawBString('    X1: ');
										DrawXDimension(x1, 2);
										NewLine;
										DrawBString('    Y1: ');
										if InvertYCoordinates then
											DrawYDimension(PicRect.bottom - y1 - 1, 2)
										else
											DrawYDimension(y1, 2);
										NewLine;
										DrawBString('    X2: ');
										DrawXDimension(x2, 2);
										NewLine;
										DrawBString('    Y2: ');
										if InvertYCoordinates then
											DrawYDimension(PicRect.bottom - y2 - 1, 2)
										else
											DrawYDimension(y2, 2);
									end;
								FreeLineRoi, SegLineRoi:  begin
										info := ImageInfo;
										GetLengthOrPerimeter(ulength, clength);
										Info := InfoWindowInfo;
										DrawBString('    Length: ');
										if SpatiallyCalibrated then begin
												DrawReal(cLength, 1, 2);
												DrawString(xUnit);
											end
										else
											DrawReal(uLength, 1, 2);
										NewLine;
									end;
								otherwise
							end; {case}
						end
					else
						DrawBString('No Selection');
					SetGDevice(SaveGDevice);
				end; {with ImageInfo^}
		SetForegroundColor(SaveForeIndex);
		SetBackgroundColor(SaveBackIndex);
	end;


	function CheckIO (err: OSerr): integer;
		var
			ErrStr, Message: str255;
			ignore: integer;
			SaveGDevice: GDHandle;
	begin
		if err <> 0 then begin
				case err of
					-34: Message := 'Disk Full';
					-35: Message := 'No such volume';
					-36: Message := 'I/O Error';
					-39: Message := 'End of file error';
					-49: Message := 'File in Use';
					-61: Message := 'Write Permission Error';
					-120: Message := 'Folder not found'
					otherwise Message := '';
				end;
				SaveGDevice := GetGDevice;
				SetGDevice(GetMainDevice);
				NumToString(err, ErrStr);
				ParamText(Message, ErrStr, '', '');
				InitCursor;
				ignore := alert(IOErrorID, nil);
				SetGDevice(SaveGDevice);
				AbortMacro;
			end;
		CheckIO := err;
	end;
	


	function OpenMacPaint (fname: str255; vnum: integer): boolean;
		const
			MaxUnPackedSize = 51840;   {Max MacPaint size in bytes=720 lines * 72 bytes/line }
		type
			mpLine = array[1..18] of LongInt;
			mpArrayT = array[1..720] of mpLine;
			mpArrayP = ^mpArrayT;
		var
			i, f, ScanLine, LastLine, LastWord, LastColumn: integer;
			err: osErr;
			srcSize: LongInt;
			srcPtr, dstPtr, src, dst: ptr;
			theBitMap: BitMap;
			mpArray: mpArrayP;
			BlankLine, BlankColumn: boolean;
			frect: rect;
			SaveGDevice: GDHandle;

		procedure abort;
		begin
			beep;
			if srcPtr <> nil then
				DisposePtr(srcPtr);
			if dstPtr <> nil then
				DisposePtr(dstPtr);
			{exit(OpenMacPaint);} {ppc-bug}
		end;

	begin
		OpenMacPaint := false;
		err := fsOpen(fname, vnum, f);
		if CheckIO(err) <> noErr then
			exit(OpenMacPaint);
		err := GetEOF(f, srcSize);
		srcSize := srcSize - 512;
		srcPtr := NewPtr(srcSize);
		if srcPtr = nil then begin
			abort;
			exit(OpenMacPaint);
		end;
		err := SetFPos(f, fsFromStart, 512);
		err := fsRead(f, srcSize, srcPtr);
		if CheckIO(err) <> noErr then
			exit(OpenMacPaint);
		err := fsClose(f);
		dstPtr := NewPtrClear(MaxUnPackedSize);
		if dstPtr = nil then begin
			abort;
			exit(OpenMacPaint);
		end;
		src := srcPtr;
		dst := dstPtr;
		for scanLine := 1 to 720 do
			UnPackBits(src, dst, 72); {bumps both ptrs}
		DisposePtr(srcPtr);
		mpArray := mpArrayP(dstPtr);
		LastLine := 720;
		BlankLine := true;
		repeat
			for i := 1 to 18 do
				blankLine := BlankLine and (mpArray^[LastLine, i] = 0);
			if BlankLine then
				LastLine := LastLine - 1;
		until (not BlankLine) or (LastLine = 1);
		LastWord := 18;
		BlankColumn := true;
		repeat
			for i := 1 to LastLine do
				blankColumn := BlankColumn and (mpArray^[i, LastWord] = 0);
			if BlankColumn then
				LastWord := LastWord - 1;
		until (not BlankColumn) or (LastWord = 1);
		LastColumn := LastWord * 32;
		LastColumn := LastColumn + 8;
		if LastColumn > 576 then
			LastColumn := 576;
		LastLine := LastLine + 8;
		if LastLine > 720 then
			LastLine := 720;
		SetRect(frect, 0, 0, LastColumn, LastLine);
		with theBitMap do begin
				baseAddr := dstPtr;
				rowBytes := 72;
				bounds := frect;
			end;
		if not NewPicWindow(fname, LastColumn, LastLine) then begin
			abort;
			exit(OpenMacPaint);
		end;
		SaveGDevice := GetGDevice;
		SetGDevice(osGDevice);
		SetForegroundColor(BlackIndex);
		SetBackgroundColor(WhiteIndex);
		with info^ do begin
				CopyBits(theBitMap, BitMapHandle(osPort^.PortPixMap)^^, frect, frect, SrcCopy, nil);
				DisposePtr(dstPtr);
				PictureType := imported;
				BinaryPic := true;
				SetGDevice(SaveGDevice);
				if PixMapSize > UndoBufSize then
					PutWarning;
			end;
		OpenMacPaint := true;
	end;


	procedure TypeMismatch (fname: str255);
	begin
		PutError(concat('The file "', fname, '" is a different type, and therefore cannot be replaced'));
	end;



	function GetTextFile (var name: str255; var RefNum: integer): boolean;
		var
			where: Point;
			typeList: SFTypeList;
			reply: SFReply;
			err: OSErr;
			pBlock: WDPBRec;
	begin
		where.v := 120;
		where.h := 120;
		typeList[0] := 'TEXT';
		SFGetFile(Where, '', nil, 1, @typeList, nil, reply);
		if reply.good then
			with reply do begin
					name := fname;
					RefNum := vRefNum;
					GetTextFile := true;
				end
		else
			GetTextFile := false;
	end;


	procedure GetBuffer;
		var
			err: OSErr;
			count, FilePos: LongInt;
	begin
		count := MaxTextBufSize;
		err := fsread(Textf, count, ptr(TextBufP));
		TextBufSize := count;
		err := GetFPos(Textf, FilePos);
		if FilePos = TextFileSize then begin
				TextBufSize := TextBufSize + 1;
				if TextBufSize > MaxTextBufSize then
					TextBufSize := MaxTextBufSize;
				TextBufP^[TextBufSize] := eofChr;
				err := fsclose(Textf);
			end;
		TextIndex := 1;
	end;


	function GetByte: char;
	begin
		GetByte := TextBufP^[TextIndex];
		TextIndex := TextIndex + 1;
		if TextIndex > MaxTextBufSize then
			GetBuffer;
	end;


	function GetNumber: extended;
		var
			c: char;
			str: str255;
	begin
		repeat
			c := GetByte;
			if c = tab then begin
					GetNumber := 0.0; {Assume 0 zero for missing value.}
					exit(GetNumber);
				end;
			if (c = cr) or (c = eofChr) then begin
					TextEol := true;
					TextEof := c = eofChr;
					GetNumber := NoValue;
					exit(GetNumber);
				end;
		until c in ['0'..'9', '-', '.'];
		Str := '';
		while c in ['0'..'9', '+', '-', '.', 'e', 'E'] do begin
				Str := concat(str, c);
				c := GetByte;
				if (c = cr) or (c = eofChr) then begin
						TextEol := true;
						TextEof := c = eofChr;
					end;
			end;
		GetNumber := StringToReal(str);
	end;


	procedure GetLineFromText (var rLine: RealLine; var count: integer);
		var
			n: extended;
	begin
		count := 0;
		if TextEof then
			exit(GetLineFromText);
		repeat
			n := GetNumber;
			if n <> NoValue then begin
					count := count + 1;
					rLine[count] := n;
				end;
		until TextEol or (count = MaxLine);
		TextEol := false;
	end;


	procedure InitTextInput (name: str255; RefNum: integer);
		var
			err: OSErr;
	begin
		err := FSOpen(name, RefNum, Textf);
		err := GetEof(Textf, TextFileSize);
		err := SetFPos(Textf, fsFromStart, 0);
		ShowWatch;
		if WhatsOnClip = TextOnClip then
			WhatsOnClip := NothingOnClip;
		GetBuffer;
		TextEol := false;
		TextEof := false;
	end;


	function ImportTextFile (name: str255; RefNum: integer): boolean;
		var
			nRows, nColumns, count, i, vloc, BlankPixel, nPixelsPerLine: integer;
			rLine: RealLine;
			pvalue: extended;
			min, max, ScaleFactor, DefaultValue, tvalue: extended;
			err: OSErr;
			line, BlankLine: LineType;
			TheInfo: FInfo;
			noScaling:boolean;
	begin
		ImportTextFile := false;
		err := GetFInfo(name, RefNum, TheInfo);
		if TheInfo.fdType <> 'TEXT' then begin
				PutError('File is not of type ''TEXT''.');
				exit(ImportTextFile);
			end;
		InitTextInput(name, RefNum);
		nRows := 0;
		nColumns := 0;
		max := -10e-10;
		min := 10e10;
		ShowMessage(concat('First pass used to find ', crStr, 'width, height,min, and max.', crStr, crStr, CmdPeriodToStop));
		DrawLabels('Line:', '', '');
		while not TextEof do begin
				GetLineFromText(rLine, count);
				if not (TextEof and (count = 0)) then
					nRows := nRows + 1;
				if count > nColumns then
					nColumns := count;
				for i := 1 to count do begin
						pvalue := rLine[i];
						if pvalue > max then
							max := pvalue;
						if pvalue < min then
							min := pvalue;
					end;
				if nRows mod 10 = 0 then begin
						Show1Value(nRows, NoValue);
						ShowAnimatedWatch;
						if CommandPeriod then begin
								beep;
								err := fsclose(Textf);
								Exit(ImportTextFile);
							end;
					end;
			end;
		ShowMessage(concat('rows= ', long2str(nRows), crStr, 'columns= ', long2str(ncolumns), crStr, 'min= ', long2str(round(min)), crStr, 'max= ', long2str(round(max))));
		if nColumns > MaxLine then begin
				PutError(concat('More than ',long2str(MaxLine),' pixels per line.'));
				Exit(ImportTextFile);
			end;
		nPixelsPerLine := nColumns;
		if NewPicWindow(name, nPixelsPerLine, nrows) then
			with info^ do begin
					if (not ImportAutoScale) and (max > min) then begin
							min := ImportMin;
							max := ImportMax;
						end;
					ScaleFactor := 253.0 / (max - min);
					InitTextInput(name, RefNum);
					vloc := 0;
					DefaultValue := 0.0;
					if DefaultValue < min then
						DefaultValue := min;
					if DefaultValue > max then
						DefaultValue := max;
					BlankPixel := round((DefaultValue - min) * ScaleFactor + 1);
					for i := 0 to nColumns - 1 do
						BlankLine[i] := BlankPixel;
					NoScaling:=not ImportAutoScale and ((min=0) and (max=255));
					DrawLabels('Line:', 'Total:', '');
					while not TextEof do begin
							GetLineFromText(rLine, count);
							if not (TextEof and (count = 0)) then begin
									line := BlankLine;
									if ImportAutoScale then     {Map values into the range 1-254}
										for i := 1 to count do
											line[i - 1] := round((rLine[i] - min) * ScaleFactor + 1)
									else
										for i := 1 to count do begin
												tvalue := rLine[i];
												if tvalue < min then
													tvalue := min;
												if tvalue > max then
													tvalue := max;
												if noScaling
													then line[i - 1]:=round(tvalue)
													else line[i - 1] := round((tvalue - min) * ScaleFactor + 1);
											end;
									PutLine(0, vloc, PixelsPerLine, line);
									vloc := vloc + 1;
								end;
							if vloc mod 10 = 0 then begin
									Show2Values(vloc, nRows);
									ShowAnimatedWatch;
									if CommandPeriod then begin
											beep;
											err := fsclose(Textf);
											Exit(ImportTextFile);
										end;
								end;
						end;
					if noScaling then
						ImportCalibrate:=false
					else begin
						fit := StraightLine;
						nCoefficients := 2;
						coefficient[2] := (max - min) / 253.0;
						coefficient[1] := min - coefficient[2];
						nKnownValues := 0;
						UpdateTitleBar;
						if macro then
							GenerateValues;
						ZeroClip := false;
					end;
					changes := true;
					PictureType := imported;
				end; {with}
		ImportTextFile := true;
	end;


	procedure PlotXYZ;
{Reads X-Y coordinate pairs and optional intensiy(Z) values from a}
{two or three column tab-delimited text file and plots them in the current window.}
		var
			fname, str: str255;
			RefNum, i, nColumns, nValues, index, wheight: integer;
			rLine: RealLine;
	begin
		RefNum := 0;
		if not GetTextFile(fname, RefNum) then
			exit(PlotXYZ);
		InitTextInput(fname, RefNum);
		GetLineFromText(rLine, nValues);
		nColumns := nValues;
		if not ((nColumns = 2) or (nColumns = 3)) then begin
				PutError('File must have two or three columns.');
				exit(PlotXYZ);
			end;
		wheight := info^.nLines;
		index := ForegroundIndex;
		repeat
			if nColumns = 3 then begin
					index := round(rLine[3]);
					if index > 255 then
						index := 255;
					if index < 0 then
						index := 0;
				end;
			PutPixel(round(rLine[1]), wheight - round(rLine[2] + 1), index);
			GetLineFromText(rLine, nValues);
		until nValues = 0;
		InitCursor;
	end;



	procedure SaveSettings;
		var
			TheInfo: FInfo;
			ByteCount: LongInt;
			f, i: integer;
			err: OSErr;
			settings: SettingsType;
			PrefsVRef: integer;
			PrefsDirID: LongInt;
			PrefsSpec: FSSpec;
			PrefsError:boolean;
	begin
		with settings, info^ do begin
				sID := 'IMAG';
				sVersion := version;
				sForegroundIndex := ForegroundIndex;
				sBackgroundIndex := BackgroundIndex;
				sBrushHeight := BrushHeight;
				sBrushWidth := BrushWidth;
				sSprayCanDiameter := SprayCanDiameter;
				sLUTMode := LUTMode;
				sOldColorStart := 30;
				sOldColorWidth := 10;
				sCurrentFontID := CurrentFontID;
				sCurrentStyle := CurrentStyle;
				sCurrentSize := CurrentSize;
				sTextJust := TextJust;
				sTextBack := TextBack;
				sNExtraColors := nExtraColors;
				sExtraColors := ExtraColors;
				sInvertVideo := InvertVideo;
				sMeasurements := Measurements;
				sInvertPlots := InvertPlots;
				sAutoScalePlots := AutoScalePlots;
				sLinePlot := LinePlot;
				sDrawPlotLabels := DrawPlotLabels;
				for i := 1 to 12 do
					sUnused1[i] := 0;
				sFixedSizePlot := FixedSizePlot;
				sProfilePlotWidth := ProfilePlotWidth;
				sProfilePlotHeight := ProfilePlotHeight;
				sFramesToAverage := FramesToAverage;
				sNewPicWidth := NewPicWidth;
				sNewPicHeight := NewPicHeight;
				sBufferSize := BufferSize;
				sThresholdToForeground := ThresholdToForeground;
				sNonThresholdToBackground := NonThresholdToBackground;
				sVideoChannel := VideoChannel;
				sWhatToImport := WhatToImport;
				sImportCustomWidth := ImportCustomWidth;
				sImportCustomHeight := ImportCustomHeight;
				sImportCustomOffset := ImportCustomOffset;
				sWandAutoMeasure := WandAutoMeasure;
				sWandAdjustAreas := WandAdjustAreas;
				sBinaryIterations := BinaryIterations;
				sScaleArithmetic := ScaleArithmetic;
				sInvertPixelValues := InvertPixelValues;
				sInvertYCoordinates := InvertYCoordinates;
				sFieldWidth := FieldWidth;
				sPrecision := precision;
				sMinParticleSize := MinParticleSize;
				sMaxParticleSize := MaxParticleSize;
				sIgnoreParticlesTouchingEdge := IgnoreParticlesTouchingEdge;
				sLabelParticles := LabelParticles;
				sOutlineParticles := OutlineParticles;
				sIncludeHoles := IncludeHoles;
				sOscillatingMovies := OscillatingMovies;
				sDriverHalftoning := DriverHalftoning;
				sMaxMeasurements := MaxMeasurements;
				sImportCustomDepth := ImportCustomDepth;
				sImportSwapBytes := ImportSwapBytes;
				sImportCalibrate := ImportCalibrate;
				sImportAutoscale := ImportAutoscale;
				for i := 1 to 12 do
					sUnused2[i] := 0;
				sShowHeadings := ShowHeadings;
				sDefaultVRefNum := 0;
				sDefaultDirID := 0;
				sKernelsVRefNum := 0;
				sKernelsDirID := 0;
        {***}
				sProfilePlotMin := ProfilePlotMin;
				sProfilePlotMax := ProfilePlotMax;
				sImportMin := ImportMin;
				sImportMax := ImportMax;
				sHighlightPixels := HighlightSaturatedPixels;
        {***}
				sBallRadius := BallRadius;
				sFasterBackgroundSubtraction := FasterBackgroundSubtraction;
				sScaleConvolutions := ScaleConvolutions;
        {V1.42}
				sBinaryCount := BinaryCount;
				sColorTable := ColorTable;
				sColorStart := ColorStart;
				sColorEnd := ColorEnd;
				sInvertedTable := InvertedColorTable;
        {V1.44}
				sHalftoneFrequency := HalftoneFrequency;
				sHalftoneAngle := HalftoneAngle;
				sHalftoneDotFunction := HalftoneDotFunction;
				sDacLow := DacLow;
				sDacHigh := DacHigh;
				sSyncMode := SyncMode;
				sSwitchLUTOnSuspend := SwitchLUTOnSuspend;
				sVideoRateAveraging := VideoRateAveraging;
				sImportInvert := ImportInvert;
				sTextCreator := TextCreator;
				sMathSubGain:=MathSubGain;
				sMathSubOffset:=round(MathSubOffset);
		{V1.60}
				sfgScale := fgScale;
				sUseBuiltinDigitizer := UseBuiltinDigitizer;
				sDigitizerMode := DigitizerMode;
				sDigitizerStandard := DigitizerStandard;
				sLutFriendlyMode := LutFriendlyMode;

				for i := 1 to 10 do
					sUnused[i] := 0;
			end; {with}
		if System7 then begin
			{Save in Preferences folder}
			PrefsError:=true;
			err:=FindFolder(kOnSystemDisk, kPreferencesFolderType,
						kDontCreateFolder, PrefsVRef, PrefsDirID);
			if err=noErr then
				err:=FSMakeFSSpec(PrefsVRef, PrefsDirID, PrefsName, PrefsSpec);
			if err=noErr
				then err:=FSpDelete(PrefsSpec);
			if (err=noErr) or (err=fnfErr) then begin
				err:=FSpCreate(PrefsSpec, 'Imag', 'pref', smSystemScript);
				if err=noErr then
					err:=FSpOpenDF(PrefsSpec, fsCurPerm, f);
				if err=noErr then
					PrefsError:=false;
			end;
			if PrefsError then begin
				PutError('Error saving settings file');
				exit(SaveSettings);
			end;
		end else begin
			{Save in System folder}
			err := GetFInfo(PrefsName, SystemRefNum, TheInfo);
			if err = FNFerr then begin
					err := create(PrefsName, SystemRefNum, 'Imag', 'pref');
					if CheckIO(err) <> 0 then
						exit(SaveSettings);
				end;
			err := fsopen(PrefsName, SystemRefNum, f);
		end;
		if CheckIO(err) <> 0 then
			exit(SaveSettings);
		err := SetFPos(f, FSFromStart, 0);
		ByteCount := SizeOf(settings);
		err := fswrite(f, ByteCount, @settings);
		if CheckIO(err) <> 0 then begin
				err := fsclose(f);
				exit(SaveSettings)
			end;
		err := SetEof(f, ByteCount);
		err := fsclose(f);
		err := FlushVol(nil, SystemRefNum);
	end;


	procedure ExportAsText (fname: str255; RefNum: integer);
		var
			err, f, width, hloc, vloc: integer;
			TheInfo: FInfo;
			ByteCount, FileSize: LongInt;
			AutoSelectAll, InvertValues: boolean;
			tLine: LineType;
	begin
		if info = NoInfo then
			exit(ExportAsText);
		err := GetFInfo(fname, RefNum, TheInfo);
		case err of
			NoErr: 
				if TheInfo.fdType <> 'TEXT' then begin
						TypeMismatch(fname);
						exit(ExportAsText)
					end;
			FNFerr:  begin
					err := create(fname, RefNum, FourCharCode(TextCreator), 'TEXT');
					if CheckIO(err) <> 0 then
						exit(ExportAsText);
				end;
			otherwise
				if CheckIO(err) <> 0 then
					exit(ExportAsText)
		end;
		ShowWatch;
		err := fsopen(fname, RefNum, f);
		if CheckIO(err) <> 0 then
			exit(ExportAsText);
		AutoSelectAll := not info^.RoiShowing;
		if AutoSelectAll then
			SelectAll(true);
		if TooWide then
			exit(ExportAsText);
		FileSize := 0;
		with info^, info^.RoiRect do begin
				InvertValues := isInvertingFunction;
				width := right - left;
				for vloc := top to bottom - 1 do begin
						GetLine(left, vloc, width, tLine);
						TextBufSize := 0;
						for hloc := 0 to width - 1 do begin
								if fit = uncalibrated then
									PutLong(tLine[hloc], 0)
								else if InvertValues then
									PutLong(255 - tLine[hloc], 0)
								else
									PutString(StringOf(cValue[tLine[hloc]]:1:precision));
								if hloc <> (width - 1) then
									PutTab;
							end;
						PutChar(cr);
						ByteCount := TextBufSize;
						err := fswrite(f, ByteCount, ptr(TextBufP));
						FIleSize := FileSize + ByteCount;
						if (CheckIO(err) <> 0) or CommandPeriod then
							leave;
						if (vloc mod 10) = 0 then ShowAnimatedWatch;
					end;
				err := SetEof(f, FileSize);
				err := fsclose(f);
				err := FlushVol(nil, RefNum);
			end;
		if AutoSelectAll then
			KillRoi;
	end;


	procedure ExportCoordinates (fname: str255; RefNum: integer);
		var
			err, f, i, y: integer;
			TheInfo: FInfo;
			ByteCount, FileSize: LongInt;
			InvertY: boolean;
	begin
		if not CoordinatesAvailableMsg then begin
				exit(ExportCoordinates)
			end;
		err := GetFInfo(fname, RefNum, TheInfo);
		case err of
			NoErr: 
				if TheInfo.fdType <> 'TEXT' then begin
						TypeMismatch(fname);
						exit(ExportCoordinates)
					end;
			FNFerr:  begin
					err := create(fname, RefNum, FourCharCode(TextCreator), 'TEXT');
					if CheckIO(err) <> 0 then
						exit(ExportCoordinates);
				end;
			otherwise
				if CheckIO(err) <> 0 then
					exit(ExportCoordinates)
		end;
		ShowWatch;
		err := fsopen(fname, RefNum, f);
		if CheckIO(err) <> 0 then
			exit(ExportCoordinates);
		FileSize := 0;
		InvertY := InvertYCoordinates and (Info <> NoInfo);
		with info^ do
			for i := 1 to nCoordinates do begin
					TextBufSize := 0;
					PutLong(xCoordinates^[i] + RoiRect.left, 0);
					PutTab;
					y := yCoordinates^[i] + RoiRect.top;
					if InvertY then
						y := PicRect.bottom - y - 1;
					PutLong(y, 0);
					PutChar(cr);
					ByteCount := TextBufSize;
					err := fswrite(f, ByteCount, ptr(TextBufP));
					FIleSize := FileSize + ByteCount;
					if (CheckIO(err) <> 0) or CommandPeriod then
						leave;
				end;
		err := SetEof(f, FileSize);
		err := fsclose(f);
		err := FlushVol(nil, RefNum);
	end;


	procedure ExportMeasurements (fname: str255; RefNum: integer);
		const
			LinesPerPass = 25;
		var
			err, f, i, first, last: integer;
			TheInfo: FInfo;
			ByteCount, FileSize: LongInt;
	begin
		err := GetFInfo(fname, RefNum, TheInfo);
		case err of
			NoErr: 
				if TheInfo.fdType <> 'TEXT' then begin
						TypeMismatch(fname);
						exit(ExportMeasurements)
					end;
			FNFerr:  begin
					err := create(fname, RefNum, FourCharCode(TextCreator), 'TEXT');
					if CheckIO(err) <> 0 then
						exit(ExportMeasurements);
				end;
			otherwise
				if CheckIO(err) <> 0 then
					exit(ExportMeasurements)
		end;
		ShowWatch;
		err := fsopen(fname, RefNum, f);
		if CheckIO(err) <> 0 then
			exit(ExportMeasurements);
		FileSize := 0;
		first := 1;
		last := LinesPerPass;
		repeat
			if last > mCount then
				last := mCount;
			CopyResultsToBuffer(first, last, ShowHeadings or OptionKeyWasDown);
			ByteCount := TextBufSize;
			err := fswrite(f, ByteCount, ptr(TextBufP));
			FIleSize := FileSize + ByteCount;
			if (CheckIO(err) <> 0) or CommandPeriod or (last = mCount) then
				leave;
			first := first + LinesPerPass;
			last := last + LinesPerPass;
		until false;
		err := SetEof(f, FileSize);
		err := fsclose(f);
		err := FlushVol(nil, RefNum);
		UnsavedResults := false;
	end;



	procedure Swap2Bytes (var i: integer);
		type
			atype = packed array[1..2] of char;
		var
			a: atype;
			c: char;
	begin
		a := atype(i);
		c := a[1];
		a[1] := a[2];
		a[2] := c;
		i := integer(a)
	end;


	procedure Swap4Bytes (var i: LongInt);
		var
			a: ostype;
			c: char;
	begin
		a := ostype(i);
		c := a[1];
		a[1] := a[4];
		a[4] := c;
		c := a[2];
		a[2] := a[3];
		a[3] := c;
		i := LongInt(a)
	end;
	


	function OpenTiffHeader (f: integer; var DirOffset: LongInt): boolean;
		var
			TiffHeader: TiffHdr;
			ByteCount: LongInt;
			err: OSErr;
	begin
		ByteCount := 8;
		err := SetFPos(f, fsFromStart, 0);
		err := fsread(f, ByteCount, @TiffHeader);
		if CheckIO(err) <> NoErr then begin
				OpenTiffHeader := false;
				exit(OpenTiffHeader);
			end;
		with TiffHeader do begin
				IntelByteOrder := ByteOrder = 'II';
				if (ByteOrder <> 'MM') and (ByteOrder <> 'II') then begin
						PutError('Invalid TIFF header.');
						OpenTiffHeader := false;
						exit(OpenTiffHeader)
					end;
				DirOffset := FirstIFDOffset;
				if IntelByteOrder then
					Swap4Bytes(DirOffset);
				OpenTiffHeader := true;
			end;
	end;


	procedure GetTiffEntry (f: integer; var tag: integer; var N, value: LongInt);
		var
			IFDEntry: TiffEntry;
			ByteCount: LongInt;
			IntValue: integer;
			err: OSErr;
			str: str255;
	begin
		ByteCount := 12;
		err := FSRead(f, ByteCount, @IFDEntry);
		with IFDEntry do begin
				tag := TagField;
				N := length;
				if IntelByteOrder then begin
						Swap2Bytes(tag);
						Swap2Bytes(ftype);
						Swap4Bytes(N);
					end;
				value := offset;
				if (ftype = short) and (N = 1) then begin
						value := bsr(value, 16);
						if IntelByteOrder then begin
								IntValue := value;
								Swap2Bytes(IntValue);
								value := IntValue
							end
					end
				else if IntelByteOrder then
					Swap4Bytes(value);
				if OptionKeyWasDown then begin
						gstr := concat(gstr, long2str(tag), '  ', long2str(ftype), '  ', long2str(N), '  ', long2str(value), crStr);
						ShowMessage(gstr);
					end;
			end;
	end;


	function OpenTiffDirectory (f: integer; DirOffset: LongInt; var TiffInfo: TiffInfoRec; Importing: boolean): boolean;
		const
			NoUnit = 1;
			inch = 2;
			centimeter = 3;
		var
			ByteCount, length, ftype, N, value, BytesPerStrip, SaveFPos: LongInt;
			err: OSErr;
			nEntries, i, tag, entry: integer;
			StripOffsetsArray: array[1..2] of LongInt;
			xRes, yRes: extended;

		function GetResolution: extended;
			var
				resolution: array[1..2] of LongInt;
		begin
			err := GetFPos(f, SaveFPos);
			err := SetFPos(f, fsFromStart, value);
			ByteCount := 8;
			err := fsread(f, ByteCount, @Resolution);
			if IntelByteOrder then begin
					Swap4Bytes(Resolution[1]);
					Swap4Bytes(Resolution[2]);
				end;
			err := SetFPos(f, fsFromStart, SaveFPos);
			if resolution[2] <> 0 then
				GetResolution := resolution[1] / resolution[2]
			else
				GetResolution := 0.0;
		end;

	begin
		if OptionKeyWasDown then
			gstr := '';
		xRes := 0.0;
		err := SetFPos(f, fsFromStart, DirOffset);
		ByteCount := 2;
		err := FSRead(f, ByteCount, @nEntries);
		if CheckIO(err) <> NoErr then begin
				OpenTiffDirectory := false;
				exit(OpenTiffDirectory);
			end;
		if IntelByteOrder then
			Swap2Bytes(nEntries);
		with TiffInfo do begin
				width := 0;
				height := 0;
				BitsPerPixel := 8;
				SamplesPerPixel:=1;
				PlanarConfig := 1;
				OffsetToData := 0;
				Resolution := 0.0;
				ResUnits := tNoUnits;
				OffsetToColorMap := 0;
				OffsetToImageHeader := -1;
				StripOffsetsArray[1] := 0;
				for entry := 1 to nEntries do begin
						GetTiffEntry(f, tag, N, value);
						if tag = 0 then begin
								PutError('Invalid TIFF format.');
								OpenTiffDirectory := false;
								exit(OpenTiffDirectory)
							end;
						case tag of
							ImageWidth: 
								width := value;
							ImageLength: 
								height := value;
							BitsPerSample:  begin
									if N = 1 then
										BitsPerPixel := value;
									if value = 1 then begin
											PutError('NIH Image cannot open 1-bit TIFF files.');
											OpenTiffDirectory := false;
											exit(OpenTiffDirectory)
										end;
									if (value = 16) and not importing then begin
											PutError('Use Import to open 16-bit TIFF files.');
											OpenTiffDirectory := false;
											exit(OpenTiffDirectory)
										end;
								end;
							SamplesPerPixelTag:
								if (value = 1) or (value = 3) then
									 SamplesPerPixel:=value
								else begin
									PutError('NIH Image can only open TIFF files with 1 or 3 samples per pixel.');
									OpenTiffDirectory := false;
									exit(OpenTiffDirectory)
								end;
							PlanarConfigTag:
								PlanarConfig := value;
							Compression: 
								if value <> 1 then begin
										PutError('NIH Image cannot open compressed TIFF files.');
										OpenTiffDirectory := false;
										exit(OpenTiffDirectory)
									end;
							PhotoInterp: 
								ZeroIsBlack := value = 1;
							StripOffsets: 
								if N = 1 then
									OffsetToData := value
								else begin
										err := GetFPos(f, SaveFPos);
										err := SetFPos(f, fsFromStart, value);
										ByteCount := 8;
										err := fsread(f, ByteCount, @StripOffsetsArray);
										if IntelByteOrder then begin
												Swap4Bytes(StripOffsetsArray[1]);
												Swap4Bytes(StripOffsetsArray[2]);
											end;
										err := SetFPos(f, fsFromStart, SaveFPos);
									end;
							RowsPerStrip: 
								if (OffsetToData=0) and (value < height) then begin
										BytesPerStrip := value * width;
										if BitsPerPixel = 16 then
											BytesPerStrip := BytesPerStrip * 2
										else if SamplesPerPixel = 3 then
											BytesPerStrip := BytesPerStrip * 3;
										if StripOffsetsArray[1] = 0 then begin
												PutError('Invalid TIFF directory.');
												OpenTiffDirectory := false;
												exit(OpenTiffDirectory)
											end;
										if StripOffsetsArray[2] <> (StripOffsetsArray[1] + BytesPerStrip) then begin
												PutError('NIH Image cannot open TIFF files with discontiguous strips.');
												OpenTiffDirectory := false;
												exit(OpenTiffDirectory)
											end;
										OffsetToData := StripOffsetsArray[1];
									end;
							XResolution: 
								XRes := GetResolution;
							YResolution:  begin
									yRes := GetResolution;
									if (xRes = yRes) and (xRes > 0.0) then begin
											resolution := xRes;
											ResUnits := tInches;
										end;
								end;
							ResolutionUnit: 
								case value of
									NoUnit: 
										ResUnits := tNoUnits;
									Centimeter: 
										ResUnits := tCentimeters;
									otherwise
								end;
							ColorMapTag: 
								if N = 768 then
									OffsetToColorMap := value;
							ImageHdrTag: 
								OffsetToImageHeader := value;
							otherwise
						end;
					end; {for}
				if OffsetToData = 0 then
					OffsetToData := StripOffsetsArray[1];
				ByteCount := 4;
				err := FSRead(f, ByteCount, @NextIFD);
				if IntelByteOrder then
					Swap4Bytes(NextIFD);
				if OptionKeyWasDown then begin
						gstr := concat(gstr, 'Next IFD=', long2str(NextIFD));
						ShowMessage(gstr);
					end;
				if width = 0 then begin
						PutError('Error opening TIFF directory');
						OpenTiffDirectory := false;
						exit(OpenTiffDirectory)
					end;
			end; {with}
		OpenTiffDirectory := true;
	end;


	procedure SaveTiffColorMap (f: integer; ImageDataSize: LongInt);
		var
			i: integer;
			err: OSErr;
			ColorMap: TiffColorMapType;
			ColorMapSize: LongInt;
	begin
		LoadLUT(info^.cTable);
		if ScreenDepth=8 then begin
			for i := 0 to 255 do
				with cScreenPort^.portPixMap^^.pmTable^^.ctTable[i].rgb do begin
					ColorMap[1, i] := red;
					ColorMap[2, i] := green;
					ColorMap[3, i] := blue;
					end;
		end else begin
			for i := 0 to 255 do
				with info^.cTable[i].rgb do begin
					ColorMap[1, i] := red;
					ColorMap[2, i] := green;
					ColorMap[3, i] := blue;
					end;
		end;
		err := SetFPos(f, FSFromStart, HeaderSize + TiffDirSize + ImageDataSize);
		ColorMapSize := SizeOf(ColorMap);
		err := fswrite(f, ColorMapSize, @ColorMap);
		if CheckIO(err) <> 0 then
			beep;
	end;


	procedure GetTiffColorMap (f: integer);
		var
			i: integer;
			ByteCount: LongInt;
			err: OSErr;
			ColorMap: TiffColorMapType;
	begin
		with info^ do begin
				ByteCount := SizeOf(ColorMap);
				err := SetFPos(f, fsFromStart, ColorMapOffset);
				err := fsRead(f, ByteCount, @ColorMap);
				if err = NoErr then begin
						if IntelByteOrder then
							for i := 0 to 255 do begin
									Swap2Bytes(ColorMap[1, i]);
									Swap2Bytes(ColorMap[2, i]);
									Swap2Bytes(ColorMap[3, i]);
								end;
						for i := 0 to 255 do
							with cTable[i].rgb do begin
									red := ColorMap[1, i];
									green := ColorMap[2, i];
									blue := ColorMap[3, i];
								end;
						LoadLUT(cTable);
						LUTMode := ColorLut;
						SetupPseudocolor;
						IdentityFunction := false;
						if isGrayScaleLUT then begin
								info^.LutMode := CustomGrayScale;
								DrawMap;
							end;
					end
				else
					beep;
			end;{with}
	end;


	function SaveTiffDir (f, slines, sPixelsPerLine: integer; SavingSelection: boolean; ctabSize, ImageDataSize: LongInt): OSErr;
		var
			i: integer;
			err: OSErr;
			SavingStack, SavingRGBStack: boolean;
			ByteCount, width, height: LongInt;
			TiffInfo1: record
					Header: TiffHdr;   {8}
					nEntries: integer; {2}
					TiffDir: array[1..9] of TiffEntry; {108}
				end;
			ColorMapEntry: TiffEntry;  {12 (Optional)}
			TiffInfo2: record
					ImageHdrEntry: TiffEntry;  {12}
					NextIFD: LongInt;  {4}
					BitsPerPixelData: array[1..3] of integer; {6} {only used for RGB files}
					filler: array[1..TiffFillerSize] of integer; {116}
				end;
			BitsPerSampleData: record
				rBitsPerSample, gBitsPerSample, bBitsPerSample:integer;
			end;
	begin
		with info^ do begin
			SavingStack := false;
			SavingRGBStack := false;
			if StackInfo <> nil then
				SavingStack := StackInfo^.nSlices > 1;
			if SavingStack then
				if (StackInfo^.StackType = rgbStack) and (StackInfo^.nSlices = 3) then begin
					SavingRGBStack := true;
					ctabSize := 0;
				end;
			if SavingSelection then begin
					width := sPixelsPerLine;
					height := sLines
				end
			else begin
					width := PixelsPerLine;
					height := nLines
				end;
			with TiffInfo1 do begin
					with header do begin
							ByteOrder := 'MM';
							Version := 42;
							FirstIFDOffset := 8;
						end;
					if ctabSize > 0 then
						nEntries := 11
					else
						nEntries := 10;
					for i := 1 to 9 do
						with TiffDir[i] do begin
								ftype := 3;
								length := 1
							end;
					with TiffDir[1] do begin
							TagField := NewSubfileType;
							ftype := 4;
							offset := 0;
						end;
					with TiffDir[2] do begin
							TagField := ImageWidth;
							offset := bsl(width, 16);
						end;
					with TiffDir[3] do begin
							TagField := ImageLength;
							offset := bsl(height, 16);
						end;
					with TiffDir[4] do begin
							TagField := BitsPerSample;
							if SavingRGBStack then begin
								ftype := 3;
								length := 3;
								offset := SizeOf(TiffInfo1) + SizeOf(TiffEntry) + SizeOf(LongInt);
								with TiffInfo2 do
									for i := 1 to 3 do
										BitsPerPixelData[i] := 8;
							end else begin
								offset := bsl(8, 16);
								with TiffInfo2 do
									for i := 1 to 3 do
										BitsPerPixelData[i] := 0;
							end;
						end;
					with TiffDir[5] do begin
							TagField := PhotoInterp;
							if SavingRGBStack then
								offset := bsl(2, 16)
							else if ctabSize > 0 then
								offset := bsl(3, 16)
							else
								offset := 0;
						end;
					with TiffDir[6] do begin
							TagField := StripOffsets;
							ftype := 4;
							offset := TiffDirSize + HeaderSize;
						end;
					with TiffDir[7] do begin
							TagField := SamplesPerPixelTag;
							if SavingRGBStack then
								offset := bsl(3, 16)
							else
								offset := bsl(1, 16);
						end;
					with TiffDir[8] do begin
							TagField := RowsPerStrip;
							offset := bsl(height, 16);
						end;
					with TiffDir[9] do begin
							TagField := StripByteCount;
							ftype := 4;
							if SavingRGBStack then
								offset := width * height * 3
							else
								offset := width * height;
						end;
				end;
			ByteCount := SizeOf(TiffInfo1);
			err := SetFPos(f, FSFromStart, 0);
			err := FSWrite(f, ByteCount, @TiffInfo1);
			if CheckIO(err) <> NoErr then begin
					SaveTiffDir := err;
					exit(SaveTiffDir);
				end;
			if ctabSize > 0 then
				with ColorMapEntry do begin
						TagField := ColorMapTag;
						ftype := 3;
						length := 768;
						offset := HeaderSize + TiffDirSize + ImageDataSize;
						ByteCount := SizeOf(ColorMapEntry);
						err := FSWrite(f, ByteCount, @ColorMapEntry);
						if CheckIO(err) <> NoErr then begin
								SaveTiffDir := err;
								exit(SaveTiffDir);
							end;
					end;
			with TiffInfo2 do begin
					with ImageHdrEntry do begin
							TagField := ImageHdrTag;
							ftype := 3;
							length := 256;
							offset := TiffDirSize;
						end;
					NextIFD := 0;
					if SavingStack then
						NextIFD := HeaderSize + TiffDirSize + ImageDataSize + ctabSize;
					for i := 1 to TiffFillerSize do
						filler[i] := 0;
				end;
			end; {with info^}
		ByteCount := SizeOf(TiffInfo2);
		err := FSWrite(f, ByteCount, @TiffInfo2);
		SaveTiffDir := CheckIO(err);
	end;


	function WriteExtraTiffIFDs (f: integer; ImageDataSize, cTabSize: LongInt): integer;
		var
			IFD, entry: integer;
			StackIFD: StackIFDType;
			err: OSErr;
			IFDoffset, SliceOffset, ByteCount: LongInt;
	begin
		with info^, StackInfo^, StackIFD do begin
				IFDoffset := HeaderSize + TiffDirSize + ImageDataSize + ctabSize;
				err := SetFPos(f, FSFromStart, IFDoffset);
				SliceOffset := HeaderSize + TiffDirSize + ImageSize;
				for IFD := 2 to nSlices do  {IFD=Image File Directory}
					begin
						nEntries := 6;
						for entry := 1 to nEntries do
							with TiffDir[entry] do begin
									ftype := 3;
									length := 1
								end;
						with TiffDir[1] do begin
								TagField := NewSubfileType;
								ftype := 4;
								offset := 0;
							end;
						with TiffDir[2] do begin
								TagField := ImageWidth;
								offset := bsl(PixelsPerLine, 16);
							end;
						with TiffDir[3] do begin
								TagField := ImageLength;
								offset := bsl(nLines, 16);
							end;
						with TiffDir[4] do begin
								TagField := BitsPerSample;
								offset := bsl(8, 16);
							end;
						with TiffDir[5] do begin
								TagField := PhotoInterp;
								offset := 0;
							end;
						with TiffDir[6] do begin
								TagField := StripOffsets;
								ftype := 4;
								offset := SliceOffset;
							end;
						SliceOffset := SliceOffset + ImageSize;
						IFDoffset := IFDoffset + SizeOf(StackIFD);
						if IFD <> nSlices then
							NextIFD := IFDoffset
						else
							NextIFD := 0;
						ByteCount := SizeOf(StackIFD);
						err := fswrite(f, ByteCount, @StackIFD);
						if err <> NoErr then begin
								WriteExtraTiffIFDs := err;
								exit(WriteExtraTiffIFDs);
							end;
					end; {for}
			end; {with}
		WriteExtraTiffIFDs := NoErr;
	end;


	procedure SaveLUT (fname: str255; RefNum: integer);
		var
			err: integer;
			TheInfo: FInfo;
			LUT: array[1..3] of packed array[0..255] of byte;
			i, f: integer;
			ByteCount: LongInt;
			tempRGB:rgbColor;
	begin
		err := GetFInfo(fname, RefNum, TheInfo);
		case err of
			NoErr: 
				if TheInfo.fdType <> 'ICOL' then begin
						TypeMismatch(fname);
						exit(SaveLUT)
					end;
			FNFerr:  begin
					err := create(fname, RefNum, 'Imag', 'ICOL');
					if CheckIO(err) <> 0 then
						exit(SaveLUT);
				end;
			otherwise
				if CheckIO(err) <> 0 then
					exit(SaveLUT);
		end;
		DisableDensitySlice;
		LoadLUT(Info^.cTable);
		if ScreenDepth = 8 then begin
			for i := 0 to 255 do
				with cScreenPort^.portPixMap^^.pmTable^^.ctTable[i].rgb do begin
						LUT[1, i] := band(bsr(red, 8), 255);
						LUT[2, i] := band(bsr(green, 8), 255);
						LUT[3, i] := band(bsr(blue, 8), 255);
					end;
		end else begin
			for i := 0 to 255 do
				with info^.cTable[i].rgb do begin
						LUT[1, i] := band(bsr(red, 8), 255);
						LUT[2, i] := band(bsr(green, 8), 255);
						LUT[3, i] := band(bsr(blue, 8), 255);
					end;
		end;
		err := fsopen(fname, RefNum, f);
		if CheckIO(err) <> 0 then
			exit(SaveLUT);
		err := SetFPos(f, FSFromStart, 0);
		ByteCount := SizeOf(LUT);
		err := fswrite(f, ByteCount, @LUT);
		if CheckIO(err) <> 0 then begin
				err := fsclose(f);
				err := FSDelete(fname, RefNum);
				exit(SaveLUT)
			end;
		err := SetEof(f, ByteCount);
		err := fsclose(f);
		err := GetFInfo(fname, RefNum, TheInfo);
		if TheInfo.fdCreator <> 'Imag' then begin
				TheInfo.fdCreator := 'Imag';
				err := SetFInfo(fname, RefNum, TheInfo);
			end;
		err := FlushVol(nil, RefNum);
	end;


	procedure SaveColorTable (fname: str255; RefNum: integer);
		var
			err: integer;
			TheInfo: FInfo;
			i, f: integer;
			ByteCount: LongInt;
			hdr: PaletteHeader;
	begin
		with info^ do
			err := GetFInfo(fname, RefNum, TheInfo);
		case err of
			NoErr: 
				if TheInfo.fdType <> 'ICOL' then begin
						TypeMismatch(fname);
						exit(SaveColorTable)
					end;
			FNFerr:  begin
					err := create(fname, RefNum, 'Imag', 'ICOL');
					if CheckIO(err) <> 0 then
						exit(SaveColorTable);
				end;
			otherwise
				if CheckIO(err) <> 0 then
					exit(SaveColorTable);
		end;
		with info^ do begin
				InitPaletteHeader(hdr);
				err := fsopen(fname, RefNum, f);
				if CheckIO(err) <> 0 then
					exit(SaveColorTable);
				err := SetFPos(f, FSFromStart, 0);
				ByteCount := SizeOf(PaletteHeader);
				if ByteCount <> 32 then
					PutError('Palette header size <> 32.');
				err := fswrite(f, ByteCount, @hdr);
				ByteCount := nColors;
				err := fswrite(f, ByteCount, @redLUT);
				ByteCount := nColors;
				err := fswrite(f, ByteCount, @greenLUT);
				ByteCount := nColors;
				err := fswrite(f, ByteCount, @blueLUT);
				if CheckIO(err) <> 0 then begin
						err := fsclose(f);
						err := FSDelete(fname, RefNum);
						exit(SaveColorTable)
					end;
				err := SetEOF(f, SizeOf(PaletteHeader) + 3 * nColors);
				err := fsclose(f);
				err := GetFInfo(fname, RefNum, TheInfo);
				if TheInfo.fdCreator <> 'Imag' then begin
						TheInfo.fdCreator := 'Imag';
						err := SetFInfo(fname, RefNum, TheInfo);
					end;
				err := FlushVol(nil, RefNum);
			end; {with info^}
	end;


	procedure SaveOutline (fname: str255; RefNum: integer);
		var
			err: integer;
			TheInfo: FInfo;
			i, f: integer;
			ByteCount, DataSize: LongInt;
			hdr: RoiHeader;
			SaveCoordinates: boolean;
			dX1, dY1, dX2, dY2: extended;
	begin
		with info^ do begin
				if not RoiShowing then begin
						PutError('No outline available to save.');
						exit(SaveOutline);
					end;
				if (RoiType = FreeLineRoi) or (RoiType = SegLineRoi) then begin
						PutError('Freehand and segmented line selections cannot be saved.');
						exit(SaveOutline);
					end;
				SaveCoordinates := (RoiType = PolygonRoi) or (RoiType = FreehandRoi) or (RoiType = TracedRoi);
				if SaveCoordinates then
					if not CoordinatesAvailableMsg then begin
							exit(SaveOutline);
						end;
				err := GetFInfo(fname, RefNum, TheInfo);
				case err of
					NoErr: 
						if TheInfo.fdType <> 'Iout' then begin
								TypeMismatch(fname);
								exit(SaveOutline)
							end;
					FNFerr:  begin
							err := create(fname, RefNum, 'Imag', 'Iout');
							if CheckIO(err) <> 0 then
								exit(SaveOutline);
						end;
					otherwise
						if CheckIO(err) <> 0 then
							exit(SaveOutline);
				end;
				with hdr do begin
						rID := 'Iout';
						rVersion := version;
						rRoiType := RoiType;
						rRoiRect := RoiRect;
						rNCoordinates := nCoordinates;
						GetLoi(dX1, dY1, dX2, dY2);
						rX1:=dX1; rY1:=dY1; rX2:=dX2; rY2:=dY2;
						rLineWidth := LineWidth;
						for i := 1 to 14 do
							rUnused[i] := 0;
					end;
				err := fsopen(fname, RefNum, f);
				if CheckIO(err) <> 0 then
					exit(SaveOutline);
				err := SetFPos(f, FSFromStart, 0);
				ByteCount := SizeOf(RoiHeader);
				if ByteCount <> 64 then
					PutError('Roi header size <> 32.');
				err := fswrite(f, ByteCount, @hdr);
				if SaveCoordinates then begin
						ByteCount := nCoordinates * 2;
						err := fswrite(f, ByteCount, ptr(xCoordinates));
						ByteCount := nCoordinates * 2;
						err := fswrite(f, ByteCount, ptr(yCoordinates));
						DataSize := nCoordinates * 4;
					end
				else
					DataSize := 0;
				if CheckIO(err) <> 0 then begin
						err := fsclose(f);
						err := FSDelete(fname, RefNum);
						exit(SaveOutline)
					end;
				err := SetEOF(f, SizeOf(RoiHeader) + DataSize);
				err := fsclose(f);
				err := GetFInfo(fname, RefNum, TheInfo);
				if TheInfo.fdCreator <> 'Imag' then begin
						TheInfo.fdCreator := 'Imag';
						err := SetFInfo(fname, RefNum, TheInfo);
					end;
				err := FlushVol(nil, RefNum);
			end; {with info^}
	end;


	procedure OpenOutline (fname: str255; RefNum: integer);
		var
			err, f, i: integer;
			count: LongInt;
			hdr: RoiHeader;
			okay: boolean;
	begin
		if Info = NoInfo then begin
				if (NewPicWidth * NewPicHeight) <= UndoBufSize then begin
						if not NewPicWindow('Untitled', NewPicWidth, NewPicHeight) then
							exit(OpenOutline)
					end
				else begin
						beep;
						exit(OpenOutline)
					end;
			end;
		KillRoi;
		err := fsopen(fname, RefNum, f);
		with info^, hdr do begin
				count := SizeOf(RoiHeader);
				err := fsread(f, count, @hdr);
				if rID <> 'Iout' then begin
						err := fsclose(f);
						PutError('File is corrupted.');
						exit(OpenOutline)
					end;
				if (rRoiRect.right > PicRect.right) or (rRoiRect.bottom > PicRect.bottom) then begin
						err := fsclose(f);
						PutError('Image is too small for the outline.');
						exit(OpenOutline)
					end;
				case rRoiType of
					LineRoi:  begin
							LX1 := rX1;
							LY1 := rY1;
							LX2 := rX2;
							LY2 := rY2;
							RoiType := LineRoi;
							MakeRegion;
							SetupUndo;
							RoiShowing := true;
						end;
					RectRoi, OvalRoi:  begin
							RoiType := rRoiType;
							RoiRect := rRoiRect;
							MakeRegion;
							SetupUndo;
							RoiShowing := true;
						end;
					PolygonRoi, FreehandRoi, TracedRoi: 
						if (rNCoordinates > 2) and (rNCoordinates <= MaxCoordinates) then begin
								count := rNCoordinates * 2;
								err := fsread(f, count, ptr(xCoordinates));
								count := rNCoordinates * 2;
								err := fsread(f, count, ptr(yCoordinates));
								if CheckIO(err) = 0 then begin
										nCoordinates := rNCoordinates;
										SelectionMode := NewSelection;
										if rVersion >= 148 then
											for i := 1 to nCoordinates do
												with rRoiRect do begin
														xCoordinates^[i] := xCoordinates^[i] + left;
														yCoordinates^[i] := yCoordinates^[i] + top;
													end;
										MakeOutline(rRoiType);
										SetupUndo;
									end;
							end;
				end;
			end;
		err := fsclose(f);
	end;


	function GetTIFFParameters (name: str255; RefNum: integer; var HasColorMap: boolean): boolean;
		var
			err: OSErr;
			f: integer;
			DirOffset: LongInt;
			TiffInfo: TiffInfoRec;
	begin
		GetTIFFParameters := false;
		HasColorMap := false;
		err := fsopen(name, RefNum, f);
		if err <> NoErr then
			exit(GetTIFFParameters);
		if not OpenTiffHeader(f, DirOffset) then begin
				err := fsclose(f);
				exit(GetTIFFParameters)
			end;
		if not OpenTiffDirectory(f, DirOffset, TiffInfo, true) then begin
				err := fsclose(f);
				exit(GetTIFFParameters)
			end;
		with TiffInfo do begin
				ImportCustomWidth := width;
				ImportCustomHeight := height;
				ImportCustomOffset := OffsetToData;
				ImportAutoScale:=true;
				if BitsPerPixel = 16 then begin
						ImportCustomDepth := SixteenBitsUnsigned;
						ImportSwapBytes := IntelByteOrder;
					end
				else begin
						ImportCustomDepth := EightBits;
						ImportInvert := ZeroIsBlack;
					end;
				HasColorMap := OffsetToColorMap > 0;
			end;
		if ImportCustomDepth = EightBits then begin
			WhatToImport := ImportTiff;
			WhatToOpen := OpenTiff
		end else begin
			WhatToImport := ImportCustom;
			WhatToOpen := OpenCustom
		end;
		err := fsclose(f);
		GetTIFFParameters := true;
	end;


	procedure GetXUnits (UnitsKind: UnitsType);
	begin
		with info^ do
			case UnitsKind of
				Nanometers: 
					xUnit := 'nm';
				Micrometers: 
					xUnit := 'µm';
				Millimeters: 
					xUnit := 'mm';
				Centimeters: 
					xUnit := 'cm';
				Meters: 
					xUnit := 'meter';
				Kilometers: 
					xUnit := 'km';
				Inches: 
					xUnit := 'inch';
				feet: 
					xUnit := 'ft';
				Miles: 
					xUnit := 'mile';
				Pixels: 
					xUnit := 'pixel';
				otherwise
					;
			end;
	end;


	procedure GetUnitsKInd (var UnitsKind: UnitsType; var UnitsPerCM: extended);
	begin
		with info^ do begin
				if xunit = 'nm' then begin
						UnitsKind := Nanometers;
						UnitsPerCm := 10000000.0;
					end
				else if xUnit = 'µm' then begin
						UnitsKind := Micrometers;
						UnitsPerCm := 10000.0;
					end
				else if xUnit = 'mm' then begin
						UnitsKind := Millimeters;
						UnitsPerCm := 10.0;
					end
				else if xUnit = 'cm' then begin
						UnitsKind := Centimeters;
						UnitsPerCm := 1.0;
					end
				else if xUnit = 'meter' then begin
						UnitsKind := Meters;
						UnitsPerCm := 0.01;
					end
				else if xUnit = 'km' then begin
						UnitsKind := Kilometers;
						UnitsPerCm := 0.00001;
					end
				else if xUnit = 'inch' then begin
						UnitsKind := Inches;
						UnitsPerCm := 0.3937;
					end
				else if xUnit = 'ft' then begin
						UnitsKind := feet;
						UnitsPerCm := 0.0328083;
					end
				else if xUnit = 'mile' then begin
						UnitsKind := Miles;
						UnitsPerCm := 0.000006213;
					end
				else if xUnit = 'pixel' then begin
						UnitsKind := pixels;
						UnitsPerCm := 0.0;
						SpatiallyCalibrated := false;
					end
				else begin
						UnitsKind := OtherUnits;
						UnitsPerCm := 0.0;
					end;
			end;
	end;
	

	function OpenMovieToolbox:boolean;
	var
		result: LongInt;
		err: OSErr;
	begin
		if MovieToolboxInitialized then begin
			OpenMovieToolbox := true;
			exit(OpenMovieToolbox);
		end;
		if Gestalt(gestaltQuickTime, result) <> noErr then begin
			ShowMessage('QuickTime Required');
			OpenMovieToolbox := false;
			exit(OpenMovieToolbox);
		end;
		err := EnterMovies;
		if (err <> noErr) then begin
			PutMessage('QuickTime Required');
			OpenMovieToolbox := false;
			exit(OpenMovieToolbox);
		end;
		MovieToolboxInitialized := true;
		OpenMovieToolbox := true;
	end;
	

	function OpenQuickTime (name: str255; fRefNum: integer; UseExistingLUT: boolean): boolean;
    {Written 3/25/94 by Eric Shelden (shelden@umich.edu)}
		const
			forwardNormalSpeed = $00010000;

		var
			RefNum, picID, hOffset, vOffset, nPICS, i: integer;
			err: OSErr;
			PicH: PicHandle;
			h: handle;
			MemError, Aborted: boolean;
			FrameRect: rect;
			movieResRefNum, actualResId, verb: integer;
			theMovie: Movie;
			theTrack, videoTrack: Track;
			theMedia: Media;
			inTime, trackOffset, trackEnd, sampleTime: TimeValue;
			mySpec: FSSpec;
			TheInfo: FInfo;
			fName: Str255;
			check: Boolean;
			trackCount, count: LongInt;
			mediaType, manuf: OSType;
			imageCTable: CTabHandle;
			imageDescH: ImageDescriptionHandle;
			pInfo: PictInfo;
			creatorName: str255;
			SavePort: GrafPtr;
			SaveGDevice: GDHandle;

		procedure Abort;
		begin
			err := CloseMovieFile(movieResRefNum);
			exit(OpenQuickTime);
		end;

	begin
		OpenQuickTime := false;
		check := FALSE;
		sampleTime := 0;
		if MaxBlock < MinFree then begin
				PutError('Insufficient memory to open QuickTime movie.');
				exit(OpenQuickTime);
			end;
		ShowWatch;
		if not OpenMovieToolbox then
			exit(OpenQuickTime);
		err := GetFInfo(name, fRefNum, TheInfo);
		err := FSMakeFSSpec(fRefNum, 0, name, mySpec);
		err := OpenMovieFile(mySpec, movieResRefNum, fsRdPerm);
		if (err <> noErr) then begin
			PutError('QuickTime Error');
			exit(OpenQuickTime);
		end;
		actualResId := DoTheRightThing;
		err := NewMovieFromFile(theMovie, movieResRefNum, actualResId, nil, newMovieActive, check);
		trackCount := GetMovieTrackCount(theMovie);
		videoTrack := nil;
		for i := 1 to trackCount do begin
				videoTrack := GetMovieIndTrack(theMovie, i);
				creatorName := '';
				GetMediaHandlerDescription(GetTrackMedia(videoTrack), mediaType, creatorName, manuf);
				if (mediaType = 'vide') then
					i := trackCount + 1
				else
					videoTrack := nil;
			end;

		if (videoTrack = nil) then begin
				PutError('No Movie Pictures found.');
				abort;
			end;

		GetMovieBox(theMovie, FrameRect);
		with FrameRect do begin
				hOffset := left;
				vOffset := top;
				right := right - hOffset;
				bottom := bottom - vOffset;
				left := 0;
				top := 0;
			end;

		with FrameRect do
			if not NewPicWindow(name, right - left, bottom - top) then
				Abort;

		with info^ do begin
				revertable := false;
				StackInfo := StackInfoPtr(NewPtr(SizeOf(StackInfoRec)));
				if StackInfo = nil then
					Abort;
				with StackInfo^ do begin
						SliceSpacing := 0.0;
						nSlices := 1;
						CurrentSlice := 1;
						PicBaseH[1] := PicBaseHandle;
					end;
			end;

		trackEnd := GetTrackDuration(videoTrack);
		trackOffset := GetTrackOffset(videoTrack);
		inTime := trackOffset;
		PicH := GetTrackPict(videoTrack, inTime);
		{
		verb := returnColorTable;
		err := GetPictInfo(PicH, pInfo, verb, 256, systemMethod, 0);
		if not UseExistingLUT then begin
			LoadColorTable(pInfo.theColorTable);
			DrawLUT;
		end;
		}

		with info^, Info^.StackInfo^ do begin
				SaveGDevice := GetGDevice;
				SetGDevice(osGDevice);
				GetPort(SavePort);
				SetPort(GrafPtr(osPort));
				pmBackColor(WhiteIndex);
				EraseRect(PicRect);
				DrawPicture(PicH, PicRect);
				DisposeHandle(handle(PicH));
				UpdatePicWindow;
				MemError := false;
				picID := 0;

				while (inTime <> -1) do begin
						GetTrackNextInterestingTime(videoTrack, nextTimeMediaSample, inTime, forwardNormalSpeed, inTime, sampleTime);
						if (inTime = -1) then
							Leave;
						picH := GetTrackPict(videoTrack, inTime);
						if (PicH = nil) or (ResError <> NoErr) then
							Leave;
						h := GetBigHandle(PixMapSize);

						if h = nil then begin
								if PicH <> nil then
									DisposeHandle(handle(picH));
								MemError := true;
								Leave;
							end;

						nSlices := nSlices + 1;
						CurrentSlice := CurrentSlice + 1;
						PicBaseH[CurrentSlice] := h;
						SelectSlice(CurrentSlice);
						FrameRect := PicH^^.PicFrame;

						with FrameRect do begin
								right := right - hOffset;
								bottom := bottom - vOffset;
								left := left - hOffset;
								top := top - vOffset;
							end;

						EraseRect(PicRect);
						if not EqualRect(FrameRect, PicRect) then
							BlockMove(PicBaseH[CurrentSlice - 1]^, PicBaseH[CurrentSlice]^, PixMapSize);
						DrawPicture(picH, FrameRect);
						DisposeHandle(handle(picH));
						UpdatePicWindow;
						SetGDevice(SaveGDevice);
						UpdateTitleBar;
						SetGDevice(osGDevice);
						Aborted := CommandPeriod;

						if Aborted then begin
								beep;
								wait(60);
								Leave;
							end;

						picID := picID + 1;
					end; {for}

				err := CloseMovieFile(movieResRefNum);
				if MemError then
					PutError('Not enough memory to open all images in MooV file.');
				CurrentSlice := 1;
				SelectSlice(CurrentSlice);
				PictureType := PicsFile;
				Revertable := false;
				SetPort(SavePort);
				SetGDevice(SaveGDevice);
				UpdateTitleBar;
				UpdateWindowsMenuItem;
				if not MemError and not Aborted then
					OpenQuickTime := true;
			end; {with}

	end;


	procedure SaveAsQuickTime (fname: str255; fRefNum: integer);
	{Written by Eric A. Shelden (shelden@umich.edu) 3/23/94}
		const
			rErr = 'Error Saving QuickTime file.';
		var
			err: OSErr;
			TheInfo: FInfo;
			replacing: boolean;
			rRefNum, i, SaveCS: integer;
			frect: rect;
			PicH: array[1..MaxSlices] of PicHandle;
			MinFreeRequired: LongInt;

			theTimeSettings: SCTemporalSettings;
			theRateSettings: SCDataRateSettings;
			theSpaceSettings: SCSpatialSettings;
			myComponentPtr: ptr;
			framesPerSecond, maxCompressedSize, curSample: longint;
			myResult: ComponentResult;
			myComponentInstance: ComponentInstance;
			mySpec: FSSpec;
			theSFR: StandardFileReply;
			resRefNum, resID: integer;
			theMovie: Movie;
			movieData: MovieRecord;
			theTrack: Track;
			theMedia: Media;
			trackFrame: Rect;
			theGWorld: GWorldPtr;
			compressedData: Handle;
			compressedDataptr: Ptr;
			imageDesc: ImageDescriptionHandle;
			thePixMap: PixMapHandle;
			check: Boolean;
			oldPort: CGrafPtr;
			oldGDeviceH: GDHandle;
			myTimeScale, actualTime: TimeScale;
			testflags: integer;

	begin
		with info^, Info^.StackInfo^ do begin
				if ImageSize > MinFree then
					MinFreeRequired := ImageSize
				else
					MinFreeRequired := MinFree;
				if MaxBlock < MinFreeRequired then begin
						PutError('Not enough memory available to save in QuickTime format.');
						exit(SaveAsQuickTime);
					end;
				if not OpenMovieToolbox then
					exit(SaveAsQuickTime);
				err := GetFInfo(fname, fRefNum, TheInfo);
				if err = NoErr then
					with TheInfo do begin
							if (fdType <> 'TIFF') and (fdType <> 'PICT') and (fdType <> 'PICS') and (fdType <> 'MooV') then begin
									TypeMismatch(fname);
									exit(SaveAsQuickTime)
								end;
							err := FSDelete(fname, fRefNum);
						end;

				SaveCS := CurrentSlice;
				SetPort(GrafPtr(osPort));
				with PicRect do
					SetRect(frect, 0, 0, right - left, bottom - top);
				ClipRect(frect);
				LoadLUT(ctable);
				pmForeColor(BlackIndex);
				pmBackColor(WhiteIndex);
				if OldSystem then begin
						RGBForeColor(BlackRGB);
						RGBBackColor(WhiteRGB);
					end;

				testflags := 0;
				theGWorld := osPort;
				thePixMap := GetGWorldPixMap(theGWorld);
				check := LockPixels(thePixMap);
				myComponentInstance := OpenDefaultComponent('scdi', 'imag');
				{myResult := SCSetTestImagePixMap(myComponentInstance, thePixMap, @frect, testflags);}
				myResult := SCRequestSequenceSettings(myComponentInstance);
				if (myResult = 1) then begin
						myResult := CloseComponent(myComponentInstance);
						exit(SaveAsQuickTime);
					end;
				if (myResult = -50) then begin
						myResult := CloseComponent(myComponentInstance);
						PutError('Invalid Parameter detected.');
						exit(SaveAsQuickTime);
					end;
				myResult := SCGetInfo(myComponentInstance, 'sptl', ptr(@theSpaceSettings));
				myResult := SCGetInfo(myComponentInstance, scTemporalSettingsType, ptr(@theTimeSettings));
				myResult := SCGetInfo(myComponentInstance, scDataRateSettingsType, ptr(@theRateSettings));
				myResult := CloseComponent(myComponentInstance);
				UnlockPixels(thePixMap);
				framesPerSecond := longint(theTimeSettings.frameRate);
				framesPerSecond := framesPerSecond div 65536;
				resRefNum := 0;
				theMovie := nil;

				ShowWatch;

				err := FSMakeFSSpec(fRefNum, 0, fname, mySpec);
				err := CreateMovieFile(mySpec, 'TVOD', $FE, createMovieFileDeleteCurFile, resRefNum, theMovie);
				if (err <> 0) then begin
						PutError(rErr);
						exit(SaveAsQuickTime);
					end;
				trackFrame := fRect;
				theTrack := NewMovieTrack(theMovie, FixRatio(trackFrame.right, 1), FixRatio(trackFrame.bottom, 1), kNoVolume);
				theMedia := NewTrackMedia(theTrack, 'vide', TimeScale(60), nil, '    ');
				err := BeginMediaEdits(theMedia);

				check := LockPixels(thePixMap);
				err := GetMaxCompressionSize(thePixMap, trackFrame, theSpaceSettings.depth, theSpaceSettings.spatialQuality, theSpaceSettings.codecType, CompressorComponent(theSpaceSettings.codec), maxCompressedSize);
				compressedData := NewHandle(maxCompressedSize);
				if (compressedData = nil) or (MemError <> 0) then begin
						err := EndMediaEdits(theMedia);
						if (theMovie <> Movie(0)) then begin
								err := CloseMovieFile(resRefNum);
								DisposeMovie(theMovie);
								PutError(rErr);
								exit(SaveAsQuickTime);
							end;
					end;
				MoveHHi(compressedData);
				HLock(compressedData);
				compressedDataPtr := StripAddress(compressedData^);
				imageDesc := ImageDescriptionHandle(NewHandle(4));
				myTimeScale := 60 div framesPerSecond;
				GetGWorld(oldPort, oldGDeviceH);
				SetGWorld(theGWorld, nil);
				for i := 1 to nSlices do begin
						CurrentSlice := i;
						SelectSlice(CurrentSlice);
						err := CompressImage(thePixMap, trackFrame, theSpaceSettings.spatialQuality, theSpaceSettings.codecType, imageDesc, compressedDataPtr);
						err := AddMediaSample(theMedia, compressedData, 0, imageDesc^^.dataSize, myTimeScale, SampleDescriptionHandle(imageDesc), 1, 0, actualTime);
					end;
				UnlockPixels(thePixMap);
				SetGWorld(oldPort, oldGDeviceH);
				if (imageDesc <> nil) then
					DisposeHandle(Handle(imageDesc));
				if (compressedData <> nil) then
					DisposeHandle(Handle(compressedData));

				err := EndMediaEdits(theMedia);
				err := InsertMediaIntoTrack(theTrack, 0, 0, GetMediaDuration(theMedia), fixed1);

				err := AddMovieResource(theMovie, resRefNum, resID, fname);
				if (resRefNum <> 0) then
					err := CloseMovieFile(resRefNum);
				DisposeMovie(theMovie);

				CurrentSlice := SaveCS;
				SelectSlice(CurrentSlice);
				title := fname;
				PictureType := PicsFile;
				UpdateTitleBar;

				UpdateWindowsMenuItem;
				pmForeColor(ForegroundIndex);
				pmBackColor(BackgroundIndex);
			end; {with}
	end;
	
	

end.