unit UMscion1200;
{Not ready for general use, use this module only if you know what you are doing.}

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

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

{WARNING:  This package does not do extensive error checking, use with caution.}
{It can cause your computer to crash if misused. }
{(especially setNBRamBase/Size commands)}

{These instructions apply if you have received only UMscion1200.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, Slots;

	procedure UMscion1200Init;
	procedure UMscion1200Final;
	procedure UMscion1200Add;
	procedure UMscion1200Lookup (var uma: UserMacroArgs);
	procedure UMscion1200Run (var uma: UserMacroArgs);

implementation

	type
		RealPtr = ^Real;
		packedUnsignedInt = packed record
				u: 0..65535
			end;
		puip = ^packedUnsignedInt;

	var
		NuBusRAMSlotBase, NuBusRAMSize: LongInt;
		ScionHeight, ScionWidth, AnalogContrast, AnalogBrightness: Integer;
		pwidth, lambda: Real;
		UserScionBusy: Boolean;

	procedure UpdateAnalog (AnalogBrightness: integer; AnalogContrast: integer; ScionSlotBase: LongInt);
	external; {defined in Analog1200.c which was compiled by ThinkC into 1200.lib and added to Image.proj}

{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 UMscion1200Init;
	begin
		NuBusRAMSlotBase := 0; {user must invoke s12FindNuBusRam}
		NuBusRamSize := 0;
		ScionHeight := 128;
		ScionWidth := 128;
		AnalogContrast := 32;
		AnalogBrightness := 32;
		lambda := 0.505;{525 is Green}
		pwidth := 0.2;{measure this with a target slide}
		UserScionBusy := false;
	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 UMscion1200Final;
	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 UMscion1200Add;
	begin
		AddUMSym('s12FindNuBusRam', UserCommandT, s12FindNuBusRamUC);
		AddUMSym('s12GetNBRamBase', UserFuncT, s12GetNBRamBaseUC);
		AddUMSym('s12GetNBRamSize', UserFuncT, s12GetNBRamSizeUC);
		AddUMSym('s12SetNBRamBase', UserCommandT, s12SetNBRamBaseUC);
		AddUMSym('s12SetNBRamSize', UserCommandT, s12SetNBRamSizeUC);
		AddUMSym('s12FakeNBRam', UserCommandT, s12FakeNBRamUC);
		AddUMSym('s12SetHeight', UserCommandT, s12SetHeightUC);
		AddUMSym('s12SetWidth', UserCommandT, s12SetWidthUC);
		AddUMSym('s12SetBright', UserCommandT, s12SetBrightUC);
		AddUMSym('s12SetContrast', UserCommandT, s12SetContrastUC);
		AddUMSym('s12GetHeight', UserFuncT, s12GetHeightUC);
		AddUMSym('s12GetWidth', UserFuncT, s12GetWidthUC);
		AddUMSym('s12GetBright', UserFuncT, s12GetBrightUC);
		AddUMSym('s12GetContrast', UserFuncT, s12GetContrastUC);
		AddUMSym('s12Start30FPS', UserCommandT, s12Start30FPSUC);
		AddUMSym('s12Done30FPS', UserFuncT, s12Done30FPSUC);
		AddUMSym('s12IntegrateFrames', UserCommandT, s12IntegrateFramesUC);
		AddUMSym('s12SmoothReal', UserCommandT, s12SmoothRealUC);
		AddUMSym('s12NumToHex', UserStrFuncT, s12NumToHexUC);
		AddUMSym('s12AddReal', UserCommandT, s12AddRealUC);
		AddUMSym('s12AddRealCons', UserCommandT, s12AddRealConsUC);
		AddUMSym('s12Cnv16ToReal', UserCommandT, s12Cnv16ToRealUC);
		AddUMSym('s12Cnv8ToReal', UserCommandT, s12Cnv8ToRealUC);
		AddUMSym('s12CnvRTo16', UserCommandT, s12CnvRTo16UC);
		AddUMSym('s12CnvRealTo8', UserCommandT, s12CnvRealTo8UC);
		AddUMSym('s12DivReal', UserCommandT, s12DivRealUC);
		AddUMSym('s12DivRealCons', UserCommandT, s12DivRealConsUC);
		AddUMSym('s12LrgReal', UserCommandT, s12LrgRealUC);
		AddUMSym('s12LrgRealCons', UserCommandT, s12LrgRealConsUC);
		AddUMSym('s12MaxReal', UserFuncT, s12MaxRealUC);
		AddUMSym('s12MinReal', UserFuncT, s12MinRealUC);
		AddUMSym('s12MpyReal', UserCommandT, s12MpyRealUC);
		AddUMSym('s12MpyRealCons', UserCommandT, s12MpyRealConsUC);
		AddUMSym('s12SmlReal', UserCommandT, s12SmlRealUC);
		AddUMSym('s12SmlRealCons', UserCommandT, s12SmlRealConsUC);
		AddUMSym('s12SubReal', UserCommandT, s12SubRealUC);
		AddUMSym('s12SubRealCons', UserCommandT, s12SubRealConsUC);
	end;

{Called from procedure LookupUserMacro in UMMacroRun.p}
{This runs every time the macro is executed, just prior to}
{parsing the arguments.}
	procedure UMscion1200Lookup (var uma: UserMacroArgs);
	begin
		with uma do
			case UserMacroCommand of
				s12FindNuBusRamUC:  begin
						nArgs := 0;
					end;
				s12GetNBRamBaseUC:  begin
						nArgs := 0;
					end;
				s12GetNBRamSizeUC:  begin
						nArgs := 0;
					end;
				s12SetNBRamBaseUC:  begin
						nArgs := 1;
						arg[1].atype := UMATreal; {uses real2unsigned}
					end;
				s12SetNBRamSizeUC:  begin
						nArgs := 1;
						arg[1].atype := UMATinteger;
					end;
				s12FakeNBRamUC:  begin
						nArgs := 1;
						arg[1].atype := UMATinteger;
					end;
				s12SetHeightUC:  begin
						nArgs := 1;
						arg[1].atype := UMATinteger;
					end;
				s12SetWidthUC:  begin
						nArgs := 1;
						arg[1].atype := UMATinteger;
					end;
				s12SetBrightUC:  begin
						nArgs := 1;
						arg[1].atype := UMATinteger;
					end;
				s12SetContrastUC:  begin
						nArgs := 1;
						arg[1].atype := UMATinteger;
					end;
				s12GetHeightUC:  begin
						nArgs := 0;
					end;
				s12GetWidthUC:  begin
						nArgs := 0;
					end;
				s12GetBrightUC:  begin
						nArgs := 0;
					end;
				s12GetContrastUC:  begin
						nArgs := 0;
					end;
				s12Start30FPSUC:  begin
						nArgs := 2;
						arg[1].atype := UMATinteger; {start frame buffer number}
						arg[2].atype := UMATinteger; {number of frames}
					end;
				s12Done30FPSUC:  begin
						nArgs := 0;
					end;
				s12IntegrateFramesUC:  begin
						nArgs := 3;
						arg[1].atype := UMATinteger; {start frame buffer number}
						arg[2].atype := UMATinteger; {number of frames}
						arg[3].atype := UMATpic; {output picNumber or pidNumber}
					end;
				s12SmoothRealUC:  begin
						nArgs := 4;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATpic;
						arg[3].atype := UMATreal;{lambda}
						arg[4].atype := UMATreal;{pwidth}
					end;
				s12NumToHexUC:  begin
						nArgs := 1;
						arg[1].atype := UMATinteger;
					end;
				s12AddRealUC, s12DivRealUC, s12LrgRealUC, s12MpyRealUC, s12SmlRealUC, s12SubRealUC:  begin
						nArgs := 3;
						arg[1].atype := UMATpic;{out}
						arg[2].atype := UMATpic;
						arg[3].atype := UMATpic;
					end;
				s12Cnv16ToRealUC, s12Cnv8ToRealUC, s12CnvRTo16UC, s12CnvRealTo8UC:  begin
						nArgs := 2;
						arg[1].atype := UMATpic;{out}
						arg[2].atype := UMATpic;
					end;
				s12AddRealConsUC, s12DivRealConsUC, s12LrgRealConsUC, s12MpyRealConsUC, s12SmlRealConsUC, s12SubRealConsUC:  begin
						nArgs := 3;
						arg[1].atype := UMATpic;{out}
						arg[2].atype := UMATpic;
						arg[3].atype := UMATreal;{cons}
					end;
				s12MaxRealUC, s12MinRealUC:  begin
						nArgs := 1;
						arg[1].atype := UMATpic;{in}
					end;
				otherwise begin
						ErrorOccurred := true;
						str := 'UMscion1200.p LookupUserMacro';
					end;
			end;
	end;


{Find NuBus RAM by asking the slot manager for RAM cards.}
{Output is NuBusRAMSlotBase and NuBusRAMSize}
{FindNuBusRAM is from Scion's "Image 1200 modified"}
{It is similar to the code provided by DayStar and probably works with DayStar}
{Two things are missing compared to DayStar code: }
{(1) does not make certain that spID is actually RAM_Func (128)}
{(2) does not check to see if the board is in use for RAM disk}
	procedure FindNuBusRAM;
		var
			MySpBlock: SpBlock;
			MySInfoRec: SInfoRecord;
			MyErr: OSErr;
	begin
		NuBusRAMSize := 0;
		NuBusRAMSlotBase := 0;
		with MySpBlock do begin
				spSlot := 0;
				spID := 128;
				spExtDev := 0;
				spCategory := 9;
				spCType := 2;
				spTBMask := 0;
				spDrvrSW := $0100;
				spDrvrHW := $0100;
			end;
		MyErr := SNextTypeSRsrc(@MySpBlock);
		if (MyErr <> 0) then begin
				NuBusRAMSize := 0;
				NuBusRAMSlotBase := 0;
				exit(FindNuBusRAM);
			end;
		with MySpBlock do begin
				NuBusRAMSlotBase := BSL(BitAnd(longint(spSlot), $0000000f), 28);
				spResult := longint(@MySInfoRec);
			end;
		MyErr := SReadInfo(@MySpBlock);
		if (MyErr <> 0) then begin
				NuBusRAMSize := 0;
				NuBusRAMSlotBase := 0;
				exit(FindNuBusRAM);
			end;
		with MySInfoRec do
			NuBusRAMSize := longint(siInitStatusV) * 1048576;
	end;

{copied from camera.p}
	procedure SetReg (index, value: integer);
		const
			RegOffset = $f5fe0;
		var
			reg: ptr;
	begin
		reg := ptr(fgSlotBase + RegOffset + index * 4);
		reg^ := value;
	end;

	procedure SetUpScion (DMAStart: LongInt);
		const
			DMAOffset = $e0000;
		var
			temp: longint;
			DMARegPtr: longintPtr;
	begin
		DMARegPtr := pointer(fgSlotBase + DMAOffset);
		temp := BSR(BitAnd(DMAStart, $ff000000), 24);
		temp := temp + BSR(BitAnd(DMAStart, $00ff0000), 8);
		temp := temp + BSL(BitAnd(DMAStart, $0000ff00), 8);
		temp := temp + BSL(BitAnd(DMAStart, $000000ff), 24);
		DMARegPtr^ := temp;
	end;

	procedure ScionResetForDMA;
		const
			LineStartsRamOffset = $f4000;
		type
			LineStartsArray = packed array[0..8191] of UnsignedByte;
			LineStartsType = ^LineStartsArray;
		var
			GrabRect: rect;
			LineStarts: LineStartsType;
			width, height, wwidth, wheight, index, i: integer;
			hstart, vstart: integer;
	begin
		if fgSlotBase = 0 then
			exit(ScionResetForDMA);
		wwidth := ScionWidth;
		wheight := ScionHeight;
		hstart := (640 - wwidth) div 2;
		vstart := (480 - wheight) div 2;
		SetRect(GrabRect, hstart, vstart, hstart + wwidth, vstart + wheight);
		with GrabRect do begin
				hstart := BitAnd(left, $fffc);
				vstart := BitAnd(top, $fffe);
				width := right - left;
				height := bottom - top;
			end;
		Index := 0;
		LineStarts := LineStartsType(fgSlotBase + LineStartsRamOffset);
		for i := 1 to height do begin
				LineStarts^[Index] := 0;
				LineStarts^[Index + 4] := 0;
				LineStarts^[Index + 8] := 0;
				LineStarts^[Index + 12] := 0;
				Index := Index + 16;
			end;
		Index := height * 16;
		LineStarts^[Index] := 0;
		LineStarts^[Index + 4] := 0;
		LineStarts^[Index + 8] := 0;
		LineStarts^[Index + 12] := 1;
		SetReg(0, 0);
		SetReg(1, 0);
		SetReg(2, 161 - (width div 4));
		SetReg(3, 128);
		SetReg(4, 225 - (hstart div 4));
		SetReg(5, 254 - (width div 4));
		SetReg(6, 241 - (vstart div 2));
		SetReg(7, 255 - (height div 2));
		UpdateAnalog(AnalogBrightness, AnalogContrast, fgSlotBase);
	end;

	procedure WaitForEven;
		type
			byteptr = ^byte;

		const
			DestOffset = $f4000;

		var
			bitptr: longintptr;

	begin
		bitptr := longintptr(fgSlotBase + DestOffset);
		if (BitAnd(bitptr^, $00000001) <> 0) then begin
				while (BitAnd(bitptr^, $00000001) <> 0) do begin
					end;
				exit(WaitForEven);
			end
		else begin
				while (BitAnd(bitptr^, $00000001) = 0) do begin
					end;
				while (BitAnd(bitptr^, $00000001) <> 0) do begin
					end;
			end;
	end;

	procedure Start30FPS (StartFrame, NumFrames: Integer; var ErrorStr: Str255);
		var
			wwidth, wheight, BufferLength, StartTime: longint;
			nPixels: LongInt;
			StartFlagLoc, StopFlagLoc: longintPtr;
			Mode: SignedByte;
	begin
		if UserScionBusy then begin
				ErrorStr := 'Scion is already in use by a UserCode macro.';
				exit(Start30FPS);
			end;
		if fgSlotBase = 0 then begin
				ErrorStr := 'There is no Scion 1200 installed.';
				exit(Start30FPS);
			end;
{Really ought to make sure there is a 1200 present, not just any frame grabber...}
		wwidth := ScionWidth;
		wheight := ScionHeight;
		nPixels := wwidth * wheight;
		if StartFrame < 0 then begin
				ErrorStr := 'StartFrame < 0.';
				exit(Start30FPS);
			end;
		if NumFrames < 1 then begin
				ErrorStr := 'NumFrames < 1.';
				exit(Start30FPS);
			end;
		BufferLength := nPixels * LongInt(StartFrame);
		StartFlagLoc := longintPtr(NuBusRAMSlotBase + BufferLength);
		BufferLength := BufferLength + nPixels * LongInt(NumFrames);
		if BufferLength > NuBusRAMSize then begin
				ErrorStr := 'There is not enough NuBus RAM for the specified number of frames.';
				exit(Start30FPS);
			end;
		StopFlagLoc := longintPtr(NuBusRAMSlotBase + BufferLength - 4);
		UserScionBusy := true;
		ScionResetForDMA; {could skip this if guarantee Camera.p wasn't used since last time...}
		SetUpScion(Ord4(StartFlagLoc));
		Mode := 1;
		SwapMMUMode(Mode);
		StartFlagLoc^ := $0f0f0f0f;
		StopFlagLoc^ := $0f0f0f0f;
		StartTime := Ticks;
		SetReg(2, 161 - (wwidth div 4));
		SetReg(5, 254 - (wwidth div 4));
		SetReg(3, 128);
		WaitForEven;
		SetReg(1, 128); { + Shutters}
		while StartFlagLoc^ = $0f0f0f0f do begin
				if Ticks > (StartTime + 5) then begin
						SetReg(1, 0);
						SetReg(3, 0);
						SetReg(2, 162 - (wwidth div 4));
						SetReg(5, 255 - (wwidth div 4));
						SwapMMUMode(Mode);
						ErrorStr := 'Valid video does not seem to be present.';
						UserScionBusy := false;
						exit(Start30FPS);
					end;
			end;
		StartTime := Ticks;
		while StopFlagLoc^ = $0f0f0f0f do begin
				if Ticks > (StartTime + ((NumFrames + 10) * 2)) then begin
						SetReg(1, 0);
						SetReg(3, 0);
						SetReg(2, 162 - (wwidth div 4));
						SetReg(5, 255 - (wwidth div 4));
						SwapMMUMode(Mode);
						ErrorStr := 'Capturing has timed out for some reason.';
						UserScionBusy := false;
						exit(Start30FPS);
					end;
			end;
		SetReg(1, 0);
		SetReg(3, 0);
		SetReg(2, 162 - (wwidth div 4));
		SetReg(5, 255 - (wwidth div 4));
		SwapMMUMode(Mode);
		UserScionBusy := false;
	end;

{This also allows for interleaved video signal}
	procedure DoIntegrate (inp: pup; outp: puip; nPixels, ppl, NumFrames: Longint);
		var
			l, n: LongInt;
			op: puip;
			oddp: pup;
	begin
		op := outp;
		n := nPixels;
		while n > 0 do begin
				op^.u := 0;
				op := puip(Ord4(op) + sizeof(Integer));
				n := n - 1;
			end;
		oddp := inp;
		while NumFrames > 0 do begin
				NumFrames := NumFrames - 1;
				op := outp;
				n := nPixels div ppl div 2;
				inp := oddp;
				oddp := pup(Ord4(inp) + nPixels div 2);
				while n > 0 do begin
						l := ppl;
						while l > 0 do begin
								op^.u := op^.u + inp^.u;
								op := puip(Ord4(op) + sizeof(Integer));
								inp := pup(Ord4(inp) + 1);
								l := l - 1;
							end;
						l := ppl;
						while l > 0 do begin
								op^.u := op^.u + oddp^.u;
								op := puip(Ord4(op) + sizeof(Integer));
								oddp := pup(Ord4(oddp) + 1);
								l := l - 1;
							end;
						n := n - 1;
					end;
			end;
	end;

	procedure IntegrateFrames (StartFrame, NumFrames: Integer; outinfo: InfoPtr; var ErrorStr: Str255);
		var
			wwidth, wheight, BufferLength: longint;
			Mode: SignedByte;
			nPixels, ppl: LongInt;
			inp: pup;
			outp: puip;
	begin
		wwidth := ScionWidth;
		wheight := ScionHeight;
		nPixels := wwidth * wheight;
		if StartFrame < 0 then begin
				ErrorStr := 'StartFrame < 0.';
				exit(IntegrateFrames);
			end;
		if NumFrames < 1 then begin
				ErrorStr := 'NumFrames < 1.';
				exit(IntegrateFrames);
			end;
		BufferLength := nPixels * LongInt(StartFrame);
		inp := pup(NuBusRAMSlotBase + BufferLength);
		BufferLength := BufferLength + nPixels * LongInt(NumFrames);
		if BufferLength > NuBusRAMSize then begin
				ErrorStr := 'There is not enough NuBus RAM for the specified number of frames . ';
				exit(IntegrateFrames);
			end;
		outp := nil;
		if outInfo <> nil then
			if outInfo^.PixelsPerLine = outInfo^.BytesPerRow then
				if outInfo^.PixelsPerLine = wwidth * sizeof(Integer) then
					if outInfo^.nlines = wheight then begin
							outp := puip(outInfo^.PicBaseAddr);
						end;
		if outp = nil then begin
				ErrorStr := 'Unsuitable output image window.';
				exit(IntegrateFrames);
			end;
		Mode := 1;
		SwapMMUMode(Mode);
		ppl := wwidth;
		doIntegrate(inp, outp, nPixels, ppl, NumFrames);
		SwapMMUMode(Mode);
	end;

	function real2unsigned (r: extended): LongInt;
	begin
		if r < 2147483648.0 then
			real2unsigned := trunc(r)
		else
			real2unsigned := trunc(r - 4294967296.0);
	end;

{rewrite or replace with a built in}
	procedure hexstr (v: LongInt; var str: str255);
		var
			i: integer;
			hex: string[16];
	begin
		i := 32;
		str := '';
		hex := '0123456789ABCDEF';
		repeat
			i := i - 4;
			str := concat(str, hex[band(bsr(v, i), 15) + 1]);
		until i = 0;
	end;

	procedure ValidateInReal (inaInfo: infoPtr; var inap: RealPtr; var nPixels: LongInt);
	begin
		nPixels := 0;
		inap := nil;
		if inaInfo <> nil then
			if inaInfo^.PixelsPerLine = inaInfo^.BytesPerRow then
				if inaInfo^.PixelsPerLine mod sizeof(Real) = 0 then begin
						nPixels := inaInfo^.PixelsPerLine div sizeof(Real);
						nPixels := nPixels * inaInfo^.nlines;
						inap := RealPtr(inaInfo^.PicBaseAddr);
					end;
	end;

	procedure validateReal (outInfo, inaInfo: infoPtr; var outp, inap: RealPtr; var nPixels: LongInt);
	begin
		nPixels := 0;
		outp := nil;
		inap := nil;
		if outInfo <> nil then
			if inaInfo <> nil then
				if outInfo^.PixelsPerLine = outInfo^.BytesPerRow then
					if inaInfo^.PixelsPerLine = inaInfo^.BytesPerRow then
						if outInfo^.PixelsPerLine = inaInfo^.PixelsPerLine then
							if outInfo^.nlines = inaInfo^.nlines then
								if outInfo^.PixelsPerLine mod sizeof(Real) = 0 then begin
										nPixels := outInfo^.PixelsPerLine div sizeof(Real);
										nPixels := nPixels * outInfo^.nlines;
										outp := RealPtr(outInfo^.PicBaseAddr);
										inap := RealPtr(inaInfo^.PicBaseAddr);
									end;
	end;

	procedure validateRealPair (outInfo, inaInfo, inbInfo: infoPtr; var outp, inap, inbp: RealPtr; var nPixels: LongInt);
	begin
		nPixels := 0;
		outp := nil;
		inap := nil;
		inbp := nil;
		if outInfo <> nil then
			if inaInfo <> nil then
				if inbInfo <> nil then
					if outInfo^.PixelsPerLine = outInfo^.BytesPerRow then
						if inaInfo^.PixelsPerLine = inaInfo^.BytesPerRow then
							if inbInfo^.PixelsPerLine = inbInfo^.BytesPerRow then
								if outInfo^.PixelsPerLine = inaInfo^.PixelsPerLine then
									if outInfo^.PixelsPerLine = inbInfo^.PixelsPerLine then
										if outInfo^.nlines = inaInfo^.nlines then
											if outInfo^.nlines = inbInfo^.nlines then
												if outInfo^.PixelsPerLine mod sizeof(Real) = 0 then begin
														nPixels := outInfo^.PixelsPerLine div sizeof(Real);
														nPixels := nPixels * outInfo^.nlines;
														outp := RealPtr(outInfo^.PicBaseAddr);
														inap := RealPtr(inaInfo^.PicBaseAddr);
														inbp := RealPtr(inbInfo^.PicBaseAddr);
													end;
	end;

	procedure validateRealTo8 (outInfo, inaInfo: infoPtr; var outp: pup; var inap: RealPtr; var nPixels: LongInt);
	begin
		nPixels := 0;
		outp := nil;
		inap := nil;
		if outInfo <> nil then
			if inaInfo <> nil then
				if outInfo^.PixelsPerLine = outInfo^.BytesPerRow then
					if inaInfo^.PixelsPerLine = inaInfo^.BytesPerRow then
						if outInfo^.PixelsPerLine * sizeof(Real) = inaInfo^.PixelsPerLine then
							if outInfo^.nlines = inaInfo^.nlines then begin
									nPixels := outInfo^.PixelsPerLine;
									nPixels := nPixels * outInfo^.nlines;
									outp := pup(outInfo^.PicBaseAddr);
									inap := RealPtr(inaInfo^.PicBaseAddr);
								end;
	end;

	procedure validateRealTo16 (outInfo, inaInfo: infoPtr; var outp: puip; var inap: RealPtr; var nPixels: LongInt);
	begin
		nPixels := 0;
		outp := nil;
		inap := nil;
		if outInfo <> nil then
			if inaInfo <> nil then
				if outInfo^.PixelsPerLine = outInfo^.BytesPerRow then
					if outInfo^.PixelsPerLine mod sizeof(Integer) = 0 then
						if inaInfo^.PixelsPerLine = inaInfo^.BytesPerRow then
							if outInfo^.PixelsPerLine * (sizeof(Real) div sizeof(Integer)) = inaInfo^.PixelsPerLine then
								if outInfo^.nlines = inaInfo^.nlines then begin
										nPixels := outInfo^.PixelsPerLine div sizeof(Integer);
										nPixels := nPixels * outInfo^.nlines;
										outp := puip(outInfo^.PicBaseAddr);
										inap := RealPtr(inaInfo^.PicBaseAddr);
									end;
	end;

	procedure validate8ToReal (outInfo, inaInfo: infoPtr; var outp: RealPtr; var inap: pup; var nPixels: LongInt);
	begin
		nPixels := 0;
		outp := nil;
		inap := nil;
		if outInfo <> nil then
			if inaInfo <> nil then
				if outInfo^.PixelsPerLine = outInfo^.BytesPerRow then
					if inaInfo^.PixelsPerLine = inaInfo^.BytesPerRow then
						if outInfo^.PixelsPerLine = inaInfo^.PixelsPerLine * sizeof(Real) then
							if outInfo^.nlines = inaInfo^.nlines then begin
									nPixels := inaInfo^.PixelsPerLine;
									nPixels := nPixels * outInfo^.nlines;
									outp := RealPtr(outInfo^.PicBaseAddr);
									inap := pup(inaInfo^.PicBaseAddr);
								end;
	end;

	procedure validate16ToReal (outInfo, inaInfo: infoPtr; var outp: RealPtr; var inap: puip; var nPixels: LongInt);
	begin
		nPixels := 0;
		outp := nil;
		inap := nil;
		if outInfo <> nil then
			if inaInfo <> nil then
				if outInfo^.PixelsPerLine = outInfo^.BytesPerRow then
					if inaInfo^.PixelsPerLine = inaInfo^.BytesPerRow then
						if inaInfo^.PixelsPerLine mod sizeof(Integer) = 0 then
							if outInfo^.PixelsPerLine = inaInfo^.PixelsPerLine * (sizeof(Real) div sizeof(Integer)) then
								if outInfo^.nlines = inaInfo^.nlines then begin
										nPixels := inaInfo^.PixelsPerLine div sizeof(Integer);
										nPixels := nPixels * outInfo^.nlines;
										outp := RealPtr(outInfo^.PicBaseAddr);
										inap := puip(inaInfo^.PicBaseAddr);
									end;
	end;

	procedure validate16To8 (outInfo, inaInfo: infoPtr; var outp: pup; var inap: puip; var nPixels: LongInt);
	begin
		nPixels := 0;
		outp := nil;
		inap := nil;
		if outInfo <> nil then
			if inaInfo <> nil then
				if outInfo^.PixelsPerLine = outInfo^.BytesPerRow then
					if inaInfo^.PixelsPerLine = inaInfo^.BytesPerRow then
						if outInfo^.PixelsPerLine * sizeof(Integer) = inaInfo^.PixelsPerLine then
							if outInfo^.nlines = inaInfo^.nlines then begin
									nPixels := outInfo^.PixelsPerLine;
									nPixels := nPixels * outInfo^.nlines;
									outp := pup(outInfo^.PicBaseAddr);
									inap := puip(inaInfo^.PicBaseAddr);
								end;
	end;

	procedure validate8To16 (outInfo, inaInfo: infoPtr; var outp: puip; var inap: pup; var nPixels: LongInt);
	begin
		nPixels := 0;
		outp := nil;
		inap := nil;
		if outInfo <> nil then
			if inaInfo <> nil then
				if outInfo^.PixelsPerLine = outInfo^.BytesPerRow then
					if inaInfo^.PixelsPerLine = inaInfo^.BytesPerRow then
						if outInfo^.PixelsPerLine = inaInfo^.PixelsPerLine * sizeof(Integer) then
							if outInfo^.nlines = inaInfo^.nlines then begin
									nPixels := inaInfo^.PixelsPerLine;
									nPixels := nPixels * outInfo^.nlines;
									outp := puip(outInfo^.PicBaseAddr);
									inap := pup(inaInfo^.PicBaseAddr);
								end;
	end;

	procedure AddReal (outp, inap, inbp: RealPtr; nPixels: LongInt);
	begin
		while nPixels > 0 do begin
				outp^ := inap^ + inbp^;
				outp := RealPtr(Ord4(outp) + sizeof(Real));
				inap := RealPtr(Ord4(inap) + sizeof(Real));
				inbp := RealPtr(Ord4(inbp) + sizeof(Real));
				nPixels := nPixels - 1;
			end;
	end;

	procedure SubReal (outp, inap, inbp: RealPtr; nPixels: LongInt);
	begin
		while nPixels > 0 do begin
				outp^ := inap^ - inbp^;
				outp := RealPtr(Ord4(outp) + sizeof(Real));
				inap := RealPtr(Ord4(inap) + sizeof(Real));
				inbp := RealPtr(Ord4(inbp) + sizeof(Real));
				nPixels := nPixels - 1;
			end;
	end;

	procedure MpyReal (outp, inap, inbp: RealPtr; nPixels: LongInt);
	begin
		while nPixels > 0 do begin
				outp^ := inap^ * inbp^;
				outp := RealPtr(Ord4(outp) + sizeof(Real));
				inap := RealPtr(Ord4(inap) + sizeof(Real));
				inbp := RealPtr(Ord4(inbp) + sizeof(Real));
				nPixels := nPixels - 1;
			end;
	end;

	procedure DivReal (outp, inap, inbp: RealPtr; nPixels: LongInt);
	begin
		while nPixels > 0 do begin
				outp^ := inap^ / inbp^;
				outp := RealPtr(Ord4(outp) + sizeof(Real));
				inap := RealPtr(Ord4(inap) + sizeof(Real));
				inbp := RealPtr(Ord4(inbp) + sizeof(Real));
				nPixels := nPixels - 1;
			end;
	end;

	procedure SmlReal (outp, inap, inbp: RealPtr; nPixels: LongInt);
	begin
		while nPixels > 0 do begin
				if inap^ < inbp^ then
					outp^ := inap^
				else
					outp^ := inbp^;
				outp := RealPtr(Ord4(outp) + sizeof(Real));
				inap := RealPtr(Ord4(inap) + sizeof(Real));
				inbp := RealPtr(Ord4(inbp) + sizeof(Real));
				nPixels := nPixels - 1;
			end;
	end;

	procedure LrgReal (outp, inap, inbp: RealPtr; nPixels: LongInt);
	begin
		while nPixels > 0 do begin
				if inap^ < inbp^ then
					outp^ := inbp^
				else
					outp^ := inap^;
				outp := RealPtr(Ord4(outp) + sizeof(Real));
				inap := RealPtr(Ord4(inap) + sizeof(Real));
				inbp := RealPtr(Ord4(inbp) + sizeof(Real));
				nPixels := nPixels - 1;
			end;
	end;

	procedure AddRealCons (outp, inap: RealPtr; cons: Real; nPixels: LongInt);
	begin
		while nPixels > 0 do begin
				outp^ := inap^ + cons;
				outp := RealPtr(Ord4(outp) + sizeof(Real));
				inap := RealPtr(Ord4(inap) + sizeof(Real));
				nPixels := nPixels - 1;
			end;
	end;

	procedure MpyRealCons (outp, inap: RealPtr; cons: Real; nPixels: LongInt);
	begin
		while nPixels > 0 do begin
				outp^ := inap^ * cons;
				outp := RealPtr(Ord4(outp) + sizeof(Real));
				inap := RealPtr(Ord4(inap) + sizeof(Real));
				nPixels := nPixels - 1;
			end;
	end;

	procedure SmlRealCons (outp, inap: RealPtr; cons: Real; nPixels: LongInt);
	begin
		while nPixels > 0 do begin
				if inap^ < cons then
					outp^ := inap^
				else
					outp^ := cons;
				outp := RealPtr(Ord4(outp) + sizeof(Real));
				inap := RealPtr(Ord4(inap) + sizeof(Real));
				nPixels := nPixels - 1;
			end;
	end;

	procedure LrgRealCons (outp, inap: RealPtr; cons: Real; nPixels: LongInt);
	begin
		while nPixels > 0 do begin
				if inap^ < cons then
					outp^ := cons
				else
					outp^ := inap^;
				outp := RealPtr(Ord4(outp) + sizeof(Real));
				inap := RealPtr(Ord4(inap) + sizeof(Real));
				nPixels := nPixels - 1;
			end;
	end;

	procedure MinReal (inap: RealPtr; nPixels: Longint; var result: extended);
		var
			r: real;
	begin
		r := inap^;
		while nPixels > 0 do begin
				if inap^ < r then
					r := inap^;
				inap := RealPtr(Ord4(inap) + sizeof(Real));
				nPixels := nPixels - 1;
			end;
		result := r;
	end;

	procedure MaxReal (inap: RealPtr; nPixels: Longint; var result: extended);
		var
			r: real;
	begin
		r := inap^;
		while nPixels > 0 do begin
				if inap^ > r then
					r := inap^;
				inap := RealPtr(Ord4(inap) + sizeof(Real));
				nPixels := nPixels - 1;
			end;
		result := r;
	end;

{restrictions:  real is already scaled to 0..255, }
{and 8 bit image has PixelsPerLine = BytesPerRow}
	procedure CnvRealTo8 (outp: pup; inap: RealPtr; nPixels: LongInt);
	begin
		while nPixels > 0 do begin
				outp^.u := round(inap^);
				outp := pup(Ord4(outp) + 1);
				inap := RealPtr(Ord4(inap) + sizeof(Real));
				nPixels := nPixels - 1;
			end;
	end;

{restriction:  8 bit image has PixelsPerLine = BytesPerRow}
	procedure Cnv8ToReal (outp: RealPtr; inap: pup; nPixels: LongInt);
	begin
		while nPixels > 0 do begin
				outp^ := inap^.u;
				outp := RealPtr(Ord4(outp) + sizeof(Real));
				inap := pup(Ord4(inap) + 1);
				nPixels := nPixels - 1;
			end;
	end;

{restrictions:  real is already scaled to 0..65535, }
{and 16 bit image has PixelsPerLine = BytesPerRow}
	procedure CnvRealTo16 (outp: puip; inap: RealPtr; nPixels: LongInt);
	begin
		while nPixels > 0 do begin
				outp^.u := round(inap^);
				outp := puip(Ord4(outp) + sizeof(Integer));
				inap := RealPtr(Ord4(inap) + sizeof(Real));
				nPixels := nPixels - 1;
			end;
	end;

{restriction:  16 bit image has PixelsPerLine = BytesPerRow}
	procedure Cnv16ToReal (outp: RealPtr; inap: puip; nPixels: LongInt);
	begin
		while nPixels > 0 do begin
				outp^ := inap^.u;
				outp := RealPtr(Ord4(outp) + sizeof(Real));
				inap := puip(Ord4(inap) + sizeof(Integer));
				nPixels := nPixels - 1;
			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 UMscion1200Run (var uma: UserMacroArgs);
		var
			ErrorStr: Str255;
			outrp, inarp, inbrp: RealPtr;
			out8p, ina8p, inb8p: pup;
			out16p, ina16p, inb16p: puip;
			nPixels: LongInt;
	begin
		ErrorStr := '';
		with uma do begin
				case UserMacroCommand of
					s12FindNuBusRamUC:  begin
							FindNuBusRam;
						end;
					s12GetNBRamBaseUC:  begin
							FuncResult := NuBusRAMSlotBase;
						end;
					s12GetNBRamSizeUC:  begin
							FuncResult := NuBusRAMSize;
						end;
					s12SetNBRamBaseUC:  begin
							NuBusRAMSlotBase := real2unsigned(round(arg[1].aval));
						end;
					s12SetNBRamSizeUC:  begin
							NuBusRAMSize := arg[1].ival;
						end;
					s12FakeNBRamUC:  begin
            {no provision for deallocating this, for testing on machine with no RAM card only}
							NuBusRAMSize := arg[1].ival;
							NuBusRAMSlotBase := LongInt(newptr(NuBusRAMSize));
							if NuBusRAMSlotBase = 0 then begin
									NuBusRAMSize := 0;
									errorOccurred := true;
									str := 'Out of memory';
								end;
						end;
					s12SetHeightUC:  begin
							if odd(arg[1].ival) or (arg[1].ival < 30) or (arg[1].ival > 438) then begin
									ErrorOccurred := true;
									str := 'Scion Height must be even and 30..438'
								end
							else
								ScionHeight := arg[1].ival;
						end;
					s12SetWidthUC:  begin
							if (BitAnd(arg[1].ival, 3) <> 0) or (arg[1].ival < 40) or (arg[1].ival > 584) then begin
									ErrorOccurred := true;
									str := 'Scion width must be a multiple of four and 40..584'
								end
							else
								ScionWidth := arg[1].ival;
						end;
					s12SetBrightUC:  begin
							if (0 <= arg[1].ival) and (arg[1].ival <= 63) then
								AnalogBrightness := arg[1].ival
							else begin
									ErrorOccurred := true;
									str := 'Analog Brightness must be 0..63';
								end;
						end;
					s12SetContrastUC:  begin
							if (0 <= arg[1].ival) and (arg[1].ival <= 63) then
								AnalogContrast := arg[1].ival
							else begin
									ErrorOccurred := true;
									str := 'Analog Contrast must be 0..63';
								end;
						end;
					s12GetHeightUC:  begin
							FuncResult := ScionHeight;
						end;
					s12GetWidthUC:  begin
							FuncResult := ScionWidth;
						end;
					s12GetBrightUC:  begin
							FuncResult := AnalogBrightness;
						end;
					s12GetContrastUC:  begin
							FuncResult := AnalogContrast;
						end;
					s12Start30FPSUC:  begin
							str := '';
							Start30FPS(arg[1].ival, arg[2].ival, str);
							if str <> '' then
								ErrorOccurred := true;
						end;
					s12Done30FPSUC:  begin
							FuncResult := ord(true);
						end;
					s12IntegrateFramesUC:  begin
							str := '';
							if arg[3].wasRoi then
								str := 'selection not allowed.'
							else
								IntegrateFrames(arg[1].ival, arg[2].ival, arg[3].infop, str);
							if str <> '' then
								ErrorOccurred := true;
						end;
					s12SmoothRealUC:  begin
							ErrorOccurred := true;
							str := 'not finished';
						end;
					s12NumToHexUC:  begin
							hexstr(arg[1].ival, str);
						end;
					s12Cnv8ToRealUC:  begin
							if arg[1].wasRoi or arg[2].wasRoi then
								nPixels := 0
							else
								Validate8ToReal(arg[1].infop, arg[2].infop, outrp, ina8p, nPixels);
							if nPixels = 0 then
								ErrorStr := 'Cnv8ToReal fail.'
							else
								Cnv8ToReal(outrp, ina8p, nPixels);
						end;
					s12CnvRealTo8UC:  begin
							if arg[1].wasRoi or arg[2].wasRoi then
								nPixels := 0
							else
								ValidateRealTo8(arg[1].infop, arg[2].infop, out8p, inarp, nPixels);
							if nPixels = 0 then
								ErrorStr := 'CnvRealTo8 fail.'
							else
								CnvRealTo8(out8p, inarp, nPixels);
						end;
					s12Cnv16ToRealUC:  begin
							if arg[1].wasRoi or arg[2].wasRoi then
								nPixels := 0
							else
								Validate16ToReal(arg[1].infop, arg[2].infop, outrp, ina16p, nPixels);
							if nPixels = 0 then
								ErrorStr := 'Cnv16ToReal fail.'
							else
								Cnv16ToReal(outrp, ina16p, nPixels);
						end;
					s12CnvRTo16UC:  begin
							if arg[1].wasRoi or arg[2].wasRoi then
								nPixels := 0
							else
								ValidateRealTo16(arg[1].infop, arg[2].infop, out16p, inarp, nPixels);
							if nPixels = 0 then
								ErrorStr := 'CnvRealTo16 fail.'
							else
								CnvRealTo16(out16p, inarp, nPixels);
						end;
					s12AddRealUC:  begin
							if arg[1].wasRoi or arg[2].wasRoi or arg[3].wasRoi then
								nPixels := 0
							else
								ValidateRealPair(arg[1].infop, arg[2].infop, arg[3].infop, outrp, inarp, inbrp, nPixels);
							if nPixels = 0 then
								ErrorStr := 'AddReal fail.'
							else
								AddReal(outrp, inarp, inbrp, nPixels);
						end;
					s12AddRealConsUC:  begin
							if arg[1].wasRoi or arg[2].wasRoi then
								nPixels := 0
							else
								ValidateReal(arg[1].infop, arg[2].infop, outrp, inarp, nPixels);
							if nPixels = 0 then
								ErrorStr := 'AddRealCons fail.'
							else
								AddRealCons(outrp, inarp, arg[3].aval, nPixels);
						end;
					s12MpyRealUC:  begin
							if arg[1].wasRoi or arg[2].wasRoi or arg[3].wasRoi then
								nPixels := 0
							else
								ValidateRealPair(arg[1].infop, arg[2].infop, arg[3].infop, outrp, inarp, inbrp, nPixels);
							if nPixels = 0 then
								ErrorStr := 'MpyReal fail.'
							else
								MpyReal(outrp, inarp, inbrp, nPixels);
						end;
					s12MpyRealConsUC:  begin
							if arg[1].wasRoi or arg[2].wasRoi then
								nPixels := 0
							else
								ValidateReal(arg[1].infop, arg[2].infop, outrp, inarp, nPixels);
							if nPixels = 0 then
								ErrorStr := 'MpyRealCons fail.'
							else
								MpyRealCons(outrp, inarp, arg[3].aval, nPixels);
						end;
					s12SubRealUC:  begin
							if arg[1].wasRoi or arg[2].wasRoi or arg[3].wasRoi then
								nPixels := 0
							else
								ValidateRealPair(arg[1].infop, arg[2].infop, arg[3].infop, outrp, inarp, inbrp, nPixels);
							if nPixels = 0 then
								ErrorStr := 'SubReal fail.'
							else
								SubReal(outrp, inarp, inbrp, nPixels);
						end;
					s12SubRealConsUC:  begin
							if arg[1].wasRoi or arg[2].wasRoi then
								nPixels := 0
							else
								ValidateReal(arg[1].infop, arg[2].infop, outrp, inarp, nPixels);
							if nPixels = 0 then
								ErrorStr := 'SubRealCons fail.'
							else
								AddRealCons(outrp, inarp, -arg[3].aval, nPixels);
						end;
					s12DivRealUC:  begin
							if arg[1].wasRoi or arg[2].wasRoi or arg[3].wasRoi then
								nPixels := 0
							else
								ValidateRealPair(arg[1].infop, arg[2].infop, arg[3].infop, outrp, inarp, inbrp, nPixels);
							if nPixels = 0 then
								ErrorStr := 'DivReal fail.'
							else
								DivReal(outrp, inarp, inbrp, nPixels);
						end;
					s12DivRealConsUC:  begin
							if arg[1].wasRoi or arg[2].wasRoi then
								nPixels := 0
							else
								ValidateReal(arg[1].infop, arg[2].infop, outrp, inarp, nPixels);
							if nPixels = 0 then
								ErrorStr := 'DivRealCons fail.'
							else
								MpyRealCons(outrp, inarp, 1.0 / arg[3].aval, nPixels);
						end;
					s12MinRealUC:  begin
							if arg[1].wasRoi then
								nPixels := 0
							else
								ValidateInReal(arg[1].infop, inarp, nPixels);
							if nPixels = 0 then
								ErrorStr := 'MinReal fail.'
							else
								MinReal(inarp, nPixels, FuncResult);
						end;
					s12MaxRealUC:  begin
							if arg[1].wasRoi then
								nPixels := 0
							else
								ValidateInReal(arg[1].infop, inarp, nPixels);
							if nPixels = 0 then
								ErrorStr := 'MaxReal fail.'
							else
								MaxReal(inarp, nPixels, FuncResult);
						end;
					s12SmlRealUC:  begin
							if arg[1].wasRoi or arg[2].wasRoi or arg[3].wasRoi then
								nPixels := 0
							else
								ValidateRealPair(arg[1].infop, arg[2].infop, arg[3].infop, outrp, inarp, inbrp, nPixels);
							if nPixels = 0 then
								ErrorStr := 'SmlReal fail.'
							else
								SmlReal(outrp, inarp, inbrp, nPixels);
						end;
					s12SmlRealConsUC:  begin
							if arg[1].wasRoi or arg[2].wasRoi then
								nPixels := 0
							else
								ValidateReal(arg[1].infop, arg[2].infop, outrp, inarp, nPixels);
							if nPixels = 0 then
								ErrorStr := 'SmlRealCons fail.'
							else
								SmlRealCons(outrp, inarp, arg[3].aval, nPixels);
						end;
					s12LrgRealUC:  begin
							if arg[1].wasRoi or arg[2].wasRoi or arg[3].wasRoi then
								nPixels := 0
							else
								ValidateRealPair(arg[1].infop, arg[2].infop, arg[3].infop, outrp, inarp, inbrp, nPixels);
							if nPixels = 0 then
								ErrorStr := 'LrgReal fail.'
							else
								LrgReal(outrp, inarp, inbrp, nPixels);
						end;
					s12LrgRealConsUC:  begin
							if arg[1].wasRoi or arg[2].wasRoi then
								nPixels := 0
							else
								ValidateReal(arg[1].infop, arg[2].infop, outrp, inarp, nPixels);
							if nPixels = 0 then
								ErrorStr := 'LrgRealCons fail.'
							else
								LrgRealCons(outrp, inarp, arg[3].aval, nPixels);
						end;
					otherwise begin
							ErrorOccurred := true;
							str := 'UMscion1200.p DoUserMacro';
						end;
				end;
				if ErrorStr <> '' then begin
						ErrorOccurred := true;
						str := ErrorStr;
					end;
			end;
	end;

end.