Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Return to the Old Classic Battleship Game
#1
This is simple elegant version in Screen 0 ie no noisey, shiney bling!

Its all about getting an fairly intelligent AI to play against. I call this version of Battleship Mod842 because the structure of the AI's random shots uses waves of Mod 8 then Mod 4 then Mod 2 in it's bombing patterns so the Destroyer the smallest ship of length 2 has to be caught in final mod 2 net if not found before that.

Code: (Select All)
_Title "BattleShip Mod842" ' b+ 2024-07-26 port from JB
' Battleship Mod842 b+ 2024-07-25 uses a garanteed AI to find Destroyer in 50 shots
' unlike Battleship 2 which AI uses mod 3 it is screwed if fails to find Destroyer when mod 3 shooting
' covers the ocean taking something like up to 66 shots to garantee finding Destroyer.
' This code starts from my first Battleship coded for JB:
' Battleship based on Hasbro Game b+ 2024-07-23 allot of code ported out of old QB64 version
' 2024-07-26 besides port trans back to QB64, fix the showing of computer ships so only the ones
' or parts not hit with ship number. Add Sound when ship is hit.

Dim Shared As Long PXO, PYO, CXO, CYO, SXO, SYO ' offsets for player, computer and ships sunk boards
Dim Shared As Long Dir ' for AI bombing testing  4 directions from last hit for more ship
Dim Shared As Long AiI ' index for AiShots$()
Dim Shared As Long CurrentHits ' tracks how many hits have been made when ship is sunk subtract it's length
'                                are there still unaccounted for hits?
Dim Shared As Long PTurn, GameOn ' TF players turn or not and GameOn if still running game
Dim Shared As Long X1, Y1, BombX, BombY, Hit2 ' tracking bombs and hits for AI to sink ship

Dim Shared As Long P(9, 9), C(9, 9), Hits(9, 9) ' player board, computer board and hits tracking for AI

Dim Shared As Long ShipLen(10), ShipHor(10), ShipX(10), ShipY(10), ShipSunk(10)
Dim Shared ShipName$(10), ShipHits$(10)
' Ship arrays are 0 based but are really numbered 1 to 10, 0 is ignored
' ShipName$() are names of ships according to length in character cells see approx line 38
' ShipLen() is the length or how many character cells a ship is long, 5 down to 2 according to index
' ShipHor() is a T/F value (0|-1) if it is Setup horizontal see SetUp where ships are positioned
' ShipX() and ShipY() locate the top of a ship if vertically set or the left start of ship if horizontal
' ShipHits$() tracks which cell on each ship was hit
' ShipSunk() T/F if ship has been sunk

Dim Shared AiShots$(50) ' AiShots sequence pattern coverage of board for bombs

Color 15, 9
Randomize Timer
'                      set one time only stuff
PXO = 8: PYO = 6 ' offsets for player grid
CXO = 35: CYO = 6 ' offsets for computer grid player shoots at
SXO = 68: SYO = 10 ' offsets ship tally
For i = 1 To 10 ' not sure I need names yet
    Select Case i
        Case 1: ShipLen(i) = 5: ShipName$(i) = "Carrier"
        Case 2: ShipLen(i) = 4: ShipName$(i) = "Battleship"
        Case 3: ShipLen(i) = 3: ShipName$(i) = "Cruiser"
        Case 4: ShipLen(i) = 3: ShipName$(i) = "Submarine"
        Case 5: ShipLen(i) = 2: ShipName$(i) = "Destroyer"
        Case 6: ShipLen(i) = 5: ShipName$(i) = "Carrier"
        Case 7: ShipLen(i) = 4: ShipName$(i) = "Battleship"
        Case 8: ShipLen(i) = 3: ShipName$(i) = "Cruiser"
        Case 9: ShipLen(i) = 3: ShipName$(i) = "Submarine"
        Case 10: ShipLen(i) = 2: ShipName$(i) = "Destroyer"
    End Select
Next

While 1 'run game loop until player quits
    Setup
    Shoot
Wend

Sub Setup ' get a game ready to play
    ' clear shared arrays and variables
    Erase ShipX, ShipY, ShipHor, ShipHits$, ShipSunk, P, C, Hits
    PTurn = 0: GameOn = 0: Dir = 0: AiI = 0: CurrentHits = 0 ' globals

    'setup 2 bombing patterns to cover sea in checkerboard pattern one is chosen in each game
    s1$ = "A0B1C2D3E4F5G6H7I8J9I0J1A8B9E0F1G2H3I4J5A4B5C6D7E8F9C0D1E2F3G4H5I6J7A6B7C8D9G0H1I2J3A2B3C4D5E6F7G8H9"
    s2$ = "A9B8C7D6E5F4G3H2I1J0B0A1I9J8A5B4C3D2E1F0E9F8G7H6I5J4A3B2C1D0A7B6C5D4E3F2G1H0C9D8E7F6G5H4I3J2G9H8I7J6"
    If Rnd < .5 Then shots$ = s1$ Else shots$ = s2$ ' don't be predictable with bombing patterns
    ' shuffle sections: priority diagonal then sub diagonals, Mod 8 then mod 4 then mod 2
    ReDim As Long T(50), i
    For i = 1 To 50: T(i) = i: Next
    start = 1: stp = 10: Shuffle T(), start, stp
    start = 11: stp = 14: Shuffle T(), start, stp
    start = 15: stp = 26: Shuffle T(), start, stp
    start = 27: stp = 50: Shuffle T(), start, stp
    For i = 1 To 50 ' stow into an array
        AiShots$(i) = Mid$(shots$, 2 * T(i) - 1, 2)
    Next
    Cls
    ' Game Board draw once per game
    Print ""
    Print "             Player                    Computer"
    Print ""
    Print "       A B C D E F G H I J        A B C D E F G H I J"
    Print "       -------------------        -------------------"
    Print "    0| . . . . . . . . . .     0| . . . . . . . . . ."
    Print "    1| . . . . . . . . . .     1| . . . . . . . . . ."
    Print "    2| . . . . . . . . . .     2| . . . . . . . . . ."
    Print "    3| . . . . . . . . . .     3| . . . . . . . . . .   Ships:     P C"
    Print "    4| . . . . . . . . . .     4| . . . . . . . . . .   Carrier    . ."
    Print "    5| . . . . . . . . . .     5| . . . . . . . . . .   Battleship . ."
    Print "    6| . . . . . . . . . .     6| . . . . . . . . . .   Cruiser    . ."
    Print "    7| . . . . . . . . . .     7| . . . . . . . . . .   Submarine  . ."
    Print "    8| . . . . . . . . . .     8| . . . . . . . . . .   Destroyer  . ."
    Print "    9| . . . . . . . . . .     9| . . . . . . . . . ."
    Print "       -------------------        -------------------"
    Print "       A B C D E F G H I J        A B C D E F G H I J"

    'locate 6, 5: print "X" ' check offsets

    ' check AIshots$((aiI) OK
    'For i = 1 To 50 'double check checker board coverage 50 cells in priority order
    '    x = InStr("ABCDEFGHIJ", Left$(AiShots$(i), 1)) - 1
    '    y = Val(Mid$(AiShots$(i), 2, 1))
    '    LP x, y, "p", "O"
    '    _Delay 1
    'Next

    For i = 1 To 10 ' restring ship hits to all clear no hits
        ShipHits$(i) = String$(ShipLen(i), "o")
    Next
    Autosetup 1 'setup the Computers ships offer to that for player
    Message "Let computer setup your ships?  press y for yes, n for no..."
    k$ = UCase$(Input$(1))
    If k$ = "Y" Then
        Autosetup 0
    Else
        For s = 1 To 5 ' do it yourself ship placement
            OK = 0
            Locate 21, 1
            Print "To place ship:" + Chr$(13) + "Enter v for vertical, h for horizontal, letter and digit for top, left of ship"
            While OK = 0
                ClearMessage
                Message "Setting up the " + ShipName$(s) + " with length" + Str$(ShipLen(s))
                Locate 23, 1: Print Space$(80);
                Locate 23, 1: Input "placement? "; place$
                place$ = UCase$(place$)
                If Left$(place$, 1) = "V" Then ShipHor(s) = 0 Else ShipHor(s) = 1
                sx = InStr("ABCDEFGHIJ", Mid$(place$, 2, 1)) - 1
                sy = Val(Mid$(place$, 3, 1))
                Locate 23, 1: Print Space$(80);
                If ShipHor(s) Then
                    If sx <= 10 - 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) = s
                                LP sx + xx, sy, "p", _Trim$(Str$(s))
                            Next
                        End If
                    End If
                Else
                    If sy <= 10 - 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) = s
                                LP sx, sy + yy, "p", _Trim$(Str$(s))
                            Next
                        End If
                    End If
                End If
            Wend
        Next
        Locate 21, 1: Print Space$(80); ' clear multi-lines
        Locate 22, 1: Print Space$(80);
        Locate 23, 1: Print Space$(80);
    End If
    ClearMessage
