Samples Gallery & Reference > Games
Battleship with AI by bplus
(1/1)
Qwerkey:
Battleship with AI
Author: @bplus with @johnno56 and @Petr
Source: qb64.org Forum
URL: https://www.qb64.org/forum/index.php?topic=218.0, « Reply #14 on: May 28, 2018, 08:14:32 AM »
Version: 5_AI
Tags: [2D], [Graphics]
Description:
Cool QB64 version of the classic game. Just like human players, my AI tracks whether it has shot at a cell or not.
Source Code:
--- Code: QB64: ---_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 DIM SHARED main&CONST xmax = 800CONST ymax = 600main& = _NEWIMAGE(xmax, ymax, 32)SCREEN main&_SCREENMOVE 360, 60RANDOMIZE TIMER 'setup boardsCONST sq = 32CONST sqPerSide = 10CONST n1 = sqPerSide - 1'screen offsets for AI board and player boardCONST ax = 50CONST ay = 232CONST px = 420CONST py = 232'setup shipsCONST nShips = 10CONST ns2 = 5 ' number of ships divide by 2CONST ns2p1 = 6 ' number of ships divide by 2 plus 1CONST df = 1 ' delay time'global arrays and variablesDIM SHARED a(sqPerSide, sqPerSide), p(sqPerSide, sqPerSide), water&, waterHit&, waterMiss&, GameOn, e, pAutoDIM 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 missesREDIM SHARED hits(n1, n1) 'hit = 1 and miss = -1 and no shot taken = 0DIM SHARED colA, row, col, bumpDIM SHARED ihit, rehit 'more hit tracking, this is for making sure all ships sunk in a hit areaREDIM SHARED hitx(0), hity(0)DIM SHARED x1, y1, bombx, bomby, dir, currentHits, hit2 'for deciding where to bomb nextDIM SHARED carrier&, battleship&, cruiser&, submarine&, destroyer& 'to use in subsDIM SHARED explode&(16) 'Johnno's Assets added to gamebanner& = _LOADIMAGE("title.bmp")water& = _LOADIMAGE("water.bmp")waterHit& = _LOADIMAGE("water-hit.bmp")waterMiss& = _LOADIMAGE("water-miss.bmp")metal& = _LOADIMAGE("frame1.bmp")setupships& = _LOADIMAGE("setupships.bmp")notpeek& = _LOADIMAGE("notpeek.bmp")carrier& = _LOADIMAGE("carrier.bmp")battleship& = _LOADIMAGE("battleship.bmp")cruiser& = _LOADIMAGE("cruiser.bmp")submarine& = _LOADIMAGE("submarine.bmp")destroyer& = _LOADIMAGE("destroyer.bmp")again& = _LOADIMAGE("again.bmp")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" shipblack& = _LOADIMAGE("ship-black.png")shipfire& = _LOADIMAGE("ship-wfire.png")xxmax = 640: yymax = 75 'pixels too slowxstep = 1: ystep = 1DIM pal&(300) 'palletteFOR i = 1 TO 100 fr = 240 * i / 100 + 15 pal&(i) = _RGB(fr, 0, 0) pal&(i + 100) = _RGB(255, fr, 0) pal&(i + 200) = _RGB(255, 255, fr)NEXTDIM f(xxmax, yymax + 2) 'fire array and seedFOR x = 0 TO xxmax f(x, yymax + 1) = INT(RND * 2) * 300 f(x, yymax + 2) = 300NEXT _PUTIMAGE , shipblack&getClick mx, my, qIF q = 27 THEN ENDticker = 0WHILE ticker < 3 CLS IF ticker < 2.95 THEN _PUTIMAGE , shipblack& ELSE _PUTIMAGE , shipfire& FOR x = 1 TO xxmax - 1 'shift fire seed a bit r = RND IF r < .15 THEN f(x, yymax + 1) = f(x - 1, yymax + 1) ELSEIF r < .3 THEN f(x, yymax + 1) = f(x + 1, yymax + 1) ELSEIF r < .35 THEN f(x, yymax + 1) = INT(RND * 2) * 300 END IF NEXT FOR y = 0 TO yymax 'fire based literally on 4 pixels below it like cellular automata FOR x = 1 TO xxmax - 1 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 NEXT NEXT ticker = ticker + .025 _DISPLAY _LIMIT 50WEND_DELAY 1.5_AUTODISPLAYrgb 0LINE (0, 0)-(xmax, ymax), , BF ' Display banner and get the Players setting questions asked once and for all games until restart program_PUTIMAGE (220, 10), banner&TxtBx 509, "m", "Special Effects? press [y] yes or [n] no"IF GetYN$ = "y" THEN e = -1 ELSE e = 0ClearTextBox_PUTIMAGE (150, 155), setupships&IF GetYN$ = "y" THEN pAuto = -1 ELSE pAuto = 0 restart: '===================================================== restart new game 'reset all critical variables and arraysERASE a, p, shipHor, shipX, shipY, shipSunkREDIM hits(n1, n1)FOR i = 1 TO nShips shipHits$(i) = SPACE$(shipLen(i))NEXT'AI trackingpTurn = 0: dir = 0: currentHits = 0: colA = -1CLS'start screen drawing ' Display Grid frame_PUTIMAGE (18, 200), metal&rgb 9drawGrid ax, ay, sq, sqPerSidedrawGrid px, py, sq, sqPerSideFOR bannerx = 220 TO 15 STEP -1 _PUTIMAGE (bannerx, 10), banner& _DELAY 0.01NEXT 'setup a board with ships, Computer or AI's setupautoset 1 'setup player's shipsIF pAuto THEN ClearTextBox _PUTIMAGE (277, 155), notpeek& autoset 0 FOR s = ns2p1 TO nShips showShip s, shipX(s), shipY(s), shipHor(s) NEXT ELSE 'player sets up his ships FOR s = ns2p1 TO nShips OK = 0 WHILE OK = 0 ClearTextBox ClearUpdateBox IF s = 1 OR s = 6 THEN _PUTIMAGE (480, 30), carrier& IF s = 2 OR s = 7 THEN _PUTIMAGE (474, 45), battleship& IF s = 3 OR s = 8 THEN _PUTIMAGE (496, 50), cruiser& IF s = 4 OR s = 9 THEN _PUTIMAGE (496, 45), submarine& IF s = 5 OR s = 10 THEN _PUTIMAGE (512, 50), destroyer& rgb 990 ' Position text in UpdateTextBox beneath the ship. _PRINTSTRING (430, 100), "Setting up the " + LTRIM$(shipName$(s)) + ": Length of" + STR$(shipLen(s)) + "." TxtBx 85, "t", "Position it Horizontally: Press [ H ]" TxtBx 942, "b", " Position it Vertically: Press [ V ]" nogo = 1 WHILE nogo hor$ = INKEY$ IF hor$ = "v" OR hor$ = "h" THEN nogo = 0 _LIMIT 200 WEND ClearTextBox IF hor$ = "v" THEN TxtBx 942, "t", "Vertial it is." TxtBx 970, "b", "Now click the top most position of the ship." shipHor(s) = 0 ELSE TxtBx 85, "t", "Horizontal it is:" TxtBx 970, "b", "Now click the left most position of the ship." shipHor(s) = -1 END IF checkClick px, py, sq, sqPerSide, sx, sy, escape IF escape THEN CLS: END IF shipHor(s) THEN IF sx <= sqPerSide - shipLen(s) THEN OK = 1 FOR xx = 0 TO shipLen(s) - 1 IF p(sx + xx, sy) < 0 THEN OK = 0: EXIT FOR NEXT IF OK THEN shipX(s) = sx: shipY(s) = sy FOR xx = 0 TO shipLen(s) - 1 p(sx + xx, sy) = -1 * s NEXT END IF END IF ELSE IF sy <= sqPerSide - shipLen(s) THEN OK = 1 FOR yy = 0 TO shipLen(s) - 1 IF p(sx, sy + yy) < 0 THEN OK = 0: EXIT FOR NEXT IF OK THEN shipX(s) = sx: shipY(s) = sy FOR yy = 0 TO shipLen(s) - 1 p(sx, sy + yy) = -1 * s NEXT END IF END IF END IF WEND 'update player board showShip s, shipX(s), shipY(s), shipHor(s) _LIMIT 30 NEXTEND IF 'start the shooting matchGameOn = 1WHILE GameOn updateStatus pTurn = 1 - pTurn IF pTurn THEN TxtBx 63, "m", "Player. Your turn. Click on the computer's board." checkClick ax, ay, sq, sqPerSide, bx, by, escape IF escape THEN CLS: END IF e THEN _SNDPLAYFILE ("launch-hi.wav"), , 1 _DELAY 3 END IF IF a(bx, by) < 0 THEN IF e THEN playPutExplode ax + bx * sq, ay + by * sq, 0 '_DELAY df END IF _PUTIMAGE (ax + bx * sq, ay + by * sq), waterHit& hitEval "a", bx, by 'game could end here ELSE _PUTIMAGE (ax + bx * sq, ay + by * sq), waterMiss& IF e THEN _SNDPLAYFILE ("splash-hi.wav"), , .3 _DELAY 1 END IF END IF ELSE '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) SELECT CASE choice 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!" END SELECT TxtBx 970, "m", m$ IF dir THEN 'we have a bomb location all set to test IF p(bombx, bomby) < 0 THEN 'hit! IF e THEN _SNDPLAYFILE ("launch-hi.wav"), , .3 _DELAY 3 playPutExplode px + bombx * sq, py + bomby * sq, 1 ClearTextBox choice = rand(1, 10) SELECT CASE choice 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." END SELECT TxtBx 930, "m", m$ END IF hit2 = 1 hits(bombx, bomby) = 1 currentHits = currentHits + 1 ihit = ihit + 1 'take a history of hits since dir has been activated REDIM _PRESERVE hitx(ihit) REDIM _PRESERVE hity(ihit) 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 ELSE decideWhereToBombNext END IF ELSE 'no hit from checklist scratch off one item IF e THEN _SNDPLAYFILE ("launch-hi.wav"), , .3 _DELAY 3 END IF hit2 = 0 hits(bombx, bomby) = -1 _PUTIMAGE (px + bombx * sq, py + bomby * sq), waterMiss& ClearTextBox TxtBx 509, "m", "MISSED!!" IF e THEN _SNDPLAYFILE ("splash-hi.wav"), , 1 _DELAY 1 END IF decideWhereToBombNext END IF ' are we still working on hit ELSE '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! IF e THEN _SNDPLAYFILE ("launch-hi.wav"), , .3 _DELAY 3 END IF ClearTextBox x1 = tryx: y1 = tryy 'save first hit to come back to hits(x1, y1) = 1 currentHits = currentHits + 1 IF e THEN playPutExplode px + x1 * sq, py + y1 * sq, 1 END IF _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 ELSE dir = -1 decideWhereToBombNext END IF ELSE 'no hit IF e THEN _SNDPLAYFILE ("launch-hi.wav"), , .3 _DELAY 3 END IF _PUTIMAGE (px + tryx * sq, py + tryy * sq), waterMiss& ClearTextBox TxtBx 509, "m", "MISSED!!" IF e THEN _SNDPLAYFILE ("splash-hi.wav"), , 1 _DELAY 1 END IF hits(tryx, tryy) = -1 END IF END IF 'rI (now tryx, tryy) was hit or not END IF 'whose turn is it _LIMIT 5WENDCLS_PUTIMAGE (125, 265), again&IF GetYN$ = "n" THEN CLS: ENDGOTO restart SUB updateStatus ClearTextBox ClearUpdateBox rgb 990 LOCATE 2, 70: PRINT "Computer" rgb 63 LOCATE 2, 83: PRINT "Player" FOR i = 1 TO 5 rgb 85: LOCATE i + 2, 55: PRINT shipName$(i) IF shipSunk(i) THEN LOCATE i + 2, 72: rgb 940: PRINT "SUNK": rgb 999 IF shipSunk(i + ns2) THEN LOCATE i + 2, 84: rgb 940: PRINT "SUNK": rgb 999 NEXTEND SUB 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 REDIM hitx(0): REDIM hity(0): ihit = 0: rehit = 0 redirect: hit2 = 0 'when direction = 0 reset 2nd hit signal to 0 IF x1 + 1 <= n1 THEN IF hits(x1 + 1, y1) = 0 THEN bombx = x1 + 1: bomby = y1: dir = 1: EXIT SUB 'always the first direction to try END IF END IF 'still here? IF x1 - 1 >= 0 THEN IF hits(x1 - 1, y1) = 0 THEN bombx = x1 - 1: bomby = y1: dir = 3: EXIT SUB END IF END IF 'still here? IF y1 + 1 <= n1 THEN IF hits(x1, y1 + 1) = 0 THEN bombx = x1: bomby = y1 + 1: dir = 2: EXIT SUB END IF END IF 'still here OK this has to do it! IF y1 - 1 >= 0 THEN IF hits(x1, y1 - 1) = 0 THEN bombx = x1: bomby = y1 - 1: dir = 4: EXIT SUB END IF END IF 'still here ???? damn! give up and go back to random shots rehit = rehit + 1 IF rehit > ihit THEN dir = 0: EXIT SUB 'back to random bombing ELSE x1 = hitx(rehit): y1 = hity(rehit) GOTO redirect END IF dir = 0: EXIT SUB ' < this signals that END IF 'setup next bombx, bomby IF hit2 THEN 'whatever direction we are taking, continue if we can SELECT CASE dir CASE 1 IF bombx + 1 <= n1 THEN IF hits(bombx + 1, bomby) = 0 THEN bombx = bombx + 1: EXIT SUB END IF END IF CASE 2 IF bomby + 1 <= n1 THEN IF hits(bombx, bomby + 1) = 0 THEN bomby = bomby + 1: EXIT SUB END IF END IF CASE 3 IF bombx - 1 >= 0 THEN IF hits(bombx - 1, bomby) = 0 THEN bombx = bombx - 1: EXIT SUB END IF END IF CASE 4 IF bomby - 1 >= 0 THEN IF hits(bombx, bomby - 1) = 0 THEN bomby = bomby - 1: dir = 4: EXIT SUB END IF END IF END SELECT END IF '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 WHILE dir < 4 AND dir > 0 'dir = dir + 1 want to try 180 direction before changing 90 IF dir = 1 THEN dir = 3 ELSEIF dir = 2 THEN dir = 4 ELSEIF dir = 3 THEN dir = 2 ELSEIF dir = 4 THEN rehit = rehit + 1 IF rehit > ihit THEN dir = 0: EXIT SUB 'back to random bombing ELSE x1 = hitx(rehit): y1 = hity(rehit) GOTO redirect END IF END IF SELECT CASE dir CASE 2 IF y1 + 1 <= n1 THEN IF hits(x1, y1 + 1) = 0 THEN bombx = x1: bomby = y1 + 1: EXIT SUB END IF END IF CASE 3 IF x1 - 1 >= 0 THEN IF hits(x1 - 1, y1) = 0 THEN bombx = x1 - 1: bomby = y1: EXIT SUB END IF END IF CASE 4 IF y1 - 1 >= 0 THEN IF hits(x1, y1 - 1) = 0 THEN bombx = x1: bomby = y1 - 1: EXIT SUB END IF END IF END SELECT WEND 'still here, well we've run out of directions rehit = rehit + 1 IF rehit > ihit THEN dir = 0: EXIT SUB 'back to random bombing ELSE x1 = hitx(rehit): y1 = hity(rehit) GOTO redirect END IF 'dir = 0 'back to random bombingEND SUB SUB hitEval (board$, bbx, bby) 'this is like a referee / judge for both players to announce a ship sunk and a game won? IF board$ <> "p" THEN s = -1 * a(bbx, bby) you$ = "Player" my$ = "Computer's" istart = 1 istop = ns2 ELSE s = -1 * p(bbx, bby) you$ = "Computer" my$ = "Player's" istart = ns2p1 istop = nShips END IF IF shipHor(s) THEN d = bbx - shipX(s) + 1 ELSE d = bby - shipY(s) + 1 MID$(shipHits$(s), d) = "X" IF shipHits$(s) = STRING$(shipLen(s), "X") THEN IF board$ = "p" THEN currentHits = currentHits - shipLen(s) updateStatus TxtBx 995, "m", you$ + " sank the " + my$ + " " + LTRIM$(shipName$(s)) + "!" _DELAY 1 shipSunk(s) = 1 tot = 0 FOR i = istart TO istop IF shipSunk(i) = 1 THEN tot = tot + 1 NEXT IF tot = ns2 THEN updateStatus TxtBx 995, "m", "Congratulations " + you$ + "!! You sank the " + my$ + " fleet! GameOver..." IF you$ = "Computer" THEN FOR y = 0 TO sqPerSide - 1 FOR x = 0 TO sqPerSide - 1 IF a(x, y) < 0 THEN rgb 900 FOR i = 1 TO 5 'show ships locations for Player that lost IF i MOD 2 THEN rgb 900 ELSE rgb 999 LINE (ax + x * sq + i, ay + y * sq + i)-STEP(sq - 2 * i, sq - 2 * i), , B NEXT END IF NEXT NEXT _DELAY 5 END IF _DELAY 4 GameOn = 0 END IF END IFEND SUB 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 FOR i = 1 TO ns2 IF AItf THEN s = i ELSE s = i + 5 OK = 0 WHILE OK = 0 shipHor(s) = rand(0, 1) IF shipHor(s) THEN sy = rand(0, n1) sx = rand(0, sqPerSide - shipLen(s)) OK = 1 FOR xx = 0 TO shipLen(s) - 1 IF AItf THEN IF a(sx + xx, sy) < 0 THEN OK = 0: EXIT FOR ELSE IF p(sx + xx, sy) < 0 THEN OK = 0: EXIT FOR END IF NEXT IF OK THEN shipX(s) = sx: shipY(s) = sy FOR xx = 0 TO shipLen(s) - 1 IF AItf THEN a(sx + xx, sy) = -1 * s ELSE p(sx + xx, sy) = -1 * s END IF NEXT END IF ELSE sx = rand(0, n1) sy = rand(0, sqPerSide - shipLen(s)) OK = 1 FOR yy = 0 TO shipLen(s) - 1 IF AItf THEN IF a(sx, sy + yy) < 0 THEN OK = 0: EXIT FOR ELSE IF p(sx, sy + yy) < 0 THEN OK = 0: EXIT FOR END IF NEXT IF OK THEN shipX(s) = sx: shipY(s) = sy FOR yy = 0 TO shipLen(s) - 1 IF AItf THEN a(sx, sy + yy) = -1 * s ELSE p(sx, sy + yy) = -1 * s END IF NEXT END IF END IF WEND NEXTEND SUB 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& END SELECT IF hTF THEN 'horizontal True dx1 = px + sq * bxhead + 1 dy1 = py + sq * byhead + 1 dx2 = px + sq * (bxhead + shipLen) - 1 dy2 = py + sq * (byhead + 1) - 1 _PUTIMAGE (dx1, dy1)-(dx2, dy2), sh&, main& ELSE DIM px(3) AS SINGLE: DIM py(3) AS SINGLE W& = _WIDTH(sh&): H& = _HEIGHT(sh&) 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 FOR i& = 0 TO 3 x2& = (px(i&) * cosr! + sinr! * py(i&)) * xscale + xpivot: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yscale + ypivot px(i&) = x2&: py(i&) = y2& NEXT _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)) END IFEND SUB 'want the board square bx, by from board with grid xoff, yoff, sq pixels, n x n square boardSUB checkClick (xoff, yoff, sq, n, bx, by, escape) WHILE 1 getClick mx, my, q ' get players move IF q = 27 OR q = 113 OR q = 81 THEN escape = 1: EXIT SUB row = (my - yoff) / sq IF row > 0 AND row < n THEN by = INT(row) col = (mx - xoff) / sq IF col > 0 AND col < n THEN bx = INT(col) EXIT WHILE ELSE 'this is beeping right after setup (not after a click) IF mx <> -1 AND my <> -1 THEN BEEP END IF ELSE 'this is beeping right after setup (not after a click) IF mx <> -1 AND my <> -1 THEN BEEP END IF _LIMIT 1000 WENDEND SUB SUB getClick (mx, my, q) WHILE _MOUSEINPUT: WEND ' clear previous mouse activity mx = -1: my = -1: q = 0 DO WHILE mx = -1 AND my = -1 q = _KEYHIT IF q = 27 OR (q > 31 AND q < 126) THEN EXIT SUB i = _MOUSEINPUT: mb = _MOUSEBUTTON(1) IF mb THEN DO WHILE mb 'wait for release q = _KEYHIT IF q = 27 OR (q > 31 AND q < 126) THEN EXIT SUB i = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY _LIMIT 1000 LOOP EXIT SUB END IF _LIMIT 1000 LOOPEND SUB SUB drawGrid (x, y, sq, n) d = sq * n FOR i = 0 TO n LINE (x + sq * i, y)-(x + sq * i, y + d) LINE (x, y + sq * i)-(x + d, y + sq * i) NEXT FOR yy = 0 TO n - 1 FOR xx = 0 TO n - 1 _PUTIMAGE (x + sq * xx, y + sq * yy), water& NEXT NEXTEND SUB FUNCTION rand% (lo%, hi%) rand% = INT(RND * (hi% - lo% + 1)) + lo%END FUNCTION SUB TxtBx (n, L$, Message$) rgb n IF L$ = "t" THEN y = 150 IF L$ = "m" THEN y = 160 IF L$ = "b" THEN y = 170 x = (769 - LEN(Message$) * 8) / 2 + 18 _PRINTSTRING (x, y), Message$END SUB SUB ClearTextBox rgb 0 LINE (18, 141)-(769, 194), , BFEND SUB SUB ClearUpdateBox rgb 0 LINE (380, 11)-(769, 129), , BFEND SUB SUB loadExplode () FOR i = 1 TO 16 x$ = RIGHT$("0" + LTRIM$(STR$(i)), 2) f$ = "exp_" + x$ + ".bmp" explode&(i) = _LOADIMAGE(f$) ' _PUTIMAGE (i * 32, i * 32), explode&(i) '< test load of file NEXTEND SUB SUB playPutExplode (x, y, shake) IF shake THEN _SNDPLAYFILE ("explosion-hi.wav"), , 1 ELSE _SNDPLAYFILE ("explosion-hi.wav"), , .3 FOR i = 1 TO 16 _PUTIMAGE (x + 1, y + 1), explode&(i) _DELAY .05 IF shake THEN _SCREENMOVE 360 + rand(-10, 10), 60 + rand(-10, 10) _SCREENMOVE 360 + rand(-10, 10), 60 + rand(-10, 10) END IF NEXT IF shake THEN _SCREENMOVE 360, 60 _DELAY .1END SUB SUB rgb (n) ' New (even less typing!) New Color System 1000 colors with up to 3 digits s3$ = RIGHT$("000" + LTRIM$(STR$(n)), 3) r = VAL(MID$(s3$, 1, 1)): IF r THEN r = 28 * r + 3 g = VAL(MID$(s3$, 2, 1)): IF g THEN g = 28 * g + 3 b = VAL(MID$(s3$, 3, 1)): IF b THEN b = 28 * b + 3 COLOR _RGB32(r, g, b)END SUB FUNCTION GetYN$ () k$ = "": WHILE k$ <> "n" AND k$ <> "y": k$ = INKEY$: _LIMIT 200: WEND GetYN$ = k$END FUNCTION 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 WEND 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 END SELECT 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) END IF WHILE bc < m cc = 1 WHILE cc <= sqPerSide 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 IF hits(col, row) = 0 THEN EXIT SUB 'good to go! END IF row = (row + 1) MOD sqPerSide rc = rc + 1 WEND row = row - 1 IF row < 0 THEN row = n1 'still here means we checked all rows in col so check next col col = (col + 1) MOD sqPerSide cc = cc + 1 WEND 'still here ? then up the bump bump = (bump + 1) MOD m bc = bc + 1 WENDEND SUB 'using a modulus m coverage with a bump so that opponent can't predict where'the hardest place to plant the DetroyerFUNCTION cover (m, bump, c, r) bm = bump MOD m 'make sure bump is in modulus cm = (c + bm) MOD m rm = r MOD m IF rm = cm THEN cover = -1 ELSE cover = 0END FUNCTION FUNCTION max (a, b) IF a > b THEN max = a ELSE max = bEND FUNCTION
Battleship 5-AI 2018-05-24.zip
Bplus edit fixed download .zip
Navigation
[0] Message Index
Go to full version