; Battleships
; Version 1.0
; For Megan and Jochen
break on
$=setascii(on)
$seed=val(substr("@time",7,2)) $seed=$seed+1
do $=rnd(1) $seed=$seed-1 until $seed=0
; Dimension vars
dim $boat[5] ; boat names
dim $name ; players name
dim $nameA[8] ; players name generator array
dim $grid[100] ; 10x10 grid
dim $boatlen[5] ; boat size
dim $boathit[5] ; hit indicators
dim $g dim $gy dim $gx
dim $ship1[7] dim $ship2[7] dim $ship3[7] ; intro graphics
; Setup vars
$boat[0]="Frigate " $boatlen[0]=2
$boat[1]="Submarine " $boatlen[1]=3
$boat[2]="Cruiser " $boatlen[2]=3
$boat[3]="BattleShip" $boatlen[3]=4
$boat[4]="Carrier " $boatlen[4]=5
$name="Player" $last="o" $lose=0
$path="c:\scripts" $random=0
$boathit[0]=0 $boathit[1]=0 $boathit[2]=0 $boathit[3]=0 $boathit[4]=0
$ship1[5]=" \ /" $ship1[6]=" \ /"
$ship2[0]=" _" $ship2[1]=" __|_" $ship2[2]=" | 87 |"
$ship3[5]=" \ \/ \/ / \/. / " $ship3[6]=" \ .\ \ / /. / "
$ship2[3]=" ________|____|________" $ship2[4]=" / ooo -- ooo \"
$ship3[3]=" | / \/ \/ | " $ship3[4]=" | \ /\ / /\ /. | "
$ship2[5]=" [| -- |" $ship2[6]=" x\______________________/"
$ship1[3]="_____|__|___|_____|___|__|____" $ship1[4]="\ 11 . . . . . /"
$ship3[0]=" |\ | | /| "
$ship3[1]=" | \/\| | | |/\/ | " $ship3[2]=" |/ \ \| |/ / | "
$ship1[0]=" |" $ship1[1]=" \ \ __|__ / /"
$ship1[2]=" \_\ | | /_/"
$i=0 do $grid[$i]=9 $i=$i+1 until $i=100
goto MAIN
:intro ; -------------------------------------------------------------------------- intro screen
cls at(12,10) color b+/n "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
; Draw ship and sub
color w/n $y=0 do at(5+$y,17) $ship1[$y] at(16+$y,20) $ship2[$y] $y=$y+1 until $y=7
; move sub
$x=20 do $y=0 do at(16+$y,$x) $ship2[$y] $y=$y+1 until $y=7 $x=$x+1 until $x=30
; shoot
$y=19 do at($y+1,35) " " at(12,35) color b+/n "~" color w/n at($y,35) "!" at(19,35) "_" at(20,35) "o"
at (31-$y,25) " " at(12,25) color b+/n "~" color w/n at(32-$y,25) "o" at(24,79) sleep 1 $y=$y-1 until $y=10
at(21,25) " " at(22,25) "*"
; burn ship
$end=50 gosub burn at(22,25) " "
; Break ship
color w/n $y=0 do at(5+$y,17) $ship3[$y] $y=$y+1 until $y=7
; burn ship
$end=30 gosub burn
; sink ship
color w/n $d=0 do $y=6 at($d+11-$y,17) " " do color w/n at($d+12-$y,17) $ship3[6-$y]
$y=$y-1 until $y=$d $end=10 gosub burn $d=$d+1 until $d=6
; move sub
color w/n $x=30 do $y=0 do at(16+$y,$x) $ship2[$y] $y=$y+1 until $y=7 $x=$x+1 until $x=50
; write title
big color w/n at(0,0) "Battle" ? " Ships" small ? ? ? ? ? "Version 1.0" ? "by cj" ? ? ? "Press any key to begin" get$ cls
return
:burn
$c=0 do $a=rnd(3)+8 $b=rnd(10)+27 $s1=rnd(2)+176 $s2=rnd(2)+176 $s3=rnd(2)+176
$col=rnd(2) if $col=0 color r+/n endif if $col=1 color r/n endif if $col=2 color y+/n endif
at($a,$b) chr($s1) at($a-1,$b-1) chr($s2) at($a-1,$b+1) chr($s3) $c=$c+1 until $c=$end
return
:drawgrid ; -------------------------------------------------------------------------- draw grid
$r=3
do
at($r,3) "³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³"
at($r+1,3) "ÃÄÄÅÄÄÅÄÄÅÄÄÅÄÄÅÄÄÅÄÄÅÄÄÅÄÄÅÄÄ´"
$r=$r+2
until $r=23
at(2,3) "ÚÄÄÂÄÄÂÄÄÂÄÄÂÄÄÂÄÄÂÄÄÂÄÄÂÄÄÂÄÄ¿"
at(22,3) "ÀÄÄÁÄÄÁÄÄÁÄÄÁÄÄÁÄÄÁÄÄÁÄÄÁÄÄÁÄÄÙ"
; If you can't use the bars above, use the following code:
;$a=chr(218) $b=chr(191) $c=chr(192) $d=chr(217) $e=chr(196) $f=chr(179)
;$g=chr(195) $h=chr(180) $i=chr(194) $j=chr(193) $k=chr(197)
;$r=3
;do
; at($r,3) "$f $f $f $f $f $f $f $f $f $f $f"
; at($r+1,3) "$g$e$e$k$e$e$k$e$e$k$e$e$k$e$e$k$e$e$k$e$e$k$e$e$k$e$e$k$e$e$h"
; $r=$r+2
;until $r=23
;at(2,3) "$a$e$e$i$e$e$i$e$e$i$e$e$i$e$e$i$e$e$i$e$e$i$e$e$i$e$e$i$e$e$b"
;at(22,3) "$c$e$e$j$e$e$j$e$e$j$e$e$j$e$e$j$e$e$j$e$e$j$e$e$j$e$e$j$e$e$d"
color w/n
at(1,4) "A B C D E F G H I J"
at(1,4) $i=0 do at(3+2*$i,2) "$i" $i=$i+1 until $i=10
at(2,37) "Battleships"
at(3,37) "Version 1.0"
at(5,37) "Please enter your name :"
$i=0 do $nameA[$i]=" " $i=$i+1 until $i=8
$i=0
do
:wrong
at(5,62+$i) get $a
if $a=chr(13) if $i=0 $name="Chris" endif $i=8 goto leave endif
if $a=chr(8)
if $i>0 $i=$i-1 endif
at(5,62+$i) " "
endif
if ((asc($a)>47) and (asc($a)<58)) or ((asc($a)>64) and (asc($a)<91)) or ((asc($a)>96) and (asc($a)<123))
at(5,62+$i) $a ; Restrictions are because this name will be a filename later.
$nameA[$i]=$a
$name=""
$i=$i+1
else
goto wrong
endif
:leave
until $i=8
$i=0
do
if $nameA[$i]<>" " $name=$name+$nameA[$i] endif
$i=$i+1
until $i=8
at(5,37) " "
at(5,37) "Welcome Commander $name."
color w+/n
at(7,37) "Enter co-ordinates:" color w/n
return
:getXY ; ---------------------------------------------======================================= Get Co-ordinates
$boatname=$boat[$i] $nogo=0
select case $i=0 color b/n case $i=1 color g/n case $i=2 color c/n case $i=3 color m/n case $i=4 color y/n endselect
at(8+$i,37) "$boatname : "
; Get column
:inputcol
if $random=1 $gx=rnd(9) $gy=rnd(9) goto calc endif
if $bad=0
$j=0 do at(3+2*$j,2) " " $j=$j+1 until $j=10
color w+/n at(1,4) ? color w/n
else
color w+/n at(9,62) "ABCDEFGHIJ"
$z=0 do at(10+$z,61) " " $z=$z+1 until $z=10
endif
at(8+$i,41+len($boatname))
flushkb get $c $c=ucase($c)
if $c="Q" goto bye endif
if $c="R" $random=1 $gx=rnd(9) $gy=rnd(9) goto calc else $random=0 endif
if (asc($c)>64) and (asc($c)<75) at(8+$i,41+len($boatname))
"$c"
else goto inputcol
endif
; Get row
:inputrow
if $bad=0
at(1,4) " "
color w+/n $j=0 do at(3+2*$j,2) "$j" $j=$j+1 until $j=10 color w/n
else
at(9,62) " "
color w+/n $z=0 do at(10+$z,61) "$z" $z=$z+1 until $z=10
endif
at(8+$i,42+len($boatname))
flushkb get $r
if $r="q" goto bye endif
if (asc($r)>47) and (asc($r)<58) at(8+$i,42+len($boatname))
"$r"
else goto inputrow
endif
; create Display vars from user input
$gx=asc($c)-65
$gy=asc($r)-48
:calc
$x=(2*$gx)+($gx+4)
$y=(2*$gy)+3
$g=($gy*10)+$gx
; restore colours
if $bad=0
color w/n at(1,4) "A B C D E F G H I J"
color w/n at(1,4) $j=0 do at(3+2*$j,2) "$j" $j=$j+1 until $j=10
else
color w/n at(9,62) "ABCDEFGHIJ"
$z=0 do at(10+$z,61) "$z" $z=$z+1 until $z=10
endif
return
:checkgrid ; ----------------------------------------------------------------------- Check grid
; Check possible starting point
$gn=$grid[$g]
if $gn=9 else at(8+$i,41+len($boatname)) " " $nogo=1 goto out endif
; Get scope
$b=$boatlen[$i]
$by1=9-$b+1 $by2=0+$b-1
;at(23,40) "$$b=$b $$by1=$by1 $$by2=$by2 $$gx=$gx $$gy=$gy "
; Check within scope
$ra="M" $da="P" $la="K" $ua="H"
if $gx>($by1) $ra="" endif
if $gx<($by2) $la="" endif
if $gy>($by1) $da="" endif
if $gy<($by2) $ua="" endif
;Check directions
; First check that this ship will not cross others
$j=1 $c=" " $rc="9" $dc="9" $lc="9" $uc="9"
do
if $ra<>"" $rc=$grid[$g+$j] endif ; right >
if $da<>"" $dc=$grid[$g+($j*10)] endif ; down v
if $la<>"" $lc=$grid[$g-$j] endif ; left <
if $ua<>"" $uc=$grid[$g-($j*10)] endif ; up ^
if $rc<>9 $ra="" endif
if $dc<>9 $da="" endif
if $lc<>9 $la="" endif
if $uc<>9 $ua="" endif
$j=$j+1
until $j=$boatlen[$i]
; $avail is the allowed directions
$avail=$ra+$da+$la+$ua
; If $avail=0 then the ship will not fit in the space
if len($avail)=0
$nogo=1 color r+/n
at(14,37) "Ship will not fit here"
color w/n goto out
else
at(14,37) " "
endif
; Get direction
color w/n at(8+$i,44+len($boatname))
; Display allowed directions only
if $random=0
if $ra<>"" chr(16) " " endif ; >
if $da<>"" chr(31) " " endif ; v
if $la<>"" chr(17) " " endif ; <
if $ua<>"" chr(30) " " endif ; ^
endif
:getway ; -------------------------------------------------------------------------- Get way
if $random=0
get $way
else
$rndch=rnd(3)
if $rndch=0 $way="M" endif
if $rndch=1 $way="P" endif
if $rndch=2 $way="K" endif
if $rndch=3 $way="H" endif
endif
if $way="q" goto bye endif
if instr($avail,$way) else goto getway endif
; Calculate ship size on screen
if ($way="M") or ($way="K") $t=(($boatlen[$i]-1)*3)+2 $k=0 endif ; horizontal
if ($way="P") or ($way="H") $t=($boatlen[$i]*2)-1 $k=0 endif ; vertical
;Choose ship colour
select case $i=0 color b/n case $i=1 color g/n case $i=2 color c/n case $i=3 color m/n case $i=4 color y/n endselect
; Display ship
do
if $way="M" at($y,$x+$k) chr(219) endif ; right
if $way="P" at($y+$k,$x) chr(219) chr(219) endif ; down
if $way="K" at($y,$x-($k-1)) chr(219) endif ; left
if $way="H" at($y-$k,$x) chr(219) chr(219) endif ; up
$k=$k+1
until $k=$t
color w/n
; Update database
$j=0
do
$grid[$g]=$i
if $way="M" $g=$g+1 endif ; right
if $way="P" $g=$g+10 endif ; down
if $way="K" $g=$g-1 endif ; left
if $way="H" $g=$g-10 endif ; up
$j=$j+1
until $j=$boatlen[$i]
:out
return
:debug
; Display GRID database (Debug)
at(13,41) color w/n
$y=0 $d=" "
do
$x=0
do
at(13+$y,41+$x)
$g=($y*10)+$x
if $grid[$g]=9 $grid[$g] else "." endif
$x=$x+1
until $x=10
$y=$y+1
until $y=10
return
:status ; ------------------------------------------------------------------------------ Status check
; Check status of boats and display on screen
$i=0 $lose=1
do
at(8+$i,51)
if $boathit[$i]=0 at(8+$i,51) color g+/n "100%" $lose=0 endif
if ($boathit[$i]>0) and ($boathit[$i]<$boatlen[$i]) $p=100-(($boathit[$i]*100)/$boatlen[$i]) color y+/n "$p% " $lose=0 endif
if $boathit[$i]=$boatlen[$i] color r+/n "Lost" endif
$i=$i+1
until $i=5
color w/n
return
:checkhit
$gn=$grid[$g] $last="o"
if $gn<>9
if $gn<>8 $boathit[$gn]=$boathit[$gn]+1 $last="X" endif
$grid[$g]=8
; Display explosion
color r+/n
else
color w/n
endif
at($y,$x) chr(178) chr(178)
color w/n
return
:badguy
color r+/n
at(7,61) "$badguy"
color w/n
box(8,60,20,72,single)
at(9,62) "ABCDEFGHIJ"
$y=0
do
at(10+$y,61) "$y"
$x=0
do
at(10+$y,62+$x)"."
$x=$x+1
until $x=10
$y=$y+1
until $y=10
return
:blowmeup
$gx=rnd(9) ;$gx=$gx*10 $gx=$gx/10
$gy=rnd(9) ;$gy=$gy*10 $gy=$gy/10
$x=(2*$gx)+($gx+4)
$y=(2*$gy)+3
;at(17,40) "$$x=$x $$y=$y "
;at(18,40) "$$gx=$gx $$gy=$gy "
$g=(10*$gy)+$gx ;at(19,40) "$$g=$g "
gosub checkhit
return
:showbad
if $mark="X" color r+/n else color w+/n endif
at(10+$gy,62+$gx)"$mark"
color w/n
return
:sendattack
$=open(1,"$path\$name.txt",5)
$out=$last+chr(13)+chr(10)
$=writeline(1,$out)
$out=chr($gx+65)+","+chr($gy+48)
$=writeline(1,$out)
$=close(1)
return
:getattack
$r=exist("$path\$badguy.txt")
if $r=0 sleep 1 goto getattack endif
sleep 1
$=open(1,"$path\$badguy.txt")
$in1=readline(1)
if $in1="lose" color g+/n at(17,37) "You Won!" goto bye endif
$in2=readline(1)
$=close(1)
del "$path\$badguy.txt"
return
:gameON
del "$path\$name.txt" ; clean up from previous games
$r=open(1,"$path\game.txt")
if $r=2 ; start new game
$create=1
$=open(1,"$path\game.txt",5)
$=writeline(1,$name)
$=close(1)
:getreply
$r=open(1,"$path\reply.txt")
if $r=2 sleep 1 goto getreply endif
$badguy=readline(1)
$=close(1)
del "$path\reply.txt"
else ; join this game
$create=0
$badguy=readline(1)
$=close(1)
del "$path\game.txt"
$=open(1,"$path\reply.txt",5)
$=writeline(1,$name)
$=close(1)
endif
return
:bye
; Clean up files
$last="lose"
gosub sendattack
del "$path\$badguy.txt"
at(22,0) color w+/n "Bye!" ?
quit
:MAIN ; ============================================================================ Main
gosub intro ; intro screen
gosub drawgrid ; Draw screen
$i=0 $r=" " $c=" " $g=0
do
:getagain
$bad=0
gosub getXY ; Get players ship placements
gosub checkgrid ; Check and place ships
if $nogo=1 goto getagain endif
at(8+$i,41+len($boatname)) " " ; Clean up screen
$i=$i+1
; gosub debug
until $i=5
$random=0
color w+/n at(15,37) "Looking for player"
gosub gameON ; look for a game to join/create
at(7,37) "Ship Status "
gosub badguy ; draw bad guy mini screen
:shoot
gosub status ; update ship status
if $lose=1 $last="lose" gosub sendattack color r+/n at(17,37) "You lost!" goto bye endif
; This code is for self destruct - used in testing
;gosub blowmeup
if $create=0 goto waitnow endif
; Get attack co-ordinates
color w+/n at(15,37) "Enter attack: "
$i=7 $bad=1 $random=0
gosub inputcol
$mark="?"
gosub showbad ; Show ? on bad guy mini screen
color w/n at(15,37) "Processing... "
gosub sendattack ; send attack co-ords to bad guy
:waitnow
$create=1
gosub getattack ; get result of attack and get bad guys attack from bad guy
; $in1 is result of my attack - "o" for miss and "X" for hit
; $in2 is bad guys attack in the form of "A,5" etc
$mark=$in1
gosub showbad ; update bad guy mini screen
;color y+/n at(16,37) "$$in2=$in2 "
$gxc=substr($in2,1,1) $gyc=substr($in2,3,1)
;color y+/n at(17,37) "$$gxc=$gxc $$gyc=$gyc "
$gx=asc($gxc)-65 $gy=asc($gyc)-48
;color y+/n at(18,37) "$$gx=$gx $$gy=$gy "
$x=(2*$gx)+($gx+4) $y=(2*$gy)+3 $g=(10*$gy)+$gx
;color y+/n at(19,37) "$$x=$x $$y=$y $$g=$g "
gosub checkhit ; Check for hit on us and update
goto shoot ; next turn
;END
