unit UMGetPutPx;

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

{Macros using these functions should specify "requiresUser('GetPutPixel',1);" }

interface

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

	procedure UMGetPutPxInit;
	procedure UMGetPutPxFinal;
	procedure UMGetPutPxAdd;
	procedure UMGetPutPxLookup (var uma: UserMacroArgs);
	procedure UMGetPutPxRun (var uma: UserMacroArgs);
implementation

	type
		u8r = packed record
				u: 0..255;
			end;
		u8p = ^u8r;
		u16r = packed record
				u: 0..65535;
			end;
		u16p = ^u16r;
		s16p = ^Integer;
		s32p = ^LongInt;
		r32p = ^Real;
		r96p = ^Extended; {?depends on compiler settings...???}

	procedure UMGetPutPxInit;
	begin
	end;

	procedure UMGetPutPxFinal;
	begin
	end;

	procedure UMGetPutPxAdd;
	begin
		AddUMSym('getPixel8', UserFuncT, getPixel8UC);
		AddUMSym('getPixVec8', UserFuncT, getPixVec8UC);
		AddUMSym('putPixel8', UserCommandT, putPixel8UC);
		AddUMSym('putPixVec8', UserCommandT, putPixVec8UC);
		AddUMSym('getPixel16u', UserFuncT, getPixel16uUC);
		AddUMSym('getPixVec16u', UserFuncT, getPixVec16uUC);
		AddUMSym('putPixel16u', UserCommandT, putPixel16uUC);
		AddUMSym('putPixVec16u', UserCommandT, putPixVec16uUC);
		AddUMSym('getPixel16s', UserFuncT, getPixel16sUC);
		AddUMSym('getPixVec16s', UserFuncT, getPixVec16sUC);
		AddUMSym('putPixel16s', UserCommandT, putPixel16sUC);
		AddUMSym('putPixVec16s', UserCommandT, putPixVec16sUC);
		AddUMSym('getPixel32s', UserFuncT, getPixel32sUC);
		AddUMSym('getPixVec32s', UserFuncT, getPixVec32sUC);
		AddUMSym('putPixel32s', UserCommandT, putPixel32sUC);
		AddUMSym('putPixVec32s', UserCommandT, putPixVec32sUC);
		AddUMSym('getPixel32r', UserFuncT, getPixel32rUC);
		AddUMSym('getPixVec32r', UserFuncT, getPixVec32rUC);
		AddUMSym('putPixel32r', UserCommandT, putPixel32rUC);
		AddUMSym('putPixVec32r', UserCommandT, putPixVec32rUC);
		AddUMSym('getPixel96r', UserFuncT, getPixel96rUC);
		AddUMSym('getPixVec96r', UserFuncT, getPixVec96rUC);
		AddUMSym('putPixel96r', UserCommandT, putPixel96rUC);
		AddUMSym('putPixVec96r', UserCommandT, putPixVec96rUC);
	end;


	procedure UMGetPutPxLookup (var uma: UserMacroArgs);
	begin
		with uma do
			case UserMacroCommand of
				getPixel8UC:  begin
						nargs := 3;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
					end;
				getPixVec8UC:  begin
						nargs := 2;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
					end;
				putPixel8UC:  begin
						nargs := 4;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
						arg[4].atype := UMATinteger;
					end;
				putPixVec8UC:  begin
						nargs := 3;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
					end;
				getPixel16uUC:  begin
						nargs := 3;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
					end;
				getPixVec16uUC:  begin
						nargs := 2;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
					end;
				putPixel16uUC:  begin
						nargs := 4;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
						arg[4].atype := UMATinteger;
					end;
				putPixVec16uUC:  begin
						nargs := 3;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
					end;
				getPixel16sUC:  begin
						nargs := 3;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
					end;
				getPixVec16sUC:  begin
						nargs := 2;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
					end;
				putPixel16sUC:  begin
						nargs := 4;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
						arg[4].atype := UMATinteger;
					end;
				putPixVec16sUC:  begin
						nargs := 3;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
					end;
				getPixel32sUC:  begin
						nargs := 3;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
					end;
				getPixVec32sUC:  begin
						nargs := 2;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
					end;
				putPixel32sUC:  begin
						nargs := 4;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
						arg[4].atype := UMATinteger;
					end;
				putPixVec32sUC:  begin
						nargs := 3;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
					end;
				getPixel32rUC:  begin
						nargs := 3;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
					end;
				getPixVec32rUC:  begin
						nargs := 2;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
					end;
				putPixel32rUC:  begin
						nargs := 4;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
						arg[4].atype := UMATinteger;
					end;
				putPixVec32rUC:  begin
						nargs := 3;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
					end;
				getPixel96rUC:  begin
						nargs := 3;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
					end;
				getPixVec96rUC:  begin
						nargs := 2;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
					end;
				putPixel96rUC:  begin
						nargs := 4;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
						arg[4].atype := UMATinteger;
					end;
				putPixVec96rUC:  begin
						nargs := 3;
						arg[1].atype := UMATpic;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
					end;
				otherwise begin
						ErrorOccurred := true;
						str := 'UMGetPutPx.p';
					end;
			end;
	end;


	procedure UMGetPutPxRun (var uma: UserMacroArgs);
		var
			h, v, n, minv, maxv: LongInt;
			p8: u8p;
			p16u: u16p;
			p16s: s16p;
			p32s: s32p;
			p32r: r32p;
			p96r: r96p;
	begin
		with uma do
			case UserMacroCommand of
				getPixel8UC:  begin
						FuncResult := BackgroundIndex;
						h := arg[2].ival * 1;
						v := arg[3].ival;
						with arg[1].infop^ do
							if h >= 0 then
								if v >= 0 then
									if h < PixelsPerLine then
										if v < nlines then
											FuncResult := u8p(Ord4(PicBaseAddr) + v * BytesPerRow + h)^.u;
					end;
				getPixel16uUC:  begin
						FuncResult := BackgroundIndex;
						h := arg[2].ival * 2;
						v := arg[3].ival;
						with arg[1].infop^ do
							if h >= 0 then
								if v >= 0 then
									if h + 1 < PixelsPerLine then
										if v < nlines then
											FuncResult := u16p(Ord4(PicBaseAddr) + v * BytesPerRow + h)^.u;
					end;
				getPixel16sUC:  begin
						FuncResult := BackgroundIndex;
						h := arg[2].ival * 2;
						v := arg[3].ival;
						with arg[1].infop^ do
							if h >= 0 then
								if v >= 0 then
									if h + 1 < PixelsPerLine then
										if v < nlines then
											FuncResult := s16p(Ord4(PicBaseAddr) + v * BytesPerRow + h)^;
					end;
				getPixel32sUC:  begin
						FuncResult := BackgroundIndex;
						h := arg[2].ival * 4;
						v := arg[3].ival;
						with arg[1].infop^ do
							if h >= 0 then
								if v >= 0 then
									if h + 3 < PixelsPerLine then
										if v < nlines then
											FuncResult := s32p(Ord4(PicBaseAddr) + v * BytesPerRow + h)^;
					end;
				getPixel32rUC:  begin
						FuncResult := BackgroundIndex;
						h := arg[2].ival * 4;
						v := arg[3].ival;
						with arg[1].infop^ do
							if h >= 0 then
								if v >= 0 then
									if h + 3 < PixelsPerLine then
										if v < nlines then
											FuncResult := r32p(Ord4(PicBaseAddr) + v * BytesPerRow + h)^;
					end;
				getPixel96rUC:  begin
						FuncResult := BackgroundIndex;
						h := arg[2].ival * 12;
						v := arg[3].ival;
						with arg[1].infop^ do
							if h >= 0 then
								if v >= 0 then
									if h + 11 < PixelsPerLine then
										if v < nlines then
											FuncResult := r96p(Ord4(PicBaseAddr) + v * BytesPerRow + h)^;
					end;
				getPixVec8UC:  begin
						FuncResult := BackgroundIndex;
						h := arg[2].ival * 1;
						with arg[1].infop^ do
							if h >= 0 then
								if h < PixMapSize then
									FuncResult := u8p(Ord4(PicBaseAddr) + h)^.u;
					end;
				getPixVec16uUC:  begin
						FuncResult := BackgroundIndex;
						h := arg[2].ival * 2;
						with arg[1].infop^ do
							if h >= 0 then
								if h + 1 < PixMapSize then
									FuncResult := u16p(Ord4(PicBaseAddr) + h)^.u;
					end;
				getPixVec16sUC:  begin
						FuncResult := BackgroundIndex;
						h := arg[2].ival * 2;
						with arg[1].infop^ do
							if h >= 0 then
								if h + 1 < PixMapSize then
									FuncResult := s16p(Ord4(PicBaseAddr) + h)^;
					end;
				getPixVec32sUC:  begin
						FuncResult := BackgroundIndex;
						h := arg[2].ival * 4;
						with arg[1].infop^ do
							if h >= 0 then
								if h + 3 < PixMapSize then
									FuncResult := s32p(Ord4(PicBaseAddr) + h)^;
					end;
				getPixVec32rUC:  begin
						FuncResult := BackgroundIndex;
						h := arg[2].ival * 4;
						with arg[1].infop^ do
							if h >= 0 then
								if h + 3 < PixMapSize then
									FuncResult := r32p(Ord4(PicBaseAddr) + h)^;
					end;
				getPixVec96rUC:  begin
						FuncResult := BackgroundIndex;
						h := arg[2].ival * 12;
						with arg[1].infop^ do
							if h >= 0 then
								if h + 11 < PixMapSize then
									FuncResult := r96p(Ord4(PicBaseAddr) + h)^;
					end;
				putPixel8UC:  begin
						h := arg[2].ival * 1;
						v := arg[3].ival;
						with arg[1].infop^ do
							if h >= 0 then
								if v >= 0 then
									if h < PixelsPerLine then
										if v < nlines then begin
												p8 := u8p(Ord4(PicBaseAddr) + v * BytesPerRow + h);
												p8^.u := arg[4].ival;
											end;
					end;
				putPixel16uUC:  begin
						h := arg[2].ival * 2;
						v := arg[3].ival;
						with arg[1].infop^ do
							if h >= 0 then
								if v >= 0 then
									if h + 1 < PixelsPerLine then
										if v < nlines then begin
												p16u := u16p(Ord4(PicBaseAddr) + v * BytesPerRow + h);
												p16u^.u := arg[4].ival;
											end;
					end;
				putPixel16sUC:  begin
						h := arg[2].ival * 2;
						v := arg[3].ival;
						with arg[1].infop^ do
							if h >= 0 then
								if v >= 0 then
									if h + 1 < PixelsPerLine then
										if v < nlines then begin
												p16s := s16p(Ord4(PicBaseAddr) + v * BytesPerRow + h);
												p16s^ := arg[4].ival;
											end;
					end;
				putPixel32sUC:  begin
						h := arg[2].ival * 4;
						v := arg[3].ival;
						with arg[1].infop^ do
							if h >= 0 then
								if v >= 0 then
									if h + 3 < PixelsPerLine then
										if v < nlines then begin
												p32s := s32p(Ord4(PicBaseAddr) + v * BytesPerRow + h);
												p32s^ := arg[4].ival;
											end;
					end;
				putPixel32rUC:  begin
						h := arg[2].ival * 4;
						v := arg[3].ival;
						with arg[1].infop^ do
							if h >= 0 then
								if v >= 0 then
									if h + 3 < PixelsPerLine then
										if v < nlines then begin
												p32r := r32p(Ord4(PicBaseAddr) + v * BytesPerRow + h);
												p32r^ := arg[4].ival;
											end;
					end;
				putPixel96rUC:  begin
						h := arg[2].ival * 12;
						v := arg[3].ival;
						with arg[1].infop^ do
							if h >= 0 then
								if v >= 0 then
									if h + 11 < PixelsPerLine then
										if v < nlines then begin
												p96r := r96p(Ord4(PicBaseAddr) + v * BytesPerRow + h);
												p96r^ := arg[4].ival;
											end;
					end;
				putPixVec8UC:  begin
						h := arg[2].ival * 1;
						with arg[1].infop^ do
							if h >= 0 then
								if h < PixMapSize then begin
										p8 := u8p(Ord4(PicBaseAddr) + h);
										p8^.u := arg[3].ival;
									end;
					end;
				putPixVec16uUC:  begin
						h := arg[2].ival * 2;
						with arg[1].infop^ do
							if h >= 0 then
								if h + 1 < PixMapSize then begin
										p16u := u16p(Ord4(PicBaseAddr) + h);
										p16u^.u := arg[3].ival;
									end;
					end;
				putPixVec16sUC:  begin
						h := arg[2].ival * 2;
						with arg[1].infop^ do
							if h >= 0 then
								if h + 1 < PixMapSize then begin
										p16s := s16p(Ord4(PicBaseAddr) + h);
										p16s^ := arg[3].ival;
									end;
					end;
				putPixVec32sUC:  begin
						h := arg[2].ival * 4;
						with arg[1].infop^ do
							if h >= 0 then
								if h + 3 < PixMapSize then begin
										p32s := s32p(Ord4(PicBaseAddr) + h);
										p32s^ := arg[3].ival;
									end;
					end;
				putPixVec32rUC:  begin
						h := arg[2].ival * 4;
						with arg[1].infop^ do
							if h >= 0 then
								if h + 3 < PixMapSize then begin
										p32r := r32p(Ord4(PicBaseAddr) + h);
										p32r^ := arg[3].ival;
									end;
					end;
				putPixVec96rUC:  begin
						h := arg[2].ival * 12;
						with arg[1].infop^ do
							if h >= 0 then
								if h + 11 < PixMapSize then begin
										p96r := r96p(Ord4(PicBaseAddr) + h);
										p96r^ := arg[3].ival;
									end;
					end;
				otherwise begin
						ErrorOccurred := true;
						str := 'UMGetPutPx.p';
					end;
			end;
	end;

end.