ZEESLAG.BAS

10 GOTO 1000:REM Basicode-2 subroutines
20 CLEAR:IN$=" ":SR=0:SR$="":CT=0:CN=0:OHT%=80:OVT%=24
22 KEY OFF:SCREEN 0:WIDTH OHT%:COLOR 7,0,0:CLS:RANDOMIZE TIMER*100
29 GOTO 1010
100 CLS:RETURN
110 GOSUB 111:LOCATE OVE%+1,OHO%+1:RETURN
111 OVE%=INT(VE):OHO%=INT(HO)
112 IF OVE%<0 THEN OVE%=0 ELSE IF OVE%>=OVT% THEN OVE%=OVT%-1
113 IF OHO%<0 THEN OHO%=0 ELSE IF OHO%>=OHT% THEN OHO%=OHT%-1
114 RETURN
120 HO=POS(0)-1:VE=CSRLIN-1:RETURN
200 IN$=INKEY$:RETURN
210 IN$=INPUT$(1):RETURN
250 BEEP:RETURN
260 RV=RND:RETURN
270 FR=FRE(""):RETURN
300 SR$=MID$(STR$(ABS(SR)),2):IF LEFT$(SR$,1)="." THEN SR$="0"+SR$
301 IF SR<0 THEN SR$="-"+SR$
302 RETURN
310 O#=ABS(SR)+.5*10^-CN:O!=INT(O#):O#=1+O#-O!:O$=""
311 IF CN THEN O$="."+STRING$(CN,48):IF O#>1 THEN MID$(O$,1)=MID$(STR$(O#),3)
312 O$=MID$(STR$(O!),2)+O$:IF VAL(O$)>0 AND SR<0 THEN O$="-"+O$
313 IF LEN(O$)<=CT THEN SR$=SPACE$(CT-LEN(O$))+O$:RETURN
314 SR$=STRING$(CT,42):RETURN
350 LPRINT SR$;:RETURN
360 LPRINT:RETURN
 1000 A=1000:GOTO 20:REM ZEESLAG
 1010 GOSUB 20000:REM UITLEG
 1020 GOSUB 20220:REM SCHERM OPMETEN
 1030 GOSUB 20570:REM READ VLOOTFORMATIES
 1040 DIM D(2),B$(5),B(5),CP$(5,5),PR(5,5),CR(10,10)
 1050 DIM M(10,10),R(5),S$(3),CC$(5,5)
 1060 FOR A=1 TO 5:R(A)=0:NEXT A
 1070 FOR A=1 TO 10:FOR B=1 TO 10
 1080 CR(A,B)=0:M(A,B)=0:NEXT B:NEXT A
 1090 FOR A=1 TO 5:FOR B=1 TO 5
 1100 PR(A,B)=0:NEXT B:NEXT A
 1110 N=0:PT=0:PM=0:PR=0
 1120 CC=0:CM=0:CR=0
 1130 B$(1)="vliegtuigmoederschip"
 1140 B$(2)="kruiser":B$(3)="onderzeeer"
 1150 B$(4)="fregat":B$(5)="mijnenveger"
 1160 B(1)=5:B(2)=4:B(3)=3:B(4)=3:B(5)=2
 1170 A1=ASC("a"):J1=A1+9
 1180 A2=ASC("A"):J2=A2+9
 1190 S$(1)="#":S$(2)="x":S$(3)="o"
 1200 D(1)=4:D(2)=22
 1210 SA$="":FOR A=1 TO HP:SA$=SA$+" ":NEXT A
 1220 REM SCHERM-OPBOUW
 1230 GOSUB 100
 1240 HO=5:VE=3:GOSUB 110
 1250 FOR A=1 TO 2:FOR B=1 TO 10
 1260 SR=B:GOSUB 300
 1270 PRINT SR$;
 1280 NEXT B:PRINT"       ";:NEXT A
 1290 VE=VE+1:FOR A=0 TO 9:FOR C=1 TO 2
 1300 HO=D(C):GOSUB 110
 1310 PRINT CHR$(A2+A);
 1320 FOR B=1 TO 10:PRINT".";:NEXT B:NEXT C
 1330 VE=VE+1:NEXT A
 1340 HO=6:VE=1:GOSUB 110:PRINT"SPELER"
 1350 HO=24:GOSUB 110:PRINT"COMPUTER"
 1360 HO=0:VE=15:GOSUB 110
 1370 FOR A=1 TO HP:PRINT"-";:NEXT A
 1380 PRINT:PRINT"Wilt U een voorgeprogrammeerde"
 1390 PRINT"vlootformatie ? (J/N)"
 1400 GOSUB 210:IF(IN$="n") OR(IN$="N") THEN 1590
 1410 IF(IN$<>"j") AND(IN$<>"J") THEN 1400
 1420 REM VLOOTFORMATIE UIT DATA
 1430 GOSUB 20300:SR=AV:GOSUB 300
 1440 PRINT"Voer nummer in (1-";SR$;")";
 1450 INPUT N:IF(N<1) OR(N>AV) THEN 1430
 1460 RESTORE:IF N=1 THEN 1480
 1470 FOR R=1 TO N-1:READ M$:NEXT R
 1480 READ M$
 1490 FOR S=1 TO 5:CB$=MID$(M$,3*(S-1)+1,3)
 1500 W=0:H=0:IF RIGHT$(CB$,1)="h" THEN H=1
 1510 FOR C=1 TO B(S)
 1520 C1=ASC(LEFT$(CB$,1))
 1530 C2=VAL(MID$(CB$,2,1))
 1540 IF H=1 THEN C2=C2+C-1:GOTO 1560
 1550 W=C-1
 1560 SR=C2:GOSUB 300
 1570 CP$(S,C)=CHR$(C1+W)+SR$
 1580 NEXT C:NEXT S:GOTO 1910
 1590 REM VLOOTFORMATIE INVOEREN
 1600 E=1:SC=1:FOR B=1 TO 5:GOSUB 20300
 1610 PRINT B$(B);" :"
 1620 PRINT"Voer meest linkse of bovenste"
 1630 PRINT"coordinaat in :";:INPUT C$
 1640 GOSUB 20360
 1650 IF F=1 THEN GOSUB 20500:GOTO 1610
 1660 GOSUB 20300:H=0
 1670 PRINT:PRINT"(H)orizontaal of (V)erticaal ?"
 1680 GOSUB 210:IF(IN$="h") OR(IN$="H") THEN H=1:GOTO 1710
 1690 IF(IN$="v") OR(IN$="V") THEN 1710
 1700 GOTO 1680
 1710 C1=ASC(LEFT$(C$,1))-A1+1
 1720 C2=VAL(RIGHT$(C$,LEN(C$)-1))
 1730 F=0:FOR T=0 TO B(B)-1
 1740 IF(H=1) AND((C2+T)>10) THEN F=1:GOTO 1820
 1750 IF(H=0) AND((C1+T)>10) THEN F=1:GOTO 1820
 1755 IF B=1 THEN 1830
 1760 IF H=1 THEN C$=CHR$(A1+C1-1):SR=C2+T:GOTO 1780
 1770 C$=CHR$(A1+C1-1+T):SR=C2
 1780 GOSUB 300:C$=C$+SR$
 1790 FOR P=1 TO B-1:FOR K=1 TO B(P)
 1800 IF C$=CP$(P,K) THEN F=1:K=B(P):P=B-1
 1810 NEXT K:NEXT P
 1820 IF F=1 THEN T=B(B)-1
 1830 NEXT T
 1840 IF F=1 THEN GOSUB 20500:GOTO 1610
 1850 FOR T=0 TO B(B)-1
 1860 IF H=1 THEN C$=CHR$(A1+C1-1):SR=C2+T:GOTO 1880
 1870 C$=CHR$(A1+C1-1+T):SR=C2
 1880 GOSUB 300:C$=C$+SR$:CP$(B,T+1)=C$
 1890 GOSUB 20440
 1900 NEXT T:NEXT B:GOTO 1950
 1910 REM TOON VLOOTFORMATIE
 1920 GOSUB 20300:SC=1:E=1
 1930 FOR A=1 TO 5:FOR B=1 TO B(A)
 1940 C$=CP$(A,B):GOSUB 20440:NEXT B:NEXT A
 1950 REM COMPUTER KIEST VLOOTFORMATIE
 1960 GOSUB 20300
 1970 PRINT"De computer kiest nu"
 1975 PRINT"zijn vlootformatie."
 1980 RESTORE
 1990 GOSUB 260:CV=INT(RV*AV+1)
 2000 IF CV=N THEN 1990
 2010 IF CV=1 THEN 2030
 2020 FOR R=1 TO CV-1:READ M$:NEXT R
 2030 READ M$
 2040 FOR S=1 TO 5:CB$=MID$(M$,3*(S-1)+1,3)
 2050 W=0:H=0:IF RIGHT$(CB$,1)="h" THEN H=1
 2060 FOR C=1 TO B(S)
 2070 C1=ASC(LEFT$(CB$,1))
 2080 C2=VAL(MID$(CB$,2,1))
 2090 IF H=1 THEN C2=C2+C-1:GOTO 2110
 2100 W=C-1
 2110 SR=C2:GOSUB 300
 2120 CC$(S,C)=CHR$(C1+W)+SR$
 2130 NEXT C:NEXT S
 2140 REM START SPEL
 2150 GOSUB 20300
 2160 PRINT"Wie begint, S)peler of C)omputer ?"
 2170 GOSUB 210
 2180 IF(IN$="S") OR(IN$="s") THEN 2210
 2190 IF(IN$<>"C") AND(IN$<>"c") THEN 2170
 2200 GOTO 2520
 2210 REM SPELER
 2220 GOSUB 20300
 2230 PRINT"SPELER: aantal schoten:";
 2240 SR=PT:GOSUB 300:PRINT SR$;" ";
 2250 SR=PM:GOSUB 300:PRINT SR$;"/";
 2260 SR=PR:GOSUB 300:PRINT SR$
 2270 PRINT"Coordinaat ";:INPUT C$
 2280 GOSUB 20360
 2290 IF F=1 THEN GOSUB 20500:GOTO 2220
 2300 PT=PT+1:B1=0:B2=0:R=0:Z=0
 2310 FOR T=1 TO 5:FOR U=1 TO B(T)
 2320 IF C$=CC$(T,U) THEN B1=T:B2=U:R=1:U=B(T):T=5
 2330 NEXT U:NEXT T:IF R=1 THEN R=0:GOTO 2380
 2340 HO=20:VE=19:GOSUB 110:PRINT"Mis..."
 2350 IF Z=1 THEN Z=0:GOTO 2370
 2360 SC=2:E=3:GOSUB 20440
 2370 PM=PM+1:GOSUB 20550:GOTO 2520
 2380 IF PR(B1,B2)=1 THEN Z=1:GOTO 2340
 2390 HO=20:VE=19:GOSUB 110:PRINT"RAAK!!"
 2400 SC=2:E=2:GOSUB 20440:GOSUB 20550
 2410 PR=PR+1
 2420 PR(B1,B2)=1
 2430 NO=0:FOR A=1 TO B(B1)
 2440 IF PR(B1,A)=0 THEN NO=1:A=B(B1)
 2450 NEXT A:IF NO=1 THEN 2520
 2460 HO=0:VE=19:GOSUB 110
 2470 SP$=LEFT$(SA$,HP-LEN(B$(B1))-13)
 2480 PRINT"U heeft mijn ";B$(B1);SP$
 2485 VE=VE+1:GOSUB 110
 2490 PRINT"tot zinken gebracht!!!"
 2500 GOSUB 20550
 2510 IF PR=17 THEN 3110
 2520 REM COMPUTER
 2530 GOSUB 20300
 2540 PRINT"COMPUTER: aantal schoten:";
 2550 SR=CC:GOSUB 300:PRINT SR$;" ";
 2560 SR=CM:GOSUB 300:PRINT SR$;"/";
 2570 SR=CR:GOSUB 300:PRINT SR$
 2580 PRINT"Coordinaat :";
 2590 G=0:FOR A=1 TO 5
 2600 IF(R(A)>0) AND(R(A)<B(A)) THEN B1=A:A=5:G=1
 2610 NEXT A
 2620 IF G=1 THEN 2870
 2630 GOSUB 260:XR=INT(RV*10+1)
 2640 GOSUB 260:YR=INT(RV*10+1)
 2650 IF(M(XR,YR)=1) OR(CR(XR,YR)=1) THEN 2630
 2660 SR=XR:GOSUB 300
 2670 C$=CHR$(YR+A1-1)+SR$
 2680 B1=0:R=0
 2690 FOR T=1 TO 5:FOR U=1 TO B(T)
 2700 IF C$=CP$(T,U) THEN B1=T:U=B(T):T=5:R=1
 2710 NEXT U:NEXT T
 2720 PRINT C$:CC=CC+1
 2730 IF R=1 THEN R=0:GOTO 2780
 2740 CM=CM+1:M(XR,YR)=1
 2750 HO=20:VE=19:GOSUB 110:PRINT"Mis..."
 2760 SC=1:E=3:GOSUB 20440
 2770 GOSUB 20550:GOTO 2210
 2780 CR=CR+1
 2790 R(B1)=R(B1)+1
 2800 CR(XR,YR)=1
 2810 SC=1:E=2:GOSUB 20440
 2820 HO=20:VE=19:GOSUB 110:PRINT"RAAK!!"
 2830 IF R(B1)=B(B1) THEN PRINT"Uw ";B$(B1);" is gezonken!"
 2840 IF CR=17 THEN GOSUB 20550:GOTO 3160
 2850 C1=XR:C2=YR
 2860 GOSUB 20550:GOTO 2210
 2870 REM BOVEN
 2880 J=1
 2890 IF(C2-J)<1 THEN 2930
 2900 XR=C1:YR=C2-J:IF M(XR,YR)=1 THEN 2930
 2910 IF CR(XR,YR)=1 THEN J=J+1:GOTO 2890
 2920 GOTO 2660
 2930 REM ONDER
 2940 J=1
 2950 IF(C2+J)>10 THEN 2990
 2960 XR=C1:YR=C2+J:IF M(XR,YR)=1 THEN 2990
 2970 IF CR(XR,YR)=1 THEN J=J+1:GOTO 2950
 2980 GOTO 2660
 2990 REM LINKS
 3000 J=1
 3010 IF(C1-J)<1 THEN 3050
 3020 XR=C1-J:YR=C2:IF M(XR,YR)=1 THEN 3050
 3030 IF CR(XR,YR)=1 THEN J=J+1:GOTO 3010
 3040 GOTO 2660
 3050 REM RECHTS
 3060 J=1
 3070 IF(C1+J)>10 THEN 2630
 3080 XR=C1+J:YR=C2:IF M(XR,YR)=1 THEN 2630
 3090 IF CR(XR,YR)=1 THEN J=J+1:GOTO 3070
 3100 GOTO 2660
 3110 REM SPELER WINT
 3120 GOSUB 20300
 3130 SR=PT:GOSUB 300
 3140 PRINT"U heeft gewonnen, in ";SR$;" beurten!!"
 3150 GOTO 3230
 3160 REM COMPUTER WINT
 3170 GOSUB 20300
 3180 PRINT"De computer heeft gewonnen!!!"
 3190 FOR A=1 TO 5:FOR B=1 TO B(A)
 3200 C$=CC$(A,B):SC=2:E=1:GOSUB 20440
 3210 NEXT B:NEXT A
 3220 GOSUB 20550:GOSUB 20300
 3230 PRINT"Nog een spel (J/N)?";
 3240 GOSUB 210
 3250 IF(IN$="j") OR(IN$="J") THEN RUN
 3260 IF(IN$<>"n") AND(IN$<>"N") THEN 3240
 3270 PRINT IN$
 3280 END