End Sub

Sub Autosetup (AItf As Long) '  there is surely a shorter way to do this but I am eager to get on with other stuff
    If AItf Then 'setup Computer's ships
        'setup a board with ships, Computer or AI's setup
        For s = 6 To 10
            OK = 0
            While OK = 0
                ShipHor(s) = Rand(0, 1)
                If ShipHor(s) Then
                    sy = Rand(0, 9)
                    sx = Rand(0, 10 - ShipLen(s))
                    OK = 1
                    For xx = 0 To ShipLen(s) - 1
                        If C(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
                            C(sx + xx, sy) = s
                            'LP sx + xx, sy, "c", _Trim$(Str$(S Mod 10)) ' for debugg
                        Next
                    End If
                Else
                    sx = Rand(0, 9)
                    sy = Rand(0, 10 - ShipLen(s))
                    OK = 1
                    For yy = 0 To ShipLen(s) - 1
                        If C(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
                            C(sx, sy + yy) = s
                            'LP sx, sy + yy, "c", _Trim$(Str$(S Mod 10)) ' for debugg
                        Next
                    End If
                End If
            Wend
        Next
    Else 'setup Player's ships
        For s = 1 To 5
            OK = 0
            While OK = 0
                ShipHor(s) = Rand(0, 1)
                If ShipHor(s) Then
                    sy = Rand(0, 9)
                    sx = Rand(0, 10 - ShipLen(s))
                    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) = s
                            LP sx + xx, sy, "p", _Trim$(Str$(s))
                        Next
                    End If
                Else
                    sx = Rand(0, 9)
                    sy = Rand(0, 10 - ShipLen(s))
                    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) = s
                            LP sx, sy + yy, "p", _Trim$(Str$(s))
                        Next
                    End If
                End If
            Wend
        Next
    End If
End Sub

Sub Message (m$)
    Locate 20, 3: Print m$;
End Sub

Sub ClearMessage
    Locate 20, 1: Print Space$(80);
    Locate 20, 1: Print ""
End Sub

Sub LP (x As Long, y As Long, pcGrid$, s$)
    If pcGrid$ = "p" Then Locate PYO + y, PXO + 2 * x Else Locate CYO + y, CXO + 2 * x
    Print s$;
End Sub

Function Rand& (low As Long, high As Long) ' Random integer from low to high inclusive
    Rand& = Int(Rnd * (high - low + 1)) + low
End Function

Sub Shoot
    GameOn = 1
    While GameOn
        If PTurn Then PTurn = 0 Else PTurn = 1
        If PTurn Then ' player
            Locate 20, 1: Input "Enter your next bomb site letter digit "; place$
            If place$ = "" Then GameOn = 0
            place$ = UCase$(place$)
            bx = InStr("ABCDEFGHIJ", Left$(place$, 1)) - 1
            by = Val(Mid$(place$, 2, 1))
            If bx >= 0 And bx < 10 Then ' better check
                If by >= 0 And by < 10 Then
                    If C(bx, by) <> 0 Then 'hit
                        LP bx, by, "c", "X"
                        Sound 200, 2
                        HitEval "c", bx, by 'game could end here
                    Else
                        LP bx, by, "c", "o"
                    End If
                End If
            End If
            ClearMessage
        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. Some effort to work it, still might get confused.
            'hits() array tracks red = 1 and white pegs = -1 like a human player for AI

            If Dir Then 'we are working around the latest hit with bombx, bomby to test
                If P(BombX, BombY) <> 0 Then 'hit!
                    Hit2 = 1
                    Hits(BombX, BombY) = 1: CurrentHits = CurrentHits + 1
                    LP BombX, BombY, "p", "X"

                    '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
                    Sound 2000, 2 ' wakeup player!
                    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
                    Hit2 = 0
                    Hits(BombX, BombY) = -1
                    LP BombX, BombY, "p", "o"
                    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
                alreadyHit:
                AiI = AiI + 1 ' next random shoot
                If AiI > 50 Then ' we should never get this far but just in case
                    x = Rand(0, 9)
                    y = Rand(0, 9)
                Else ' normal shooting pattern by diagonals to form checker board coverage
                    x = InStr("ABCDEFGHIJ", Left$(AiShots$(AiI), 1)) - 1
                    y = Val(Mid$(AiShots$(AiI), 2, 1))
                End If
                If Hits(x, y) <> 0 Then GoTo alreadyHit

                ' was that shot just fired a hit or miss
                If P(x, y) <> 0 Then ' test our shot just fired is hit!
                    X1 = x: Y1 = y 'save first hit to come back to
                    Hits(X1, Y1) = 1: CurrentHits = CurrentHits + 1
                    LP X1, Y1, "p", "X"
                    ' we need to know stuff but can't use this info for AI finding the ship
                    ' keep the same as for the player
                    Sound 2000, 2 ' wakeup 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: Y1 = 0: Dir = 0 'we are done
                    Else
                        Dir = -1 ' this signals we are working on a hit
                        DecideWhereToBombNext
                    End If
                Else 'no hit
                    Hits(x, y) = -1
                    LP x, y, "p", "o"
                End If
            End If 'rI was hit or not
        End If 'whose turn is it
        _Delay 1.5 ' a sec pause to allow us to see computers move
    Wend
    Message "Play Again? press y for yes, n for no..."
    k$ = Input$(1)
    Cls
    If k$ = "n" Then End
End Sub

Sub HitEval (board$, bbx, bby)
    'this is like a referee for both players to announce a ship sunk and a game won?
    If board$ <> "p" Then
        s = C(bbx, bby) ' which ship number
        you$ = "Player": my$ = "Computer's"
        istart = 6: istop = 10
    Else
        s = P(bbx, bby)
        you$ = "Computer": my$ = "Player's"
        istart = 1: istop = 5
    End If
    If ShipHor(s) Then D = bbx - ShipX(s) + 1 Else D = bby - ShipY(s) + 1
    Mid$(ShipHits$(s), D, 1) = "X"
    If ShipHits$(s) = String$(ShipLen(s), "X") Then
        ShipSunk(s) = 1
        If board$ = "p" Then CurrentHits = CurrentHits - ShipLen(s)
        UpdateStatus
        _MessageBox "Congrats:", you$ + " sank " + my$ + " " + ShipName$(s) + "!"
        tot = 0
        For i = istart To istop
            If ShipSunk(i) = 1 Then tot = tot + 1
        Next
        If tot = 5 Then
            UpdateStatus
            If you$ = "Computer" Then ShowComputersShips
            _MessageBox "Congratulations ", you$ + ", you sank all " + my$ + " ships! GameOver..."
            GameOn = 0
        End If
    End If
End Sub

Sub DecideWhereToBombNext
    'find next good location, mark the direction we took
    If Dir = -1 Then '
        Hit2 = 0 'when direction = 0 reset 2nd hit signal to 0
        If X1 + 1 <= 9 Then
            If Hits(X1 + 1, Y1) = 0 Then
                BombX = X1 + 1: BombY = Y1: Dir = 1: Exit Sub
            End If
        End If
        'still here?
        If Y1 + 1 <= 9 Then
            If Hits(X1, Y1 + 1) = 0 Then
                BombX = X1: BombY = Y1 + 1: Dir = 2: Exit Sub
            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 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
        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 <= 9 Then
                    If Hits(BombX + 1, BombY) = 0 Then
                        BombX = BombX + 1: Exit Sub
                    End If
                End If
            Case 2
                If BombY + 1 <= 9 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
        Dir = Dir + 1
        Select Case Dir
            Case 2
                If Y1 + 1 <= 9 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
    Dir = 0 'back to random bombing
End Sub

