|
|
Post by bplus on Aug 9, 2024 23:28:12 GMT
OK I have this code saving ship positions that took over 55 shots to sink all the ships.
_Title "m842 ship positions 2024-08-08" 'bplus
' 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...
' 2024-07-30 BS Mod842 AI Movie 2 tsh suggest if running successfully one way and stop
' the reverse direction and go opposite ie heading dir 1 right then go left if stopped.
' 2024-07-31 still with Movie 2 - Take out View Print with Locate and ClearPartial sub
' to clear only bottom part of screen. Now I have code portable to all Basics.
' 2024-08-01 BS Mod 842 Counting Hits 1, as posted at JB today:
' =========================================================================================================
' I am studying cases when/where AI fails to sustain an attack when current hits > 0 after a ship is sunk.
' The attack needs to persist for the original hit area until currentHits is zero, = no ships left in
' area of first hit in sequence after random fire gets a first hit.
'
' Towards that end I need to restructure:
' Add HitX(), HitY() track where we have hits 1, 0 for untested
' yet I suppose we have to track if missed at that spot too, -1
' that would replace X1, Y1 with the array ordered by hitIndex
' kinda of confused at moment to include misses or not.
' BTW 17 is max amount of hits possible if you hit everything on Board, could have a cluster convoy.
'
' Dir() = 0 1 2 3 4 test all 4 directions for each hit, 0 no direction tested,
' 5 = all directions tested and so hitIndex for that place is played out
'
' the 3 (new arrays) above are indexed with hitIndex (global)
'
' When currentHits does go to 0 after all ships sunk then call new ZeroOutHits sub
'
' Maybe need a tryThisIndexNext global also when deciding where to bomb next,
' set to 1 in ZeroOut This would track where we are in the hit List.
'
' Well that sketches out my next mods and experiment towards a more intelligent AI.
' There, you 'all have it in my words before the code is written! :)
' =========================================================================================================
' note: previous version had Dir2 that never got used
' oh I need 4 arrays for 4 directions possible because can't depend on directions going in order from
' 1 to 4.
' 2024-08-01 BS Mod 842 Counting Hits 2 Player back - yeah so now that AI is playing so well
' bring back the player!
' 2024-08-05 BS Olympics 1 2024-08-05 starting from last version line above
' add DATA line(s) for loading Players ships and load those ships in Setup Sub.
' DATA for 5 ships is 15 chars long using l (level) for replacement to horizontal.
' using Instr() in function PlaceShip$ to find 3 symbol code to place Players ship.
' The take player out of the game and count all the shots AI makes to sink all the ships.
' 2024-08-09 starting with code from 2024-08-01 BS Mod 842 Counting Hits 2 Player back
' here we are looking for hard to sink ship positions from player's random autoset.
' If nShots exceeds 55 it is a candidate.
'==========================================================================================================
' 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 BombX, BombY, Hit2 ' tracking bombs and hits for AI to sink ship
' Bombx, Bomby is next bomb location when working a first hit area
' Hit2 indicates the direction we are going was success on last hit, keep going!
' new for Counting Hits D1 east right, D2, west left, D3 down south, D4 up North
ReDim Shared As Long HitX(17), HitY(17), D1(17), D2(17), D3(17), D4(17), HitI, tryNextI
' HitI is HitIndex tryNextI tracks open slots of left of currentHits to shoot around
Dim Shared As Long NShots 'counting how long it takes for computer to sink all players ships
Dim Shared ShipPositions$ ' save the ship positions to file if nshots > 55
Dim Shared As Long Filed ' count how many positions filed
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: AiI = 0: CurrentHits = 0 ' globals
NShots = 0: ShipPositions$ = ""
'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 ' 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
ZeroOutHits
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
'Locate 20, 1
'Print " Let computer setup your ships? press y for yes, n for no..."
'k$ = UCase$(Input$(1))
'CLSpart
'If k$ = "Y" Then
Autosetup 0
'Else
'For s = 1 To 5 ' do it yourself ship placement
' OK = 0
' While OK = 0
' placeAgain:
' Locate 20, 1
' 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$
' CLSpart
' 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
ShipPositions$ = ShipPositions$ + "H"
ShipPositions$ = ShipPositions$ + Mid$("ABCDEFGHIJ", sx + 1, 1)
ShipPositions$ = ShipPositions$ + Mid$("0123456789", sy + 1, 1)
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
ShipPositions$ = ShipPositions$ + "V"
ShipPositions$ = ShipPositions$ + Mid$("ABCDEFGHIJ", sx + 1, 1)
ShipPositions$ = ShipPositions$ + Mid$("0123456789", sy + 1, 1)
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
Locate 20, 1
Print Space$(3); Info$ + " (3 secs)"
_Delay 3
CLSpart
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:
Locate 20, 1
Input " Enter your next bomb site letter digit "; place$
CLSpart
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
NShots = NShots + 1
_Title "Ship positions: " + ShipPositions$ + ", shots:" + TS$(NShots) + " Filed: " + TS$(Filed)
If CurrentHits > 0 Then 'we are working around the latest hit with bombx, bomby to test
' BombX, Bomby already deided in decide... sub
If P(BombX, BombY) <> 0 Then 'hit!
Hit2 = 1 ' signal AI that bomb x, y was a success, keep that direction going
Hits(BombX, BombY) = 1 ' update hits board
CurrentHits = CurrentHits + 1 ' update AI hit count Counting Hits!!!!
LP BombX, BombY, "p", "X" ' update display
'new stuff 2024-08-01 mod
HitI = HitI + 1 ' increase index
HitX(HitI) = BombX ' save location
HitY(HitI) = BombY
' 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 ship sank
If CurrentHits = 0 Then ' clear our checklist we sank all ships we hit,
Call ZeroOutHits ' call off bombing of area
Else
DecideWhereToBombNext
End If
Else 'no hit from checklist scratch off one item
Hit2 = 0 ' signal ai that direction was not successful move on to next
Hits(BombX, BombY) = -1 ' update ALL the hits on board
LP BombX, BombY, "p", "o" ' update board display
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!
CurrentHits = CurrentHits + 1 ' counting hits!!
HitI = HitI + 1
HitX(HitI) = x
HitY(HitI) = y
Hits(x, y) = 1 ' update board
LP HitX(HitI), HitY(HitI), "p", "X" ' update display of board
Sound 2000, 2 ' wakeup player!
HitEval "p", HitX(HitI), HitY(HitI) ' see if ship sunk
'did we just happen to finish off a ship?
If CurrentHits = 0 Then ' finished off all ships in area of hit
ZeroOutHits
Else
DecideWhereToBombNext ' still working the hit area
End If
Else 'no hit
Hits(x, y) = -1 ' record in board
LP x, y, "p", "o" ' update display
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
Locate 20, 1
Print " Ship Positions: "; ShipPositions$
Print " took:"; NShots; "shots."
Print
If NShots > 55 Then
Open "Tough Position Candidates.txt" For Append As #1
Print #1, ShipPositions$, NShots
Close #1
Filed = Filed + 1
End If
'Print " Play Again? press y for yes, n for no..."
'k$ = Input$(1)
CLSpart
If k$ = "n" Then End
End Sub
Sub HitEval (board$, bbx, bby) '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
' this is only thing ref does to help Computer AI
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 ' this sets the next place to try with 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 BombX - 1 >= 0 Then
If Hits(BombX - 1, BombY) = 0 Then
BombX = BombX - 1: Exit Sub
End If
End If
Case 3
If BombY + 1 <= 9 Then
If Hits(BombX, BombY + 1) = 0 Then
BombY = BombY + 1: Exit Sub
End If
End If
Case 4
If BombY - 1 >= 0 Then
If Hits(BombX, BombY - 1) = 0 Then
BombY = BombY - 1: Exit Sub
End If
End If
End Select
' still here then the direction is no longer good to try
Hit2 = 0 ' turn off signal
End If
tryNextI = 1 'vsearch next open hit location not tested
While tryNextI <= HitI ' Not CurrentHits !!!
If D1(tryNextI) = 0 Then
D1(tryNextI) = 1
If HitX(tryNextI) + 1 <= 9 Then
If Hits(HitX(tryNextI) + 1, HitY(tryNextI)) = 0 Then
BombX = HitX(tryNextI) + 1: BombY = HitY(tryNextI): Dir = 1: Exit Sub
End If
End If
End If
If D2(tryNextI) = 0 Then
D2(tryNextI) = 1
If HitX(tryNextI) - 1 >= 0 Then
If Hits(HitX(tryNextI) - 1, HitY(tryNextI)) = 0 Then
BombX = HitX(tryNextI) - 1: BombY = HitY(tryNextI): Dir = 2: Exit Sub
End If
End If
End If
If D3(tryNextI) = 0 Then
D3(tryNextI) = 1
If HitY(tryNextI) + 1 <= 9 Then
If Hits(HitX(tryNextI), HitY(tryNextI) + 1) = 0 Then
BombX = HitX(tryNextI): BombY = HitY(tryNextI) + 1: Dir = 3: Exit Sub
End If
End If
End If
If D4(tryNextI) = 0 Then
D4(tryNextI) = 1
If HitY(tryNextI) - 1 >= 0 Then
If Hits(HitX(tryNextI), HitY(tryNextI) - 1) = 0 Then
BombX = HitX(tryNextI): BombY = HitY(tryNextI) - 1: Dir = 4: Exit Sub
End If
End If
End If
tryNextI = tryNextI + 1
Wend
' exhausted all hit locations hit1 area played out!!!
CurrentHits = 0 ' abandon hit area
ZeroOutHits
End Sub
Sub UpdateStatus ' ships sunk area of the display
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
Sub CLSpart ' clear lower part of screen
For i = 20 To 25
Locate i, 1: Print Space$(80);
Next
Locate 20, 1
End Sub
Sub ZeroOutHits ' at setup and everytime CurrentHits is set back to zero
ReDim As Long HitX(17), HitY(17), D1(17), D2(17), D3(17), D4(17)
HitI = 0: Dir = 0: Hit2 = 0: tryNextI = 0
End Sub
Function TS$ (n As Long)
TS$ = _Trim$(Str$(n))
End Function
Here are the first 15 it found:
HC0VE6HG6HD3VI0 65
VC2VI6VC7VA2VJ2 57
HD3VF5HG9HA7HB4 61
VJ4HE4HD2HB1HE8 60
HE5HG1HC6HD7VH8 60
HF0VA5HC3VF3VG3 62
HB5HA8VE6HF7VG3 58
VJ4VC0VE5VA5HC7 57
HE2HF7VA1HG1HA4 56
HC5VI3VC0VF6VF2 68
VA4HF8HF2VB2VE6 64
VC5VF6HG5VH1VC0 68
HC2VD5VI2VG5HF0 66
VI3VJ6VF2HE8VG1 64
VD3VG6VE7HC2VF2 64
I suspect all or most all went over 55 shots trying to hunt down the Destroyer, it's mostly just bad luck they take so many shots. Here is a screen shot of the report produced by bplus, Battleship Olympics 2 of these 15 run again in that code where positions are entered through Data statements.  About half run over 55 shots the 2nd time. |
|
