unit PlugIns;
{This unit for utilizing Adobe Photoshop compatible acquisition, export and filter plug-ins}
{is based on code written by Greg Brown, Steven Gonzalo and Richard Ohlendorf.}
{Ohlendorf Research, Inc.}
{818 LaSalle Street}
{Ottawa, IL 61350}
{815-434-5622}
{Applelink--Abraham@AppleLink.com}

interface
	uses
		Types, Memory, QuickDraw, Packages, Menus, Events, Fonts, Scrap, ToolUtils, Resources,
		Errors, Palettes, QDOffscreen, StandardFile, MixedMode, Files, Windows,
		Globals, utilities, Graphics, Lut, Filters, Stacks, File1, File2;

	procedure RunAcqPlugIn (item: integer);
	procedure LoadAcqPlugIn (FileName: str255);
	procedure RunExportPlugIn (item: integer);
	procedure LoadExportPlugIn (FileName: str255);
	procedure RunFilterPlugIn (item: integer);
	procedure LoadFilterPlugIn (FileName: str255);
	{$ifc PowerPC}
	procedure CallCode(selector: integer; stuff: ptr; var data: LongInt; var result: Integer; codePtr: UniversalProcPtr); external; {Glue.c}
	{$endc}


implementation

	const
		uppCallCodeInfo = $00003F80; { PROCEDURE (2 byte param, 4 byte param, 4 byte param, 4 byte param); }
		uppTestAbortProcInfo = $00000010; { FUNCTION : 1 byte result; }
		uppUpdateProgressProcInfo = $000003C0; { PROCEDURE (4 byte param, 4 byte param); }
		
	type
		PluginCodeType=procedure(selector: integer; AcqRec: ptr; var data: LongInt; var result: Integer);

		MonitorRec = record
				gamma: Fixed;
				redX: Fixed;
				redY: Fixed;
				greenX: Fixed;
				greenY: Fixed;
				blueX: Fixed;
				blueY: Fixed;
				whiteX: Fixed;
				whiteY: Fixed;
				ambient: Fixed;
			end;

		PlaneMapType = array[0..15] of integer;

		AcquireRecord = record
				serialNumber: LongInt;
				abortProc: ProcPtr;
				progressProc: ProcPtr;
				maxData: LongInt;
				imageMode: integer;
				fImageSize: Point;
				depth: integer;
				planes: integer;
				imageHRes: Fixed;
				imageVRes: Fixed;
				rLUT: packed array[0..255] of char;
				gLUT: packed array[0..255] of char;
				bLUT: packed array[0..255] of char;
				data: Ptr;
				theRect: Rect;
				loPlane: integer;
				hiPlane: integer;
				colBytes: integer;
				rowBytes: LongInt;
				planeBytes: LongInt;
				FileName: Str255;
				vRefNum: integer;
				dirty: boolean;
	     {Version 4 fields}
				hostSig: OSType;
				hostProc: ProcPtr;
				hostModes: LongInt;
				planeMap: PlaneMapType;
				canTranspose: boolean;
				needTranspose: boolean;
				duotoneInfo: Handle;
				diskSpace: LongInt;
				spaceProc: ProcPtr;
				monitor: MonitorRec;
				reserved: packed array[0..255] of char;
			end;

		FilterColor = packed array[0..3] of char;

		FilterRecord = record
				serialNumber: LongInt;
				abortProc: ProcPtr;
				progressProc: ProcPtr;
				parameters: Handle;
				fImageSize: Point;
				planes: integer;
				filterRect: Rect;
				background: RGBColor;
				foreground: RGBColor;
				maxSpace: LongInt;
				bufferSpace: LongInt;
				inRect: Rect;
				inLoPlane: integer;
				inHiPlane: integer;
				outRect: Rect;
				outLoPlane: integer;
				outHiPlane: integer;
				inData: Ptr;
				inRowBytes: LongInt;
				outData: Ptr;
				outRowBytes: LongInt;
				isFloating: boolean;
				haveMask: boolean;
				autoMask: boolean;
				maskRect: Rect;
				maskData: Ptr;
				maskRowBytes: LongInt;
	     {Version 4 fields}
				backColor: FilterColor;
				foreColor: FilterColor;
				hostSig: OSType;
				hostProc: ProcPtr;
				imageMode: integer;
				imageHRes: Fixed;
				imageVRes: Fixed;
				floatCoord: Point;
				wholeSize: Point;
				monitor: MonitorRec;
				reserved: packed array[0..255] of char;
			end;


		ExportRecord = record
				serialNumber: LongInt;
				abortProc: ProcPtr;
				progressProc: ProcPtr;
				maxData: LongInt;
				imageMode: integer;
				eImageSize: Point;
				depth: integer;
				planes: integer;
				imageHRes: Fixed;
				imageVRes: Fixed;
				rLUT: packed array[0..255] of char;
				gLUT: packed array[0..255] of char;
				bLUT: packed array[0..255] of char;
				theRect: Rect;
				loPlane: integer;
				hiPlane: integer;
				data: Ptr;
				rowBytes: LongInt;
				filename: Str255;
				vRefNum: integer;
				dirty: BOOLEAN;
				selectBBox: Rect;
        {Version 4 fields }
				hostSig: OSType;
				hostProc: ProcPtr;
				duotoneInfo: Handle;
				thePlane: integer;
				monitor: MonitorRec;
				reserved: packed array[0..255] of char;
			end;


	var
		acqData, exportData, filterData, nlines, rowpix: LongInt;
		disppict, srcpict: ptr;
		refnum: integer;
		ShowProgress: boolean;
		ProgressMsg: string[17];
		FilterRec: FilterRecord;
		PluginCode:PluginCodeType;


	procedure DummyProc;
	begin
	end;

	function TestAbort: boolean;
	begin
		if commandperiod then
			testabort := true
		else
			testabort := false;
	end;


	procedure UpdateProgress (done, total: LongInt);
		var
			whatpercent: integer;
	begin
		if ShowProgress and (done > 0) and (total > 0) and (total >= done) then begin
				whatpercent := round((done / total) * 100);
				UpdateMeter(whatpercent, ProgressMsg);
			end;
	end;



	procedure CopyData (src: ptr; theRect: rect; srcRowBytes, dstRowBytes: LongInt; lines: integer);
		var
			i: integer;
			dst: ptr;
			width: LongInt;
	begin
		with theRect do
			width := right - left;
		with info^ do
			dst := ptr(ord4(PicBaseAddr) + therect.top * BytesPerRow + therect.left);
		for i := 0 to lines - 1 do begin
				BlockMove(src, dst, width);
				src := ptr(ord4(src) + srcRowBytes);
				dst := ptr(ord4(dst) + dstRowBytes);
			end;
	end;


	procedure CopyInterleavedRGBData (src: ptr; theRect: rect; srcRowBytes, dstRowBytes, colBytes: LongInt; lines: integer; planeMap: PlaneMapType);
		var
			i, j, slice, plane, width: integer;
			src2, src3, dst2, dst3: ptr;
	begin
		with theRect do
			width := right - left;
		with info^.StackInfo^ do
			for slice := 1 to 3 do begin
					CurrentSlice := slice;
					SelectSlice(slice);
					plane := planeMap[slice - 1];
					src2 := src;
					dst2 := ptr(ord4(info^.PicBaseAddr) + therect.top * info^.BytesPerRow + therect.left);
					for i := 0 to lines - 1 do begin
							src3 := ptr(ord4(src2) + plane);
							dst3 := dst2;
							for j := 0 to width - 1 do begin
									dst3^ := src3^;
									src3 := ptr(ord4(src3) + colBytes);
									dst3 := ptr(ord4(dst3) + 1);
								end;
							src2 := ptr(ord4(src2) + srcRowBytes);
							dst2 := ptr(ord4(dst2) + dstRowBytes);
						end; {for i:=1 to nlines-1}
				end; {for slice:=1 to 3}
	end;


	procedure CopyPlanarRGBData (src: ptr; theRect: rect; srcRowBytes, dstRowBytes, planeBytes: LongInt; lines, loPlane, hiPlane: integer);
		var
			i, j, slice, plane: integer;
			src2, dst2: ptr;
			width: LongInt;
	begin
		with theRect do
			width := right - left;
		if loPlane = hiPlane then
			planeBytes := 0;
		if (planeBytes < 0) or (planeBytes > srcRowBytes) then
			planeBytes := width;
		with info^.StackInfo^ do
			for plane := loPlane to hiPlane do begin
					slice := plane + 1;
					if slice > 3 then
						slice := 3;
					CurrentSlice := slice;
					SelectSlice(slice);
					src2 := ptr(ord4(src) + planeBytes * plane);
					dst2 := ptr(ord4(info^.PicBaseAddr) + therect.top * info^.BytesPerRow + therect.left);
					for i := 0 to lines - 1 do begin
							BlockMove(src2, dst2, width);
							src2 := ptr(ord4(src2) + srcRowBytes);
							dst2 := ptr(ord4(dst2) + dstRowBytes);
						end;
				end;
	end;


	function MakeRGBStack (name: str255; width, height: integer): boolean;
		var
			ignore: integer;
	begin
		MakeRGBStack := false;
		if not NewPicWindow('RGB', width, height) then
			exit(MakeRGBStack);
		if not MakeStackFromWindow then
			exit(MakeRGBStack);
		if not AddSlice(false) then begin
				info^.changes := false;
				ignore := CloseAWindow(info^.wptr);
				exit(MakeRGBStack);
			end;
		if not AddSlice(false) then begin
				info^.changes := false;
				ignore := CloseAWindow(info^.wptr);
				exit(MakeRGBStack);
			end;
		MakeRGBStack := true;
	end;

	procedure GetSFCurDir (var vRefNum: integer; var DirID: LongInt);
  {From "Inside Macintosh:Files", page 3-31.}
		type
			IntPtr = ^integer;
			LongIntPtr = ^LongInt;
		const
			SFSaveDisk = $214;
			CurDirStore = $398;
	begin
		vRefNum := -IntPtr(SFSaveDisk)^;
		DirID := LongIntPtr(CurDirStore)^;
	end;

	procedure SetSFCurDir (vRefNum: integer; DirID: LongInt);
		type
			IntPtr = ^integer;
			LongIntPtr = ^LongInt;
		const
			SFSaveDisk = $214;
			CurDirStore = $398;
	begin
		IntPtr(SFSaveDisk)^ := -vRefNum;
		LongIntPtr(CurDirStore)^ := dirID;
	end;


	function isSystem7: boolean;
	begin
		if not System7 then {These routines uses File Manager calls only available under System 7.}
			PutError('System 7 required to use plug-ins.');
		isSystem7 := System7;
	end;


	procedure LoadCodeResource (FileName: str255; fType: osType; var codePtr: ProcPtr);
		var
			myReply: StandardFileReply;
			myTypes: SFTypeList;
			err: OSErr;
			CodeResource: handle;
			GotSpec: boolean;
			spec: FSSpec;
			SaveVol: integer;
			SaveDir: LongInt;
	begin
		GotSpec := false;
		if FileName <> '' then begin
				err := FSMakeFSSpec(PluginsVRefNum, PluginsDirID, FileName, spec);
				GotSpec := err = noerr;
			end;
		if not GotSpec then begin
				GetSFCurDir(SaveVol, SaveDir);
				if PluginsVRefNum <> 0 then
					SetSFCurDir(PluginsVRefNum, PluginsDirID);
				myTypes[0] := fType;
				StandardGetFile(nil, 1, @myTypes, myReply);
				if myReply.sfGood then begin
						spec := myReply.sfFile;
						FileName := myReply.sfFile.name;
						GotSpec := true
					end;
				GetSFCurDir(PluginsVRefNum, PluginsDirID);
				SetSFCurDir(SaveVol, SaveDir);
			end;
		if GotSpec then begin
				refnum := FSpOpenResFile(spec, fsCurPerm);
				if (refnum <> -1) then begin
						if fType = '8BAM' then begin {Acquistion plug-in}
								if pos('Raster', FileName) <> 0 then {Can't show progress indicator if RasterOps frame grabber.}
									ShowProgress := false;
								if FileName <> LastAcqPlugIn then
									acqData := 0;
								LastAcqPlugIn := FileName;
							end
						else if fType = '8BFM' then begin  {Filter plug-in}
								if FileName <> LastFilterPlugIn then begin
										filterData := 0;
										FilterRec.parameters := nil;
									end;
								LastFilterPlugIn := FileName;
							end
						else if fType = '8BEM' then begin  {Export plug-in}
								if FileName <> LastExportPlugIn then
									exportData := 0;
								LastExportPlugIn := FileName;
							end;
						UseResFile(refnum);
						codeResource := GetIndResource(fType, 1);
						hlock(codeResource);
						codePtr := ProcPtr(codeResource^);
					end
				else
					PutError(concat('Error opening plug-in. (Code=', Long2Str(ResError), ')'));
			end;
	end;


{$ifc not PowerPC}
procedure CallCode (selector: integer; AcqRec: ptr; var data: LongInt; var result: Integer; codePtr: ptr);
	inline
		$205F,   {move.l (a7)+,a0}
		$4E90;   {jsr (a0)}
{$endc}
{Otherwise use C glue routine ("Glue.c") that calls CallUniversalProc. We can't
 call it directly because CallUniversalProc uses a variable number of arguments.}


	procedure LoadAcqPlugIn (FileName: str255);

		const
			AcquireAbout = 0;
			AcquireStart = 1;
			AcquireContinue = 2;
			AcquireFinish = 3;
			AcquirePrepare = 4;

			BitMapMode = 0;
			GrayScaleMode = 1;
			IndexedColorMode = 2;
			RGBColorMode = 3;

		var
			thiserror: qderr;
			codePtr: ProcPtr;
			AcqRec: acquirerecord;
			result, i, selector, width, height, ignore: integer;
			ok, PlugInDigitizer: boolean;
			dst: ptr;
			name: str255;

		procedure ShowInfo (str: str255);
		begin
			with AcqRec do
				if ControlKeyDown then begin
						str := concat(str, crStr, crStr, 'imageMode=', long2str(imageMode));
						str := concat(str, crStr, 'width=', long2str(therect.right - therect.left));
						str := concat(str, crStr, 'height=', long2str(therect.bottom - therect.top));
						str := concat(str, crStr, 'depth=', long2str(depth));
						str := concat(str, crStr, 'planes=', long2str(planes));
						str := concat(str, crStr, 'colBytes=', long2str(colBytes));
						str := concat(str, crStr, 'rowBytes=', long2str(rowBytes));
						str := concat(str, crStr, 'planeBytes=', long2str(planeBytes));
						str := concat(str, crStr, 'planeMap=', long2str(planeMap[0]), ' ', long2str(planeMap[1]), long2str(planeMap[2]), ' ', long2str(planeMap[3]));
						str := concat(str, crStr, 'loPlane=', long2str(loPlane));
						str := concat(str, crStr, 'hiPlane=', long2str(hiPlane));
						ShowMessage(str);
						wait(30);
					end;
		end;

		procedure CopyLUT;
			var
				i: integer;
		begin
			with info^ do begin
					for i := 0 to 255 do
						with cTable[i], cTable[i].rgb, AcqRec do begin
								value := 0;
								red := bsl(ord(rLUT[255 - i]), 8);
								green := bsl(ord(gLUT[255 - i]), 8);
								blue := bsl(ord(bLUT[255 - i]), 8);
							end;
					LoadLUT(cTable);
					SetupPseudocolor;
					LutMode := ColorLUT;
					IdentityFunction := false;
					UpdateMap;
				end
		end;

		procedure abort (error: integer; started: boolean);
			var
				msg: str255;
		begin
			if started then
				CallCode(AcquireFinish, @AcqRec, acqData, result, codePtr);
			CloseResFile(RefNum);
			if MeterWindow <> nil then begin
					DisposeWindow(MeterWindow);
					MeterWindow := nil;
				end;
			if error < 0 then begin
					msg := '';
					if error = -108 then
						msg := concat(crStr, crStr, '"', 'Not enough memory', '"');
					PutError(concat('Plug-in error (result code=', long2str(error), ')', msg));
				end;
			PicLeft := PicLeftBase;
			PicTop := PicTopBase;
			AbortMacro;
			{exit(LoadAcqPlugIn);} {ppc-bug}
		end;

	begin
		if not isSystem7 then
			exit(LoadAcqPlugIn);
		PlugInDigitizer := pos('Plug-in', FileName) <> 0;
		ShowProgress := true;
		codePtr := nil;
		LoadCodeResource(FileName, '8BAM', codePtr);
		if codePtr = nil then
			exit(LoadAcqPlugIn);
		if TestAbortProc=nil then
			TestAbortProc := NewRoutineDescriptor(@TestAbort, uppTestAbortProcInfo, GetCurrentISA);
		if UpdateProgressProc=nil then 
			UpdateProgressProc := NewRoutineDescriptor(@UpdateProgress, uppUpdateProgressProcInfo, GetCurrentISA);
		with AcqRec do begin
				SerialNumber := 12345;
				AbortProc := TestAbortProc;
				ProgressProc := UpdateProgressProc;
				MaxData := maxBlock div 2;
				if MaxData < 25000 then begin
						PutError('Out of memory.');
						abort(0, false);
						exit(LoadAcqPlugIn)
					end;
				imageHRes := 0;
				hostSig := 'Imag';
				hostProc := nil {@DummyProc};
				hostModes := 14;{=1110, i.e., grayscale, indexed color and RGB}
				for i := 0 to 15 do begin
						planemap[i] := i;
					end;
				FileName := '';
				canTranspose := false;
				needTranspose := false;
				duoToneInfo := nil;
				diskSpace := -1;
				spaceProc := nil;
				monitor.gamma := 0;
				for i := 0 to 255 do
					reserved[i] := chr(0);
			end;
		ProgressMsg := 'Acquiring ImageÉ';
		ShowInfo('Acquire');
		CallCode(AcquirePrepare, @AcqRec, acqData, result, codePtr);
		if (result <> 0) then
			begin abort(result, false); exit(LoadAcqPlugIn) end;
		ShowInfo('start');
		CallCode(AcquireStart, @AcqRec, acqData, result, codePtr);{call main dialog box etc.}
		if (result <> 0) then
			begin abort(result, false); exit(LoadAcqPlugIn) end;
		if AcqRec.depth = 1 then begin
				PutError('NIH Image does not support acquisition of bitmap (black and white) images.');
				abort(0, true);
				exit(LoadAcqPlugIn)
			end;
		ShowInfo('Opening');
		OpeningPlugInWindow := true; {Causes MakeNewWindow to open window offscreen.}
		if AcqRec.ImageMode = RGBColorMode then
			ok := MakeRGBStack('Untitled', AcqRec.fImageSize.h, AcqRec.fImageSize.v)
		else begin
				if FileName <> '' then
					name := FileName
				else
					name := 'Untitled';
				ok := NewPicWindow(name, AcqRec.fImageSize.h, AcqRec.fImageSize.v);
			end;
		OpeningPlugInWindow := false;
		if not ok then begin
				ShowInfo('Aborting');
				abort(0, true);
				exit(LoadAcqPlugIn)
			end;
		with info^, AcqRec do
			if ImageMode = GrayScaleMode then begin
					if LUTMode = ColorLUT then
						ResetGrayMap
				end
			else if ImageMode = RGBColorMode then
				ResetGrayMap
			else if ImageMode = IndexedColorMode then begin
					ShowInfo('CopyLUT');
					CopyLUT;
				end;
		ShowWatch;
		ShowInfo('Continue');
		repeat
			CallCode(AcquireContinue, @AcqRec, acqData, result, codePtr);
			if result <> 0 then begin
					info^.changes := false;
					ignore := CloseAWindow(info^.wptr);
					abort(result, true);
					exit(LoadAcqPlugIn)
				end;
			with AcqRec do
				if data <> nil then begin
						width := therect.right - therect.left;
						height := therect.bottom - therect.top;
						with Info^ do
							if ((therect.left + width) <= PixelsPerLine) and (therect.top < nlines) then begin
									if (ImageMode = RGBColorMode) and (planes >= 3) and ((hiPlane - loPlane) < 3) then begin
											if planeBytes = 1 then
												CopyInterleavedRGBData(data, theRect, rowBytes, Info^.BytesPerRow, colBytes, height, planeMap)
											else
												CopyPlanarRGBData(data, theRect, rowBytes, Info^.BytesPerRow, planeBytes, height, loPlane, hiPlane)
										end
									else
										CopyData(data, theRect, rowBytes, Info^.BytesPerRow, height);
								end;
					end;
		until (result <> 0) or (AcqRec.data = nil);
		ShowInfo('Finish');
		CallCode(AcquireFinish, @AcqRec, acqData, result, codePtr);
		CloseResFile(RefNum);
		if MeterWindow <> nil then begin
				DisposeWindow(MeterWindow);
				MeterWindow := nil;
			end;
		MoveWindow(info^.wptr, PicLeft, PicTop, true);
		if (AcqRec.imageHRes <> 0) and (not PlugInDigitizer) then
			with info^ do begin
					xScale := FixRound(AcqRec.imageHRes);
					yScale := xScale;
					PixelAspectRatio := 1.0;
					xUnit := 'inch';
					SpatiallyCalibrated := true;
					UpdateTitleBar;
				end;
		if info^.StackInfo <> nil then
			with info^.StackInfo^ do begin
					for i := nSlices downto 1 do begin
							CurrentSlice := i;
							SelectSlice(CurrentSlice);
							InvertPic;
						end;
					StackType := rgbStack;
					UpdateTitleBar;
					ConvertRGBToEightBitColor(true);
				end
		else
			InvertPic;
		if AcqRec.ImageMode = IndexedColorMode then begin
				FixColors;
				WhatToUndo := NothingToUndo;
			end;
		Info^.changes := true;
	end; {LoadAcqPlugIn}


	procedure PutPlugInMsg (str: str255);
		var
			str2: str255;
	begin
		if System7 then
			PutError(concat(str, ' plug-ins found'))  {Code Warrior bug}
		else
			PutError('System 7 required to use plug-ins.');
	end;


	procedure RunAcqPlugIn (item: integer);
		var
			name: str255;
	begin
		if nAcqPlugIns = 0 then begin
				PutPlugInMsg('No acquisition');
				exit(RunAcqPlugIn);
			end;
		GetMenuItemText(AcquireMenuH, item, name);
		LoadAcqPlugIn(name);
	end;


	procedure LoadExportPlugIn (FileName: str255);

		const
			ExportAbout = 0;
			ExportStart = 1;
			ExportContinue = 2;
			ExportFinish = 3;
			ExportPrepare = 4;

			BitMapMode = 0;
			GrayScaleMode = 1;
			IndexedColorMode = 2;
			RGBColorMode = 3;

		var
			thiserror: qderr;
			codePtr: ProcPtr;
			ExportRec: ExportRecord;
			result, i, selector, width, height: integer;
			ok: boolean;
			dst: ptr;
			roi, empty: rect;
			offset: LongInt;

		procedure ShowInfo (str: str255);
		begin
			with ExportRec do
				if ControlKeyDown then begin
						str := concat(str, crStr, crStr, 'imageMode=', long2str(imageMode));
						str := concat(str, crStr, 'width=', long2str(therect.right - therect.left));
						str := concat(str, crStr, 'height=', long2str(therect.bottom - therect.top));
						str := concat(str, crStr, 'depth=', long2str(depth));
						str := concat(str, crStr, 'planes=', long2str(planes));
						str := concat(str, crStr, 'rowBytes=', long2str(rowBytes));
						str := concat(str, crStr, 'loPlane=', long2str(loPlane));
						str := concat(str, crStr, 'hiPlane=', long2str(hiPlane));
						ShowMessage(str);
					end;
		end;

		function BadRect: boolean;
		begin
			BadRect := false;
			with info^.PicRect do begin
					if (ExportRec.theRect.left < left) or (exportRec.theRect.right > right) or (exportRec.theRect.top < top) or (exportRec.theRect.bottom > bottom) then
						BadRect := true;
				end;
		end;

		procedure abort (result: integer);
		begin
			CloseResFile(RefNum);
			if MeterWindow <> nil then begin
					DisposeWindow(MeterWindow);
					MeterWindow := nil;
				end;
			InvertPic;
			if result < 0 then
				PutError(concat('Plug-in error (result code=', long2str(result), ').'));
			{exit(LoadExportPlugIn);} {ppc-bug}
		end;

	begin
		if not isSystem7 then
			exit(LoadExportPlugIn);
		SetRect(empty, 0, 0, 0, 0);
		with info^ do
			if RoiShowing then
				roi := RoiRect
			else
				roi := empty;
		ShowProgress := true;
		codePtr := nil;
		LoadCodeResource(FileName, '8BEM', codePtr);
		if codePtr = nil then
			exit(LoadExportPlugIn);
		if TestAbortProc=nil then
			TestAbortProc := NewRoutineDescriptor(@TestAbort, uppTestAbortProcInfo, GetCurrentISA);
		if UpdateProgressProc=nil then 
			UpdateProgressProc := NewRoutineDescriptor(@UpdateProgress, uppUpdateProgressProcInfo, GetCurrentISA);
		InvertPic;
		with ExportRec, info^ do begin
				SerialNumber := 12345;
				AbortProc := TestAbortProc;
				ProgressProc := UpdateProgressProc;
				MaxData := maxBlock div 2;
				if MaxData < 25000 then begin
						PutError('Out of memory.');
						abort(0);
						exit(LoadExportPlugIn);
					end;
				if LUTMode = Grayscale then
					ImageMode := GrayScaleMode
				else
					ImageMode := IndexedColorMode;
				with PicRect, eImageSize do begin
						h := right - left;
						v := bottom - top;
					end;
				depth := 8;
				planes := 1;
				imageHRes := bsl(72, 16);
				imageVRes := imageHRes;
				for i := 0 to 255 do
					with cTable[i].rgb do begin
							rLUT[255 - i] := chr(bsr(red, 8));
							gLUT[255 - i] := chr(bsr(green, 8));
							bLUT[255 - i] := chr(bsr(blue, 8));
						end;
				theRect := empty;
				loPlane := 0;
				hiPlane := 0;
				data := PicBaseAddr;
				rowBytes := BytesPerRow;
				FileName := title;
				vRefNum := vRef;
				dirty := changes;
				selectBBox := roi;
				hostSig := 'Imag';
				hostProc := nil; {@DummyProc}
				duoToneInfo := nil;
				thePlane := 0;
				monitor.gamma := 0;
				for i := 0 to 255 do
					reserved[i] := chr(0);
			end;
		ProgressMsg := 'Exporting ImageÉ';
		CallCode(ExportPrepare, @ExportRec, ExportData, result, codePtr);
		if (result <> 0) then begin
			abort(result);
			exit(LoadExportPlugIn);
		end;
		CallCode(ExportStart, @ExportRec, ExportData, result, codePtr);{call main dialog box etc.}
		if (result <> 0) then begin
			abort(result);
			exit(LoadExportPlugIn);
		end;
		ShowWatch;
		repeat
			if BadRect then begin
				abort(0);
				exit(LoadExportPlugIn);
			end;
			with ExportRec, info^ do begin
					offset := theRect.top * BytesPerRow + theRect.left;
					data := ptr(ord4(PicBaseAddr) + offset);
				end;
			CallCode(exportContinue, @exportRec, exportData, result, codePtr);
		until (result <> 0) or EmptyRect(exportRec.theRect);
		CallCode(ExportFinish, @ExportRec, ExportData, result, codePtr);
		CloseResFile(RefNum);
		if MeterWindow <> nil then begin
				DisposeWindow(MeterWindow);
				MeterWindow := nil;
			end;
		InvertPic;
	end;


	procedure RunExportPlugIn (item: integer);
		var
			name: str255;
	begin
		if nExportPlugIns = 0 then begin
				PutPlugInMsg('No export');
				exit(RunExportPlugIn);
			end;
		GetMenuItemText(ExportMenuH, item, name);
		LoadExportPlugIn(name);
	end;


	procedure LoadFilterPlugIn (FileName: str255);

		const
			filterAbout = 0;
			filterParameters = 1;
			filterPrepare = 2;
			filterStart = 3;
			filterContinue = 4;
			filterFinish = 5;

			GrayScaleMode = 1;

		var
			thiserror: qderr;
			codePtr: ProcPtr;
			result, i, selector, width, height: integer;
			ok: boolean;
			dst: ptr;
			Empty, roi: rect;
			offset: LongInt;

		procedure InvertUndoPic;
			var
				tPort: GrafPtr;
				SaveGDevice: GDHandle;
		begin
			SaveGDevice := GetGDevice;
			SetGDevice(osGDevice);
			GetPort(tPort);
			with UndoInfo^ do begin
					SetPort(GrafPtr(osPort));
					InvertRect(PicRect);
				end;
			SetPort(tPort);
			SetGDevice(SaveGDevice);
		end;

		procedure abort;
		begin
			CloseResFile(RefNum);
			InvertPic;
			InvertUndoPic;
			if MeterWindow <> nil then begin
					DisposeWindow(MeterWindow);
					MeterWindow := nil;
				end;
			{exit(LoadFilterPlugIn);} {ppc-bug}
		end;

		function BadRect: boolean;
		begin
			BadRect := false;
			with info^.PicRect do begin
					if (FilterRec.inRect.left < left) or (FilterRec.inRect.right > right) or (FilterRec.inRect.top < top) or (FilterRec.inRect.bottom > bottom) then
						BadRect := true;
					if (FilterRec.outRect.left < left) or (FilterRec.outRect.right > right) or (Fi