Sub UpdateStatus ' ships area
    For i = 1 To 5 ' row 10 carrier player colum 66 computer column 68
        If ShipSunk(i) Then Locate i + 9, 68,: Print "X";
        If ShipSunk(i + 5) Then Locate i + 9, 70: Print "X"
    Next
End Sub

Sub ShowComputersShips '  fixed this so only empty spaces not bombed are displayed
    For s = 6 To 10
        If ShipHor(s) Then
            sx = ShipX(s): sy = ShipY(s)
            For xx = 0 To ShipLen(s) - 1
                If Mid$(ShipHits$(s), xx + 1, 1) = "o" Then LP sx + xx, sy, "c", _Trim$(Str$(s Mod 10))
            Next
        Else
            sx = ShipX(s): sy = ShipY(s)
            For yy = 0 To ShipLen(s) - 1
                If Mid$(ShipHits$(s), yy + 1, 1) = "o" Then LP sx, sy + yy, "c", _Trim$(Str$(s Mod 10))
            Next
        End If
    Next
End Sub

Sub Shuffle (a() As Long, start, stp) ' here used to randomize shooting pattern a bit
    For i = stp To start + 1 Step -1
        Swap a(i), a(Rand(start, i))
    Next
End Sub

PS I commented a little more than usual for Phil.

Oh here is Introduction to Battleship Game my version is based on Hasbro Game.
Quote:The object of the game is to sink all the Computer's ships before it sinks all yours.

Both the Player and the Computer are given 5 ships to lay out on a 10x10 grid.

The ships are a straight line of squares (2 to 5 squares) forming a long rectangle.
The ships are laid vertically or horizontally on the 10x10 cell grid without overlap.
Each square must be hit by the opponent in order to sink the ship.

The 5 ships are:
Carrier - 5 squares to hit
Battleship - 4 squares to hit
Cruiser - 3 squares to hit
Submarine - 3 squares to hit
Destroyer - 2 squares to hit

The game is started by each opponent laying out their ships secretly to the other.
You the Player must setup your ships on the left board.
They are setup in same order I listed above.

If you do not want the computer to setup for you:
So the first ship to set up will be the Carrier that is 5 squares long.
Enter v or h for horizontal or vertical then the column letter don't worry about capitals then
the digit 0 to 9. So that is 3 chraracters the first v or h, the 2nd abcdefghi or j and 3rd
is 0 to 9. Be careful not to click other places on board because printing will start there
and mess up board.

