perm filename SHEDPY.SAI[CAR,BGB] blob
sn#019090 filedate 1973-01-07 generic text, type T, neo UTF8
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";