20 ! -------------------------------
30 ! PINBALL - Flipperspel f|r ABC800, 802, 806
40 !
50 ! 1.00, 1986-09-13, David Andersson <5201>, F|r ABC80
52 ! 2.00, 1986-12-10, Kristoffer Eriksson <5357>, Konverterat till ABC80X
54 ! 2.01, 1986-12-15, <5357>, Ch$ och BLK bort, 640 snabbare
70 ! -------------------------------
80 !
82 ! Avsett att fungera p} alla modeller i ABC 800-serien, dock knappast
84 ! njutbart p} ABC 800 M. Till ABC806 kr{vs SET DOT-option, t ex
86 ! programmet DOTOPT.BAC.
90 !
100 ! --- Init ---
110 INTEGER : EXTEND
120 DIM T$(3)=30,P$(9)=10,P1$(9)=5,X(71),Y(79)
130 ! WIDTH 40 ! Dubbel bredd
140 Ch=128+(ASCII(RED) AND 7)*8+0 ! +(ASCII(BLK) AND 7)
150 Cn$=GYEL : Cn=ASCII(YEL) AND 7
160 Ct$=CYA : Cgt$=GCYA : Ct=ASCII(CYA) AND 7
170 Abc=800+(6 AND PEEK(39)=4)+(2 AND PEEK(39)=3)
180 Tgbget=(Abc<>806 AND Abc<>802)
185 Klick=0 ! (Abc=806 OR Abc=802)
190 Wid=PEEK(65364) : Dwid=(Wid<=40)
200 DEF FNMin(X,Y)=(X AND XT0 GOSUB 1000
560 GOSUB 7000 : IF B=0 GOSUB 800 : GOTO 680
580 X1=X1+X7 : Y1=Y1+Y7 : X5=X5-X6 : Y5=Y5-Y6
590 X=SWAP%(X1) AND 255 : Y=SWAP%(Y1) AND 255 : IF X=X0 IF Y=Y0 GOSUB 800 : GOTO 680
610 G2=X(X) AND Y(Y) : IF G2 IF G2 AND 1 GOSUB 4000 : GOTO 680 ELSE GOSUB 2000 ELSE IF P5 AND 1 GOSUB 840
630 CLR DOT X0,Y0+1 : CLR DOT X0+1,Y0 : CLR DOT X0,Y0 : IF SYS(5) GOSUB 900
640 D=-DOT(X,Y) OR DOT(X,Y+1) AND 2 OR DOT(X+1,Y) AND 4 OR DOT(X+1,Y+1) AND 8
650 IF D GOSUB 1900 : GOSUB 2200 : X=X0 : Y=Y0 ELSE X0=X : Y0=Y
660 SET DOT X,Y : SET DOT X+1,Y : SET DOT X,Y+1 : IF G2 GOSUB 2100
680 ! IF L0 OUT 6,121 : L0=0 ELSE IF L OUT 6,0,6,L : L0=L : L=0
685 IF L0 THEN L0=0 ELSE IF L THEN L0=L : L=0
700 NEXT P5
704 !
705 ! ---Timeouthantering
710 IF M3 M3=M3-1 : IF M3=0 GOSUB 4400
711 IF M2 M2=M2-1 : IF M2=0 ; P$(0); : M1=-8*(P1=2) : P1=0 : IF M1 Z=FNInv(P4,32)
720 IF M1 M1=M1-1 : IF M1=0 Z=FNInvinv(P4)
731 IF M5 M5=M5-1 : IF M5=0 GOSUB 3100
732 IF P7 THEN Z=FNInva(FNC(0,36-M5-M5))+FNInva(FNC(0,37-M5-M5))
740 GOTO 500
750 END
790 !
800 ! --- Justera hastighet och acceleration ---
810 X6=X5/12 : IF X6<-3 X6=-3 ELSE IF X6>3 X6=3
820 X6=X6-6+(X5>256)
830 X7=X5 : IF X7>256 X7=256 ELSE IF X7<-256 X7=-256
840 Y6=Y5/24 : IF Y6<-3 Y6=-3 ELSE IF Y6>3 Y6=3
850 Y7=Y5 : IF Y7>256 Y7=256 ELSE IF Y7<-256 Y7=-256
860 RETURN
890 !
900 ! --- Ny tangent ---
910 GET X$ : IF T1<128 THEN T1=ASCII(X$) OR 128
915 IF ASCII(X$)<>192 THEN RETURN
920 END
930 !
1000 ! --- Tangent ---
1010 T0=T1 : L=121
1020 IF T0=141 GOTO 1520 ELSE IF T0=137 GOTO 1400 ELSE IF T0=177 GOTO 4200
1030 I=(INSTR(1,'ZXCVzxcv-.,m;:`M ',CHR$(T0 XOR 128))+7)/8+1
1040 ON I GOTO 1100,1300,1400,1500
1100 ! ---Ingen
1110 IF T0>=128 AND B GOTO 1560
1120 IF T2 T2=0 : GOSUB 1160
1130 IF T3 T3=0 : GOSUB 1200
1140 IF T4 T4=0 : GOSUB 1250
1150 RETURN
1160 ! ---Sl{pp v{nster
1170 X2=0
1180 IF X0>=60 AND Y0<=51 GOTO 1230 ELSE 1240
1190 ; T$(0);
1200 ! ---Sl{pp h|ger
1210 X2=1
1220 IF X0>=60 AND Y0>=55 AND Y0<66 GOTO 1230 ELSE 1240
1230 GOSUB 1800 : Y0=53 : GOSUB 1900
1240 ; T$(X2); : RETURN
1250 ! ---Sl{pp RETURN
1260 IF X0<61 OR Y0<75 GOTO 1280
1270 GOSUB 1800 : Y5=-6 : X5=-(58-X0)^2*16-ABS(X5) : Y0=76 : X0=61 : GOSUB 1900 : GOSUB 800
1280 ; CUR(21,38) 'g' CUR(22,38) '9' CUR(23,38) 'f';
1290 RETURN
1295 !
1300 ! --- V{nster ---
1310 IF T2 RETURN ELSE X2=2 : T2=1 : Y=Y0/2
1320 IF X0+Y<78 OR X0-Y0>16 OR Y0>52 GOTO 1470 ELSE GOSUB 1800
1330 X5=-ABS(X5)/3-35*(X0-80+Y)-35*(Y0-41)
1340 Y5=Y5/3+350*(X0-60)/(Y0-39)+15*(Y0-41)
1350 IF Y0<50 X0=FNMin(80-Y,X0) ELSE Y0=52 : Y5=Y5+40
1360 GOTO 1460
1390 !
1400 ! --- H|ger ---
1410 IF T3 RETURN ELSE X2=3 : T3=1 : Y=Y0/2
1420 IF X0-Y<25 OR X0+Y0>122 OR Y0<54 GOTO 1470 ELSE GOSUB 1800
1430 X5=-ABS(X5)/3-35*(X0-27-Y)-35*(66-Y0)
1440 Y5=Y5/3+350*(X0-60)/(Y0-67)+15*(Y0-65)
1450 IF Y0>56 X0=FNMin(27+Y,X0) ELSE Y0=54 : Y5=Y5-40
1460 GOSUB 1900 : GOSUB 800 : L=9
1470 ; T$(X2); : RETURN
1490 !
1500 ! --- ---
1510 GOSUB 1300 : GOTO 1400
1520 ! --- ---
1530 IF T4 RETURN ELSE T4=1
1540 ; CUR(21,38) ' ' CUR(22,38) '|' CUR(23,38) '';
1550 RETURN
1560 ! ---Tilt
1570 ; P$(9); : M1=0 : IF Klick THEN OUT 34,9 ! : OUT 6,7
1575 P1=9 : IF M2<5 Y5=Y5+96 : X5=X5-96 : M2=10
1580 RETURN
1790 !
1800 ! --- CLRDOT ---
1810 CLR DOT X0,Y0+1 : CLR DOT X0+1,Y0 : CLR DOT X0,Y0 : RETURN
1890 !
1900 ! --- Till f|reg}ende pos ---
1910 X1=SWAP%(X0)+128 : Y1=SWAP%(Y0)+128 : RETURN
1990 !
2000 ! --- Kolla specialfall ---
2010 IF G2 AND 16 IF X0>23 CLR DOT 23,30 : CLR DOT 23,31 : CLR DOT 23,76 : CLR DOT 23,77
2020 IF P1=9 GOTO 2060
2030 IF G2 AND 64 IF P1<>5 GOTO 2080
2040 IF G2 AND 128 IF M1 P1=4 : GOSUB 3200
2050 IF G2 AND 2 IF P1<>3 P1=3 : GOSUB 3200
2060 IF G2 AND 32 IF P1 ; P$(0);
2070 RETURN
2080 P1=5 : GOSUB 3200 : IF B<4 B=B+1 : ; CUR(17,3) Ct$ CUR(17,4) ' BONUS ';CUR(17,11) Cn$; : M3=5
2090 RETURN
2095 !
2100 ! --- ]terst{ll specialfall ---
2110 IF G2 AND 32 IF P1 ; P$(P1); : RETURN
2120 IF G2 AND 8 SET DOT 23,30 : SET DOT 23,31 : SET DOT 23,76 : SET DOT 23,77 : CLR DOT X+1,Y+1
2130 RETURN
2190 !
2200 ! --- Studs ---
2210 X2=0 : IF X>=46 GOTO 2250 ELSE IF G2 AND 4 GOSUB 3000
2220 IF ABS(X-16)<4. IF ABS(Y-43)<4. X2=16 : Y2=43
2230 IF ABS(X-19)<4. IF ABS(Y-63)<4. X2=19 : Y2=63
2240 IF ABS(X-40)<4. IF ABS(Y-47)<4. X2=40 : Y2=47
2250 ON D GOSUB 2320,2330,2350,2330,2360,2320,2320,2320,2330,2360,2330,2350,2330,2320
2260 IF X2 AND P1<>9 P1=2 : GOSUB 2400 ELSE IF I>=40-30*(X+Y>129) L=137
2270 IF (D AND 3)=0 IF X5>16 X5=X5/4
2280 IF (D AND 12)=0 IF X5<-16 X5=X5/4
2290 IF (D AND 5)=0 IF Y5>16 Y5=Y5/4
2300 IF (D AND 10)=0 IF Y5<-16 Y5=Y5/4
2310 GOTO 800
2320 I=X5 : X5=-Y5+SGN(Y5)*2+Y5/4 : Y5=-I+SGN(I)+I/6 : GOTO 2340
2330 I=X5 : X5=Y5-SGN(Y5)*2-Y5/4 : Y5=I-SGN(I)-I/6
2340 I=ABS(X5)+ABS(Y5) : RETURN
2350 X5=-X5+SGN(X5)*2+X5/4 : I=ABS(X5) : RETURN
2360 Y5=-Y5+SGN(Y5)+Y5/4 : I=ABS(Y5) : RETURN
2390 !
2400 ! --- Bumpa ---
2410 FOR I=X2-1 TO X2+1 : FOR J=Y2-1 TO Y2+1 : SET DOT I,J : NEXT J : NEXT I : CLR DOT X2,Y2
2420 X5=X5/3+(X0-X2)*160 : Y5=Y5/3+(Y0-Y2)*160
2430 X5=X5-.7*RND*X5 : Y5=Y5-.7*RND*X5
2440 GOSUB 3200 : L=155 : IF Klick THEN OUT 34,10 ! : OUT 6,9
2450 FOR I=X2-1 TO X2+1 : FOR J=Y2-1 TO Y2+1 : CLR DOT I,J : NEXT J : NEXT I : SET DOT X2,Y2
2460 RETURN
2990 !
3000 ! --- Bingo ---
3010 IF P6=0 OR P7 OR P1=9 RETURN
3020 ; CUR(0,17) Ct$;
3030 IF P6<>8 ; 'By D.A. in Jun 1986' Cn$; ELSE ; ' Master of PinBall ' Cn$ CHR$(7);
3040 M5=10 : P1=P6 : P7=1 : GOTO 3200
3090 !
3100 ! --- S{tt bingo ---
3110 IF P7 GOTO 3150
3120 IF P6=0 P6=6 : M5=140 : GOTO 3170
3130 IF P6=6 P6=7 : M5=60 : GOTO 3170
3140 IF P6=7 AND COMP%(P$,'20000')>=0 AND B P6=8 : M5=60 : GOTO 3170
3150 P6=0 : P7=0 : M5=25
3160 ; CUR(0,0) Cn$ CUR(0,17) '9999999997i9999999999'; : RETURN
3170 ; CUR(0,29) Ct$ CUR(0,30) '(' P1$(P6) ')' Cn$ '99';
3180 RETURN
3190 !
3200 ! --- R{kna po{ng ---
3210 M2=3 : ; P$(P1); : M1=0 : L=131
3220 P$=ADD$(P$,P1$(P1),0) : ; CUR(11,3) Ct$ CUR(11,11-LEN(P$)) P$ CUR(11,11) Cn$;
3230 RETURN
3990 !
4000 ! --- Bollen ute ---
4010 GOSUB 1800 : GOSUB 4300 : L=95
4015 ! OUT 6,119
4020 FOR I=0 TO 1200 : NEXT I
4030 B=B-1 : GOSUB 4400 : IF B RETURN
4035 ! OUT 6,223
4040 FOR I=0 TO 1200 : NEXT I
4090 !
4100 ! --- Game over ---
4110 B=0 : P1=0 : M1=0 : M2=0 : P7=0
4120 X$="GAME OVER"
4125 FOR I=-4 TO 4 : Z=FNInv(FNC(8,27+I),ASCII(RIGHT$(X$,5+I))) : NEXT I
4130 ; CUR(20,0) Ct$ CUR(20,1) 'Start play=1 ' CUR(20,17) Cn$ : ; SPACE$(17) Cn$ : ; SPACE$(17) Cn$;
4140 IF COMP%(P$,P9$)<=0 RETURN
4150 P9$=P$ : ; CUR(6,3) Ct$ CUR(6,11-LEN(P9$)) P9$ CUR(6,11) Cn$;
4160 FOR I=4 TO 4+6 : Z=FNInva(FNC(6,I)) : NEXT I
4170 RETURN
4190 !
4200 ! --- Start play ---
4210 IF B RETURN ELSE B=4 : P7=1 : GOSUB 3100 ! : OUT 6,0,6,131
4220 ; CUR(8,23) SPACE$(9); : GOSUB 4400
4230 ; CUR(20,0) Ct$;CUR(20,1) ' Spring=RETURN';Cn$;CUR(21,0) Ct$;CUR(21,1) ' Left pin=Z' Cn$;
4235 ; CUR(22,0) Ct$;CUR(22,1);'Right pin=-';Cn$;
4240 FOR I=4 TO 4+6 : Z=FNUninv(FNC(6,I),PEEK(FNC(6,I))) : NEXT I
4250 P$='0' : ; CUR(11,3) Ct$ CUR(11,4) '0000000';
4260 ; CUR(11,11) Cn$;
4290 !
4300 ! --- Ny boll ---
4310 X5=0 : Y5=0 : GOSUB 800
4320 X0=61 : Y0=76 : GOTO 1900
4390 !
4400 ! --- Balls ---
4410 ; CUR(17,3) Cgt$ CUR(17,4) SPACE$(7);
4420 FOR I=1 TO B : ; CUR(17,2+I*2) "'"; : NEXT I
4425 ; CUR(17,11) Cn$;
4430 RETURN
4990 !
5000 ! --- Init screen ---
5010 ; CHR$(12); : RESTORE
5020 FOR I=0 TO 23
5022 READ I$ : ; CUR(I,0) Cn$ CUR(I,1) I$;
5025 IF I=6 OR I=11 THEN ; CUR(I,3) Ct$ CUR(I,4) MID$(I$,4,7) Cn$;
5027 NEXT I
5030 SET DOT 69,79 : SET DOT 70,79 : REM SETDOT 71%,79%
5040 ! ; CUR(6,3) Ct$ CUR(6,11) Cn$ CUR(11,3) Ct$ CUR(11,11) Cn$;
5050 FOR X=1 TO 9
5060 READ I$,P1$(X) : P$(X)=CUR(8,24)+Ct$+I$+Cn$
5070 NEXT X
5080 P$(0)=CUR(8,24)+SPACE$(6)
5090 P4=FNC(8,27)
5100 Z=FNInv(FNC(11,35),32)
5110 Z=FNInv(FNC(8,15),32)
5120 FOR X=0 TO 3 : READ X1 : FOR Y=19 TO 22
5130 READ I$ : T$(X)=T$(X)+CUR(Y,X1)+I$
5140 NEXT Y : NEXT X
5150 ; T$(0) T$(1);
5160 READ X1,X2,Y1,Y2,I : IF I=0 RETURN
5170 FOR X=X1 TO X2 : X(X)=X(X) OR I : NEXT X
5180 FOR Y=Y1 TO Y2 : Y(Y)=Y(Y) OR I : NEXT Y
5190 GOTO 5160
5500 DATA '8=----------m9999999999997i999999999990
5510 DATA 'f5 PIN BALL jfffffv.##############.vfff
5520 DATA '9;;;;;;;;;;;;9999# )99
5530 DATA 'ff&&&&&&&&&ffff& jf
5540 DATA '99TOP SCORE(995 p0 =
5550 DATA 'fn.........vfn j(j p0 j
5560 DATA '9{ 0000000 =95 #! j(j j
5570 DATA 'ffggggggggggf5p #! pj
5580 DATA '9999))))))9995 j;t 85 j
5590 DATA 'fff$SCORE fff5 jff5 ff5 j
5600 DATA '9y---------=95 j995 0 )5 j
5610 DATA 'fn 0000000 wf5 "ff% `f5 5 j
5620 DATA '9;;;;;;;;;;995 ! p0 j95 j 5 j
5630 DATA 'fffffffffffff5 j(j jf5 j 5 j
5640 DATA '9999))))))9995 #! j9! j 5 j
5650 DATA 'fff$BALLS fffm " j 5 j
5660 DATA '9y---------=9990 j 5 j
5670 DATA 'fn wffffd j 5 j
5680 DATA '9;;;;;;;;;;99999990 z 5 j
5690 DATA '.................vfd0 `fn 5 j
5700 DATA ' =9yi# #6={ 5 j
5710 DATA ' wfn2, ,agn 5gj
5720 DATA ' =99;t 899{ 59j
5730 DATA 'ggggggggggggggggggffffm0 `ffffn 5f
5740 DATA ' 100',100
5750 DATA ' 50 ',50
5760 DATA ' 300',300
5770 DATA ' 600',600
5780 DATA '1000',1000
5790 DATA ' 400',400
5800 DATA '2500',2500
5810 DATA '8000',8000
5820 DATA 'TILT',0
5830 DATA 23,' ','d ','p)0',' #.'
5840 DATA 28,' ',' 8','`&p','-# '
5850 DATA 23,'p,;','`& ','! ',' '
5860 DATA 28,'g,p',' )0',' "',' '
5870 DATA 71,71,48,73,1
5880 DATA 32,35,69,71,2
5890 DATA 3,3,52,54,4
5900 DATA 21,26,28,32,8
5910 DATA 21,26,74,79,8
5920 DATA 23,26,28,31,16
5930 DATA 23,26,74,79,16
5940 DATA 22,27,44,63,32
5950 DATA 24,25,29,31,64
5960 DATA 23,26,53,55,128
5970 DATA 0,0,0,0,0
6000 !
6010 DEF FNInv(A,K) LOCAL X
6020 IF Abc<>806 THEN POKE A,K OR 128 : RETURN 0
6030 X=INP(53) : OUT 53,Ch : POKE A,K : IF Dwid THEN Z=PEEK(A-1) : POKE A-1,K
6040 OUT 53,X : RETURN 0
6050 FNEND
6060 !
6070 DEF FNInva(A) LOCAL X,K
6080 IF Abc<>806 THEN POKE A,PEEK(A) OR 128 : RETURN 0
6090 X=INP(53) : K=PEEK(A) : OUT 53,Ch : POKE A,K : OUT 53,X
6100 RETURN 0
6110 FNEND
6120 !
6130 DEF FNInvinv(A) LOCAL X,K
6140 IF Abc<>806 THEN POKE A,PEEK(A) XOR 128 : RETURN 0
6150 K=PEEK(A) : X=INP(53) : IF X AND 184 THEN OUT 53,Cn ELSE OUT 53,Ch
6160 POKE A,K
6170 RETURN 0
6180 FNEND
6190 !
6200 DEF FNUninv(A,K) LOCAL X
6210 IF Abc<>806 THEN POKE A,K AND 127 : RETURN 0
6220 OUT 53,Ct : POKE A,K
6230 RETURN 0
6240 FNEND
6250 !
6260 DEF FNC(R,K)
6270 IF Abc=806 THEN IF Dwid RETURN 30721+R*80+K+K ELSE RETURN 30720+R*80+K
6280 IF Abc=802 THEN IF Dwid RETURN 30720+R*80+K+K ELSE RETURN 30720+R*80+K
6290 RETURN 30720+R*Wid+K
6300 FNEND
6310 !
7000 ! ----L{s tangentkod----
7010 IF Tgbget THEN IF SYS(5) THEN GET X$ : T1=ASCII(X$) OR 128 : RETURN ELSE T1=0 : RETURN
7020 IF SYS(8) THEN IF T1=0 THEN FOR R=1 TO 70 : NEXT R : T1=INP(34) OR 128 ELSE T1=INP(34) OR 128 ELSE T1=0
7030 RETURN