If there is room on board to lay out all 5 across AND this ship does not overlap another,
then the rest of the ship will be drawn in with its numbers 1 - 5 for the player. The computers
ship numbers are 6-10 but 10 is shown as 0 (after you lose and the comnputers ship placement is
displayed, you can see these before next game is started.)
(Of course, the first ship can't overlap another but every other ship has that potential.)
If there is not room or the ship would overlap another,
then you must start over with the prompt to lay the ship horizontally or vertically...

When you get all 5 of your ships laid out on the 10x10 grid on the left, the shooting match begins!

You will be prompted to Enter a cell on the right 10x10 board to guess where a Computer's ship might be.
If you hit a cell of the Computers ships an X for hit appears at that cell.
If you miss all the Computers ships, an O will appear = miss

The Computer will then take a shot and your board will show an X or O according to the Computer's hit or miss.

Then it's your turn again. If you had a hit the last turn you will likely want to find the
rest of the ship to sink it. So Enter cells above, below, left or right of the hit.
A 2nd hit will tell you if the ship is laid out horizontally or vertically.
A 2nd hit would actually sink a Destroyer because it is only 2 squares long.

So you scout around the 10x10 board making random shots (or systematically cover the board with shots)
until you find a ship, sink it and go hunting for the next ship to sink until you get all 5.

Meanwhile the Computer is doing the same thing, so whichever opponent sinks all the ships first, wins!

Oh a caveat!
It is possible to align the ships side by side or one end up next to another ship
(as long as they don't overlap). This makes it confusing as you might be hitting 2 different ships
with your shots, so pay close attention to which ship is announced sunk, you might have more hits
in the same area than how many it took to sink the ship.

https://en.wikipedia.org/wiki/Battleship_game
PS where I say squares, I mean character cells that letters and digits... fit in.


Attached Files Image(s)
   
b = b + ...
Reply
#2
Honestly I forgot some of the details of what the AI was doing and wouldn't mind one bit if @PhilOfPerth would help me make this code crystal clear. Phil's Seal of Approval would be very valuable to me. This code specially the AI stuff came from 2018 I think:
Quote:_Title "Battleship by bplus v 2018-04-26"
'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
yeah

With or without Phil's help I do intend to comment and name things better.
b = b + ...
Reply
#3
(07-28-2024, 06:46 PM)bplus Wrote: Honestly I forgot some of the details of what the AI was doing and wouldn't mind one bit if @PhilOfPerth would help me make this code crystal clear. Phil's Seal of Approval would be very valuable to me. This code specially the AI stuff came from 2018 I think:
Quote:_Title "Battleship by bplus v 2018-04-26"
'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
yeah

With or without Phil's help I do intend to comment and name things better.

 Thanks@bplus. But you are one of the people I respect very highly for your commenting and clarifying of your works - even if much of it is still beyond my limited understanding.
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#4
Even without the "noise and bling" it is still a cool game! Nicely done!
May your journey be free of incident. Live long and prosper.
Reply
#5
Hey @johnno56! so good to hear from you, our game from 6 years ago still Great Fun!

I have to credit tsh73 at JB forum for inspiring me to pull out that old but gold thing.

He was doing a Battleship version actually with a couple of different game options on their "Screen 0" they call MainWin which has no color, no mouse, not really an inkey$ function though Input$(1) works; mainly Input and Print with Locate but that screen scrolls like a console screen and he was using the scroll feature allot to show updates to game. I thought the whole thing would work better without scrolling like our Player Game Board from 6 years ago, only in Screen 0.

But I was impressed how the pure game can still be played with same passion. So I pulled out our game version and coded it for our screen 0 and ported back to JB that worked with the Mod842 new change to the AI. Actually Mod842 was third version I posted at JB. Problem was in building new AI with Mod842, I forgot how some of the old AI did its thing, in particular how it was sinking ships after finding one with a first hit on it. There were variables there that I could not remember what they did so when writing a new possibly even better AI, I kinda winged it with the old ship sinking routines after first hit on ship occurred. Better AI in that you are garanteed to find that pesky little Destroyer in 50 shots or less, it's actually a little more boring too as the average game tends to run longer.... Our version, somebody usually won well before 50 shots easy but there are times when our game actually sucked rotten eggs hunting that dang little destroyer!

Anyway,
Main problem is sorting out if you are hitting one ship or several. tsh73 never had to face that problem because in the rules he was using you could not place a ship right next to another, a space had to go around each ship, which made layout at setup time harder but shooting ships much easier.

TMI? probably, sorry something about this game and writing AI for a game gets me enthused! Battleship might have been my first time for game AI? If so, no wonder it gets me jazzed.

It was quite a coincidence that @PhilOfPerth (hey! maybe you guys are neighbors!!! Johnno, Phil did you know you could be neighbors?) was talking about properly docummenting when I was porting our game to JB Black print on White background console like screen. Blue and White looks so much better in QB64 IMHO.
b = b + ...
Reply
#6
I like the look of the "old style" of white on blue - definitely an improvement on white on black... lol

Never could get my head around how the AI algo works... too much brain-strain for this old brain... lol But, it certainly plays better the plain old random pot-shots... but harder as well...

Neighbours? Hardly... Phil is in Perth (Western Australia) and I am in Melbourne (Victoria) about 2,720Kms (1,691Miles) apart... which is roughly a 52 hour drive... most of it in a straight line... lol

I won't have any time on the PC today. My eldest grandson has a day off from high school... and you just know how much these screen-agers love their keyboards...

Have a great day....
May your journey be free of incident. Live long and prosper.
Reply
#7
(07-29-2024, 10:13 PM)johnno56 Wrote: I like the look of the "old style" of white on blue - definitely an improvement on white on black... lol

Never could get my head around how the AI algo works... too much brain-strain for this old brain... lol But, it certainly plays better the plain old random pot-shots... but harder as well...

Neighbours? Hardly... Phil is in Perth (Western Australia) and I am in Melbourne (Victoria) about 2,720Kms (1,691Miles) apart... which is roughly a 52 hour drive... most of it in a straight line... lol

I won't have any time on the PC today. My eldest grandson has a day off from high school... and you just know how much these screen-agers love their keyboards...

Have a great day....

Hi @johnno56! I didn't know you were in Aus; most of my adult life was spent around Melbourne (Dandenong area) and I still go back to visit my (diminishing number of) relis. 
Where are you? It's amazing I never bump into you - I'll look out for you next time I'm over lol.
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#8
hey cool mates!

I have updated Battleship Mod842 ViewPrint that replaces messagebox messages, got rid my other message stuff and practiced using View Print a bit. I've cleaned up and made more extensive comments fixed errors caused by Player entering bad data or shots he already made (and sinking a ship already sunk!) All around a more solid version.

Code: (Select All)
_Title "BattleShip Mod842 View Print 2024-07-29"
' b+ 2024-07-26 port from JB
' Battleship Mod842 b+ 2024-07-25 uses a garanteed AI to find Destroyer in 50 shots
' unlike Battleship 2 which AI uses mod 3 it is screwed if fails to find Destroyer when mod 3
' shooting covers the ocean taking something like up to 66 shots to garantee finding Destroyer.
' This code starts from my first Battleship coded for JB:
' Battleship based on Hasbro Game b+ 2024-07-23 allot of code ported out of old QB64 version
' 2024-07-26 besides port trans back to QB64, fix the showing of computer ships so only the ones
' or parts not hit with ship number. Add Sound when ship is hit.

' 2024-07-29 Oh I forgot, MessageBox does not work for older versions of QB64.
' Actually that turns out to be no problem at all!!!
' I think I can use View Print and not need my Message and Message Clear subroutines.
' This might be a very cool fix! Also I am going to work on my organization and commenting.
' OK View Print did not scroll inside the view text port so I had to cls before turning off
' View Print. I was thinking scrolling would be cool, no cls needed but no.

' Fix a bug that has been here from beginning, check player's bomb site to see if already done
' if so BEEP him, definitely don't want to sink a ship twice which is what has been happening.
' So we should use computer c() to track players shots. -1 for miss but what about when ship
' is hit???  c(x, y) = c(x, y) + 10 so if c(x, y) is > 5 and < 11  then good hit.
' if c(x,y) > 10 then already hit. BEEPing now for places already bombed plus give player another
' chance to shoot.

' Need to check place$ to see if player screwed up placement instructions,  done.

'   Offsets for the Game board print at top of screen P is for Player, C is for Computer
'   S is for Ships Sunk tally on far right of screen  (x,y) offsets:
Dim Shared As Long PXO, PYO, CXO, CYO, SXO, SYO

Dim Shared As Long PTurn, GameOn ' TF players turn or not and GameOn if still running game

' internal tracking of P() Players ships, C() Computer ships
Dim Shared As Long P(9, 9), C(9, 9), Hits(9, 9) ' player board, computer board and hits tracking for AI

Dim Shared As Long ShipLen(10), ShipHor(10), ShipX(10), ShipY(10), ShipSunk(10)
Dim Shared ShipName$(10), ShipHits$(10)
' Ship arrays are 0 based but are really numbered 1 to 10, 0 is ignored
' ShipName$() are names of ships according to length in character cells see approx line 38
' ShipLen() is the length or how many character cells a ship is long, 5 down to 2 according to index
' ShipHor() is a T/F value (0|-1) if it is Setup horizontal see SetUp where ships are positioned
' ShipX() and ShipY() locate the top of a ship if vertically set or the left start of ship if horizontal
' ShipHits$() tracks which cell on each ship was hit
' ShipSunk() T/F if ship has been sunk

' this stuff is for the AI for computer's turn to play
Dim Shared AiShots$(50) ' AiShots sequence pattern coverage of board when c not working a hit
Dim Shared As Long AiI ' index for AiShots$()
Dim Shared As Long Dir ' for AI bombing testing  4 directions from last hit for more of ship hit
Dim Shared As Long CurrentHits ' tracks how many hits have been made
'                                when ship is sunk subtract it's length
Dim Shared As Long X1, Y1, BombX, BombY, Hit2 ' tracking bombs and hits for AI to sink ship
' X1, Y1 is the location of the latest hit on ship
' Bombx, Bomby is next bomb location when working a first hit
' hit2 indicates the direction we are going was success on last hit

Color 15, 9
Randomize Timer
'                      set one time only stuff
PXO = 8: PYO = 6 ' offsets for player grid display, tracks players ships and computers shots
CXO = 35: CYO = 6 ' offsets for computer grid display, player shots hit= X miss= o
SXO = 68: SYO = 10 ' offsets ships sunk tally
For i = 1 To 10
    Select Case i
        Case 1: ShipLen(i) = 5: ShipName$(i) = "Carrier"
        Case 2: ShipLen(i) = 4: ShipName$(i) = "Battleship"
        Case 3: ShipLen(i) = 3: ShipName$(i) = "Cruiser"
        Case 4: ShipLen(i) = 3: ShipName$(i) = "Submarine"
        Case 5: ShipLen(i) = 2: ShipName$(i) = "Destroyer"
        Case 6: ShipLen(i) = 5: ShipName$(i) = "Carrier"
        Case 7: ShipLen(i) = 4: ShipName$(i) = "Battleship"
        Case 8: ShipLen(i) = 3: ShipName$(i) = "Cruiser"
        Case 9: ShipLen(i) = 3: ShipName$(i) = "Submarine"
        Case 10: ShipLen(i) = 2: ShipName$(i) = "Destroyer"
    End Select
Next

While 1 'run game loop until player quits
    Setup
    Shoot
Wend

Sub Setup ' get a game ready to play
    ' clear shared arrays and variables
    Erase ShipX, ShipY, ShipHor, ShipHits$, ShipSunk, P, C, Hits
    PTurn = 0: GameOn = 0: Dir = 0: AiI = 0: CurrentHits = 0 ' globals

    'setup 2 bombing patterns to cover sea in checkerboard pattern one is chosen in each game
    s1$ = "A0B1C2D3E4F5G6H7I8J9I0J1A8B9E0F1G2H3I4J5A4B5C6D7E8F9C0D1E2F3G4H5I6J7A6B7C8D9G0H1I2J3A2B3C4D5E6F7G8H9"
    s2$ = "A9B8C7D6E5F4G3H2I1J0B0A1I9J8A5B4C3D2E1F0E9F8G7H6I5J4A3B2C1D0A7B6C5D4E3F2G1H0C9D8E7F6G5H4I3J2G9H8I7J6"
    If Rnd < .5 Then shots$ = s1$ Else shots$ = s2$ ' don't be predictable with bombing patterns
    ' shuffle sections: priority diagonal then sub diagonals, Mod 8 then mod 4 then mod 2
    ReDim As Long T(50), i
    For i = 1 To 50: T(i) = i: Next
    start = 1: stp = 10: Shuffle T(), start, stp
    start = 11: stp = 14: Shuffle T(), start, stp
    start = 15: stp = 26: Shuffle T(), start, stp
    start = 27: stp = 50: Shuffle T(), start, stp
    For i = 1 To 50 ' stow into an array
        AiShots$(i) = Mid$(shots$, 2 * T(i) - 1, 2)
    Next
    Cls
    ' Game Board draw once per game
    Print ""
    Print "             Player                    Computer"
    Print ""
    Print "       A B C D E F G H I J        A B C D E F G H I J"
    Print "       -------------------        -------------------"
    Print "    0| . . . . . . . . . .     0| . . . . . . . . . ."
    Print "    1| . . . . . . . . . .     1| . . . . . . . . . ."
    Print "    2| . . . . . . . . . .     2| . . . . . . . . . ."
    Print "    3| . . . . . . . . . .     3| . . . . . . . . . .   Ships:     P C"
    Print "    4| . . . . . . . . . .     4| . . . . . . . . . .   Carrier    . ."
    Print "    5| . . . . . . . . . .     5| . . . . . . . . . .   Battleship . ."
    Print "    6| . . . . . . . . . .     6| . . . . . . . . . .   Cruiser    . ."
    Print "    7| . . . . . . . . . .     7| . . . . . . . . . .   Submarine  . ."
    Print "    8| . . . . . . . . . .     8| . . . . . . . . . .   Destroyer  . ."
    Print "    9| . . . . . . . . . .     9| . . . . . . . . . ."
    Print "       -------------------        -------------------"
    Print "       A B C D E F G H I J        A B C D E F G H I J"

    'locate 6, 5: print "X" ' check offsets

    ' debugg check AIshots$((aiI) OK
    'For i = 1 To 50 'double check checker board coverage 50 cells in priority order
    '    x = InStr("ABCDEFGHIJ", Left$(AiShots$(i), 1)) - 1
    '    y = Val(Mid$(AiShots$(i), 2, 1))
    '    LP x, y, "p", "O"
    '    _Delay 1
    'Next

    For i = 1 To 10 ' restring ship hits to all clear no hits
        ShipHits$(i) = String$(ShipLen(i), "o")
    Next
    Autosetup 1 'setup the Computers ships offer to that for player
    View Print 20 To 25
    Print "   Let computer setup your ships?  press y for yes, n for no..."
    k$ = UCase$(Input$(1))
    Cls
    View Print

    If k$ = "Y" Then
        Autosetup 0
    Else
        For s = 1 To 5 ' do it yourself ship placement
            OK = 0
            While OK = 0
                placeAgain:
                View Print 20 To 25
                Print "   Setting up the " + ShipName$(s) + " with length" + Str$(ShipLen(s))
                Print "   To place ship:"
                Print " Enter v for vertical, h for horizontal, letter and digit for top, left of ship"
                Input "   Placement "; place$
                Cls
                View Print ' turn off view
                place$ = UCase$(place$)
                ' check place
                If Left$(place$, 1) <> "V" And Left$(place$, 1) <> "H" Then Beep: GoTo placeAgain
                sx = InStr("ABCDEFGHIJ", Mid$(place$, 2, 1))
                If sx < 1 Or sx > 10 Then Beep: GoTo placeAgain Else sx = sx - 1
                sy = InStr("0123456789", Mid$(place$, 3, 1))
                If sy < 1 Or sy > 10 Then Beep: GoTo placeAgain Else sy = sy - 1

                If Left$(place$, 1) = "V" Then ShipHor(s) = 0 Else ShipHor(s) = 1
                If ShipHor(s) Then ' layout ship horiz
                    If sx <= 10 - 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) = s
                                LP sx + xx, sy, "p", _Trim$(Str$(s))
                            Next
                        End If
                    End If
                Else ' layout vertical
                    If sy <= 10 - 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) = s
                                LP sx, sy + yy, "p", _Trim$(Str$(s))
                            Next
                        End If
                    End If
                End If
            Wend
        Next
    End If
