10REM **************************
20REM ****** Battle Ships ******
30REM **************************
40
50MODE 6
60
70REM S(x,x,0) is position of compute
r's ships
80REM S(x,x,1) is position of player'
s ships
90REM S(x,x,2) is where computer has
tried
100REM S(x,x,3) is where player has tr
ied
110
120DIM S(9,9,3),name$(7),DI(3,1)
130REPEAT
140PROCintro
150PROCcomputer`init
160PROCplayer`init
170PROCplay
180PROCcomment
190UNTIL NOT FNyes("Another Game")
200END
210
220
230DEF PROCcomputer`init
240
250REM set array S() to zero
260
270FORI=0TO9
280FORJ=0TO9
290FORK=0TO3
300S(I,J,K)=0
310NEXT
320NEXT
330NEXT
340
350REM read search direction vectors
360
370RESTORE
380FORI=0TO3
390READ DI(I,0),DI(I,1)
400NEXT
410REM read in names of ship types
420
430FORI=1TO7
440READ name$(I)
450NEXT
460
470REM number of hits that have not su
nk any ships
480
490HP=0
500
510REM position computer's ships
520
530FORI=7TO1STEP-1
540PROCcship(I)
550NEXT
560PRINT'''" All my ships are in place
."
570ENDPROC
580
590
600DEF PROCplayer`init
610
620REM position player's ships
630
640PRINT'''" You may now position your
ships & I promise I will not look."
650FORI=7TO1STEP-1
660PROCpship(I)
670NEXT
680ENDPROC
690
700
710DEF PROCcship(L) LOCAL ok
720
730REM position a computer's ship of l
ength L
740
750REPEAT
760IF RND(2)=1 THEN ok=FNcvship(L) ELS
E ok=FNchship(L)
770UNTIL ok
780ENDPROC
790
800
810DEF FNcvship(L) LOCAL X,Y,C,I
820
830REM try to position a computer's sh
ip of length L vertically
840
850X=RND(10)-1
860Y=RND(10-L)-1
870FOR I=0 TO L-1
880C=C+S(X,Y+I,0)
890NEXT
900IF C<>0 THEN =FALSE
910FOR I=0 TO L-1
920S(X,Y+I,0)=L
930NEXT
940=TRUE
950
960
970DEF FNchship(L) LOCAL X,Y,C,I
980
990REM ... horizontally
1000
1010X=RND(10-L)-1
1020Y=RND(10)-1
1030FOR I=0 TO L-1
1040C=C+S(X+I,Y,0)
1050NEXT
1060IF C<>0 THEN =FALSE
1070FOR I=0 TO L-1
1080S(X+I,Y,0)=L
1090NEXT
1100=TRUE
1110
1120
1130DEF PROCpship(L) LOCAL X,Y,ok
1140
1150REM position player's ship of lengt
h L
1160
1170REPEAT
1180PROCpshow
1190PRINT" Position of "name$(L);
1200INPUT" (X,Y) :"X,Y
1210REPEAT
1220IF L<>1 THEN INPUT"Position it hori
zontally or vertically"',A$ ELSE A$="H"
1230A$=LEFT$(A$,1)
1240UNTIL A$="H" OR A$="V"
1250IF A$="H" THEN ok=FNhpship(L) ELSE
ok=FNvpship(L)
1260UNTIL ok
1270PRINT''" OK"
1280ENDPROC
1290
1300
1310DEF PROCpshow LOCAL I,J
1320
1330REM show player ship positions
1340
1350£=INKEY(400)
1360CLS
1370PRINTSTRING$(40,"`");
1380PRINT" 0 1 2 3 4 5 6 7 8
9"
1390FOR I=0 TO 9
1400PRINT" ";I;
1410FOR J=0 TO 9
1420V=S(J,I,1)
1430C$="."
1440IF V=0 THEN C$=" "
1450IF V>=8 THEN C$="S"
1460
1470PRINT" "C$;7 AND V;
1480NEXT
1490PRINT
1500NEXT
1510PRINTSTRING$(40,"`");
1520ENDPROC
1530
1540
1550DEF FNhpship(L) LOCAL I,C
1560
1570REM try to place it horizontally
1580
1590IF X<0 OR X+L>10 OR Y<0 OR Y>9 THEN
=FALSE
1600FOR I=0 TO L-1
1610C=C+S(X+I,Y,1)
1620NEXT
1630IF C<>0 THEN =FALSE
1640FOR I=0 TO L-1
1650S(X+I,Y,1)=L
1660NEXT
1670=TRUE
1680
1690
1700DEF FNvpship(I) LOCAL I,C
1710
1720REM try to place it vertically
1730
1740IF X<0 OR X>9 OR Y<0 OR Y+L>10 THEN
=FALSE
1750FOR I=0 TO L-1
1760C=C+S(X,Y+I,1)
1770NEXT
1780IF C<>0 THEN =FALSE
1790FOR I=0 TO L-1
1800S(X,Y+I,1)=L
1810NEXT
1820=TRUE
1830
1840
1850DEF PROCplay
1860
1870REM let computer & player have alte
rnate goes at blasting each othdr
1880
1890PRINT''" Now let's start the battle
."
1900AL=TRUE
1910TC=28
1920TP=28
1930REPEAT
1940IF AL THEN PROCplayer ELSE PROCcomp
uter
1950AL=NOT AL
1960UNTIL TC=0 OR TP=0
1970ENDPROC
1980
1990
2000DEF PROCplayer LOCAL X,Y,P
2010
2020REM Pleyer's go
2030
2040PROCpshowt
2050REPEAT
2060INPUT"Your go."'"Position X,Y : "X,
Y
2070UNTIL X>=0 AND Y>=0 AND X<10 AND Y<
10
2080P=S(X,Y,0)<>0 AND 0=(S(X,Y,0)AND8)
2090S(X,Y,3)=1-P
2100S(X,Y,0)=S(X,Y,0)-P*8
2110IF P THEN PRINT''"BANG !"'" A HIT!
" ELSEPRINT''"SPLASH"
2120TC=TC+P
2130IF P THEN PROCsunk
2140ENDPROC
2150
2160
2170DEF PROCpshowt LOCAL I,J,V
2180
2190REM Show player's target field
2200
2210£=INKEY(300)
2220CLS
2230PRINTSTRING$(20,"+*");
2240PRINT" 0 1 2 3 4 5 6 7 8
9"
2250FOR I=0 TO 9
2260PRINT;I;
2270FOR J=0 TO 9
2280V=S(J,I,3)
2290IF V=0 THEN PRINT" .";
2300IF V=1 THEN PRINT" X";
2310IF V=2 THEN PRINT" *";
2320NEXT
2330PRINT
2340NEXT
2350PRINTSTRING$(20,"+*");
2360ENDPROC
2370
2380
2390DEF PROCsunk LOCAL V,C,I,J
2400
2410REM check if player has sunk one of
the computer's ships
2420
2430V=S(X,Y,0)
2440FOR I=0 TO 9
2450FOR J=0 TO 9
2460IF S(I,J,0)=V THEN C=C+1
2470NEXT
2480NEXT
2490IF C>(V AND7) THEN PRINT"ERROR":STO
P
2500IF C<(V AND7) THEN ENDPROC
2510PRINT" You sunk my "name$(V A
ND 7)"."
2520ENDPROC
2530
2540
2550DEF FNS(X,Y)
2560
2570REM read computer's target field. R
eturn 1 (tried before) if position is au
side of array
2580
2590IF X<0 OR Y<0 OR X>9 OR Y>9 THEN =1
2600=S(X,Y,2)
2610
2620
2630DEF PROCcomputer LOCAL X,Y
2640
2650REM computer's go
2660
2670IF HP=0 THEN PROCrand ELSE PROCinte
l
2680PROCtry
2690ENDPROC
2700
2710
2720DEF PROCrand LOCAL AT
2730
2740REM random shot about X,Y
2750
2760SD=RND(4)-1
2770REPEAT
2780X=RND(10)-1
2790Y=RND(10)-1
2800AT=AT+1
2810UNTIL S(X,Y,2)=0 OR AT>1500
2820IF AT>150 THEN PROCatomic
2830ENDPROC
2840
2850
2860DEF PROCtry
2870
2880REM try a shot at the calculated po
sition
2890
2900PROCpshow
2910PRINTTAB(X*3+2,Y+2)"["+CHR$9+CHR$9;
"]"
2920PRINTTAB(0,13);
2930PRINTX,Y
2940REPEAT
2950INPUT"Was that a hit a miss or a si
nking"'"(H,M,S) ",A$
2960UNTIL A$="H" OR A$="M" OR A$="S"
2970S(X,Y,1)=S(X,Y,1)+8
2980IF A$="M" THEN S(X,Y,2)=1:ENDPROC
2990TP=TP-1
3000S(X,Y,2)=2
3010LHX=X
3020LHY=Y
3030IF HP=0 THEN FHX=X:FHY=Y
3040HP=HP+1
3050IF A$="S" THEN PROCgoing`down:ENDPR
OC
3060ENDPROC
3070
3080
3090DEF PROCsd(D)
3100
3110REM move search position in directi
on SD
3120
3130D=(D+8)MOD4
3140X=X+DI(D,0)
3150Y=Y+DI(D,1)
3160ENDPROC
3170
3180
3190DEF PROCintel LOCAL SD,T
3200
3210REM find a untried position at the
end of a line of hits. Start searching f
or pos of first hit.If that fails then s
earch from last hit position.
3220REM If no line of hits could be fou
nd then search for an untried position a
round first nd last positiona. If no luc
k by now the player must have replied wr
ongly to (H,M,S). Get nasty.
3230
3240SD=RND(4)-1
3250PROChits(FHX,FHY)
3260IF T THEN ENDPROC
3270PROChits(LHX,LHY)
3280IF T THEN ENDPROC
3290PROCrab(FHX,FHY)
3300IF T THEN ENDPROC
3310PROCrab(LHX,LHY)
3320IF T THEN ENDPROC
3330PROCatomic
3340ENDPROC
3350
3360
3370DEF PROChits(U,V) LOCAL I
3380
3390REM search around U,V for an untest
ed position at the end of line of hits.
3400
3410FOR I=0 TO 3
3420X=U
3430Y=V
3440PROCsd(I+SD)
3450IF FNS(X,Y)=2 THEN PROChits1(I+SD)
3460NEXT
3470ENDPROC
3480
3490
3500DEF PROChits1(D)
3510
3520REM search in direction D for an un
tested position at the end of line of hi
ts.
3530
3540REPEAT
3550PROCsd(D)
3560UNTIL FNS(X,Y)<>2
3570IF FNS(X,Y)=0 THEN T=TRUE:SD=D:I=3
3580ENDPROC
3590
3600
3610DEF PROCrab(U,V) LOCAL I
3620
3630REM random search about U,V for an
untried position
3640
3650FOR I=0 TO 3
3660X=U
3670Y=V
3680PROCsd(I+SD)
3690IF FNS(X,Y)=0 THEN T=TRUE:I=3
3700NEXT
3710ENDPROC
3720
3730
3740DEF PROCgoing`down LOCAL I,C,A,T
3750
3760REM when computer has sunk a ship c
hange hit markers to tried (2 to 1)
3770
3780REPEAT
3790INPUT"What did I sink (1-7) ",A
3800UNTIL A>0 AND A<8
3810PRINT"I got your "name$(A)"!"
3820FOR I=0 TO 3
3830X=LHX
3840Y=LHY
3850PROCc1(X,Y,A-1)
3860IF T THEN I=3
3870NEXT
3880IF NOT T THEN STOP
3890S(X,Y,2)=1
3900HP=HP-A
3910IF HP=0 THEN ENDPROC
3920T=FALSE
3930FOR I=0 TO 9
3940FOR J=0 TO 9
3950IF S(I,J,2)=2 THEN LHX=I:LHY=J:FHX=
I:FHY=J:T=TRUE
3960NEXT
3970NEXT
3980IF NOT T THEN STOP
3990ENDPROC
4000
4010
4020DEF PROCc1(X,Y,L)
4030
4040REM recursive search in direction I
for a line of hits of length L. If foun
d change to pos tried on exit. (see text
)
4050
4060PROCsd(I)
4070T=(L=0)
4080IF FNS(X,Y)<>2 OR T THEN ENDPROC
4090PROCc1(X,Y,L-1)
4100IF T THEN S(X,Y,2)=1:ENDPROC
4110ENDPROC
4120
4130
4140DEF PROCcomment
4150
4160REM massage at end of game
4170
4180IF TP=0 THEN PRINT''"I win..!!" ELS
E PRINT''"I will have my revange."
4190IF NOT FNyes(" Do you wish to see t
he position of my ships") THEN ENDPROC
4200FOR I=0 TO 9
4210FOR J=0 TO 9
4220S(I,J,1)=S(I,J,0)
4230NEXT
4240NEXT
4250PROCpshow
4260ENDPROC
4270
4280
4290DEF FNyes(A$)
4300
4310REM ask yes or no
4320
4330PRINT A$;
4340REPEAT
4350INPUT" (Y/N)",A$
4360A$=LEFT$(A$,1)
4370UNTIL A$="Y" OR A$="N"
4380=A$="Y"
4390
4400
4410DEF PROCintro
4420
4430REM introduction & instructions
4440
4450CLS
4460PRINT'''
4490PRINT" B A T T L E S H I P
S "
4510PRINT''" The computer will first po
sition its own ships. Then it will ask
you for the positions of your ships."
4520PRINT'" When all the ships are in p
osition then the game begins. The ob
ject of the game is to sink all the comp
uter's shipsbefore it sinks yours. The o
nly problem is that you do not know wher
e each other's ships are."
4530PRINT'" Positions for shot are, for
example, 3,6 which is 3 across & 6 do
wn."''" PRESS ANY KEY TO CONTINUE :"GET
$
4540CLS
4550PRINT''" BATTLE SHIPS"'"
------ -----"
4560PRINT'''" When calculating its move
the computer does not look at the posit
ions of your ships at all, so you will
have to tell it if it has hit , missed
or sunk your ship. ";
4570PRINT"Be very careful not to lie, a
s thecomputer will find you out."''''"
PRESS ANY KEY TO PLAY :"GET$
4580CLS
4590ENDPROC
4600
4610
4620DEF PROCatomic
4630
4640REM get nasty
4650
4660CLS
4670PRINT''''" I can't find the rest of
this ship."''" I think you LIE!"'''"
BYE"
4680PRINT''''" Note for observers :"'"
The computer just dropped a H bomb"'"on
this fellow's ships."
4690END
4700
4710
4720
4730REM X,Y of the four directions (0-3
)
4740
4750DATA 0,1,1,0,0,-1,-1,0
4760
4770DATA Dinghy,Patrol Boat,Submarine,F
rigate,Cruiser,Battle Ship,Carrier