10REM BATTLESHIPS - version 4.2
20REM (c) M.Bobrowski 2'93
30:
40MODE 4:LOMEM=PAGE+&2C00:W%=LOMEM-&1
60:M%=W%-&120
50M%?&36=?&220:M%?&3B=?&221:XX=RND(-T
IME):*FX202,32
60DIM S%(3,9,9),N$(10),V%(10),D%(3,1)
:PS%=0:CS%=0
70PROCsetup:PROCinstr
80REPEAT
90PROCinit
100PROCplay
110PROCcomment
120UNTIL NOT FNyes("Another Game")
130END
140:
150DEF PROCinit
160FOR K%=0 TO 3:FOR I%=0 TO 9:FOR J%=
0 TO 9:S%(K%,I%,J%)=0:NEXT,,
170PROCdisplay
180H%=0:PRINT"Calculating. Please wait
a moment.."
190FOR I%=10 TO 1 STEP-1
200PROCcship(I%,V%(I%)):NEXT
210CLS:PRINT" All my ships are in plac
e."''" Position your ships now !":CALL &
927:Z=INKEY(200)
220FOR I%=10 TO 1 STEP-1
230PROCpship(I%,V%(I%)):NEXT
240PROCpshow
250ENDPROC
260:
270DEF PROCcship(N%,L%):LOCAL ok
280REPEAT:IF RND(2)=1 ok=FNcv(L%) ELSE
ok=FNch(L%)
290UNTIL ok:ENDPROC
300:
310DEF FNcv(L%):LOCAL X%,Y%,C%,I%,J%
320X%=RND(10)-1:Y%=RND(10-L%)-1
330FOR I%=X%-1 TO X%+1:FOR J%=Y%-1 TO
Y%+L%
340IF I%>-1 AND I%<10 AND J%>-1 AND J%
<10 C%=C%+S%(0,I%,J%)
350NEXT,:IF C%>0:=FALSE
360FOR I%=0 TO L%-1
370S%(0,X%,Y%+I%)=N%
380NEXT
390=TRUE
400:
410DEF FNch(L%):LOCAL X%,Y%,C%,I%,J%
420X%=RND(10-L%)-1:Y%=RND(10)-1
430FOR I%=X%-1 TO X%+L%:FOR J%=Y%-1 TO
Y%+1
440IF I%>-1 AND I%<10 AND J%>-1 AND J%
<10 C%=C%+S%(0,I%,J%)
450NEXT,:IF C%>0:=FALSE
460FOR I%=0 TO L%-1
470S%(0,X%+I%,Y%)=N%
480NEXT
490=TRUE
500:
510DEF PROCpship(N%,L%):LOCAL X%,Y%,ok
520REPEAT
530PROCpshow:SOUND 1,-10,200,2
540CLS:PRINT"Position of "N$(N%);" : "
;:PROCenter
550IF L%>1 PRINT"Position it horizonal
ly or"'"vertically (H,V) ? ";:REPEAT A$=
GET$:UNTIL INSTR("HV",A$):PRINTA$ ELSE A
$="H"
560IF A$="H" ok=FNph(L%) ELSE ok=FNpv(
L%)
570IF NOT ok SOUND 1,2,200,20:PRINT'CH
R$(X%+65);Y%;" ? ILLEGAL PLACING !";:FOR
Z=0 TO 4000:NEXT
580UNTIL ok:PRINT'"OK";
590ENDPROC
600:
610DEF PROCpshow:LOCAL I%,J%
620VDU5:FOR I%=0 TO 9:FOR J%=0 TO 9
630V%=S%(1,J%,I%):IF V%=0 ELSE MOVE 13
6+J%*44,746-I%*44:IF V%<11 VDU229 ELSE I
F V%>11 GCOL 1,0:VDU 228:GCOL 0,1
640NEXT,:VDU4:ENDPROC
650:
660DEF FNph(L%):LOCAL I%,J%,C%
670IF X%+L%>10:=FALSE
680FOR I%=X%-1 TO X%+L%:FOR J%=Y%-1 TO
Y%+1
690IF I%>-1 AND I%<10 AND J%>-1 AND J%
<10 C%=C%+S%(1,I%,J%)
700NEXT,:IF C%>0:=FALSE
710FOR I%=0 TO L%-1
720S%(1,X%+I%,Y%)=N%
730NEXT
740=TRUE
750:
760DEF FNpv(L%):LOCAL I%,J%,C%
770IF Y%+L%>10:=FALSE
780FOR I%=X%-1 TO X%+1:FOR J%=Y%-1 TO
Y%+L%
790IF I%>-1 AND I%<10 AND J%>-1 AND J%
<10 C%=C%+S%(1,I%,J%)
800NEXT,:IF C%>0:=FALSE
810FOR I%=0 TO L%-1
820S%(1,X%,Y%+I%)=N%
830NEXT
840=TRUE
850:
860DEF PROCplay
870CLS:PRINT" Now let's start the batt
le.":B%=RND(2)-2:Q%=20:P%=20:PRINT'" Thi
s time ";:IF B% PRINT"you begin."; ELSE
PRINT"I begin.";
880PROCsound1:PROCsound2
890REPEAT:CLS
900IF B% PROCplayer ELSE PROCcomputer
910B%=NOT B%
920UNTIL Q%=0 OR P%=0
930ENDPROC
940:
950DEF PROCplayer:LOCAL X%,Y%,Z%
960CLS:PRINT"Your go. ";
970REPEAT:SOUND 1,-10,200,2
980PRINT"Position : ";:PROCenter:IF S%
(3,X%,Y%)<>0 PRINT"Already shot !"':SOUN
D 1,2,200,20
990UNTIL S%(3,X%,Y%)=0:SOUND1,-10,200,
2
1000Z%=S%(0,X%,Y%)<>0 AND NOT (S%(0,X%,
Y%) AND 16)
1010S%(3,X%,Y%)=1-Z%:S%(0,X%,Y%)=S%(0,X
%,Y%)-Z%*16
1020Q%=Q%+Z%:PROCtarget
1030IF Z% PROCsound3:PROCsunk
1040ENDPROC
1050:
1060DEF PROCtarget
1070VDU 5:V%=S%(3,X%,Y%)
1080IF V%=0 ELSE MOVE 764+X%*44,746-Y%*
44:IF V%=1 VDU227 ELSE VDU228
1090VDU 4:ENDPROC
1100:
1110DEF PROCsunk:LOCAL V%,C%,I%,J%
1120V%=S%(0,X%,Y%)
1130FOR I%=0 TO 9:FOR J%=0 TO 9
1140IF S%(0,I%,J%)=V% C%=C%+1
1150NEXT,
1160IF C%<V%(V% AND15) ENDPROC
1170PRINT'"You sunk my "N$(V% AND 15)".
":PROCsound2
1180ENDPROC
1190:
1200DEF PROCcomputer:LOCAL X%,Y%
1210PRINT"Thinking ...":IF H%=0 PROCran
d ELSE PROCintel
1220PROCtry
1230ENDPROC
1240:
1250DEF PROCrand
1260R%=RND(4)-1
1270F%=0:REPEAT:F%=F%+1:IF F%>1000 H%=4
:PROClie
1280X%=RND(10)-1:Y%=RND(10)-1
1290UNTIL S%(2,X%,Y%)=0 AND FNaround(X%
,Y%)
1300ENDPROC
1310:
1320DEF FNaround(X%,Y%):LOCAL I%,J%,K%:
K%=TRUE
1330FOR J%=Y%+(Y%>0) TO Y%-(Y%<9):FOR I
%=X%+(X%>0) TO X%-(X%<9)
1340IF S%(2,I%,J%)=2 K%=FALSE
1350NEXT,:=K%
1360:
1370DEF PROCtry
1380PROCcross:SOUND 1,-10,0,10
1390CLS:PRINT'"My shot is at "CHR$(X%+6
5);Y%;". Is this a hit,"'"a sinking, or
a miss (H,S,M) ? ";
1400TIME=1:REPEAT:G%=INKEY(0):IF TIME M
OD 1000=0 SOUND 1,2,150,5
1410A$=CHR$G%:UNTIL INSTR("HMS",A$)
1420VDU4:PRINTA$:PROCcross
1430S%(1,X%,Y%)=S%(1,X%,Y%)+16
1440IF A$="M" S%(2,X%,Y%)=1:ENDPROC
1450P%=P%-1:S%(2,X%,Y%)=2:PROCupdate:PR
OCsound3
1460lhx%=X%:lhy%=Y%
1470IF H%=0 fhx%=X%:fhy%=Y%
1480H%=H%+1:IF H%>4 PROClie
1490IF A$="H" ENDPROC
1500H%=0:PROCsound1:ENDPROC
1510:
1520DEF PROCcross
1530VDU 5:GCOL 4,0:MOVE 136+X%*44,746-Y
%*44:VDU226:GCOL 0,1:VDU 4:ENDPROC
1540:
1550DEF PROCupdate
1560VDU 24,136+X%*44;714-Y%*44;168+X%*4
4;746-Y%*44;16:MOVE 136+X%*44,746-Y%*44:
GCOL 0,1:VDU 5,224,4,24,0;0;1279;1023;:E
NDPROC
1570:
1580DEF PROCsd(D%)
1590D%=(D%+8)MOD4
1600X%=X%+D%(D%,0):Y%=Y%+D%(D%,1)
1610ENDPROC
1620:
1630DEF PROCintel:LOCAL R%,T%
1640R%=RND(4)-1
1650PROChits(fhx%,fhy%):IF T% ENDPROC
1660PROChits(lhx%,lhy%):IF T% ENDPROC
1670PROCrecheck(fhx%,fhy%):IF T% ENDPRO
C
1680PROClie
1690ENDPROC
1700:
1710DEF PROChits(U%,V%):LOCAL I%
1720FOR I%=0 TO 3
1730X%=U%:Y%=V%:PROCsd(I%+R%)
1740IF FNs(X%,Y%)=2 PROChits1(I%+R%)
1750NEXT
1760ENDPROC
1770:
1780DEF PROChits1(D%)
1790REPEAT
1800PROCsd(D%)
1810UNTIL FNs(X%,Y%)<>2
1820IF FNd(X%,Y%) T%=TRUE:R%=D%:I%=3
1830ENDPROC
1840:
1850DEF PROCrecheck(U%,V%):LOCAL I%
1860FOR I%=0 TO 3
1870X%=U%:Y%=V%:PROCsd(I%+R%)
1880IF FNd(X%,Y%) T%=TRUE:I%=3
1890NEXT
1900ENDPROC
1910:
1920DEF FNs(X%,Y%)
1930IF X%<0 OR Y%<0 OR X%>9 OR Y%>9 THE
N =1 ELSE =S%(2,X%,Y%)
1940:
1950DEF FNd(X%,Y%):IF FNs(X%,Y%)>0:=FAL
SE
1960dx%=SGN(X%-lhx%):dy%=SGN(Y%-lhy%):X
2%=X%+dx%:Y2%=Y%+dy%
1970IF X2%<0 OR X2%>9 OR Y2%<0 OR Y2%>9
:=TRUE
1980IF S%(2,X2%,Y2%)=2:=FALSE
1990IF X2%>0 AND dx%=0 IF S%(2,X2%-1,Y2
%)=2:=FALSE
2000IF X2%<9 AND dx%=0 IF S%(2,X2%+1,Y2
%)=2:=FALSE
2010IF Y2%>0 AND dy%=0 IF S%(2,X2%,Y2%-
1)=2:=FALSE
2020IF Y2%<9 AND dy%=0 IF S%(2,X2%,Y2%+
1)=2:=FALSE
2030=TRUE
2040:
2050DEF PROCcomment
2060PS%=PS%+P%:CS%=CS%+Q%
2070CLS:IF P%=0 PRINT'"I "; ELSE PRINT'
"You ";
2080PRINT"win.";SPC6;"Total score is ";
PS%;":";CS%
2090IF Q%=0 CALL &900:ENDPROC ELSE IF N
OT FNyes("Do you wish to see the positio
ns of my ships") ENDPROC
2100VDU 5:FOR I%=0 TO 9:FOR J%=0 TO 9
2110V%=S%(0,I%,J%):IF V%>0 AND V%<11 MO
VE 764+I%*44,746-J%*44:VDU229:SOUND 1,2,
I%*J%*3,3:SOUND 1,0,0,3
2120NEXT,:VDU 4
2130ENDPROC
2140:
2150DEF FNyes(A$)
2160PRINT A$;" (Y/N) ? ";
2170REPEAT
2180A$=GET$:UNTIL INSTR("YN",A$):PRINTA
$:CALL &927
2190=(A$="Y")
2200:
2210DEF PROClie
2220CLS:OSCLI"FX15,1":SOUND 1,2,200,20:
IF H%<4 PRINT" I can't find the rest of
this ship":ELSE IF H%=4 PRINT" Impossibl
e! I tested all positions":ELSE PRINT" H
it? It's impossible!"
2230PRINT'" I think you cheat. ";:FORZ=
1TO4000:NEXT:PROCsound3:PROCsound2:PRINT
"Bye!":PROCsound3:END
2240:
2250DEF PROCsetup
2260FOR I%=0 TO &115 STEP4:I%!&900=I%!M
%:NEXT
2270FOR I%=0 TO 3:READ D%(I%,0),D%(I%,1
):NEXT
2280FOR I%=1 TO 10:READ N$(I%),V%(I%):N
EXT
2290CLS:VDU23;8202;0;0;0;19,0,4;0;19,1,
3;0;
2300VDU23,224,170,85,170,85,170,85,170,
85,23,225,0,24,38,193,0,24,38,193,23,226
,24,24,24,255,255,24,24,24,23,227,0,60,6
6,66,66,66,60,0,23,228,0,60,126,126,126,
126,60,0,23,229,255,255,255,255,255,255,
255,255
2310ENVELOPE 1,5,0,0,0,0,0,0,120,-5,-2,
-10,63,63:ENVELOPE 2,4,4,8,128,4,8,128,1
26,0,0,-126,126,126:ENVELOPE 3,132,-1,0,
0,50,0,0,20,-1,-1,-12,100,0:ENVELOPE 4,1
,0,0,0,0,0,0,126,-1,0,-20,126,30
2320ENDPROC
2330:
2340DEF PROCdisplay
2350VDU5,24,56;256;600;776;16,24,684;25
6;1228;776;16,26
2360x=128:FOR y=312 TO 752 STEP 44:MOVE
128,y:DRAW 568,y:MOVE x,312:DRAW x,752:
MOVE 756,y:DRAW 1196,y:MOVE 628+x,312:DR
AW 628+x,752:x=x+44:NEXT
2370a=65:b=48:y=744:FOR x=136 TO 532 ST
EP 44:MOVE x,296:VDU a:MOVE 80,y:VDU b:M
OVEx+628,296:VDU a:MOVE 708,y:VDU b:a=a+
1:b=b+1:y=y-44:NEXT:VDU 4
2380VDU 28,2,29,37,26,12:ENDPROC
2390:
2400DEF PROCenter:LOCAL x%,y%:x%=POS:y%
=VPOS:*FX11
2410REPEAT:IF FNkey=0 PRINTTAB(x%,y%)SP
C2;TAB(x%,y%);
2420UNTIL INKEY-74:OSCLI"FX12":PRINT':E
NDPROC
2430:
2440DEF FNkey:REPEAT:OSCLI"FX15,1":G%=G
ET:UNTIL G%>64 AND G%<75:VDUG%:X%=G%-65:
REPEAT:G%=GET:UNTIL G%>47 AND G%<58 OR G
%=127:VDUG%:IF G%=127:=FALSE
2450Y%=G%-48:REPEAT UNTIL INKEY-90 OR I
NKEY-74
2460IF INKEY-90 THEN =FALSE:ELSE =TRUE
2470:
2480DEF PROCsound1:FOR K%=0 TO 225 STEP
4:SOUND 1,-K%DIV15,K%,1:NEXT:ENDPROC
2490DEF PROCsound2:FOR K%=225 TO 1 STEP
-4:SOUND 1,-K%DIV15,K%,1:NEXT:ENDPROC
2500DEF PROCsound3:SOUND 0,4,6,20:FOR Z
=0TO1200:NEXT:ENDPROC
2510:
2520DATA 0,1,1,0,0,-1,-1,0
2530DATA Dinghy,1,Patrol Boat,1,Tug Boa
t,1,Submarine,1,Minesweeper,2,Frigate,2,
Cruiser,2,Destroyer,3,Battleship,3,Aircr
aft Carrier,4
2540DATA 48,248,608,784, 676,248,1236,7
84, 48,32,1236,212
2550:
2560DEF PROCinstr
2570FOR I%=0 TO 4:PRINTSTRING$(255,CHR$
224);:NEXT:VDU 5:MOVE 1122,30:PRINTSTRIN
G$(6,CHR$224):PROCbo:PROCw(48,832,1236,1
000):PROCw(48,32,1236,784)
2580FOR I%=0 TO 172 STEP4:I%!&5AC8=I%!W
%:NEXT:FOR I%=0 TO 172 STEP4:I%!&5C08=I%
!(W%+&B0):NEXT
2590PROCship(172,890):PROCship(1100,888
):GCOL 4,0:MOVE 52,870:PRINTSTRING$(37,C
HR$225):VDU 18,0,1,4,28,2,29,37,8
2600CALL &900:ON ERROR VDU4:CALL&927:RE
PORT:END
2610PROCtext
2620VDU 26,31,0,7:FOR I%=0 TO 2:PRINTST
RING$(255,CHR$224);:NEXT:VDU 5:MOVE 160,
191:PRINTSTRING$(235,CHR$224):PROCbo:FOR
I%=0 TO 2:READ a,b,c,d:PROCw(a,b,c,d):N
EXT:VDU4
2630ENDPROC
2640:
2650DEF PROCbo:GCOL 0,1:MOVE 0,0:DRAW 0
,1023:DRAW 1279,1023:DRAW 1279,0:DRAW 0,
0:ENDPROC
2660:
2670DEF PROCship(X,Y)
2680VDU29,X;Y;
2690MOVE -4,20:MOVE -100,0:PLOT 85,-88,
-32:MOVE -4,-32:PLOT 85,-4,20:MOVE 4,20:
MOVE 100,0:PLOT 85,88,-32:MOVE 4,-32:PLO
T 85,4,20
2700MOVE -60,40:DRAW 60,40:MOVE 60,16:P
LOT 85,0,28:MOVE -60,16:PLOT 85,-60,40:M
OVE -40,48:MOVE 40,48:PLOT 85,40,56:MOVE
-40,56:PLOT 85,-40,48
2710MOVE 0,56:DRAW 0,72:MOVE -10,64:DRA
W 12,64:MOVE -50,28:PLOT 22,-20,28:MOVE
52,28:PLOT 22,20,28:PLOT 69,8,32:PLOT 69
,-8,32
2720VDU 26:ENDPROC
2730:
2740DEF PROCw(L%,B%,R%,T%):VDU 18,0,129
,18,0,0,24,L%-16;B%-16;R%-16;T%-16;16,26
:MOVE L%-16,B%-16:DRAW R%-16,B%-16:DRAW
R%-16,T%-16:DRAW L%-16,T%-16:DRAW L%-16,
B%-16:VDU 18,0,128,18,0,1,24,L%;B%;R%;T%
;16,26
2750MOVE L%,B%:DRAW R%,B%:DRAW R%,T%:DR
AW L%,T%:DRAW L%,B%
2760ENDPROC
2770:
2780DEF PROCsp:LOCAL A$,B$,C$,I%:OSCLI"
FX21":A$=STRING$(17," ")+"Press <SPACE B
AR>":REPEAT:B$=INKEY$0:C$=LEFT$(A$,1):A$
=RIGHT$(A$,33)+C$:PRINTTAB(1,20);A$:FORI
%=0TO1000:NEXT:UNTILB$=" ":CLS:ENDPROC
2790:
2800DEF PROCtext
2810PRINT"This version of the game allo
ws you to play against the computer as a
n opponent. The object of the game is t
o sink the computer's fleet before it si
nks yours."
2820PRINT'"The ships are represented as
lines of squares of various length and
areplaced on a ten by ten grid. The"'"g
rid rows are numbered from 0 to 9 and t
he grid columns are indicated with lett
ers from A to J."
2830PRINT'"There are two grids on the s
creen. The grid on the left hand side"'
"stores the positions of your ships and
the one on the right side shows the res
ults of your shots.":PROCsp
2840PRINT"Each fleet consists of 10 shi
ps:-"''" Aircraft carrier - 4 squares"'
" Battleship"TAB(19)"- 3 squares"'" De
stroyer"TAB(19)"- 3 squares"'" Cruiser"
TAB(19)"- 2 squares"'" Frigate"TAB(19)"
- 2 squares"
2850PRINT" Minesweeper"TAB(19)"- 2 squ
ares"'" Submarine"TAB(19)"- 1 square"'"
Tug boat"TAB(19)"- 1 square"'" Patrol
Boat"TAB(19)"- 1 square"'" Dinghy"TAB(
19)"- 1 square"
2860PRINT'"Larger ships occupy contiguo
us grid locations, and are placed either
"'"horizontally or vertically. No two"'"
ships will touch.":PROCsp
2870PRINT"The computer will first posit
ion"'"its own ships. Then it will be ask
you for the positions of your ships."
2880PRINT"It is worth remembering that
each ship should be surrounded by one"
'"empty square in all directions."
2890PRINT'"When all the ships are in po
sition the battle begins and shots are"
'"alternated until one fleet (yours orth
at of your opponent) is destroyed.":PROC
sp
2900PRINT"Your shots are fired by enter
ing"'"the position of the target square
and pressing <RETURN>."''"Positions fo
r shots are, for exampleD3, which is: co
lumn D, row 3."
2910PRINT'"The result of your shot will
be"'"shown on the right hand grid. A mi
ssis denoted by a square with rounded co
rners whereas a hit is denoted by a fill
ed circle."
2920PRINT'"The position of the computer
's shot is indicated each time by a cros
s onthe left hand grid. Simultanously a
question appears in the text window.":PR
OCsp
2930PRINT"As a rule, when calculating i
ts movethe computer does not look at the
positions of your ships at all, so y
ou will have to tell the computer if it
has hit (H), missed (M), or"'"sunk (S)
your ship."
2940PRINT'"When replying to a computer
guess be very careful to give the corr
ect response so that you are not accused
of cheating. If you make a mistake or i
f you try to lie, the computer will fin
d you out."
2950PRINT'"At the end of each battle th
e"'"current score is given.":PROCsp
2960ENDPROC