-
Notifications
You must be signed in to change notification settings - Fork 0
/
KLH; DAZDRT 110
1984 lines (1747 loc) · 43.5 KB
/
KLH; DAZDRT 110
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
title dazdrt
subttl Accumulator Definitions and Assembly Parameters
.mllit==1
f=0 ;flag register
a=1
b=2
c=3
d=4
e=5
t=6 ;temps
tt=7
pwb=10 ;index to player with beam (always !!!!)
plr=11 ;player index (random)
DP=14 ;DISP BLKO PTR
DL=15 ;DISP LIST PTR
ia=16 ;APR interrupt acc
p=17 ;pdl acc
nplyrs==4 ;# of players
DEFINE SETF TEXT,FLG ;useful set-flag macro!
IFDEF FLG,.STOP
.TAG FOOBAR
PRINTC "TEXT
FLG="
.TTYMAC FLAG
IFSE FLAG,YES,FLG==1
IFSE FLAG,NO,FLG==0
IFSE FLAG,Y,FLG==1
IFSE FLAG,N,FLG==0
IFNDEF FLG,FLG==FLAG
TERMIN
IFNDEF FLG,.GO FOOBAR
TERMIN
SETF [Run under ITS?]$ITS
subttl Processor state definitions
;---------- bit definitions -------------------
;produces BIT2.3, BIT35 type defs
radix 10.
define bitdef a,b,c
bit!a!.!b==1_<<a-1>*9.+<b-1>>
bit!c==1_<35.-c>
termin
%%3=-1
repeat 4,[%%1==.rpcnt+1 ? repeat 9.,[%%2==.rpcnt+1 ? %%3==%%3+1
bitdef \%%1,\%%2,\%%3
]]
radix 8.
; ------ PDP-6 APR condition flags
;CONO
A%rpov==bit18 ;reset the PDL OV flag
A%rio== bit19 ;I/O reset
A%rmp== bit22 ;reset the Memory Protection flag
A%rnxm==bit23 ;reset the nonexistent Memory flag
A%ccez==bit24 ;turn the Clock Count Enable flag off
A%cceo==bit25 ;turn the Clock Count Enable flag on
A%clkz==bit26 ;turn the Clock flag off
A%pcez==bit27 ;turn the PC Change Enable flag off
A%pceo==bit28 ;turn the PC Change Enable flag on
A%pcfz==bit29 ;turn the PC Change flag off
A%ovez==bit30 ;turn the OV flag enable off
A%oveo==bit31 ;turn the OV flag enable on
A%ovfz==bit32 ;turn the OV flag off
;33-35 = assign PI Channel to APR flags (listed above)
;define name to reset/clear all flags and I/O
a%STRT==a%RPOV+a%RIO+a%RMP+a%RNXM+a%CCEZ+a%CLKZ+a%PCEZ+a%PCFZ+a%OVEZ+a%OVFZ
;CONI
A%pov== bit18 ;PDL OV flag set
A%ilop==bit22 ;Illegal Instruction flag set
A%nxm== bit23 ;non-existent Memory flag set
A%cce== bit25 ;Clock Count enable on
A%clk== bit26 ;Clock Count flag set
A%pce== bit28 ;PC Change enable on
A%pcf== bit29 ;PC Change flag set
A%ove== bit31 ;OV enable on
A%ovf== bit32 ;OV flag set
;33-35 = set to the current PI channel assignment
;-------- PDP-6 Priority Interrupt system flags
;CONO
P%clr== bit23 ;clear the PI system
P%act== bit24 ;activate interrupt on channels selected (29-35)
P%cenb==bit25 ;enable channels selected (")
P%cdsb==bit26 ;disable channels selected (")
P%off== bit27 ;turn off the PI system
P%on== bit28 ;turn on the PI system
;29-35 = channel select: bit 29 selects channel 1,
; bit 35 selects channel 7, etc
;CONI
P%piup==bit28 ;PI system is on
;29-35 = if a bit is 1, corresponding channel is on.
;---------- 340 display flags
;CONO
D%init==bit1.7 ;initialize display
D%cont==bit1.8 ;resume display after special interrupt
;---------- Flag register (F)
%pfneg==bit1.1 ;for PFDVR, PFMPR etc
%m1inf==bit1.2 ;for intrsc routine
%m2inf==bit1.3 ; "
%zfire==bit1.4 ;set when beam being zapped
%lnchk==bit1.6
%dexch==bit1.6 ;for drwlin routine
%rstrt==bit1.7 ;indicates restart from lossage, dont reset scores
;---------------------------------------------
aprchn==4 ;processor has highest priority pi channel
dspchn==5 ;special interrupt channel for display
dischn==6 ;normal 'done' channel for display
imxchn==7 ;IMX data channel (pots)
imx==574
..d574==574
aprpic==bit1.3 ;channels as represented in PI condition word
dsppic==bit1.2
dispic==bit1.1
IFE $ITS,[
loc aprchn*2+40
jsr aprbrk ;processor (clock) interrupt vector
loc dspchn*2+40
jsr dspbrk ;special interrupt on display
loc dischn*2+40
blko dis,DP ;display output instr for PI system
jsr disbrk ;int vector when BLKO done
]
IFN $ITS,[
LOC 42
JSR TSINT
]
loc 100
trza f,%rstrt ;set that this is not a restart
tro f,%rstrt ; if started at 10, this is a restart
Jrst go
patch: block 100
pdllen==20
pdl: -pdllen,,pdl
block pdllen
cpie==3.1415926535
cpie.5==1.5707963
cpi1.5==4.7123889
PIE: 3.1415926535
PI$2: 6.2831853072
PI.5: 1.5707963
subttl Macro definitions
maxflo: 377777,,-1 ;maximum floating point value
JOV=<jfcl 10,> ;jump on overflow
DEFINE PFMPR ac,loc
jov .+1
fmpr ac,loc
jov [caige ac,0
troa f,%pfneg
trz f,%pfneg
movm ac,ac
caml ac,[177400,,0]
jrst [setz ac, ? jrst .+1]
move ac,maxflo
trze f,%pfneg
movn ac,ac ? jrst .+1]
TERMIN
DEFINE PFDVR ac,loc
jov .+1
skipn loc
jrst [cail ac,0
skipa ac,maxflo
movn ac,maxflo ? jrst .+3]
fdvr ac,loc
jov [caige ac,0
troa f,%pfneg
trz f,%pfneg
movm ac,ac
caml ac,[201400,,0]
jrst [setz ac, ? jrst .+1]
move ac,maxflo
trze f,%pfneg
movn ac,ac ? jrst .+1]
TERMIN
DEFINE PFADR ac,loc
jov .+1
fadr ac,loc
jov [call ac,0
skipa ac,maxflo
movn ac,maxflo
jrst .+1]
TERMIN
;find intersection of lines specified and leave xi,yi in a,b
;xi= (b1-b2)/(m2-m1)
;yi= m1 xi+b1
;where b=y-mx
slplim: 1.0^30 ;criterion for 'infinite'; maxflo is approx 1.E38
DEFINE INTRSC DM1,DX1,DY1,DM2,DX2,DY2
move a,DM1
movem a,m1
move a,dx1
movem a,x1
move a,dy1
movem a,y1
move a,dm2
movem a,m2
move a,dx2
movem a,x2
move a,dy2
movem a,y2
pushj p,intcal
TERMIN
x1: 0
y1: 0
m1: 0
x2: 0
y2: 0
m2: 0
intcal: push p,c
push p,d
push p,e
trz f,%m1inf+%m2inf
movm c,M1
caml c,slplim
troa f,%m1inf
jrst [movn c,M1
fmpr c,X1
fadr c,Y1 ;B1=Y1-M1X1
jrst .+1]
movm d,M2
caml d,slplim
troa f,%m2inf
jrst [movn d,M2
fmpr d,X2
fadr d,Y2 ;B2=Y2-M2X2
jrst .+1]
move b,M1
move e,b
fsbr b,M2 ;M1-M2
;(b)=M1-M2 (c)=B1 (d)=B2 (e)=M1
trnn f,%m1inf+%m2inf ;either infinite?
jrst intrs2 ;no, normal crunching.
setz a,
trne f,%m1inf
jrst [trne f,%m2inf ;1st infinite, 2nd also?
jrst intrs9 ;yes, no intersection
move a,X1
move b,M2
fmpr b,X1
fadr b,d ;Y=B2+M*X1
; move b,d ;X=X1, Y=B2 If M1 infinite
jrst intrs7]
move a,X2
move b,X2
fmpr b,M1
fadr b,c
; move b,c ;X=X2, Y=B1 if M2 infinite
jrst intrs7
intrs2: jumpe b,intrs9 ;if M1-M2 then lines parallel
move a,d
fsbr a,c ;(B2-B1)
PFDVR a,b ;(B2-B1)/(M1-M2) = X
move b,a
PFMPR b,e ;X*M1
fadr b,c ;X*M1+B1 = Y
intrs7: pop p,e
pop p,d
pop p,c
aos (p)
popj p,
intrs9: pop p,e
pop p,d
pop p,c
popj p,
define conc a,b
a!b!termin
define ssfix a,b
muli a,400
tsc a,a
ash a+1,-243+19.!b(a)
termin
;floating to`integer conversion -- works for pos/neg
define ifix a
push p,a+1
ssfix a,-19.
move a,a+1
pop p,a+1
termin
;floating to fractional integer conversion; integer in LH, fraction in RH
define frifix a
push p,a+1
ssfix a,-1
move a,a+1
pop p,a+1
termin
subttl interrupt handlers
IFE $ITS,[
;processor interrupt handler
aprbrk: 0
coni apr,ia ;get apr conditions into interrupt acc
trnn ia,A%clk ;clock interrupt?
jrst aprbr2 ;no, don't do clock hackery...go check for bad news
;clock interrupt
sosle clkcnt ;count off one tick
jrst aprbr1 ;and don't unset lock if haven't finished countdown
setom clksnk ;ah! unset synchronization lock
move ia,steptm ;get # tics per game step
movem ia,clkcnt ;and reset count.
aprbr1: cono apr,a%cceo+A%clkz+aprchn ;turn off clock flag and make sure enabled
jrst 12,@aprbrk ;and dismiss interrupt
aprbr2: movem ia,aprcns
jsr death ;for time being, all non-clock ints are no-no's...
]
aprcns: 0 ;apr conditions if die
steptm: 1 ;duration of a game step in ticks (1 tick= 1/60 sec)
clkcnt: 0 ;tick countdown; when steptm ticks done, setom cklsnk.
clksnk: 0 ;synch lock; each game step must wait until set to -1
DDT==34000 ;SA of DDT when present in 6.
death: 0 ;JSR'd here so can tell where came from.
jrst 4,DDT ;stop with PC->DDT so 'continue' get's DDT
IFN $ITS,[
TSINT: 0
0
SKIPGE IA,TSINT
.DISMIS TSINT+1
TLNN IA,200000
.DISMIS TSINT+1
SETOM CLKSNK
.SUSET [.SAMASK,,[200000,,0]]
.DISMIS TSINT+1
]
IFE $ITS,[
DISBRK: 0
DISBR0: TRNN DL,-1 ;ADDR OF NEXT ITEM IN RH?
MOVE DL,DISLST ;NO, GET PTR TO BEG OF CURRENT DISLIST
MOVE DL,(DL) ;GET ITEM
HLRZ DP,DL ;GET ADDR OF BLKO PTR FOR ITEM
JUMPE DP,DISBR0 ;NOTHING THERE, GET NEXT ITEM
SKIPL DP,(DP) ;GET BLKO PTR
JRST DISBR0 ;AGAIN NOTHING THERE, GET NEXT.
JRST 12,@DISBRK ;RETURN
DSPBRK: 0 ;SPECIAL DISPLAY INTERRUPT
; HLRZ DP,DL ;GET ADDR OF BLKO THAT INTERRUPTED
; CAIN DP,BKPT1 ;IF WAS DOING FIRST BACKGROUND,
; MOVE DL,(DL) ;SKIP NEXT (2ND BACKGND) ITEM.
DSPBR1: TRNN DL,-1
MOVE DL,DISLST
MOVE DL,(DL)
HLRZ DP,DL
JUMPE DP,DSPBR1
SKIPL DP,(DP)
JRST DSPBR1
CONO DIS,D%INIT+DSPCHN_3+DISCHN
JRST 12,@DSPBRK ;RETURN
DEFINE DSTART
MOVE DL,DISLST
MOVE DP,[-1,,[0]-1]
CONO DIS,D%INIT+<DSPCHN_3>+DISCHN
TERMIN
]
IFN $ITS,[
DEFINE DSTART
.DSTART DISLST
.VALUE [ASCIZ /:DISPLAY NOT AVAIL
/]
TERMIN
]
vbfend: pushj p,disran ;display random stuffs
MOVE B,VDSW
move t,vdlipt ;get addr to end of vlist currently being written
movei a,3000 ;get stop command
movem a,(t) ;terminate vlist
HRRZ T,T
HRRZ A,VDCUR
SUB T,A
CAIGE T,
SETZ T,
MOVN T,T
HRLZ T,T
HRR T,VDCUR
MOVEM T,VDPTR+1(B)
MOVEI A,DSTL+1(B)
MOVEM A,DISLST
SETCAB B,VDSW
MOVE A,VDPTAB+1(B)
MOVEM A,VDCUR
ADDI A,1
HRRZM A,VDLIPT
POPJ P,
subttl main program
;one time initialization
go: move p,pdl
IFE $ITS,[
cono apr,a%STRT+aprchn ;clear all APR flags and i/o
cono apr,a%cceo+aprchn ;enable clock ints
cono 420,40 ;enable 36-bit input array
cono pi,p%clr+p%cenb+p%on+aprpic+dispic+dsppic ;PI reset+assignments
]
IFN $ITS,[
MOVE A,[600000,,STEPTM]
.REALT A,
JFCL
.SUSET [.SMASK,,[200000,,0]]
.SUSET [.SPICLR,,[-1]]
.OPEN IMXCHN,[.BII,,'IMX]
.VALUE [ASCIZ /: OPEN OF IMX FAILED?
/]
]
;series initialization
series: pushj p,bsetup ;set up board if necessary
IFE $ITS,[
cono dis,d%init ;reset/initialize display
]
movsi plr,-nplyrs
seri: setzm plscor(plr) ;whatever.
move a,splen ;standard player length
movem a,plen(plr)
fmpr a,a
movem a,plensq(plr)
aobjn plr,seri
trne f,%rstrt
jrst game ; if this is restart, don't zero the scores
setzm tmscor ;zero scores
setzm tmscor+1
;game initialization
game: setzm f
pushj p,zassgn ;decide which player gets beam (initialize PWB)
move a,ztime
movem a,ztmlft
imuli a,60.
movem a,ztim60
setzm a,passtm ;make sure pass timer is zero
movsi plr,-nplyrs
game1: move a,pinitx(plr)
movem a,plocx(plr)
move a,pinity(plr)
movem a,plocy(plr)
move a,pinita(plr)
movem a,plang(plr)
setzm input(plr)
pushj p,updat
pushj p,plrdis ;update player (plr) and display him
aobjn plr,game1
; movei a,distrt-1 ;set up blko ptr
; movem a,disptr
; setzm vdlflg
; setzm vdlloc
; setom vdlapr
MOVE B,VDSW
HRRZ a,VDPTAB+1(B)
MOVEM A,VDCUR
ADDI A,1
movem a,vdlipt
MOVE A,DBDPT
MOVEM A,BDPT
MOVEI A,DSTL3
MOVEM A,DISLST
DSTART
; cono dis,d%init+dischn+dspchn_3 ;start display with PI assigned
subttl main processing loop
gamlup: pushj p,vbfend ;switch var. display buffers
aose clksnk ;wait for clock synch
IFE $ITS,[
jrst .-1
datai a ;for DDT hacking in the 6
trze a,1
break: jfcl
]
IFN $ITS,[
.HANG
MOVE A,[-2,,[.SPIRQC,,[0] ? .SIMASK,,[200000,,0]]]
.SUSET A
]
pushj p,inpget ;get inputs for all players
movsi plr,-nplyrs
pushj p,updat
aobjn plr,.-1
setcmm ransw'
move a,ztim60 ;beam-possession time left in 60th's
sub a,steptm
jumpge a,gamlp0
movsi a,-nplyrs
gaml01: move b,tmon(a)
camn b,tmon(pwb)
aobjn a,gaml01
skipe ransw
addi a,1
movei pwb,(a)
setzm passtm;when beam changes hands, pass timer is 0
move a,ztime
imuli a,60.
gamlp0: movem a,ztim60
addi a,59.
idivi a,60.
movem a,ztmlft ;time left, in seconds
move a,pwb ;get index to player with beam * 4
ash a,2
skipg b,passtm ;has the passing timer run out yet?
jrst tstpas
sub b,steptm ;subtract the number of 60ths gone by from it
movem b,passtm
tstpas: skipl inval+fire(a) ;is he passing beam?
jrst tstfir
move pwb,tmmate(pwb) ;if so, transfer.
move b,paslim ; set pass timer going
movem b,passtm
tstfir: move a,pwb ;note that pwb may have changed...this is the idea.
ash a,2
skiple inval+fire(a) ;is PWB firing?
troa f,%zfire ;yes, set global flag and skip
trz f,%zfire ;clear flag otherwise
movsi plr,-nplyrs
gamlp1: pushj p,plrdis ;display new position etc.
aobjn plr,gamlp1
trnn f,%zfire ;now see if beam was fired
jrst gamlup ;nope, just loop back and wait.
;aha! if skipped over to here, means-must compute beam path!
;first must initialize beam variables
setzm zbounc ;# of bounces
move a,plang(pwb) ;angle of beam
fadr a,pi.5 ;get angle+90 deg
caml a,pi$2 ;normalize
fsbr a,pi$2
movem a,zangle
move a,plsin(pwb)
movnm a,zcos ;cos (ang+90)= -sin (ang)
move a,plcos(pwb)
movem a,zsin ;sin (ang+90)= cos(ang)
move a,plocx(pwb)
movem a,zstrtx
move a,plocy(pwb)
movem a,zstrty
move a,zsin
PFDVR a,zcos ;find (possibly infinite) slope
movem a,zslope
movem pwb,zfrom ;indicate which player beam coming from
trz f,%lnchk ;clear check-boundary-lines flag.
;loops once for each straight line path
zlup: movsi plr,-nplyrs
zlup0: setom zbestd
setom zbestp ;clear locs which save closest termination of this path
;loops thru each player seeing if this path hits anyone
zlup1: hrrz a,plr ;get # of player being checked
camn a,zfrom ;same as player beam is coming from?
jrst zlup50 ;yep, don't check this one.
intrsc zslope,zstrtx,zstrty,plslop(plr),plocx(plr),plocy(plr)
jrst zlup50 ;no skip if no intersection
trne f,%lnchk
jrst zlup2 ;skip within-ness check if doing boundaries
caml a,blowx ;check if intersection within board limits
camle a,bhighx
jrst zlup50 ;out-of-bounds
caml b,blowy
camle b,bhighy
jrst zlup50 ;out
zlup2: pushj p,angchk
jrst zlup50 ;not pointing in right direction
trne f,%lnchk
jrst zlup25 ;skip hit-it check if doing boundaries
move c,plocx(plr) ;see if intersction is close enough to player to hit him
move d,plocy(plr) ;set up to find dist
pushj p,distsq ;leave result in c
camle c,plensq(plr) ;compare with player radius squared
jrst zlup50 ;no skip=nope
zlup25: move c,zstrtx ;find distance from start of this path to the intersection.
move d,zstrty
pushj p,distsq ;find distance (squared) in c
skipge zbestd ;have any hits already?
jrst zlup3 ;nope, skip the closeness check
caml c,zbestd ;see if it's any closer than closest so far
jrst zlup50 ;nope, forget about it
zlup3: movem c,zbestd ;ah! closer...store its vars
movem a,zbestx
movem b,zbesty
hrrzm plr,zbestp
zlup50: aobjn plr,zlup1 ;loop on thru players
skipge plr,zbestp ;found any hits?
jrst [troe f,%lnchk ;nope, go check board boundaries.
jsr death ;couldn't find boundary hit
move plr,[-4,,nplyrs]
jrst zlup0]
trne f,%lnchk
jrst zlup90 ;boundary hit!
;found a solid hit on a player. now must bounce it off.
move a,zstrtx ;draw line from starting pt
move b,zstrty
move c,zbestx ;to bounce pt
move d,zbesty
pushj p,drwlin ;do it
aos a,zbounc ;increment bounce cnt
hrrzm plr,zbnclt-1(a) ;record the player bounced off of
cail a,zmaxbc ;skip if not yet reached max # bouncts.
jrst [move pwb,zbestp ;ah! beam ownership transfers!
setzm passtm ;zero the pass timer
move a,ztime ;but start a new, ownership timout
movem a,ztmlft
imuli a,60.
movem a,ztim60
jrst gamlup]
movem c,zstrtx ;else do again, relative to new starting place
movem d,zstrty
pushj p,reflct ;find reflected angle of beam
movem a,zangle ;store
push p,a
pushj p,cos ;now get vars related to angle.(sin,cos,tan)
movem a,zcos
pop p,a
pushj p,sin
movem a,zsin
PFDVR a,zcos
movem a,zslope
hrrzm plr,zfrom
jrst zlup ;now do another straight beam path....
;boundary hit!
zlup90: move a,zstrtx
move b,zstrty
move c,zbestx
move d,zbesty
pushj p,drwlin ;draw final leg
;now determine if hit a goal...
skipg zbounc ;bounced off someone?
jrst gamlup ;no, back to game.
movei plr,-4(plr) ;adjust index (not pointing into player tables now)
skipn bglflg(plr) ;is line a goal line?
jrst gamlup ;nope. loop back
move a,zbestx ;get x coord of hit.
camle a,bglow(plr) ;test low value coordinate of boundary
caml a,bghigh(plr) ;test high "
jrst gamlup ;if no hit
;aha! hit goal! whoopee etc...
pushj p,goalht ;go do whatever
jrst game ;back to another game
subttl calculational subroutines
distsq: push p,d
fsbr c,a
fsbr d,b
fmpr c,c
fmpr d,d
fadr c,d
pop p,d
popj p,
angchk: push p,c
push p,d
push p,e
push p,t
move c,a ;x coord of hit
move d,b ;y coord of hit
fsbr c,zstrtx ;get coords relative to start of beam
fsbr d,zstrty
movm e,c
movm t,d
camg e,t
jrst [move c,d ? xor c,zsin ? jumpge c,angchw ? jrst angchl]
xor c,zcos
jumpge c,angchw
angchl: pop p,t
pop p,e
pop p,d
pop p,c
popj p,
angchw: pop p,t
pop p,e
pop p,d
pop p,c
aos (p)
popj p,
reflct: move a,plang(plr) ;get ang2
fmpr a,[2.0] ;2*ang2
fsbr a,zangle ;reflected angle = 2*ang2 - ang1
jumpl a,[fadr a,pi$2 ? popj p,]
caml a,pi$2
fsbr a,pi$2
popj p,
;FLOATING POINT SINE AND COSINE. REENTERABLE.
SIND: FMPR A,[.01745329251994] ;PI/180
JRST SIN
COSD: FMPR A,[.01745329251994]
COS: FADR A,SC1 ;P1/2
SIN: CAMG A,SC9 ;.000211431983 IS SUFFICIENT FOR IDENTITY, 10**-15 IS NESESSARY NOT TO UNDERFLOW
CAMGE A,[-.000211431983] ;ABS X MIGHT CAUSE POLYNOMIAL UNDERFLON
JRST .+2
POPJ P, ;AND IS SMALL ENOUGH FOR SIN X _ X
FDVR A,SC1 ;PI/2
PUSH P,A
PUSH P,B
MULI A,400
TSC A,A ;CAML A,...SETZB B,-1(P)
ASH B,-243(A)
MOVNS A,8
ANDCMI A,1
TLC A,232000
FAD A,A
FADRB A,-1(P)
TRNE B,2
MOVNS A,-1(P)
FMP A,A
MOVE B,SC9
FMP B,A
FAD B,SC7
FMP B,A
FAD B,SC5
FMP B,A
FAD B,SC3
FMP A,B
FADR A,SC1
FMPRM A,-1(P)
POP P,B
POP P,A
POPJ P,
SC1: 1.5707963267
SC3: -0.64596371106
SC5: 0.07968967928
SC7: -0.00467376557
SC9: 0.00015148419
CONSTANTS
VARIABLES
subttl data bases and constants
;data base for players
plrbri: 20112 ;parameter mode haflwds to set brightness and scale
pwbbri: 20114 ;and go into point mode
pinitd: 150.0 ;initial dist. from center of board (x and y derived from this)
pinitx: 300.0 ;initial x value for player positions at start of game
500.0
700.0
500.0
pinity: 500.0 ;initial y
700.0
500.0
300.0
pinita: cpie.5 ;initial angle,
0.0
cpi1.5
cpie
input: block nplyrs ;holds inputs for each player during pass
speed: 3.0 ;points/step to move if moving
angrat: .03 ;radians/step to turn if turning
angspd: 4.0 ;factor to scale pot*angrat by when using pots
fuzzm: .3 ;factor for which pots are considered close enough to be zero
fuzzr: .3 ;same thing except for rotation instead of motion
dconst: 1.0 ;value digital inputs are assumed to be
splen: 40.0 ;standard player length on a side
paslim: 10 ;number of 60th's that must go by between passes
passtm: 0 ;timer for above
plocx: block nplyrs ; x coord of player
block 4 ;boundary line x coords (kludge)
plocy: block nplyrs ; y coord
block 4
plang: block nplyrs ;heading angle in radians
block 4
plsin: block nplyrs ;sin(plang)
block 4
plcos: block nplyrs ;cos(plang)
block 4
plslop: block nplyrs ; tan(plang) i.e. slope
block 4
plen: block nplyrs ;player length
block 4
plensq: block nplyrs ;player length squared
block 4
plscor: block nplyrs
tmmate: 1 ;index of other teammate(s) (circular list if more than 2)
0
3 ;teams are (0,1) and (2,3)
2
tmon: 0 ;team # player is on
0
1
1
control: ; says whether to get input from A/D pots or bits
play1: 0?0 ? 0?0 ? 0?0 ? .bp 20,input+1?.bp 100,input+1
play2: 0?0 ? 0?0 ? 0?0 ? .bp 20,input+1?.bp 100,input+1
play3: 0?0 ? 0?0 ? 0?0 ? .bp 20,input+3?.bp 100,input+3
play4: 0?0 ? 0?0 ? 0?0 ? .bp 20,input+3?.bp 100,input+3
rotrtght==0 ;symbols defined to make patching control table easy
rotleft==1
Xright==2
Xleft==3
Yup==4
Ydown==5
fire==6
pass==7
ltmscr: 0 ;last team that had beam when goal hit.
lglhit: 0 ;last goal hit (team # of)
tmscor: 0 ;score for team 0 (0 and 1)
0 ;team 1 (2 and 3)
ztime: 30. ;# of seconds team can possess beam
ztmlft: 0 ;count of seconds left til beam possession lost
ztim60: 0 ;count in 60ths of sec
;boundary lines
blowx: 0 ;left
bhighx: 0 ;right
blowy: 0 ;bottom
bhighy: 0 ;top
pbdgap: 2.0 ;boundary-player gap
plowx: 0 ;limits of trvael for players.
plowy: 0
phighx: 0
phighy: 0
bglflg: 0 ;nonzero if line has a goal on it
1
0
1
bglow: block 4 ;lower bound of coordinate for goal on line (if any)
bghigh: block 4 ;upper bound "
bgwide: 100.0 ;width of goal
bdlenx: 700.0 ;width of board (x coord)
bdleny: 900.0 ;height of board (y coord)
bln.5x: 0 ;half bdlenx
bln.5y: 0 ;half bdleny
bdcenx: 0 ;coord of center axis (x)
bdceny: 0 ;coord of center axis (y)
bprot: 160.0 ;radius of protective shield around goal
bprosq: 0 ;set to square of above
frztim: 3 ;# seconds to freeze action on beam hit.
;----------------
;beam hit variables used while computing beam path
zstrtx: 0 ;start of beam, x coord
zstrty: 0 ;start of beam, y coord
zangle: 0 ;direction of beam in radians
zsin: 0 ;sin(zangle)
zcos: 0 ;cos(zangle)
zslope: 0 ;slope = tan(zangle)
zslopx: 0 ;non-zero if slope infinite
zfrom: 0 ;index of player beam from (via fire or bounce)
zbestd: 0 ;holds distance to best hit seen so far (closest)
zbestp: 0 ;holds index of player implicated by zbestd
zbestx: 0 ;x coord of best hit
zbesty: 0 ;y coord of best hit
zbounc: 0 ; # times beam has bounced off something so far
zmaxbc==3 ;max # bounces before beam ownership transfers
zbnclt: block zmaxbc ;stores record of players bounced off
zbri: 20113 ;beam brightness/scale, go into point mode
subttl board setup
define dline x1,y1,x2,y2
move a,x1
move b,y1
move c,x2
move d,y2
pushj p,drwlin
termin
bsetup: move a,bprot ;get protective-circle radius
fmpr a,a ;square it
movem a,bprosq ;store for use by player updat
move a,splen ;get player length
fadr a,[2.0] ;add 2 units for safety
movem a,blowx ;and use that as lower limit of board
movem a,blowy ;in both directions.
fadr a,pbdgap
movem a,plowx
movem a,plowy
IRP xory,,[x,y]
move b,[1024.0] ;get absolute limit of coord
move c,bdlen!xory ;and desired width
fadr c,a ;adjust out
fsbr b,c ;and check
camle a,b ;skip if enough room
jsr death ;foo.
movem c,bhigh!xory
fsbr c,pbdgap ;spacing
movem c,phigh!xory
move b,bdlen!xory
fmpr b,[0.5] ;find 1/2 length
movem b,bln.5!xory
fadr b,blow!xory
movem b,bdcen!xory ;center of board line
TERMIN
movei t,3 ;loop 4 times storing line data
bsetp1: cain t,0
jrst [move a,blowx ? move b,bdceny ? move c,pi.5 ? move d,bdleny ? jrst bset2]
cain t,1
jrst [move a,bdcenx ? move b,bhighy ? setz c, ? move d,bdlenx ? jrst bset2]
cain t,2
jrst [move a,bhighx ? move b,bdceny ? move c,pi.5 ? move d,bdleny ? jrst bset2]
cain t,3
jrst [move a,bdcenx ? move b,blowy ? setz c, ? move d,bdlenx ? jrst bset2]
bset2: movem a,plocx+nplyrs(t)
movem b,plocy+nplyrs(t)
movem c,plang+nplyrs(t)
movem d,plen+nplyrs(t)
fmpr d,d
movem d,plensq+nplyrs(t)
move a,c ;setup for trig stuff
pushj p,cos
movem a,plcos+nplyrs(t)
move a,c
pushj p,sin
movem a,plsin+nplyrs(t)
PFDVR a,plcos+nplyrs(t) ;find tan
movem A,plslop+nplyrs(t)
sojge t,bsetp1