End Sub

Sub Autosetup (AItf As Long)
    If AItf Then 'setup Computer's ships
        'setup a board with ships, Computer or AI's setup
        For s = 6 To 10
            OK = 0
            While OK = 0
                ShipHor(s) = Rand(0, 1)
                If ShipHor(s) Then
                    sy = Rand(0, 9)
                    sx = Rand(0, 10 - ShipLen(s))
                    OK = 1
                    For xx = 0 To ShipLen(s) - 1
                        If C(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
                            C(sx + xx, sy) = s
                            'LP sx + xx, sy, "c", _Trim$(Str$(S Mod 10)) ' for debugg
                        Next
                    End If
                Else
                    sx = Rand(0, 9)
                    sy = Rand(0, 10 - ShipLen(s))
                    OK = 1
                    For yy = 0 To ShipLen(s) - 1
                        If C(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
                            C(sx, sy + yy) = s
                            'LP sx, sy + yy, "c", _Trim$(Str$(S Mod 10)) ' for debugg
                        Next
                    End If
                End If
            Wend
        Next
    Else 'setup Player's ships
        For s = 1 To 5
            OK = 0
            While OK = 0
                ShipHor(s) = Rand(0, 1)
                If ShipHor(s) Then
                    sy = Rand(0, 9)
                    sx = Rand(0, 10 - ShipLen(s))
                    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) = s
                            LP sx + xx, sy, "p", _Trim$(Str$(s))
                        Next
                    End If
                Else
                    sx = Rand(0, 9)
                    sy = Rand(0, 10 - ShipLen(s))
                    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) = s
                            LP sx, sy + yy, "p", _Trim$(Str$(s))
                        Next
                    End If
                End If
            Wend
        Next
    End If
End Sub

Sub FYI (Info$) ' in place of a MessageBox
    Sound 3000, 4
    Color 10, 1
    View Print 20 To 25
    Print Space$(3); Info$ + " ...zzz"
    Sleep 3
    Cls
    View Print
    Color 15, 1
End Sub

Sub LP (x As Long, y As Long, pcGrid$, s$)
    If pcGrid$ = "p" Then Locate PYO + y, PXO + 2 * x Else Locate CYO + y, CXO + 2 * x
    Print s$;
End Sub

Function Rand& (low As Long, high As Long) ' Random integer from low to high inclusive
    Rand& = Int(Rnd * (high - low + 1)) + low
End Function

Sub Shoot
    GameOn = 1
    While GameOn
        If PTurn Then PTurn = 0 Else PTurn = 1
        If PTurn Then ' player
            playerAgain:
            View Print 20 To 25
            Input "   Enter your next bomb site letter digit "; place$
            Cls
            View Print
            If place$ = "" Then GameOn = 0
            place$ = UCase$(place$)
            bx = InStr("ABCDEFGHIJ", Left$(place$, 1)) - 1
            by = Val(Mid$(place$, 2, 1))
            If bx >= 0 And bx < 10 Then ' better check
                If by >= 0 And by < 10 Then
                    If C(bx, by) = 0 Then 'miss
                        LP bx, by, "c", "o"
                        C(bx, by) = -1
                    ElseIf C(bx, by) > 5 And C(bx, by) < 11 Then 'hit
                        LP bx, by, "c", "X"
                        Sound 200, 2
                        HitEval "c", bx, by 'game could end here
                        C(bx, by) = C(bx, by) + 10 ' signal we hit this spot already!
                    ElseIf C(bx, by) = -1 Or C(bx, by) > 10 Then
                        Beep: GoTo playerAgain
                    End If
                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. Some effort to work it,
            'still might get confused.
            'hits() array tracks red = 1 and white pegs = -1 like a human player for AI

            If Dir Then 'we are working around the latest hit with bombx, bomby to test
                If P(BombX, BombY) <> 0 Then 'hit!
                    Hit2 = 1 ' found 2nd hit neighbor of first hi could be another ship
                    Hits(BombX, BombY) = 1: CurrentHits = CurrentHits + 1
                    LP BombX, BombY, "p", "X"
                    '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
                    Sound 2000, 2 ' wakeup player!
                    HitEval "p", BombX, BombY ' this will reduce currentHits by the amount
                    '                          a ship would 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
                    Hit2 = 0
                    Hits(BombX, BombY) = -1
                    LP BombX, BombY, "p", "o"
                    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
                alreadyHit:
                AiI = AiI + 1 ' next random shoot
                If AiI > 50 Then ' we should never get this far but just in case
                    x = Rand(0, 9)
                    y = Rand(0, 9)
                Else ' normal shooting pattern by diagonals to form checker board coverage
                    x = InStr("ABCDEFGHIJ", Left$(AiShots$(AiI), 1)) - 1
                    y = Val(Mid$(AiShots$(AiI), 2, 1))
                End If
                If Hits(x, y) <> 0 Then GoTo alreadyHit

                ' was that shot just fired a hit or miss
                If P(x, y) <> 0 Then ' test our shot just fired is hit!
                    X1 = x: Y1 = y 'save first hit to come back to
                    Hits(X1, Y1) = 1: CurrentHits = CurrentHits + 1
                    LP X1, Y1, "p", "X"
                    Sound 2000, 2 ' wakeup 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: Y1 = 0: Dir = 0 'we are done
                    Else
                        Dir = -1 ' this signals we are working on a hit
                        DecideWhereToBombNext
                    End If
                Else 'no hit
                    Hits(x, y) = -1
                    LP x, y, "p", "o"
                End If
            End If 'rI was hit or not
        End If 'whose turn is it
        _Delay 1.5 ' a sec pause to allow us to see computers move
    Wend
    View Print 20 To 25
    Print "   Play Again? press y for yes, n for no..."
    k$ = Input$(1)
    Cls
    View Print
    If k$ = "n" Then End