20000 REM UITLEG
20010 GOSUB 100
20020 HO=15:VE=2:GOSUB 110:PRINT"ZEESLAG"
20030 VE=VE+1:GOSUB 110:PRINT"-------"
20040 PRINT:PRINT"Dit programma is gebaseerd op het echte"
20050 PRINT"spel 'ZEESLAG PER COMPUTER'. Het bevat"
20060 PRINT"data voor 100 verschillende vlootforma-"
20070 PRINT"ties die in het instructie-boekje van"
20080 PRINT"MB-ELECTRONICS vermeld staan."
20090 PRINT"Nadere uitleg vindt U in bijbehorende"
20100 PRINT"gebruiksaanwijzing in de vorm van een"
20110 PRINT"beeldkrant."
20120 GOSUB 20130:RETURN
20130 REM WACHT OP TOETS
20140 HO=31:VE=22:GOSUB 110
20150 PRINT"<toets>"
20160 FOR W=1 TO 400:NEXT W
20170 HO=31:VE=22:GOSUB 110
20180 PRINT"       "
20190 FOR W=1 TO 200:NEXT W
20200 GOSUB 200:IF IN$="" THEN 20140
20210 RETURN
20220 REM SCHERM OPMETEN
20230 GOSUB 100:GOSUB 120
20240 HP=HO+1:PRINT" ";:GOSUB 120
20250 IF HP=HO THEN 20240
20260 GOSUB 100:GOSUB 120
20270 VP=VE+1:PRINT:GOSUB 120
20280 IF VP=VE THEN 20270
20290 RETURN
20300 REM CLR WINDOW
20310 HO=0:FOR VE=16 TO VP-2
20320 GOSUB 110:PRINT LEFT$(SA$,HP-1)
20330 NEXT VE
20340 HO=0:VE=17:GOSUB 110
20350 RETURN
20360 REM CONTROLEER COORDINAAT
20370 F=0:L=LEN(C$):IF(L<2) OR(L>3) THEN 20410
20380 Y=ASC(LEFT$(C$,1)):X=VAL(RIGHT$(C$,L-1))
20390 CY=0:IF(Y>=A1) AND(Y<=J1) THEN 20420
20400 IF(Y>=A2) AND(Y<=J2) THEN CY=1:GOTO 20420
20410 F=1:RETURN
20420 IF(X<1) OR(X>10) THEN F=1
20425 IF CY=1 THEN C$=CHR$((Y-A2)+A1)+RIGHT$(C$,L-1)
20430 RETURN
20440 REM PRINT COORDINAAT OP SCHERM
20450 L=LEN(C$)
20460 Y=ASC(LEFT$(C$,1))-A1+1:X=VAL(RIGHT$(C$,L-1))
20470 HO=X+4+18*(SC-1):VE=3+Y:GOSUB 110
20480 PRINT S$(E)
20490 RETURN
20500 REM FOUTIEVE INVOER
20510 HO=11:VE=VP-2:GOSUB 110:GOSUB 250
20520 PRINT"Onjuiste invoer!";
20530 GOSUB 20550
20540 GOSUB 20300:F=0:RETURN
20550 REM WACHTLUS
20560 FOR P=1 TO 1000:NEXT P:RETURN
20570 REM READ VLOOTFORMATIES
20580 AV=0:RESTORE
20590 READ CB$
20600 IF CB$<>"$$$$$" THEN AV=AV+1:GOTO 20590
20610 RETURN
25000 REM DATA 100 VLOOTFORMATIES
25010 DATA"b3vd7vg8vc1vb9v","b3vd7hc5vc4vi5v"
25030 DATA"b3vf7hg7ha1vb9h","b3hg1vh8va8hi5v"
25050 DATA"b3hg3vc1va8vi5h","d6vd7vg8vc5vh4v"
25060 DATA"d6vd7hc4ha1va5v","d6vf7hh8vg7hh4h"
25070 DATA"d6hg1hg7vc1vh4v","d6hg3vc5va8va5h"
25080 DATA"f2vf7vc1hg8vh4h","f2vf7hc5hc4va5h"
25090 DATA"f2hg1hg7ha1hh4v","f2hg3va8hh8ha5h"
25100 DATA"b3vd7va8vc1vi5v","b3vf7vc5vg8vb9h"
25110 DATA"b3vf7ha1vc4hi5h","b3hg1hh8vg7hb9v"
25120 DATA"b3hg3hg7vc1vb9h","d6vd7va8vc5va5v"
25130 DATA"f4hg1vc1hg8vb9v","f4hg1hc5hc4vi5v"
25140 DATA"f4hg3ha1hg7hb9h","f2vd7vh8ha8ha5v"
25150 DATA"f2vf7va8vc1ha5h","f2hg1vg8vc5hh4v"
25160 DATA"f2hg1ha1hc4ha5v","f2hg3hh8hg7hh4h"
25170 DATA"b3vd7hg7vc1vb9v","b3vf7vc5va8vi5h"
25180 DATA"d6hg3vc1vg8vh4h","d6hg3hc4vc5va5h"
25190 DATA"f4vd7hg7ha1hb9v","f4vf7vh8ha8hi5h"
25200 DATA"f4hg1vc1ha8vi5v","f4hg3vg8vc5hb9h"
25210 DATA"f4hg3ha1hc4hi5h","f2vd7hh8hg7hh4v"
25220 DATA"f2vf7hc1hg7vh4h","f2hg1va8vc5ha5v"
25230 DATA"d6vd7vc1vg8vh4v","d6vd7hc4vc5va5v"
25240 DATA"d6vf7hg7ha1vh4h","d6hg1va8hh8va5v"
25250 DATA"d6hg3va8vc1va5h","f4vd7vc5hg8vb9v"
25260 DATA"f4vd7ha1hc4hi5v","f4vf7hh8hg7hb9h"
25270 DATA"f4hg1hc1hg7vb9v","f4hg3vc5ha8vi5h"
25280 DATA"b3vf7vc1vg8vb9h","b3vf7hc5vc4vi5h"
25290 DATA"b3hg1hg7ha1vb9v","b3hg3vh8va8hi5h"
25300 DATA"d6vd7va8vc1va5v","d6vf7vg8vc5vh4h"
25310 DATA"d6vf7ha1vc4ha5h","d6hg1hh8vg7hh4v"
25320 DATA"d6hg3hg7vc1vh4h","f4vd7vc5ha8vi5v"
25330 DATA"f2hg1vc1hg8vh4v","f2hg1hc5hc4va5v"
25340 DATA"f2hg3hg7ha1hh4h","b3vd7va8hh8vi5v"
25350 DATA"b3vf7vc1va8vi5h","b3hg1vc5vg8vb9v"
25360 DATA"b3hg1ha1vc4hi5v","b3hg3hh8vg7hb9h"
25370 DATA"d6vd7hc1vg7vh4v","d6vf7va8vc5va5h"
25380 DATA"f4hg3vc1hg8vb9h","f4hg3hc5hc4vi5h"
25390 DATA"f2vd7hg7ha1hh4v","f2vf7va8hh8ha5h"
25400 DATA"f2hg1va8vc1ha5v","f2hg3vc5hg8vh4h"
25410 DATA"f2hg3ha1hc4ha5h","b3vd7hg7hh8vb9v"
25420 DATA"b3vf7hc1vg7vb9h","b3hg1vc5va8vi5v"
25430 DATA"f4vd7vc1hg8vb9v","f4vd7hc5hc4vi5v"
25440 DATA"f4vf7ha1hg7hb9h","f4hg1va8hh8hi5v"
25450 DATA"f4hg3vc1ha8vi5h","f2vd7vg8vc5hh4v"
25460 DATA"f2vd7ha1hc4ha5v","f2vf7hh8hg7hh4h"
25470 DATA"f2hg1hc1hg7vh4v","f2hg3va8vc5ha5h"
25480 DATA"d6vf7vc1vg8vh4h","d6vf7hc5vc4va5h"
25490 DATA"d6hg1hg7ha1vh4v","d6hg3vh8va8ha5h"
25500 DATA"f4vd7vc1ha8vi5v","f4vf7vc5hg8vb9h"
25510 DATA"f4vf7hc4ha1hi5h","f4hg1hh8hg7hb9v"
25520 DATA"f4hg3hc1hg7vb9h","f2vd7vc5ha8va5v"
25530 DATA"$$$$$"
30000 REM
30010 REM****************************
30020 REM*                          *
30030 REM*         ZEESLAG          *
30040 REM*         -------          *
30050 REM*  MET 100 VERSCHILLENDE   *
30060 REM*     VLOOTFORMATIES       *
30070 REM*  UIT INSTRUCTIEBOEKJE    *
30080 REM*  'ZEESLAG PER COMPUTER'  *
30090 REM*  VAN MB-ELECTRONICS.     *
30100 REM*                          *
30110 REM*     GEPROGRAMMEERD       *
30120 REM*  OP EEN COMMODORE-128    *
30130 REM*         DOOR:            *
30140 REM* PETER JAN VAN DER MESPEL *
30150 REM*     TEL.070-232491       *
30160 REM*                          *
30170 REM*       BASICODE-2         *
30180 REM*      (19-02-1989)        *
30190 REM*                          *
30200 REM****************************
30210 REM
30220 REM COPYRIGHT NOS HILVERSUM