unit File1;

{Routines used by Image for implementing File Menu commands.}

interface


	uses
		QuickDraw, OSIntf, PickerIntf, PrintTraps, ToolIntf, globals, Utilities, Graphics, file2;


	function CloseAWindow (WhichWindow: WindowPtr): integer;
	function OpenFile (fname: str255; vnum: integer): boolean;
	function OpenPict (fname: str255; vnum: integer; Reverting: boolean): boolean;
	procedure SaveFile;
	procedure DoOpen;
	procedure ImportFile;
	procedure RevertToSaved;
	procedure SaveSettings;
	procedure SaveAs;
	procedure UpdateFileMenu;
	procedure SaveAsText (reply: SFReply);
	procedure DoSave;
	procedure SaveAll;
	procedure UpdateWindowsMenuItem (PicSize: LongInt; title: str255; PicNum: integer);



implementation

	var
		OpenAllFiles, UseExistingLUT: boolean;
		SaveReply: SFReply;
		gstr: str255;

	function IOCheck (err: OSerr): integer;
		var
			ErrStr, Message: str255;
			ignore: integer;
	begin
		if err <> 0 then begin
				Message := '';
				case err of
					-34: 
						Message := 'Disk Full';
					-43: 
						Message := 'Disk Directory Full';
					-49: 
						Message := 'File in Use';
				end;
				NumToString(err, ErrStr);
				ParamText(Message, ErrStr, '', '');
				InitCursor;
				ignore := alert(IOErrorID, nil);
			end;
		IOCheck := err;
	end;


	procedure SaveCustomClut (fname: str255; vnum: integer);
		var
			RefNum: integer;
			err: OSErr;
			MyColorTable: record
					ctSeed: LONGINT;
					transIndex: INTEGER;
					ctSize: INTEGER;
					ctTable: MyCSpecArray;
				end;
			TempH: Handle;
			Size: LongInt;
	begin
		err := SetVol(nil, vnum);
		CreateResFile(fname);
		refNum := OpenResFile(fname);
		TempH := GetResource('clut', KlutzID);
		if GetHandleSize(TempH) > 0 then
			RmveResource(TempH);
		size := SizeOF(MyColorTable);
		TempH := NewHandle(size);
		with MyColorTable do begin
				ctSeed := 0;
				TransIndex := 0;
				ctsize := 255;
				ctTable := info^.cTable;
			end;
		BlockMove(@MyColorTable, TempH^, size);
		AddResource(TempH, 'clut', KLutzID, '');
		WriteResource(TempH);
		DisposHandle(TempH);
		CloseResFile(refNum);
	end;


	procedure LookForCluts (fname: str255; vnum: integer);
		var
			RefNum: integer;
			err: OSErr;
			ok1, ok2: boolean;
	begin
		if not UseExistingLUT then begin
				err := SetVol(nil, vnum);
				refNum := OpenResFile(fname);
				if RefNum <> -1 then begin
						ok1 := LoadCLUTResource(KlutzID);
						if not ok1 then
							ok2 := LoadCLUTResource(PixelPaintID);
						CloseResFile(refNum);
					end;
			end;
	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;


	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);
						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), cr);
						ShowMessage(gstr);
					end;
			end;
	end;


	function OpenTiffHeader (f: integer): boolean;
		const
			NoUnit = 1;
			inch = 2;
			centimeter = 3;
		var
			TiffHeader: TiffHdr;
			offset, ByteCount, length, ftype, N, value, PixelsPerStrip, 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;
		ByteCount := 8;
		err := SetFPos(f, fsFromStart, 0);
		err := fsread(f, ByteCount, @TiffHeader);
		with TiffHeader do begin
				IntelByteOrder := ByteOrder = 'II';
				if (ByteOrder <> 'MM') and (ByteOrder <> 'II') then begin
						PutMessage('Invalid TIFF header.');
						OpenTiffHeader := false;
						exit(OpenTiffHeader)
					end;
				offset := FirstIFDOffset;
				if IntelByteOrder then
					Swap4Bytes(offset);
				err := SetFPos(f, fsFromStart, Offset);
				if IOCheck(err) <> NoErr then begin
						OpenTiffHeader := false;
						exit(OpenTiffHeader);
					end;
				ByteCount := 2;
				err := FSRead(f, ByteCount, @nEntries);
				if IntelByteOrder then
					Swap2Bytes(nEntries);
				with info^ do begin
						PixelsPerLine := 0;
						nLines := 0;
						offset := 0;
						ImageDataOffset := 0;
						for entry := 1 to nEntries do begin
								GetTiffEntry(f, tag, N, value);
								if tag = 0 then begin
										PutMessage('Invalid TIFF format.');
										OpenTiffHeader := false;
										exit(OpenTiffHeader)
									end;
								case tag of
									ImageWidth: 
										PixelsPerLine := value;
									ImageLength: 
										nLines := value;
									BitsPerSample: 
										begin
											if value = 4 then
												PictureType := FourBitTiff;
											if value = 1 then begin
													PutMessage('Image cannot open 1-bit TIFF files.');
													OpenTiffHeader := false;
													exit(OpenTiffHeader)
												end;
										end;
									Compression: 
										if value <> 1 then begin
												PutMessage('Image cannot open compressed TIFF files.');
												OpenTiffHeader := false;
												exit(OpenTiffHeader)
											end;
									PhotoInterp: 
										if (value = 1) and (PictureType <> FourBitTIFF) then
											PictureType := InvertedTiff;
									StripOffsets: 
										if N = 1 then
											ImageDataOffset := 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 value < nLines then begin
												PixelsPerStrip := value * PixelsPerLine;
												if StripOffsetsArray[2] <> (StripOffsetsArray[1] + PixelsPerStrip) then begin
														PutMessage('Image cannot open TIFF files with discontiguous strips.');
														OpenTiffHeader := false;
														exit(OpenTiffHeader)
													end;
												ImageDataOffset := StripOffsetsArray[1];
											end;
									XResolution: 
										XRes := GetResolution;
									YResolution: 
										begin
											yRes := GetResolution;
											if (xRes = yRes) and (xRes > 0.0) then begin
													GetUnits(11); {inches}
													RawSpatialScale := xRes;
													SpatialScale := xRes;
													ScaleMagnification := 1.0;
												end;
										end;
									ResolutionUnit: 
										case value of
											NoUnit: 
												GetUnits(14); {pixels}
											Centimeter: 
												GetUnits(8);
											otherwise
										end;
									ImageHdrTag: 
										HeaderOffset := value;
									otherwise
								end;
							end; {for}
					end; {with}
			end;
		OpenTiffHeader := true;
	end;


	function OpenImageHeader (f: integer; fname: str255; vnum: integer): boolean;
		var
			ByteCount: LongInt;
			err: OSErr;
			TempHdr: PicHeader;
			i, OldNExtra: integer;
			ok: boolean;
	begin
		ByteCount := 512;
		err := SetFPos(f, fsFromStart, info^.HeaderOffset);
		err := fsread(f, ByteCount, @TempHdr);
		if IOCheck(err) <> NoErr then begin
				OpenImageHeader := false;
				exit(OpenImageHeader);
			end;
		with info^, TempHdr do begin
				if PictureType <> TiffFile then begin
						nlines := hnlines;
						PixelsPerLine := hPixelsPerLine;
					end;
				if (hversion > 54) and not UseExistingLUT then begin
						OldNExtra := nExtraColors;
						nExtraColors := hnExtraColors;
						ExtraColors := hExtraColors;
						if (nExtraColors > 0) or (OldNExtra <> nExtraColors) then
							RedrawCLUTWindow;
					end;
				if (hversion >= 42) and not UseExistingLUT then begin
						LUTMode := hLUTMode;
						case LUTMode of
							PseudoColor32: 
								begin
									nColors := hncolors;
									CheckColorWidth;
									for i := 0 to ncolors - 1 do begin
											RedX[i] := hr[i] * 255;
											GreenX[i] := hg[i] * 255;
											BlueX[i] := hb[i] * 255;
										end;
									ColorStart := hColorStart;
									ColorWidth := hColorWidth;
									UpdateColors;
								end;
							AppleDefault: 
								ok := LoadCLUTResource(AppleDefaultCLUT);
							Spectrum: 
								Load256ColorCLUT;
							GrayScale: 
								ResetGrayMap;
							Custom, CustomGrayscale: 
								if PictureType <> PictFile then
									LookForCluts(fname, vnum);
						end; {case}
						if hLutMode = CustomGrayscale then
							LutMode := CustomGrayscale;
					end;{if}
				if (hversion >= 65) and ((ForegroundIndex <> hForegroundIndex) or (BackgroundIndex <> hBackgroundIndex)) then begin
						SetForegroundColor(hForegroundIndex);
						SetBackgroundColor(hBackgroundIndex);
					end;
				if (hversion > 88) and (LUTMode = GrayScale) and not UseExistingLUT then begin
						p1x := hp1x;
						p1y := hp1y;
						p2x := hp2x;
						p2y := hp2y;
						SetGrayScaleLUT;
					end;
				if hversion > 106 then begin
						RawSpatialScale := hRawSpatialScale;
						if hversion > 124 then begin
								ScaleMagnification := hScaleMagnification;
								SpatialScale := hRawSpatialScale * ScaleMagnification;
							end
						else begin
								ScaleMagnification := 1.0;
								SpatialScale := hRawSpatialScale;
							end;
					end;
				GetUnits(hUnitsID);
				if hnCoefficients > 0 then begin
						fit := hfit;
						nCoefficients := hnCoefficients;
						Coefficient := hCoeff;
						UnitOfMeasure := hUM;
						Calibrated := true;
						GenerateValues;
					end
				else begin
						Calibrated := false;
						DrawLabels('', '', '');
					end;
				RestoringOutline := hContainsOutline;
				BinaryPic := hBinaryPic;
				if hThresholdEnd > 1 then begin
						ThresholdStart := hThresholdStart;
						ThresholdEnd := hThresholdEnd;
					end;
				OpenImageHeader := true
			end;
	end;


	function OpenHeader (f: integer; fname: str255; vnum: integer): boolean;
		var
			ByteCount: LongInt;
			hdr: packed array[1..512] of byte;
			err: OSErr;
			TempHdr: PicHeader;
	begin
		with info^ do begin
				if (WhatToOpen = OpenUnknown) or (WhatToOpen = OpenImported) then begin
						err := SetFPos(f, fsFromStart, 0);
						ByteCount := 8;
						err := fsread(f, ByteCount, @hdr);
						if ((hdr[1] = 73) and (hdr[2] = 73)) or ((hdr[1] = 77) and (hdr[2] = 77)) then
							WhatToOpen := OpenTIFF
						else if WhatToOpen = OpenUnknown then
							WhatToOpen := OpenImage
						else
							WhatToOpen := OpenMCID;
					end;
				case WhatToOpen of
					OpenImage: 
						begin
							err := SetFPos(f, fsFromStart, 0);
							ByteCount := 8;
							err := fsread(f, ByteCount, @TempHdr);
							if TempHdr.FileID = FileID8 then begin
									HeaderOffset := 0;
									PictureType := normal
								end
							else begin
									HeaderOffset := -1;
									BlockMove(@TempHdr, @hdr, 8);
									nlines := hdr[1] + hdr[2] * 256;
									PixelsPerLine := hdr[3] + hdr[4] * 256;
									PictureType := PDP11;
								end;
							ImageDataOffset := 512;
						end;
					OpenMCID: 
						begin
							err := SetFPos(f, fsFromStart, 0);
							ByteCount := 4;
							err := fsread(f, ByteCount, @hdr);
							PixelsPerLine := hdr[1] + hdr[2] * 256 + 1;
							if PixelsPerLine > MaxPixelsPerLine then begin
									beep;
									PixelsPerLine := MaxPixelsPerLine;
								end;
							nlines := hdr[3] + hdr[4] * 256 + 1;
							PictureType := imported;
							LUTMode := grayscale;
							HeaderOffset := -1;
							ImageDataOffset := 4;
						end;
					OpenCustom: 
						begin
							PixelsPerLine := ImportCustomWidth;
							nlines := ImportCustomHeight;
							PictureType := imported;
							HeaderOffset := -1;
							ImageDataOffset := ImportCustomOffset;
						end;
					OpenPICT2: 
						begin
							err := SetFPos(f, fsFromStart, 0);
							ByteCount := 8;
							err := fsread(f, ByteCount, @TempHdr);
							if TempHdr.FileID = FileID8 then
								HeaderOffset := 0
							else
								HeaderOffset := -1;
							PictureType := PictFile;
							LutMode := custom;
							ImageDataOffset := 512;
						end;
					OpenTIFF: 
						begin
							PictureType := TiffFile;
							ImageDataOffset := 0;
							HeaderOffset := -1;
							nlines := 100;
							PixelsPerLine := 100;
							if not OpenTiffHeader(f) then begin
									OpenHeader := false;
									exit(OpenHeader)
								end;
							if not UseExistingLUT then
								LutMode := Grayscale;
						end;
				end; {case}
				if HeaderOffset <> -1 then begin
						if not OpenImageHeader(f, fname, vnum) then begin
								OpenHeader := false;
								exit(OpenHeader)
							end
					end;
			end; {with}
		OpenHeader := true;
	end;


	function SaveHeader (f, slines, sPixelsPerLine, vnum: integer; fname: str255; SavingSelection, SavingTIFF: boolean): OSErr;
		var
			TempHdr: PicHeader;
			DummyHdr: array[1..128] of LongInt;
			i: integer;
			ByteCount: LongInt;
			position: LongInt;
			err: OSErr;
			str: str255;
	begin
		with TempHdr, info^ do begin
				for i := 1 to 128 do
					DummyHdr[i] := 0;
				BlockMove(@DummyHdr, @TempHdr, HeaderSize);
				FileID := FileID8;
				hnlines := nlines;
				hPixelsPerLine := PixelsPerLine;
				hversion := version;
				hLUTMode := LUTMode;
				hnColors := ncolors;
				if LUTMode = PseudoColor32 then
					for i := 0 to nColors - 1 do begin
							hr[i] := BSR(RedX[i], 8);
							hg[i] := BSR(GreenX[i], 8);
							hb[i] := BSR(BlueX[i], 8);
						end;
				hColorStart := ColorStart;
				hColorWidth := ColorWidth;
				hnExtraColors := nExtraColors;
				hExtraColors := ExtraColors;
				hForegroundIndex := ForegroundIndex;
				hBackgroundIndex := BackgroundIndex;
				hRawSpatialScale := RawSpatialScale;
				hScaleMagnification := ScaleMagnification;
				hUnitsID := ord(UnitsID) + 5;
				hp1x := p1x;
				hp1y := p1y;
				hp2x := p2x;
				hp2y := p2y;
				if not calibrated then
					hnCoefficients := 0
				else
					hnCoefficients := nCoefficients;
				hfit := fit;
				hCoeff := Coefficient;
				hUM := UnitOfMeasure;
				hContainsOutline := SavingOutline;
				hBinaryPic := BinaryPic;
				hThresholdStart := ThresholdStart;
				hThresholdEnd := ThresholdEnd;
				ByteCount := SizeOf(TempHdr);
				if ByteCount <> HeaderSize then begin
						NumToString(ByteCount, str);
						PutMessage('Internal error check: header size is incorrect.');
						ExitToShell;
					end;
				if SavingSelection then begin
						hnlines := slines;
						hPixelsPerLine := sPixelsPerLine;
					end;
				err := fswrite(f, ByteCount, @TempHdr);
				SaveHeader := IOCheck(err);
				if ((LutMode = Custom) or (LutMode = CustomGrayscale)) and SavingTIFF and (SaveAsWhat <> asRawData) then
					SaveCustomClut(fname, vnum);
			end; {with}
	end;


	function SaveTiffDirectory (f, slines, sPixelsPerLine: integer; SavingSelection: boolean): OSErr;
		var
			err: integer;
			ByteCount, width, height: LongInt;
	begin
		with info^ do begin
				if SavingSelection then begin
						width := sPixelsPerLine;
						height := sLines
					end
				else begin
						width := PixelsPerLine;
						height := nLines
					end;
				with TiffInfo do begin
						directory[2].offset := bsl(width, 16);
						directory[3].offset := bsl(height, 16);
					end;
			end;
		ByteCount := SizeOf(TiffInfo);
		err := SetFPos(f, FSFromStart, 0);
		err := FSWrite(f, ByteCount, @TiffInfo);
		SaveTiffDirectory := IOCheck(err);
	end;


	function SaveTiffFile (fname: str255; vnum: integer; slines, sPixelsPerLine: integer; SavingSelection: boolean): boolean;
		var
			f, err, i: integer;
			HdrSize, ByteCount, SelectionSize: LongInt;
			TheInfo: FInfo;
	begin
		SaveTiffFile := false;
		ShowWatch;
		err := fsopen(fname, vNum, f);
		if IOCheck(err) <> 0 then
			exit(SaveTiffFile);
		with Info^ do begin
				if SaveAsWhat <> asRawData then begin
						if SaveTiffDirectory(f, slines, sPixelsPerLine, SavingSelection) <> NoErr then begin
								err := fsclose(f);
								err := FSDelete(fname, vnum);
								exit(SaveTiffFile)
							end;
						err := SetFPos(f, FSFromStart, TiffDirSize);
						if SaveHeader(f, slines, sPixelsPerLine, vnum, fname, SavingSelection, true) <> NoErr then begin
								err := fsclose(f);
								err := FSDelete(fname, vnum);
								exit(SaveTiffFile)
							end;
					end;
				HeaderOffset := TiffDirSize;
				ImageDataOffset := TiffDirSize + HeaderSize;
				if SavingSelection then begin
						SelectionSize := LongInt(slines) * sPixelsPerLine;
						ByteCount := SelectionSize;
						err := fswrite(f, ByteCount, UndoBuf);
						SetupUndo; {Needed for drawing roi outline}
						WhatToUndo := NothingToUndo;
					end
				else begin
						ByteCount := PicSize;
						err := fswrite(f, ByteCount, PicBaseAddr);
						SelectionSize := 0
					end;
				if IOCheck(err) <> 0 then begin
						err := fsclose(f);
						err := FSDelete(fname, vnum);
						exit(SaveTiffFile)
					end;
				if SaveAsWhat = asRawData then
					HdrSize := 0
				else
					HdrSize := HeaderSize + TiffDirSize;
				if SavingSelection then
					err := SetEOF(f, SelectionSize + HdrSize)
				else
					err := SetEOF(f, PicSize + HdrSize);
				err := fsclose(f);
				err := GetFInfo(fname, vnum, TheInfo);
				if TheInfo.fdCreator <> 'IMAG' then begin
						TheInfo.fdCreator := 'IMAG';
						err := SetFInfo(fname, vnum, TheInfo);
					end;
				if SaveAsWhat = asRawData then begin
						TheInfo.fdType := 'RawD';
						err := SetFInfo(fname, vnum, TheInfo);
					end
				else if TheInfo.fdType <> 'TIFF' then begin
						TheInfo.fdType := 'TIFF';
						err := SetFInfo(fname, vnum, TheInfo);
					end;
				err := FlushVol(nil, vNum);
				if not SavingSelection then begin
						if (PictureType <> BlankField) and (PictureType <> QuickCaptureType) and (PictureType <> ScionType) and (SaveAsWhat <> asRawData) then begin
								PictureType := TiffFile;
								title := fname;
								ShowMagnification;
								vref := vnum;
							end;
					end;
				if SaveAsWhat <> asRawData then
					Changes := false;
			end; {with}
		SaveTiffFile := true;
	end;


	procedure UpdateWindowsMenuItem (PicSize: LongInt; title: str255; PicNum: integer);
		var
			str: str255;
	begin
		NumToString(PicSize div 1024, str);
		str := concat(title, '  ', str, 'K');
		SetItem(WindowsMenuH, PicNum + WindowsMenuItems, str);
	end;


	procedure SaveTiffAs (reply: SFReply; slines, sPixelsPerLine: integer; SavingSelection: boolean);
		var
			err: integer;
			TheInfo: FInfo;
			replacing, ok: boolean;
			name: str255;
	begin
		err := GetFInfo(reply.fname, reply.vRefNum, TheInfo);
		case err of
			NoErr: 
				with TheInfo do begin
						if (fdType <> 'TIFF') and (fdType <> 'PICT') and (fdType <> 'IPIC') and (fdType <> 'RawD') then begin
								TypeMismatch(reply.fname);
								exit(SaveTiffAs)
							end;
						replacing := true;
					end;
			FNFerr: 
				begin
					if SaveAsWhat = asRawData then
						err := create(reply.fname, reply.vRefNum, 'IMAG', 'RawD')
					else
						err := create(reply.fname, reply.vRefNum, 'IMAG', 'TIFF');
					if IOCheck(err) <> 0 then
						exit(SaveTiffAs);
					replacing := false;
				end;
			otherwise
				if IOCheck(err) <> 0 then
					exit(SaveTiffAs);
		end;
		ok := SaveTiffFile(reply.fname, reply.vRefNum, slines, sPixelsPerLine, SavingSelection);
		if ok then
			with info^ do
				UpdateWindowsMenuItem(PicSize, title, PicNum);
		with info^ do
			if SavingSelection and Replacing and (PictureType <> BlankField) and (PictureType <> QuickCaptureType) and (PictureType <> ScionType) then
				PictureType := Leftover;
	end;


	function SavePICTFile (fname: str255; vnum: integer; SavingSelection, NewFile: boolean): boolean;
		var
			f, err, i, v: integer;
			ByteCount, PICTSize: LongInt;
			PicH: PicHandle;
			fRect, frect2: rect;
			tPort: GrafPtr;
			TheInfo: FInfo;

		procedure Abort;
		begin
			err := fsclose(f);
			if NewFile then
				err := FSDelete(fname, vnum);
			DisposHandle(handle(PicH));
			SavingOutline := false;
			exit(SavePICTFile)
		end;

	begin
		with info^ do begin
				if OpPending then
					KillRoi;
				SavePICTFile := false;
				ShowWatch;
				GetPort(tPort);
				if SavingSelection then
					fRect := osRoiRect
				else
					SetRect(fRect, 0, 0, PixelsPerLine, nlines);
				with frect do
					SetRect(frect2, 0, 0, right - left, bottom - top);
				with osPort^ do begin
						SetPort(GrafPtr(osPort));
						SetRGBForeColor(BlackRGB, BlackIndex);
						SetRGBBackColor(WhiteRGB, WhiteIndex);
						ClipRect(PicRect);
						if (LUTMode = GrayScale) or (LUTMode = CustomGrayScale) then
							ResetGrayMap;
						LoadLUT(cTable);  {Restore look-up table in case it has changed.}
						PicH := OpenPicture(fRect2);
						if SavingOutline then begin
								PenNormal;
								FrameRgn(osroiRgn);
							end
						else begin
								hlock(handle(PortPixMap));
								CopyBits(BitMapHandle(PortPixMap)^^, BitMapHandle(PortPixMap)^^, frect, frect2, SrcCopy, nil);
								hunlock(handle(PortPixMap));
							end;
						ClosePicture;
						SetRGBForeColor(ForegroundRGB, BackgroundIndex);
						SetRGBBackColor(BackgroundRGB, BackgroundIndex);
					end;
				SetPort(tPort);
				PICTSize := GetHandleSize(handle(PicH));
				if PICTSize <= 10 then begin
						PutMessage('Sorry, but there is not enough memory available to save this PICT file. Try closing some windows, or save as TIFF.');
						if NewFile then
							err := FSDelete(fname, vnum);
						DisposHandle(handle(PicH));
						exit(SavePICTFile)
					end;
				err := fsopen(fname, vnum, f);
				err := SetFPos(f, FSFromStart, 0);
				if SaveHeader(f, 0, 0, vnum, fname, SavingSelection, false) <> 0 then
					abort;
				err := fswrite(f, PICTSize, pointer(PicH^));
				if IOCheck(err) <> 0 then
					abort;
				DisposHandle(handle(PicH));
				ByteCount := PICTSize + HeaderSize;
				err := SetEOF(f, ByteCount);
				err := fsclose(f);
				err := GetFInfo(fname, vnum, TheInfo);
				if TheInfo.fdCreator <> 'IMAG' then begin
						TheInfo.fdCreator := 'IMAG';
						err := SetFInfo(fname, vnum, TheInfo);
					end;
				if TheInfo.fdType <> 'PICT' then begin
						TheInfo.fdType := 'PICT';
						err := SetFInfo(fname, vnum, TheInfo);
					end;
				err := FlushVol(nil, vnum);
				if not SavingSelection then begin
						if (PictureType <> BlankField) and (PictureType <> QuickCaptureType) and (PictureType <> ScionType) and not SavingOutline then begin
								PictureType := PictFile;
								title := fname;
								ShowMagnification;
								vref := vnum;
							end;
						Changes := false;
					end;
			end; {with}
		SavePICTFile := true;
		SavingOutline := false;
	end;


	procedure SavePICTAs (reply: SFReply; SavingSelection: boolean);
		var
			f, err, i: integer;
			where: Point;
			TheInfo: FInfo;
			replacing, ok: boolean;
			name: str255;
	begin
		err := GetFInfo(reply.fname, reply.vRefNum, TheInfo);
		case err of
			NoErr: 
				with TheInfo do begin
						if (fdType <> 'TIFF') and (fdType <> 'PICT') and (fdType <> 'IPIC') then begin
								TypeMismatch(reply.fname);
								exit(SavePictAs)
							end;
						replacing := true;
					end;
			FNFerr: 
				begin
					err := create(reply.fname, reply.vRefNum, 'IMAG', 'PICT');
					if IOCheck(err) <> 0 then
						exit(SavePictAs);
					replacing := false;
				end;
			otherwise
				if IOCheck(err) <> 0 then
					exit(SavePictAs);
		end;
		ok := SavePICTFile(reply.fname, reply.vRefNum, SavingSelection, not Replacing);
		if ok then
			with info^ do
				UpdateWindowsMenuItem(PicSize, title, PicNum);
		with info^ do
			if SavingSelection and replacing and (PictureType <> BlankField) and (PictureType <> QuickCaptureType) and (PictureType <> ScionType) then
				PictureType := Leftover;
	end;


	procedure SaveSelection (reply: SFReply; SaveAsSameType: boolean);
		var
			size, offset: LongInt;
			i, slines, spixelsPerLine, hstart, vstart: integer;
			src, dst: ptr;
	begin
		if NoSelection or NotRectangular or NotInBounds then
			exit(SaveSelection);
		if OpPending then
			KillRoi;
		with info^ do begin
				with osRoiRect do begin
						sPixelsPerLine := right - left;
						if odd(sPixelsPerLine) and (left + sPixelsPerLine < PicRect.right) then
							sPixelsPerLine := sPixelsPerLine + 1;
						slines := bottom - top;
						size := LongInt(slines) * sPixelsPerLine;
						hstart := left;
						vstart := top;
					end;
				if (PictureType <> PictFile) or not SaveAsSameType then begin
						if size > UndoBufSize then begin
								PutMessage('There is not enough memory available to save the selection');
								exit(SaveSelection)
							end;
						offset := LongInt(vstart) * BytesPerRow + hstart;
						src := ptr(ord4(PicBaseAddr) + offset);
						dst := UndoBuf;
						for i := 0 to slines - 1 do begin
								BlockMove(src, dst, sPixelsPerLine);
								src := ptr(ord4(src) + BytesPerRow);
								dst := ptr(ord4(dst) + sPixelsPerLine);
							end;
					end;
				if (PictureType = PictFile) and SaveAsSameType and (SaveAsWhat <> asRawData) then
					SavePICTAs(reply, true)
				else
					SaveTiffAs(reply, slines, sPixelsPerLine, true);
			end;
	end;


	procedure SaveCameraWindow (reply: SFReply);
	begin
		SelectAll(true);
		SaveSelection(reply, false);
		KillRoi;
		info^.changes := false
	end;


	procedure SavePalette (reply: SFReply);
		var
			err: integer;
			TheInfo: FInfo;
			PaletteData: array[1..4] of ColorArray;
			i, f: integer;
			ByteCount: LongInt;
	begin
		if info^.LUTMode <> PseudoColor32 then begin
				PutMessage('You can only save pseudocolor palettes consisting of 32 or fewer colors.');
				exit(SavePalette)
			end;
		err := GetFInfo(reply.fname, reply.vRefNum, TheInfo);
		case err of
			NoErr: 
				if TheInfo.fdType <> 'ICOL' then begin
						TypeMismatch(reply.fname);
						exit(SavePalette)
					end;
			FNFerr: 
				begin
					err := create(reply.fname, reply.vRefNum, 'IMAG', 'ICOL');
					if IOCheck(err) <> 0 then
						exit(SavePalette);
				end;
			otherwise
				if IOCheck(err) <> 0 then
					exit(SavePalette);
		end;
		with info^ do begin
				PaletteData[1, 0] := ncolors;
				PaletteData[1, 1] := ColorStart;
				PaletteData[1, 2] := ColorWidth;
				for i := 3 to MaxPseudoColorsLessOne do
					PaletteData[1, i] := 0;
				for i := 0 to MaxPseudoColorsLessOne do begin
						PaletteData[2, i] := BSR(RedX[i], 8);
						PaletteData[3, i] := BSR(GreenX[i], 8);
						PaletteData[4, i] := BSR(BlueX[i], 8);
					end;
			end;
		with reply do begin
				err := fsopen(fname, vRefNum, f);
				if IOCheck(err) <> 0 then
					exit(SavePalette);
				err := SetFPos(f, FSFromStart, 0);
				ByteCount := MaxPseudoColors * 4;
				err := fswrite(f, ByteCount, @PaletteData);
				if IOCheck(err) <> 0 then begin
						err := fsclose(f);
						err := FSDelete(fname, vRefNum);
						exit(SavePalette)
					end;
				err := fsclose(f);
				err := FlushVol(nil, vRefNum);
			end;
	end;


	procedure SaveAsText (reply: SFReply);
		var
			err, f: integer;
			TheInfo: FInfo;
			ByteCount: LongInt;
	begin
		err := GetFInfo(reply.fname, reply.vRefNum, TheInfo);
		case err of
			NoErr: 
				if TheInfo.fdType <> 'TEXT' then begin
						TypeMismatch(reply.fname);
						exit(SaveAsText)
					end;
			FNFerr: 
				begin
					err := create(reply.fname, reply.vRefNum, 'MACA', 'TEXT');
					if IOCheck(err) <> 0 then
						exit(SaveAsText);
				end;
			otherwise
				if IOCheck(err) <> 0 then
					exit(SaveAsTExt)
		end;
		ShowWatch;
		with reply do
			err := fsopen(fname, vRefNum, f);
		if IOCheck(err) <> 0 then
			exit(SaveAsText);
		ByteCount := TextBufSize;
		err := fswrite(f, ByteCount, ptr(TextBufP));
		if IOCheck(err) <> 0 then
			exit(SaveAsText);
		err := SetEof(f, ByteCount);
		err := fsclose(f);
		err := FlushVol(nil, reply.vRefNum);
		if WhatsOnClip = TextOnClip then
			WhatsOnClip := Nothing;
	end;


	procedure SaveMeasurements (reply: SFReply);
		var
			SaveTool: ToolType;
			str: str255;
			ok: boolean;
	begin
		SaveTool := CurrentTool;
		ok := false;
		case SaveAsWhat of
			asRegions: 
				begin
					CurrentTool := SelectionTool;
					str := 'area';
					ok := nRegions > 0;
				end;
			asLengths: 
				begin
					CurrentTool := ruler;
					str := 'length';
					ok := nLengths > 0;
				end;
			asPoints: 
				begin
					CurrentTool := PointingTool;
					str := 'point';
					ok := nPoints > 0;
				end;
		end;
		if ok then begin
				CopyResultsToBuffer;
				SaveAsText(reply)
			end
		else
			PutMessage(concat('Sorry, but no ', str, ' measurements are available to save.'));
		CurrentTool := SaveTool;
	end;


	function SuggestedName: str255;
		var
			name: str255;
	begin
		case SaveAsWhat of
			asTiff, asPict, asMacPaint, asRawData: 
				begin
					name := info^.title;
					if name = 'Camera' then
						name := 'Untitled';
					SuggestedName := name;
				end;
			asPalette: 
				SuggestedName := ' Palette';
			asOutline: 
				SuggestedName := 'Outline';
			asRegions, asLengths, asPoints: 
				SuggestedName := 'Measurements';
			AsPlotValues: 
				SuggestedName := 'Plot Values';
			asHistogramValues: 
				SuggestedName := 'Histogram Values';
		end;
	end;


	function SaveAsHook (item: integer; theDialog: DialogPtr): integer;
		const
			EditTextID = 7;
			TiffID = 9;
			HistogramID = 19;
		var
			i: integer;
			fname: str255;
			NameEdited: boolean;
	begin
		if item = -1 then {Initialize}
			SetDialogItem(theDialog, TiffID + ord(SaveAsWhat), 1);
		fname := GetDString(theDialog, EditTextID);
		NameEdited := fname <> SuggestedName;
		if (item >= TiffID) and (item <= HistogramID) then begin
				SaveAsWhat := SaveAsWhatType(item - TiffID);
				if not NameEdited then begin
						SetDString(theDialog, EditTextID, SuggestedName);
						SelIText(theDialog, EditTextID, 0, 32767);
					end;
				for i := TiffID to HistogramID do
					SetDialogItem(theDialog, i, 0);
				SetDialogItem(theDialog, item, 1);
			end;
		SaveAsHook := item;
	end;


	procedure SaveAs;
		const
			CustomDialogID = 60;
		var
			where: Point;
			reply: SFReply;
			isSelection: boolean;
			kind: integer;
	begin
		where.v := 50;
		where.h := 50;
		with info^ do begin
				if SaveAllFlag = SaveAllStage2 then begin
						reply := SaveReply;
						reply.fname := title;
					end
				else
					SFPPutFile(Where, 'Save as?', SuggestedName, @SaveAsHook, reply, CustomDialogID, nil);
				if not reply.good then
					exit(SaveAs);
				if SaveAllFlag = SaveAllStage1 then begin
						SaveReply := reply;
						SaveAllFlag := SaveAllStage2;
					end;
				isSelection := RoiShowing and (RoiType = RectRoi);
				case SaveAsWhat of
					asTiff, asRawData: 
						if isSelection then
							SaveSelection(reply, false)
						else
							SaveTiffAs(reply, 0, 0, false);
					asPict: 
						if isSelection then
							SavePICTAs(reply, true)
						else
							SavePICTAs(reply, false);
					asMacPaint: 
						SaveAsMacPaint(reply);
					asPalette: 
						SavePalette(reply);
					asOutline: 
						begin
							SavingOutline := true;
							SavePICTAs(reply, false);
						end;
					asRegions, asLengths, asPoints: 
						SaveMeasurements(reply);
					AsPlotValues: 
						if PlotWindow <> nil then begin
								kind := WindowPeek(PlotWindow)^.WindowKind;
								case kind of
									ProfilePlotKind: 
										ConvertPlotToText;
									CalibrationPlotKind: 
										ConvertCalibrationCurveToText;
									otherwise
										TextBufSize := 0;
								end;
								SaveAsText(reply);
							end
						else
							beep;
					asHistogramValues: 
						if HistoWindow <> nil then begin
								ConvertHistoToText;
								SaveAsText(reply);
							end
						else
							beep;
					otherwise
						beep;
				end; {case}
				if SaveAsWhat = asRawData then
					SaveAsWhat := asTIFF;
			end; {with}
	end;


	procedure SaveFile;
		var
			fname: str255;
			size: LongInt;
			ok: boolean;
	begin
		if OpPending then
			KillRoi;
		with Info^ do begin
				fname := title;
				size := 0;
				if PictureType = TiffFile then
					ok := SaveTiffFile(fname, vref, 0, 0, false)
				else if PictureType = PictFile then
					ok := SavePICTFile(fname, vref, false, false)
				else begin
						SaveAsWhat := asTIFF;
						SaveAs;
					end;
			end;
	end;


	function SaveChanges: integer;
		const
			yesID = 1;
			noID = 2;
			cancelID = 3;
		var
			id: integer;
			reply: SFReply;
	begin
		id := 0;
		if info^.changes then
			with info^ do begin
					if CommandPeriod then begin
							SaveChanges := ok;
							exit(SaveChanges);
						end;
					ParamText(title, '', '', '');
					InitCursor;
					id := alert(600, nil);
					if id = yesID then begin
							SaveFile;
							InitCursor;
						end; {if yes}
				end; {if changes}
		if (id = cancelID) or ((id = yesID) and (info^.changes)) then
			SaveChanges := cancel
		else
			SaveChanges := ok;
	end;


	function CloseAWindow (WhichWindow: WindowPtr): integer;
		var
			i, kind, n: integer;
			TempInfo: InfoPtr;
			SizeStr, str: str255;
			wp: ^WindowPtr;
	begin
		kind := WindowPeek(WhichWindow)^.WindowKind;
		CloseAWindow := ok;
		case kind of
{$IFC Arlo }
   PicKind, FFTKind: 
{$ELSEC }
    PicKind: 
{$ENDC }
				begin
					Info := pointer(WindowPeek(WhichWindow)^.RefCon);
					with Info^ do begin
							if SaveChanges = cancel then begin
									CloseAWindow := cancel;
									exit(CloseAWindow)
								end;
							DelMenuItem(WindowsMenuH, PicNum + WindowsMenuItems);
							for i := PicNum to nPics - 1 do begin
									PicWindow[i] := PicWindow[i + 1];
									TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
									TempInfo^.PicNum := i
								end;
							if PictureType = QuickCaptureType then
								QuickCaptureInfo := nil;
							if PictureType = BlankField then
								BlankFieldInfo := nil;
							if PictureType = ScionType then
								ScionInfo := nil;
							DisposPtr(PicBaseAddr);
							DisposeWindow(WhichWindow);
							CloseCPort(osPort);
							Dispose(osPort);
							DisposeRgn(osroiRgn);
{$IFC Arlo }
     if (FHTBuf <> nil) then
     DisposPtr(FHTBuf);
     InFrequencyDomain := (WindowPeek(FrontWindow)^.WindowKind = FFTkind);
{$ENDC }
							nPics := nPics - 1;
							OpPending := false;
							isInsertionPoint := false;
							DisposPtr(pointer(Info));
							Info := NoInfo;
							if (nPics = 0) and (not finished) then
								with info^ do begin
										LoadLUT(info^.cTable);
										if (LutMode = GrayScale) or (LutMode = CustomGrayScale) then
											DrawGrayMap;
									end;
							PicLeft := PicLeftBase;
							PicTop := PicTopBase;
						end;
				end; {PicKind}
			HistoKind: 
				begin
					DisposeWindow(HistoWindow);
					HistoWindow := nil;
					ContinuousHistogram := false;
				end;
			ProfilePlotKind, CalibrationPlotKind: 
				begin
					DisposeWindow(PlotWindow);
					PlotWindow := nil;
					KillPicture(PlotPICT);
					PlotPICT := nil;
				end;
			PasteControlKind: 
				begin
					DisposeWindow(PasteControl);
					PasteControl := nil;
					wp := pointer(GhostWindow);
					wp^ := nil;
					SetMenuItem(GetMHandle(WindowsMenu), 9, false);
				end;
		end; {case}
	end;


	procedure Read4BitTIFF (f: integer);
		var
			vloc, hloc, i: integer;
			ByteCount, count: LongInt;
			err: OSErr;
			UnpackedLine, PackedLine: LineType;
	begin
		with info^ do begin
				if PixelsPerLine > MaxPixelsPerLine then
					exit(Read4BitTIFF);
				ByteCount := (PixelsPerLine + 1) div 2;
				for vloc := 0 to nLines - 1 do begin
						err := FSRead(f, ByteCount, @PackedLine);
						i := 0;
						for hloc := 0 to PixelsPerLine - 1 do
							if odd(hloc) then begin
									UnpackedLine[hloc] := bsl(band(PackedLine[i], $F), 4);
									i := i + 1;
								end
							else
								UnpackedLine[hloc] := band(PackedLine[i], $F0);
						PutLine(0, vloc, PixelsPerLine, UnpackedLine);
					end;
			end; {with}
	end;


	procedure Import16BitImage;
		type
			IntArrayType = packed array[0..5000000] of integer;
			IntArrayPtr = ^IntArrayType;
		var
			line: LineType;
			IntArray: IntArrayPtr;
			i, value, size16, min, max: LongInt;
			ScaleFactor, emin: extended;
			hloc, vloc, wwidth, wheight, IntValue: integer;
			tPort: GrafPtr;
	begin
		with info^ do begin
				IntArray := IntArrayPtr(PicBaseAddr);
				size16 := PicSize;
				min := 999999;
				max := -999999;
				for i := 0 to size16 - 1 do begin
						if ImportSwapBytes then begin
								IntValue := IntArray^[i];
								swap2bytes(IntValue);
								IntArray^[i] := IntValue;
							end;
						value := IntArray^[i];
						if (value < 0) and (ImportCustomDepth = SixteenBitsUnsigned) then
							value := value + 65536;
						if value > max then
							max := value;
						if value < min then
							min := value;
					end;
				ShowMessage(concat('min=', long2str(min), cr, 'max=', long2str(max)));
				ScaleFactor := 255.0 / (max - min);
				emin := min;
				i := 0;
				for vloc := 0 to nlines - 1 do begin
						for hloc := 0 to PixelsPerLine - 1 do begin
								value := IntArray^[i];
								if (value < 0) and (ImportCustomDepth = SixteenBitsUnsigned) then
									value := value + 65536;
								line[hloc] := trunc((value - min) * ScaleFactor);
								i := i + 1;
							end;
						PutLine(0, vloc, PixelsPerLine, line);
					end;
				fit := StraightLine;
				nCoefficients := 2;
				coefficient[1] := max;
				coefficient[2] := (min - max) / 255;
				calibrated := true;
				FileDepth := ImportCustomDepth;
			end; {with}
	end;


	function OpenFile (fname: str255; vnum: integer): boolean;
		var
			ticks, ByteCount, i, TempSize: LongInt;
			err: OSErr;
			f: integer;
			line, pixel: integer;
			r2, r3: rect;
			p: ptr;
			value: byte;
			iptr: ptr;
	begin
		OpenFile := false;
		ShowWatch;
		err := fsopen(fname, vNum, f);
		SaveInfo := Info;
		iptr := NewPtr(SizeOf(PicInfo));
		if iptr = nil then begin
				PutOutOfMemMsg;
				DisposPtr(iptr);
				err := fsclose(f);
				exit(OpenFile)
			end;
		Info := pointer(iptr);
		info^ := SaveInfo^;
		with Info^ do begin
				if not OpenHeader(f, fname, vnum) then begin
						DisposPtr(iptr);
						err := fsclose(f);
						Info := SaveInfo;
						exit(OpenFile)
					end;
				PicSize := LongInt(nlines) * PixelsPerLine;
				TempSize := PicSize;
				if (WhatToOpen = OpenCustom) and (ImportCustomDepth <> EightBits) then
					TempSize := TempSize * 2;
				PicBaseAddr := Getmemory(TempSize);
				if PicBaseAddr = nil then begin
						err := fsclose(f);
						exit(OpenFile)
					end;
				MakeNewWindow(fname);
				err := SetFPos(f, fsFromStart, ImageDataOffset);
				if PictureType = FourBitTIFF then
					Read4BitTIFF(f)
				else
					err := fsread(f, TempSize, PicBaseAddr);
				if (WhatToOpen = OpenCustom) and (ImportCustomDepth <> EightBits) then
					Import16BitImage;
				if (PictureType = pdp11) or (PictureType = imported) or (PictureType = InvertedTIFF) then
					InvertPic;
				if PictureType = FourBitTIFF then
					PictureType := imported;
				vref := vnum;
				if PicSize > UndoBufSize then
					PutWarning;
			end; {with}
		err := fsclose(f);
		SetupUndo;
		OpenFile := true;
	end;


	procedure InitPictBuffer (howBig: LongInt);
	begin
		repeat
			PictBuffer := NewPtr(howBig);
			if PictBuffer = nil then
				howBig := howBig div 2;
		until PictBuffer <> nil;
		DisposPtr(PictBuffer);
		PictBuffer := NewPtr(howBig div 2);
	end;


	procedure FillPictBuffer;
		var
			count: LongInt;
			err: OSErr;
	begin
		count := GetPtrSize(PictBuffer);
		if not fitsInPictBuffer then
			err := FSRead(PictF, count, PictBuffer);
		bytesInPictBuffer := count;
		curPictBufPtr := PictBuffer;
	end;


	procedure GetPICTData (dataPtr: Ptr; byteCount: Integer);
	{Input picture spooler routine taken from Apple's PICTViewer example program.}
		var
			count: LongInt;
			anErr: OSErr;
	begin
		count := byteCount;
		repeat
			if bytesInPictBuffer >= count then begin
					BlockMove(curPictBufPtr, dataPtr, count);
					curPictBufPtr := Ptr(Ord4(curPictBufPtr) + count);
					bytesInPictBuffer := bytesInPictBuffer - count;
					count := 0;
				end
			else begin		{Not enough in buffer}
					if bytesInPictBuffer > 0 then begin
							BlockMove(curPictBufPtr, dataPtr, bytesInPictBuffer);
							dataPtr := Ptr(Ord4(dataPtr) + bytesInPictBuffer);
							count := count - bytesInPictBuffer;
						end;
					FillPictBuffer;
				end;
		until count = 0;
	end;


	procedure BitInfo (var srcBits: PixMap; var srcRect, dstRect: rect; mode: integer; maskRgn: rgnHandle);
		var
			i, size: integer;
	begin
		if BitInfoCount = 0 then
			if srcBits.rowBytes < 0 then
				with srcBits.pmTable^^ do begin{Make sure it is a PixMap.}
						size := ctSize;
						if size > 255 then
							size := 255;
						if size > 0 then
							BitInfoCount := BitInfoCount + 1;
						for i := 0 to size do
							info^.cTable[i].rgb := ctTable[i].rgb;
						if size > 0 then
							info^.LutMode := custom;
					end;
	end;


	procedure GetClutFromPict (thePict: PicHandle);
  {Refer to "Screen Dump FKEY for Color Picts", February 1988 MacTutor.}
		type
			myPicData = record
					p: Picture;
					ID: integer
				end;
			myPicPtr = ^myPicData;
			myPicHdl = ^myPicPtr;
		var
			tempProcs: CQDProcs;
			SaveProcsPtr: QDProcsPtr;
			tPort: GrafPtr;
			err: osErr;
	begin
		with info^ do begin
				GetPort(tPort);
				SetPort(wptr);
				SaveProcsPtr := pointer(wptr^.grafProcs);
				SetStdCProcs(tempProcs);
				tempProcs.bitsProc := @BitInfo;
				tempProcs.getPicProc := @GetPICTData;
				BitInfoCount := 0;
				wptr^.grafProcs := @tempProcs;
				err := SetFPos(PictF, fsFromStart, 512 + SizeOf(Picture));
				FillPictBuffer;
				DrawPicture(thePict, thePict^^.picFrame);
				SetPort(tPort);
				wptr^.grafProcs := pointer(SaveProcsPtr);
			end;
		LoadLUT(info^.cTable);
	end;


	procedure RestoreOutline (thePict: PicHandle; pRect: rect);
		var
			tRect: rect;
			temp: integer;
			TempRgn: RgnHandle;
	begin
		with info^ do begin
				RoiShowing := true;
				PenNormal;
				OpenRgn;
				DrawPicture(thePict, pRect);
				CloseRgn(osroiRgn);
				if GetHandleSize(handle(osroiRgn)) = 10 then
					roiType := RectRoi
				else
					roiType := RgnRoi;
				osroiRect := osroiRgn^^.rgnBBox;
				roiRect := osroiRect;
				OffscreenToScreenRect(roiRect);
				RestoringOutline := false;
			end;
	end;


	function isGrayScaleLUT: boolean;
		var
			i: integer;
			GrayScaleLUT: boolean;
	begin
		with info^ do begin
				GrayscaleLUT := true;
				i := 0;
				repeat
					with cTable[i].rgb do
						GrayscaleLUT := GrayscaleLUT and (red = green) and (green = blue);
					i := i + 1;
				until (i = 256) or not GrayscaleLUT;
				isGrayScaleLUT := GrayScaleLUT;
			end;
	end;


	function OpenPict;{(fname:str255; vnum:integer; Reverting:boolean):boolean}
		var
			err: OSErr;
			i: integer;
			value: byte;
			iptr: ptr;
			PictSize, HowBig: LongInt;
			thePict: PicHandle;
			tPort: GrafPtr;
			tempProcs: CQDProcs;
			SaveProcsPtr: QDProcsPtr;

		procedure Abort;
		begin
			if not reverting then begin
					DisposPtr(pointer(Info));
					Info := SaveInfo;
					LoadLUT(info^.cTable);
				end;
			if thePict <> nil then
				DisposHandle(handle(thePict));
			if PictF <> 0 then
				err := fsclose(PictF);
			RestoringOutline := false;
			exit(OpenPict);
		end;

	begin
		PictF := 0;
		thePict := nil;
		OpenPict := false;
		ShowWatch;
		SaveInfo := Info;
		err := fsopen(fname, vNum, PictF);
		if IOCheck(err) <> 0 then
			Abort;
		if not Reverting then begin
				iptr := NewPtr(SizeOf(PicInfo));
				if iptr = nil then begin
						PutOutOfMemMsg;
						DisposPtr(iptr);
						err := fsclose(PictF);
						exit(OpenPict)
					end;
				Info := pointer(iptr);
				info^ := SaveInfo^;
			end;
		with Info^ do begin
				err := GetEof(PictF, PictSize);
				if IOCheck(err) <> 0 then
					Abort;
				PictSize := PictSize - 512;
				if PictSize <= 0 then
					Abort;
				WhatToOpen := OpenPICT2;
				if not OpenHeader(PictF, fname, vnum) then
					Abort;
				thePict := PicHandle(NewHandle(SizeOf(Picture)));
				if thePict = nil then
					Abort;
				err := SetFPos(PictF, fsFromStart, 512);
				if IOCheck(err) <> 0 then
					Abort;
				howBig := SizeOf(Picture);
				err := FSRead(PictF, howBig, Pointer(thePict^));
				with thePict^^.PicFrame do begin
						nlines := bottom - top;
						PixelsPerLine := right - left;
					end;
				PicSize := LongInt(nlines) * PixelsPerLine;
				if not Reverting then begin
						PicBaseAddr := GetMemory(PicSize);
						if PicBaseAddr = nil then begin
								DisposHandle(handle(thePict));
								err := fsclose(PictF);
								exit(OpenPict)
							end;
						MakeNewWindow(fname);
					end;
				if (PicSize > UndoBufSize) and (not Reverting) then begin
						PutWarning;
						ShowWatch;
					end;
				err := GetEof(PictF, howBig);
				howBig := howBig - (512 + SizeOf(Picture));
				InitPictBuffer(HowBig * 2);
				if GetPtrSize(PictBuffer) >= howBig then begin
						err := FSRead(PictF, howBig, PictBuffer);
						fitsInPictBuffer := true;
					end
				else
					fitsInPictBuffer := false;
				if ((LutMode = custom) or (LutMode = CustomGrayscale)) and (not UseExistingLUT) then
					GetClutFromPict(thePict);
				if isGrayScaleLUT then
					ResetGrayMap;
				GetPort(tPort);
				SetPort(GrafPtr(osPort));
				EraseRect(PicRect);
				SaveProcsPtr := pointer(osPort^.grafProcs);
				SetStdCProcs(tempProcs);
				tempProcs.getPicProc := @GetPICTData;
				osPort^.grafProcs := @TempProcs;
				err := SetFPos(PictF, fsFromStart, 512 + SizeOf(Picture));
				FillPictBuffer;
				if RestoringOutline then
					RestoreOutline(thePict, PicRect)
				else
					DrawPicture(thePict, PicRect);
				osPort^.grafProcs := pointer(SaveProcsPtr);
				DisposHandle(handle(thePict));
				DisposPtr(PictBuffer);
				SetPort(tPort);
				vref := vnum;
				PictureType := PictFile;
			end; {with}
		err := fsclose(PictF);
		SetupUndo;
		OpenPict := true;
	end;


	procedure LoadPseudoColorPalette (fname: str255; vRefNum: integer);
	begin
		InitColor(fname, vRefNum);
		UpdateColors;
	end;


	procedure LoadPalette (FileType: OSType; fname: str255; vnum: integer);
		var
			RefNum: integer;
			ok: boolean;
			err: OSErr;
	begin
		err := SetVol(nil, vnum);
		refNum := OpenResFile(fname);
		if RefNum <> -1 then begin
				if FileType = 'CLUT' then
					ok := LoadClutResource(KlutzID)
				else
					ok := LoadClutResource(PixelPaintID); {Load PixelPaint or Canvas palette}
				CloseResFile(RefNum);
				if isGrayScaleLUT then begin
						info^.LutMode := CustomGrayScale;
						DrawGrayMap;
					end;
			end;
	end;


	procedure OpenAll (reply: SFReply);
	  {Opens all appropriate files in a folder.    Original version contributed by Ira Rampil.}
		var
			OpenedOK: boolean;
			RefNum, index: integer;
			name: Str255;
			ftype: OSType;
			err: OSErr;
			PB: HParamBlockRec;
	begin
		RefNum := reply.vRefNum;
		index := 0;
		while true do begin
				index := index + 1;
				with PB do begin
						ioCompletion := nil;
						ioNamePtr := @name;
						ioVRefNum := RefNum;
						ioVersNum := 0;
						ioFDirIndex := index;
						err := PBGetFInfo(@PB, false);
						if err = fnfErr then
							exit(OpenAll);
						ftype := ioFlFndrInfo.fdType;
					end;
				if ftype = 'IPIC' then begin
						WhatToOpen := OpenImage;
						if not OpenFile(name, RefNum) then
							exit(OpenAll);
					end
				else if ftype = 'PICT' then begin
						if not OpenPICT(name, RefNum, false) then
							exit(OpenAll)
					end
				else if ftype = 'TIFF' then begin
						WhatToOpen := OpenTiff;
						if not OpenFile(name, RefNum) then
							exit(OpenAll);
					end
				else if ftype = 'PNTG' then
					if not OpenMacPaint(name, RefNum) then
						exit(OpenAll);
			end; {while}
	end;


	function OpenDialogHook (item: integer; theDialog: DialogPtr): integer;
		const
			OpenAllID = 11;
			KeepLutID = 12;
		var
			i: integer;
	begin
		if (item = -1) and UseExistingLUT then
			SetDialogItem(theDialog, KeepLutID, 1);
		if item = OpenAllID then begin
				OpenAllFiles := not OpenAllFiles;
				SetDialogItem(theDialog, OpenAllID, ord(OpenAllFiles));
			end;
		if item = KeepLutID then begin
				UseExistingLUT := not UseExistingLUT;
				SetDialogItem(theDialog, KeepLutID, ord(UseExistingLut));
			end;
		OpenDialogHook := item;
	end;


	procedure DoOpen;
		const
			MyDialogID = 70;
		var
			where: Point;
			reply: SFReply;
			b: boolean;
			vnum: integer;
			sfPtr: ^SFTypeList;
			TypeList: array[0..7] of OSType;
	begin
		KillOperation;
		StopThresholding;
		where.v := 50;
		where.h := 50;
		typeList[0] := 'IPIC';
		typeList[1] := 'PICT';
		typeList[2] := 'TIFF';
		typeList[3] := 'ICOL';
		typeList[4] := 'PX05'; {PixelPaint LUT}
		typeList[5] := 'CLUT';  {Klutz LUT}
		typeList[6] := 'drwC';  {Canvas LUT}
		typeList[7] := 'PNTG';  {MacPaint}
		sfPtr := @TypeList;
		OpenAllFiles := false;
		UseExistingLUT := false;
		SFPGetFile(Where, '', nil, 8, sfPtr^, @OpenDialogHook, reply, MyDialogID, nil);
		if reply.good and OpenAllFiles then begin
				OpenAll(reply);
				exit(DoOpen);
			end;
		if reply.good then
			with reply do begin
					vnum := vRefNum;
					if ftype = 'IPIC' then begin
							WhatToOpen := OpenImage;
							b := OpenFile(fname, vNum)
						end
					else if ftype = 'PICT' then begin
							b := OpenPICT(fname, vNum, false)
						end
					else if ftype = 'TIFF' then begin
							WhatToOpen := OpenTIFF;
							b := OpenFile(fname, vNum)
						end
					else if reply.ftype = 'ICOL' then
						LoadPseudoColorPalette(fname, vNum)
					else if reply.ftype = 'PX05' then
						LoadPalette('PX05', fname, vNum)
					else if reply.ftype = 'CLUT' then
						LoadPalette('CLUT', fname, vNum)
					else if reply.ftype = 'drwC' then
						LoadPalette('PX05', fname, vNum)
					else if reply.ftype = 'PNTG' then
						b := OpenMacPaint(fname, vNum)
					else begin
							WhatToOpen := OpenUnknown;
							b := OpenFile(fname, vNum)
						end;
					info^.ScaleToFitWindow := false;
				end;
	end;


	procedure OpenImportedPalette (fname: str255; vnum: integer);
		var
			err: OSErr;
			f, i: integer;
			ByteCount: LongInt;
			ImportedPalette: array[1..3] of packed array[0..255] of byte;
	begin
		StopThresholding;
		err := fsopen(fname, vNum, f);
		ByteCount := 768;
		err := fsRead(f, ByteCount, @ImportedPalette);
		if err = NoErr then
			with info^ do begin
					for i := 0 to 255 do
						with cTable[i], cTable[i].rgb do begin
								value := 0;
								red := bsl(ImportedPalette[1, i], 8);
								green := bsl(ImportedPalette[2, i], 8);
								blue := bsl(ImportedPalette[3, i], 8);
							end;
					LoadLUT(cTable);
					LUTMode := Custom;
					IdentityFunction := false;
					if isGrayScaleLUT then begin
							info^.LutMode := CustomGrayScale;
							DrawGrayMap;
						end;
				end
		else
			beep;
		err := fsClose(f);
	end;


	function FindWhatToImport: boolean;
		const
			TiffID = 3;
			McidID = 4;
			CustomID = 5;
			WidthID = 9;
			HeightID = 10;
			OffsetID = 11;
			PaletteID = 12;
			EightBitsID = 13;
			SixteenBitsUnsignedID = 14;
			SixteenBitsSignedID = 15;
			SwapBytesID = 16;
			ImportAllID = 17;
		var
			mylog: DialogPtr;
			item, i: integer;
			SaveWhatToImport: WhatToImportType;
			SaveWidth, SaveHeight: integer;
			SaveOffset: LongInt;
			SaveDepth: FileDepthType;
			SaveSwapBytes: boolean;

		procedure SetRadioButton;
			var
				i: integer;
		begin
			SetDialogItem(mylog, TiffID, 0);
			SetDialogItem(mylog, McidID, 0);
			SetDialogItem(mylog, PaletteID, 0);
			SetDialogItem(mylog, CustomID, 0);
			case WhatToImport of
				ImportTiff: 
					SetDialogItem(mylog, TiffID, 1);
				ImportMcid: 
					SetDialogItem(mylog, McidID, 1);
				ImportPalette: 
					SetDialogItem(mylog, PaletteID, 1);
				ImportCustom: 
					SetDialogItem(mylog, CustomID, 1);
			end;
		end;

		procedure SetRadioButton2;
			var
				i: integer;
		begin
			SetDialogItem(mylog, EightBitsID, 0);
			SetDialogItem(mylog, SixteenBitsUnsignedID, 0);
			SetDialogItem(mylog, SixteenBitsSignedID, 0);
			case ImportCustomDepth of
				EightBits: 
					SetDialogItem(mylog, EightBitsID, 1);
				SixteenBitsUnsigned: 
					SetDialogItem(mylog, SixteenBitsUnsignedID, 1);
				SixteenBitsSigned: 
					SetDialogItem(mylog, SixteenBitsSignedID, 1);
			end;
		end;

	begin
		InitCursor;
		SaveWhatToImport := WhatToImport;
		SaveWidth := ImportCustomWidth;
		SaveHeight := ImportCustomHeight;
		SaveOffset := ImportCustomOffset;
		SaveDepth := ImportCustomDepth;
		SaveSwapBytes := ImportSwapBytes;
		mylog := GetNewDialog(7000, nil, pointer(-1));
		SetRadioButton;
		SetDNum(MyLog, WidthID, ImportCustomWidth);
		SelIText(MyLog, WidthID, 0, 32767);
		SetDNum(MyLog, HeightID, ImportCustomHeight);
		SetDNum(MyLog, OffsetID, ImportCustomOffset);
		SetRadioButton2;
		SetDialogItem(mylog, SwapBytesID, ord(ImportSwapBytes));
		ImportAll := false;
		OutlineButton(MyLog, ok, 16);
		repeat
			ModalDialog(nil, item);
			if ((item >= TiffID) and (item <= CustomID)) or (item = PaletteID) then begin
					case item of
						TiffID: 
							WhatToImport := ImportTiff;
						McidID: 
							WhatToImport := ImportMCID;
						PaletteID: 
							WhatToImport := ImportPalette;
						CustomID: 
							WhatToImport := ImportCustom;
					end;
					SetRadioButton;
				end;
			if item = WidthID then begin
					ImportCustomWidth := GetDNum(MyLog, WidthID);
					if (ImportCustomWidth < 0) or (ImportCustomWidth > 2048) then begin
							ImportCustomWidth := SaveWidth;
							SetDNum(MyLog, WidthID, ImportCustomWidth);
						end;
					WhatToImport := ImportCustom;
					SetRadioButton;
				end;
			if item = HeightID then begin
					ImportCustomHeight := GetDNum(MyLog, HeightID);
					if ImportCustomHeight < 0 then begin
							ImportCustomHeight := SaveHeight;
							SetDNum(MyLog, HeightID, ImportCustomHeight);
						end;
					WhatToImport := ImportCustom;
					SetRadioButton;
				end;
			if item = OffsetID then begin
					ImportCustomOffset := GetDNum(MyLog, OffsetID);
					if ImportCustomOffset < 0 then begin
							ImportCustomOffset := SaveWidth;
							SetDNum(MyLog, OffsetID, ImportCustomOffset);
						end;
					WhatToImport := ImportCustom;
					SetRadioButton;
				end;
			if (item >= EightBitsID) and (item <= SixteenBitsSignedID) then begin
					case item of
						EightBitsID: 
							ImportCustomDepth := EightBits;
						SixteenBitsUnsignedID: 
							ImportCustomDepth := SixteenBitsUnsigned;
						SixteenBitsSignedID: 
							ImportCustomDepth := SixteenBitsSigned;
					end;
					SetRadioButton2;
					WhatToImport := ImportCustom;
					SetRadioButton;
				end;
			if item = SwapBytesID then begin
					ImportSwapBytes := not ImportSwapBytes;
					SetDialogItem(mylog, SwapBytesID, ord(ImportSwapBytes));
					WhatToImport := ImportCustom;
					SetRadioButton;
				end;
			if item = ImportAllID then begin
					ImportAll := not ImportAll;
					SetDialogItem(mylog, ImportAllID, ord(ImportAll));
				end;
		until (item = ok) or (item = cancel);
		DisposDialog(mylog);
		if item = cancel then begin
				WhatToImport := SaveWhatToImport;
				ImportCustomWidth := SaveWidth;
				ImportCustomHeight := SaveHeight;
				ImportCustomOffset := SaveOffset;
				ImportCustomDepth := SaveDepth;
				ImportSwapBytes := SaveSwapBytes;
				FindWhatToImport := false
			end
		else
			FindWhatToImport := true;
	end;


	procedure ImportAllFiles (reply: SFReply);
		var
			OpenedOK: boolean;
			RefNum, index: integer;
			name: Str255;
			ftype: OSType;
			err: OSErr;
			PB: HParamBlockRec;
	begin
		RefNum := reply.vRefNum;
		index := 0;
		while true do begin
				index := index + 1;
				with PB do begin
						ioCompletion := nil;
						ioNamePtr := @name;
						ioVRefNum := RefNum;
						ioVersNum := 0;
						ioFDirIndex := index;
						err := PBGetFInfo(@PB, false);
						if err = fnfErr then
							exit(ImportAllFiles);
						ftype := ioFlFndrInfo.fdType;
					end;
				if not OpenFile(name, RefNum) then
					exit(ImportAllFiles);
				if CommandPeriod then begin
						beep;
						exit(ImportAllFiles);
					end;
			end; {while}
	end;


	procedure ImportFile;
		var
			where: Point;
			typeList: SFTypeList;
			reply: SFReply;
			b: boolean;
	begin
		StopThresholding;
		if not OptionKeyWasDown then
			if not FindWhatToImport then
				exit(ImportFile);
		where.v := 50;
		where.h := 50;
		SFGetFile(Where, '', nil, -1, typeList, nil, reply); {Show User all Types}
		if reply.good then begin
				case WhatToImport of
					ImportTiff: 
						WhatToOpen := OpenTiff;
					ImportMCID: 
						WhatToOpen := OpenImported;
					ImportPalette: 
						OpenImportedPalette(reply.fname, reply.vRefNum);
					ImportCustom: 
						WhatToOpen := OpenCustom;
				end;
				if WhatToImport <> ImportPalette then begin
						if ImportAll then
							ImportAllFiles(reply)
						else
							b := OpenFile(reply.fname, reply.vRefNum);
					end;
			end;
	end;


	procedure RevertToSaved;
		var
			fname: str255;
			err, f: integer;
			ok: boolean;
	begin
		if Info = NoInfo then begin
				beep;
				exit(RevertToSaved)
			end;
		if OpPending then
			KillRoi;
		StopThresholding;
		with Info^ do begin
				fname := title;
				if PictureType = PICTFile then begin
						ok := OpenPICT(fname, vref, true);
						invalRect(wrect)
					end
				else begin
						ShowWatch;
						err := fsopen(fname, vref, f);
						ok := true;
						if HeaderOffset <> -1 then
							ok := OpenImageHeader(f, fname, vref);
						if ok then begin
								err := SetFPos(f, fsFromStart, ImageDataOffset);
								err := fsread(f, PicSize, PicBaseAddr);
								with info^ do
									if (PictureType = PDP11) or (PictureType = InvertedTIFF) or (PictureType = imported) then
										InvertPic;
								InvalRect(wrect);
							end;
						err := fsclose(f);
						RoiShowing := false;
					end;
				OpPending := false;
				Changes := false;
			end; {with}
	end;


	procedure SaveSettings;
		var
			size: LongInt;
			TempH: handle;
			SettingsH: handle;
	begin
		with settings, info^ do begin
				sForegroundIndex := ForegroundIndex;
				sBackgroundIndex := BackgroundIndex;
				sBrushHeight := BrushHeight;
				sBrushWidth := BrushWidth;
				sAirbrushDiameter := AirbrushDiameter;
				sLUTMode := LUTMode;
				sColorStart := ColorStart;
				sColorWidth := ColorWidth;
				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;
				sProfilePlotMin := ProfilePlotMin;
				sProfilePlotMax := ProfilePlotMax;
				sFixedSizePlot := FixedSizePlot;
				sProfilePlotWidth := ProfilePlotWidth;
				sProfilePlotHeight := ProfilePlotHeight;
				sFramesToAverage := FramesToAverage;
				sNewPicWidth := NewPicWidth;
				sNewPicHeight := NewPicHeight;
				sBufferSize := BufferSize;
				sMaxScionWidth := MaxScionWidth;
				sThresholdToForeground := ThresholdToForeground;
				sNonThresholdToBackground := NonThresholdToBackground;
				sVideoChannel := VideoChannel;
				sWhatToImport := WhatToImport;
				sImportCustomWidth := ImportCustomWidth;
				sImportCustomHeight := ImportCustomHeight;
				sImportCustomOffset := ImportCustomOffset;
				sWandAutoMeasure := WandAutoMeasure;
				sWandAutoNumber := WandAutoNumber;
				sBinaryIterations := BinaryIterations;
				sScaleArithmetic := ScaleArithmetic;
				sUseZeroForBlack := UseZeroForBlack;
				sInvertYCoordinates := InvertYCoordinates;
				sPrecision := precision;
				sMinParticleSize := MinParticleSize;
				sMaxParticleSize := MaxParticleSize;
				sIgnoreParticlesTouchingEdge := IgnoreParticlesTouchingEdge;
				sLabelParticles := LabelParticles;
				sOutlineParticles := OutlineParticles;
{$IFC Arlo }
    sFFTConfig := FFTConfig;
    sMaskConfig := MaskConfig;
{$ENDC }
			end;
		SettingsH := GetResource('SETT', 1000);
		if GetHandleSize(SettingsH) > 0 then
			RmveResource(SettingsH);
		size := SizeOF(settings);
		TempH := NewHandle(size);
		BlockMove(@settings, TempH^, size);
		AddResource(TempH, 'SETT', 1000, '');
		WriteResource(TempH);
		if ResError <> NoErr then
			SysBeep(1);
		DisposHandle(TempH);
	end;


	procedure FindWhatToPrint;
		var
			kind: integer;
			WhichWindow: WindowPtr;
   rightKind: boolean;
	begin
		WhatToPrint := NothingToPrint;
		WhichWindow := FrontWindow;
		kind := WindowPeek(WhichWindow)^.WindowKind;
  rightKind := (kind = PicKind);
{$IFC Arlo }
  rightKind := rightKind or (kind = FFTKind);
{$ENDC }
  if rightKind and info^.RoiShowing and measuring then
			kind := ResultsKind;
		case kind of
{$IFC Arlo }
   PicKind, FFTKind: 
{$ELSEC }
    PicKind: 
{$ENDC }
				if info^.RoiShowing then
					WhatToPrint := PrintSelection
				else
					WhatToPRint := PrintImage;
			HistoKind: 
				WhatToPrint := PrintHistogram;
			ProfilePlotKind, CalibrationPlotKind: 
				WhatToPrint := PrintPlot;
			ResultsKind: 
				if (CurrentTool = ruler) and (nLengths > 0) then
					WhatToPrint := PrintLengths
				else if (CurrentTool = PointingTool) and (nPoints > 0) then
					WhatToPrint := PrintPoints
				else if nRegions > 0 then
					WhatToPrint := PrintAreas;
			otherwise
				;
		end;
		if (WhatToPrint = NothingToPRint) and (info <> NoInfo) then
			WhatToPrint := PrintImage;
	end;


	procedure UpdateFileMenu;
		var
			ShowItems, isSelection: boolean;
			i: integer;
			str, str2: str255;
			fwptr: WindowPtr;
			kind: integer;
	begin
		ShowItems := Info <> NoInfo;
		fwptr := FrontWindow;
		kind := WindowPeek(fwptr)^.WindowKind;
		if OptionKeyWasDown then begin
				SetItem(FileMenuH, CloseItem, 'Close AllÉ');
				SetItem(FileMenuH, SaveItem, 'Save All');
				SetMenuItem(FileMenuH, CloseItem, ShowItems);
			end
		else begin
				SetItem(FileMenuH, CloseItem, 'CloseÉ');
				SetItem(FileMenuH, SaveItem, 'Save');
				SetMenuItem(FileMenuH, CloseItem, ShowItems or (kind = ProfilePlotKind) or (kind = CalibrationPlotKind) or (kind = HistoKind));
			end;
		with info^ do
			isSelection := RoiShowing and (RoiType = RectRoi);
		case kind of
			ProfilePlotKind, CalibrationPlotKind: 
				SaveAsWhat := asPlotValues;
			HistoKind: 
				SaveAsWhat := asHistogramValues;
			PicKind: 
				if (SaveAsWhat = asPlotValues) or (SaveAsWhat = asHistogramValues) then
					SaveAsWhat := asTiff;
			otherwise
		end;
		if isSelection and (SaveAsWhat <= asRawData) then
			SetItem(FileMenuH, SaveAsItem, 'Save Selection AsÉ')
		else
			SetItem(FileMenuH, SaveAsItem, 'Save AsÉ');
		for i := SaveItem to SaveAsItem do
			SetMenuItem(FileMenuH, i, ShowItems);
		if isSelection then
			str := 'Duplicate Selection'
		else
			str := 'Duplicate';
		SetItem(FileMenuH, DuplicateItem, str);
		for i := RevertItem to GetInfoItem do
			SetMenuItem(FileMenuH, i, ShowItems);
		with info^ do
			if (PictureType = NewPicture) or (PictureType = Leftover) or (PictureType = QuickCaptureType) or (PictureType = NullPicture) or (PictureType = BlankField) or (PictureType = FourBitTIFF) or (PictureType = ScionType) or ((PictureType = imported) and (FileDepth <> EightBits)) then
				SetMenuItem(FileMenuH, RevertItem, false);
		FindWhatToPrint;
		case WhatToPrint of
			NothingToPrint: 
				str := '';
			PrintImage: 
				str := 'Image';
			PrintSelection: 
				str := 'Selection';
			PrintPlot: 
				str := 'Plot';
			PrintHistogram: 
				str := 'Histogram';
			PrintAreas: 
				str := 'Measurements';
			PrintLengths: 
				str := 'Lengths';
			PrintPoints: 
				str := 'Points';
		end;
		SetItem(FileMenuH, PrintItem, concat('Print ', str, 'É'));
		SetMenuItem(FileMenuH, PrintItem, WhatToPrint <> NothingToPrint);
	end;


	procedure DoSave;
	begin
		SaveFile;
	end;


	procedure SaveAll;
		var
			SaveInfo: InfoPtr;
			i: integer;
	begin
		SaveInfo := Info;
		SaveAllFlag := SaveAllStage1;
		for i := 1 to nPics do begin
				Info := pointer(WindowPeek(PicWindow[i])^.RefCon);
				DoSave;
				if CommandPeriod then
					leave;
			end;
		Info := SaveInfo;
		SaveAllFlag := NoSaveAll;
	end;

end.