End Sub

Sub HitEval (board$, bbx, bby)
    'this is like a referee for both players to announce a ship sunk and a game won?
    If board$ <> "p" Then
        s = C(bbx, bby) ' which ship number
        you$ = "Player": my$ = "Computer's"
        istart = 6: istop = 10
    Else
        s = P(bbx, bby)
        you$ = "Computer": my$ = "Player's"
        istart = 1: istop = 5
    End If
    If ShipHor(s) Then D = bbx - ShipX(s) + 1 Else D = bby - ShipY(s) + 1
    Mid$(ShipHits$(s), D, 1) = "X"
    If ShipHits$(s) = String$(ShipLen(s), "X") Then
        ShipSunk(s) = 1
        If board$ = "p" Then CurrentHits = CurrentHits - ShipLen(s)
        UpdateStatus
        FYI "Congrats: " + you$ + " sank " + my$ + " " + ShipName$(s) + "!"
        tot = 0
        For i = istart To istop
            If ShipSunk(i) = 1 Then tot = tot + 1
        Next
        If tot = 5 Then
            UpdateStatus
            If you$ = "Computer" Then ShowComputersShips
            FYI "Congrats: " + you$ + ", you sank all " + my$ + " ships! Game Over"
            GameOn = 0
        End If
    End If
End Sub

Sub DecideWhereToBombNext
    'find next good location, mark the direction we took
    If Dir = -1 Then ' new hit
        Hit2 = 0 'when direction = 0 reset 2nd hit signal to 0
        If X1 + 1 <= 9 Then
            If Hits(X1 + 1, Y1) = 0 Then
                BombX = X1 + 1: BombY = Y1: Dir = 1: Exit Sub
            End If
        End If
        'still here?
        If Y1 + 1 <= 9 Then
            If Hits(X1, Y1 + 1) = 0 Then
                BombX = X1: BombY = Y1 + 1: Dir = 2: Exit Sub
            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 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
        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 <= 9 Then
                    If Hits(BombX + 1, BombY) = 0 Then
                        BombX = BombX + 1: Exit Sub
                    End If
                End If
            Case 2
                If BombY + 1 <= 9 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
        Dir = Dir + 1
        Select Case Dir
            Case 2
                If Y1 + 1 <= 9 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
    Dir = 0 'back to random bombing
End Sub

Sub UpdateStatus ' ships area
    For i = 1 To 5 ' row 10 carrier player colum 66 computer column 68
        If ShipSunk(i) Then Locate i + 9, 68,: Print "X";
        If ShipSunk(i + 5) Then Locate i + 9, 70: Print "X"
    Next
End Sub

Sub ShowComputersShips '  fixed this so only empty spaces not bombed are displayed
    For s = 6 To 10
        If ShipHor(s) Then
            sx = ShipX(s): sy = ShipY(s)
            For xx = 0 To ShipLen(s) - 1
                If Mid$(ShipHits$(s), xx + 1, 1) = "o" Then
                    LP sx + xx, sy, "c", _Trim$(Str$(s Mod 10))
                End If
            Next
        Else
            sx = ShipX(s): sy = ShipY(s)
            For yy = 0 To ShipLen(s) - 1
                If Mid$(ShipHits$(s), yy + 1, 1) = "o" Then
                    LP sx, sy + yy, "c", _Trim$(Str$(s Mod 10))
                End If
            Next
        End If
    Next
End Sub

Sub Shuffle (a() As Long, start, stp) ' used to randomize shooting pattern a bit
    For i = stp To start + 1 Step -1
        Swap a(i), a(Rand(start, i))
    Next
End Sub
b = b + ...
Reply
#9
(07-29-2024, 11:23 PM)PhilOfPerth Wrote:
(07-29-2024, 10:13 PM)johnno56 Wrote: I like the look of the "old style" of white on blue - definitely an improvement on white on black... lol

Never could get my head around how the AI algo works... too much brain-strain for this old brain... lol But, it certainly plays better the plain old random pot-shots... but harder as well...

Neighbours? Hardly... Phil is in Perth (Western Australia) and I am in Melbourne (Victoria) about 2,720Kms (1,691Miles) apart... which is roughly a 52 hour drive... most of it in a straight line... lol

I won't have any time on the PC today. My eldest grandson has a day off from high school... and you just know how much these screen-agers love their keyboards...

Have a great day....

Hi @johnno56! I didn't know you were in Aus; most of my adult life was spent around Melbourne (Dandenong area) and I still go back to visit my (diminishing number of) relis. 
Where are you? It's amazing I never bump into you - I'll look out for you next time I'm over lol.
Cranbourne North... Between Thompson Park and Springhill shoping centers... Short drive from Dandenong...
May your journey be free of incident. Live long and prosper.
Reply
#10
Computer AI The Movie


Watch the drama unfold as the Computer AI Hunts down and sinks your ships!

Code: (Select All)
_Title "BS Mod842 AI Movie 2024-07-30"
' b+ 2024-07-26 port from JB
' Battleship Mod842 b+ 2024-07-25 uses a garanteed AI to find Destroyer in 50 shots
' unlike Battleship 2 which AI uses mod 3 it is screwed if fails to find Destroyer when mod 3
' shooting covers the ocean taking something like up to 66 shots to garantee finding Destroyer.
' This code starts from my first Battleship coded for JB:
' Battleship based on Hasbro Game b+ 2024-07-23 allot of code ported out of old QB64 version
' 2024-07-26 besides port trans back to QB64, fix the showing of computer ships so only the ones
' or parts not hit with ship number. Add Sound when ship is hit.

' 2024-07-29 Oh I forgot, MessageBox does not work for older versions of QB64.
' Actually that turns out to be no problem at all!!!
' I think I can use View Print and not need my Message and Message Clear subroutines.
' This might be a very cool fix! Also I am going to work on my organization and commenting.
' OK View Print did not scroll inside the view text port so I had to cls before turning off
' View Print. I was thinking scrolling would be cool, no cls needed but no.

' Fix a bug that has been here from beginning, check player's bomb site to see if already done
' if so BEEP him, definitely don't want to sink a ship twice which is what has been happening.
' So we should use computer c() to track players shots. -1 for miss but what about when ship
' is hit???  c(x, y) = c(x, y) + 10 so if c(x, y) is > 5 and < 11  then good hit.
' if c(x,y) > 10 then already hit. BEEPing now for places already bombed plus give player another
' chance to shoot.

' Need to check place$ to see if player screwed up placement instructions,  done.

' 2024-07-30 BS Mod842 AI Movie - last night I got this great idea and want to share it.
' This Movie shows The Computer AI in action finding and sinking ships, it does so with
' minimum interruption from viewer/Player. I do want to set it so the Player can setup
' tricky ship placements to test how well the AI handles them, also excellent tool to
' improve the AI because just watching a number of these I see AI failures clearly some
' holes left in coverage...



'   Offsets for the Game board print at top of screen P is for Player, C is for Computer
'   S is for Ships Sunk tally on far right of screen  (x,y) offsets:
Dim Shared As Long PXO, PYO, CXO, CYO, SXO, SYO

Dim Shared As Long PTurn, GameOn ' TF players turn or not and GameOn if still running game

' internal tracking of P() Players ships, C() Computer ships
Dim Shared As Long P(9, 9), C(9, 9), Hits(9, 9) ' player board, computer board and hits tracking for AI

Dim Shared As Long ShipLen(10), ShipHor(10), ShipX(10), ShipY(10), ShipSunk(10)
Dim Shared ShipName$(10), ShipHits$(10)
' Ship arrays are 0 based but are really numbered 1 to 10, 0 is ignored
' ShipName$() are names of ships according to length in character cells see approx line 38
' ShipLen() is the length or how many character cells a ship is long, 5 down to 2 according to index
' ShipHor() is a T/F value (0|-1) if it is Setup horizontal see SetUp where ships are positioned
' ShipX() and ShipY() locate the top of a ship if vertically set or the left start of ship if horizontal
' ShipHits$() tracks which cell on each ship was hit
' ShipSunk() T/F if ship has been sunk

