unit CShade;

interface


	uses
		QuickDraw, Palettes, PrintTraps, globals, Utilities, edit, Functions, File1, FFT, SpeedTest;


	procedure DoCShade (x1, y1, z1, x2, y2, z2: longint; ThreeDHeightFactor: real; step: integer);


implementation

	const
		sizeofpixelarray = 10;
		VectorArraySize = 5;
		maxv = 10;
		maxf = 10;
		maxlist = 10;
		epsilon = 0.000001;
		maxmaterl = 10;
		maxgrid = 600;
		xfact = 2;
		yfact = 2;
		epscos = 0.0001;
	type
		pixelvector = record
				x, y, z: longint;
			end;
		pixelarray = array[1..sizeofpixelarray] of pixelvector;
		Vector2 = record
				x, y: real;
			end;
		Vector3 = record
				x, y, z: real;
			end;
		Vector3Array = array[1..VectorArraySize] of Vector3;
		ObsArray = array[1..2, 1..maxgrid] of Vector3;
		matrix4x4 = array[1..4, 1..4] of real;


	var
		eye: Vector3;
		direct: Vector3;
		src: Vector3;
		Q: matrix4x4;
		horiz, vert, xyscale: real;
		ppd: real;
		nxpix: longint;
		nypix: longint;
		maxpix: longint;



