unit File2;

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

interface


	uses
		QuickDraw, OSIntf, PickerIntf, PrintTraps, ToolIntf, 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 (reply: SFReply);
	procedure GetUnits (id: 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 osRoiRect do begin
						iwidth := right - left;
						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 (OptionKeyWasDown: boolean; PageWidth, PageHeight: integer);
		var
			PrintRect: rect;
			Width, Height: integer;
	begin
		if isLaserWriter and (not OptionKeyDown) and (not OptionKeyWasDown) 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 osroiRect 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)^^, osroiRect, PrintRect, SrcCopy, nil);
							hunlock(handle(CGrafPort(ThePort^).PortPixMap))
						end
					else
						CopyBits(BitMapHandle(osPort^.portPixMap)^^, thePort^.PortBits, osRoiRect, osroiRect, 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;
		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;
	end;


	procedure Print (ShowDialog: boolean);
		var
			err, i, LinesToPrint: Integer;
			tPort: GrafPtr;
			PrintPort: TPPrPort;
			PrintStatusRec: TPrStatus;
			prect: rect;
			result, OptionKeyWasDown: boolean;
	begin
		OptionKeyWasDown := OptionKeyDown;
		DrawLabels('Line:', 'Total:', '');
		if WhatToPrint = PrintImage then
			SelectAll(false);
		if (WhatToPrint = PrintImage) or (WhatToPrint = PrintSelection) then begin
				if OpPending then
					KillRoi;
				with info^.osroiRect do
					LinesToPrint := bottom - top;
				Show2Values(0, LinesToPrint);
			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;
				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(OptionKeyWasDown, prect.right, prect.bottom);
									PrintAreas, PrintLengths, PrintPoints: 
										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 = 11;
			FirstAngleID = 3;
			LastAngleID = 5;
		var
			mylog: DialogPtr;
			item, i, ignore, SaveFrequency, SaveAngle, AngleID: 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);
		OutlineButton(MyLog, ok, 16);
		if HalftoneAngle = 45 then
			AngleID := FirstAngleID
		else if HalftoneAngle = 90 then
			AngleID := FirstAngleID + 1
		else if HalftoneAngle = 0 then
			AngleID := FirstAngleID + 2;
		SetDialogItem(mylog, AngleID, 1);
		if HalftoneDotFunction then
			SetDialogItem(mylog, 7, 1)
		else
			SetDialogItem(mylog, 8, 1);
		repeat
			ModalDialog(nil, item);
			if item = FrequencyID then
				HalftoneFrequency := GetDNum(MyLog, FrequencyID);
			if (item >= FirstAngleID) and (item <= LastAngleID) then begin
					for i := FirstAngleID to LastAngleID do
						SetDialogItem(mylog, i, 0);
					SetDialogItem(mylog, item, 1);
					AngleID := item;
					case AngleID of
						3: 
							HalftoneAngle := 45;
						4: 
							HalftoneAngle := 90;
						5: 
							HalftoneAngle := 0;
					end;
				end;
			if (item >= 7) and (item <= 8) then begin
					for i := 7 to 8 do
						SetDialogItem(mylog, i, 0);
					SetDialogItem(mylog, item, 1);
					HalftoneDotFunction := item = 7;
				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;

		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);
		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(PicSize 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 osroirect 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;
		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 PicSize > UndoBufSize then
					PutWarning;
			end;
		OpenMacPaint := true;
	end;


	procedure TypeMismatch (fname: str255);
		var
			ignore: integer;
	begin
		ParamText('The file "', fname, '" is a different type, and therefore cannot be replaced', '');
		InitCursor;
		ignore := Alert(MessageID, nil);
	end;


	procedure SaveAsMacPaint (reply: SFReply);
		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(reply.fname, reply.vRefNum, TheInfo);
		case err of
			NoErr: 
				with TheInfo do begin
						if fdType <> 'PNTG' then begin
								TypeMismatch(reply.fname);
								exit(SaveAsMacPaint)
							end;
					end;
			FNFerr: 
				begin
					err := create(reply.fname, reply.vRefNum, '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 := osroiRect
				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(reply.fname, reply.vRefNum, 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;


end.