unit UMPixel32r;

{Contributed by Edward J. Huff <huff@mcclb0.med.nyu.edu> }
{Copyright is hereby waived:  UMPixel32r.p is in the public domain.}

{User Macro "Pixel32r" package. }
{Macros which use these extensions should specify "requiresUser('Pixel32r',1)".}

{These instructions apply if you have received only UMPixel32r.p and}
{a copy of UMacroDef.p and UMacroRun.p, and want to install the code}
{into your copy of NIH Image.}

{You need the Think Pascal compiler to use this source code. }

{Installation instructions.  At the moment, the UMacroDef.p and UMacroRun.p}
{have not been accepted for distribution with standard Image.  If they are, then}
{these instructions will apply.  Otherwise, you will have to obtain a copy of image}
{with UMacroDef.p etc. already installed.  This will typically be available in}
{the /pub/nih-image/contrib directory of zippy.nimh.nih.gov and the file}
{name will include "UMX".}

{If you have no other user macro extension packages installed,}
{then just replace the default UMacroDef.p and UMacroRun.p with the enclosed}
{versions.  Otherwise, you must merge the changes, which should be found only}
{at well marked places.  Generally, this means simply adding lines, although you }
{may also need to add a comma here and there.  Changes should be found at}
{one place in UMacroDef.p and seven places in UMacroRun.p.}

{You will also have to use the "Project/Add File..." menu item to tell Think Pascal }
{to compile this file, and use the "Windows/Image.proj" item to get the project window, }
{and drag this file from the bottom of the list to somewhere between UMacroDef.p and }
{UMacroRun.p.}

{Finally, recompile and rebuild:  Use "Run/Build" (command B) and }
{"Project/Build Application...".}


interface

	uses
		QuickDraw, Palettes, PrintTraps, Globals, Utilities, UMacroDef;

	procedure UMPixel32rInit;
	procedure UMPixel32rFinal;
	procedure UMPixel32rAdd;
	procedure UMPixel32rLookup (var uma: UserMacroArgs);
	procedure UMPixel32rRun (var uma: UserMacroArgs);

implementation

	type
		r32p = ^Real;
		u16r = packed record
				u: 0..65535;
			end;
		u16p = ^u16r;

{Called from procedure InitUserMacros in UMacroRun.p, }
{which is called from Image.p early in initialization.}
{Do not start timers (see UMTimer.p) in this function.}
	procedure UMPixel32rInit;
	begin
	end;


{Called from procedure FinalUserMacros in UMacroRun,p.}
{This is guaranteed to run prior to any exit which happens after a call}
{to DoUserMacro, and is intended for things which MUST be done prior }
{to exit, like removing timers from the system timer list.}
{Note well that it is NOT guaranteed to be called prior to any exit}
{which might happen after InitUserMacros but before DoUserMacro.}
	procedure UMPixel32rFinal;
	begin
	end;


{AddUMSym calls:}
{Add one call for each macro command, function, or string function}
{you wish to add to the macro language.}
{First argument is a string, case is ignored, truncated to SymbolSize characters.}
{Second argument must be one of UserCommandT, UserFuncT, or UserStrFuncT}
{Third argument is the UserCommandType item associated with the name.}


{Called from procedure AddUserMacros in UMacroRun.p.}
{This runs once each time macros are loaded from a file or a text window.}
	procedure UMPixel32rAdd;
	begin
		AddUMSym('Cnvrt8To32r', UserCommandT, Cnvrt8To32rUC);
		AddUMSym('Cnvrt32rTo8', UserCommandT, Cnvrt32rTo8UC);
		AddUMSym('Cnvrt16uT32r', UserCommandT, Cnvrt16uT32rUC);
		AddUMSym('Cnvrt32rT16u', UserCommandT, Cnvrt32rT16uUC);
		AddUMSym('Add32r', UserCommandT, Add32rUC);
		AddUMSym('Sub32r', UserCommandT, Sub32rUC);
		AddUMSym('Mpy32r', UserCommandT, Mpy32rUC);
		AddUMSym('Div32r', UserCommandT, Div32rUC);
		AddUMSym('Lrg32r', UserCommandT, Lrg32rUC);
		AddUMSym('Sml32r', UserCommandT, Sml32rUC);
		AddUMSym('AddK32r', UserCommandT, AddK32rUC);
		AddUMSym('SubK32r', UserCommandT, SubK32rUC);
		AddUMSym('MpyK32r', UserCommandT, MpyK32rUC);
		AddUMSym('DivK32r', UserCommandT, DivK32rUC);
		AddUMSym('LrgK32r', UserCommandT, LrgK32rUC);
		AddUMSym('SmlK32r', UserCommandT, SmlK32rUC);
		AddUMSym('minMax32r', UserCommandT, minMax32rUC);
		AddUMSym('Min32r', UserFuncT, Min32rUC);
		AddUMSym('Max32r', UserFuncT, Max32rUC);
		AddUMSym('Sqrt32r', UserCommandT, Sqrt32rUC);
		AddUMSym('Ln32r', UserCommandT, Ln32rUC);
		AddUMSym('Exp32r', UserCommandT, Exp32rUC);
		AddUMSym('LeastSqr32r', UserCommandT, LeastSqr32rUC);
		AddUMSym('ExpFtStep32r', UserCommandT, ExpFtStep32rUC);
		AddUMSym('Fill32r', UserCommandT, Fill32rUC);
	end;

