perm filename ARC[3,PMP]1 blob
sn#011764 filedate 1972-11-12 generic text, type T, neo UTF8
00100 TITLE ARC
00200
00300 ↓A←1
00400 ↓B←2 ↓C←3 ↓D←4 ↓E←5 ↓F←6 ↓G←7
00500 ↓P←17 ↓T←15 ↓T1←16 ↓X←13 ↓Y←14
00600
00700 FSIZE←←=10
00800 PDLEN←←200
00900 PDL: BLOCK PDLEN
01000 ZLIST: .+2
01100 ZPNT: XWD -=400,.
01200 BLOCK =400
01300 FSTPNT: 0
01400 STRTDS:
01500 DZL: 0
01600 CURZL: 0
01700 DZU: 10.0
01800 DSCL: 4.0
01900 XOFF: 0
02000 YOFF: 0
02100 CURX: 0
02200 CURY: 0
02210 CCENTX: 0
02220 CCENTY: 0
02300 DBLEN←←400
02400 DSP: DBUF-1
02500 0
02600 0
02700 DBUF: BLOCK DBLEN+2
02800 CURB: .+2
02900 22
03000 0
03100 CURV: 0
03200 BYTE (11)10,10(3)5,0(8)46
03300 BYTE (11)0-20,-20(14)6
03400 BYTE (11)0,20(14)46
03500 BYTE (11) 20,-20(14)6
03600 BYTE (11)0,0(3)3,0(8)46
03700 CURG: 0
03800 0
03900 BLOCK 12
04000
04100
04200 STRT: CALLI
04300 MOVE P,[XWD -PDLEN,PDL-1]
04400 EXTERN JOBREL,JOBSYM
04500 DPYPOS -400
04600 DPYSIZ 4002
04700 MOVE A,JOBSYM
04800 HLRE B,A
04900 SUB A,B
05000 ADDI A,2
05100 HRRZM A,NXTF#
05200 PUSHJ P,CORGET
05300 SETZM WCUR#
05350 SETZM FCLS#
05400 JRST MAIN
05500
00100 DEFINE TONEXT (A)
00200 { ADDI A,1
00300 MOVE X,(A)
00400 TLNE X,-1
00500 JRST .+5
00600 CAIN X,-1
00700 JRST .+4
00800 HRRZ A,X
00900 MOVE X,(A)}
01000 ;→→ NEXT OK
01100 ;→→ NO NEXT
01200
01300 DEFINE GETFST (A,B)
01400 { SKIPN A,FSTPNT
01500 JSR NOFST
01600 MOVE B,(A)
01700 MOVEM B,FSTPNT}
01800
00100 CORGET: HRRZ T,JOBREL
00200 ADDI T,2000
00300 CALLI T,11
00400 JRST 4,.
00500 HRRZ T,NXTF
00600 MOVEM T,FSTPNT
00700 CG1: ADDI T,FSIZE
00800 HRRZM T,-FSIZE(T)
00900 CAMG T,JOBREL
01000 JRST CG1
01100 SUBI T,FSIZE
01200 SETZM -FSIZE(T)
01300 MOVEM T,NXTF
01400 POPJ P,
01500
01600 DISP: MOVE A,ZLIST
01700 HRRZ B,ZPNT
01800 CAMLE A,B
01900 POPJ P,
02000 MOVE E,[XWD -DBLEN,DBUF+1]
02060 MOVEI C,14146
02080 MOVEM C,DBUF
02100 DN1: MOVE C,(A)
02200 MOVE D,(C) ;GET OBJECT TYPE
02220 SETZM 11(C)
02300 JRST @DTAB1(D) ;GO TO ROUTINE FOR OBJECT
02400 DTAB1: .-1
02500 DWALL
02600 DFLOOR
02700 DDOOR
02800 DWIND
02900 DSTAIR
03000
03100
03200 DFLOOR: MOVE D,1(C) ;GET Z LEVEL
03300 CAMGE D,DZL ;IS THIS FLOOR IN THE RANGE?
03400 JRST DNXT ;NO
03500 CAMLE D,DZU ;?
03600 JRST DNXT ;NO
03700 MOVE D,10(C) ;GET POINTER TO CORNER LIST
03800 JUMPE D,DNXT ;NONE?
03820 SETOM 11(C)
03900 MOVEM D,SAVEXY# ;SAVE POINTER TO FIRST X,Y
04000 MOVE X,(D) ;GET X
04100 MOVE Y,1(D) ;GET Y
04200 PUSHJ P,IVECT ;PUT VECTOR THERE
04300 DFL2: ADDI D,1
04400 TONEXT(D)
04500 SKIPA Y,1(D) ;GET NEXT Y
04600 JRST DFL1 ;NO NEXT
04700 PUSHJ P,VECT ;PUT VISIBLE VECTOR THERE
04800 JRST DFL2
04900 DFL1: MOVE D,SAVEXY ;GET STARTING X,Y
05000 MOVE X,(D)
05100 MOVE Y,1(D)
05200 PUSHJ P,VECT
05300 DNXT: ADDI A,1
05400 CAMG A,B
05500 JRST DN1
05600 SETZM (E)
05700 SUBI E,DBUF-2
05800 HRRZM E,DSP+1
05900 UPGIOT 5,DSP
06000 POPJ P,
06100
06200 XYVECT: FAD X,XOFF
06300 FAD Y,YOFF
06400 FMP X,DSCL
06500 FMP Y,DSCL
06600 FIX X,233000
06700 FIX Y,233000
06800 ASH X,=25
06900 DPB Y,[POINT 11,X,21]
07000 POPJ P,
07100 IVECT: PUSHJ P,XYVECT
07200 TROA X,40
07300 VECT: PUSHJ P,XYVECT
07400 TRO X,106
07500 MOVEM X,(E)
07600 AOBJN E,.+2
07700 SUBI E,1
07800 POPJ P,
07900
08000 DWALL: MOVE D,1(C) ;GET Z LEVEL
08100 CAMLE D,DZU ;WALL TOO HIGH?
08200 JRST DNXT ;YES
08300 CAMGE D,DZL ;WALL TOO LOW?
08400 JRST DNXT ;YES
08500 MOVEI F,3(C) ;POINT TO X,Y,X,Y
08600 MOVE G,2(C) ;GET THICKNESS
08650 SETOM 11(C)
08700 PUSHJ P,WALDIS ;DISPLAY THE WALL
08800 JRST DNXT
08900 WALDIS: MOVE X,(F)
09000 MOVE Y,1(F)
09100 FSB X,2(F)
09200 FSB Y,3(F)
09300 MOVEM Y,DY#
09400 MOVEM X,DX#
09500 MOVMS X
09600 MOVMS Y
09700 CAMGE X,Y
09800 EXCH X,Y
09900 FMPR Y,[0.5]
10000 FAD X,Y
10100 MOVEM X,LEN#
10200 MOVE Y,DY
10300 MOVE X,DX
10400 FMPR X,G
10500 FMPR Y,G
10600 FDVR X,LEN
10700 FDVR Y,LEN
10800 MOVEM X,DY
10900 MOVEM Y,DX
11000 DEFINE TEMP $(T1,T2,OFF,TYP)
11100 { MOVE X,OFF(F)
11200 MOVE Y,OFF+1(F)
11300 F$T1 X,DX
11400 F$T2 Y,DY
11500 PUSHJ P,TYP$VECT}
11600
11700 TEMP (AD,SB,0,I)
11800 TEMP (SB,AD,0)
11900 TEMP (SB,AD,2)
12000 TEMP (AD,SB,2)
12100 TEMP (AD,SB,0)
12200 TEMP (SB,AD,2)
12300 TEMP (AD,SB,2,I)
12400 TEMP (SB,AD,0)
12500 POPJ P,
12600
12700 CURDIS: MOVE X,CURX
12800 MOVE Y,CURY
12900 MOVEI E,CURV
13000 PUSHJ P,IVECT
13100 SETZM CURG
13200 SKIPE E,WCUR
13300 PUSHJ P,@(E)[0
13400 WCWAL
13500 WCFLR]
13600 UPGIOT 4,CURB
13700 POPJ P,
13800 WCFLR: MOVEI E,CURG
13900 MOVE B,SAVB#
14000 HLRZ C,B
14100 ADD C,B
14200 MOVE X,-2(C)
14300 MOVE Y,-1(C)
14400 PUSHJ P,IVECT
14500 MOVE B,CURV
14600 TRZ B,40
14700 MOVEM B,CURG+1
14800 MOVEI E,CURG+2
14900 MOVE B,WCUR1#
15000 MOVE X,(B)
15100 MOVE Y,1(B)
15200 PUSHJ P,VECT
15300 SETZM CURG+3
15400 POPJ P,
15500 WCWAL: MOVEI E,CURG
15600 HRLI E,400000
15700 MOVE F,WCUR1
15800 ADDI F,3
15900 MOVEI G,2(F)
16000 HRLI G,CURX
16100 BLT G,3(F)
16200 MOVE G,-1(F)
16300 PUSHJ P,WALDIS
16400 SETZM (E)
16500 POPJ P,
16600
16700 NUMDIS: SETZM DBUF
16800 AOS DBUF
16900 MOVE T,[XWD DBUF,DBUF+1]
17000 BLT T,DBUF+100
17100 MOVEI T,DBUF
17200 MOVE X,[BYTE(11)100,-700(3)4,3(8)146]
17300 MOVEI Y,STRTDS
17400 MOVEI C,3
17500 NDS1: MOVE A,(Y)
17600 FIX A,233000
17700 MOVEM X,(T)
17800 ADDI T,1
17900 HRLI T,440700
18000 PUSHJ P,NUMC
18100 ADDI T,1
18200 ADDI Y,1
18300 ADD X,[BYTE(11)200]
18400 SOJG C,NDS1
18500 SETZM (T)
18600 SUBI T,DBUF-2
18700 HRRZM T,DSP+1
18800 UPGIOT 6,DSP
18900 POPJ P,
19000 NUMC: IDIVI A,12
19100 JUMPE A,.+4
19200 HRLM B,(P)
19300 PUSHJ P,NUMC
19400 HLRZ B,(P)
19500 ADDI B,60
19600 IDPB B,T
19700 POPJ P,
19800
19900 INSCUR: MOVE X,CURX
20000 MOVE Y,CURY
20100 INSXY: HLRZ E,B
20200 ADDI E,2
20300 CAIL E,FSIZE
20400 JRST INSXN
20500 HRL B,E
20600 ADD E,B
20700 MOVEM X,-2(E)
20800 MOVEM Y,-1(E)
20900 SETZM (E)
21000 HLLOS (E)
21100 POPJ P,
21200 INSXN: PUSH P,D
21300 GETFST T,D
21400 POP P,D
21500 ADD E,B
21600 HRRZM T,-2(E)
21700 HRRZ B,T
21800 JRST INSXY
21900
22000 INTERS: MOVE T,(B)
22100 FSB T,(A) ;DX1
22200 MOVEM T,DX1#
22300 MOVE X,1(B)
22400 FSB X,1(A) ;DY1
22500 MOVEM X,DY1#
22600 FDVR T,X ;M1
22700 MOVE T1,(D)
22800 FSB T1,(C) ;DX2
22900 MOVE Y,1(D)
23000 FSB Y,1(C) ;DY2
23100 MOVEM T1,DX2#
23200 MOVEM Y,DY2#
23300 FDVR T1,Y ;M2
23400 JUMPE X,DY1ZER
23500 JUMPE Y,DY2ZER
23600 MOVE X,T
23700 FSB X,T1
23800 JUMPE X,NOI1
23900 MOVE Y,1(A)
24000 FMPR Y,T
24100 FMPR T1,1(C)
24200 FSB Y,T1
24300 FSB Y,(A)
24400 FAD Y,(C)
24500 FDVRB Y,X
24600 FSB X,1(A)
24700 FMPR X,T
24800 MOVEM X,DX
24900 FAD X,(A)
25000 SKIPN T,DX1
25100 JRST INDZ1
25200 SKIPN DX
25300 JRST EP1
25400 XOR T,DX
25500 JUMPG T,EP1
25600 INDZ1: MOVE T,1(A)
25700 FSB T,Y
25800 JUMPE T,EP1
25900 XOR T,DY1
26000 JUMPG T,NOI1
26100 JUMPE T,EP1
26200 IN1: SKIPN T,DX2
26300 JRST INDZ2
26400 MOVE T,(C)
26500 FSB T,X
26600 JUMPE T,EP2
26700 XOR T,DX2
26800 JUMPG T,NOI1
26900 JUMPE T,EP2
27000 INT1: AOS (P)
27100 EP2: AOS (P)
27200 EP3: AOS (P)
27300 NOI1: POPJ P,
27400 EP1: SKIPN T,DX2
27500 JRST INDZ3
27600 MOVE T,(C)
27700 FSB T,X
27800 JUMPE T,EP3
27900 XOR T,DX2
28000 JUMPG T,NOI1
28100 JRST EP3
28200 INDZ3: MOVE T,1(C)
28300 FSB T,Y
28400 JUMPE T,EP3
28500 XOR T,DX2
28600 JUMPG T,NOI1
28700 JRST EP3
28800 INDZ2: MOVE T,1(C)
28900 FSB T,X
29000 JUMPE T,EP2
29100 XOR T,DX2
29200 JUMPG T,NOI1
29300 JUMPE T,EP2
29400 JRST INT1
29500
29600 SQRTX: LDB T,[POINT 5,X,7]
29700 MOVNS T
29800 MOVE Y,X
29850 TLNE X,200000
29900 FSC X,(T)
30000 MOVEI T,10
30100 MOVE T1,Y
30200 FDVR T1,X
30300 FAD T1,X
30400 FDVR T1,[2.0]
30500 MOVE X,T1
30600 SOJG T,.-5
30700 POPJ P,
30800
30900 CORNL: BLOCK 10
31000 WCORN: MOVE X,3(C)
31100 MOVE Y,4(C)
31200 FSB X,5(C)
31300 FSB Y,6(C)
31400 MOVEM Y,DY
31500 MOVEM X,DX
31600 FMPR X,X
31700 FMPR Y,Y
31800 FAD X,Y
31900 PUSHJ P,SQRTX
32000 MOVEM X,LEN
32100 MOVE X,DX
32200 MOVE Y,DY
32300 FMPR X,2(C)
32400 FMPR Y,2(C)
32500 FDVR X,LEN
32600 FDVR Y,LEN
32700 DEFINE TEMP $(A,B,C)
32800 { MOV$A$M B,CORNL+C
32900 MOV$A$M B,CORNL+C+4}
33000 TEMP (E,Y,0)
33100 TEMP (N,X,1)
33200 TEMP (N,Y,2)
33300 TEMP (E,X,3)
33400 MOVE X,3(C)
33500 MOVE Y,4(C)
33600 FADM X,CORNL
33700 FADM Y,CORNL+1
33800 FADM X,CORNL+2
33900 FADM Y,CORNL+3
34000 MOVE X,5(C)
34100 MOVE Y,6(C)
34200 FADM X,CORNL+4
34300 FADM Y,CORNL+5
34400 FADM X,CORNL+6
34500 FADM Y,CORNL+7
34600 POPJ P,
34700
34800 CLDIS: SKIPN A,FCLS
34900 JRST CLDON
35000 TRZN A,10
35100 JRST @(A)[0
35200 CLDW
35300 CLDF]
35400 JRST @(A)[CLDP
35500 CLDL]
35600 CLDON: UPGIOT 7,.+2
35700 CPOPJ: POPJ P,
35800 .+1
35900 0
36000 0
36100 CLBP: CLBUF
36200 10
36300 CLBUF: 0
36400 0
36500 BYTE (11)0-11,-11(3)7,0(8)46
36600 BYTE (11) 22, 0(14) 6
36700 BYTE (11) 0, 22(14) 6
36800 BYTE (11)0-22, 0(14) 6
36900 BYTE (11)0 ,-22(14) 6
37000 0
37100
37200 CLDW: JSR CLCOM
37300 MOVEI D,1
37400 CLP1: MOVE C,(A)
37500 CAME D,(C)
37600 JRST CLWD
37700 SKIPN 11(C) ;DOES IT DISPLAY?
37800 JRST CLWD
37900 MOVEI E,3(C)
38000 MOVEI F,5(C)
38100 PUSHJ P,CLINE
38200 CLWD: ADDI A,1
38300 SOJG B,CLP1
38400 MOVE E,CLPNT1
38500 SKIPN CLPNTR
38600 JRST CLDON
38700 MOVE X,2(E)
38800 MOVE Y,3(E)
38900 FINLN: FAD X,(E)
39000 FAD Y,1(E)
39100 FSC X,-1
39200 FSC Y,-1
39300 CLEND: MOVEI E,CLBUF+1
39400 PUSHJ P,IVECT
39500 UPGIOT 7,CLBP
39600 POPJ P,
39700 CLCOM: 0
39800 HRRZ A,ZPNT
39900 MOVE B,A
40000 SUB B,ZLIST
40100 HRRZS B
40200 SETZM CLPNTR#
40300 MOVSI D,277700
40400 MOVEM D,CLDIS#
40500 JUMPE B,CLDON
40600 JRST @CLCOM
40700 CLDF: JSR CLCOM
40800 MOVEI D,2
40900 CLP2: MOVE C,(A)
41000 CAME D,(C)
41100 JRST CLFD
41200 SKIPN 11(C)
41300 JRST CLFD
41400 MOVE E,10(C) ;GET CORNER POINTER
41500 CLP3: PUSHJ P,CLPNT
41600 TONEXT(E)
41700 JRST CLP3
41800 CLFD: ADDI A,1
41900 SOJG B,CLP2
42000 FINPN: SKIPN CLPNTR
42100 JRST CLDON
42200 MOVE E,CLPNT1
42300 MOVE X,(E)
42400 MOVE Y,1(E)
42500 JRST CLEND
42600 CLDP: JSR CLCOM
42700 MOVEI D,1
42800 CLP4: MOVE C,(A)
42900 CAME D,(C)
43000 JRST CLPD
43100 SKIPN 11(C)
43200 JRST CLPD
43300 PUSHJ P,WCORN
43400 MOVEI F,4
43500 MOVEI E,CORNL
43600 PUSHJ P,CLPNT
43700 ADDI E,2
43800 SOJG F,.-2
43900 CLPD: ADDI A,1
44000 SOJG B,CLP4
44100 JRST FINPN
44200 CLDL: JSR CLCOM
44300 MOVEI D,2
44400 CLP5: MOVE C,(A)
44500 CAME D,(C)
44600 JRST CLLD
44700 SKIPN 11(C)
44800 JRST CLLD
44900 MOVE E,10(C)
45000 MOVE G,E
45100 MOVE F,E
45200 TONEXT (F)
45300 SKIPA
45400 JRST CLLD
45500 CLP6: PUSHJ P,CLINE
45600 MOVE E,F
45700 TONEXT (F)
45800 JRST CLP6
45900 MOVE F,G
46000 PUSHJ P,CLINE
46100 CLLD: ADDI A,1
46200 SOJG B,CLP5
46300 SKIPN CLPNTR
46400 JRST CLDON
46500 MOVE E,CLPNT1
46600 MOVE F,CLPNT2
46700 MOVE X,(F)
46800 MOVE Y,1(F)
46900 JRST FINLN
47000 CLPNT: MOVE X,(E)
47100 MOVE Y,1(E)
47200 FSB X,CURX
47300 FSB Y,CURY
47400 MOVMS X
47500 MOVMS Y
47600 CAMG X,Y
47700 EXCH X,Y
47800 FMPR Y,[0.5]
47900 FAD X,Y
48000 CAML X,CLDIS
48100 POPJ P,
48200 MOVEM C,CLPNTR
48300 MOVEM X,CLDIS
48400 MOVEM E,CLPNT1#
48500 POPJ P,
48600
48700 CLINE: MOVE X,(E)
48800 MOVE Y,1(E)
48900 FSB X,(F)
49000 FSB Y,1(F)
49100 JUMPE Y,CLYZER
49200 FDVR X,Y
49300 MOVEM X,DX
49400 FMPR X,X
49500 FAD X,[1.0]
49600 PUSHJ P,SQRTX
49700 MOVEM X,LEN
49800 MOVN Y,CURY
49900 FMPR Y,DX
50000 FAD Y,CURX
50100 MOVN X,1(E)
50200 FMPR X,DX
50300 FAD X,Y
50400 FSB X,(E)
50500 FDVR X,LEN
50600 GOTLEN: CAML X,CLDIS
50700 POPJ P,
50800 MOVEM C,CLPNTR
50900 MOVEM X,CLDIS
51000 MOVEM E,CLPNT1
51100 MOVEM F,CLPNT2#
51200 POPJ P,
51300 CLYZER: MOVE X,CURY
51400 FSB X,1(E)
51500 JRST GOTLEN
51600
00100 FOR @$ I←0,177
00200 { DEFINE FOO$I{JFCL}
00300 }
00400 DEFINE FO (A,B)
00500 {FO2(→"A",B)}
00600 DEFINE FO2 $(A,B)
00700 {DEFINE FOO$A{JRST B}}
00800 DEFINE CBBIT $(A,B,C,Q,E)
00900 { JRST @(D).+1
00950 IFE B,<MERR;>A$0
01000 IFE C,<MERR;>A$1
01100 IFE Q,<MERR;>A$2
01200 IFE E,<MERR;>A$3
01300 }
01400 FO(<(>,MCL1)
01500 FO(<[>,MCL2)
01600 FO(<)>,MCR1)
01700 FO(<]>,MCR2)
01800 FO(</>,MCU1)
01900 FO(<∂>,MCU2)
02000 FO(<\>,MCD1)
02100 FO(<∞>,MCD2)
02200 FO(<*>,MAKS)
02300 FO(<⊗>,MAKL)
02400 FO(F,CF)
02500 FO(+,CPLS)
02600 FO2(175,CALT)
02700 FO(W,CW)
02800 FO(∩,CMUB)
02900 FO(∪,CMLB)
03000 FO(↑,CUPA)
03100 FO(↓,CDNA)
03200 FO(<≡>,CMBB)
03300 FO(P,CP)
03400 FO(M,CM)
03500 FO(D,CD)
03600 FO(C,CC)
03700 FO(R,CR)
03710 FO(L,CL)
03715 FO(U,CU)
03720
03800
03900
04000 CMUB: CBBIT(CMUB,0,1,1,0)
04100 CMLB: CBBIT(CMLB,0,1,1,0)
04200 CMBB: CBBIT(CMBB,0,1,1,1)
04210 CC: CBBIT(CC,0,1,1,1)
04220 CR: CBBIT(CR,0,1,1,0)
04230 CF: CBBIT(CF,0,1,1,0)
04240 CW: CBBIT(CW,0,1,1,0)
04250 CP: CBBIT(CP,0,0,1,0)
04260 CM: CBBIT(CM,0,1,1,0)
04270 CD: CBBIT(CD,0,1,0,0)
04280 CL: CBBIT(CL,0,0,1,0)
04285 CU: CBBIT(CU,0,0,1,0)
04290
04300
04400
04500 DTAB2:
04600 FOR @$ I←0,177
04700 { FOO$I
04800 }
00100 GETCOM: INCHRW C
00200 POPJ P,
00300 DISTAB: DTAB2(C)
00400
00500 MAIN: PUSHJ P,CURDIS