{Routine cshade}
{ aus high-resolution computer graphics     Seite 271/272}

	function fx (x: real): integer;
	begin
		fx := trunc(x * xyscale + xfact * maxpix * 0.5 - 0.5);
	end;


	function fy (y: real): integer;
	begin
		fy := trunc(y * xyscale + yfact * maxpix * 0.5 - 0.5);
	end;



	function dot3 (p1, p2: vector3): real;
	begin
		dot3 := p1.x * p2.x + p1.y * p2.y + p1.z * p2.z;
	end;



	procedure normalvector (var n: vector3; var k: real; v1, v2, v3: vector3);
		var
			d1, d2: vector3;
	begin
		d1.x := v2.x - v1.x;
		d1.y := v2.y - v1.y;
		d1.z := v2.z - v1.z;
		d2.x := v3.x - v2.x;
		d2.y := v3.y - v2.y;
		d2.z := v3.z - v2.z;
		n.x := d1.y * d2.z - d2.y * d1.z;
		n.y := d1.z * d2.x - d2.z * d1.x;
		n.z := d1.x * d2.y - d2.x * d1.y;
		k := n.x * v1.x + n.y * v1.y + n.z * v1.z;
	end;

	procedure midpoint3 (var midpt, obs1, obs2, obs3: vector3);
		var
			i, j: integer;
	begin
		midpt.x := (obs1.x + obs2.x + obs3.x) / 3;
		midpt.y := (obs1.y + obs2.y + obs3.y) / 3;
		midpt.z := (obs1.z + obs2.z + obs3.z) / 3;
	end;




	procedure midpoint4 (var midpt, obs1, obs2, obs3, obs4: vector3);
		var
			i, j: integer;
	begin
		midpt.x := (obs1.x + obs2.x + obs3.x + obs4.x) / 4;
		midpt.y := (obs1.y + obs2.y + obs3.y + obs4.y) / 4;
		midpt.z := (obs1.z + obs2.z + obs3.z + obs4.z) / 4;
	end;


	procedure cshade (p, norm: vector3; var color: real);
		var
			ptosrc, q: vector3;
			ambient, cosa, cosaover2, cosval, dotprod, specular: real;
			modnormal, modp, modptosrc, modq: real;

	begin
		ptosrc.x := src.x - p.x;
		ptosrc.y := src.y - p.y;
		ptosrc.z := src.z - p.z;
		dotprod := dot3(norm, ptosrc);
		modnormal := sqrt(sqr(norm.x) + sqr(norm.y) + sqr(norm.z));
		modptosrc := sqrt(sqr(ptosrc.x) + sqr(ptosrc.y) + sqr(ptosrc.z));
		cosval := dotprod / (modnormal * modptosrc);
		if cosval < 0 then
			cosval := 0;
		ambient := 0.3;
		color := (1 - ambient) * cosval + ambient;
		if color > 1 then
			color := 1;
	end;



	function angle (x, y: real): real;
	begin
		if abs(x) < epsilon then
			if abs(y) < epsilon then
				angle := 0.0
			else if y > 0.0 then
				angle := pi * 0.5
			else
				angle := pi * 1.5
		else if x < 0.0 then
			angle := arctan(y / x) + pi
		else
			angle := arctan(y / x)
	end;




	procedure trans3 (tx, ty, tz: real; var A: matrix4x4);
		var
			i, j: integer;
	begin
		for i := 1 to 4 do begin
				for j := 1 to 4 do
					A[i, j] := 0.0;
				A[i, i] := 1.0;
			end;
		A[1, 4] := -tx;
		A[2, 4] := -ty;
		A[3, 4] := -tz;
	end;



	procedure rot3 (m: integer; theta: real; var A: matrix4x4);
		var
			i, j, m1, m2: integer;
			c, s: real;
	begin
		for i := 1 to 4 do
			for j := 1 to 4 do
				A[i, j] := 0.0;
		A[m, m] := 1.0;
		A[4, 4] := 1.0;
		m1 := (m mod 3) + 1;
		m2 := (m1 mod 3) + 1;
		c := cos(theta);
		s := sin(theta);
		A[m1, m1] := c;
		A[m2, m2] := c;
		A[m1, m2] := s;
		A[m2, m1] := -s;
	end;



	procedure mult3 (A, B: matrix4x4; var C: matrix4x4);
		var
			i, j, k: integer;
			ab: real;
	begin
		for i := 1 to 4 do
			for j := 1 to 4 do begin
					ab := 0;
					for k := 1 to 4 do
						ab := ab + A[i, k] * B[k, j];
					C[i, j] := ab;
				end;
	end;



	procedure findQ;
		var
			E, F, G, H, U: matrix4x4;
			alpha, beta, gamma, v, w: real;
	begin
		trans3(eye.x, eye.y, eye.z, F);
		alpha := angle(-direct.x, -direct.y);
		rot3(3, alpha, G);
		v := sqrt(direct.x * direct.x + direct.y * direct.y);
		beta := angle(-direct.z, v);
		rot3(2, beta, H);
		w := sqrt(v * v + direct.z * direct.z);
		gamma := angle(-direct.x * w, direct.y * direct.z);
		rot3(3, -gamma, U);
		mult3(G, F, Q);
		mult3(H, Q, E);
		mult3(U, E, Q);
	end;



	procedure transform (v: vector3; A: matrix4x4; var w: vector3);
	begin
		w.x := A[1, 1] * v.x + A[1, 2] * v.y + A[1, 3] * v.z + A[1, 4];
		w.y := A[2, 1] * v.x + A[2, 2] * v.y + A[2, 3] * v.z + A[2, 4];
		w.z := A[3, 1] * v.x + A[3, 2] * v.y + A[3, 3] * v.z + A[3, 4];
	end;




	procedure FillPoly (var poly: Vector3Array; n: longint);
		var
			q: pixelarray;
			i, iv, ix, iy, xmin, xmax, ymin, ymax, zmin, zmax, zmed, nv: longint;
			ixi: longint;
			color: real;
			pix1, pix2: pixelvector;
			factor: real;
	begin
		for i := 1 to n do begin
				q[i].x := fx(poly[i].x);
				q[i].y := fy(poly[i].y);
				q[i].z := round(poly[i].z);
			end;
		ymax := q[1].y;
		ymin := ymax;
		for i := 2 to n do begin
				if q[i].y > ymax then
					ymax := q[i].y;
				if q[i].y < ymin then
					ymin := q[i].y;
			end;
		if ymax >= yfact * maxpix then
			ymax := yfact * maxpix - 1;
		if ymin < 0 then
			ymin := 0;
		for iy := ymin to ymax do begin
				xmin := xfact * maxpix;
				xmax := -1;
				iv := n;
				for nv := 1 to n do begin
						if ((q[iv].y >= iy) or (q[nv].y >= iy)) and ((q[iv].y <= iy) or (q[nv].y <= iy)) and (q[iv].y <> q[nv].y) then begin
								factor := (q[nv].x - q[iv].x) / (q[nv].y - q[iv].y);
								ixi := q[iv].x + round((iy - q[iv].y) * factor);
								if ixi < xmin then
									xmin := ixi;
								if ixi > xmax then
									xmax := ixi;
							end;
						iv := nv;
					end;
				if xmax >= xfact * maxpix then
					xmax := xfact * maxpix - 1;
				if xmin < 0 then
					xmin := 0;
				if xmin <= xmax then begin
						moveto(xmin, iy);
						lineto(xmax, iy);
					end;
			end;
	end;

	procedure Shadetriangle (obs1, obs2, obs3: Vector3; var color: real);
		var
			facenorm: vector3;
			constant: real;
			midpt: vector3;
	begin
		midpoint3(midpt, obs1, obs2, obs3);
		normalvector(facenorm, constant, obs1, obs2, obs3);
		cshade(midpt, facenorm, color);
		color := 254 * (1 - color);
	end;


	procedure triangle (v1, v2, v3, obs1, obs2, obs3: Vector3; var color: real; switch: boolean);

		var
			poly: Vector3Array;
			facenorm: vector3;
			constant, dotprod, modnormal, modmid, cosval: real;
			p, midpt: vector3;
			triPoly: PolyHandle;
	begin
		poly[1].x := v1.x;
		poly[1].y := v1.y;
		poly[1].z := v1.z;
		poly[2].x := v2.x;
		poly[2].y := v2.y;
		poly[2].z := v2.z;
		poly[3].x := v3.x;
		poly[3].y := v3.y;
		poly[3].z := v3.z;
		midpoint3(midpt, obs1, obs2, obs3);
		normalvector(facenorm, constant, obs1, obs2, obs3);
		dotprod := dot3(facenorm, midpt);
		modnormal := sqrt(sqr(facenorm.x) + sqr(facenorm.y) + sqr(facenorm.z));
		modmid := sqrt(sqr(midpt.x) + sqr(midpt.y) + sqr(midpt.z));
		cosval := dotprod / (modnormal * modmid);
		if switch then
			cosval := -cosval;
		if (cosval > 0) then
			exit(triangle);
{cshade(midpt, facenorm, color)}
		setforegroundcolor(trunc(color));
		moveto(fx(poly[3].x), fy(poly[3].y));
		lineto(fx(poly[1].x), fy(poly[1].y));
		lineto(fx(poly[2].x), fy(poly[2].y));
		lineto(fx(poly[3].x), fy(poly[3].y));
		FillPoly(poly, 3);
	end;

	procedure Shadequadrilateral (obs1, obs2, obs3, obs4: Vector3; var color: real);
		var
			facenorm: vector3;
			dummy: real;
			midpt: vector3;
	begin
		midpoint4(midpt, obs1, obs2, obs3, obs4);
		normalvector(facenorm, dummy, obs1, obs2, obs3);
		cshade(midpt, facenorm, color);
		color := 254 * (1 - color);
	end;


	procedure quadrilateral (v1, v2, v4, v3, obs1, obs2, obs3, obs4: Vector3; var color: real; switch: boolean);
		var
			poly: Vector3Array;
			midpt, facenorm: Vector3;
			dummy, dotprod, modmid, modnormal, cosval: real;
			tripoly: PolyHandle;
	begin
		poly[1].x := v1.x;
		poly[1].y := v1.y;
		poly[1].z := v1.z;
		poly[2].x := v2.x;
		poly[2].y := v2.y;
		poly[2].z := v2.z;
		poly[3].x := v4.x;
		poly[3].y := v4.y;
		poly[3].z := v4.z;
		poly[4].x := v3.x;
		poly[4].y := v3.y;
		poly[4].z := v3.z;
		midpoint4(midpt, obs1, obs2, obs3, obs4);
		normalvector(facenorm, dummy, obs1, obs2, obs3);
		dotprod := dot3(facenorm, midpt);
		modnormal := sqrt(sqr(facenorm.x) + sqr(facenorm.y) + sqr(facenorm.z));
		modmid := sqrt(sqr(midpt.x) + sqr(midpt.y) + sqr(midpt.z));
		cosval := dotprod / (modnormal * modmid);
		if switch then
			cosval := -cosval;
		if (cosval > 0) then
			exit(quadrilateral);
		setforegroundcolor(trunc(color));
		moveto(fx(poly[4].x), fy(poly[4].y));
		lineto(fx(poly[1].x), fy(poly[1].y));
		lineto(fx(poly[2].x), fy(poly[2].y));
		lineto(fx(poly[3].x), fy(poly[3].y));
		lineto(fx(poly[4].x), fy(poly[4].y));
		FillPoly(poly, 4);
	end;

	procedure Shadepatch (v1, v2, v3, v4, obs1, obs2, obs3, obs4: Vector3; var color: real);
		var
			denom, denom2, mu: real;
			v5: Vector3;
	begin
		denom := (v2.x - v1.x) * (v4.y - v3.y) - (v2.y - v1.y) * (v4.x - v3.x);
		if abs(denom) > epsilon then begin
				mu := ((v3.x - v1.x) * (v4.y - v3.y) - (v3.y - v1.y) * (v4.x - v3.x)) / denom;
				if (mu >= 0) and (mu <= 1) then begin
						v5.x := (1 - mu) * v1.x + mu * v2.x;
						v5.y := (1 - mu) * v1.y + mu * v2.y;
						v5.z := (1 - mu) * v1.z + mu * v2.z;
						Shadetriangle(obs1, obs2, obs3, color);
						Shadetriangle(obs1, obs2, obs3, color);
						exit(Shadepatch);
					end
			end;
		denom := (v3.x - v1.x) * (v4.y - v2.y) - (v3.y - v1.y) * (v4.x - v2.x);
		if abs(denom) > epsilon then begin
				mu := ((v2.x - v1.x) * (v4.y - v2.y) - (v2.y - v1.y) * (v4.x - v2.x)) / denom;
				if (mu >= 0) and (mu <= 1) then begin
						v5.x := (1 - mu) * v1.x + mu * v3.x;
						v5.y := (1 - mu) * v1.y + mu * v3.y;
						v5.z := (1 - mu) * v1.z + mu * v3.z;
						Shadetriangle(obs1, obs2, obs3, color);
						Shadetriangle(obs1, obs2, obs3, color);
						exit(Shadepatch);
					end
			end;
		Shadequadrilateral(obs1, obs2, obs3, obs4, color);
	end;



	procedure patch (v1, v2, v3, v4, obs1, obs2, obs3, obs4: Vector3; var color: real; switch: boolean);
		var
			denom, mu: real;
			v5: Vector3;
	begin
		denom := (v2.x - v1.x) * (v4.y - v3.y) - (v2.y - v1.y) * (v4.x - v3.x);
		if abs(denom) > epsilon then begin
				mu := ((v3.x - v1.x) * (v4.y - v3.y) - (v3.y - v1.y) * (v4.x - v3.x)) / denom;
				if (mu >= 0) and (mu <= 1) then begin
						v5.x := (1 - mu) * v1.x + mu * v2.x;
						v5.y := (1 - mu) * v1.y + mu * v2.y;
						v5.z := (1 - mu) * v1.z + mu * v2.z;
						triangle(v1, v3, v5, obs1, obs2, obs3, color, switch);
						triangle(v2, v4, v5, obs1, obs2, obs3, color, switch);
						exit(patch);
					end
			end;
		denom := (v3.x - v1.x) * (v4.y - v2.y) - (v3.y - v1.y) * (v4.x - v2.x);
		if abs(denom) > epsilon then begin
				mu := ((v2.x - v1.x) * (v4.y - v2.y) - (v2.y - v1.y) * (v4.x - v2.x)) / denom;
				if (mu >= 0) and (mu <= 1) then begin
						v5.x := (1 - mu) * v1.x + mu * v3.x;
						v5.y := (1 - mu) * v1.y + mu * v3.y;
						v5.z := (1 - mu) * v1.z + mu * v3.z;
						triangle(v1, v2, v5, obs1, obs2, obs3, color, switch);
						triangle(v3, v4, v5, obs1, obs2, obs3, color, switch);
						exit(patch);
					end
			end;
		quadrilateral(v1, v2, v4, v3, obs1, obs2, obs3, obs4, color, switch);
	end;


	function DuplicateShade: boolean;
		var
			name: str255;
			width, height, hstart, vstart, i: integer;
			SaveInfo: InfoPtr;
			src, dst: ptr;
			offset: LongInt;
			AutoSelectAll, a: boolean;
	begin
		duplicateshade := true;
		WhatToUndo := NothingToUndo;
		if (NotRectangular or NotinBounds) then begin
				duplicateshade := false;
				exit(DuplicateShade);
			end;
		AutoSelectAll := (not Info^.RoiShowing);
		if AutoSelectAll then
			SelectAll(false);
		ShowWatch;
		with info^ do begin

				GetWTitle(wptr, name);
				with RoiRect do begin
						width := right - left;
						if odd(width) and (left + width < PicRect.right) then
							width := Width + 1;
						height := bottom - top;
						hstart := left;
						vstart := top;
					end;
			end;
		if AutoSelectAll then
			KillRoi;
		SaveInfo := Info;
		if NewPicWindow(name, width, height) then
			with SaveInfo^ do begin
					offset := LongInt(vstart) * BytesPerRow + hstart;
					src := ptr(ord4(PicBaseAddr) + offset);
					dst := Info^.PicBaseAddr;
					for i := 0 to height - 1 do begin
							BlockMove(src, dst, width);
							src := ptr(ord4(src) + BytesPerRow);
							dst := ptr(ord4(dst) + width);
						end;
				end
		else
			duplicateshade := false;
	end;

	function makelargewindow: boolean;
		var
			name: str255;
			width, height, hstart, vstart, i: integer;
			SaveInfo: InfoPtr;
			src, dst: ptr;
			offset: LongInt;
			AutoSelectAll: boolean;
	begin
		WhatToUndo := NothingToUndo;
		if (NotRectangular or NotinBounds) then
			exit(makelargewindow);
		AutoSelectAll := (not Info^.RoiShowing);
		if AutoSelectAll then
			SelectAll(false);
		ShowWatch;
		with info^ do begin

				GetWTitle(wptr, name);
				name := concat('3D-Shade-', name);
				if length(name) > 32 then
					delete(name, 33, length(name) - 32);

				with RoiRect do begin
						width := right - left;
						if odd(width) and (left + width < PicRect.right) then
							width := Width + 1;
						height := bottom - top;
						hstart := left;
						vstart := top;
					end;
			end;
		if AutoSelectAll then
			KillRoi;
		saveinfo := info;
		if height > width then
			width := height;
		if NewPicWindow(name, trunc(xfact * width), trunc(yfact * width)) then
			makelargewindow := true
		else
			makelargewindow := false;
	end;



	procedure DoCShade (x1, y1, z1, x2, y2, z2: longint; ThreeDHeightFactor: real; Step: integer);
		var
			v: array[1..2, 1..maxgrid] of Vector3;
			obs: ObsArray;
			xi, xmin, xmax, yij: real;
			zj, zmin, zmax, color, vscale: real;
			i, j, k, nx, nx1, nz, sum: Longint;
			Line: LineType;
			tPort: GrafPtr;
			SaveInfo, Shadeinfo, saveinfo1: InfoPtr;
			MaskRect: rect;
			AutoSelectAll, ApplyLUT, switch: boolean;
			table: LookupTable;
			StartTicks: LongInt;
			xstep, zstep, maxcolor, dummy: integer;
			act, helpsrc: vector3;
			t: FateTable;

	begin
		if nPics < 1 then
			PutMessage('You need a Picture to run Shade!')
		else begin
				if x1 = 0 then
					x1 := 1;
				if z1 = 0 then
					z1 := 1;
				xyscale := 1;
				eye.x := x1;
				eye.y := y1;
				eye.z := z1;
				helpsrc.x := x2;
				helpsrc.y := y2;
				helpsrc.z := z2;
				direct.x := -eye.x;
				direct.y := -eye.y;
				direct.z := -eye.z;
				findQ;
				transform(helpsrc, q, src);
				x1 := -x1;
				if x1 * z1 < 0 then
					switch := true
				else
					switch := false;
				with info^ do
					vscale := ThreeDHeightFactor * 2 * z_range / (x_range + y_range);
				if not DuplicateShade then
					exit(DoCShade);
				saveinfo1 := info;
				if not DuplicateShade then
					exit(DoCShade);
				shadeinfo := info;
				with info^ do begin
						nxpix := PixelsPerLine;
						xmin := PicRect.topLeft.h - trunc(nxpix / 2);
						xmax := PicRect.botRight.h - trunc(nxpix / 2);
						nypix := nlines;
						zmin := PicRect.topLeft.v - trunc(nypix / 2);
						zmax := PicRect.botRight.v - trunc(nypix / 2);
					end;
				if nxpix > nypix then
					maxpix := nxpix
				else
					maxpix := nypix;
				nx := nxpix - 1;
				nz := nypix - 1;
				nx1 := nx + 1;
				sum := 0;
				maxcolor := 0;
				for i := 0 to nz do begin
						GetLine(0, i, nxpix, Line);
						for j := 0 to nx do begin
								sum := sum + longint(Line[j]);
								if line[j] > maxcolor then
									maxcolor := line[j];
							end;
					end;
				sum := sum div longint(nxpix * nypix);
				xstep := step;
				zstep := step;
				nx := trunc((nxpix - 1) / step);
				nz := trunc((nypix - 1) / step);
				nx1 := nx + 1;
				xi := xmin;
				zj := zmax;
				if not makelargewindow then
					exit(DoCShade);
				SaveInfo := Info;
				GetPort(tPort);
				with Info^, info^.RoiRect do begin
						changes := true;
						SetPort(GrafPtr(osPort));
						PenNormal;
						EraseRect(PicRect);
						UpdatePicWindow;
					end;
				OpenBusyBox('Shading');
				Info := Saveinfo1;
				GetLine(0, nz * step, nxpix, Line);
				Info := ShadeInfo;
				for i := 1 to nx1 do begin
						yij := (Line[(nx1 - i) * xstep] - sum) * vscale;
						v[1, i].x := Q[1, 1] * xi + Q[1, 2] * yij + Q[1, 3] * zj;
						v[1, i].y := Q[2, 1] * xi + Q[2, 2] * yij + Q[2, 3] * zj;
						v[1, i].z := Q[3, 1] * xi + Q[3, 2] * yij + Q[3, 3] * zj;
						act.x := xi;
						act.y := yij;
						act.z := zj;
						transform(act, Q, Obs[1, i]);
						xi := xi + xstep;
					end;
				for j := (nz - 1) downto 0 do begin
						if commandperiod then begin
								CloseBusyBox;
								SetPort(tPort);
								Saveinfo1^.changes := false;
								shadeinfo^.changes := false;
								Saveinfo^.changes := false;
								dummy := CloseAWindow(Saveinfo1^.wptr);
								dummy := CloseAWindow(ShadeInfo^.wptr);
								dummy := CloseAWindow(SaveInfo^.wptr);
								exit(DoCShade);
							end;
						xi := xmin;
						zj := zj - zstep;
						Info := Saveinfo1;
						GetLine(0, j * zstep, nxpix, Line);
						Info := Shadeinfo;
						for i := 1 to nx1 do begin
								yij := (Line[(nx1 - i) * xstep] - sum) * vscale;
								v[2, i].x := Q[1, 1] * xi + Q[1, 2] * yij + Q[1, 3] * zj;
								v[2, i].y := Q[2, 1] * xi + Q[2, 2] * yij + Q[2, 3] * zj;
								v[2, i].z := Q[3, 1] * xi + Q[3, 2] * yij + Q[3, 3] * zj;
								act.x := xi;
								act.y := yij;
								act.z := zj;
								transform(act, Q, Obs[2, i]);
								xi := xi + xstep;
							end;
						for i := 1 to nx do begin
								shadepatch(v[1, i], v[1, i + 1], v[2, i], v[2, i + 1], obs[1, i], obs[1, i + 1], obs[2, i], obs[2, i + 1], color);
								Line[i * xstep] := trunc(color + 1);
								for k := 1 to xstep - 1 do
									Line[i * xstep - k] := trunc(color + 1);
							end;
						for k := 1 to xstep - 1 do
							Line[(i - 1) * xstep + k] := trunc(color + 1);
						PutLine(0, j * zstep, nxpix, Line);
						for k := 1 to xstep - 1 do
							PutLine(0, j * zstep + k, nxpix, Line);
						for i := 1 to nx1 do begin
								v[1, i].x := v[2, i].x;
								v[1, i].y := v[2, i].y;
								v[1, i].z := v[2, i].z;
								obs[1, i].x := obs[2, i].x;
								obs[1, i].y := obs[2, i].y;
								obs[1, i].z := obs[2, i].z;
							end;
						DoBusyBox(nz - j, nz);
					end;
				CloseBusyBox;
				info := shadeinfo;
				getport(tport);
				setport(grafptr(info^.osport));
				filter(unweightedavg, 0, t);
				filter(unweightedavg, 0, t);
				Info := Saveinfo1;
				setport(tport);
				nx := trunc((nxpix - 5) / step);
				nz := trunc((nypix - 5) / step);
				nx1 := nx + 1;
				xstep := step;
				zstep := step;

				if x1 >= 0 then
					xi := xmin + 2
				else
					xi := xmax - 2;
				if z1 >= 0 then begin
						zj := zmax - 2;
						GetLine(0, nz * step + 2, nxpix, Line);
					end
				else begin
						zj := zmin + 2;
						GetLine(0, 2, nxpix, Line);
					end;
				Info := shadeinfo;
				for i := 1 to nx1 do begin
						if x1 >= 0 then
							yij := (Line[(nx1 - i) * step + 2] - sum) * vscale
						else
							yij := (Line[(i - 1) * step + 2] - sum) * vscale;
						v[1, i].x := Q[1, 1] * xi + Q[1, 2] * yij + Q[1, 3] * zj;
						v[1, i].y := Q[2, 1] * xi + Q[2, 2] * yij + Q[2, 3] * zj;
						v[1, i].z := Q[3, 1] * xi + Q[3, 2] * yij + Q[3, 3] * zj;
						act.x := xi;
						act.y := yij;
						act.z := zj;
						transform(act, Q, Obs[1, i]);
						if x1 >= 0 then
							xi := xi + xstep
						else
							xi := xi - xstep;
					end;
				yij := (maxcolor - sum) * vscale;
				v[1, i].x := Q[1, 1] * xi + Q[1, 2] * yij + Q[1, 3] * zj;
				v[1, i].y := Q[2, 1] * xi + Q[2, 2] * yij + Q[2, 3] * zj;
				v[1, i].z := Q[3, 1] * xi + Q[3, 2] * yij + Q[3, 3] * zj;
				act.x := xi;
				act.y := yij;
				act.z := zj;
				transform(act, Q, Obs[1, i]);
				OpenBusyBox('Drawing');
				for j := (nz - 1) downto 0 do begin
						if commandperiod then begin
								closebusybox;
								SetPort(tPort);
								Saveinfo1^.changes := false;
								shadeinfo^.changes := false;
								Saveinfo^.changes := false;
								dummy := CloseAWindow(Saveinfo1^.wptr);
								dummy := CloseAWindow(ShadeInfo^.wptr);
								dummy := CloseAWindow(SaveInfo^.wptr);
								exit(DoCShade);
							end;
						if x1 >= 0 then
							xi := xmin + 2
						else
							xi := xmax - 2;
						Info := Saveinfo1;
						if z1 >= 0 then begin
								zj := zj - zstep;
								GetLine(0, j * step + 2, nxpix, Line);
							end
						else begin
								zj := zj + zstep;
								GetLine(0, (nz - j) * step + 2, nxpix, Line);
							end;
						Info := shadeinfo;
						for i := 1 to nx1 do begin
								if x1 >= 0 then
									yij := (Line[(nx1 - i) * step + 2] - sum) * vscale
								else
									yij := (Line[(i - 1) * step + 2] - sum) * vscale;
								v[2, i].x := Q[1, 1] * xi + Q[1, 2] * yij + Q[1, 3] * zj;
								v[2, i].y := Q[2, 1] * xi + Q[2, 2] * yij + Q[2, 3] * zj;
								v[2, i].z := Q[3, 1] * xi + Q[3, 2] * yij + Q[3, 3] * zj;
								act.x := xi;
								act.y := yij;
								act.z := zj;
								transform(act, Q, Obs[2, i]);
								if x1 >= 0 then
									xi := xi + xstep
								else
									xi := xi - xstep;
							end;
						if x1 >= 0 then
							xi := xi - xstep
						else
							xi := xi + xstep;
						yij := (maxcolor - sum) * vscale;
						v[2, i].x := Q[1, 1] * xi + Q[1, 2] * yij + Q[1, 3] * zj;
						v[2, i].y := Q[2, 1] * xi + Q[2, 2] * yij + Q[2, 3] * zj;
						v[2, i].z := Q[3, 1] * xi + Q[3, 2] * yij + Q[3, 3] * zj;
						act.x := xi;
						act.y := yij;
						act.z := zj;
						transform(act, Q, Obs[2, i]);
						if z1 >= 0 then
							GetLine(0, j * step + 2, nxpix, Line)
						else
							GetLine(0, (nz - j) * step + 2, nxpix, Line);
						Info := Saveinfo;
						for i := 1 to nx do begin
								if x1 >= 0 then
									color := Line[i * step + 2]
								else
									color := Line[(nx + 1 - i) * step + 2];
								patch(v[1, i], v[1, i + 1], v[2, i], v[2, i + 1], obs[1, i], obs[1, i + 1], obs[2, i], obs[2, i + 1], color, switch);
							end;
						color := 255;
						patch(v[1, i], v[1, i + 1], v[2, i], v[2, i + 1], obs[1, i], obs[1, i + 1], obs[2, i], obs[2, i + 1], color, switch);
						for i := 1 to nx1 do begin
								v[1, i].x := v[2, i].x;
								v[1, i].y := v[2, i].y;
								v[1, i].z := v[2, i].z;
								obs[1, i].x := obs[2, i].x;
								obs[1, i].y := obs[2, i].y;
								obs[1, i].z := obs[2, i].z;
							end;
						DoBusyBox(nz - j, nz);
					end;
				CloseBusyBox;
				if x1 >= 0 then
					xi := xmin + 2
				else
					xi := xmax - 2;
				for i := 1 to nx1 do begin
						yij := (maxcolor - sum) * vscale;
						v[2, i].x := Q[1, 1] * xi + Q[1, 2] * yij + Q[1, 3] * zj;
						v[2, i].y := Q[2, 1] * xi + Q[2, 2] * yij + Q[2, 3] * zj;
						v[2, i].z := Q[3, 1] * xi + Q[3, 2] * yij + Q[3, 3] * zj;
						act.x := xi;
						act.y := yij;
						act.z := zj;
						transform(act, Q, Obs[2, i]);
						if x1 >= 0 then
							xi := xi + xstep
						else
							xi := xi - xstep;
					end;
				Info := Saveinfo;
				for i := 1 to nx1 do begin
						color := 255;
						patch(v[1, i], v[1, i + 1], v[2, i], v[2, i + 1], obs[1, i], obs[1, i + 1], obs[2, i], obs[2, i + 1], color, switch);
					end;
				SetPort(tPort);
				Saveinfo1^.changes := false;
				shadeinfo^.changes := false;
				dummy := CloseAWindow(Saveinfo1^.wptr);
				dummy := CloseAWindow(ShadeInfo^.wptr);
			end;
	end;
end.