' this stuff is for the AI for computer's turn to play
Dim Shared AiShots$(50) ' AiShots sequence pattern coverage of board when c not working a hit
Dim Shared As Long AiI ' index for AiShots$()
Dim Shared As Long Dir ' for AI bombing testing  4 directions from last hit for more of ship hit
Dim Shared As Long CurrentHits ' tracks how many hits have been made
'                                when ship is sunk subtract it's length
Dim Shared As Long X1, Y1, BombX, BombY, Hit2 ' tracking bombs and hits for AI to sink ship
' X1, Y1 is the location of the latest hit on ship
' Bombx, Bomby is next bomb location when working a first hit
' hit2 indicates the direction we are going was success on last hit

Color 15, 9
Randomize Timer
'                      set one time only stuff
PXO = 8: PYO = 6 ' offsets for player grid display, tracks players ships and computers shots
CXO = 35: CYO = 6 ' offsets for computer grid display, player shots hit= X miss= o
SXO = 68: SYO = 10 ' offsets ships sunk tally
For i = 1 To 10
    Select Case i
        Case 1: ShipLen(i) = 5: ShipName$(i) = "Carrier"
        Case 2: ShipLen(i) = 4: ShipName$(i) = "Battleship"
        Case 3: ShipLen(i) = 3: ShipName$(i) = "Cruiser"
        Case 4: ShipLen(i) = 3: ShipName$(i) = "Submarine"
        Case 5: ShipLen(i) = 2: ShipName$(i) = "Destroyer"
        Case 6: ShipLen(i) = 5: ShipName$(i) = "Carrier"
        Case 7: ShipLen(i) = 4: ShipName$(i) = "Battleship"
        Case 8: ShipLen(i) = 3: ShipName$(i) = "Cruiser"
        Case 9: ShipLen(i) = 3: ShipName$(i) = "Submarine"
        Case 10: ShipLen(i) = 2: ShipName$(i) = "Destroyer"
    End Select
Next

While 1 'run game loop until player quits
    Setup
    Shoot
Wend

Sub Setup ' get a game ready to play
    ' clear shared arrays and variables
    Erase ShipX, ShipY, ShipHor, ShipHits$, ShipSunk, P, C, Hits
    PTurn = 0: GameOn = 0: Dir = 0: AiI = 0: CurrentHits = 0 ' globals

    'setup 2 bombing patterns to cover sea in checkerboard pattern one is chosen in each game
    s1$ = "A0B1C2D3E4F5G6H7I8J9I0J1A8B9E0F1G2H3I4J5A4B5C6D7E8F9C0D1E2F3G4H5I6J7A6B7C8D9G0H1I2J3A2B3C4D5E6F7G8H9"
    s2$ = "A9B8C7D6E5F4G3H2I1J0B0A1I9J8A5B4C3D2E1F0E9F8G7H6I5J4A3B2C1D0A7B6C5D4E3F2G1H0C9D8E7F6G5H4I3J2G9H8I7J6"
    'If Rnd < .5 Then shots$ = s1$ Else shots$ = s2$ ' don't be predictable with bombing patterns
    shots$ = s1$
    ' shuffle sections: priority diagonal then sub diagonals, Mod 8 then mod 4 then mod 2
    ReDim As Long T(50), i
    For i = 1 To 50: T(i) = i: Next ' don't shuffle want to test with predictable bombing
    'start = 1: stp = 10: Shuffle T(), start, stp
    'start = 11: stp = 14: Shuffle T(), start, stp
    'start = 15: stp = 26: Shuffle T(), start, stp
    'start = 27: stp = 50: Shuffle T(), start, stp
    For i = 1 To 50 ' stow into an array
        AiShots$(i) = Mid$(shots$, 2 * T(i) - 1, 2)
    Next
    Cls
    ' Game Board draw once per game
    Print ""
    Print "             Player                    Computer"
    Print ""
    Print "       A B C D E F G H I J        A B C D E F G H I J"
    Print "       -------------------        -------------------"
    Print "    0| . . . . . . . . . .     0| . . . . . . . . . ."
    Print "    1| . . . . . . . . . .     1| . . . . . . . . . ."
    Print "    2| . . . . . . . . . .     2| . . . . . . . . . ."
    Print "    3| . . . . . . . . . .     3| . . . . . . . . . .   Ships:     P C"
    Print "    4| . . . . . . . . . .     4| . . . . . . . . . .   Carrier    . ."
    Print "    5| . . . . . . . . . .     5| . . . . . . . . . .   Battleship . ."
    Print "    6| . . . . . . . . . .     6| . . . . . . . . . .   Cruiser    . ."
    Print "    7| . . . . . . . . . .     7| . . . . . . . . . .   Submarine  . ."
    Print "    8| . . . . . . . . . .     8| . . . . . . . . . .   Destroyer  . ."
    Print "    9| . . . . . . . . . .     9| . . . . . . . . . ."
    Print "       -------------------        -------------------"
    Print "       A B C D E F G H I J        A B C D E F G H I J"

    'locate 6, 5: print "X" ' check offsets

    ' debugg check AIshots$((aiI) OK
    'For i = 1 To 50 'double check checker board coverage 50 cells in priority order
    '    x = InStr("ABCDEFGHIJ", Left$(AiShots$(i), 1)) - 1
    '    y = Val(Mid$(AiShots$(i), 2, 1))
    '    LP x, y, "p", "O"
    '    _Delay 1
    'Next

    For i = 1 To 10 ' restring ship hits to all clear no hits
        ShipHits$(i) = String$(ShipLen(i), "o")
    Next
    Autosetup 1 'setup the Computers ships offer to that for player
    View Print 20 To 25
    Print "   Let computer setup your ships?  press y for yes, n for no..."
    k$ = UCase$(Input$(1))
    Cls
    View Print

    If k$ = "Y" Then
        Autosetup 0
    Else
        For s = 1 To 5 ' do it yourself ship placement
            OK = 0
            While OK = 0
                placeAgain:
                View Print 20 To 25
                Print "   Setting up the " + ShipName$(s) + " with length" + Str$(ShipLen(s))
                Print "   To place ship:"
                Print " Enter v for vertical, h for horizontal, letter and digit for top, left of ship"
                Input "   Placement "; place$
                Cls
                View Print ' turn off view
                place$ = UCase$(place$)
                ' check place
                If Left$(place$, 1) <> "V" And Left$(place$, 1) <> "H" Then Beep: GoTo placeAgain
                sx = InStr("ABCDEFGHIJ", Mid$(place$, 2, 1))
                If sx < 1 Or sx > 10 Then Beep: GoTo placeAgain Else sx = sx - 1
                sy = InStr("0123456789", Mid$(place$, 3, 1))
                If sy < 1 Or sy > 10 Then Beep: GoTo placeAgain Else sy = sy - 1

                If Left$(place$, 1) = "V" Then ShipHor(s) = 0 Else ShipHor(s) = 1
                If ShipHor(s) Then ' layout ship horiz
                    If sx <= 10 - 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) = s
                                LP sx + xx, sy, "p", _Trim$(Str$(s))
                            Next
                        End If
                    End If
                Else ' layout vertical
                    If sy <= 10 - 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) = s
                                LP sx, sy + yy, "p", _Trim$(Str$(s))
                            Next
                        End If
                    End If
                End If
            Wend
        Next
    End If
End Sub

Sub Autosetup (AItf As Long)
    If AItf Then 'setup Computer's ships
        'setup a board with ships, Computer or AI's setup
        For s = 6 To 10
            OK = 0
            While OK = 0
                ShipHor(s) = Rand(0, 1)
                If ShipHor(s) Then
                    sy = Rand(0, 9)
                    sx = Rand(0, 10 - ShipLen(s))
                    OK = 1
                    For xx = 0 To ShipLen(s) - 1
                        If C(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
                            C(sx + xx, sy) = s
                            'LP sx + xx, sy, "c", _Trim$(Str$(S Mod 10)) ' for debugg
                        Next
                    End If
                Else
                    sx = Rand(0, 9)
                    sy = Rand(0, 10 - ShipLen(s))
                    OK = 1
                    For yy = 0 To ShipLen(s) - 1
                        If C(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
                            C(sx, sy + yy) = s
                            'LP sx, sy + yy, "c", _Trim$(Str$(S Mod 10)) ' for debugg
                        Next
                    End If
                End If
            Wend
        Next
    Else 'setup Player's ships
        For s = 1 To 5
            OK = 0
            While OK = 0
                ShipHor(s) = Rand(0, 1)
                If ShipHor(s) Then
                    sy = Rand(0, 9)
                    sx = Rand(0, 10 - ShipLen(s))
                    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) = s
                            LP sx + xx, sy, "p", _Trim$(Str$(s))
                        Next
                    End If
                Else
                    sx = Rand(0, 9)
                    sy = Rand(0, 10 - ShipLen(s))
                    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) = s
                            LP sx, sy + yy, "p", _Trim$(Str$(s))
                        Next
                    End If
                End If
            Wend
        Next
    End If
