unit File1;

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

interface


	uses
		QuickDraw, Palettes, PrintTraps, globals, Utilities, Graphics, file2, file3, file4;

	procedure Swap2Bytes (var i: integer);
	procedure Swap4Bytes (var i: LongInt);
	function CloseAWindow (WhichWindow: WindowPtr): integer;
	procedure DoClose;
	function OpenFile (fname: str255; vnum: integer): boolean;
	function OpenPict (fname: str255; vnum: integer; Reverting: boolean): boolean;
	procedure SaveFile;
	function DoOpen (FileName: str255; RefNum: integer): boolean;
	function ImportFile (FileName: str255; RefNum: integer): boolean;
	procedure RevertToSaved;
	procedure SaveAs (name: str255; RefNum: integer);
	procedure Export (name: str255; RefNum: integer);
	function Revertable: boolean;
	procedure UpdateFileMenu;
	procedure SaveAsText (fname: str255; RefNum: integer);
	procedure SaveAll;
	procedure UpdateWindowsMenuItem (PicSize: LongInt; title: str255; PicNum: integer);
	procedure LoadPseudoColorPalette (fname: str255; RefNum: integer);
	procedure SaveScreen;



implementation

	var
		OpenAllFiles, UseExistingLUT: boolean;
		SaveRefNum: integer;
		gstr: str255;

{$PUSH}
{$D-}

	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 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 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
							RedrawLUTWindow;
					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) and (hfit <= RodbardFit) then begin
						fit := hfit;
						nCoefficients := hnCoefficients;
						Coefficient := hCoeff;
						UnitOfMeasure := hUM;
						Calibrated := true;
						GenerateValues;
					end
				else begin
						Calibrated := false;
						DrawLabels('', '', '');
					end;
				BinaryPic := hBinaryPic;
				if hSliceEnd > 1 then begin
						SliceStart := hSliceStart;
						SliceEnd := hSliceEnd;
						if SliceEnd > 254 then
							SliceEnd := 254;
					end;
				OpenImageHeader := true
			end;
	end;


	function OpenHeader (f: integer; fname: str255; vnum: integer): boolean;
		var
			ByteCount, FileSize: 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
							if macro then begin
									err := GetEof(f, FileSize);
									if (ImportCustomOffset + LongInt(ImportCustomWidth) * ImportCustomHeight) > FileSize then begin
											macro := false;
											OpenHeader := false;
											exit(OpenHeader)
										end;
								end;
							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;
					OpenAPIC: 
						begin
							err := SetFPos(f, fsFromStart, 0);
							ByteCount := 512;
							err := fsread(f, ByteCount, @hdr);

							if PixelsPerLine > MaxPixelsPerLine then begin
									beep;
									PixelsPerLine := MaxPixelsPerLine;
								end;
							PictureType := imported;
							HeaderOffset := -1;
							ImageDataOffset := 0;
							Load256ColorCLUT;
						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;
				hBinaryPic := BinaryPic;
				hSliceStart := SliceStart;
				hSliceEnd := SliceEnd;
				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;


