Page 1 of 1 1
Topic Options
#50353 - 2000-06-27 02:22 PM 2nd KiX game ever!!
cj Offline
MM club member
*****

Registered: 2000-04-06
Posts: 1102
Loc: Brisbane, Australia

Hi again,

Here is Battle Ships, well my variation on it. Very simple array based game for two players. The next message is an AS (Artificial Stupidity) computer opponent.

Works by passing small text files between games via a shared path - ie both games use \\server\share or x:\path etc

If the into animation is too fast, put some SLEEP 1 into the INTRO subroutine, I wrote this on a P100 with Win95...

cj

code:

; 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


[This message has been edited by cj (edited 27 June 2000).]

Top
#50354 - 2000-06-27 02:30 PM Re: 2nd KiX game ever!!
cj Offline
MM club member
*****

Registered: 2000-04-06
Posts: 1102
Loc: Brisbane, Australia

Here is the computer opponent: It takes shots at you at random and you get a 1 in 100 chance of winning.

Oh, Some things about the main game I forgot to mention:

Pressing Q at any prompt quits and resets the computer player if you are using it.
Pressing R at the place ships menu will place all your ships for you at random.
Pressing R at attack time will choose an attack for you at random.

cj

code:

;BattleShip computer player
; also for Megan and Jochen


break on
:start
cls


$seed=val(substr("@time",7,2)) $seed=$seed+1
do $=rnd(1) $seed=$seed-1 until $seed=0


$path="c:\scripts"
$gx=0 $gy=0 $l=0 $in2=" " $last="o" $lose=0
$cc=rnd(100)


goto Main


:gameON
del "$path\$name.txt" ; clean up from previous games
$r=open(1,"$path\game.txt")
if $r=2 ; start new game
at(1,0) "Waiting for player..."
$create=1
$=open(1,"$path\game.txt",5)
$=writeline(1,"computer$cc")
$=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,"computer$cc")
$=close(1)
endif
return


:generate
$gx=rnd(9)$gy=rnd(9)
$l=99 $l=rnd(100)+1
if $l=55 $last="lose" else $l=rnd(1)+1 if $l=1 $last="o" else $last="X" endif endif
return


:updatescreen
at(3,0) "$$gx=$gx $$gy=$gy "
at(4,0) "$$l=$l "
at(5,0) "Player attack"
at(6,0) "$in2 "
return


:sendattack
$=open(1,"$path\computer$cc.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=open(1,"$path\$badguy.txt")
if $r=2 sleep 1 goto getattack endif


$in1=readline(1)
if $in1="lose" $lose=1 endif
$in2=readline(1)


$=close(1)
del "$path\$badguy.txt"
if $lose=1 goto start endif
return


:MAIN


gosub gameON ; Create/join game
if $create=1 at(1,0) "computer$cc Vs $badguy " else "$badguy Vs computer$cc " endif


:again
gosub generate ; generate attack info
gosub updatescreen


if $create=0 goto waitnow endif
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
gosub updatescreen
goto again


;END




Top
#50355 - 2000-06-28 05:52 PM Re: 2nd KiX game ever!!
Shawn Administrator Offline
Administrator
*****

Registered: 1999-08-13
Posts: 8611
cj:

You're an amazing KiX scripter (KiXster) !

Can you explain more fully how to set this up for single player vs computer play.

I especially like the opening sequence !

I betcha Megan is pleased. You might even get "lucky" tonight !

Shawn.

Never mind - got it to work !

You might want to remind folks to change the value of $path in both scripts to point to their own installed (shared) paths ! Doh !!

Cool !

Shawn..

[This message has been edited by Shawn (edited 28 June 2000).]

Top
#50356 - 2000-07-01 12:40 AM Re: 2nd KiX game ever!!
cj Offline
MM club member
*****

Registered: 2000-04-06
Posts: 1102
Loc: Brisbane, Australia

Hey,

About $path I did remember that... later...

I was going to make the computer player smarter but I am not THAT bored

cj

Top
#50357 - 2000-07-05 12:08 AM Re: 2nd KiX game ever!!
Anonymous
Unregistered


wow !
Top
#50358 - 2000-07-07 02:45 PM Re: 2nd KiX game ever!!
Jochen Administrator Offline
KiX Supporter
*****

Registered: 2000-03-17
Posts: 6380
Loc: Stuttgart, Germany
WAAAAAAAAAAAAHHHHHHHHHH,

he did it !

_________________________



Top
#50359 - 2000-07-07 02:52 PM Re: 2nd KiX game ever!!
Jochen Administrator Offline
KiX Supporter
*****

Registered: 2000-03-17
Posts: 6380
Loc: Stuttgart, Germany
WAAAAAAAAAAAAHHHHHHHHHH,

he did it !


cj, what is your Occasion??!? Engineer ?!!?
For who do You work ?!?! Can i get a job there ?

I mean , wow , there are 2 possibilities:

1st : You are a kix - GURU & and bored
2nd : You are doing nothing @work & ....

there are 3 possibilities:

1st : You are a kix - GURU & and bored
2nd : You are doing nothing @work & have to much spare time
3rd : You possess a Spirit of .....

there are 4 possibilities:

1st ....etc . etc .

Or to say it with Terry Gilliam :

YOU NEVER EXPPECT THE SPANISH INQUISITION.


Great work man !
I'll play it as soon i got some spare time


Jochen

_________________________



Top
#50360 - 2000-07-07 08:56 PM Re: 2nd KiX game ever!!
cj Offline
MM club member
*****

Registered: 2000-04-06
Posts: 1102
Loc: Brisbane, Australia

Option 4: I am currently out of work and have too much spare time...

cj

Top
Page 1 of 1 1


Moderator:  Glenn Barnas, NTDOC, Arend_, Jochen, Radimus, Allen, ShaneEP, Ruud van Velsen, Mart 
Hop to:
Shout Box

Who's Online
1 registered (Allen) and 1198 anonymous users online.
Newest Members
M_Moore, BeeEm, min_seow, Audio, Hoschi
17883 Registered Users

Generated in 0.058 seconds in which 0.025 seconds were spent on a total of 12 queries. Zlib compression enabled.

Search the board with:
superb Board Search
or try with google:
Google
Web kixtart.org