00100	BEGIN	"SHEDPY"
00200	REQUIRE "ABBREV[SYS,BGB]" 	SOURCE_FILE;
00300	REQUIRE "TIMER[SYS,BGB]"	SOURCE_FILE;
00400	REQUIRE "SAITRG[SYS,BGB]" 	SOURCE_FILE;
00500	REQUIRE "DPYIII[SYS,BGB]"	SOURCE_FILE;
00600		REAL X,Y,Z;
00700	
00800		INTEGER LDX,LDY,LDZ;
00900		REAL PDX,PDY,FOCAL;
01000		REAL SCALX,SCALY,SCALZ;
01100		REAL IX,IY,IZ;
01200		REAL JX,JY,JZ;
01300		REAL KX,KY,KZ;
01400		REAL CX,CY,CZ;
01500		REAL XX,YY,ZZ,XXX,YYY,ZZZ;
01600		SHORT INTEGER XPP,YPP,ZPP,OLDXPP;
01700		INTEGER FRAME;
01800	
01900		SAFE ITG ARRAY DPYBUF[0:2000];
     

00100	PROCEDURE PROJECT;
00200	BEGIN	"PROJECT"
00300		XX ← X - CX;
00400		YY ← Y - CY;
00500		ZZ ← Z - CZ;
00600		XXX ← XX*IX + YY*IY + ZZ*IZ;
00700		YYY ← XX*JX + YY*JY + ZZ*JZ;
00800		ZZZ ← XX*KX + YY*KY + ZZ*KZ;
00900		XPP ← SCALX*XXX/ZZZ;
01000		YPP ← SCALY*YYY/ZZZ;
01100		ZPP ← SCALZ/ZZZ;
01200	END	"PROJECT";
     

00100		REAL C,S,TMP,PAN,TILT;
00200		DEFINE ROTATE(X,Y)="TMP←X;X←C*X+S*Y;Y←C*Y-S*TMP;";
00300	PROCEDURE CAMINIT;
00400		BEGIN	"CAMINIT"
00500		DEFINE MM="*3.2@-3";
00600		LDX ← 511;
00700		LDY ← 511;
00800		LDZ ← 512;
00900		PDX ← 12 MM;
01000		PDY ← 12 MM;
01100		FOCAL ← 12 MM;
01200		SCALX ← -FOCAL*LDX/PDX;
01300		SCALY ← -FOCAL*LDY/PDY;
01400		SCALZ ←  FOCAL*LDZ;
01500		CX ← -9;
01600		CY ← -16;
01700		CZ ←  13;
01800		IX ← JY ← KZ ← 1;
01900		IY ← IZ ← JX ← JZ ← KX ← KY ← 0;
02000	
02100		TILT ← -π/4;
02200		C ← COS(TILT);
02300		S ← SIN(TILT);
02400		ROTATE(JY,JZ);
02500		ROTATE(KY,KZ);
02600	
02700		PAN ← π/4;
02800		C ← COS(PAN);
02900		S ← SIN(PAN);
03000		
03100		ROTATE(IX,IY);
03200		ROTATE(JX,JY);
03300		ROTATE(KX,KY);
03400	END	"CAMINIT";
     

00100	REAL PROCEDURE FN(REAL X,Y);
00200	BEGIN	"FN"
00300		REAL R;
00400	 	R ← SQRT(X↑2+Y↑2);
00500	 	RETURN(6*COS(2*R + π*FRAME/32)/(R+0.75));
00600	END	"FN";
     

00100		INTEGER XPPP,ZN,I;
00200		REAL XL,XH,YL,YH;
00300		SAFE REAL ARRAY YPPMAX[-600:+600];
00700	
00800	FOR FRAME←0 TO 15 DO
00900	BEGIN	"LOOP"
01000		DPYSET(DPYBUF);
01100		XL ← -10.0;
01200		XH ← +10.0;
01300		YL ← -10.0;
01400		YH ← +10.0;
01500	
01600		FOR I←-600 STEP 1 UNTIL 600 DO YPPMAX[I]←-512;
01700		CAMINIT;
     

00100		FOR Y←YL STEP 0.3 UNTIL YH DO
00200	BEGIN
00300		FOR X←XL STEP 2.0 UNTIL XH DO
00400	BEGIN
00500		Z ← FN(X,Y);
00600		OLDXPP ← XPP;
00700		PROJECT;
00800		YPP ← YPP MIN 505;
00850	
00900	α ADVANCE THE YPP-HI-FRONT;
01000		IF X≠XL∧ABS(XPP)≤511∧YPP=(511 MIN (YPP MAX YPPMAX[XPP])) THEN
01100		BEGIN
01200			INTEGER I;
01300			REAL X1,X2,Y1,Y2,DX,DY;
01400			X1←OLDXPP; X2←XPP; Y1←YPPMAX[X1]; Y2←YPP;
01500			IF X2<X1 THEN ⊂ X1↔X2;Y1↔Y2;OUTSTR("X-SWAP"&↓) ⊃;
01600			DY ← (Y2-Y1)/(X2-X1+1);
01700			FOR I←X1 STEP 1 UNTIL X2 DO 
01800			YPPMAX[I]←YPPMAX[I] MAX (Y1←Y1+DY);
01900		END;
     

02000	α DISPLAY IT IF YOU CAN;
02100		IF XPP =((XPP MAX -511)MIN 511) THEN 
02200	 	BEGIN  
02300			XPP ← ((XPP MAX -511)MIN 511);
02400			IF X=XL THEN
02500			AIVECT(XPP,YPPMAX[XPP]←YPPMAX[XPP]MAX YPP) ELSE
02600			AVECT(XPP,YPPMAX[XPP]);
02700		END;
02800	END;
02810	END;
02900		DPYOUT(0);
03100	END	"LOOP";
03200	END	"SHEDPY";