{Called from procedure LookupUserMacro in UMMacroRun.p}
{This runs every time the macro is executed, just prior to}
{parsing the arguments.}
	procedure UMPixel32rLookup (var uma: UserMacroArgs);
	begin
		with uma do
			case UserMacroCommand of
				Cnvrt8To32rUC:  begin
						nArgs := 2;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATpic;
					end;
				Cnvrt32rTo8UC:  begin
						nArgs := 2;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATpic;
					end;
				Cnvrt16uT32rUC:  begin
						nArgs := 2;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATpic;
					end;
				Cnvrt32rT16uUC:  begin
						nArgs := 2;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATpic;
					end;{}
				Add32rUC, Sub32rUC, Mpy32rUC, Div32rUC, Lrg32rUC, Sml32rUC:  begin
           {ina, inb, out: pidNumber}
						nArgs := 3;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATpic;
						arg[3].atype := UMATpic;
					end; {}
				AddK32rUC, SubK32rUC, MpyK32rUC, DivK32rUC, LrgK32rUC, SmlK32rUC:  begin
          {cons: real; in, out: pidNumber;}
						nArgs := 3;
						arg[1].atype := UMATreal;
						arg[2].atype := UMATpic;
						arg[3].atype := UMATpic;
					end;{}
				minMax32rUC:  begin
						nArgs := 3;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATrealvar;
						arg[3].atype := UMATrealvar;
					end;
				Min32rUC, Max32rUC:  begin
						nArgs := 1;
						arg[1].atype := UMATpic;
					end;
				Sqrt32rUC, Ln32rUC, Exp32rUC:  begin
						nArgs := 2;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATpic;
					end;
				LeastSqr32rUC:  begin
						nArgs := 7;
						arg[1].atype := UMATreal; {sumX}
						arg[2].atype := UMATreal; {n}
						arg[3].atype := UMATreal; {sumXsqd}
						arg[4].atype := UMATpic;{sumY}
						arg[5].atype := UMATpic;{sumXY}
						arg[6].atype := UMATpic;{m}
						arg[7].atype := UMATpic;{b}
					end;
				ExpFtStep32rUC:  begin
						nArgs := 5;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATpic;
						arg[3].atype := UMATpic;
						arg[4].atype := UMATpic;
						arg[5].atype := UMATpic;
					end;
				Fill32rUC:  begin
						nArgs := 2;
						arg[1].atype := UMATreal;
						arg[2].atype := UMATpic;
					end;
				otherwise begin
						ErrorOccurred := true;
						str := 'UMPixel32r.p LookupUserMacro';
					end;
			end;
	end;

	procedure checkRoiSize (var uma: UserMacroArgs; i, j: integer);
		var
			argi, argj: ^UserMacroArg;
	begin
		with uma do begin
				argi := @arg[i];
				argj := @arg[j];
				if (argi^.atype <> UMATpic) or (argj^.atype <> UMATpic) then begin
						errorOccurred := true;
						str := 'UMPixel32r.p';
					end
				else if (argi^.roi.Width <> argj^.roi.Width) or (argi^.roi.Height <> argj^.roi.Height) then begin
						errorOccurred := true;
						str := 'All selection sizes must be equal';
					end
			end;
	end;

	type
		ConvertArg = record
				wpix, height, skipIn, skipOut: longint;
				baseIn, baseOut: ptr;
			end;

	procedure Cnvrt8To32r (var arg: ConvertArg);
		var
			inp: pup;
			out: r32p;
			w: longInt;
	begin
		with arg do begin
				inp := pup(baseIn);
				out := r32p(baseOut);
				repeat
					w := wpix;
					repeat
						out^ := inp^.u;
						inp := pup(ord4(inp) + 1);
						out := r32p(ord4(out) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inp := pup(ord4(inp) + skipIn);
					out := r32p(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure Cnvrt32rTo8 (var arg: ConvertArg);
		var
			inp: r32p;
			out: pup;
			w: longInt;
	begin
		with arg do begin
				inp := r32p(baseIn);
				out := pup(baseOut);
				repeat
					w := wpix;
					repeat
						out^.u := round(inp^);
						inp := r32p(ord4(inp) + sizeof(real));
						out := pup(ord4(out) + 1);
						w := w - 1;
					until w <= 0;
					inp := r32p(ord4(inp) + skipIn);
					out := pup(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure Cnvrt16uT32r (var arg: ConvertArg);
		var
			inp: u16p;
			out: r32p;
			w: longInt;
	begin
		with arg do begin
				inp := u16p(baseIn);
				out := r32p(baseOut);
				repeat
					w := wpix;
					repeat
						out^ := inp^.u;
						inp := u16p(ord4(inp) + sizeof(Integer));
						out := r32p(ord4(out) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inp := u16p(ord4(inp) + skipIn);
					out := r32p(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure Cnvrt32rT16u (var arg: ConvertArg);
		var
			inp: r32p;
			out: u16p;
			w: longInt;
	begin
		with arg do begin
				inp := r32p(baseIn);
				out := u16p(baseOut);
				repeat
					w := wpix;
					repeat
						out^.u := round(inp^);
						inp := r32p(ord4(inp) + sizeof(real));
						out := u16p(ord4(out) + sizeof(Integer));
						w := w - 1;
					until w <= 0;
					inp := r32p(ord4(inp) + skipIn);
					out := u16p(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure doConvert (var uma: UserMacroArgs; inBytes, outBytes: LongInt);
		var
			cnvArg: ConvertArg;
	begin
		with uma do begin {in, out: pidNumber;value: real}
				checkPixelWidth(inBytes, uma, 1);
				checkPixelWidth(outBytes, uma, 2);
				if (arg[1].roi.Width * outBytes <> arg[2].roi.Width * inBytes) or (arg[1].roi.Height <> arg[2].roi.Height) then begin
						errorOccurred := true;
						str := 'All selection sizes must be equal';
					end;
				checkOutputConflict(uma, 2);
				if errorOccurred then
					exit(doConvert);
				with arg[1].roi do begin
						cnvArg.wpix := Width div inBytes;
						cnvArg.height := Height;
					end;
				with cnvArg do begin
						with arg[1].roi do begin
								baseIn := Base;
								skipIn := Skip;
							end;
						with arg[2].roi do begin
								baseOut := Base;
								skipOut := Skip;
							end;
					end;
				case UserMacroCommand of
					Cnvrt8To32rUC: 
						Cnvrt8To32r(cnvArg);
					Cnvrt32rTo8UC: 
						Cnvrt32rTo8(cnvArg);
					Cnvrt16uT32rUC: 
						Cnvrt16uT32r(cnvArg);
					Cnvrt32rT16uUC: 
						Cnvrt32rT16u(cnvArg);
				end;
			end;
	end;

	type
		Pixel32rPair = record
				wpix, height, skipA, skipB, skipOut: longint;
				baseA, baseB, baseOut: ptr;
			end;

	procedure add32r (var pairArg: Pixel32rPair);
		var
			inA, inB, out: r32p;
			w: longInt;
	begin
		with pairArg do begin
				inA := r32p(baseA);
				inB := r32p(baseB);
				out := r32p(baseOut);
				repeat
					w := wpix;
					repeat
						out^ := inA^ + inB^;
						inA := r32p(ord4(inA) + sizeof(real));
						inB := r32p(ord4(inB) + sizeof(real));
						out := r32p(ord4(out) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inA := r32p(ord4(inA) + skipA);
					inB := r32p(ord4(inB) + skipB);
					out := r32p(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure sub32r (var pairArg: Pixel32rPair);
		var
			inA, inB, out: r32p;
			w: longInt;
	begin
		with pairArg do begin
				inA := r32p(baseA);
				inB := r32p(baseB);
				out := r32p(baseOut);
				repeat
					w := wpix;
					repeat
						out^ := inA^ - inB^;
						inA := r32p(ord4(inA) + sizeof(real));
						inB := r32p(ord4(inB) + sizeof(real));
						out := r32p(ord4(out) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inA := r32p(ord4(inA) + skipA);
					inB := r32p(ord4(inB) + skipB);
					out := r32p(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure mpy32r (var pairArg: Pixel32rPair);
		var
			inA, inB, out: r32p;
			w: longInt;
	begin
		with pairArg do begin
				inA := r32p(baseA);
				inB := r32p(baseB);
				out := r32p(baseOut);
				repeat
					w := wpix;
					repeat
						out^ := inA^ * inB^;
						inA := r32p(ord4(inA) + sizeof(real));
						inB := r32p(ord4(inB) + sizeof(real));
						out := r32p(ord4(out) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inA := r32p(ord4(inA) + skipA);
					inB := r32p(ord4(inB) + skipB);
					out := r32p(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure div32r (var pairArg: Pixel32rPair);
		var
			inA, inB, out: r32p;
			w: longInt;
	begin
		with pairArg do begin
				inA := r32p(baseA);
				inB := r32p(baseB);
				out := r32p(baseOut);
				repeat
					w := wpix;
					repeat
						out^ := inA^ / inB^;
						inA := r32p(ord4(inA) + sizeof(real));
						inB := r32p(ord4(inB) + sizeof(real));
						out := r32p(ord4(out) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inA := r32p(ord4(inA) + skipA);
					inB := r32p(ord4(inB) + skipB);
					out := r32p(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure lrg32r (var pairArg: Pixel32rPair);
		var
			inA, inB, out: r32p;
			w: longInt;
	begin
		with pairArg do begin
				inA := r32p(baseA);
				inB := r32p(baseB);
				out := r32p(baseOut);
				repeat
					w := wpix;
					repeat
						if inA^ > inB^ then
							out^ := inA^
						else
							out^ := inB^;
						inA := r32p(ord4(inA) + sizeof(real));
						inB := r32p(ord4(inB) + sizeof(real));
						out := r32p(ord4(out) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inA := r32p(ord4(inA) + skipA);
					inB := r32p(ord4(inB) + skipB);
					out := r32p(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure sml32r (var pairArg: Pixel32rPair);
		var
			inA, inB, out: r32p;
			w: longInt;
	begin
		with pairArg do begin
				inA := r32p(baseA);
				inB := r32p(baseB);
				out := r32p(baseOut);
				repeat
					w := wpix;
					repeat
						if inA^ > inB^ then
							out^ := inB^
						else
							out^ := inA^;
						inA := r32p(ord4(inA) + sizeof(real));
						inB := r32p(ord4(inB) + sizeof(real));
						out := r32p(ord4(out) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inA := r32p(ord4(inA) + skipA);
					inB := r32p(ord4(inB) + skipB);
					out := r32p(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure pairOp (var uma: UserMacroArgs);
		var
			pairArg: Pixel32rPair;
	begin
		with uma do begin
				if sizeof(Real) <> 4 then begin
						errorOccurred := true;
						str := 'sizeof(Real) is not 4';
						exit(pairOp);
					end;
				checkPixelWidth(4, uma, 1);
				checkPixelWidth(4, uma, 2);
				checkPixelWidth(4, uma, 3);
{checkOutputConflict(uma, 3);output can be one of the inputs}
				checkRoiSize(uma, 1, 2);
				checkRoiSize(uma, 1, 3);
        {checkRoiSize(uma,2,3);redundant}
				if errorOccurred then
					exit(pairOp);
				with arg[1].roi do begin
						pairArg.wpix := Width div 4;
						pairArg.height := Height;
					end;
				with pairArg do begin
						with arg[1].roi do begin
								baseA := Base;
								skipA := Skip;
							end;
						with arg[2].roi do begin
								baseB := Base;
								skipB := Skip;
							end;
						with arg[3].roi do begin
								baseOut := Base;
								skipOut := Skip;
							end;
					end;
				case UserMacroCommand of
					Add32rUC: 
						add32r(pairArg);
					Sub32rUC: 
						sub32r(pairArg);
					Mpy32rUC: 
						mpy32r(pairArg);
					Div32rUC: 
						div32r(pairArg);
					Lrg32rUC: 
						lrg32r(pairArg);
					Sml32rUC: 
						sml32r(pairArg);
				end;
			end;
	end;

	type
		PixelK32rArg = record
				wpix, height, skipIn, skipOut: longint;
				value: real;
				baseIn, baseOut: ptr;
			end;

	procedure AddK32r (var kArg: PixelK32rArg);
		var
			inp, out: r32p;
			w: longInt;
	begin
		with kArg do begin
				inp := r32p(baseIn);
				out := r32p(baseOut);
				repeat
					w := wpix;
					repeat
						out^ := inp^ + value;
						inp := r32p(ord4(inp) + sizeof(real));
						out := r32p(ord4(out) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inp := r32p(ord4(inp) + skipIn);
					out := r32p(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure SubK32r (var kArg: PixelK32rArg);
		var
			inp, out: r32p;
			w: longInt;
	begin
		with kArg do begin
				inp := r32p(baseIn);
				out := r32p(baseOut);
				repeat
					w := wpix;
					repeat
						out^ := value - inp^;
						inp := r32p(ord4(inp) + sizeof(real));
						out := r32p(ord4(out) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inp := r32p(ord4(inp) + skipIn);
					out := r32p(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure MpyK32r (var kArg: PixelK32rArg);
		var
			inp, out: r32p;
			w: longInt;
	begin
		with kArg do begin
				inp := r32p(baseIn);
				out := r32p(baseOut);
				repeat
					w := wpix;
					repeat
						out^ := inp^ * value;
						inp := r32p(ord4(inp) + sizeof(real));
						out := r32p(ord4(out) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inp := r32p(ord4(inp) + skipIn);
					out := r32p(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure DivK32r (var kArg: PixelK32rArg);
		var
			inp, out: r32p;
			w: longInt;
	begin
		with kArg do begin
				inp := r32p(baseIn);
				out := r32p(baseOut);
				repeat
					w := wpix;
					repeat
						out^ := value / inp^;
						inp := r32p(ord4(inp) + sizeof(real));
						out := r32p(ord4(out) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inp := r32p(ord4(inp) + skipIn);
					out := r32p(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure SmlK32r (var kArg: PixelK32rArg);
		var
			inp, out: r32p;
			w: longInt;
	begin
		with kArg do begin
				inp := r32p(baseIn);
				out := r32p(baseOut);
				repeat
					w := wpix;
					repeat
						if inp^ < value then
							out^ := inp^
						else
							out^ := value;
						inp := r32p(ord4(inp) + sizeof(real));
						out := r32p(ord4(out) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inp := r32p(ord4(inp) + skipIn);
					out := r32p(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure LrgK32r (var kArg: PixelK32rArg);
		var
			inp, out: r32p;
			w: longInt;
	begin
		with kArg do begin
				inp := r32p(baseIn);
				out := r32p(baseOut);
				repeat
					w := wpix;
					repeat
						if inp^ > value then
							out^ := inp^
						else
							out^ := value;
						inp := r32p(ord4(inp) + sizeof(real));
						out := r32p(ord4(out) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inp := r32p(ord4(inp) + skipIn);
					out := r32p(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure constOp (var uma: UserMacroArgs);
		var
			KArg: PixelK32rArg;
	begin
		with uma do begin {value: real; in, out: pidNumber;}
				checkPixelWidth(4, uma, 2);
				checkPixelWidth(4, uma, 3);
				checkRoiSize(uma, 2, 3);
{checkOutputConflict(uma, 3);output can be same as input}
				if errorOccurred then
					exit(constOp);
				with arg[2].roi do begin
						KArg.wpix := Width div 4;
						KArg.height := Height;
					end;
				with KArg do begin
						with arg[2].roi do begin
								baseIn := Base;
								skipIn := Skip;
							end;
						with arg[3].roi do begin
								baseOut := Base;
								skipOut := Skip;
							end;
						value := arg[1].aval;
					end;
				case UserMacroCommand of
					AddK32rUC: 
						AddK32r(KArg);
					SubK32rUC: 
						SubK32r(KArg);
					MpyK32rUC: 
						MpyK32r(KArg);
					DivK32rUC: 
						DivK32r(KArg);
					LrgK32rUC: 
						LrgK32r(KArg);
					SmlK32rUC: 
						SmlK32r(KArg);
				end;
			end;
	end;

	type
		Unary32rArg = record
				wpix, height, skipIn, skipOut: longint;
				baseIn, baseOut: ptr;
			end;

	procedure Sqrt32r (var kArg: Unary32rArg);
		var
			inp, out: r32p;
			w: longInt;
	begin
		with kArg do begin
				inp := r32p(baseIn);
				out := r32p(baseOut);
				repeat
					w := wpix;
					repeat
						out^ := sqrt(inp^);
						inp := r32p(ord4(inp) + sizeof(real));
						out := r32p(ord4(out) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inp := r32p(ord4(inp) + skipIn);
					out := r32p(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure Ln32r (var kArg: Unary32rArg);
		var
			inp, out: r32p;
			w: longInt;
	begin
		with kArg do begin
				inp := r32p(baseIn);
				out := r32p(baseOut);
				repeat
					w := wpix;
					repeat
						out^ := ln(inp^);
						inp := r32p(ord4(inp) + sizeof(real));
						out := r32p(ord4(out) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inp := r32p(ord4(inp) + skipIn);
					out := r32p(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure Exp32r (var kArg: Unary32rArg);
		var
			inp, out: r32p;
			w: longInt;
	begin
		with kArg do begin
				inp := r32p(baseIn);
				out := r32p(baseOut);
				repeat
					w := wpix;
					repeat
						out^ := exp(inp^);
						inp := r32p(ord4(inp) + sizeof(real));
						out := r32p(ord4(out) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inp := r32p(ord4(inp) + skipIn);
					out := r32p(ord4(out) + skipOut);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure unaryOp (var uma: UserMacroArgs);
		var
			KArg: Unary32rArg;
	begin
		with uma do begin {in, out: pidNumber;value: real}
				checkPixelWidth(4, uma, 1);
				checkPixelWidth(4, uma, 2);
				checkRoiSize(uma, 1, 2);
{checkOutputConflict(uma, 2);output can be same as input}
				if errorOccurred then
					exit(unaryOp);
				with arg[1].roi do begin
						KArg.wpix := Width div 4;
						KArg.height := Height;
					end;
				with KArg do begin
						with arg[1].roi do begin
								baseIn := Base;
								skipIn := Skip;
							end;
						with arg[2].roi do begin
								baseOut := Base;
								skipOut := Skip;
							end;
					end;
				case UserMacroCommand of
					Sqrt32rUC: 
						Sqrt32r(KArg);
					Ln32rUC: 
						Ln32r(KArg);
					Exp32rUC: 
						Exp32r(KArg);
				end;
			end;
	end;

	type
		minMax32rArg = record
				wpix, height, skipIn: LongInt;
				baseIn: Ptr;
				minv, maxv: real;
			end;

	procedure MinMax32 (var minMaxArg: minMax32rArg);
		var
			inp: r32p;
			w: longInt;
			rmin, rmax, r: real;
	begin
		with minMaxArg do begin
				inp := r32p(baseIn);
				rmin := inp^;
				rmax := inp^;
				repeat
					w := wpix;
					repeat
						r := inp^;
						if r < rmin then
							rmin := r;
						if r > rmax then
							rmax := r;
						inp := r32p(ord4(inp) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inp := r32p(ord4(inp) + skipIn);
					height := height - 1;
				until height <= 0;
				minv := rmin;
				maxv := rmax;
			end;
	end;

	procedure Min32 (var minMaxArg: minMax32rArg);
		var
			inp: r32p;
			w: longInt;
			rmin: real;
	begin
		with minMaxArg do begin
				inp := r32p(baseIn);
				rmin := inp^;
				repeat
					w := wpix;
					repeat
						if inp^ < rmin then
							rmin := inp^;
						inp := r32p(ord4(inp) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inp := r32p(ord4(inp) + skipIn);
					height := height - 1;
				until height <= 0;
				minv := rmin;
			end;
	end;

	procedure Max32 (var minMaxArg: minMax32rArg);
		var
			inp: r32p;
			w: longInt;
			rmax: real;
	begin
		with minMaxArg do begin
				inp := r32p(baseIn);
				rmax := inp^;
				repeat
					w := wpix;
					repeat
						if inp^ > rmax then
							rmax := inp^;
						inp := r32p(ord4(inp) + sizeof(real));
						w := w - 1;
					until w <= 0;
					inp := r32p(ord4(inp) + skipIn);
					height := height - 1;
				until height <= 0;
				maxv := rmax;
			end;
	end;


	procedure doMinMax32r (var uma: UserMacroArgs);
		var
			minMaxArg: minMax32rArg;
	begin
		with uma do begin {in, out: pidNumber;value: real}
				checkPixelWidth(sizeof(real), uma, 1);
				if errorOccurred then
					exit(doMinMax32r);
				with arg[1].roi do begin
						minMaxArg.wpix := Width div sizeof(real);
						minMaxArg.height := Height;
					end;
				with minMaxArg do begin
						with arg[1].roi do begin
								baseIn := Base;
								skipIn := Skip;
							end;
					end;
				case UserMacroCommand of
					minMax32rUC:  begin
							MinMax32(minMaxArg);
							arg[2].aval := minMaxArg.minv;
							arg[3].aval := minMaxArg.maxv;
						end;
					Min32rUC:  begin
							Min32(minMaxArg);
							FuncResult := minMaxArg.minv;
						end;
					Max32rUC:  begin
							Max32(minMaxArg);
							FuncResult := minMaxArg.maxv;
						end;
				end;
			end;
	end;

{one least squares fit for each pixel of stack of images}
{given sum of X values, }
{sum of X squared values,}
{number of data points, }
{an image of sum of Y values}
{and an image of sum of XY values.}
	type
		LeastSqr32rArg = record
				wpix, height, skipSumY, skipSumXY, skipM, skipB: LongInt;
				baseSumY, baseSumXY, baseM, baseB: Ptr;
				denom: extended;
				SumX, N, SumXSqd: extended;
			end;

	procedure LeastSqr32r (var sqArg: LeastSqr32rArg);
		var
			SumY, SumXY, M, B: r32p;
			tSumY, tSumXY: extended;
			w: LongInt;
	begin
		with sqArg do begin
				SumY := r32p(baseSumY);
				SumXY := r32p(baseSumXY);
				M := r32p(baseM);
				B := r32p(baseB);
				repeat
					w := wpix;
					repeat
						tSumY := SumY^;
						tSumXY := SumXY^;
						M^ := (tSumY * SumX - N * tSumXY) / denom;
						B^ := (SumX * tSumXY - tSumY * SumXSqd) / denom;
						SumY := r32p(ord4(SumY) + sizeof(real));
						SumXY := r32p(ord4(SumXY) + sizeof(real));
						M := r32p(ord4(M) + sizeof(real));
						B := r32p(ord4(B) + sizeof(real));
						w := w - 1;
					until w <= 0;
					SumY := r32p(ord4(SumY) + skipSumY);
					SumXY := r32p(ord4(SumXY) + skipSumXY);
					M := r32p(ord4(M) + skipM);
					B := r32p(ord4(B) + skipB);
					height := height - 1;
				until height <= 0;
			end;
	end;


	procedure doLeastSqr32r (var uma: UserMacroArgs);
		var
			sqArg: LeastSqr32rArg;
	begin
		with uma do begin
				checkPixelWidth(sizeof(real), uma, 4);
				checkPixelWidth(sizeof(real), uma, 5);
				checkPixelWidth(sizeof(real), uma, 6);
				checkPixelWidth(sizeof(real), uma, 7);
				checkOutputConflict(uma, 6);
				checkOutputConflict(uma, 7);
				checkRoiSize(uma, 4, 5);
				checkRoiSize(uma, 4, 6);
				checkRoiSize(uma, 4, 7);
				if errorOccurred then
					exit(doLeastSqr32r);
				with arg[4].roi do begin
						sqArg.wpix := Width div sizeof(real);
						sqArg.height := Height;
					end;
				with sqArg do begin
						with arg[4].roi do begin
								baseSumY := Base;
								skipSumY := Skip;
							end;
						with arg[5].roi do begin
								baseSumXY := Base;
								skipSumXY := Skip;
							end;
						with arg[6].roi do begin
								baseM := Base;
								skipM := Skip;
							end;
						with arg[7].roi do begin
								baseB := Base;
								skipB := Skip;
							end;
						SumX := arg[1].aval;
						N := arg[2].aval;
						SumXSqd := arg[3].aval;
						denom := SumX * SumX - N * SumXSqd;
						LeastSqr32r(sqArg);
					end;
			end;
	end;

	type
		ExpFtStep32rArg = record
				wpix, height, skipBestResid, skipNextResid, skipBestBase, skipNextBase, skipDeltaBase: LongInt;
				baseBestResid, baseNextResid, baseBestBase, baseNextBase, baseDeltaBase: Ptr;
			end;
	procedure ExpFtStep32r (var stepArg: ExpFtStep32rArg);
		var
			BestResid, NextResid, BestBase, NextBase, DeltaBase: r32p;
			w: LongInt;
	begin
		with stepArg do begin
				BestResid := r32p(baseBestResid);
				NextResid := r32p(baseNextResid);
				BestBase := r32p(baseBestBase);
				NextBase := r32p(baseNextBase);
				DeltaBase := r32p(baseDeltaBase);
				repeat
					w := wpix;
					repeat
						if NextResid^ < BestResid^ then begin
								BestResid^ := NextResid^;
								BestBase^ := NextBase^;
							end
						else begin
								DeltaBase^ := -0.5 * DeltaBase^;
							end;
						NextBase^ := BestBase^ + DeltaBase^;
						BestResid := r32p(ord4(BestResid) + sizeof(real));
						NextResid := r32p(ord4(NextResid) + sizeof(real));
						BestBase := r32p(ord4(BestBase) + sizeof(real));
						NextBase := r32p(ord4(NextBase) + sizeof(real));
						DeltaBase := r32p(ord4(DeltaBase) + sizeof(real));
						w := w - 1;
					until w <= 0;
					BestResid := r32p(ord4(BestResid) + skipBestResid);
					NextResid := r32p(ord4(NextResid) + skipNextResid);
					BestBase := r32p(ord4(BestBase) + skipBestBase);
					NextBase := r32p(ord4(NextBase) + skipNextBase);
					DeltaBase := r32p(ord4(DeltaBase) + skipDeltaBase);
					height := height - 1;
				until height <= 0;
			end;
	end;

	procedure doExpFtStep32r (var uma: UserMacroArgs);
		var
			stepArg: ExpFtStep32rArg;
			i: integer;
	begin
		with uma do begin
{ExpFtStep(BestResid,NextResid,BestBase,NextBase,DeltaBase: pidNum);}
				for i := 1 to 5 do begin
						checkPixelWidth(sizeof(real), uma, i);
						checkOutputConflict(uma, i);
					end;
				for i := 2 to 5 do
					checkRoiSize(uma, 1, i);
				if errorOccurred then
					exit(doExpFtStep32r);
				with arg[1].roi do begin
						stepArg.wpix := Width div sizeof(real);
						stepArg.height := Height;
					end;
				with stepArg do begin
						with arg[1].roi do begin
								baseBestResid := Base;
								skipBestResid := Skip;
							end;
						with arg[2].roi do begin
								baseNextResid := Base;
								skipNextResid := Skip;
							end;
						with arg[3].roi do begin
								baseBestBase := Base;
								skipBestBase := Skip;
							end;
						with arg[4].roi do begin
								baseNextBase := Base;
								skipNextBase := Skip;
							end;
						with arg[5].roi do begin
								baseDeltaBase := Base;
								skipDeltaBase := Skip;
							end;
						ExpFtStep32r(stepArg);
					end;
			end;
	end;

	type
		Fill32rArg = record
				wpix, hpix, skipOut: LongInt;
				baseOut: Ptr;
				FillValue: Real;
			end;

	procedure Fill32r (var FillArg: Fill32rArg);
		var
			outp: r32p;
			w: longInt;
			v: extended;
	begin
		with FillArg do begin
				outp := r32p(baseOut);
				v := FillValue;
				repeat
					w := wpix;
					repeat
						outp^ := v;
						outp := r32p(ord4(outp) + sizeof(real));
						w := w - 1;
					until w <= 0;
					outp := r32p(ord4(outp) + skipOut);
					hpix := hpix - 1;
				until hpix <= 0;
			end;
	end;

	procedure doFill32r (var uma: UserMacroArgs);
		var
			FillArg: Fill32rArg;
	begin
		with uma, FillArg do begin
				checkPixelWidth(sizeof(real), uma, 2);
				if errorOccurred then
					exit(doFill32r);
				with arg[2].roi do begin
						wpix := Width div sizeof(real);
						hpix := Height;
						baseOut := Base;
						skipOut := Skip;
					end;
				FillValue := arg[1].aval;
				Fill32r(FillArg);
			end;
	end;


{Called from procedure DoUserMacro in UMacroRun.p .}
{Do not change uma.nArgs or uma.arg[i].argt here.}
{This runs once each time the macro is used, after parsing the arguments.}
	procedure UMPixel32rRun (var uma: UserMacroArgs);
	begin
		with uma do begin
				case UserMacroCommand of
					Cnvrt8To32rUC: 
						doConvert(uma, 1, 4);
					Cnvrt32rTo8UC: 
						doConvert(uma, 4, 1);
					Cnvrt16uT32rUC: 
						doConvert(uma, 2, 4);
					Cnvrt32rT16uUC: 
						doConvert(uma, 4, 2);
					Add32rUC, Sub32rUC, Mpy32rUC, Div32rUC, Lrg32rUC, Sml32rUC: 
						PairOp(uma);
					AddK32rUC, SubK32rUC, MpyK32rUC, DivK32rUC, LrgK32rUC, SmlK32rUC: 
						ConstOp(uma);
					Sqrt32rUC, Ln32rUC, Exp32rUC: 
						UnaryOp(uma);
					minMax32rUC, Min32rUC, Max32rUC: 
						doMinMax32r(uma);
					LeastSqr32rUC: 
						doLeastSqr32r(uma);
					ExpFtStep32rUC: 
						doExpFtStep32r(uma);
					Fill32rUC: 
						doFill32r(uma);
					otherwise begin
							ErrorOccurred := true;
							str := 'UMPixel32r.p DoUserMacro';
						end;
				end;
			end;
	end;
end.