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