unit File1;

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

interface


	uses
		Memory, QuickDraw, Packages, Menus, Events, Fonts, Scrap, ToolUtils, Resources, Errors, Palettes, StandardFile, SegLoad, globals, Utilities, Graphics, file2, Dicom, sound, Lut, Text;


	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);
	procedure FindWhatToPrint;
	procedure UpdateFileMenu;
	procedure SaveAsText (fname: str255; RefNum: integer);
	procedure SaveAll;
	function OpenPICS (name: str255; fRefNum: integer): boolean;
	procedure RescaleToEightBits;


implementation

	var
		OpenAllFiles, UseExistingLUT, PICTReadErr: boolean;
		SaveRefNum: integer;
		TempStackInfo: StackInfoRec;
		PictSrcRect: rect;

{$PUSH}
{$D-}

	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;



	function OpenImageHeader (f: integer; fname: str255; vnum: integer): boolean;
		var
			ByteCount: LongInt;
			err: OSErr;
			TempHdr: PicHeader;
			i, OldNExtra, p1x, p2x: integer;
			ok: boolean;
			hUnitsKind: UnitsType;
	begin
		if SizeOf(PicHeader)<>HeaderSize then begin
			PutError(StringOf('Internal error (size= ', SizeOf(PicHeader):1,')'));
			OpenImageHeader := false;
			exit(OpenImageHeader);
		end;
		ByteCount := HeaderSize;
		err := SetFPos(f, fsFromStart, info^.HeaderOffset);
		err := fsread(f, ByteCount, @TempHdr);
		if CheckIO(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
						if hversion < 142 then begin
								LUTMode := hOldLUTMode;
								if (LutMode = OldAppleDefault) or (LutMode = OldSpectrum) then
									LutMode := ColorLut;
							end
						else begin
								LUTMode := hLUTMode;
								if LutMode = Pseudocolor then begin
										if ((hnColors > 32) and (hTable = CustomTable)) or (hTable > spectrum) then
											LutMode := ColorLut;
									end;
							end;
						case LUTMode of
							PseudoColor: 
								if hversion < 142 then begin
										nColors := hOldnColors;
										for i := 0 to ncolors - 1 do begin
												RedLUT[i] := hr[i];
												GreenLUT[i] := hg[i];
												BlueLUT[i] := hb[i];
											end;
										ColorEnd := 255 - hOldColorStart;
										ColorStart := ColorEnd - nColors * hColorWidth + 1;
										if ColorStart < 0 then
											ColorStart := 0;
										InvertPalette;
										FillColor1 := BlackRGB;
										FillColor2 := BlackRGB;
										ColorTable := CustomTable;
										UpdateLUT;
									end
								else begin {V1.42 or later}
										if (hTable <> CustomTable) and (hTable <= spectrum) then begin
												SwitchColorTables(GetColorTableItem(hTable), false);
												if hInvertedTable then
													InvertPalette;
											end
										else begin
												nColors := hnColors;
												ColorTable := CustomTable;
												if nColors <= 32 then
													for i := 0 to ncolors - 1 do begin
															RedLUT[i] := hr[i];
															GreenLUT[i] := hg[i];
															BlueLUT[i] := hb[i];
														end;
											end;
										ColorStart := hColorStart;
										ColorEnd := hColorEnd;
										FillColor1 := hFill1;
										FillColor2 := hFill2;
										UpdateLUT;
										UpdateMap;
									end; {v1.42 or later}
							GrayScale: 
								ResetGrayMap;
							ColorLut, CustomGrayscale: 
								if PictureType <> PictFile then begin
										if ColorMapOffset > 0 then
											GetTiffColorMap(f)
										else
											LookForCluts(fname, vnum);
									end;
							otherwise
						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
						if hversion < 138 then begin
								p1x := 255 - hp2x;
								p2x := 255 - hp1x;
							end
						else begin
								p1x := hp1x;
								p2x := hp2x
							end;
						nColors := 256;
						ColorStart := p1x;
						ColorEnd := p2x;
						UpdateLUT;
					end;
				if hversion > 106 then begin
						{xScale := hXScale;} {68k-bug}
						xScale := DoubleToReal(hXScale);
						yScale := xScale;
						PixelAspectRatio := 1.0;
						SpatiallyCalibrated := xScale <> 0.0;
					end;
				if hversion > 140 then begin
						PixelAspectRatio := hPixelAspectRatio;
						yScale := xScale / PixelAspectRatio;
					end;
				if hversion > 153 then
					xUnit := hXUnit
				else begin
						hUnitsKind := UnitsType(hUnitsID - 5);
						GetXUnits(hUnitsKind);
					end;
				if xUnit = 'pixel' then
					SpatiallyCalibrated := false;
				if ((hnCoefficients > 0) and (hfit < Uncalibrated)) or (hfit = UncalibratedOD) then begin
						if hfit = SpareFit1 then begin
								fit := uncalibrated;
								DrawLabels('', '', '');
							end
						else begin
								fit := hfit;
								if hfit <> UncalibratedOD then begin
										nCoefficients := hnCoefficients;
										for i:=1 to maxCoeff do
											{Coefficient[i] := hCoeff[i];} {68k-bug}
											Coefficient[i]:=DoubleToReal(hCoeff[i]);
										nKnownValues := 0;
									end;
								UnitOfMeasure := hUM;
								if hversion >= 144 then
									ZeroClip := hZeroClip
								else
									ZeroClip := false;
							end;
					end
				else begin
						fit := uncalibrated;
						DrawLabels('', '', '');
					end;
				BinaryPic := hBinaryPic;
				if hSliceEnd > 1 then begin
						SliceStart := hSliceStart;
						SliceEnd := hSliceEnd;
						if SliceEnd > 254 then
							SliceEnd := 254;
					end;
				if hNSlices > 1 then begin
						with TempStackInfo do begin
								nSlices := hNSlices;
								if nSlices > MaxSlices then
									nSlices := MaxSlices;
								CurrentSlice := hCurrentSlice;
								if (hCurrentSlice < 1) or (hCurrentSlice > nSlices) then
									CurrentSlice := 1;
								SliceSpacing := hSliceSpacing;
								FrameInterval := hFrameInterval;
								StackType := VolumeStack;
								if hVersion >= 158 then
									StackType := hStackType;
							end;
					end;
				FileVersion := hVersion;
				OpenImageHeader := true
			end;
	end;


	function OpenHeader (f: integer; fname: str255; vnum: integer; var TiffInfo: TiffInfoRec): boolean;
		var
			ByteCount, FileSize, DirOffset, MaxImages: 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;
				StackInfo := nil;
				with TempStackInfo do begin
						nSlices := 0;
						CurrentSlice := 1;
						SliceSpacing := 0.0;
						FrameInterval := 0.0;
					end;
				fileVersion := 0;
				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 := Imported;
									InvertedImage := true;
								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 > MaxLine then begin
									beep;
									PixelsPerLine := MaxLine;
								end;
							nlines := hdr[3] + hdr[4] * 256 + 1;
							PictureType := imported;
							LUTMode := grayscale;
							HeaderOffset := -1;
							ImageDataOffset := 4;
						end;
					OpenCustom:  begin
							err := GetEof(f, FileSize);
							if macro then begin
									if (ImportCustomOffset + ImportCustomWidth * ImportCustomHeight) > FileSize then begin
											AbortMacro;
											OpenHeader := false;
											exit(OpenHeader)
										end;
								end;
							PixelsPerLine := ImportCustomWidth;
							nlines := ImportCustomHeight;
							PictureType := imported;
							HeaderOffset := -1;
							ImageDataOffset := ImportCustomOffset;
							if ImportCustomSlices > 1 then
								with TempStackInfo do begin
										nSlices := ImportCustomSlices;
										MaxImages := (FileSize - ImportCustomOffset) div (ImportCustomWidth * ImportCustomHeight);
										if nSlices > MaxImages then
											nSlices := MaxImages;
										if nSlices < 2 then
											nSlices := 0;
									end;
						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;
							if not UseExistingLUT then
								LutMode := ColorLut;
							ImageDataOffset := 512;
						end;
					OpenTIFF:  begin
							if not OpenTiffHeader(f, DirOffset) then begin
									OpenHeader := false;
									exit(OpenHeader)
								end;
							if not OpenTiffDirectory(f, DirOffset, TiffInfo, false) then begin
									OpenHeader := false;
									exit(OpenHeader)
								end;
							with TiffInfo do begin
									PictureType := TiffFile;
									PixelsPerLine := width;
									nlines := height;
									if BitsPerPixel = 4 then
										PictureType := FourBitTiff;
									ImageDataOffset := OffsetToData;
									InvertedImage := ZeroIsBlack and (PictureType <> FourBitTIFF);
									if resolution > 0.0 then begin
											case ResUnits of
												tNoUnits: 
													xUnit := 'pixel';
												tCentimeters: 
													xUnit := 'cm';
												tInches: 
													xUnit := 'inch';
											end;
											xScale := resolution;
											yScale := resolution;
											PixelAspectRatio := 1.0;
											if xUnit <> 'pixel' then
												SpatiallyCalibrated := true;
										end;
									ColorMapOffset := OffsetToColorMap;
									HeaderOffset := OffsetToImageHeader;
								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
				else if (ColorMapOffset > 0) and not UseExistingLUT then
					GetTiffColorMap(f);
			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;
			UnitsKind: UnitsType;
			UnitsPerCM: extended;
	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;
				hOldLutMode := LutMode;
				hnColors := ncolors;
				hOldnColors := 0;
				if LutMode = Pseudocolor then begin
						hOldLutMode := ColorLut;
						if (ColorTable = CustomTable) and (ncolors <= 32) then
							for i := 0 to nColors - 1 do begin
									hr[i] := RedLUT[i];
									hg[i] := GreenLUT[i];
									hb[i] := BlueLUT[i];
								end;
					end;
				hColorStart := ColorStart;
				hColorEnd := ColorEnd;
				hFill1 := FillColor1;
				hFill2 := FillColor2;
				hTable := ColorTable;
				hInvertedTable := InvertedColorTable;
				hOldColorStart := 255 - ColorEnd;
				if nColors > 0 then
					hColorWidth := (ColorEnd - ColorStart) div nColors
				else
					hColorWidth := 1;
				hnExtraColors := nExtraColors;
				hExtraColors := ExtraColors;
				hForegroundIndex := ForegroundIndex;
				hBackgroundIndex := BackgroundIndex;
				{hXScale := xScale;} {68k-bug}
				RealToDouble(xScale, hXScale);
				hScaleMagnification := 1.0;
				hPixelAspectRatio := PixelAspectRatio;
				hUnitsID := 14; {Pixels. For backward compatibility only since hUnits no longer used.}
				if SpatiallyCalibrated then begin
						GetUnitsKind(UnitsKind, UnitsPerCM);
						hUnitsID := ord(UnitsKind) + 5;
						if hUnitsID > 14 then
							hUnitsID := 14;
					end;
				FindPoints(hp1x, hp1y, hp2x, hp2y);
				if fit = uncalibrated then
					hnCoefficients := 0
				else
					hnCoefficients := nCoefficients;
				hfit := fit;
				for i:=1 to maxCoeff do
					{hCoeff[i] := Coefficient[i];} {68k-bug}
					RealToDouble(Coefficient[i], hCoeff[i]);
				hZeroClip := ZeroClip;
				hUM := UnitOfMeasure;
				hBinaryPic := BinaryPic;
				hSliceStart := SliceStart;
				hSliceEnd := SliceEnd;
				if StackInfo <> nil then
					with StackInfo^ do begin
							hNSlices := nSlices;
							hSliceSpacing := SliceSpacing;
							hFrameInterval := FrameInterval;
							hCurrentSlice := CurrentSlice;
							hStackType := StackType;
						end
				else begin
						hNSlices := 0;
						hSliceSpacing := 0.0;
						hFrameInterval := 0.0;
						hCurrentSlice := 0;
						hStackType := VolumeStack;
					end;
				hXUnit := xUnit;
				ByteCount := SizeOf(TempHdr);
				if ByteCount <> HeaderSize then begin
						NumToString(ByteCount, str);
						PutError('Internal error check: header size is incorrect.');
						ExitToShell;
					end;
				if SavingSelection then begin
						hnlines := slines;
						hPixelsPerLine := sPixelsPerLine;
					end;
				err := fswrite(f, ByteCount, @TempHdr);
				SaveHeader := CheckIO(err);
			end; {with}
	end;


	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) + (nlines - 1) * PixelsPerLine);
				DstPtr := ptr(ord4(PicBaseAddr) + (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 WriteSlices (f: integer): integer;
		var
			ByteCount, SelectionSize: LongInt;
			i, err, SaveCS: integer;
	begin
		with info^, Info^.StackInfo^ do begin
				SaveCS := CurrentSlice;
				for i := 1 to nSlices do begin
						CurrentSlice := i;
						SelectSlice(CurrentSlice);
						UpdateTitleBar;
						ByteCount := ImageSize;
						if odd(PixelsPerLine) then
							PackLines;
						err := fswrite(f, ByteCount, PicBaseAddr);
						if odd(PixelsPerLine) then
							UnpackLines;
						if err <> 0 then
							leave;
					end;
				CurrentSlice := SaveCS;
				SelectSlice(CurrentSlice);
				UpdateTitleBar;
				WriteSlices := err;
			end;
	end;


	procedure WriteSelection (f: integer; sLines, sPixelsPerLine: LongInt);
  {Contributed by Edward J. Huff(huff@mcclb0.med.nyu.edu).}
		var
			size, offset, ByteCount, BytesDone: LongInt;
			src, dst: ptr;
			err: OSErr;
	begin
		if sPixelsPerLine > UndoBufSize then
			exit(WriteSelection);
		size := sLines * sPixelsPerLine;
		with info^, info^.RoiRect do begin
				offset := top * BytesPerRow + left;
				src := ptr(ord4(PicBaseAddr) + offset);
				BytesDone := 0;
				while BytesDone < size do begin
						ByteCount := 0;
						dst := UndoBuf;
						while ((ByteCount + sPixelsPerLine) < UndoBufSize) and (BytesDone < size) do begin
								BlockMove(src, dst, sPixelsPerLine);
								src := ptr(ord4(src) + BytesPerRow);
								dst := ptr(ord4(dst) + sPixelsPerLine);
								ByteCount := ByteCount + sPixelsPerLine;
								BytesDone := BytesDone + sPixelsPerLine;
							end;
						err := fswrite(f, ByteCount, UndoBuf);
					end;
				SetupUndo; {Needed for drawing roi outline}
			end
	end;


	procedure SaveRGBTiff(f: integer; SavingSelection: boolean);
	const
		bufsize = 12000;
	var
		i, row, pixel, count, ignore: LongInt;
		vstart, height, hstart, width: LongInt;
		buffer: packed array [0 .. bufsize] of byte;
		rLine, gLine, bLine: LineType;
		err: OSErr;
	begin
		with info^ do begin
			if SavingSelection then with RoiRect do begin
				vstart := top;
				height := bottom - top;
				hstart := left;
				width := right - left;
			end else begin
				vstart := 0;
				height := nLInes;
				hstart := 0;
				width := PixelsPerLine;
			end;
			if width > MaxLine then
				exit(SaveRGBTiff);
			ShowMeter;
			count := 0;
			for row:=0 to height - 1 do begin
				if (row mod 10) = 0 then
					UpdateMeter(((row * 100) div height), 'Saving RGB TIFF');
				SelectSlice(1);
				GetLine(hstart, vstart + row, width, rLine);
				SelectSlice(2);
				GetLine(hstart, vstart + row, width, gLine);
				SelectSlice(3);
				GetLine(hstart, vstart + row, width, bLine);
				for pixel := 0 to width - 1 do begin
					buffer[count] := 255 - rLine[pixel];
					buffer[count + 1] := 255 - gLine[pixel];
					buffer[count + 2] := 255 - bLine[pixel];
					count := count + 3;
					if count > (bufsize - 3) then begin
						if CheckIO(fswrite(f, count, @buffer)) <> noErr then begin
							exit(SaveRGBTiff);
							UpdateMeter(-1, '');
						end;
						count := 0;
					end;
				end; {for}
			end; {for}
			if count > 0 then
				err := fswrite(f, count, @buffer);
			UpdateMeter(-1, '');
			with StackInfo^ do begin
				CurrentSlice := 1;
				SelectSlice(CurrentSlice);
			end;
			UpdateTitleBar;
		end; {with}
	end;
	

	function SaveTiffFile (fname: str255; vnum: integer; slines, sPixelsPerLine: integer; SavingSelection: boolean): boolean;
		var
			f, err, i, width, height: integer;
			HdrSize, ByteCount, ctabSize, StackTiffDirSize, ImageDataSize: LongInt;
			TheInfo: FInfo;
			MCIDHeader: packed array[1..4] of byte;
			SaveColorMap, SaveAs24BitTiff: boolean;
	begin
		SaveTiffFile := false;
		SaveAs24BitTiff := false;
		ShowWatch;
		err := fsopen(fname, vNum, f);
		if CheckIO(err) <> 0 then
			exit(SaveTiffFile);
		with Info^ do begin
				SaveColorMap := (LutMode <> Grayscale) and (SaveAsWhat <> asRawData);
				if SaveAsWhat = SaveAsMCID then begin
						if SavingSelection then begin
								width := sPixelsPerLine;
								height := slines;
							end
						else begin
								width := PixelsPerLine;
								height := nLines;
							end;
						MCIDHeader[1] := (width - 1) mod 256;
						MCIDHeader[2] := (width - 1) div 256;
						MCIDHeader[3] := (height - 1) mod 256;
						MCIDHeader[4] := (height - 1) div 256;
						ByteCount := 4;
						err := fswrite(f, ByteCount, @MCIDHeader);
					end;
				HeaderOffset := TiffDirSize;
				ImageDataOffset := TiffDirSize + HeaderSize;
				if SaveColorMap then
					ctabSize := SizeOf(TiffColorMapType)
				else
					ctabSize := 0;
				StackTiffDirSize := 0;
				if SavingSelection then
					ImageDataSize := ord4(sLines) * sPixelsPerLine
				else
					ImageDataSize := ImageSize;
				if StackInfo <> nil then begin
						ImageDataSize := ImageSize * StackInfo^.nSlices;
						if SaveAsWhat <> asRawData then
							StackTiffDirSize := SizeOf(StackIFDType) * (StackInfo^.nSlices - 1);
						if (StackInfo^.StackType = rgbStack) and (StackInfo^.nSlices = 3) then begin
							SaveAs24BitTiff := true;
							ctabSize := 0;
							StackTiffDirSize := 0;
						end;
					end;
				if (SaveAsWhat <> asRawData) and (SaveAsWhat <> SaveAsMCID) then begin
						if SaveTiffDir(f, slines, sPixelsPerLine, SavingSelection, ctabSize, ImageDataSize) <> 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;
				if SaveAsWhat = SaveAsMCID then
					KillRoi;
				if SaveAs24bitTiff then
					SaveRGBTiff(f, SavingSelection)
				else if SavingSelection then
					WriteSelection(f, sLines, sPixelsPerLine)
				else if StackInfo <> nil then
					err := WriteSlices(f)
				else begin
						ByteCount := ImageDataSize;
						if odd(PixelsPerLine) then
							PackLines;
						err := fswrite(f, ByteCount, PicBaseAddr);
						if odd(PixelsPerLine) then
							UnpackLines;
					end;
				if SaveAsWhat = SaveAsMCID then
					InvertPic;
				if CheckIO(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 SaveColorMap then
					SaveTiffColorMap(f, ImageDataSize);
				if StackTiffDirSize > 0 then
					err := WriteExtraTiffIFDs(f, ImageDataSize, cTabSize);
				err := SetEOF(f, HdrSize + ImageDataSize + ctabSize + StackTiffDirSize);
				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 <> FrameGrabberType)  and (SaveAsWhat <> asRawData) then begin
								PictureType := TiffFile;
								RemovePath(fname);
								TruncateString(fname, maxTitle);
								title := fname;
								vref := vnum;
								UpdateTitleBar;
								if StackInfo = nil then begin
										revertable := true;
										InvertedImage := false;
									end;
							end;
					end;
				if (SaveAsWhat <> asRawData) and (not RoiShowing) then
					Changes := false;
			end; {with}
		SaveTiffFile := true;
	end;


	procedure SaveAsTIFF (fname: str255; RefNum: integer; slines, sPixelsPerLine: integer; SavingSelection: boolean);
		var
			err: integer;
			TheInfo: FInfo;
			replacing, ok: boolean;
			name: str255;
	begin
		if info = NoInfo then
			exit(SaveAsTIFF);
		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') and (fdType <> 'PICS') then begin
								TypeMismatch(fname);
								exit(SaveAsTIFF)
							end;
						replacing := true;
					end;
			FNFerr:  begin
					if SaveAsWhat = asRawData then
						err := create(fname, RefNum, 'Imag', 'RawD')
					else
						err := create(fname, RefNum, 'Imag', 'TIFF');
					if CheckIO(err) <> 0 then
						exit(SaveAsTIFF);
					replacing := false;
				end;
			otherwise
				if CheckIO(err) <> 0 then
					exit(SaveAsTIFF);
		end;
		if replacing then
			if not RoomForFile(fname, RefNum, slines, sPixelsPerLine, SavingSelection) then
				exit(SaveAsTIFF);
		ok := SaveTiffFile(fname, RefNum, slines, sPixelsPerLine, SavingSelection);
		if ok then
			UpdateWindowsMenuItem;
		with info^ do
			if SavingSelection and Replacing and (PictureType <> BlankField) and (PictureType <> FrameGrabberType)  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;
			SaveGDevice: GDHandle;

		procedure Abort;
		begin
			err := fsclose(f);
			if NewFile then
				err := FSDelete(fname, vnum);
			DisposeHandle(handle(PicH));
			{exit(SavePICTFile)}   {ppc-bug}
		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
						SaveGDevice := GetGDevice;
						SetGDevice(osGDevice);
						SetPort(GrafPtr(osPort));
						pmForeColor(BlackIndex);
						pmBackColor(WhiteIndex);
						if OldSystem then begin
								RGBForeColor(BlackRGB);
								RGBBackColor(WhiteRGB);
							end;
						ClipRect(PicRect);
						LoadLUT(cTable);
						PicH := OpenPicture(fRect2);
						CopyBits(BitMapHandle(PortPixMap)^^, BitMapHandle(PortPixMap)^^, frect, frect2, SrcCopy, nil);
						ClosePicture;
						pmForeColor(ForegroundIndex);
						pmBackColor(BackgroundIndex);
					end;
				SetPort(tPort);
				SetGDevice(SaveGDevice);
				PICTSize := GetHandleSize(handle(PicH));
				if PICTSize <= 10 then begin
						PutError('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);
						DisposeHandle(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
						nColors := 256;
						ColorStart := 0;
						ColorEnd := 255;
						LUTMode := Grayscale;
						IdentityFunction := true;
					end;
				HeaderSaved := SaveHeader(f, 0, 0, vnum, fname, SavingSelection, false) = 0;
				Info^ := SaveInfoRec;
				if not HeaderSaved then begin
					abort;
					exit(SavePICTFile)
				end;
				err := fswrite(f, PICTSize, pointer(PicH^));
				if CheckIO(err) <> 0 then begin
					abort; 
					exit(SavePICTFile)
				end;
				DisposeHandle(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 <> FrameGrabberType)  and (PictureType <> NullPicture) then begin
								PictureType := PictFile;
								RemovePath(fname);
								TruncateString(fname, maxTitle);
								title := fname;
								UpdateTitleBar;
								vref := vnum;
								revertable := true;
								InvertedImage := false;
							end;
						Changes := false;
					end;
			end; {with}
		SavePICTFile := true;
	end;


	procedure SaveAsPICT (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(SaveAsPICT)
							end;
						replacing := true;
					end;
			FNFerr:  begin
					err := create(fname, RefNum, 'Imag', 'PICT');
					if CheckIO(err) <> 0 then
						exit(SaveAsPICT);
					replacing := false;
				end;
			otherwise
				if CheckIO(err) <> 0 then
					exit(SaveAsPICT);
		end;
		ok := SavePICTFile(fname, RefNum, SavingSelection, not Replacing);
		if ok then
			UpdateWindowsMenuItem;
		with info^ do
			if SavingSelection and replacing and (PictureType <> BlankField) and (PictureType <> FrameGrabberType)  then
				PictureType := Leftover;
	end;


	procedure SaveSelection (fname: str255; RefNum: integer; SaveAsSameType: boolean);
		var
			slines, spixelsPerLine: integer;
	begin
		if info = NoInfo then
			exit(SaveSelection);
		if NoSelection or NotRectangular or NotInBounds then
			exit(SaveSelection);
		if OpPending then
			KillRoi;
		with info^ do begin
				with RoiRect do begin
						sPixelsPerLine := right - left;
						slines := bottom - top;
					end;
				if (PictureType = PictFile) and SaveAsSameType and (SaveAsWhat <> asRawData) then
					SaveAsPICT(fname, RefNum, true)
				else
					SaveAsTIFF(fname, RefNum, sLines, sPixelsPerLine, true);
			end;
	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, TextCreator, 'TEXT');
					if CheckIO(err) <> 0 then
						exit(SaveAsText);
				end;
			otherwise
				if CheckIO(err) <> 0 then
					exit(SaveAsTExt)
		end;
		ShowWatch;
		err := fsopen(fname, RefNum, f);
		if CheckIO(err) <> 0 then
			exit(SaveAsText);
		ByteCount := TextBufSize;
		err := fswrite(f, ByteCount, ptr(TextBufP));
		if CheckIO(err) <> 0 then
			exit(SaveAsText);
		err := SetEof(f, ByteCount);
		err := fsclose(f);
		err := FlushVol(nil, RefNum);
		if WhatsOnClip = TextOnClip then
			WhatsOnClip := NothingOnClip;
	end;


	procedure SaveAsPICS (fname: str255; fRefNum: integer);
		const
			rErr = 'Error Saving PICS file.';
		var
			err: OSErr;
			TheInfo: FInfo;
			replacing: boolean;
			rRefNum, i, SaveCS: integer;
			frect: rect;
			PicH: array[1..MaxSlices] of PicHandle;
			MinFreeRequired: LongInt;
			SaveGDevice: GDHandle;
	begin
		with info^, Info^.StackInfo^ do begin
				if StackInfo = nil then begin
						PutError('Only Stacks can be saved in PICS format.');
						SaveAsWhat := asTiff;
						exit(SaveAsPICS);
					end;
				if ImageSize > MinFree then
					MinFreeRequired := ImageSize
				else
					MinFreeRequired := MinFree;
				if MaxBlock < MinFreeRequired then begin
						PutError('Not enough memory available to save in PICS format.');
						exit(SaveAsPICS);
					end;
				err := GetFInfo(fname, fRefNum, TheInfo);
				if err = NoErr then
					with TheInfo do begin
							if (fdType <> 'TIFF') and (fdType <> 'PICT') and (fdType <> 'PICS') then begin
									TypeMismatch(fname);
									exit(SaveAsPICS)
								end;
							err := FSDelete(fname, fRefNum);
						end;
				ShowWatch;
				err := SetVol(nil, fRefNum);
				CreateResFile(fname);
				if ResError <> NoErr then
					exit(SaveAsPICS);
				rRefNum := OpenResFile(fname);
				SaveCS := CurrentSlice;
				SaveGDevice := GetGDevice;
				SetGDevice(osGDevice);
				SetPort(GrafPtr(osPort));
				with PicRect do
					SetRect(frect, 0, 0, right - left, bottom - top);
				ClipRect(frect);
				LoadLUT(ctable);
				pmForeColor(BlackIndex);
				pmBackColor(WhiteIndex);
				if OldSystem then begin
						RGBForeColor(BlackRGB);
						RGBBackColor(WhiteRGB);
					end;
				for i := 1 to nSlices do begin
						CurrentSlice := i;
						SelectSlice(CurrentSlice);
						UpdateTitleBar;
						PicH[i] := OpenPicture(frect);
						with osPort^ do
							CopyBits(BitMapHandle(portPixMap)^^, BitMapHandle(portPixMap)^^, PicRect, frect, SrcCopy, nil);
						ClosePicture;
						if (PicH[i] = nil) or ((PicH[i] <> nil) and (GetHandleSize(handle(PicH[i])) <= 10)) then begin
								PutError(rErr);
								leave;
							end;
						AddResource(handle(PicH[i]), 'PICT', i - 1 + 128, '');
						if ResError <> NoErr then begin
								PutError(rErr);
								leave;
							end;
						WriteResource(handle(PicH[i]));
						ReleaseResource(handle(PicH[i]));
						if ResError <> NoErr then begin
								PutError(rErr);
								leave;
							end;
					end; {for}
				pmForeColor(ForegroundIndex);
				pmBackColor(BackgroundIndex);
				SetGDevice(SaveGDevice);
				CurrentSlice := SaveCS;
				SelectSlice(CurrentSlice);
				RemovePath(fname);
				TruncateString(fname, maxTitle);
				title := fname;
				PictureType := PicsFile;
				UpdateTitleBar;
				CloseResFile(rRefNum);
				if ResError <> NoErr then
					PutError(rErr);
				err := GetFInfo(fname, fRefNum, TheInfo);
				TheInfo.fdType := 'PICS';
				TheInfo.fdCreator := 'Imag';
				err := SetFInfo(fname, fRefNum, TheInfo);
				err := FlushVol(nil, fRefNum);
				UpdateWindowsMenuItem;
			end; {with}
	end;


	function SuggestedName: str255;
		var
			name: str255;
	begin
		case SaveAsWhat of
			asTiff, asPict, asMacPaint, asRawData, asPICS:  begin
					name := info^.title;
					if name = 'Camera' then
						name := 'Untitled';
					SuggestedName := name;
				end;
			AsPalette: 
				SuggestedName := 'Palette';
			AsOutline: 
				SuggestedName := 'Outline';
		end;
	end;


	function SaveAsHook (item: integer; theDialog: DialogPtr): integer;
		const
			EditTextID = 7;
			TiffID = 9;
			OutlineID = 14;
		var
			i: integer;
			fname: str255;
			NameEdited: boolean;
	begin
		if item = -1 then {Initialize}
			SetDlogItem(theDialog, TiffID + ord(SaveAsWhat), 1);
		fname := GetDString(theDialog, EditTextID);
		NameEdited := fname <> SuggestedName;
		if (item >= TiffID) and (item <= OutlineID) then begin
				SaveAsWhat := SaveAsWhatType(item - TiffID);
				if not NameEdited then begin
						SetDString(theDialog, EditTextID, SuggestedName);
						SelectdialogItemText(theDialog, EditTextID, 0, 32767);
					end;
				for i := TiffID to OutlineID do
					SetDlogItem(theDialog, i, 0);
				SetDlogItem(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
		if SaveAsDHookProc=nil
			then SaveAsDHookProc:=NewRoutineDescriptor(@SaveAsHook, uppDlgHookProcInfo, GetCurrentISA);
		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) and (pos(':', name) = 0)) then begin
						where.v := 50;
						where.h := 50;
						if (StackInfo = nil) and (SaveAsWhat = asPICS) then
							SaveAsWhat := asTIFF;
						if (StackInfo <> nil) and ((SaveAsWhat = asPICT) or (SaveAsWhat = asMacPaint)) then
							SaveAsWhat := asTIFF;
						if name = '' then
							name := SuggestedName;
						SFPPutFile(Where, 'Save as?', name, SaveAsDHookProc, reply, CustomDialogID, nil);
						if not reply.good then begin
								SaveAllState := NoSaveAll;
								AbortMacro;
								exit(SaveAs);
							end;
						with reply do begin
								name := fname;
								RefNum := vRefNum;
								DefaultRefNum := RefNum;
							end;
					end;
				if StackInfo <> nil then begin
						if (SaveAsWhat <> asOutline) and not ((StackInfo^.StackType = RGBStack) and (StackInfo^.nSlices = 3)) then
							KillRoi;
						SaveAllState := NoSaveAll;
						if not ((SaveAsWhat = asTIFF) or (SaveAsWhat = asPICS) or (SaveAsWhat = asPalette) or (SaveAsWhat = asOutline)) then begin
								PutError('Stacks can only be saved in TIFF or PICS format.');
								SaveAsWhat := asTIFF;
								exit(SaveAs);
							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
							SaveAsTIFF(name, RefNum, 0, 0, false);
					asPict: 
						if isSelection then
							SaveAsPICT(name, RefNum, true)
						else
							SaveAsPICT(name, RefNum, false);
					asMacPaint: 
						SaveAsMacPaint(name, RefNum);
					asPICS: 
						SaveAsPICS(name, RefNum);
					AsPalette: 
						SaveColorTable(name, RefNum);
					AsOutline: 
						SaveOutline(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 CurrentWindow = ResultsKind then begin
				Export('', 0);
				exit(SaveFile);
			end;
		if CurrentWindow = TextKind then begin
				SaveText;
				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 MakingStack 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;
			TempTextInfo: TextInfoPtr;
			SizeStr, str: str255;
			wp: ^WindowPtr;
			pcrect: rect;
	begin
		if WhichWindow = nil then
			exit(CloseAWindow);
		kind := WindowPeek(WhichWindow)^.WindowKind;
		CloseAWindow := ok;
		if WhichWindow = VideoControl then begin
				DisposeDialog(VideoControl);
				VideoControl := nil;
				exit(CloseAWindow);
			end;
		case kind of
			PicKind:  begin
					Info := pointer(WindowPeek(WhichWindow)^.RefCon);
					with Info^ do begin
							if PicNum = 0 then begin
									beep;
									exit(CloseAWindow);
								end;
							if SaveChanges = cancel then begin
									CloseAWindow := cancel;
									exit(CloseAWindow)
								end;
							DeleteMenuItem(WindowsMenuH, PicNum + WindowsMenuItems + nTextWindows);
							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 = BlankField then
								BlankFieldInfo := nil;
							if StackInfo <> nil then begin
									with StackInfo^ do
										for i := 1 to nSlices do
											DisposeHandle(PicBaseH[i]);
									DisposePtr(pointer(StackInfo));
								end
							else begin
									if not MakingStack then
										DisposeHandle(PicBaseHandle);
								end;
							DisposeWindow(WhichWindow);
							CloseCPort(osPort);
							DisposePtr(ptr(osPort));
							DisposeRgn(roiRgn);
							nPics := nPics - 1;
							OpPending := false;
							isInsertionPoint := false;
							DisposePtr(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
											DrawMap;
									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;
			ResultsKind:  begin
					DisposeWindow(ResultsWindow);
					ResultsWindow := nil;
					TEDispose(ListTE);
				end;
			TextKind:  begin
					TextInfo := TextInfoPtr(WindowPeek(WhichWindow)^.RefCon);
					if TextInfo <> nil then
						with TextInfo^ do begin
								if SaveTextChanges = cancel then begin
										CloseAWindow := cancel;
										exit(CloseAWindow)
									end;
								DisposeWindow(TextWindowPtr);
								DeleteMenuItem(WindowsMenuH, WindowsMenuItems - 1 + WindowNum);
								TEDispose(TextTE);
								DisposePtr(ptr(TextInfo));
								TextInfo := nil;
								for i := WindowNum to nTextWindows - 1 do begin
										TextWindow[i] := TextWindow[i + 1];
										TempTextInfo := pointer(WindowPeek(TextWindow[i])^.RefCon);
										TempTextInfo^.WindowNum := i
									end;
								nTextWindows := nTextWindows - 1;
							end;
				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;
			otherwise
				;
		end; {case}
	end;


	procedure DoClose;
		var
			ignore: integer;
			fwptr: WindowPtr;
			kind: integer;
	begin
		fwptr := FrontWindow;
		if fwptr <> nil then begin
				if fwptr = VideoControl then begin
						DisposeDialog(VideoControl);
						VideoControl := nil;
						exit(DoClose);
					end;
				kind := WindowPeek(fwptr)^.WindowKind;
				if (kind = PicKind) or (kind = ProfilePlotKind) or (kind = CalibrationPlotKind) or (kind = HistoKind) or (Kind = PasteControlKind) or (Kind = ResultsKind) or (Kind = TextKind) then
					ignore := CloseAWindow(fwptr);
			end;
	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 > MaxLine 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;


{$POP}

	procedure CheckFileSize(f:integer; var size: LongInt; offset: LongInt);
	{Check to make sure we don't read past the end of file.}
	var
		FileSize: LongInt;
		err: OSErr;
	begin
		err := GetEof(f, FileSize);
		if (offset + size) > FileSize then begin
		   size := FileSize - offset;
		   if size < 0 then size := 0;
		end;
	end;


	procedure ReadStackSlices (f, nExtraImages: integer; var table: TiffIFDTable);
		var
			i, err, SaveCS: integer;
			h: handle;
			DataSize: LongInt;
			PartialStack: boolean;
	begin
		ShowMessage(CmdPeriodToStop);
		PartialStack := false;
		with info^ do begin
				StackInfo := StackInfoPtr(NewPtr(SizeOf(StackInfoRec)));
				if StackInfo = nil then
					exit(ReadStackSlices);
			end;
		with info^, info^.StackInfo^ do begin
				nSlices := nExtraImages + 1;
				CurrentSlice := TempStackInfo.CurrentSlice;
				if (CurrentSlice < 1) or (CurrentSlice > nSlices) then
					CurrentSlice := 1;
				SliceSpacing := TempStackInfo.SliceSpacing;
				FrameInterval := TempStackInfo.FrameInterval;
				StackType := TempStackInfo.StackType;
				SaveCS := CurrentSlice;
				PicBaseH[1] := PicBaseHandle;
				revertable := false;
				for i := 2 to nSlices do begin
						h := GetBigHandle(PixMapSize);
						if h = nil then begin
								nSlices := i - 1;
								PutError(concat('Not enough memory to open all ', long2str(nExtraImages + 1), ' slices in the stack.'));
								PartialStack := true;
								leave;
							end;
						PicBaseH[i] := h;
						CurrentSlice := i;
						SelectSlice(i);
						UpdateTitleBar;
						DataSize := ImageSize;
						err := SetFPos(f, fsFromStart, table[i - 1].offset);
						CheckFileSize(f, DataSize, table[i - 1].offset);
						if DataSize > 0 then
							err := fsread(f, DataSize, h^);
						if odd(PixelsPerLine) then
							UnpackLines;
						if InvertedImage then
							InvertPic;
						UpdatePicWindow;
						if CommandPeriod then begin
								beep;
								if i < nSlices then
									PartialStack := true;
								nSlices := i;
								wait(60);
								leave;
							end;
					end; {for}
				CurrentSlice := SaveCS;
				if CurrentSlice > nSlices then
					CurrentSlice := 1;
				SelectSlice(CurrentSlice);
				if PartialStack then begin
						vref := 0;
						PictureType := NewPicture;
						title := concat(title, '@');
					end;
				UpdateTitleBar;
				UpdateWindowsMenuItem;
			end;
	end;


	procedure OpenStack (f: integer);
		var
			table: TiffIFDTable;
			i, nExtraImages: integer;
			where: LongInt;
	begin
		nExtraImages := TempStackInfo.nSlices - 1;
		with info^ do begin
				where := ImageDataOffset;
				for i := 1 to nExtraImages do
					with table[i] do begin
							iWidth := PixelsPerLine;
							iHeight := nLines;
							where := where + ImageSize;
							Offset := where;
							invert := false;
						end;
				ReadStackSlices(f, nExtraImages, table);
			end;
	end;


	procedure OpenExtraTiffImages (f: integer; NextTiffIFD: LongInt);
		var
			table: TiffIFDTable;
			TiffInfo: TiffInfoRec;
			i, nExtraImages: integer;
			AllSameSize: boolean;
	begin
		nExtraImages := 0;
		repeat
			if not OpenTiffDirectory(f, NextTiffIFD, TiffInfo, false) then
				exit(OpenExtraTiffImages);
			nExtraImages := nExtraImages + 1;
			with TiffInfo, table[nExtraImages] do begin
					iWidth := width;
					iHeight := height;
					Offset := OffsetToData;
					invert := ZeroIsBlack;
					NextTiffIFD := NextIFD;
				end;
		until (NextTiffIFD = 0) or (nExtraImages = MaxSlices);
		AllSameSize := true;
		with info^ do begin
				for i := 1 to nExtraImages do
					AllSameSize := AllSameSize and (PixelsPerLine = table[i].iWidth) and (nLines = table[i].iHeight);
				if AllSameSize and not odd(PixelsPerLine) then
					ReadStackSlices(f, nExtraImages, table);
			end;
	end;

	procedure OpenRGBTiff(f: integer);
	const
		bufsize = 12000;
	var
		i, row, pixel, rgbPixel, ignore, SaveRow: integer;
		NextUpdate, count: LongInt;
		buffer: packed array [0 .. bufsize] of byte;
		rLine, gLine, bLine: LineType;
		err: OSErr;
		MaskRect: rect;
	begin
		with info^ do begin
			if PixelsPerLine > MaxLine then
				exit(OpenRGBTiff);
			if not MakeStackFromWindow then
				exit(OpenRGBTiff);
			if not AddSlice(false) then begin
					info^.changes := false;
					ignore := CloseAWindow(info^.wptr);
					exit(OpenRGBTiff);
				end;
			if not AddSlice(false) then begin
					info^.changes := false;
					ignore := CloseAWindow(info^.wptr);
					exit(OpenRGBTiff);
				end;
			SaveRow:=0;
			NextUpdate:=TickCount+6;
			err := SetFPos(f, fsFromStart, ImageDataOffset);
			count := 0;
			for row:=0 to nLines - 1 do begin
				for pixel := 0 to PixelsPerLine - 1 do begin
					if count <= 0 then begin
						count := bufsize;
						err := fsread(f, count, @buffer);
						if err <> -39 then {eof error}
							if CheckIO(err) <> noErr then
								exit(OpenRGBTiff);
						rgbPixel := 0;
					end;
					rLine[pixel] := 255 - buffer[rgbPixel];
					gLine[pixel] := 255 - buffer[rgbPixel + 1];
					bLine[pixel] := 255 - buffer[rgbPixel + 2];
					rgbPixel := rgbPixel + 3;
					count := count - 3;
				end;
				SelectSlice(1);
				PutLine(0, row, PixelsPerLine, rLine);
				if TickCount>=NextUpdate then begin
					SetRect(MaskRect, 0, SaveRow, PixelsPerLine, row+1);
					UpdateScreen(MaskRect);
					SaveRow:=row + 1;
					NextUpdate:=TickCount+6;
				end;
				SelectSlice(2);
				PutLine(0, row, PixelsPerLine, gLine);
				SelectSlice(3);
				PutLine(0, row, PixelsPerLine, bLine);
			end; {for}
			with StackInfo^ do begin
				CurrentSlice := 1;
				SelectSlice(CurrentSlice);
				StackType := rgbStack;
			end;
			SetRect(MaskRect, 0, SaveRow, PixelsPerLine, nLines);
			UpdateScreen(MaskRect);
			UpdateTitleBar;
			ResetGrayMap;
			OpeningRGB := true;
		end; {with}
	end;
	

	function OpenFile (fname: str255; vnum: integer): boolean;
		var
			ticks, ByteCount, i, DataSize, NextTiffIFD: LongInt;
			err: OSErr;
			f: integer;
			line, pixel: integer;
			iptr, p: ptr;
			SaveInfo: InfoPtr;
			TiffInfo: TiffInfoRec;
			isRGBTiff: boolean;
	begin
		OpenFile := false;
		ShowWatch;
		err := fsopen(fname, vNum, f);
		SaveInfo := Info;
		iptr := NewPtr(SizeOf(PicInfo));
		if iptr = nil then begin
				PutMemoryAlert;
				err := fsclose(f);
				exit(OpenFile)
			end;
		Info := pointer(iptr);
		CloneInfo(SaveInfo^, Info^);
		with Info^ do begin
				ColorMapOffset := 0;
				if not OpenHeader(f, fname, vnum, TiffInfo) then begin
						DisposePtr(iptr);
						err := fsclose(f);
						Info := SaveInfo;
						exit(OpenFile)
					end;
				if WhatToOpen = OpenTIFF then begin
					NextTiffIFD := TiffInfo.NextIFD;
					isRGBTiff := TiffInfo.SamplesPerPixel = 3;
				end else begin
					NextTiffIFD := 0;
					isRGBTiff := false;
				end;
				p := GetImageMemory(SaveInfo);
				if p = nil then begin
						err := fsclose(f);
						exit(OpenFile)
					end;
				PicBaseAddr := p;
				MakeNewWindow(fname);
				err := SetFPos(f, fsFromStart, ImageDataOffset);
				if PictureType = FourBitTIFF then
					Read4BitTIFF(f)
				else if not isRGBTiff then begin
						DataSize := nlines * PixelsPerLine;
						CheckFileSize(f, DataSize, ImageDataOffset);
						if DataSize > 0 then
							err := fsread(f, DataSize, PicBaseAddr);
						if CheckIO(err) <> NoErr then begin
								err := fsclose(f);
								exit(OpenFile)
							end;
					end;
				if odd(PixelsPerLine) and (PictureType <> FourBitTiff) then
					UnpackLines;
				if (PictureType = Imported) and (ImportInvert or (WhatToImport = ImportMCID)) then
					InvertedImage := true;
				if InvertedImage then
					InvertPic;
				if PictureType = FourBitTIFF then
					PictureType := imported;
				if (ColorMapOffset > 0) and (fileVersion = 0) then begin
						FixColors; {Fix colors, if necessary, of imported color TIFF files.}
						WhatToUndo := NothingToUndo;
					end;
				vref := vnum;
				if PixMapSize > UndoBufSize then
					PutWarning;
				revertable := true;
			end; {with}
			if isRGBTiff then
				OpenRGBTiff(f)
			else if TempStackInfo.nSlices > 0 then
				OpenStack(f)
			else if NextTiffIFD > 0 then
			OpenExtraTiffImages(f, NextTiffIFD);
		err := fsclose(f);
		OpenFile := true;
	end;


{$PUSH}
{$D-}

	procedure ScaleToEightBits (f: integer);
		type
			PixelLUTType = packed array[0..65535] of byte;
			PixelLUTPtr = ^PixelLUTType;
			IntLineType = array[0..MaxLine] of integer;
		var
			line: LineType;
			i, j, value, LineSize, offset: LongInt;
			ScaleFactor: extended;
			hloc, vloc, wwidth, wheight, IntValue, SaveBytesPerRow: integer;
			PixelLUT: PixelLUTPtr;
			str1, str2: str255;
			err: integer;
			aLine: IntLineType;
			LinesPerUpdate: integer;

		procedure reset;
			var
				DataSize, SliceOffset: LongInt;
				p: ptr;
		begin
			with info^ do begin
					if StackInfo <> nil then
						SliceOffset := ImageSize * 2 * (StackInfo^.CurrentSlice - 1)
					else
						SliceOffset := 0;
					err := SetFPos(f, fsFromStart, ImageDataOffset + SliceOffset);
					if DataH <> nil then begin
							if offset = -1 then begin
									hlock(DataH);
									DataSize := ImageSize * 2;
									CheckFileSize(f, DataSize, ImageDataOffset);
									if DataSize > 0 then
										err := fsread(f, DataSize, DataH^);
								end;
							offset := 0
						end;
				end;
		end;


		procedure GetIntLine (var line: IntLineType);
			type
				atype = packed array[1..2] of char;
			var
				p: ptr;
				a: atype;
				c: char;
				i: integer;
		begin
			with info^ do begin
					if DataH <> nil then begin
							p := ptr(ord4(DataH^) + offset);
							if (offset + LineSize) <= (PixMapSize * 2) then
								BlockMove(p, @line, LineSize);
							offset := offset + LineSize;
						end
					else
						err := fsread(f, LineSize, @line);
					if LittleEndian then
						for i := 0 to LineSize div 2 - 1 do begin
								a := atype(line[i]);
								c := a[1];
								a[1] := a[2];
								a[2] := c;
								line[i] := integer(a)
							end;
				end;
		end;
		
		procedure FindMinAndMax;
		var
			vloc, hloc: integer;
			value: LongInt;
		begin
			with info^ do begin
				AbsoluteMin := 999999;
				AbsoluteMax := -999999;
				for vloc := 0 to nlines - 1 do begin
						if (vloc mod LinesPerUpdate) = 0 then
							ShowAnimatedWatch;
						GetIntLine(aLine);
						for hloc := 0 to PixelsPerLine - 1 do begin
								value := aLine[hloc];
								if (DataType = SixteenBitsUnsigned) and (value < 0) then
									value := value + 65536;
								if value > AbsoluteMax then
									AbsoluteMax := value;
								if value < AbsoluteMin then begin
									if ImportingDicom then begin
										if value <> -32767 then AbsoluteMin := value
									end else
										AbsoluteMin := value;
								end; {value <AbsoluteMin}
							end {for hloc:=}
					end;{for vloc := }
				if (CurrentMin = 0) and (CurrentMax = 0) then begin
						CurrentMin := AbsoluteMin;
						CurrentMax := AbsoluteMax;
					end;
				reset;
			end; {with}
		end;

	begin
		with info^ do begin
				PixelLUT := PixelLUTPtr(NewPtr(SizeOf(PixelLUTType)));
				if PixelLUT = nil then begin
						if DataH <> nil then begin
								DisposeHandle(DataH);
								DataH := nil
							end;
						PutError('Not enough memory to do 16 to 8-bit scaling.');
						AbortMacro;
						exit(ScaleToEightBits);
					end;
				offset := -1;
				reset;
				LineSize := PixelsPerLine * 2;
				LinesPerUpdate := 40000 div LineSize;
				if (AbsoluteMin = 0) and (AbsoluteMax = 0) then
					FindMinAndMax;
				str1 := concat('min=', long2str(CurrentMin), ' (', long2str(AbsoluteMin), ')', crStr, 'max=', long2str(CurrentMax), ' (', long2str(AbsoluteMax), ')');
				ScaleFactor := 253.0 / (CurrentMax - CurrentMin);
				RealToString(ScaleFactor, 1, 4, str2);
				ShowMessage(concat(str1, crStr, 'scale factor= ', str2));
				j := 0;
				for i := CurrentMin to CurrentMax do begin
						PixelLUT^[j] := round((i - CurrentMin) * ScaleFactor + 1);
						j := j + 1;
					end;
				for vloc := 0 to nlines - 1 do begin
						if (vloc mod LinesPerUpdate) = 0 then
							ShowAnimatedWatch;
						GetIntLine(aLine);
						for hloc := 0 to PixelsPerLine - 1 do begin
								value := aLine[hloc];
								if (DataType = SixteenBitsUnsigned) and (value < 0) then
									value := value + 65536;
								if value < CurrentMin then
									value := CurrentMin;
								if value > CurrentMax then
									value := CurrentMax;
								line[hloc] := PixelLUT^[value - CurrentMin];
								i := i + 1;
							end;
						PutLine(0, vloc, PixelsPerLine, line);
					end;
				if fit = StraightLine then begin
						nCoefficients := 2;
						coefficient[2] := (CurrentMin - CurrentMax) / 253.0;
						coefficient[1] := CurrentMax - coefficient[2];
						nKnownValues := 0;
						ZeroClip := false;
						UpdateTitleBar;
					end;
				DisposePtr(ptr(PixelLUT));
				if DataH <> nil then begin
						DisposeHandle(DataH);
						DataH := nil
					end;
			end; {with}
	end;


	procedure RescaleToEightBits;
		var
			range: LongInt;
			err: OSErr;
			f: integer;
	begin
		with info^ do begin
				ShowWatch;
				KillRoi;
				DisableDensitySlice;
				err := fsopen(title, vref, f);
				if CheckIO(err) <> 0 then
					exit(RescaleToEightBits);
				range := CurrentMax - CurrentMin;
				if ColorStart > 0 then
					CurrentMax := CurrentMax - round((ColorStart / 255.0) * range)
				else
					CurrentMax := AbsoluteMax;
				if ColorEnd < 255 then
					CurrentMin := CurrentMin + round(((255 - ColorEnd) / 255.0) * range)
				else
					CurrentMin := AbsoluteMin;
				ScaleToEightBits(f);
				err := fsclose(f);
				InvertPic;
				UpdatePicWindow;
				ResetMap;
				if fit <> uncalibrated then
					GenerateValues;
			end;
	end;


	procedure Import16BitSlices (f: integer);
		var
			i, err: integer;
			h: handle;
			DataSize, nImages, MaxImages, FileSize: LongInt;
	begin
		with info^ do begin
				nImages := ImportCustomSlices;
				err := GetEof(f, FileSize);
				MaxImages := (FileSize - ImportCustomOffset) div (ImageSize * 2);
				if nImages > MaxImages then
					nImages := MaxImages;
				if nImages < 2 then
					exit(Import16BitSlices);
				ShowMessage(CmdPeriodToStop);
				StackInfo := StackInfoPtr(NewPtr(SizeOf(StackInfoRec)));
				if StackInfo = nil then
					exit(Import16BitSlices);
			end; {with}
		with info^, info^.StackInfo^ do begin
				nSlices := nImages;
				SliceSpacing := 0.0;
				FrameInterval := 0.0;
				StackType := VolumeStack;
				PicBaseH[1] := PicBaseHandle;
				revertable := false;
				for i := 2 to nSlices do begin
						h := NewHandle(PixMapSize);
						if h = nil then begin
								nSlices := i - 1;
								leave;
							end;
						PicBaseH[i] := h;
						CurrentSlice := i;
						SelectSlice(i);
						UpdateTitleBar;
						DataSize := ImageSize;
						AbsoluteMin := 0;
						AbsoluteMax := 0;
						CurrentMin := 0;
						CurrentMax := 0;
						if not ImportAutoScale then begin
								if ((ImportMax - ImportMin) > 65536.0) or (ImportMin > ImportMax) then begin
										ImportMin := 0.0;
										ImportMax := 255;
									end;
								CurrentMin := round(ImportMin);
								CurrentMax := round(ImportMax);
							end;
						ScaleToEightBits(f);
						InvertPic;
						UpdatePicWindow;
						if CommandPeriod then begin
								beep;
								nSlices := i;
								wait(60);
								leave;
							end;
					end; {for}
				if (MaxBlock < MinFree) and (nSlices > 1) then begin
						repeat
							DisposeHandle(PicBaseH[nSlices]);
							nSlices := nSlices - 1;
						until (MaxBlock > MinFree) or (nSlices = 1);
						PutError(concat('Not enough memory to open all ', long2str(nImages), ' slices in the stack.'));
					end;
				CurrentSlice := 1;
				SelectSlice(CurrentSlice);
				UpdateTitleBar;
				UpdateWindowsMenuItem;
			end;
	end;


	function Import16BitFile (fname: str255; vnum: integer): boolean;
		var
			ticks, ByteCount, i: LongInt;
			err: OSErr;
			f: integer;
			line, pixel: integer;
	begin
		Import16BitFile := false;
		if ImportCustomWidth > MaxLine then
			exit(Import16BitFile);
		if not NewPicWindow(fname, ImportCustomWidth, ImportCustomHeight) then
			exit(Import16BitFile);
		ShowWatch;
		err := fsopen(fname, vNum, f);
		with info^ do begin
				PictureType := imported;
				ImageDataOffset := ImportCustomOffset;
				DataType := ImportCustomDepth;
				vref := vnum;
				AbsoluteMin := 0;
				AbsoluteMax := 0;
				CurrentMin := 0;
				CurrentMax := 0;
				LittleEndian := ImportSwapBytes;
				if ImportCalibrate then begin
					fit := StraightLine;
					nCoefficients := 2;
					coefficient[1] := 0.0; {ScaleToEightBits changes these coefficient}
					coefficient[2] := 1.0;
				end else
					RemoveDensityCalibration;
				if not ImportAutoScale then begin
						if ((ImportMax - ImportMin) > 65536.0) or (ImportMin > ImportMax) then begin
								ImportMin := 0.0;
								ImportMax := 255;
							end;
						CurrentMin := round(ImportMin);
						CurrentMax := round(ImportMax);
					end;
				DataH := GetBigHandle(PixMapSize * 2);
				ScaleToEightBits(f);
				if ImportCustomSlices > 1 then
					Import16BitSlices(f);
				err := fsclose(f);
				InvertPic;
				if PixMapSize > UndoBufSize then
					PutWarning;
				revertable := false;
			end; {with}
		Import16BitFile := true;
	end;


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


	procedure FillPictBuffer;
		var
			count: LongInt;
			err: OSErr;
	begin
		count := GetPtrSize(PictBuffer);
		if not fitsInPictBuffer then begin
				err := FSRead(PictF, count, PictBuffer);
				if err <> NoErr then
					PictReadErr := true;
			end;
		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 begin
				PictSrcRect := srcRect;
				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 begin
									BitInfoCount := BitInfoCount + 1;
									if not UseExistingLUT then
										with info^ do begin
												for i := 0 to size do
													cTable[i].rgb := ctTable[i].rgb;
												LutMode := ColorLut;
												SetupPseudocolor;
											end;
								end;
						end; {with}
			end;
	end;


	procedure GetLUTFromPict (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;
			SavePort: GrafPtr;
			err: osErr;
			TempPort: CGrafPort;
			limbo: rect;
			xxscale, yyscale: extended;
	begin
		GetPort(SavePort);
		OpenCPort(@TempPort);
		SetStdCProcs(tempProcs);
		tempProcs.bitsProc := BitInfoProc;
		tempProcs.getPicProc := GetPICTDataProc;
		PictSrcRect := thePict^^.picFrame;
		BitInfoCount := 0;
		TempPort.grafProcs := @tempProcs;
		err := SetFPos(PictF, fsFromStart, 512 + SizeOf(Picture));
		FillPictBuffer;
		limbo := thePict^^.picFrame;
		OffsetRect(limbo, 10000, 10000);
		if not PictReadErr then
			DrawPicture(thePict, limbo);
		CloseCPort(@TempPort);
		SetPort(SavePort);
		with info^, PictSrcRect do begin
				LoadLUT(cTable);
				xxScale := (right - left) / PixelsPerLine;
				yyScale := (bottom - top) / nLines;
				if (xxScale > 1.0) and ((PixelsPerLine * xxScale) <= MaxLine) and ((xxScale - yyScale) < 0.1) then begin
						PixelsPerLine := right - left;
						nLines := bottom - top;
					end;
			end; {with}
	end;


	function OpenPict;{(fname:str255; vnum:integer; Reverting:boolean):boolean}
		var
			err: OSErr;
			i: integer;
			iptr, p: ptr;
			PictSize, HowBig: LongInt;
			thePict: PicHandle;
			tPort: GrafPtr;
			tempProcs: CQDProcs;
			SaveProcsPtr: QDProcsPtr;
			SaveInfo: InfoPtr;
			SaveGDevice: GDHandle;
			TiffInfo: TiffInfoRec;

		procedure Abort;
		begin
			if not reverting then begin
					DisposePtr(pointer(Info));
					Info := SaveInfo;
					LoadLUT(info^.cTable);
				end;
			if thePict <> nil then
				DisposeHandle(handle(thePict));
			if PictF <> 0 then
				err := fsclose(PictF);
			{exit(OpenPict);} {ppc-bug}
		end;

	begin
		if BitInfoProc=nil
			then BitInfoProc:=NewRoutineDescriptor(@BitInfo, uppQDBitsProcInfo, GetCurrentISA);
		if GetPictDataProc=nil
			then GetPictDataProc:=NewRoutineDescriptor(@GetPictData, uppQDGetPicProcInfo, GetCurrentISA);
		PictF := 0;
		thePict := nil;
		OpenPict := false;
		PictReadErr := false;
		ShowWatch;
		SaveInfo := Info;
		err := fsopen(fname, vNum, PictF);
		if CheckIO(err) <> 0 then begin
			Abort;
			exit(OpenPict)
		end;
		if not Reverting then begin
				iptr := NewPtr(SizeOf(PicInfo));
				if iptr = nil then begin
						PutMemoryAlert;
						err := fsclose(PictF);
						exit(OpenPict)
					end;
				Info := pointer(iptr);
				CloneInfo(SaveInfo^, Info^);
			end;
		with Info^ do begin
				err := GetEof(PictF, PictSize);
				if CheckIO(err) <> 0 then begin
					Abort;
					exit(OpenPict)
				end;
				PictSize := PictSize - 512;
				if PictSize <= 0 then begin
					Abort;
					exit(OpenPict)
				end;
				WhatToOpen := OpenPICT2;
				if not OpenHeader(PictF, fname, vnum, TiffInfo) then begin
					Abort;
					exit(OpenPict)
				end;
				thePict := PicHandle(NewHandle(SizeOf(Picture)));
				if thePict = nil then begin
					Abort;
					exit(OpenPict);
				end;
				err := SetFPos(PictF, fsFromStart, 512);
				if CheckIO(err) <> 0 then begin
					Abort;
					exit(OpenPict)
				end;
				howBig := SizeOf(Picture);
				err := FSRead(PictF, howBig, Pointer(thePict^));
				if CheckIO(err) <> 0 then begin
					Abort;
					exit(OpenPict)
				end;
				with thePict^^.PicFrame do begin
						nlines := bottom - top;
						PixelsPerLine := right - left;
					end;
         {....}
				err := GetEof(PictF, howBig);
				howBig := howBig - (512 + SizeOf(Picture));
				InitPictBuffer(HowBig * 2);
				if GetPtrSize(PictBuffer) >= howBig then begin
						err := FSRead(PictF, howBig, PictBuffer);
						if CheckIO(err) <> NoErr then begin
								DisposeHandle(handle(thePict));
								DisposePtr(PictBuffer);
								err := fsclose(PictF);
								exit(OpenPict)
							end;
						fitsInPictBuffer := true;
					end
				else
					fitsInPictBuffer := false;
				if (LutMode = ColorLut) or (LutMode = CustomGrayscale) or (fileVersion = 0) then
					GetLUTFromPict(thePict);
				if not Reverting then begin
						p := GetImageMemory(SaveInfo);
						if p = nil then begin
								DisposeHandle(handle(thePict));
								DisposePtr(PictBuffer);
								err := fsclose(PictF);
								exit(OpenPict)
							end;
						PicBaseAddr := p;
						MakeNewWindow(fname);
					end;
				if (PixMapSize > UndoBufSize) and (not Reverting) then begin
						PutWarning;
						ShowWatch;
					end;
				if isGrayScaleLUT then
					ResetGrayMap;
				SaveGDevice := GetGDevice;
				SetGDevice(osGDevice);
				GetPort(tPort);
				SetPort(GrafPtr(osPort));
				pmForeColor(BlackIndex);
				pmBackColor(WhiteIndex);
				RGBForeColor(BlackRGB);
				RGBBackColor(WhiteRGB);
				EraseRect(PicRect);
				SaveProcsPtr := pointer(osPort^.grafProcs);
				SetStdCProcs(tempProcs);
				tempProcs.getPicProc := GetPICTDataProc;
				osPort^.grafProcs := @TempProcs;
				err := SetFPos(PictF, fsFromStart, 512 + SizeOf(Picture));
				FillPictBuffer;
				if not PictReadErr then
					DrawPicture(thePict, PicRect);
				osPort^.grafProcs := pointer(SaveProcsPtr);
				DisposeHandle(handle(thePict));
				DisposePtr(PictBuffer);
				pmForeColor(ForegroundIndex);
				pmBackColor(BackgroundIndex);
				SetPort(tPort);
				SetGDevice(SaveGDevice);
				vref := vnum;
				PictureType := PictFile;
				revertable := true;
			end; {with}
		err := fsclose(PictF);
		SetupUndo;
		if not PictReadErr then
			OpenPict := true;
	end;


	procedure GetCLUT (thePict: PicHandle);
		type
			myPicData = record
					p: Picture;
					ID: integer
				end;
			myPicPtr = ^myPicData;
			myPicHdl = ^myPicPtr;
		var
			tempProcs: CQDProcs;
			SaveProcsPtr: QDProcsPtr;
			err: osErr;
	begin
		with info^ do begin
				SetPort(GrafPtr(osPort));
				SaveProcsPtr := pointer(wptr^.grafProcs);
				SetStdCProcs(tempProcs);
				tempProcs.bitsProc := BitInfoProc;
				BitInfoCount := 0;
				osPort^.grafProcs := @tempProcs;
				DrawPicture(thePict, thePict^^.picFrame);
				osPort^.grafProcs := pointer(SaveProcsPtr);
				LoadLUT(cTable);
			end;
	end;


	function OpenPICS (name: str255; fRefNum: integer): boolean;
		var
			RefNum, picID, hOffset, vOffset, nPICS, i: integer;
			err: OSErr;
			PicH: PicHandle;
			h: handle;
			MemError, Aborted: boolean;
			FrameRect: rect;
			SaveGDevice: GDHandle;
	begin
		if BitInfoProc=nil
			then BitInfoProc:=NewRoutineDescriptor(@BitInfo, uppQDBitsProcInfo, GetCurrentISA);
		OpenPics := false;
		if MaxBlock < MinFree then begin
				PutError('Insufficient memory to open PICS file.');
				exit(OpenPICS);
			end;
		ShowWatch;
		err := SetVol(nil, fRefNum);
		RefNum := OpenResFile(name);
		if RefNum = -1 then begin
				PutError('Unable to open PICS file.');
				exit(OpenPICS);
			end;
		nPICS := Count1Resources('PICT');
		if nPICS < 1 then begin
				PutError('No PICTs found.');
				CloseResFile(RefNum);
				exit(OpenPICS);
			end;
		PicH := GetPicture(128);
		if PicH = nil then begin
			CloseResFile(RefNum);
			exit(OpenPICS);
		end;
		FrameRect := PicH^^.PicFrame;
		with FrameRect do begin
				hOffset := left;
				vOffset := top;
				right := right - hOffset;
				bottom := bottom - vOffset;
				left := 0;
				top := 0;
			end;
		with FrameRect do
			if not NewPicWindow(name, right - left, bottom - top) then begin
				CloseResFile(RefNum);
				exit(OpenPICS);
			end;
		with info^ do begin
				revertable := false;
				StackInfo := StackInfoPtr(NewPtr(SizeOf(StackInfoRec)));
				if StackInfo = nil then begin
					CloseResFile(RefNum);
					exit(OpenPICS);
				end;
				with StackInfo^ do begin
						SliceSpacing := 0.0;
						FrameInterval := 0.0;
						StackType := VolumeStack;
						nSlices := 1;
						CurrentSlice := 1;
						PicBaseH[1] := PicBaseHandle;
					end;
			end;
		if not UseExistingLUT then
			GetCLUT(picH);
		with info^, Info^.StackInfo^ do begin
				SaveGDevice := GetGDevice;
				SetGDevice(osGDevice);
				SetPort(GrafPtr(osPort));
				pmBackColor(WhiteIndex);
				EraseRect(PicRect);
				DrawPicture(picH, PicRect);
				DisposeHandle(handle(picH));
				SetGDevice(SaveGDevice);
				UpdatePicWindow;
				picID := 129;
				MemError := false;
				for i := 2 to nPICS do begin
						PicH := GetPicture(picID);
						if (PicH = nil) or (ResError <> NoErr) then
							Leave;
						h := GetBigHandle(PixMapSize);
						if h = nil then begin
								if PicH <> nil then
									DisposeHandle(handle(picH));
								MemError := true;
								Leave;
							end;
						nSlices := nSlices + 1;
						CurrentSlice := CurrentSlice + 1;
						PicBaseH[CurrentSlice] := h;
						SelectSlice(CurrentSlice);
						FrameRect := PicH^^.PicFrame;
						with FrameRect do begin
								right := right - hOffset;
								bottom := bottom - vOffset;
								left := left - hOffset;
								top := top - vOffset;
							end;
						SetGDevice(osGDevice);
						EraseRect(PicRect);
						if not EqualRect(FrameRect, PicRect) then
							BlockMove(PicBaseH[CurrentSlice - 1]^, PicBaseH[CurrentSlice]^, PixMapSize);
						DrawPicture(picH, FrameRect);
						DisposeHandle(handle(picH));
						SetGDevice(SaveGDevice);
						UpdatePicWindow;
						UpdateTitleBar;
						Aborted := CommandPeriod;
						if Aborted then begin
								beep;
								wait(60);
								Leave;
							end;
						picID := picID + 1;
					end;
				CloseResFile(RefNum);
				if MemError then
					PutError('Not enough memory to open all images in PICS file.');
				CurrentSlice := 1;
				SelectSlice(CurrentSlice);
				PictureType := PicsFile;
				Revertable := false;
				UpdateTitleBar;
				UpdateWindowsMenuItem;
				if not MemError and not Aborted then
					OpenPICS := true;
			end; {with}
	end;


{$D-}

	procedure OpenAll (RefNum: integer);
	  {Opens all appropriate files in a folder.    Original version contributed by Ira Rampil.}
		var
			OpenedOK: boolean;
			index,vRefNum: integer;
			name: Str255;
			ftype: OSType;
			err: OSErr;
			PB: CInfoPBRec;
			dirID,ProcID:LongInt;
	begin
		vRefNum:=0;
		err:=GetWDInfo(RefNum,vRefNum,dirID,ProcID);
		if err<>noErr then
			exit(OpenAll);
		index := 0;
		while true do begin
				index := index + 1;
				with PB do begin
						ioCompletion := nil;
						ioNamePtr := @name;
						ioVRefNum := RefNum;
						ioDirID:=DirID;
						ioFDirIndex := index;
						err := PBGetCatInfoSync(@PB); {ppc-bug}
						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);
				if CommandPeriod or (nPics>=MaxPics) then begin
						beep;
						exit(OpenAll);
					end;
			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
			SetDlogItem(theDialog, KeepLutID, 1);
		if item = OpenAllID then begin
				OpenAllFiles := not OpenAllFiles;
				SetDlogItem(theDialog, OpenAllID, ord(OpenAllFiles));
			end;
		if item = KeepLutID then begin
				UseExistingLUT := not UseExistingLUT;
				SetDlogItem(theDialog, KeepLutID, ord(UseExistingLut));
			end;
		OpenDialogHook := item;
	end;


	function isTiffFile (fname: str255; RefNum: integer): boolean;
  {Returns true if the first 16-bit word of the file contains 'MM' or 'II' and the second contains 42.}
		var
			f: integer;
			ByteCount: LongInt;
			hdr: array[1..512] of integer;
			err: OSErr;
	begin
		err := fsopen(fname, RefNum, f);
		err := SetFPos(f, fsFromStart, 0);
		ByteCount := 4;
		err := fsread(f, ByteCount, @hdr);
		isTiffFile := ((hdr[1] = $4949) and (hdr[2] = $2A00) or (hdr[1] = $4D4D) and (hdr[2] = $002A));
		err := fsclose(f);
	end;


	function DoOpen (FileName: str255; RefNum: integer): boolean;
		const
			MyDialogID = 70;
		var
			where: Point;
			reply: SFReply;
			b: boolean;
			TypeList: array[0..10] of OSType;
			FileType: OSType;
			OKToContinue: boolean;
			FinderInfo: FInfo;
			err: OSErr;
	begin
		if OpenDHookProc=nil
			then OpenDHookProc:=NewRoutineDescriptor(@OpenDialogHook, uppDlgHookProcInfo, GetCurrentISA);
		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';   {Color Tables}
				typeList[4] := 'PX05'; {PixelPaint LUT}
				typeList[5] := 'CLUT';  {Klutz LUT}
				typeList[6] := 'drwC';  {Canvas LUT}
				typeList[7] := 'PNTG';  {MacPaint}
				typeList[8] := 'PICS';
				typeList[9] := 'Iout';    {Outlines}
				typeList[10] := 'TEXT';
				SFPGetFile(Where, '', nil, 11, @TypeList, OpenDHookProc, 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(RefNum);
						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 = 'ICOL' then
					OpenColorTable(FileName, RefNum)
				else if FileType = 'PX05' then
					ImportPalette('PX05', FileName, RefNum)
				else if FileType = 'CLUT' then
					ImportPalette('CLUT', FileName, RefNum)
				else if FileType = 'drwC' then
					ImportPalette('PX05', FileName, RefNum)
				else if FileType = 'PNTG' then
					b := OpenMacPaint(FileName, RefNum)
				else if FileType = 'PICS' then
					b := OpenPICS(FileName, RefNum)
				else if FileType = 'Iout' then
					OpenOutline(FileName, RefNum)
				else if FileType = 'TEXT' then begin
						if isTiffFile(FileName, RefNum) and not OptionKeyWasDown then begin
								WhatToOpen := OpenTIFF;
								b := OpenFile(FileName, RefNum)
							end
						else
							b := OpenTextFile(FileName, RefNum)
					end
				else begin
						WhatToOpen := OpenUnknown;
						b := OpenFile(FileName, RefNum)
					end;
				info^.ScaleToFitWindow := false;
				if macro then
					GenerateValues;
			end;
	end;


	procedure ImportAllFiles (RefNum: integer);
		var
			OpenedOK: boolean;
			index, vRefNum: integer;
			name: Str255;
			ftype: OSType;
			err: OSErr;
			PB: CInfoPBRec;
			dirID,ProcID:LongInt;
	begin
		vRefNum:=0;
		err:=GetWDInfo(RefNum, vRefNum, dirID, ProcID);
		if err<>noErr then
			exit(ImportAllFiles);
		index := 0;
		while true do begin
				index := index + 1;
				with PB do begin
						ioCompletion := nil;
						ioNamePtr := @name;
						ioVRefNum := RefNum;
						ioDirID:=dirID;
						ioFDirIndex := index;
						err := PBGetCatInfoSync(@PB); {ppc-bug}
						if err = fnfErr then
							exit(ImportAllFiles);
						ftype := ioFlFndrInfo.fdType;
					end;
				if (WhatToOpen = OpenCustom) and (ImportCustomDepth <> EightBits) then begin
						if not Import16BitFile(name, RefNum) then
							exit(ImportAllFiles);
					end
				else begin
						if not OpenFile(name, RefNum) then
							exit(ImportAllFiles);
					end;
				if CommandPeriod or (nPics>=MaxPics) then begin
						beep;
						exit(ImportAllFiles);
					end;
			end; {while}
	end;


	procedure EditImportParameters;
		const
			WidthID = 2;
			HeightID = 3;
			OffsetID = 4;
			SlicesID = 5;
			FixedID = 6;
			MinID = 7;
			MaxID = 8;
		var
			mylog: DialogPtr;
			item, fwidth: integer;
	begin
		mylog := GetNewDialog(110, nil, pointer(-1));
		SetDNum(MyLog, WidthID, ImportCustomWidth);
		SelectdialogItemText(MyLog, WidthID, 0, 32767);
		SetDNum(MyLog, HeightID, ImportCustomHeight);
		SetDNum(MyLog, SlicesID, ImportCustomSlices);
		SetDNum(MyLog, OffsetID, ImportCustomOffset);
		SetDlogItem(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 = SlicesID then begin
					ImportCustomSlices := GetDNum(MyLog, SlicesID);
					if ImportCustomSlices < 0 then begin
							ImportCustomSlices := 1;
							SetDNum(MyLog, SlicesID, ImportCustomSlices);
						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;
					SetDlogItem(mylog, FixedID, ord(not ImportAutoScale));
				end;
			if item = MinID then begin
					ImportMin := GetDReal(MyLog, MinID);
					ImportAutoScale := false;
					SetDlogItem(MyLog, FixedID, 1);
				end;
			if item = MaxID then begin
					ImportMax := GetDReal(MyLog, MaxID);
					ImportAutoScale := false;
					SetDlogItem(MyLog, FixedID, 1);
				end;
		until item = ok;
		DisposeDialog(mylog);
	end;


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

		var
			i: integer;

		procedure SetRadioButtons1;
			var
				i: integer;
		begin
			SetDlogItem(mylog, TiffID, 0);
			SetDlogItem(mylog, DicomID, 0);	
			SetDlogItem(mylog, LutID, 0);
			SetDlogItem(mylog, TextID, 0);
			SetDlogItem(mylog, CustomID, 0);
			case WhatToImport of
				ImportTiff: 
					SetDlogItem(mylog, TiffID, 1);
			    ImportDicom: 
					SetDlogItem(mylog, DicomID, 1);
				ImportLUT: 
					SetDlogItem(mylog, LutID, 1);
				ImportText: 
					SetDlogItem(mylog, TextID, 1);
				ImportCustom: 
					SetDlogItem(mylog, CustomID, 1);
			end;
		end;

		procedure SetRadioButtons2;
			var
				i: integer;
		begin
			SetDlogItem(mylog, EightBitsID, 0);
			SetDlogItem(mylog, SixteenBitsUnsignedID, 0);
			SetDlogItem(mylog, SixteenBitsSignedID, 0);
			case ImportCustomDepth of
				EightBits: 
					SetDlogItem(mylog, EightBitsID, 1);
				SixteenBitsUnsigned: 
					SetDlogItem(mylog, SixteenBitsUnsignedID, 1);
				SixteenBitsSigned: 
					SetDlogItem(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;
				SetDlogItem(mylog, SwapBytesID, ord(ImportSwapBytes));
				SetDlogItem(mylog, ImportAllID, ord(ImportAll));
				SetDlogItem(mylog, InvertID, ord(ImportInvert));
				SetDlogItem(mylog, CalibrateID, ord(ImportCalibrate));
			end;
		if (item >= TiffID) and (item <= CustomID) then begin
				case item of
					TiffID: 
						WhatToImport := ImportTiff;
					DicomID: 
						WhatToImport := ImportDicom;	
					LutID: 
						WhatToImport := ImportLUT;
					TextID: 
						WhatToImport := ImportText;
					CustomID: 
						WhatToImport := ImportCustom;
				end;
				SetRadioButtons1;
			end;
		if item = EditID then begin
				EditImportParameters;
				WhatToImport := ImportCustom;
				SetRadioButtons1;
				ShowParameters;
				SetDlogItem(mylog, CalibrateID, ord(ImportCalibrate));
			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;
				SetDlogItem(mylog, SwapBytesID, ord(ImportSwapBytes));
				WhatToImport := ImportCustom;
				SetRadioButtons1;
			end;
		if item = ImportAllID then begin
				ImportAll := not ImportAll;
				SetDlogItem(mylog, ImportAllID, ord(ImportAll));
			end;
		if item = InvertID then begin
				ImportInvert := not ImportInvert;
				SetDlogItem(mylog, InvertID, ord(ImportInvert));
			end;
		if item = CalibrateID then begin
				ImportCalibrate := not ImportCalibrate;
				SetDlogItem(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, ImportingTIFF, HasColorMap: boolean;
	begin
		if ImportDHookProc=nil
			then ImportDHookProc:=NewRoutineDescriptor(@ImportDialogHook, uppDlgHookProcInfo, GetCurrentISA);
		ImportFile := true;
		DisableDensitySlice;
		if not macro then begin
			ImportAll := false;
			if WhatToImport=ImportMCID then
				WhatToImport:=ImportTIFF;
		end;
		if FileName = '' then begin
				where.v := 50;
				where.h := 50;
				SFPGetFile(Where, '', nil, -1, @typeList, ImportDHookProc, 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;
		if isTiffFile(FileName, RefNum) and not macro and not OptionKeyWasDown then
			WhatToImport := ImportTiff;
		ImportingTIFF := WhatToImport = ImportTiff;
		if ImportingTIFF then
			if not GetTIFFParameters(FileName, RefNum, HasColorMap) then
				exit(ImportFile);
		case WhatToImport of
			ImportMCID: 
				WhatToOpen := OpenImported;
			ImportCustom:  begin
					if (ImportCustomDepth <> EightBits) and (ImportCustomWidth > MaxLine) then begin
							PutError(concat('Maximum width of imported 16-bit images is ', long2str(MaxLine), '.'));
							exit(ImportFile);
						end;
					WhatToOpen := OpenCustom;
				end;
			ImportDicom: 
			   begin	
					ImportDicomImages(FileName, RefNum, ImportAll, Import16BitFile);
					exit(ImportFile);
			   end
			ImportLUT:  begin
					DoImportLut(FileName, RefNum);
					exit(ImportFile);
				end;
			ImportText:  begin
					ImportFile := ImportTextFile(FileName, RefNum);
					exit(ImportFile);
				end;
			otherwise;
		end;
		if ImportAll then
			ImportAllFiles(RefNum)
		else if (WhatToOpen = OpenCustom) and (ImportCustomDepth <> EightBits) then
			b := Import16BitFile(FileName, RefNum)
		else
			b := OpenFile(FileName, RefNum);
		if macro then
			GenerateValues;
		if ImportingTIFF then
			WhatToImport := ImportTiff; {GetTIFFParameters may have changed it to ImportCustom.}
	end;


	procedure RevertToSaved;
		var
			fname: str255;
			err, f: integer;
			ok: boolean;
			size: LongInt;
	begin
		if OpPending then
			KillRoi;
		DisableDensitySlice;
		with Info^ do begin
				fname := title;
				SetPort(wptr);
				if PictureType = PICTFile then begin
						ok := OpenPICT(fname, vref, true);
						UpdatePicWindow;
					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);
								size := ImageSize;
								CheckFileSize(f, size, ImageDataOffset);
								if size > 0 then
									err := fsread(f, size, PicBaseAddr);
								if odd(PixelsPerLine) then
									UnpackLines;
								if Info^.InvertedImage then
									InvertPic;
								UpdatePicWindow;
							end;
						err := fsclose(f);
						RoiShowing := false;
					end;
				OpPending := false;
				Changes := false;
				UpdateTitleBar;
			end; {with}
	end;


	procedure FindWhatToPrint;
		var
			kind: integer;
			WhichWindow: WindowPtr;
	begin
		WhatToPrint := NothingToPrint;
		WhichWindow := FrontWindow;
		if WhichWindow = nil then
			exit(FindWhatToPrint);
		kind := WindowPeek(WhichWindow)^.WindowKind;
		if (kind = PicKind) and info^.RoiShowing and measuring then
			kind := InfoKind;
		case kind of
			PicKind: 
				if info^.RoiShowing then
					WhatToPrint := PrintSelection
				else
					WhatToPRint := PrintImage;
			HistoKind: 
				WhatToPrint := PrintHistogram;
			ProfilePlotKind, CalibrationPlotKind: 
				WhatToPrint := PrintPlot;
			InfoKind, ResultsKind: 
				if mCount > 0 then
					WhatToPrint := PrintMeasurements;
			TextKind: 
				WhatToPrint := PrintText;
			otherwise
				;
		end;
		if (WhatToPrint = NothingToPRint) and (info <> NoInfo) then
			WhatToPrint := PrintImage;
	end;


	procedure UpdateFileMenu;
		var
			ShowItems, isSelection, notStack: boolean;
			i: integer;
			str, str2: str255;
	begin
		with info^ do begin
				ShowItems := Info <> NoInfo;
				isSelection := RoiShowing and (RoiType = RectRoi);
				notStack := StackInfo = nil;
				if OptionKeyWasDown and (CurrentKind <> TextKind) then begin
						SetMenuItemText(FileMenuH, CloseItem, 'Close AllÉ');
						SetMenuItemText(FileMenuH, SaveItem, 'Save All');
						SetMenuItem(FileMenuH, CloseItem, ShowItems);
					end
				else begin
						SetMenuItemText(FileMenuH, CloseItem, 'CloseÉ');
						if isSelection and notStack and (CurrentKind <> TextKind) and (PictureType <> TiffFile) and (PictureType <> PictFile) and (CurrentKind = PicKind) then
							SetMenuItemText(FileMenuH, SaveItem, 'Save Selection')
						else
							SetMenuItemText(FileMenuH, SaveItem, 'Save');
						SetMenuItem(FileMenuH, CloseItem, ShowItems or (CurrentKind = TextKind) or (CurrentKind = ResultsKind) or (CurrentKind = ProfilePlotKind) or (CurrentKind = CalibrationPlotKind) or (CurrentKind = HistoKind));
					end;
				case CurrentKind of
					ProfilePlotKind, CalibrationPlotKind: 
						ExportAsWhat := asPlotValues;
					HistoKind: 
						ExportAsWhat := asHistogramValues;
					ResultsKind: 
						ExportAsWhat := asMeasurements;
					PicKind:  begin
							if (SaveAsWhat <> asPICT) then
								SaveAsWhat := asTiff;
							if (ExportAsWhat > asText) then
								ExportAsWhat := asRaw;
						end;
					otherwise
				end;
				if isSelection and notStack and (SaveAsWhat <> AsPalette) and (CurrentKind <> ResultsKind) and (CurrentKind <> TextKind) then
					SetMenuItemText(FileMenuH, SaveAsItem, 'Save Selection AsÉ')
				else
					SetMenuItemText(FileMenuH, SaveAsItem, 'Save AsÉ');
				if isSelection and notStack and (ExportAsWhat <= AsText) then
					SetMenuItemText(FileMenuH, ExportItem, 'Export Selection AsÉ')
				else
					SetMenuItemText(FileMenuH, ExportItem, 'ExportÉ');
				for i := SaveItem to SaveAsItem do
					SetMenuItem(FileMenuH, i, ShowItems or (CurrentKind = TextKind));
				SetMenuItem(FileMenuH, ExportItem, (ShowItems or (CurrentKind = ResultsKind)) and (CurrentKind <> TextKind));
				if isSelection then
					str := 'Duplicate Selection'
				else
					str := 'Duplicate';
				SetMenuItemText(FileMenuH, DuplicateItem, str);
				for i := DuplicateItem to GetInfoItem do
					SetMenuItem(FileMenuH, i, ShowItems and (CurrentKind <> TextKind));
				if DataType <> EightBits then
					str := 'Rescale'
				else
					str := 'Revert to Saved';
				SetMenuItemText(FileMenuH, RevertItem, str);
				SetMenuItem(FileMenuH, RevertItem, (Revertable or (DataType <> EightBits)) and (CurrentKind <> TextKind));
				SetMenuItem(FileMenuH, PlugInExportItem, ShowItems);
				FindWhatToPrint;
				case WhatToPrint of
					NothingToPrint: 
						str := '';
					PrintImage: 
						str := 'Image';
					PrintSelection: 
						str := 'Selection';
					PrintPlot: 
						str := 'Plot';
					PrintHistogram: 
						str := 'Histogram';
					PrintMeasurements: 
						str := 'Results';
					PrintText: 
						str := 'Text';
				end;
				SetMenuItemText(FileMenuH, PrintItem, concat('Print ', str, 'É'));
				SetMenuItem(FileMenuH, PrintItem, WhatToPrint <> NothingToPrint);
			end; {with info^}
	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;


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


	function ExportHook (item: integer; theDialog: DialogPtr): integer;
		const
			EditTextID = 7;
			RawID = 9;
			xyCoordinatesID = 16;
		var
			i: integer;
			fname: str255;
			NameEdited: boolean;
	begin
		if item = -1 then {Initialize}
			SetDlogItem(theDialog, RawID + ord(ExportAsWhat), 1);
		fname := GetDString(theDialog, EditTextID);
		NameEdited := fname <> SuggestedExportName;
		if (item >= RawID) and (item <= xyCoordinatesID) then begin
				ExportAsWhat := ExportAsWhatType(item - RawID);
				if not NameEdited then begin
						SetDString(theDialog, EditTextID, SuggestedExportName);
						SelectdialogItemText(theDialog, EditTextID, 0, 32767);
					end;
				for i := RawID to xyCoordinatesID do
					SetDlogItem(theDialog, i, 0);
				SetDlogItem(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
		if ExportDHookProc=nil
			then ExportDHookProc:=NewRoutineDescriptor(@ExportHook, uppDlgHookProcInfo, GetCurrentISA);
		with info^ do begin
				if (name = '') or ((RefNum = 0) and (pos(':', name) = 0)) then begin
						where.v := 50;
						where.h := 50;
						if name = '' then
							name := SuggestedExportName;
						SFPPutFile(Where, 'Save as?', name, ExportDHookProc, reply, CustomDialogID, nil);
						if not reply.good then begin
								AbortMacro;
								exit(Export);
							end;
						with reply do begin
								name := fname;
								RefNum := vRefNum;
								DefaultRefNum := RefNum;
							end;
					end;
				if (Info = NoInfo) and (ExportAsWhat <= asText) then begin
					PutError('No image data available.');
					AbortMacro;
					exit(Export);
				end;
				isSelection := RoiShowing and (RoiType = RectRoi);
				case ExportAsWhat of
					asRaw, asMCID:  begin
							if ExportAsWhat = asMCID then
								InvertPic;
							SaveAsState := SaveAsWhat;
							if ExportAsWhat = AsRaw then
								SaveAsWhat := asRawData
							else
								SaveAsWhat := SaveAsMCID;
							if isSelection then
								SaveSelection(name, RefNum, false)
							else
								SaveAsTIFF(name, RefNum, 0, 0, false);
							SaveAsWhat := SaveAsState;
						end;
					AsText: 
						ExportAsText(name, RefNum);
					AsLUT: 
						SaveLUT(name, RefNum);
					asMeasurements: 
						if mCount > 0 then
							ExportMeasurements(name, RefNum)
						else
							PutError('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;
					asCoordinates: 
						ExportCoordinates(name, RefNum);
					otherwise
						beep;
				end; {case}
				if (SaveAsWhat = asRawData) and (SaveAllState <> SaveAllStage2) then
					SaveAsWhat := asTIFF;
			end; {with}
	end;



end.