unit File2;

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

interface


	uses
		QuickDraw, Palettes, PrintTraps, globals, Utilities, Graphics;


	procedure GetInfo;
	procedure DoPageSetup;
	procedure Print (ShowDialog: boolean);
	procedure SetHalftone;
	function OpenMacPaint (fname: str255; vnum: integer): boolean;
	procedure TypeMismatch (fname: str255);
	procedure SaveAsMacPaint (fname: str255; RefNum: integer);
	procedure GetUnits (id: integer);
	function OpenTextFile (var name: str255; var RefNum: integer): boolean;
	procedure InitTextInput (name: str255; RefNum: integer);
	procedure GetLineFromText (var rLine: rLineType; var count: integer);
	function ImportTextFile (name: str255; RefNum: integer): boolean;
	procedure PlotXYZ;
	procedure SaveSettings;
	procedure ExportAsText (fname: str255; RefNum: integer);
	procedure ExportLUT (fname: str255; RefNum: integer);
	procedure ExportMeasurements (fname: str255; RefNum: integer);


implementation


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


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


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

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

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


	procedure PrintPicture (PageWidth, PageHeight: integer);
		var
			PrintRect: rect;
			Width, Height: integer;
	begin
		if isLaserWriter and (not OptionKeyDown) and (not OptionKeyWasDown) and (not UsingLaserWriter6) then
			PrintHalftone
		else
			with info^ do begin
					LoadLUT(cTable);
					hlock(handle(osPort^.portPixMap));
					if BitAnd(thePort^.portBits.rowBytes, $8000) = $8000 then begin
        {Assume driver understands Color QD}
							with RoiRect do begin
									width := right - left;
									height := bottom - top;
								end;
							with PrintRect do begin
									left := 0;
									top := 0;
									if width < PageWidth then
										left := (PageWidth - width) div 2;
									if height < PageHeight then
										top := (Pageheight - height) div 2;
									right := left + width;
									bottom := top + height;
								end;
							hlock(handle(CGrafPort(ThePort^).PortPixMap));
							CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPort(ThePort^).PortPixMap)^^, RoiRect, PrintRect, SrcCopy, nil);
							hunlock(handle(CGrafPort(ThePort^).PortPixMap))
						end
					else
						CopyBits(BitMapHandle(osPort^.portPixMap)^^, thePort^.PortBits, RoiRect, RoiRect, SrcCopy, nil);
					hunlock(handle(osPort^.portPixMap));
				end;
	end;


	procedure PrintResults (PageHeight: integer; var PrintPort: TPPrPort);
		const
			LinesPerPage = 59;
			MaxLine = 100;
		var
			LineInc, hloc, vloc, i, LineCount, CharCount: integer;
			aLine: str255;
	begin
		CopyResultsToBuffer(1, mCount, true);
		ClipTextInBuffer := false;
		LineInc := PageHeight div LinesPerPage;
		hloc := 0;
		vloc := LineInc;
		LineCount := 0;
		CharCount := 0;
		TextFont(Monaco);
		TextSize(9);
		i := 1;
		repeat
			while TextBufP^[i] >= ' ' do begin
					CharCount := CharCount + 1;
					aLine[CharCount] := TextBufP^[i];
					i := i + 1;
				end;
			aLine[0] := chr(CharCount);
			MoveTo(hloc, vloc);
			DrawString(aLine);
			CharCount := 0;
			if TextBufP^[i] = cr then begin
					vLoc := vLoc + LineInc;
					hloc := 0;
					LineCount := LineCount + 1;
					if LineCount >= LinesPerPage then begin
							LineCount := 0;
							if i < TextBufSize then begin
									PrClosePage(PrintPort);
									PrintErrCheck;
									PrOpenPage(PrintPort, nil);
									vloc := LineInc
								end;
						end;
				end;
			i := i + 1;
		until i > TextBufSize;
		UnsavedResults := false;
	end;


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


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

	procedure GetFileInfo (name: str255; vnum: integer; var DateCreated, LastModified: str255);
		var
			FileParmBlock: ParmBlkPtr;
			theErr: OSErr;
			DateVar, TimeVar: str255;
			Secs: LongInt;
	begin
		DateCreated := '';
		new(FIleParmBlock);
		if FileParmBlock <> nil then
			with FileParmBlock^ do begin
					ioCompletion := nil;
					ioNamePtr := @name;
					ioVRefNum := vnum;
					ioFVersNum := 0;
					ioFDirIndex := 0;
					theErr := PBGetFInfo(FileParmBlock, false);
					if theErr = NoErr then begin
							Secs := ioFlCrDat;
							IUDateString(Secs, abbrevDate, DateVar);
							IUTimeString(Secs, true, TimeVar);
							DateCreated := concat(DateVar, '  ', TimeVar);
							Secs := ioFlMDDat;
							IUDateString(Secs, abbrevDate, DateVar);
							IUTimeString(Secs, true, TimeVar);
							LastModified := concat(DateVar, '  ', TimeVar);
						end;
					Dispose(FileParmBlock);
				end;
	end;


	procedure GetVolumnInfo (vnum: integer; var VolumnName: str255; var FreeSpace: LongInt);
		var
			theErr: OSErr;
			SPtr: StringPtr;
			VolParmBlock: ParmBlkPtr;
	begin
		VolumnName := '';
		new(SPtr);
		new(VolParmBlock);
		if (SPtr <> nil) and (VolParmBlock <> nil) then
			with VolParmBlock^ do begin
					SPtr^ := '';
					ioVRefNum := vnum;
					ioNamePtr := SPtr;
					ioCompletion := nil;
					ioVolIndex := -1;
					theErr := PBGetVInfo(VolParmBlock, false);
					VolumnName := ioNamePtr^;
					FreeSpace := ioVAlBlkSiz * ioVFrBlk;
					dispose(SPtr);
					dispose(VolParmBlock);
				end;
	end;


	procedure GetInfo;
		const
			InfoWindowWidth = 260;
			InfoWindowHeight = 300;
		var
			name, str, DateCreated, LastModified, VolumnName: str255;
			hloc, vloc: integer;
			tPort: GrafPtr;
			SaveRoiShowing: boolean;
			FreeSpace: LongInt;
			SaveForeIndex, SaveBackIndex: integer;
			SaveInfo: InfoPtr;


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

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

	begin
		name := concat('Info About ', info^.title);
		SaveRoiShowing := info^.RoiShowing;
		SaveForeIndex := ForegroundIndex;
		SaveBackIndex := BackgroundIndex;
		SetForegroundColor(BlackIndex);
		SetBackgroundColor(WhiteIndex);
		SaveInfo := info;
		if NewPicWindow(name, InfoWindowWidth, InfoWindowHeight) then
			with SaveInfo^ do begin
					hloc := 15;
					vloc := 10;
					GetPort(tPort);
					SetPort(GrafPtr(info^.osPort));
					TextFont(ApplFont);
					TextSize(9);
					NewLine;
					DrawBString('Name: ');
					DrawString(title);
					NewParagraph;
					DrawBString('Width: ');
					DrawDimension(PixelsPerLine);
					NewLine;
					DrawBString('Height: ');
					DrawDimension(nlines);
					NewLine;
					DrawBString('Size: ');
					DrawLong(ImageSize div 1024);
					DrawString('K');
					NewParagraph;
					GetFileInfo(title, vref, DateCreated, LastModified); {DateCreated:='';}
					if DateCreated <> '' then begin
							DrawBString('Creation Date: ');
							DrawString(DateCreated);
							NewLine;
							DrawBString('Last Modified: ');
							DrawString(LastModified);
							NewLine;
						end;
					GetVolumnInfo(vref, VolumnName, FreeSpace);
					if VolumnName <> '' then begin
							DrawBString('Volume: ');
							DrawString(VolumnName);
							DrawString(' (');
							DrawLong(FreeSpace div 1024);
							DrawString('K free)');
							NewParagraph;
						end;
					DrawBString('Type: ');
					case PictureType of
						pdp11: 
							str := 'PDP-11';
						NewPicture: 
							str := 'New';
						normal: 
							str := 'Normal';
						PictFile: 
							str := 'PICT';
						TiffFile: 
							str := 'TIFF';
						InvertedTIFF: 
							str := 'TIFF';
						Leftover: 
							str := 'Left Over';
						imported: 
							str := 'Imported';
						QuickCaptureType: 
							str := 'Camera(QuickCapture)';
						BlankField: 
							str := 'Blank Field';
						ScionType: 
							str := 'Camera(Scion)';
						otherwise
							;
					end;
					if BinaryPic then
						str := concat(str, ' (Binary)');
					DrawString(str);
					NewLine;
					DrawBString('Lookup Table: ');
					case LutMode of
						PseudoColor32: 
							str := 'Pseudocolor';
						AppleDefault: 
							str := 'System';
						Spectrum: 
							str := 'Spectrum';
						GrayScale: 
							str := 'Grayscale';
						Custom: 
							str := 'Custom';
						CustomGrayscale: 
							str := 'Custom Grayscale';
						otherwise
					end;
					DrawString(str);
					NewLine;
					DrawBString('Magnification: ');
					if ScaleToFitWindow then begin
							DrawReal(magnification, 1, 2);
							DrawString(' (Scale to Window Mode)')
						end
					else begin
							DrawReal(magnification, 1, 0);
							DrawString(':1')
						end;
					NewLine;
					DrawBString('Scale: ');
					if SpatialScale <> 0.0 then begin
							DrawReal(SpatialScale, 1, 3);
							DrawString(' Pixels Per ');
							DrawString(FullUnits)
						end
					else
						DrawString('None');
					if calibrated then begin
							NewLine;
							DrawBString('Unit of Measure:');
							if UnitOfMEasure = '' then
								DrawString('None')
							else
								DrawString(UnitOfMeasure)
						end;
					NewParagraph;
					DrawBString('Free RAM: ');
					DrawLong(FreeMem div 1024);
					DrawString('K');
					NewLine;
					DrawBString('Largest Free Block: ');
					DrawLong(MaxBlock div 1024);
					DrawString('K');
					NewParagraph;
					if RoiType <> NoRoi then begin
							DrawBString('Selection Type: ');
							case RoiType of
								RgnRoi: 
									DrawString('Freehand or Polygon');
								RectRoi: 
									DrawString('Rectangle');
								OvalRoi: 
									DrawString('Oval');
								RoundRectRoi: 
									DrawString('Rounded Rectangle');
							end;
							NewLine;
							with RoiRect do begin
									DrawBString('    Left: ');
									DrawDimension(left);
									NewLine;
									DrawBString('    Top: ');
									if InvertYCoordinates then
										DrawDimension(PicRect.bottom - top - 1)
									else
										DrawDimension(top);
									NewLine;
									DrawBString('    Width: ');
									DrawDimension(right - left);
									NewLine;
									DrawBString('    Height: ');
									DrawDimension(bottom - top);
								end
						end
					else
						DrawBString('No Selection');
					SetPort(tPort);
				end;
		SetForegroundColor(SaveForeIndex);
		SetBackgroundColor(SaveBackIndex);
	end;


	function NewPtrClear (blockSize: Size): Ptr;
    {This function will return a pointer of size specified and will}
    {clear the memory to zeros . This is done to create an empty bit}
    {map containing nothing but white bits . }

    {MOVE . L  ( SP ) + , D0  ; get Size variable from stack}
    {_NewPtr , clear           ; make pointer }
    {MOVE.L  A0 , ( SP )       ; return pointer }
    {MOVE.W D0, MemErr     ; set up MemErr }
	inline
		$201F, $A31E, $2E88, $31C0, $0220;


	function IOCheck (err: OSerr): integer;
		var
			ignore: integer;
			errStr: str255;
	begin
		if err <> noErr then begin
				NumToString(err, errStr);
				ParamText('', errStr, '', '');
				InitCursor;
				ignore := alert(IOErrorID, nil);
			end;
		IOCheck := err;
	end;


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

		procedure abort;
		begin
			beep;
			if srcPtr <> nil then
				DisposPtr(srcPtr);
			if dstPtr <> nil then
				DisposPtr(dstPtr);
			exit(OpenMacPaint);
		end;

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


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


	procedure SaveAsMacPaint (fname: str255; RefNum: integer);
		const
			MaxFileSize = 53072;   { maximum MacPaint file size. }
		var
			TheInfo: FInfo;
			dstPtr, srcPtr, mpBufPtr: Ptr;
			i, f, scanLine, err, width, height: integer;
			dstBuffer: array[1..128] of LongInt;
			size, dstSize: LongInt;
			theBitMap: BitMap;
			mprect, srect, drect: rect;

		procedure abort;
		begin
			beep;
			if mpBufPtr <> nil then
				DisposPtr(mpBufPtr);
			if f <> -1 then
				err := fsclose(f);
			exit(SaveAsMacPaint);
		end;

	begin
		f := -1;
		err := GetFInfo(fname, RefNum, TheInfo);
		case err of
			NoErr: 
				with TheInfo do begin
						if fdType <> 'PNTG' then begin
								TypeMismatch(fname);
								exit(SaveAsMacPaint)
							end;
					end;
			FNFerr: 
				begin
					err := create(fname, RefNum, 'MPNT', 'PNTG');
					if IOCheck(err) <> 0 then
						exit(SaveAsMacPaint);
				end;
			otherwise
				if IOCheck(err) <> 0 then
					exit(SaveAsMacPaint);
		end;
		mpBufPtr := NewPtrClear(MaxFileSize);
		if mpBufPtr = nil then
			abort;
		ShowWatch;
		SetRect(mprect, 0, 0, 576, 720);
		with theBitMap do begin
				baseAddr := mpBufPtr;
				rowBytes := 72;
				bounds := mprect;
			end;
		with info^ do begin
				if roiShowing then
					srect := RoiRect
				else
					srect := PicRect;
				with srect do begin
						width := right - left;
						height := bottom - top;
						if width > 576 then
							width := 576;
						if height > 720 then
							height := 720;
						right := left + width;
						bottom := top + height;
					end;
				SetRect(drect, 0, 0, width, height);
				hlock(handle(osPort^.portPixMap));
				CopyBits(BitMapHandle(osPort^.PortPixMap)^^, theBitMap, srect, drect, srcCopy, nil);
				hunlock(handle(osPort^.PortPixMap));
			end;
		err := fsOpen(fname, RefNum, f);
		if IOCheck(err) <> noErr then
			abort;
		for I := 1 to 128 do
			dstBuffer[I] := 0;
		Size := 512;
		err := FSWrite(f, Size, @dstBuffer);
		if IOCheck(err) <> noErr then
			abort;
		srcPtr := theBitMap.baseAddr;
		for scanLine := 1 to 720 do begin
				dstPtr := @dstBuffer; { reset the pointer to bottom }
				PackBits(srcPtr, dstPtr, 72); { bumps both ptrs}
				dstSize := ord(dstPtr) - ord(@dstBuffer);{calc packed size}
				err := fsWrite(f, dstSize, @dstBuffer);
				if IOCheck(err) <> noErr then
					abort;
			end;
		err := fsclose(f);
		DisposPtr(mpBufPtr);
		info^.changes := false;
	end;


	procedure GetUnits (id: integer);
	begin
		with info^ do
			case id of
				5: 
					begin
						UnitsID := Nanometers;
						FullUnits := 'Nanometer';
						UnitsPerCm := 10000000.0;
						units := 'nm';
					end;
				6: 
					begin
						UnitsID := Micrometers;
						FullUnits := 'Micrometer';
						UnitsPerCm := 10000.0;
						units := 'µm';
					end;
				7: 
					begin
						UnitsID := Millimeters;
						FullUnits := 'Millimeter';
						UnitsPerCm := 10.0;
						units := 'mm';
					end;
				8: 
					begin
						UnitsID := Centimeters;
						FullUnits := 'Centimeter';
						UnitsPerCm := 1.0;
						units := 'cm';
					end;
				9: 
					begin
						UnitsID := Meters;
						FullUnits := 'Meter';
						UnitsPerCm := 0.01;
						units := 'm ';
					end;
				10: 
					begin
						UnitsID := Kilometers;
						FullUnits := 'Kilometer';
						UnitsPerCm := 0.00001;
						units := 'km';
					end;
				11: 
					begin
						UnitsID := Inches;
						FullUnits := 'Inch';
						UnitsPerCm := 0.3937;
						units := 'in';
					end;
				12: 
					begin
						UnitsID := feet;
						FullUnits := 'foot';
						UnitsPerCm := 0.0328083;
						units := 'ft';
					end;
				13: 
					begin
						UnitsID := Miles;
						FullUnits := 'Mile';
						UnitsPerCm := 0.000006213;
						units := 'mi';
					end;
				otherwise
					begin
						UnitsID := Pixels;
						FullUnits := 'Pixel';
						UnitsPerCm := 0.0;
						units := '  ';
						RawSpatialScale := 0.0;
						ScaleMagnification := 1.0;
						SpatialScale := 0.0;
					end
			end; {case}
	end;


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


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


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


	function GetNumber: real;
		var
			c: char;
			str: str255;
	begin
		repeat
			c := GetByte;
			if c = tab then begin
					GetNumber := 0.0;
					exit(GetNumber);
				end;
			if (c = cr) or (c = eof) then begin
					TextEol := true;
					TextEof := c = eof;
					GetNumber := NoValue;
					exit(GetNumber);
				end;
		until c in ['0'..'9', '-', '.'];
		Str := '';
		while c in ['0'..'9', '-', '.'] do begin
				Str := concat(str, c);
				c := GetByte;
				if (c = cr) or (c = eof) then begin
						TextEol := true;
						TextEof := c = eof;
					end;
			end;
		GetNumber := StringToReal(str);
	end;


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


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


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

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


	function GetWDInfo (wdRefNum: integer; var vRefNum: integer; var DirID, ProcID: LongInt): OSErr;
{Converts a working directory reference number into a volume reference number and directory ID. See TN 218.}
		var
			theWD: WDPBRec;
			err: OSErr;
	begin
		with theWD do begin
				ioVRefNum := wdRefNum;
				ioCompletion := nil;
				ioWDIndex := 0;
				ioWDProcID := 0;
				err := PBGetWDInfo(@theWD, false);
				if err = NoErr then begin
						vRefNum := ioWDVRefNum;
						DirID := ioWDDirID;
					end;
			end; {with}
		GetWDInfo := err;
	end;


	procedure SaveKernelsWorkingDir;
		var
			KernelsVRefNum, err: integer;
			KernelsDirID: LongInt;
			ProcID: LongInt;
	begin
		with settings do begin
				KernelsVRefNum := 0;
				sKernelsDirID := 0;
				if KernelsRefNum <> 0 then begin
						err := GetWDInfo(KernelsRefNum, KernelsVRefNum, KernelsDirID, ProcID);
						if err = NoErr then begin
								sKernelsVRefNum := KernelsVRefNum;
								sKernelsDirID := KernelsDirID;
							end;
					end;
				sKernelsVRefNum := KernelsVRefNum;
				sKernelsDirID := KernelsDirID;
       {ShowMessage(concat('KernelsRefNum=', long2str(KernelsRefNum), cr, 'vRefNum=', long2str(sKernelsVRefNum), cr, 'DirID=', long2str(sKernelsDirID)));}
			end; {with}
	end;


	procedure SaveDefaultWorkingDir;
		var
			DefaultVRefNum, err: integer;
			DefaultDirID: LongInt;
			ProcID: LongInt;
	begin
		with settings do begin
				DefaultVRefNum := 0;
				sDefaultDirID := 0;
				if DefaultRefNum <> 0 then begin
						err := GetWDInfo(DefaultRefNum, DefaultVRefNum, DefaultDirID, ProcID);
						if err = NoErr then begin
								sDefaultVRefNum := DefaultVRefNum;
								sDefaultDirID := DefaultDirID;
							end;
					end;
				sDefaultVRefNum := DefaultVRefNum;
				sDefaultDirID := DefaultDirID;
       {ShowMessage(concat('KernelsRefNum=', long2str(KernelsRefNum), cr, 'vRefNum=', long2str(sKernelsVRefNum), cr, 'DirID=', long2str(sKernelsDirID)));}
			end; {with}
	end;


	procedure SaveSettings;
		var
			TheInfo: FInfo;
			ByteCount: LongInt;
			f: integer;
			err: OSErr;
	begin
		with settings, info^ do begin
				sID := 'IMAG';
				sVersion := version;
				sForegroundIndex := ForegroundIndex;
				sBackgroundIndex := BackgroundIndex;
				sBrushHeight := BrushHeight;
				sBrushWidth := BrushWidth;
				sAirbrushDiameter := AirbrushDiameter;
				sLUTMode := LUTMode;
				sColorStart := ColorStart;
				sColorWidth := ColorWidth;
				sCurrentFontID := CurrentFontID;
				sCurrentStyle := CurrentStyle;
				sCurrentSize := CurrentSize;
				sTextJust := TextJust;
				sTextBack := TextBack;
				sNExtraColors := nExtraColors;
				sExtraColors := ExtraColors;
				sInvertVideo := InvertVideo;
				sMeasurements := Measurements;
				sInvertPlots := InvertPlots;
				sAutoScalePlots := AutoScalePlots;
				sLinePlot := LinePlot;
				sDrawPlotLabels := DrawPlotLabels;
				sProfilePlotMin := ProfilePlotMin;
				sProfilePlotMax := ProfilePlotMax;
				sFixedSizePlot := FixedSizePlot;
				sProfilePlotWidth := ProfilePlotWidth;
				sProfilePlotHeight := ProfilePlotHeight;
				sFramesToAverage := FramesToAverage;
				sNewPicWidth := NewPicWidth;
				sNewPicHeight := NewPicHeight;
				sBufferSize := BufferSize;
				sMaxScionWidth := MaxScionWidth;
				sThresholdToForeground := ThresholdToForeground;
				sNonThresholdToBackground := NonThresholdToBackground;
				sVideoChannel := VideoChannel;
				sWhatToImport := WhatToImport;
				sImportCustomWidth := ImportCustomWidth;
				sImportCustomHeight := ImportCustomHeight;
				sImportCustomOffset := ImportCustomOffset;
				sWandAutoMeasure := WandAutoMeasure;
				sWandAdjustAreas := WandAdjustAreas;
				sBinaryIterations := BinaryIterations;
				sScaleArithmetic := ScaleArithmetic;
				sUseZeroForBlack := UseZeroForBlack;
				sInvertYCoordinates := InvertYCoordinates;
				sFieldWidth := FieldWidth;
				sPrecision := precision;
				sMinParticleSize := MinParticleSize;
				sMaxParticleSize := MaxParticleSize;
				sIgnoreParticlesTouchingEdge := IgnoreParticlesTouchingEdge;
				sLabelParticles := LabelParticles;
				sOutlineParticles := OutlineParticles;
				sIncludeHoles := IncludeHoles;
				sShowReversingMovies := ShowReversingMovies;
				sUsingLaserWriter6 := UsingLaserWriter6;
				sMaxRegions := MaxRegions;
				sImportCustomDepth := ImportCustomDepth;
				sImportSwapBytes := ImportSwapBytes;
				sImportCalibrate := ImportCalibrate;
				sImportAutoscale := ImportAutoscale;
				sImportMin := ImportMin;
				sImportMax := ImportMax;
				sShowHeadings := ShowHeadings;
			end; {with}
		SaveKernelsWorkingDir;
		SaveDefaultWorkingDir;
		err := GetFInfo(PrefsName, SystemRefNum, TheInfo);
		if err = FNFerr then begin
				err := create(PrefsName, SystemRefNum, 'IMAG', 'PREF');
				if IOCheck(err) <> 0 then
					exit(SaveSettings);
			end;
		err := fsopen(PrefsName, SystemRefNum, f);
		if IOCheck(err) <> 0 then
			exit(SaveSettings);
		err := SetFPos(f, FSFromStart, 0);
		ByteCount := SizeOf(settings);
		err := fswrite(f, ByteCount, @settings);
		if IOCheck(err) <> 0 then begin
				err := fsclose(f);
				exit(SaveSettings)
			end;
		err := SetEof(f, ByteCount);
		err := fsclose(f);
		err := FlushVol(nil, SystemRefNum);
	end;


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


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


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


end.