{$POP}

	procedure PackLines;
  {For odd width images, removes the extra bytes at the end of each line required to make RowBytes even.}
		var
			i: integer;
			SrcPtr, DstPtr: ptr;
	begin
		with info^ do begin
				SrcPtr := ptr(ord4(PicBaseAddr) + BytesPerRow);
				DstPtr := ptr(ord4(PicBaseAddr) + PixelsPerLine);
				for i := 1 to nlines - 1 do begin
						BlockMove(SrcPtr, DstPtr, PixelsPerLine);
						SrcPtr := ptr(ord4(SrcPtr) + BytesPerRow);
						DstPtr := ptr(ord4(DstPtr) + PixelsPerLine);
					end;
			end;
	end;


	procedure UnpackLines;
  {For odd width images, adds an extra byte to each line so RowBytes is even.}
		var
			i: integer;
			SrcPtr, DstPtr: ptr;
	begin
		with info^ do begin
				SrcPtr := ptr(ord4(PicBaseAddr) + LongInt(nlines - 1) * PixelsPerLine);
				DstPtr := ptr(ord4(PicBaseAddr) + LongInt(nlines - 1) * BytesPerRow);
				for i := 1 to nlines - 1 do begin
						BlockMove(SrcPtr, DstPtr, PixelsPerLine);
						SrcPtr := ptr(ord4(SrcPtr) - PixelsPerLine);
						DstPtr := ptr(ord4(DstPtr) - BytesPerRow);
					end;
			end;
	end;


	function SaveTiffFile (fname: str255; vnum: integer; slines, sPixelsPerLine: integer; SavingSelection: boolean): boolean;
		var
			f, err, i: integer;
			HdrSize, ByteCount, SelectionSize: LongInt;
			TheInfo: FInfo;
			MCIDHeader: packed array[1..4] of byte;
	begin
		SaveTiffFile := false;
		ShowWatch;
		err := fsopen(fname, vNum, f);
		if IOCheck(err) <> 0 then
			exit(SaveTiffFile);
		with Info^ do begin
				if SaveAsWhat = SaveAsMCID then begin
						MCIDHeader[1] := (PixelsPerLine - 1) mod 256;
						MCIDHeader[2] := (PixelsPerLine - 1) div 256;
						MCIDHeader[3] := (nLines - 1) mod 256;
						MCIDHeader[4] := (nLines - 1) div 256;
						ByteCount := 4;
						err := fswrite(f, ByteCount, @MCIDHeader);
					end;
				if (SaveAsWhat <> asRawData) and (SaveAsWhat <> SaveAsMCID) 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 := ImageSize;
						if odd(PixelsPerLine) then
							PackLines;
						err := fswrite(f, ByteCount, PicBaseAddr);
						if odd(PixelsPerLine) then
							UnpackLines;
						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 if SaveAsWhat = SaveAsMCID then begin
						HdrSize := 4;
						SaveAsWhat := asRawData;
					end
				else
					HdrSize := HeaderSize + TiffDirSize;
				if SavingSelection then
					err := SetEOF(f, SelectionSize + HdrSize)
				else
					err := SetEOF(f, ImageSize + 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;
								revertable := true;
							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 (fname: str255; RefNum: integer; slines, sPixelsPerLine: integer; SavingSelection: boolean);
		var
			err: integer;
			TheInfo: FInfo;
			replacing, ok: boolean;
			name: str255;
	begin
		err := GetFInfo(fname, RefNum, TheInfo);
		case err of
			NoErr: 
				with TheInfo do begin
						if (fdType <> 'TIFF') and (fdType <> 'PICT') and (fdType <> 'IPIC') and (fdType <> 'RawD') then begin
								TypeMismatch(fname);
								exit(SaveTiffAs)
							end;
						replacing := true;
					end;
			FNFerr: 
				begin
					if SaveAsWhat = asRawData then
						err := create(fname, RefNum, 'IMAG', 'RawD')
					else
						err := create(fname, RefNum, 'IMAG', 'TIFF');
					if IOCheck(err) <> 0 then
						exit(SaveTiffAs);
					replacing := false;
				end;
			otherwise
				if IOCheck(err) <> 0 then
					exit(SaveTiffAs);
		end;
		ok := SaveTiffFile(fname, RefNum, slines, sPixelsPerLine, SavingSelection);
		if ok then
			with info^ do
				UpdateWindowsMenuItem(ImageSize, 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;
			SaveInfoRec: PicInfo;
			HeaderSaved: boolean;

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

	begin
		with info^ do begin
				if OpPending then
					KillRoi;
				SavePICTFile := false;
				ShowWatch;
				GetPort(tPort);
				if SavingSelection then
					fRect := RoiRect
				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));
						pmForeColor(BlackIndex);
						pmBackColor(WhiteIndex);
						if OldSystem then begin  {Work around for Palette Manager bug in Systems before 6.0.5.}
								RGBForeColor(BlackRGB);
								RGBBackColor(WhiteRGB);
							end;
						ClipRect(PicRect);
						LoadLUT(cTable);  {Restore look-up table in case it has changed.}
						PicH := OpenPicture(fRect2);
						hlock(handle(PortPixMap));
						CopyBits(BitMapHandle(PortPixMap)^^, BitMapHandle(PortPixMap)^^, frect, frect2, SrcCopy, nil);
						hunlock(handle(PortPixMap));
						ClosePicture;
						pmForeColor(ForegroundIndex);
						pmBackColor(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);
				SaveInfoRec := Info^;
				if (LutMode = GrayScale) or (LutMode = CustomGrayScale) then begin
						p1x := 0;
						p1y := 0;
						p2x := 255;
						p2y := 255;
						LUTMode := Grayscale;
						IdentityFunction := true;
					end;
				HeaderSaved := SaveHeader(f, 0, 0, vnum, fname, SavingSelection, false) = 0;
				Info^ := SaveInfoRec;
				if not HeaderSaved 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 (PictureType <> NullPicture) then begin
								PictureType := PictFile;
								title := fname;
								ShowMagnification;
								vref := vnum;
								revertable := true;
							end;
						Changes := false;
					end;
			end; {with}
		SavePICTFile := true;
	end;


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


	procedure SaveSelection (fname: str255; RefNum: integer; 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 RoiRect 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(fname, RefNum, true)
				else
					SaveTiffAs(fname, RefNum, slines, sPixelsPerLine, true);
			end;
	end;


	procedure SavePalette (fname: str255; RefNum: integer);
		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(fname, RefNum, TheInfo);
		case err of
			NoErr: 
				if TheInfo.fdType <> 'ICOL' then begin
						TypeMismatch(fname);
						exit(SavePalette)
					end;
			FNFerr: 
				begin
					err := create(fname, RefNum, '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;
		err := fsopen(fname, RefNum, 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, RefNum);
				exit(SavePalette)
			end;
		err := fsclose(f);
		err := FlushVol(nil, RefNum);
	end;


	procedure SaveAsText (fname: str255; RefNum: integer);
		var
			err, f: integer;
			TheInfo: FInfo;
			ByteCount: LongInt;
	begin
		err := GetFInfo(fname, RefNum, TheInfo);
		case err of
			NoErr: 
				if TheInfo.fdType <> 'TEXT' then begin
						TypeMismatch(fname);
						exit(SaveAsText)
					end;
			FNFerr: 
				begin
					err := create(fname, RefNum, 'MACA', 'TEXT');
					if IOCheck(err) <> 0 then
						exit(SaveAsText);
				end;
			otherwise
				if IOCheck(err) <> 0 then
					exit(SaveAsTExt)
		end;
		ShowWatch;
		err := fsopen(fname, RefNum, 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, RefNum);
		if WhatsOnClip = TextOnClip then
			WhatsOnClip := Nothing;
	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';
		end;
	end;


	function SaveAsHook (item: integer; theDialog: DialogPtr): integer;
		const
			EditTextID = 7;
			TiffID = 9;
			PaletteID = 12;
		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 <= PaletteID) 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 PaletteID do
					SetDialogItem(theDialog, i, 0);
				SetDialogItem(theDialog, item, 1);
			end;
		SaveAsHook := item;
	end;


	procedure SaveAs (name: str255; RefNum: integer);
		const
			CustomDialogID = 60;
		var
			where: Point;
			reply: SFReply;
			isSelection: boolean;
			kind: integer;
	begin
		with info^ do begin
				if SaveAllState = SaveAllStage2 then begin
						name := title;
						RefNum := SaveRefNum;
						if SaveAsWhat = AsPalette then
							SaveAsWhat := AsTiff;
					end
				else if (name = '') or (RefNum = 0) then begin
						where.v := 50;
						where.h := 50;
						if name = '' then
							name := SuggestedName;
						SFPPutFile(Where, 'Save as?', name, @SaveAsHook, reply, CustomDialogID, nil);
						if not reply.good then begin
								SaveAllState := NoSaveAll;
								macro := false;
								exit(SaveAs);
							end;
						with reply do begin
								name := fname;
								RefNum := vRefNum;
								DefaultRefNum := RefNum;
							end;
					end;
				isSelection := RoiShowing and (RoiType = RectRoi);
				if SaveAllState = SaveAllStage1 then begin
						SaveRefNum := RefNum;
						SaveAllState := SaveAllStage2;
					end;
				case SaveAsWhat of
					asTiff, asRawData: 
						if isSelection then
							SaveSelection(name, RefNum, false)
						else
							SaveTiffAs(name, RefNum, 0, 0, false);
					asPict: 
						if isSelection then
							SavePICTAs(name, RefNum, true)
						else
							SavePICTAs(name, RefNum, false);
					asMacPaint: 
						SaveAsMacPaint(name, RefNum);
					AsPalette: 
						SavePalette(name, RefNum);
				end; {case}
				if (SaveAsWhat = asRawData) and (SaveAllState <> SaveAllStage2) then
					SaveAsWhat := asTIFF;
			end; {with}
	end;


	procedure SaveFile;
		var
			fname: str255;
			size: LongInt;
			ok: boolean;
	begin
		if FrontWindow = MeasurementsWindow then begin
				Export('', 0);
				exit(SaveFile);
			end;
		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
					SaveAs('', 0);
			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 or (macro and ((MacroCommand = DisposeC) or (MacroCommand = DisposeAllC))) 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;
			pcrect: rect;
	begin
		kind := WindowPeek(WhichWindow)^.WindowKind;
		CloseAWindow := ok;
		case kind of
			PicKind: 
				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;
							DisposHandle(PicBaseHandle);
							DisposeWindow(WhichWindow);
							CloseCPort(osPort);
							Dispose(osPort);
							DisposeRgn(roiRgn);
							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;
			MeasurementsKind: 
				begin
					DisposeWindow(MeasurementsWindow);
					MeasurementsWindow := nil;
					TEDispose(ListTE);
				end;
			PasteControlKind: 
				begin
					GetWindowRect(PasteControl, pcrect);
					with pcrect do begin
							PasteControlLeft := left;
							PasteControlTop := top;
						end;
					DisposeWindow(PasteControl);
					PasteControl := nil;
					wp := pointer(GhostWindow);
					wp^ := nil;
				end;
		end; {case}
	end;


	procedure DoClose;
		var
			ignore: integer;
			fwptr: WindowPtr;
			kind: integer;
	begin
		fwptr := FrontWindow;
		kind := WindowPeek(fwptr)^.WindowKind;
		if (kind = PicKind) or (kind = ProfilePlotKind) or (kind = CalibrationPlotKind) or (kind = HistoKind) or (Kind = PasteControlKind) or (Kind = MeasurementsKind) then
			ignore := CloseAWindow(fwptr);
	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;
			PixelLUTType = packed array[0..65535] of Unsignedbyte;
			PixelLUTPtr = ^PixelLUTType;
		var
			line: LineType;
			IntArray: IntArrayPtr;
			i, j, value, min, max, tmin, tmax: LongInt;
			ScaleFactor: extended;
			hloc, vloc, wwidth, wheight, IntValue, SaveBytesPerRow: integer;
			tPort: GrafPtr;
			PixelLUT: PixelLUTPtr;
			FixedScale: boolean;
			str1, str2, str3: str255;
	begin
		with info^ do begin
				if PixelsPerLine > MaxPixelsPerLine then
					exit(Import16BitImage);
				PixelLUT := PixelLUTPtr(NewPtr(SizeOf(PixelLUTType)));
				if PixelLUT = nil then begin
						PutMessage('Not enough memory to do 16 to 8-bit scaling.');
						exit(Import16BitImage);
					end;
				if odd(PixelsPerLine) then begin
						SaveBytesPerRow := BytesPerRow;
						BytesPerRow := PixelsPerLine; {Needed to get PutLine to work.}
					end;
				IntArray := IntArrayPtr(PicBaseAddr);
				min := 999999;
				max := -999999;
				for i := 0 to ImageSize - 1 do begin
						if ImportSwapBytes then begin
								IntValue := IntArray^[i];
								swap2bytes(IntValue);
								IntArray^[i] := IntValue;
							end;
						value := IntArray^[i];
						if (ImportCustomDepth = SixteenBitsUnsigned) and (value < 0) then
							value := value + 65536;
						if value > max then
							max := value;
						if value < min then
							min := value;
					end;
				str1 := concat('min=', long2str(min), cr, 'max=', long2str(max));
				str2 := '';
				FixedScale := not ImportAutoScale;
				if FixedScale then begin
						tmin := round(ImportMin);
						tmax := round(ImportMax);
						if ((tmax - tmin) < 65536) and (tmin <= tmax) then begin
								min := tmin;
								max := tmax;
								str2 := concat(cr, 'fixed: ', long2str(min), '-', long2str(max));
							end;
					end;
				ScaleFactor := 253.0 / (max - min);
				RealToString(ScaleFactor, 1, 4, str3);
				ShowMessage(concat(str1, str2, cr, 'scale factor= ', str3));
				j := 0;
				for i := min to max do begin
						PixelLUT^[j] := round((i - min) * ScaleFactor + 1);
						j := j + 1;
					end;
				i := 0;
				for vloc := 0 to nlines - 1 do begin
						for hloc := 0 to PixelsPerLine - 1 do begin
								value := IntArray^[i];
								if FixedScale then begin
										if value < min then
											value := min;
										if value > max then
											value := max;
									end;
								if (ImportCustomDepth = SixteenBitsUnsigned) and (value < 0) then
									value := value + 65536;
								line[hloc] := PixelLUT^[value - min];
								i := i + 1;
							end;
						PutLine(0, vloc, PixelsPerLine, line);
					end;
				if ImportCalibrate then begin
						fit := StraightLine;
						nCoefficients := 2;
						coefficient[1] := max;
						coefficient[2] := (min - max) / 255;
						calibrated := true;
					end
				else
					calibrated := false;
				FileDepth := ImportCustomDepth;
				if odd(PixelsPerLine) then
					BytesPerRow := SaveBytesPerRow;
				DisposPtr(ptr(PixelLUT));
			end; {with}
	end;


	function OpenFile (fname: str255; vnum: integer): boolean;
		var
			ticks, ByteCount, i, DataSize: LongInt;
			err: OSErr;
			f: integer;
			line, pixel: integer;
			r2, r3: rect;
			p: ptr;
			value: byte;
			iptr: ptr;
			SaveInfo: InfoPtr;
			is16bits: boolean;
	begin
		OpenFile := false;
		if whatToImport = ImportNCCD then begin
				OpenFile := OpenNCCDFile(fName, vNum);
				exit(OpenFile);
			end;
		ShowWatch;
		err := fsopen(fname, vNum, f);
		SaveInfo := Info;
		iptr := NewPtr(SizeOf(PicInfo));
		if iptr = nil then begin
				PutMemoryAlert;
				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;
				is16bits := (WhatToOpen = OpenCustom) and (ImportCustomDepth <> EightBits);
				PicBaseAddr := GetImageMemory(SaveInfo, PicBaseHandle, is16bits);
				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 begin
						DataSize := LongInt(nlines) * PixelsPerLine;
						if is16bits then
							DataSize := DataSize * 2;
						err := fsread(f, DataSize, PicBaseAddr);
					end;
				if is16bits then
					Import16BitImage;
				if odd(PixelsPerLine) and (PictureType <> FourBitTiff) then
					UnpackLines;
				if (PictureType = pdp11) or (PictureType = InvertedTIFF) or ((PictureType = Imported) and is16bits) then
					InvertPic;
				if PictureType = FourBitTIFF then
					PictureType := imported;
				vref := vnum;
				if PixMapSize > UndoBufSize then
					PutWarning;
				revertable := FileDepth = EightBits;
			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;


	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;
			SaveInfo: InfoPtr;

		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);
			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
						PutMemoryAlert;
						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;
				if not Reverting then begin
						PicBaseAddr := GetImageMemory(SaveInfo, PicBaseHandle, false);
						if PicBaseAddr = nil then begin
								DisposHandle(handle(thePict));
								err := fsclose(PictF);
								exit(OpenPict)
							end;
						MakeNewWindow(fname);
					end;
				if (PixMapSize > 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;
				DrawPicture(thePict, PicRect);
				osPort^.grafProcs := pointer(SaveProcsPtr);
				DisposHandle(handle(thePict));
				DisposPtr(PictBuffer);
				SetPort(tPort);
				vref := vnum;
				PictureType := PictFile;
				revertable := true;
			end; {with}
		err := fsclose(PictF);
		SetupUndo;
		OpenPict := true;
	end;


	procedure OpenImportedLUT (fname: str255; vnum: integer);
		var
			err: OSErr;
			f, i: integer;
			ByteCount: LongInt;
			ImportedLUT: array[1..3] of packed array[0..255] of byte;
	begin
		DisableDensitySlice;
		err := fsopen(fname, vNum, f);
		ByteCount := 768;
		err := fsRead(f, ByteCount, @ImportedLUT);
		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(ImportedLUT[1, i], 8);
								green := bsl(ImportedLUT[2, i], 8);
								blue := bsl(ImportedLUT[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;


	procedure LoadPseudoColorPalette (fname: str255; RefNum: integer);
		var
			err: OSErr;
			f: integer;
			FileSize: LongInt;
	begin
		err := fsopen(fname, RefNum, f);
		err := GetEOF(f, FileSize);
		err := fsclose(f);
		if FileSize = 768 then
			OpenImportedLUT(fname, RefNum)
		else begin
				InitColor(fname, RefNum);
				UpdateColors;
			end;
	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 = 'APIC' then begin
						WhatToOpen := OpenAPIC;
						if not OpenAPICFile(name, RefNum) then
							exit(OpenAll);
					end
				else if ftype = 'API2' then begin
						WhatToOpen := OpenAPI2;
						if not OpenAPI2File(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;


	function DoOpen (FileName: str255; RefNum: integer): boolean;
		const
			MyDialogID = 70;
		var
			where: Point;
			reply: SFReply;
			b: boolean;
			sfPtr: ^SFTypeList;
			TypeList: array[0..10] of OSType;
			FileType: OSType;
			OKToContinue: boolean;
			FinderInfo: FInfo;
			err: OSErr;
	begin
		KillOperation;
		DisableDensitySlice;
		OpenAllFiles := false;
		UseExistingLUT := false;
		OKToContinue := false;
		if FileName = '' then begin
				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}
				typeList[8] := 'APIC';
				typeList[9] := '    ';{frei,(frŸher NCCD)}
				typeList[10] := 'API2';

				sfPtr := @TypeList;
				SFPGetFile(Where, '', nil, 11, sfPtr^, @OpenDialogHook, reply, MyDialogID, nil);
				if reply.good then
					with reply do begin
							FileName := fname;
							FileType := ftype;
							RefNum := vRefNum;
							DefaultRefNum := RefNum;
							DefaultFileName := fname;
							OKToContinue := true;
						end;
				if reply.good and OpenAllFiles then begin
						OpenAll(reply);
						exit(DoOpen);
					end;
			end
		else begin
				err := GetFInfo(FileName, RefNum, FinderInfo);
				FileType := FinderInfo.fdType;
				OKToContinue := true;
			end;
		DoOpen := OKToContinue;
		if OKToContinue then begin
				if FileType = 'IPIC' then begin
						WhatToOpen := OpenImage;
						b := OpenFile(FileName, RefNum)
					end
				else if FileType = 'PICT' then begin
						b := OpenPICT(FileName, RefNum, false)
					end
				else if FileType = 'TIFF' then begin
						WhatToOpen := OpenTIFF;
						b := OpenFile(FileName, RefNum)
					end
				else if FileType = 'APIC' then begin
						WhatToOpen := OpenAPIC;
						b := OpenAPICFile(FileName, RefNum)
					end
				else if FileType = 'API2' then begin
						WhatToOpen := OpenAPI2;
						b := OpenAPI2File(FileName, RefNum)
					end

				else if FileType = 'ICOL' then
					LoadPseudoColorPalette(FileName, RefNum)
				else if FileType = 'PX05' then
					LoadPalette('PX05', FileName, RefNum)
				else if FileType = 'CLUT' then
					LoadPalette('CLUT', FileName, RefNum)
				else if FileType = 'drwC' then
					LoadPalette('PX05', FileName, RefNum)
				else if FileType = 'PNTG' then
					b := OpenMacPaint(FileName, RefNum)
				else begin
						WhatToOpen := OpenUnknown;
						b := OpenFile(FileName, RefNum)
					end;
				info^.ScaleToFitWindow := false;
			end;
	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 EditImportParameters;
		const
			WidthID = 2;
			HeightID = 3;
			OffsetID = 4;
			FixedID = 8;
			MinID = 11;
			MaxID = 12;
		var
			mylog: DialogPtr;
			item, fwidth: integer;
	begin
		mylog := GetNewDialog(110, nil, pointer(-1));
		SetDNum(MyLog, WidthID, ImportCustomWidth);
		SelIText(MyLog, WidthID, 0, 32767);
		SetDNum(MyLog, HeightID, ImportCustomHeight);
		SetDNum(MyLog, OffsetID, ImportCustomOffset);
		SetDialogItem(MyLog, FixedID, ord(not ImportAutoScale));
		if WhatToImport = ImportText then
			fwidth := 2
		else
			fwidth := 0;
		SetDReal(MyLog, MinID, ImportMin, fwidth);
		SetDReal(MyLog, MaxID, ImportMax, fwidth);
		OutlineButton(MyLog, ok, 16);
		repeat
			ModalDialog(nil, item);
			if item = WidthID then begin
					ImportCustomWidth := GetDNum(MyLog, WidthID);
					if (ImportCustomWidth < 0) or (ImportCustomWidth > MaxPicSize) then begin
							ImportCustomWidth := 512;
							SetDNum(MyLog, WidthID, ImportCustomWidth);
						end;
				end;
			if item = HeightID then begin
					ImportCustomHeight := GetDNum(MyLog, HeightID);
					if ImportCustomHeight < 0 then begin
							ImportCustomHeight := 512;
							SetDNum(MyLog, HeightID, ImportCustomHeight);
						end;
				end;
			if item = OffsetID then begin
					ImportCustomOffset := GetDNum(MyLog, OffsetID);
					if ImportCustomOffset < 0 then begin
							ImportCustomOffset := 0;
							SetDNum(MyLog, OffsetID, ImportCustomOffset);
						end;
				end;
			if item = FixedID then begin
					ImportAutoScale := not ImportAutoScale;
					SetDialogItem(mylog, FixedID, ord(not ImportAutoScale));
				end;
			if item = MinID then begin
					ImportMin := GetDReal(MyLog, MinID);
					ImportAutoScale := false;
					SetDialogItem(MyLog, FixedID, 1);
				end;
			if item = MaxID then begin
					ImportMax := GetDReal(MyLog, MaxID);
					ImportAutoScale := false;
					SetDialogItem(MyLog, FixedID, 1);
				end;
		until item = ok;
		DisposDialog(mylog);
	end;


	function ImportDialogHook (item: integer; myLog: DialogPtr): integer;
		const
			TiffID = 11;
			McidID = 12;
			TextID = 13;
			NCCD_ID = 25;
			LutID = 14;
			CustomID = 15;
			WidthAndHeightID = 16;
			OffsetID = 17;
			EightBitsID = 18;
			SixteenBitsUnsignedID = 19;
			SixteenBitsSignedID = 20;
			SwapBytesID = 21;
			ImportAllID = 22;
			EditID = 23;
			CalibrateID = 24;
		var
			i: integer;

		procedure SetRadioButtons1;
			var
				i: integer;
		begin
			SetDialogItem(mylog, TiffID, 0);
			SetDialogItem(mylog, McidID, 0);
			SetDialogItem(mylog, LutID, 0);
			SetDialogItem(mylog, TextID, 0);
			SetDialogItem(mylog, CustomID, 0);
			SetDialogItem(mylog, NCCD_ID, 0);
			case WhatToImport of
				ImportTiff: 
					SetDialogItem(mylog, TiffID, 1);
				ImportMcid: 
					SetDialogItem(mylog, McidID, 1);
				ImportLUT: 
					SetDialogItem(mylog, LutID, 1);
				ImportText: 
					SetDialogItem(mylog, TextID, 1);
				ImportCustom: 
					SetDialogItem(mylog, CustomID, 1);
				ImportNCCD: 
					SetDialogItem(mylog, NCCD_ID, 1);
			end;
		end;

		procedure SetRadioButtons2;
			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;

		procedure ShowParameters;
			var
				str1, str2, str3: str255;
		begin
			NumToString(ImportCustomWidth, str1);
			NumToString(ImportCustomHeight, str2);
			NumToString(ImportCustomOffset, str3);
			ParamText(str1, str2, str3, '');
		end;

	begin
		if item = -1 then begin {Initialize}
				SetRadioButtons1;
				SetRadioButtons2;
				ShowParameters;
				SetDialogItem(mylog, SwapBytesID, ord(ImportSwapBytes));
				SetDialogItem(mylog, ImportAllID, ord(ImportAll));
				SetDialogItem(mylog, CalibrateID, ord(ImportCalibrate));
			end;
		if ((item >= TiffID) and (item <= CustomID)) or (item = NCCD_ID) then begin
				case item of
					TiffID: 
						WhatToImport := ImportTiff;
					McidID: 
						WhatToImport := ImportMCID;
					LutID: 
						WhatToImport := ImportLUT;
					TextID: 
						WhatToImport := ImportText;
					CustomID: 
						WhatToImport := ImportCustom;
					NCCD_ID: 
						WhatToImport := ImportNCCD;
				end;
				SetRadioButtons1;
			end;
		if item = EditID then begin
				EditImportParameters;
				WhatToImport := ImportCustom;
				SetRadioButtons1;
				ShowParameters;
			end;
		if (item >= EightBitsID) and (item <= SixteenBitsSignedID) then begin
				case item of
					EightBitsID: 
						ImportCustomDepth := EightBits;
					SixteenBitsUnsignedID: 
						ImportCustomDepth := SixteenBitsUnsigned;
					SixteenBitsSignedID: 
						ImportCustomDepth := SixteenBitsSigned;
				end;
				SetRadioButtons2;
				WhatToImport := ImportCustom;
				SetRadioButtons1;
			end;
		if item = SwapBytesID then begin
				ImportSwapBytes := not ImportSwapBytes;
				SetDialogItem(mylog, SwapBytesID, ord(ImportSwapBytes));
				WhatToImport := ImportCustom;
				SetRadioButtons1;
			end;
		if item = ImportAllID then begin
				ImportAll := not ImportAll;
				SetDialogItem(mylog, ImportAllID, ord(ImportAll));
			end;
		if item = CalibrateID then begin
				ImportCalibrate := not ImportCalibrate;
				SetDialogItem(mylog, CalibrateID, ord(ImportCalibrate));
				WhatToImport := ImportCustom;
				SetRadioButtons1;
			end;
		ImportDialogHook := item;
	end;


	function ImportFile (FileName: str255; RefNum: integer): boolean;
		const
			ImportDialogID = 90;
		var
			where: Point;
			typeList: SFTypeList;
			reply: SFReply;
			b: boolean;
	begin
		ImportFile := true;
		DisableDensitySlice;
		if not macro then
			ImportAll := false;
		if FileName = '' then begin
				where.v := 50;
				where.h := 50;
				SFPGetFile(Where, '', nil, -1, typeList, @ImportDialogHook, reply, ImportDialogID, nil);
				if not reply.good then begin
						ImportFile := false;
						exit(ImportFile);
					end;
				with reply do begin
						FileName := fname;
						RefNum := vRefNum;
						DefaultRefNum := RefNum;
						DefaultFileName := fname;
					end;
			end;
		case WhatToImport of
			ImportTiff: 
				WhatToOpen := OpenTiff;
			ImportMCID: 
				WhatToOpen := OpenImported;
			ImportCustom: 
				WhatToOpen := OpenCustom;
			ImportNCCD: 
				WhatToOpen := OpenNCCD;
			ImportLUT: 
				begin
					OpenImportedLUT(FileName, RefNum);
					exit(ImportFile);
				end;
			ImportText: 
				begin
					ImportFile := ImportTextFile(FileName, RefNum);
					exit(ImportFile);
				end;
		end;
		if ImportAll then
			ImportAllFiles(reply)
		else
			b := OpenFile(FileName, RefNum);
	end;


	procedure RevertToSaved;
		var
			fname: str255;
			err, f: integer;
			ok: boolean;
	begin
		if OpPending then
			KillRoi;
		DisableDensitySlice;
		with Info^ do begin
				fname := title;
				SetPort(wptr);
				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, ImageSize, PicBaseAddr);
								with info^ do
									if (PictureType = PDP11) or (PictureType = InvertedTIFF) or (PictureType = imported) then
										InvertPic;
								InvalRect(wrect);
								if odd(PixelsPerLine) then
									UnpackLines;
							end;
						err := fsclose(f);
						RoiShowing := false;
					end;
				OpPending := false;
				Changes := false;
			end; {with}
	end;


	procedure FindWhatToPrint;
		var
			kind: integer;
			WhichWindow: WindowPtr;
	begin
		WhatToPrint := NothingToPrint;
		WhichWindow := FrontWindow;
		kind := WindowPeek(WhichWindow)^.WindowKind;
		if (kind = PicKind) and info^.RoiShowing and measuring then
			kind := ResultsKind;
		case kind of
			PicKind: 
				if info^.RoiShowing then
					WhatToPrint := PrintSelection
				else
					WhatToPRint := PrintImage;
			HistoKind: 
				WhatToPrint := PrintHistogram;
			ProfilePlotKind, CalibrationPlotKind: 
				WhatToPrint := PrintPlot;
			ResultsKind, MeasurementsKind: 
				if mCount > 0 then
					WhatToPrint := PrintMeasurements;
			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: 
				ExportAsWhat := asPlotValues;
			HistoKind: 
				ExportAsWhat := asHistogramValues;
			MeasurementsKind: 
				ExportAsWhat := asMeasurements;
			PicKind: 
				begin
					if (SaveAsWhat <> asPICT) then
						SaveAsWhat := asTiff;
					if (ExportAsWhat > asText) then
						ExportAsWhat := asRaw;
				end;
			otherwise
		end;
		if isSelection and (SaveAsWhat <> AsPalette) and (fwptr <> MeasurementsWindow) then
			SetItem(FileMenuH, SaveAsItem, 'Save Selection AsÉ')
		else
			SetItem(FileMenuH, SaveAsItem, 'Save AsÉ');
		if isSelection and (ExportAsWhat <= AsText) then
			SetItem(FileMenuH, ExportItem, 'Export Selection AsÉ')
		else
			SetItem(FileMenuH, ExportItem, 'ExportÉ');
		for i := SaveItem to SaveAsItem do
			SetMenuItem(FileMenuH, i, ShowItems);
		SetMenuItem(FileMenuH, ExportItem, ShowItems);
		if isSelection then
			str := 'Duplicate Selection'
		else
			str := 'Duplicate';
		SetItem(FileMenuH, DuplicateItem, str);
		for i := DuplicateItem to GetInfoItem do
			SetMenuItem(FileMenuH, i, ShowItems);
		SetMenuItem(FileMenuH, RevertItem, info^.Revertable);
		FindWhatToPrint;
		case WhatToPrint of
			NothingToPrint: 
				str := '';
			PrintImage: 
				str := 'Image';
			PrintSelection: 
				str := 'Selection';
			PrintPlot: 
				str := 'Plot';
			PrintHistogram: 
				str := 'Histogram';
			PrintMeasurements: 
				str := 'Measurements';
		end;
		SetItem(FileMenuH, PrintItem, concat('Print ', str, 'É'));
		SetMenuItem(FileMenuH, PrintItem, WhatToPrint <> NothingToPrint);
	end;


	procedure SaveAll;
		var
			SaveInfo: InfoPtr;
			i: integer;
	begin
		SaveInfo := Info;
		SaveAsWhat := AsTiff;
		SaveAllState := SaveAllStage1;
		for i := 1 to nPics do begin
				Info := pointer(WindowPeek(PicWindow[i])^.RefCon);
				SaveAs('', 0);
				if CommandPeriod or (SaveAllState = NoSaveAll) then
					leave;
			end;
		Info := SaveInfo;
		SaveAllState := NoSaveAll;
	end;


	procedure SaveScreen;
		var
			err, RefNum: integer;
			TheInfo: FInfo;
			name: str255;
			ok, NewFile: boolean;
			SaveInfo: InfoPtr;
			SaveNoInfoRec: PicInfo;
	begin
		name := 'Screen';
		err := GetVol(nil, RefNum);
		err := GetFInfo(name, RefNum, TheInfo);
		case err of
			NoErr: 
				begin
					if TheInfo.fdType <> 'PICT' then begin
							TypeMismatch(name);
							exit(SaveScreen)
						end;
					NewFile := false;
				end;
			FNFerr: 
				begin
					err := create(name, RefNum, 'IMAG', 'PICT');
					if IOCheck(err) <> 0 then
						exit(SaveScreen);
					NewFile := true;
				end;
			otherwise
				if IOCheck(err) <> 0 then
					exit(SaveScreen)
		end;
		SaveInfo := info;
		SaveNoInfoRec := NoInfoRec;
		with NoInfo^ do begin
				PixelsPerLine := ScreenWidth;
				nLines := ScreenHeight;
				osPort := cScreenPort;
				SetRect(PicRect, 0, 0, ScreenWidth, ScreenHeight);
				LutMode := info^.LutMode;
				cTable := info^.cTable;
			end;
		info := NoInfo;
		ok := SavePICTFile(name, RefNum, false, NewFile);
		NoInfoRec := SaveNoInfoRec;
		info := SaveInfo;
		if ok then
			PutMessage('The screen has been dumped to a PICT file named ÒScreenÓ in the same folder as Image.');
	end;


	function SuggestedExportName: str255;
		var
			name: str255;
	begin
		case ExportAsWhat of
			asRaw, asMCID, asText: 
				begin
					name := info^.title;
					if name = 'Camera' then
						name := 'Untitled';
					if ExportAsWhat = AsText then
						SuggestedExportName := concat(name, '(Text)')
					else
						SuggestedExportName := name;
				end;
			AsLUT: 
				SuggestedExportName := 'Palette';
			asMeasurements: 
				SuggestedExportName := 'Measurements';
			AsPlotValues: 
				SuggestedExportName := 'Plot Values';
			asHistogramValues: 
				SuggestedExportName := 'Histogram Values';
		end;
	end;


	function ExportHook (item: integer; theDialog: DialogPtr): integer;
		const
			EditTextID = 7;
			RawID = 9;
			HistogramID = 15;
		var
			i: integer;
			fname: str255;
			NameEdited: boolean;
	begin
		if item = -1 then {Initialize}
			SetDialogItem(theDialog, RawID + ord(ExportAsWhat), 1);
		fname := GetDString(theDialog, EditTextID);
		NameEdited := fname <> SuggestedExportName;
		if (item >= RawID) and (item <= HistogramID) then begin
				ExportAsWhat := ExportAsWhatType(item - RawID);
				if not NameEdited then begin
						SetDString(theDialog, EditTextID, SuggestedExportName);
						SelIText(theDialog, EditTextID, 0, 32767);
					end;
				for i := RawID to HistogramID do
					SetDialogItem(theDialog, i, 0);
				SetDialogItem(theDialog, item, 1);
			end;
		ExportHook := item;
	end;


	procedure Export (name: str255; RefNum: integer);
		const
			CustomDialogID = 100;
		var
			where: Point;
			reply: SFReply;
			isSelection: boolean;
			kind: integer;
			SaveAsState: SaveAsWhatType;
	begin
		with info^ do begin
				if (name = '') or (RefNum = 0) then begin
						where.v := 50;
						where.h := 50;
						if name = '' then
							name := SuggestedExportName;
						SFPPutFile(Where, 'Save as?', name, @ExportHook, reply, CustomDialogID, nil);
						if not reply.good then begin
								macro := false;
								exit(Export);
							end;
						with reply do begin
								name := fname;
								RefNum := vRefNum;
								DefaultRefNum := RefNum;
							end;
					end;
				isSelection := RoiShowing and (RoiType = RectRoi);
				case ExportAsWhat of
					asRaw, asMCID: 
						begin
							SaveAsState := SaveAsWhat;
							if ExportAsWhat = AsRaw then
								SaveAsWhat := asRawData
							else
								SaveAsWhat := SaveAsMCID;
							if isSelection then
								SaveSelection(name, RefNum, false)
							else
								SaveTiffAs(name, RefNum, 0, 0, false);
							SaveAsWhat := SaveAsState;
						end;
					AsText: 
						ExportAsText(name, RefNum);
					AsLUT: 
						ExportLut(name, RefNum);
					asMeasurements: 
						if mCount > 0 then
							ExportMeasurements(name, RefNum)
						else
							PutMessage('Sorry, but no measurements are available to export.');
					AsPlotValues: 
						if PlotWindow <> nil then begin
								kind := WindowPeek(PlotWindow)^.WindowKind;
								case kind of
									ProfilePlotKind: 
										ConvertPlotToText;
									CalibrationPlotKind: 
										ConvertCalibrationCurveToText;
									otherwise
										TextBufSize := 0;
								end;
								SaveAsText(name, RefNum);
							end
						else
							beep;
					asHistogramValues: 
						if HistoWindow <> nil then begin
								ConvertHistoToText;
								SaveAsText(name, RefNum);
							end
						else
							beep;
					otherwise
						beep;
				end; {case}
				if (SaveAsWhat = asRawData) and (SaveAllState <> SaveAllStage2) then
					SaveAsWhat := asTIFF;
			end; {with}
	end;


end.