perm filename CAREYE.SAI[CAR,BGB] blob
sn#013960 filedate 1972-11-28 generic text, type T, neo UTF8
00100 BEGIN "CAREYE-3 - CART'S EYE THREE - AUGUST 1972"
00200 DEFINE
00300 α = "COMMENT",↓ = "(13&10)",⊂ = "BEGIN",⊃ = "END",
00400 S⊂ = "START_CODE",
00500 TO= "STEP 1 UNTIL",
00600 SUBR="SIMPLE PROCEDURE",
00700 ITG="INTEGER";
00800
00900 EXTERNAL SIMPLE PROCEDURE DPYSET(INTEGER ARRAY DPYBUF);
01000 EXTERNAL SIMPLE PROCEDURE DPYOUT(INTEGER POG);
01100 EXTERNAL SIMPLE PROCEDURE AIVECT(INTEGER X,Y);
01200 EXTERNAL SIMPLE PROCEDURE AVECT(INTEGER X,Y);
01300 EXTERNAL SIMPLE PROCEDURE RIVECT(INTEGER X,Y);
01400 EXTERNAL SIMPLE PROCEDURE RVECT(INTEGER X,Y);
01500 EXTERNAL SIMPLE PROCEDURE HYDPOG(INTEGER POG);
01600 EXTERNAL SIMPLE PROCEDURE DPYSST(STRING S);
01700 EXTERNAL SIMPLE PROCEDURE DPYBRT(INTEGER X);
01800 EXTERNAL SIMPLE PROCEDURE DPYBIG(INTEGER SIZ);
01900 EXTERNAL SIMPLE PROCEDURE DPYCLR;
02000 α TELETYPE COMMAND STATE;
02100 ITG CHR,CTRL,META,LETT,αβ,BRK,FLG;
02200 STRING STR;
02300
02400 α DEFINITIONS;
02500
02600 DEFINE mm = "3.2808@-3";
02700 DEFINE PPIOT="'702000000000";
02800 DEFINE THRICE="FOR I←1 STEP 1 UNTIL 3 DO";
02900 DEFINE INCREM(I)="I←I+1";
03000 DEFINE DECREM(I)="I←I-1";
03100 DEFINE XSUBR="EXTERNAL SIMPLE PROCEDURE";
03200
03400 INTERNAL ITG PDLPTR,CUT,DEL;
03500
03600 INTERNAL SAFE ITG ARRAY DPYBUF[1:5000];
03700 INTERNAL SAFE ITG ARRAY HISTO[-1:64];
03800
03900 α SOURCE WINDOW CENTER;
04000 ITG SX,SY;
04100 REAL SOX,SOY;
04200 α OBJECT WINDOW;
04300 REAL OX,OY,MAG;
04400 α PSEUDO BEAM POSITION;
04500 REAL XXX,YYY;
04600 EXTERNAL SUBR CLIPIN (REAL XL,XH,YL,YH);
04700 EXTERNAL BOOLEAN SUBR CLIP (REFERENCE REAL X1,Y1,X2,Y2);
04800 REAL QQQ;
04900 ITG BRTMIN,VBMIN;
00100 α ABBREVIATIONS FOR PROCEDURE DECLARATIONS;
00200 DEFINE XISUBR= "EXTERNAL INTEGER SIMPLE PROCEDURE";
00300 DEFINE XRSUBR= "EXTERNAL REAL SIMPLE PROCEDURE";
00400 DEFINE XSUBR = "EXTERNAL SIMPLE PROCEDURE";
00500 DEFINE ISUBR = "INTEGER SIMPLE PROCEDURE";
00600 DEFINE RSUBR = "REAL SIMPLE PROCEDURE";
00700 DEFINE BSUBR = "BOOLEAN SIMPLE PROCEDURE";
00800
00900 α YE OLDE MNEMONICS;
01000 ISUBR LAC (ITG Q); START_CODE MOVE 1,@Q END;
01100 RSUBR LACR(ITG Q); START_CODE MOVE 1,@Q END;
01200 ISUBR CAR (ITG Q); START_CODE HLRZ 1,@Q END;
01300 ISUBR CDR (ITG Q); START_CODE HRRZ 1,@Q END;
01400 SUBR DAC (ITG N,Q); START_CODE MOVE N; MOVEM @Q END;
01500 SUBR DACR(REAL X;ITG Q);START_CODE MOVE X;MOVEM @Q END;
01600 SUBR DIP (ITG N,Q); START_CODE MOVE N; HRLM @Q END;
01700 SUBR DAP (ITG N,Q); START_CODE MOVE N; HRRM @Q END;
01800 ISUBR NIP (ITG Q); START_CODE HLRE 1,@Q END;
01900 ISUBR NAP (ITG Q); START_CODE HRRE 1,@Q END;
02000 DEFINE INCREM(A)="A←A+1";
02100 DEFINE DECREM(A)="A←A-1";
00100 SUBR AI(REAL X,Y);⊂ XXX←X*MAG+SOX;YYY←Y*MAG+SOY;⊃;
00200 SUBR AV(REAL X,Y);
00300 BEGIN
00400 REAL X1,Y1,X2,Y2;
00500 X1←XXX;Y1←YYY;X2←XXX←X*MAG+SOX;Y2←YYY←Y*MAG+SOY;
00600 IF CLIP(X1,Y1,X2,Y2) THEN
00700 ⊂ AIVECT(X1,Y1);AVECT(X2,Y2);⊃;
00800 END;
00900
01000 SUBR CROP;
01100 BEGIN "CROP"
01200 REAL OXL,OXH,OYL,OYH;
01300 SOX ← OX - SX*MAG;
01400 SOY ← OY - SY*MAG;
01500 OXL ← (OX - MAG*150*64) MAX -500;
01600 OXH ← (OX + MAG*150*64) MIN 500;
01700 OYL ← (OY - MAG*115*64) MAX -450;
01800 OYH ← (OY + MAG*115*64) MIN 450;
01900 CLIPIN(OXL,OXH,OYL,OYH);
02000 END;
02100
02200 ITG X0,Y0,X,Y,I,RC,R,C;
02300 ITG CNT,BUF;
02400 EXTERNAL SUBR PACXOR;
02500 EXTERNAL ITG SUBR MKVIC;
02600 EXTERNAL SUBR TVDSK;
00100 SUBR DPYPGON(ITG P);
00200 BEGIN "DPYPGON"
00300 ITG X,Y,E,E0,V,BRT;
00400
00500 SUBR GETXY(ITG V);
00600 BEGIN "GETXY"
00700 ITG I,J,K,L;
00800 RC←LAC(V-1);
00900 R←RC LSH-18; C←RC LAND '777777;
01000 Y←(108*64-R)*MAG; X←(C-144*64)*MAG;
01100 END "GETXY";
01200
01300 DPYBIG(1);
01400 E←E0←CAR(P+1);V←CAR(E+1);GETXY(V);AI(X,Y);
01500 DO ⊂ BRT ← ABS(NAP(E-1))%2↑3;
01600 V←CDR(E+1);GETXY(V);
01700 IF BRT≥BRTMIN THEN ⊂ DPYBRT(BRT);AV(X,Y);⊃
01800 ELSE AI(X,Y); ⊃ UNTIL (E←CDR(V+1))=E0;
01900 END "DPYPGON";
02000
02100
02200 SUBR REFRESH;
02300 BEGIN "REFRESH"
02400 EXTERNAL ITG PGON0;
02500 ITG P,E,E0,V,I,CNT;
02600 DPYSET(DPYBUF);
02700 AIVECT(-500,-450);
02800 AVECT(+500,-450);
02900 AVECT(+500,+450);AVECT(-500,+450);AVECT(-500,-450);
03000
03100 P←PGON0; DO ⊂ P ← CDR(P+2);DPYPGON(P);⊃ UNTIL P=PGON0;
03200 DPYOUT(0);
03300 END "REFRESH";
00100 XSUBR MKVICS(ITG Q1,Q2);
00200 INTERNAL SUBR MKVICI;
00300 BEGIN "MKVICI"
00400 ITG Q1,Q2;
00500 SX←SY←0;
00600 MAG ← 7/32; DEL ←32*64;
00700 CROP;
00800 Q1←Q2←0;
00900 IF CUT≤35 THEN DPB(1,POINT(1,Q1,CUT)) ELSE
01000 DPB(1,POINT(1,Q2,(CUT-35)));
01100 MKVICS(Q1,Q2);
01200 REFRESH;
01300 END "MKVICI";
00100 INTERNAL SUBR PLOT;
00200 BEGIN
00300 STRING FILNAM;
00400 INTEGER FLG,CHN;
00500 CHN ← GETCHAN;
00600 OPEN(CHN,"DSK",8,0,3,0,0,0);
00700 DO BEGIN
00800 OUTSTR(13&10&"PLOT FILE = ");
00900 FILNAM ← INCHWL;
01000 ENTER(CHN,FILNAM&".PLT",FLG);
01100 END UNTIL ¬FLG;
01200 ARRYOUT(CHN,DPYBUF[1],DPYBUF[2]);
01300 RELEASE(CHN);
01400 END;
00100 XSUBR HISTOGRAM;
00200 XSUBR DPYHIS;
00300
00400 α CAREYE COMMAND SCANNER - A JUMP TABLE;
00500
00600 INTERNAL PROCEDURE CAREYE;
00700 BEGIN "CAREYE"
00800
00900 OUTSTR(↓&"o");
01000 WHILE TRUE DO
01100 BEGIN "LISTEN"
01200
01300 CHR ← INCHRW;
01400 αβ ← (CHR LSH -7)LAND 3;
01500 CTRL ← CHR LAND '200;
01600 META ← CHR LAND '400;
01700 CHR ← CHR LAND '177;
01800 LETT ← CHR LAND '37;
01900
00100 IF "A"≤CHR ∧ CHR≤"Z" ∨ "a"≤CHR ∧ CHR≤"z" THEN
00200 CASE LETT OF
00300 BEGIN ;
00400 "A" ;
00500 "B" ⊂ STR←INCHWL;BRTMIN←INTSCAN(STR,BRK);REFRESH;OUTSTR("o");⊃;
00600 "C" ⊂ STR←INCHWL;CUT←INTSCAN(STR,BRK);OUTSTR("o");⊃;
00700 "D" ;
00800 "E" ;
00900 "F" ;
01000 "G" ;
01100 "H" ⊂ HISTOGRAM;DPYHIS;⊃;
01200 "I" ⊂ TVDSK;OUTSTR(↓&"o");⊃;
01300 "J" ;
01400 "K" ;
01500 "L" ;
01600 "M" ⊂ MKVICI;OUTSTR(↓&"o");⊃;
01700 "N" ⊂ MKVICI;OUTSTR(↓&"o");⊃;
01800 "O" ;
01900 "P" PLOT;
02000 "Q" ⊂ MKVICS('001020410204,'102041020000);REFRESH;⊃;
02100 "R" ;
02200 "S" ;
02300 "T" ⊂ EXTERNAL SUBR TVCAM;TVCAM;⊃;
02400 "U" ;
02500 "V" ⊂ STR←INCHWL;VBMIN←INTSCAN(STR,BRK);REFRESH;OUTSTR("o");⊃;
02600 "W" ;
02700 "X" ;
02800 "Z" ;
02900 END;
03000
03100 IF CHR=13 THEN ⊂ OUTSTR("o");CONTINUE;⊃;
03200 IF CHR=":" THEN SX←SX+DEL ELSE
03300 IF CHR=";" THEN SX←SX-DEL ELSE
03400 IF CHR=")" THEN SY←SY+DEL ELSE
03500 IF CHR="(" THEN SY←SY-DEL ELSE
03600 IF CHR="/" THEN DEL←(DEL%2)MAX 1 ELSE
03700 IF CHR="\" THEN DEL←(DEL*2) ELSE
03800 IF CHR="*" THEN MAG←MAG*2 ELSE
03900 IF CHR="-" THEN MAG←MAG/2 ELSE CONTINUE;
04000 CROP;REFRESH;
04100
04200 END "LISTEN";
04300 END "CAREYE";
00100 SX←SY←0;
00200 MAG ←7/32;
00300 DEL ←32*64;
00400 CROP;
00500 VBMIN ← 5;
00600 S⊂ PPIOT 2,-250;PPIOT 3,'3003;⊃;
00700 ⊂ ITG I;FOR I←1 TO 20 DO OUTSTR(↓);⊃;
00800 OUTCHR("o");
00900 REFRESH;
01000 CAREYE;
01100
01200 END;