End Sub

Sub FYI (Info$) ' in place of a MessageBox
    Sound 3000, 4
    Color 10, 1
    View Print 20 To 25
    Print Space$(3); Info$ + " ...zzz"
    Sleep 3
    Cls
    View Print
    Color 15, 1
End Sub

Sub LP (x As Long, y As Long, pcGrid$, s$)
    If pcGrid$ = "p" Then Locate PYO + y, PXO + 2 * x Else Locate CYO + y, CXO + 2 * x
    Print s$;
End Sub

Function Rand& (low As Long, high As Long) ' Random integer from low to high inclusive
    Rand& = Int(Rnd * (high - low + 1)) + low
End Function

Sub Shoot
    GameOn = 1
    While GameOn
        'If PTurn Then PTurn = 0 Else PTurn = 1
        PTurn = 0 ' for the AI Movie
        If PTurn Then ' player
            playerAgain:
            View Print 20 To 25
            Input "   Enter your next bomb site letter digit "; place$
            Cls
            View Print
            If place$ = "" Then GameOn = 0
            place$ = UCase$(place$)
            bx = InStr("ABCDEFGHIJ", Left$(place$, 1)) - 1
            by = Val(Mid$(place$, 2, 1))
            If bx >= 0 And bx < 10 Then ' better check
                If by >= 0 And by < 10 Then
                    If C(bx, by) = 0 Then 'miss
                        LP bx, by, "c", "o"
                        C(bx, by) = -1
                    ElseIf C(bx, by) > 5 And C(bx, by) < 11 Then 'hit
                        LP bx, by, "c", "X"
                        Sound 200, 2
                        HitEval "c", bx, by 'game could end here
                        C(bx, by) = C(bx, by) + 10 ' signal we hit this spot already!
                    ElseIf C(bx, by) = -1 Or C(bx, by) > 10 Then
                        Beep: GoTo playerAgain
                    End If
                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. Some effort to work it,
            'still might get confused.
            'hits() array tracks red = 1 and white pegs = -1 like a human player for AI

            If Dir Then 'we are working around the latest hit with bombx, bomby to test
                If P(BombX, BombY) <> 0 Then 'hit!
                    Hit2 = 1 ' found 2nd hit neighbor of first hi could be another ship
                    Hits(BombX, BombY) = 1: CurrentHits = CurrentHits + 1
                    LP BombX, BombY, "p", "X"
                    '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
                    Sound 2000, 2 ' wakeup player!
                    HitEval "p", BombX, BombY ' this will reduce currentHits by the amount
                    '                          a ship would 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
                    Hit2 = 0
                    Hits(BombX, BombY) = -1
                    LP BombX, BombY, "p", "o"
                    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
                alreadyHit:
                AiI = AiI + 1 ' next random shoot
                If AiI > 50 Then ' we should never get this far but just in case
                    x = Rand(0, 9)
                    y = Rand(0, 9)
                Else ' normal shooting pattern by diagonals to form checker board coverage
                    x = InStr("ABCDEFGHIJ", Left$(AiShots$(AiI), 1)) - 1
                    y = Val(Mid$(AiShots$(AiI), 2, 1))
                End If
                If Hits(x, y) <> 0 Then GoTo alreadyHit

                ' was that shot just fired a hit or miss
                If P(x, y) <> 0 Then ' test our shot just fired is hit!
                    X1 = x: Y1 = y 'save first hit to come back to
                    Hits(X1, Y1) = 1: CurrentHits = CurrentHits + 1
                    LP X1, Y1, "p", "X"
                    Sound 2000, 2 ' wakeup 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: Y1 = 0: Dir = 0 'we are done
                    Else
                        Dir = -1 ' this signals we are working on a hit
                        DecideWhereToBombNext
                    End If
                Else 'no hit
                    Hits(x, y) = -1
                    LP x, y, "p", "o"
                End If
            End If 'rI was hit or not
        End If 'whose turn is it
        _Delay 1 ' a sec pause to allow us to see computers move
    Wend
    View Print 20 To 25
    Print "   Play Again? press y for yes, n for no..."
    k$ = Input$(1)
    Cls
    View Print
    If k$ = "n" Then End
End Sub

Sub HitEval (board$, bbx, bby)
    'this is like a referee for both players to announce a ship sunk and a game won?
    If board$ <> "p" Then
        s = C(bbx, bby) ' which ship number
        you$ = "Player": my$ = "Computer's"
        istart = 6: istop = 10
    Else
        s = P(bbx, bby)
        you$ = "Computer": my$ = "Player's"
        istart = 1: istop = 5
    End If
    If ShipHor(s) Then D = bbx - ShipX(s) + 1 Else D = bby - ShipY(s) + 1
    Mid$(ShipHits$(s), D, 1) = "X"
    If ShipHits$(s) = String$(ShipLen(s), "X") Then
        ShipSunk(s) = 1
        If board$ = "p" Then CurrentHits = CurrentHits - ShipLen(s)
        UpdateStatus
        FYI "Congrats: " + you$ + " sank " + my$ + " " + ShipName$(s) + "!"
        tot = 0
        For i = istart To istop
            If ShipSunk(i) = 1 Then tot = tot + 1
        Next
        If tot = 5 Then
            UpdateStatus
            If you$ = "Computer" Then ShowComputersShips
            FYI "Congrats: " + you$ + ", you sank all " + my$ + " ships! Game Over"
            GameOn = 0
        End If
    End If
End Sub

Sub DecideWhereToBombNext
    'find next good location, mark the direction we took
    If Dir = -1 Then ' new hit
        Hit2 = 0 'when direction = 0 reset 2nd hit signal to 0
        If X1 + 1 <= 9 Then
            If Hits(X1 + 1, Y1) = 0 Then
                BombX = X1 + 1: BombY = Y1: Dir = 1: Exit Sub
            End If
        End If
        'still here?
        If Y1 + 1 <= 9 Then
            If Hits(X1, Y1 + 1) = 0 Then
                BombX = X1: BombY = Y1 + 1: Dir = 2: Exit Sub
            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 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
        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 <= 9 Then
                    If Hits(BombX + 1, BombY) = 0 Then
                        BombX = BombX + 1: Exit Sub
                    End If
                End If
            Case 2
                If BombY + 1 <= 9 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
        Dir = Dir + 1
        Select Case Dir
            Case 2
                If Y1 + 1 <= 9 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
    Dir = 0 'back to random bombing
End Sub

Sub UpdateStatus ' ships area
    For i = 1 To 5 ' row 10 carrier player colum 66 computer column 68
        If ShipSunk(i) Then Locate i + 9, 68,: Print "X";
        If ShipSunk(i + 5) Then Locate i + 9, 70: Print "X"
    Next
End Sub

Sub ShowComputersShips '  fixed this so only empty spaces not bombed are displayed
    For s = 6 To 10
        If ShipHor(s) Then
            sx = ShipX(s): sy = ShipY(s)
            For xx = 0 To ShipLen(s) - 1
                If Mid$(ShipHits$(s), xx + 1, 1) = "o" Then
                    LP sx + xx, sy, "c", _Trim$(Str$(s Mod 10))
                End If
            Next
        Else
            sx = ShipX(s): sy = ShipY(s)
            For yy = 0 To ShipLen(s) - 1
                If Mid$(ShipHits$(s), yy + 1, 1) = "o" Then
                    LP sx, sy + yy, "c", _Trim$(Str$(s Mod 10))
                End If
            Next
        End If
    Next
End Sub

Sub Shuffle (a() As Long, start, stp) ' used to randomize shooting pattern a bit
    For i = stp To start + 1 Step -1
        Swap a(i), a(Rand(start, i))
    Next
End Sub

Also makes a great tool to test and improve the AI with tricky ship positioning in attempts to befuddle the AI.
b = b + ...
Reply




Users browsing this thread: 4 Guest(s)