_TITLE "Battleship 5_AI.bas by bplus" 'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
'OK this version with AI works though AI needs a fix
'2018-04-25 fixed the AI! yeah
'2018-04-25 PM Show ONLY ships sunk! Post 2018-04-25PM update
'2018-04-26PM add play again loop Post v 2018-04-26
' use Johnno's assets, Thanks Johnno
' water = _loadimag("filename")
' _PUTIMAGE (x, y), water
' Add Petr's idea from today about Player option for automatic setup,
' Thanks Petr for sharing ideas.
'add Johnno's sounds
'2018-05-02 AM for me Johnno adds explode stuff
'2018-05-02 9PM Battleship3 fix surprise screen shake
'2018-05-12&13 Battleship 4
' added checkClick for improved getClick routine
' option to turn off effects, center text in text box
' install new color system, and showShips on Players Board
' cut 20 lines from autoset, removed fill circle drawing routine
'2018-05-14 post version 05-14
' testing new shoot systems for getting first hits on ships
'2018-05-18 added new shoot subroutine that mods according to ships sunk
'2018-05-20 the 5_AI 5-20 version is working with new hit directions around first hit
'I am now going to add hitx(), hity(), ihit, rehit for going back into sunk ship area for more ships if currentHits <> 0
'it works, keeps hitting an area until currentHits = 0 or all previous hits have been surrounded with misses
'show boats not sunk!!!!
' try mod 3 coverage effectsON and AutosetON to avoid questions when play a ton of games
'reviewed sound handling and changed to using handles
'changed grid color to blue
' cut m = 7 stuff from shoot reduced from 128 lines to nice size now!
' 5-AI 5-21 backup
' 2018-05-23 post 5_AI with this date
' remove playing soundfiles by handle& and go back to _SNDPLAYFILE but use volume!!!
' add splash screen
'setup boards
'screen offsets for AI board and player board
'setup ships
CONST ns2
= 5 ' number of ships divide by 2 CONST ns2p1
= 6 ' number of ships divide by 2 plus 1 CONST df
= 1 ' delay time 'global arrays and variables
DIM SHARED a
(sqPerSide
, sqPerSide
), p
(sqPerSide
, sqPerSide
), water&
, waterHit&
, waterMiss&
, GameOn
, e
, pAuto
DIM SHARED shipName$
(nShips
), shipLen
(nShips
), shipHits$
(nShips
), shipHor
(nShips
), shipX
(nShips
), shipY
(nShips
), shipSunk
(nShips
) 'hits array will track red and white pegs of hits and misses
REDIM SHARED hits
(n1
, n1
) 'hit = 1 and miss = -1 and no shot taken = 0 DIM SHARED ihit
, rehit
'more hit tracking, this is for making sure all ships sunk in a hit area DIM SHARED x1
, y1
, bombx
, bomby
, dir
, currentHits
, hit2
'for deciding where to bomb next DIM SHARED carrier&
, battleship&
, cruiser&
, submarine&
, destroyer&
'to use in subs
'Johnno's Assets added to game
loadExplode
shipLen(1) = 5: shipName$(1) = " Carrier"
shipLen(2) = 4: shipName$(2) = "Battleship"
shipLen(3) = 3: shipName$(3) = " Cruiser"
shipLen(4) = 3: shipName$(4) = " Submarine"
shipLen(5) = 2: shipName$(5) = " Destroyer"
shipLen(6) = 5: shipName$(6) = " Carrier"
shipLen(7) = 4: shipName$(7) = "Battleship"
shipLen(8) = 3: shipName$(8) = " Cruiser"
shipLen(9) = 3: shipName$(9) = " Submarine"
shipLen(10) = 2: shipName$(10) = " Destroyer"
xxmax = 640: yymax = 75 'pixels too slow
xstep = 1: ystep = 1
fr = 240 * i / 100 + 15
pal&
(i
+ 100) = _RGB(255, fr
, 0) pal&
(i
+ 200) = _RGB(255, 255, fr
)DIM f
(xxmax
, yymax
+ 2) 'fire array and seed f
(x
, yymax
+ 1) = INT(RND * 2) * 300 f(x, yymax + 2) = 300
getClick mx, my, q
ticker = 0
FOR x
= 1 TO xxmax
- 1 'shift fire seed a bit f(x, yymax + 1) = f(x - 1, yymax + 1)
f(x, yymax + 1) = f(x + 1, yymax + 1)
f
(x
, yymax
+ 1) = INT(RND * 2) * 300 FOR y
= 0 TO yymax
'fire based literally on 4 pixels below it like cellular automata f(x, y) = max((f(x - 1, y + 1) + f(x, y + 1) + f(x + 1, y + 1) + f(x - 1, y + 2)) / 4 - 5, 0)
LINE (80 + x
* xstep
, 230 + y
* ystep
)-STEP(xstep
, ystep
), pal&
(f
(x
, y
)), BF
ticker = ticker + .025
rgb 0
LINE (0, 0)-(xmax
, ymax
), , BF
' Display banner and get the Players setting questions asked once and for all games until restart program
TxtBx 509, "m", "Special Effects? press [y] yes or [n] no"
ClearTextBox
restart: '===================================================== restart new game
'reset all critical variables and arrays
ERASE a
, p
, shipHor
, shipX
, shipY
, shipSunk
shipHits$
(i
) = SPACE$(shipLen
(i
))'AI tracking
pTurn = 0: dir = 0: currentHits = 0: colA = -1
'start screen drawing
' Display Grid frame
rgb 9
drawGrid ax, ay, sq, sqPerSide
drawGrid px, py, sq, sqPerSide
'setup a board with ships, Computer or AI's setup
autoset 1
'setup player's ships
ClearTextBox
autoset 0
showShip s, shipX(s), shipY(s), shipHor(s)
ELSE 'player sets up his ships OK = 0
ClearTextBox
ClearUpdateBox
rgb 990
' Position text in UpdateTextBox beneath the ship.
TxtBx 85, "t", "Position it Horizontally: Press [ H ]"
TxtBx 942, "b", " Position it Vertically: Press [ V ]"
nogo = 1
IF hor$
= "v" OR hor$
= "h" THEN nogo
= 0 ClearTextBox
TxtBx 942, "t", "Vertial it is."
TxtBx 970, "b", "Now click the top most position of the ship."
shipHor(s) = 0
TxtBx 85, "t", "Horizontal it is:"
TxtBx 970, "b", "Now click the left most position of the ship."
shipHor(s) = -1
checkClick px, py, sq, sqPerSide, sx, sy, escape
IF sx
<= sqPerSide
- shipLen
(s
) THEN OK = 1
FOR xx
= 0 TO shipLen
(s
) - 1 shipX(s) = sx: shipY(s) = sy
FOR xx
= 0 TO shipLen
(s
) - 1 p(sx + xx, sy) = -1 * s
IF sy
<= sqPerSide
- shipLen
(s
) THEN OK = 1
FOR yy
= 0 TO shipLen
(s
) - 1 shipX(s) = sx: shipY(s) = sy
FOR yy
= 0 TO shipLen
(s
) - 1 p(sx, sy + yy) = -1 * s
'update player board
showShip s, shipX(s), shipY(s), shipHor(s)
'start the shooting match
GameOn = 1
updateStatus
pTurn = 1 - pTurn
TxtBx 63, "m", "Player. Your turn. Click on the computer's board."
checkClick ax, ay, sq, sqPerSide, bx, by, escape
playPutExplode ax + bx * sq, ay + by * sq, 0
'_DELAY df
_PUTIMAGE (ax
+ bx
* sq
, ay
+ by
* sq
), waterHit&
hitEval "a", bx, by 'game could end here
_PUTIMAGE (ax
+ bx
* sq
, ay
+ by
* sq
), waterMiss&
'AI's turn if it gets a hit it will bomb around the ship until it is finished
'could be trouble if 2 ships are next to each other, damn until just now I hadn't anticipated this
'hits board tracks red and white pegs like a human player for AI
' Try to display random computer messages before it fires! - Humour...
' Possibly use select.. case.. end select?
ClearTextBox
choice = rand(1, 10)
CASE 1: m$
= "Hold onto something! My turn!" CASE 2: m$
= "Are you sure you want to do this?" CASE 3: m$
= "Close your eyes and start praying!" CASE 4: m$
= "Are you ready for what's coming?" CASE 5: m$
= "My turn! Buckle up Princess!" CASE 6: m$
= "Prepare for a world of hurt!" CASE 7: m$
= "Airmail... Special delivery!" CASE 8: m$
= "You have nowhere to hide!" CASE 9: m$
= "I have a surprise for you!" CASE 10: m$
= "Let's play catch! My turn!" TxtBx 970, "m", m$
IF dir
THEN 'we have a bomb location all set to test IF p
(bombx
, bomby
) < 0 THEN 'hit! playPutExplode px + bombx * sq, py + bomby * sq, 1
ClearTextBox
choice = rand(1, 10)
CASE 1: m$
= "No point crying about it!" CASE 2: m$
= "You'll get over it." CASE 3: m$
= "It's either you or me." CASE 4: m$
= "No pain. No gain." CASE 5: m$
= "Now that's gotta hurt!" CASE 6: m$
= "You can always go home!" CASE 7: m$
= "No shame in quitting." CASE 8: m$
= "It'll buff right out." CASE 9: m$
= "Side dish of scrap to go!" CASE 10: m$
= "May you rust in peace." TxtBx 930, "m", m$
hit2 = 1
hits(bombx, bomby) = 1
currentHits = currentHits + 1
ihit = ihit + 1 'take a history of hits since dir has been activated
hitx(ihit) = bombx
hity(ihit) = bomby
_PUTIMAGE (px
+ bombx
* sq
, py
+ bomby
* sq
), waterHit&
'we need to know stuff but can't use this info for AI finding the ship
'when hitEval announces a ship sunk we can reduce the currentHits count by that ships amount
'if still have more current hits, continue bombing area as another ship is there
hitEval "p", bombx, bomby 'this will reduce currentHits by the amount a ship could take when sunk
IF currentHits
= 0 THEN 'clear our checklist we sank all ships we hit, call off bombing of area x1 = 0: y1 = 0: dir = 0
decideWhereToBombNext
ELSE 'no hit from checklist scratch off one item hit2 = 0
hits(bombx, bomby) = -1
_PUTIMAGE (px
+ bombx
* sq
, py
+ bomby
* sq
), waterMiss&
ClearTextBox
TxtBx 509, "m", "MISSED!!"
decideWhereToBombNext
END IF ' are we still working on hit
'not working on any hits x1, y1 = 0, dir = 0, currentHits might be = 0
'random but systematic shooting, bring up next good shooting location
shoot tryx, tryy
'consider that shot just fired was it a hit or miss
IF p
(tryx
, tryy
) < 0 THEN ' test our shot just fired is hit! ClearTextBox
x1 = tryx: y1 = tryy 'save first hit to come back to
hits(x1, y1) = 1
currentHits = currentHits + 1
playPutExplode px + x1 * sq, py + y1 * sq, 1
_PUTIMAGE (px
+ x1
* sq
, py
+ y1
* sq
), waterHit&
'we need to know stuff but can't use this info for AI finding the ship
'it's the same as for the player
hitEval "p", x1, y1
'did we just happen to finish off a ship? current hits = 0
IF currentHits
= 0 THEN 'must of finished off an ship x1 = 0: x2 = 0: dir = 0 'we are done
dir = -1
decideWhereToBombNext
_PUTIMAGE (px
+ tryx
* sq
, py
+ tryy
* sq
), waterMiss&
ClearTextBox
TxtBx 509, "m", "MISSED!!"
hits(tryx, tryy) = -1
END IF 'rI (now tryx, tryy) was hit or not
ClearTextBox
ClearUpdateBox
rgb 990
rgb 63
SUB decideWhereToBombNext
'find next good location, mark the direction we took
IF dir
= -1 THEN ' we just got a fresh hit the rest of the ship is in 1 of 4 directions 'fresh slate
redirect:
hit2 = 0 'when direction = 0 reset 2nd hit signal to 0
bombx
= x1
+ 1: bomby
= y1: dir
= 1:
EXIT SUB 'always the first direction to try 'still here?
bombx
= x1
- 1: bomby
= y1: dir
= 3:
EXIT SUB 'still here?
bombx
= x1: bomby
= y1
+ 1: dir
= 2:
EXIT SUB 'still here OK this has to do it!
bombx
= x1: bomby
= y1
- 1: dir
= 4:
EXIT SUB 'still here ???? damn! give up and go back to random shots
rehit = rehit + 1
dir
= 0:
EXIT SUB 'back to random bombing x1 = hitx(rehit): y1 = hity(rehit)
dir
= 0:
EXIT SUB ' < this signals that
'setup next bombx, bomby
IF hit2
THEN 'whatever direction we are taking, continue if we can IF hits
(bombx
+ 1, bomby
) = 0 THEN IF hits
(bombx
, bomby
+ 1) = 0 THEN IF hits
(bombx
- 1, bomby
) = 0 THEN IF hits
(bombx
, bomby
- 1) = 0 THEN bomby
= bomby
- 1: dir
= 4:
EXIT SUB
'still here? then we have to change direction and go back to x1, y1 the first hit
hit2 = 0 'reset this for the new direction check
'dir = dir + 1 want to try 180 direction before changing 90
dir = 3
dir = 4
dir = 2
rehit = rehit + 1
dir
= 0:
EXIT SUB 'back to random bombing x1 = hitx(rehit): y1 = hity(rehit)
bombx
= x1: bomby
= y1
+ 1:
EXIT SUB bombx
= x1
- 1: bomby
= y1:
EXIT SUB bombx
= x1: bomby
= y1
- 1:
EXIT SUB 'still here, well we've run out of directions
rehit = rehit + 1
dir
= 0:
EXIT SUB 'back to random bombing x1 = hitx(rehit): y1 = hity(rehit)
'dir = 0 'back to random bombing
SUB hitEval
(board$
, bbx
, bby
) 'this is like a referee / judge for both players to announce a ship sunk and a game won?
s = -1 * a(bbx, bby)
you$ = "Player"
my$ = "Computer's"
istart = 1
istop = ns2
s = -1 * p(bbx, bby)
you$ = "Computer"
my$ = "Player's"
istart = ns2p1
istop = nShips
IF shipHor
(s
) THEN d
= bbx
- shipX
(s
) + 1 ELSE d
= bby
- shipY
(s
) + 1 MID$(shipHits$
(s
), d
) = "X" IF board$
= "p" THEN currentHits
= currentHits
- shipLen
(s
) updateStatus
TxtBx
995, "m", you$
+ " sank the " + my$
+ " " + LTRIM$(shipName$
(s
)) + "!" shipSunk(s) = 1
tot = 0
IF shipSunk
(i
) = 1 THEN tot
= tot
+ 1 updateStatus
TxtBx 995, "m", "Congratulations " + you$ + "!! You sank the " + my$ + " fleet! GameOver..."
FOR y
= 0 TO sqPerSide
- 1 FOR x
= 0 TO sqPerSide
- 1 rgb 900
FOR i
= 1 TO 5 'show ships locations for Player that lost LINE (ax
+ x
* sq
+ i
, ay
+ y
* sq
+ i
)-STEP(sq
- 2 * i
, sq
- 2 * i
), , B
GameOn = 0
SUB autoset
(AItf
) ' there is surely a shorter way to do this but I am eager to get on with other stuff 'setup a board with ships, AItf if true setup for Computer else for Player
OK = 0
shipHor(s) = rand(0, 1)
sy = rand(0, n1)
sx = rand(0, sqPerSide - shipLen(s))
OK = 1
FOR xx
= 0 TO shipLen
(s
) - 1 shipX(s) = sx: shipY(s) = sy
FOR xx
= 0 TO shipLen
(s
) - 1 a(sx + xx, sy) = -1 * s
p(sx + xx, sy) = -1 * s
sx = rand(0, n1)
sy = rand(0, sqPerSide - shipLen(s))
OK = 1
FOR yy
= 0 TO shipLen
(s
) - 1 shipX(s) = sx: shipY(s) = sy
FOR yy
= 0 TO shipLen
(s
) - 1 a(sx, sy + yy) = -1 * s
p(sx, sy + yy) = -1 * s
SUB showShip
(shipn
, bxhead
, byhead
, hTF
) 'setup to combine use with RotoZoom code Wiki
SELECT CASE shipn
'player's ships only, get ship len and CASE 6: shipLen
= 5: sh&
= carrier&
CASE 7: shipLen
= 4: sh&
= battleship&
CASE 8: shipLen
= 3: sh&
= cruiser&
CASE 9: shipLen
= 3: sh&
= submarine&
CASE 10: shipLen
= 2: sh&
= destroyer&
dx1 = px + sq * bxhead + 1
dy1 = py + sq * byhead + 1
dx2 = px + sq * (bxhead + shipLen) - 1
dy2 = py + sq * (byhead + 1) - 1
px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
sinr!
= SIN(-90 / 57.2957795131): cosr!
= COS(-90 / 57.2957795131)
xsqlen = 30: ysqlen = 32 * shipLen - 2
xscale = xsqlen / H&: yscale = ysqlen / W&
xpivot = px + sq * bxhead + .5 * sq: ypivot = py + sq * byhead + .5 * sq * shipLen
x2& = (px(i&) * cosr! + sinr! * py(i&)) * xscale + xpivot: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yscale + ypivot
px(i&) = x2&: py(i&) = y2&
_MAPTRIANGLE (0, 0)-(0, H&
- 1)-(W&
- 1, H&
- 1), sh&
TO(px
(0), py
(0))-(px
(1), py
(1))-(px
(2), py
(2)) _MAPTRIANGLE (0, 0)-(W&
- 1, 0)-(W&
- 1, H&
- 1), sh&
TO(px
(0), py
(0))-(px
(3), py
(3))-(px
(2), py
(2))
'want the board square bx, by from board with grid xoff, yoff, sq pixels, n x n square board
SUB checkClick
(xoff
, yoff
, sq
, n
, bx
, by
, escape
) getClick mx, my, q ' get players move
row = (my - yoff) / sq
col = (mx - xoff) / sq
ELSE 'this is beeping right after setup (not after a click) ELSE 'this is beeping right after setup (not after a click)
mx = -1: my = -1: q = 0
SUB drawGrid
(x
, y
, sq
, n
) d = sq * n
LINE (x
+ sq
* i
, y
)-(x
+ sq
* i
, y
+ d
) LINE (x
, y
+ sq
* i
)-(x
+ d
, y
+ sq
* i
)
rand%
= INT(RND * (hi%
- lo%
+ 1)) + lo%
SUB TxtBx
(n
, L$
, Message$
) rgb n
x
= (769 - LEN(Message$
) * 8) / 2 + 18
rgb 0
LINE (18, 141)-(769, 194), , BF
rgb 0
LINE (380, 11)-(769, 129), , BF
f$ = "exp_" + x$ + ".bmp"
' _PUTIMAGE (i * 32, i * 32), explode&(i) '< test load of file
SUB playPutExplode
(x
, y
, shake
)
SUB rgb
(n
) ' New (even less typing!) New Color System 1000 colors with up to 3 digits
GetYN$ = k$
SUB shoot
(col
, row
) 'col, row aren't inputs so mush as outputs like a double function return wo input parameters i = nShips
WHILE shipSunk
(i
) 'find smallest ship not sunk i = i - 1
SELECT CASE i
'm for modulus, d for direction to run a check from CASE nShips: m
= 3 'still have destroyer, for more exciting game testng m = 3 CASE nShips
- 1: m
= 3 'still have sub CASE nShips
- 2: m
= 3 'still have cruiser CASE nShips
- 3: m
= 4 'still have battleship CASE nShips
- 4: m
= 5 'still have carrier bc = 0
IF colA
= -1 THEN 'col the Attact starts from notice it is random so player can't anticipate colA = rand%(0, n1): col = colA: row = rand(0, n1): bump = rand(0, m - 1)
cc = 1
rc = 0
WHILE rc
<= sqPerSide
'find a space to hit if one left in this column IF cover
(m
, bump
, col
, row
) THEN 'are we on a place to cover board row
= (row
+ 1) MOD sqPerSide
rc = rc + 1
row = row - 1
'still here means we checked all rows in col so check next col
col
= (col
+ 1) MOD sqPerSide
cc = cc + 1
'still here ? then up the bump
bc = bc + 1
'using a modulus m coverage with a bump so that opponent can't predict where
'the hardest place to plant the Detroyer
bm
= bump
MOD m
'make sure bump is in modulus
