unit File1;

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

interface


	uses
		Types, Memory, QuickDraw, QuickDrawText, Packages, Menus, Events, Fonts, 
		Scrap, ToolUtils, Resources, Errors, Palettes, StandardFile, Windows,
		Controls, TextEdit, Files, Dialogs, TextUtils, Finder, MixedMode, SegLoad,
		globals, Utilities, Graphics, file2, Dicom, sound, Lut, Text, Processes;

	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));
						IndexToRgbForeColor(BlackIndex);
						IndexToRgbBackColor(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;
						IndexToRgbForeColor(ForegroundIndex);
						IndexToRgbBackColor(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, FourCharCode(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.';
		type
			PicHArray = array[1..MaxSlices] of PicHandle;
			PicHArrayPtr = ^PicHArray;
		var
			err: OSErr;
			TheInfo: FInfo;
			replacing: boolean;
			rRefNum, i, SaveCS: integer;
			frect: rect;
			{PicH: array[1..MaxSlices] of PicHandle;}
			PicH: PicHArrayPtr;
			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;
				PicH := PicHArrayPtr(NewPtr(SizeOf(PicHArray)));
				if PicH = nil then
					exit(SaveAsPICS);
				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);
				IndexToRgbForeColor(BlackIndex);
				IndexToRgbBackColor(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}
				IndexToRgbForeColor(ForegroundIndex);
				IndexToRgbBackColor(BackgroundIndex);
				SetGDevice(SaveGDevice);
				CurrentSlice := SaveCS;
				SelectSlice(CurrentSlice);
				RemovePath(fname);
				TruncateString(fname, maxTitle);
				title := fname;
				PictureType := PicsFile;
				UpdateTitleBar;
				CloseResFile(rRefNum);
				if ResError = NoErr then
					changes := false
				else
					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, asQuickTime, 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) 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 = asQuickTime)  or (SaveAsWhat = asPICS) or (SaveAsWhat = asPalette) or (SaveAsWhat = asOutline)) then begin
								PutError('Stacks can only be saved in TIFF, QuickTime 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);
					asQuickTime: 
						SaveAsQuickTime(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
							KillRoi;
							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 (PictureType = FrameGrabberType) and (FrameGrabber = QTvdig) then
								CloseVdig;
							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);
							if DataH <> nil then
									DisposeHandle(DataH);
							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: TiffIFDTablePtr);
		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: TiffIFDTablePtr;
			i, nExtraImages: integer;
			where: LongInt;
	begin
		table := TiffIFDTablePtr(NewPtr(SizeOf(TiffIFDTable)));
		if table = nil then
			exit(OpenStack);
		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;
		DisposePtr(Pointer(table));
	end;


	procedure OpenExtraTiffImages (f: integer; NextTiffIFD: LongInt);
		var
			table: TiffIFDTablePtr;
			TiffInfo: TiffInfoRec;
			i, nExtraImages: integer;
			AllSameSize: boolean;
	begin
		table := TiffIFDTablePtr(NewPtr(SizeOf(TiffIFDTable)));
		if table = nil then
			exit(OpenExtraTiffImages);
		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;
		DisposePtr(Pointer(table));
	end;

	procedure OpenPlanarRGBTiff(f: integer);
	var
		row, ignore, SaveRow: integer;
		NextUpdate, count: LongInt;
		rLine, gLine, bLine: LineType;
		err: OSErr;
		MaskRect: rect;
	begin
		with info^ do begin
			err := SetFPos(f, fsFromStart, ImageDataOffset);
			SelectSlice(1);
			for row:=0 to nLines - 1 do begin
				count := PixelsPerLine;
				err := fsread(f, count, @rLine);
				PutLine(0, row, PixelsPerLine, rLine);
			end;
			InvertPic;
			ResetGrayMap;
			UpdatePicWindow; 
			SelectSlice(2);
			for row:=0 to nLines - 1 do begin
				count := PixelsPerLine;
				err := fsread(f, count, @gLine);
				PutLine(0, row, PixelsPerLine, gLine);
			end; 
			InvertPic;
			UpdatePicWindow; 
			SelectSlice(3);
			for row:=0 to nLines - 1 do begin
				count := PixelsPerLine;
				err := fsread(f, count, @bLine);
				PutLine(0, row, PixelsPerLine, bLine);
			end; 
			InvertPic;
			UpdatePicWindow; 
			with StackInfo^ do begin
				CurrentSlice := 1;
				SelectSlice(CurrentSlice);
				StackType := rgbStack;
			end;
			UpdateTitleBar;
			OpeningRGB := true;
		end; {with}
	end;


	procedure OpenRGBTiff(f: integer; TiffInfo: TiffInfoRec);
	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;
			if TiffInfo.PlanarConfig <> 1 then begin
				OpenPlanarRGBTiff(f);
				exit(OpenRGBTiff);
			end;
			if ScreenDepth <> 8 then begin
				SelectAll(false);
				DoOperation(EraseOp);
				changes:= false;
				KillRoi;
			end;
			ResetGrayMap;
			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;
			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, TiffInfo)
			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;
					end;
				DisposePtr(ptr(PixelLUT));
				if DataH <> nil then begin
						DisposeHandle(DataH);
						DataH := nil
					end;
				UpdateTitleBar;
			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);
				if ImportCalibrate and  ImportAutoScale then begin
					RemoveDensityCalibration;
					ImportCalibrate := false;
				end;
				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);
						if ScreenDepth <> 8 then begin
							SelectAll(false);
							DoOperation(EraseOp);
							changes:= false;
							KillRoi;
						end;
					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));
				IndexToRgbForeColor(BlackIndex);
				IndexToRgbBackColor(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);
				IndexToRgbForeColor(ForegroundIndex);
				IndexToRgbBackColor(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));
				IndexToRgbBackColor(WhiteIndex);
				EraseRect(PicRect);
				DrawPicture(picH, PicRect);
				ReleaseResource(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
									ReleaseResource(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);
						ReleaseResource(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..11] of OSType;
			FileType: OSType;
			OKToContinue: boolean;
			FinderInfo: FInfo;
			err: OSErr;
			mySpec:FSSpec;
	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';
				typeList[11] := 'MooV';
				SFPGetFile(Where, '', nil, 12, @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 if FileType = 'MooV' then
					b := OpenQuickTime(FileName, RefNum, UseExistingLUT)
				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;
					if ImportCustomSlices > MaxSlices then begin
							ImportCustomSlices := MaxSlices;
							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, ImportFile);
					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 CheckRoiBounds;
	begin
		with info^, info^.RoiRect do
			if (left < 0) or (top < 0) or (right > PicRect.right) or (bottom > PicRect.bottom) then
				KillRoi;
	end;
	
	
	procedure UpdateFileMenu;
		var
			ShowItems, isSelection, notStack: boolean;
			i: integer;
			str, str2: str255;
	begin
		with info^ do begin
				ShowItems := Info <> NoInfo;
				CheckRoiBounds;
				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;
				CheckRoiBounds;
				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.