+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Smarter than a fb Worm (/showthread.php?tid=1471)
Smarter than a fb Worm - bplus - 02-13-2023
This snake never goes hungry:
Code: (Select All)
_Title "Snake AI-1.1" 'b+ 2020-03-16
'2020-03-14 Snake AI-1 first post
'2020-03-16 Snake AI-1.1 there must be overlap of the snake somewhere!
Const sq = 20, sqs = 20, xmax = 400, ymax = 400
Screen _NewImage(xmax, ymax, 32)
_Delay .25
_ScreenMove _Middle
Randomize Timer
Dim X(xmax + 100), Y(ymax + 100), overlap(19, 19) As Integer
hx = 10: hy = 10: ax = 15: ay = 15: top = 0: X(top) = hx: Y(top) = hy 'initialize
Do
_Title Str$(top + 1)
Line (0, 0)-(xmax, ymax), &HFF006600, BF 'clear garden
'>>>>>>>>>>> SNAKE BRAIN <<<<<<<<<<<<<<<
If hx = 0 And hy = 19 Then
hy = hy - 1
ElseIf hx Mod 2 = 0 And hy <> 0 And hy <> 19 Then
hy = hy - 1
ElseIf hx Mod 2 = 0 And hy = 0 And hy <> 19 Then
hx = hx + 1
ElseIf hx Mod 2 = 1 And hx <> 19 And hy < 18 Then
hy = hy + 1
ElseIf hx Mod 2 = 1 And hx <> 19 And hy = 18 Then
hx = hx + 1
ElseIf hx = 19 And hy = 19 Then
hx = hx - 1
ElseIf hy = 19 And hx <> 0 Then
hx = hx - 1
ElseIf hx Mod 2 = 1 And hy = 0 And hy <> 19 Then
hy = hy + 1
ElseIf hx = 19 And hy < 19 Then
hy = hy + 1
End If
For i = 0 To top - 1
X(i) = X(i + 1): Y(i) = Y(i + 1)
Next
X(top) = hx: Y(top) = hy
'apple
If (ax = hx And ay = hy) Then 'snake eats apple, get new apple watch it's not where snake is
top = top + 1
X(top) = hx: Y(top) = hy
Do 'check new apple
ax = Int(Rnd * sqs): ay = Int(Rnd * sqs): good = -1
For i = 0 To top - 1
If ax = X(i) And ay = Y(i) Then good = 0: Exit For
Next
Loop Until good
End If
Line (ax * sq, ay * sq)-Step(sq - 2, sq - 2), _RGB32(255, 100, 255), BF
'snake
Erase overlap
For i = 0 To top
If i = top Then
c~& = &HFF000000
Else
Select Case (top - i) Mod 4
Case 0: c~& = &HFF000088
Case 1: c~& = &HFF880000
Case 2: c~& = &HFFBB8800
Case 3: c~& = &HFF008888
End Select
End If
overlap(X(i), Y(i)) = overlap(X(i), Y(i)) + 1
Line (X(i) * sq, Y(i) * sq)-Step(sq - 2, sq - 2), c~&, BF
If overlap(X(i), Y(i)) > 1 Then Line (X(i) * sq + .25 * sq, Y(i) * sq + .25 * sq)-Step(.5 * sq - 2, .5 * sq - 2), &HFFFFFFFF, BF
Next
_Display
If top < 10 Then
_Limit 10 + top
ElseIf top < 300 Then
_Limit 100
Else
_Limit 10
End If
LoopAnd it's the dumbest snake I have!
RE: Smarter than a fb Worm - bplus - 02-14-2023
This snake finds the food fast enough and does alright finding a path to the food until...
his own body blocks the way between head and food.
Code: (Select All)
Option _Explicit
_Title "Snake AI-1_7 Real AI" 'b+ 2020-03-20 and Ashish SUB snakeBrainAshish1
'2020-03-14 Snake AI-1 first post
'2020-03-16 Snake AI-1_1 there must be overlap of the snake somewhere! Aha!
'2020-03-17 Snake AI-1_2 fix the duplicate segment problem
' Now a new mystery, an ocassional flashing duplicate box
'2020-03-17 Install standard snake rules for testing brain evolving
' First setup XY type and rename and convert variables using XY type.
' 2nd Make snake brain and whole game only dependent sqrsX, sqrsY and sq for screen size
' Got it!!! the code ends with hangup head next to fruit with 99 (1 cell less that whole board)
' cells of snake length, no new place can be found for fruit, perfect finish and no duplicate
' cells! PLUS now can turn on a dime go up one colume and down the next in 2 key press.
' Now add autoPilot on -1 / off 0 toggle control, OK snake rules tested when human pilots snake.
' Help screen & independent speeds for human or AI.
'2020-03-18 "Snake AI-1_4 fix tester" The AI tester needs to save Head(x, y) in case the AI
' does not change the head(x, y) or tries to move it diagonally.
'2020-03-18 Snake AI-1_5 SHARE change AS XY
' DIM SHARE change AS XY or change.x, change.y replaces variables called dx, dy.
' I decided to switch over to human control if AI fails to return a proper change.
' AI must leave change.x, change.y ready for human to take over control which means my changing
' the code for toggling the autopilot and adding change.x, change.y updates in my snakeBrain SUB.
' Rewrite SnakeBrain using only change.X and change.Y now. A BEEP will indicate an AI error and
' signal control returned to human. This noted in Key Help part of screen.
'2020-03-19 Snake AI-1_6 B+brain#2 begin a new snakeBrainBplus2 sub routine
' Add a driver report in title bar along with sLen.
' Oh hey what a fancy snake dance, not the least bit faster than snakeBrainBplus1.
'2020-03-20 Snake AI-1_7 real AI
' RE: snakeBrainBplus2
' Recode snakeBrainBplus2 to be self contained in one SUB, load data for the array it uses inside
' that SUB. It also has to check sqrsX, sqrsY to be sure they are correct, this is pure novelty
' SUB so will set sqrsX, sqrsY back to 20 each for standard game AI setting. OK good!
' RE: sqrsX, sqrsY
' sqrsX, sqrsY reset back to 20, 20 for standard setup for testing AI.
' RE: Ashish first "real AI" very excellent submission!
' Attempt to incorporate Ashish "real AI" as SUB snakeBrainAshish1
' Ashish is using $CONSOLE and DIM SHARED state$ but I don't see why so I made state$ STATIC in
' his SUB and took console out, though I can see it might be needed later. Working here yeah!
' RE: SnakeBrainBplus3, bplus first "real AI" also working pretty well to a point.
' SnakeBrainBplus3 uses real AI and crashes when snake can't get to fruit due to it's length
' either by inaccessible fruit, snakes body blocks head or head buried in body and can't escape.
' Using lessons learned from Pathfinder work.
' Snakepit Dimensions: square size = sq, sqrsX = # of squares along x-axis and sqrsY squares down.
Const sq = 20, sqrsX = 20, sqrsY = 20, xmax = sq * sqrsX, ymax = sq * sqrsY
Screen _NewImage(800, 600, 32)
_Delay .25
_ScreenMove _Middle
Randomize Timer
'Usually used to give a point on 2D board a single name that has an X dimension and a Y dimension.
Type XY
X As Integer
Y As Integer
End Type
' SHARED variables for any version of SnakeBrain SUB to act as autoPilot for snake snake.
Dim Shared change As XY ' directs the head direction through AI or Human
Dim Shared head As XY ' leads the way of the snake(body) through snakepit
Dim Shared sLen As Integer ' length of snake
Dim Shared snake(1 To sqrsX * sqrsY) As XY ' whole snake, head is at index = sLen
Dim Shared fruit As XY ' as snake eats fruit it grows, object is to grow snake to fill snakepit
' SHARED for screenUpdate
Dim Shared pal(sqrsX * sqrsY) As _Unsigned Long ' for snake colors
'other data needed for program
Dim i As Integer, good As Integer, KEY$, r As Integer, g As Integer, b As Integer
Dim autoPilot As Integer, hSpeed, aSpeed, saveChange As XY, title$
help ' Key Menu
hSpeed = 3: aSpeed = 20 ' autopilot speed is independent of human control speed
restart: ' reinitialize
r = .3 + Rnd * .7: g = r * .5 + Rnd * .3 - .15: b = .5 * r + Rnd * .3 - .15 ' rnd pal color vars
For i = 1 To sqrsX * sqrsY ' enough colors for snake to fill snakepit
pal(i) = _RGB32(84 + 64 * Sin(r + i / 2), 84 + 64 * Sin(g + i / 2), 104 * Sin(b + i / 2))
Next
head.X = sqrsX / 2 - 3: head.Y = sqrsY / 2 - 3 ' head start
fruit.X = sqrsX / 2 + 2: fruit.Y = sqrsY / 2 + 2 ' first fruit
sLen = 1 ' for starters snake is all head
snake(sLen).X = head.X: snake(sLen).Y = head.Y ' head is always at sLen end
autoPilot = 1 ' start snake body count
change.X = 0: change.Y = 1 ' head snake down board, Y direction of first fruit
Do
If autoPilot Then title$ = "AI." Else title$ = "human."
_Title Str$(sLen) + " Current driver is " + title$
Line (0, 0)-(xmax, ymax), &HFF884422, BF ' clear snakepit
If sLen = sqrsX * sqrsY - 1 Then screenUpdate: Exit Do ' game is won! start another
KEY$ = InKey$
If KEY$ = "q" Or KEY$ = Chr$(27) Then ' here is quit
End '
ElseIf KEY$ = "a" Then ' toggle autoPilot
autoPilot = 1 - autoPilot ' it is now up to AI to keep change updated for human take over
ElseIf KEY$ = "p" Then ' pause toggle p starts pause p ends pause
_KeyClear: While InKey$ <> "p": _Limit 60: Wend
ElseIf KEY$ = "s" Then
If autoPilot And aSpeed + 5 < 400 Then aSpeed = aSpeed + 5 'max autopilot speed is 400 !!!
If autoPilot = 0 And hSpeed + .5 < 10 Then hSpeed = hSpeed + .5 ' max human speed is 10
ElseIf KEY$ = "-" Then
If autoPilot And aSpeed - 5 > 0 Then aSpeed = aSpeed - 5
If autoPilot = 0 And hSpeed - .5 > 1 Then hSpeed = hSpeed - .5
End If ' '
If autoPilot Then ' who is piloting the snake?
saveChange.X = change.X: saveChange.Y = change.Y ' if AI screws up then human takes over
' PLUG-IN YOUR Snake Brain AI here
'=========================================================================== AI Auto Pilot
'snakeBrainBplus1 ' dumb track AI but always gets it's fruit! requires even # sqrsX
'sqrsX = 17: sqrsY = 16
'snakeBrainBplus2 ' dumb track AI but looks cool! requires custom sqrsX = 17, sqrsY = 16
'snakeBrainAshish1 ' first "realAI" I would call an heuristic approach, thanks Ashish!
snakeBrainBplus3 ' bplus "first real AI" uses modified Pathfinder methods
'=========================================================================================
'check changes
If Abs(change.X) = 0 Then ' must have diffence in y's
If Abs(change.Y) <> 1 Then autoPilot = 0 ' error switch to human
ElseIf Abs(change.Y) = 0 Then
If Abs(change.X) <> 1 Then autoPilot = 0 ' error switch to human
Else ' must have a 0 in either change.x or change.y but not both
autoPilot = 0 ' error switch to human
End If
If autoPilot = 0 Then ' switching control over to human restore change values
change.X = saveChange.X: change.Y = saveChange.Y: Beep ' alert human
End If
Else ' ======================================================================= human control
If KEY$ = Chr$(0) + Chr$(72) Then ' up arrow
change.X = 0: change.Y = -1
ElseIf KEY$ = Chr$(0) + Chr$(80) Then ' down arrow
change.X = 0: change.Y = 1
ElseIf KEY$ = Chr$(0) + Chr$(77) Then ' right arrow
change.X = 1: change.Y = 0
ElseIf KEY$ = Chr$(0) + Chr$(75) Then ' left arrow
change.X = -1: change.Y = 0
End If
End If
head.X = head.X + change.X: head.Y = head.Y + change.Y ' OK human or AI have spoken
' ============================ check snake head with Rules: ===============================
' 1. Snakepit boundary check, snake hits wall, dies.
If head.X < 0 Or head.X > sqrsX - 1 Or head.Y < 0 Or head.Y > sqrsY - 1 Then
_Title _Trim$(Str$(sLen)) + " Wall Crash": screenUpdate: Exit Do ' wall crash, new game
End If
' 2. Snake eats body part, dies. This should kill snake if turn its head back on itself.
For i = 1 To sLen ' did head just crash into body?
If head.X = snake(i).X And head.Y = snake(i).Y Then
_Title _Trim$(Str$(sLen)) + " Body Crash": screenUpdate: Exit Do ' yes! start new game
End If
Next ' no
' 3. Eats Fruit and grows or just move every segment up 1 space.
If (fruit.X = head.X And fruit.Y = head.Y) Then ' snake eats fruit
sLen = sLen + 1
snake(sLen).X = head.X: snake(sLen).Y = head.Y 'assimilate fruit into head for new segment
Do 'check new apple
fruit.X = Int(Rnd * sqrsX): fruit.Y = Int(Rnd * sqrsY): good = -1
For i = 1 To sLen
If fruit.X = snake(i).X And fruit.Y = snake(i).Y Then good = 0: Exit For
Next
Loop Until good
Else
For i = 1 To sLen ' move the snake data down 1 dropping off last
snake(i).X = snake(i + 1).X: snake(i).Y = snake(i + 1).Y
Next
snake(sLen).X = head.X: snake(sLen).Y = head.Y ' and adding new head position
End If
screenUpdate ' on with the show this is it!
If autoPilot Then _Limit aSpeed Else _Limit hSpeed 'independent speed control for human and AI
Loop
_Delay 4 ' win or loose, go again
GoTo restart:
Sub screenUpdate ' draw snake and fruit, overlap code debugger
Dim c~&, i As Integer, overlap(sqrsX, sqrsY) As Integer
For i = 1 To sLen
If i = sLen Then c~& = &HFF000000 Else c~& = pal(sLen - i)
' overlap helps debug duplicate square drawing which indicates a flawed code
overlap(snake(i).X, snake(i).Y) = overlap(snake(i).X, snake(i).Y) + 1
Line (snake(i).X * sq, snake(i).Y * sq)-Step(sq - 2, sq - 2), c~&, BF
If overlap(snake(i).X, snake(i).Y) > 1 Then 'show visually where code flaws effect display
LINE (snake(i).X * sq + .25 * sq, snake(i).Y * sq + .25 * sq)_
-STEP(.5 * sq - 2, .5 * sq - 2), &HFFFFFFFF, BF
End If
Next
Line (fruit.X * sq, fruit.Y * sq)-Step(sq - 2, sq - 2), _RGB32(255, 100, 255), BF
_Display
End Sub
Sub help
_PrintString (610, 20), "Keys:"
_PrintString (610, 40), "p toggles pause on/off"
_PrintString (610, 60), "a toggles autoPilot"
_PrintString (610, 100), "arrows control snake"
_PrintString (610, 80), "q or esc quits"
_PrintString (610, 120), "s increases speed"
_PrintString (610, 140), "- decreases speed"
_PrintString (610, 200), "A BEEP means AI error,"
_PrintString (610, 216), "human put in control."
End Sub
'basic functions added for snakeBrainBplus3 (bplus first real AI)
Function max (n As Integer, m As Integer)
If n > m Then max = n Else max = m
End Function
Function min (n As Integer, m As Integer)
If n < m Then min = n Else min = m
End Function
' ================================================================= end code that runs Snake Games
Sub snakeBrainBplus1 '>>>>>>>>>> B+ SNAKE BRAIN needs sqrsX to be even number <<<<<<<<<<<<<<<
' This will be handy for standard 20x20 snakepit to dove tail real AI towrds.
'todo fix this so that when takeover control won't crash into self
If sqrsX Mod 2 = 1 Then change.X = 0: change.Y = 0: Exit Sub ' throw error for code check to
' discover and switch to human control
If head.X = 0 And head.Y = sqrsY - 1 Then
change.X = 0: change.Y = -1
ElseIf head.X Mod 2 = 0 And head.Y <> 0 And head.Y <> sqrsY - 1 Then
change.X = 0: change.Y = -1
ElseIf head.X Mod 2 = 0 And head.Y = 0 And head.Y <> sqrsY - 1 Then
change.X = 1: change.Y = 0
ElseIf head.X Mod 2 = 1 And head.X <> sqrsX - 1 And head.Y = sqrsY - 2 Then
change.X = 1: change.Y = 0
ElseIf head.X Mod 2 = 1 And head.X <> sqrsX - 1 And head.Y < sqrsY - 1 Then
change.X = 0: change.Y = 1
ElseIf head.X = sqrsX - 1 And head.Y = sqrsY - 1 Then
change.X = -1: change.Y = 0
ElseIf head.Y = sqrsY - 1 And head.X <> 0 Then
change.X = -1: change.Y = 0
ElseIf head.X Mod 2 = 1 And head.Y = 0 And head.Y <> sqrsY - 1 Then
change.X = 0: change.Y = 1
ElseIf head.X = sqrsX - 1 And head.Y < sqrsY - 1 Then
change.X = 0: change.Y = 1
End If
End Sub
Sub snakeBrainBplus2 ' Needs custom sqrsX = 17, sqrsY = 16 This is mainly a novelty SUB for fun!
'A good AI will NOT require a custom sqrsX = 17, sqrsY = 16
If sqrsX <> 17 Or sqrsY <> 16 Then change.X = 0: change.Y = 0: Exit Sub ' throw error for code
' check to discover and switch to human control
Dim x, y, s$, direction$
Static brain2Directions(sqrsX - 1, sqrsY - 1) As String
If brain2Directions(0, 0) <> "R" Then GoSub loadBrain2Directions 'array not loaded yet so load
direction$ = brain2Directions(head.X, head.Y)
Select Case direction$
Case "U": change.X = 0: change.Y = -1
Case "D": change.X = 0: change.Y = 1
Case "L": change.X = -1: change.Y = 0
Case "R": change.X = 1: change.Y = 0
End Select
Exit Sub
loadBrain2Directions:
For y = 0 To sqrsY - 1
Read s$
For x = 0 To sqrsX - 1
brain2Directions(x, y) = Mid$(s$, x + 1, 1)
Next
Next
Return
Data RRRRRRRRRRRRRRRRD
Data UDLLLLLLLLLLLLLLD
Data UDRRRRRRRRRRRRDUD
Data UDUDLLLLLLLLLLDUD
Data UDUDRRRRRRRRDUDUD
Data UDUDUDLLLLLLDUDUD
Data UDUDUDRRRRDUDUDUD
Data UDUDUDUDLLDUDUDUD
Data UDUDUDUDRUDUDUDUD
Data UDUDUDUDULLUDUDUD
Data UDUDUDURRRRUDUDUD
Data UDUDUDULLLLLLUDUD
Data UDUDURRRRRRRRUDUD
Data UDUDULLLLLLLLLLUD
Data UDURRRRRRRRRRRRUD
Data ULULLLLLLLLLLLLLL
' note: I had the following lines in main code delares section in case OPTION _EXPLICIT
' started alerts about DIM the STATIC variable in main but not needed.
'
' I think OPTION _EXPLICIT requires next line but will make snakeBrainBplus2 self contained.
'DIM SHARED brain2Directions(0 TO sqrsX - 1, 0 TO sqrsY - 1) AS STRING ' 4 snakeBrainBplus2 AI
End Sub
Sub snakeBrainAshish1 'needs supplemental FUNCTION snakeBodyExists (which%)
Dim nx, ny, dx, dy 'Ashish AI
Static decided
Static state$ ' bplus added state$ to SUB here and removed from DIM SHARED in Main Declares
dx = fruit.X - head.X
dy = fruit.Y - head.Y
nx = snakeBodyExists(1)
ny = snakeBodyExists(2)
If sLen > 1 Then 'collison at corners of square
If head.X = 0 And head.Y = 0 Then
state$ = "corners"
If change.X = -1 Then change.X = 0: change.Y = 1: decided = 0: Exit Sub
If change.Y = -1 Then change.Y = 0: change.X = 1: decided = 0: Exit Sub
ElseIf head.X = 0 And head.Y = sqrsY - 1 Then
state$ = "corners"
If change.X = -1 Then change.X = 0: change.Y = -1: decided = 0: Exit Sub
If change.Y = 1 Then change.Y = 0: change.X = 1: decided = 0: decided = 0: Exit Sub
ElseIf head.X = sqrsX - 1 And head.Y = 0 Then
state$ = "corners"
If change.X = 1 Then change.X = 0: change.Y = 1: decided = 0: Exit Sub
If change.Y = -1 Then change.Y = 0: change.X = -1: decided = 0: Exit Sub
ElseIf head.X = sqrsX - 1 And head.Y = sqrsY - 1 Then
state$ = "corners"
If change.X = 1 Then change.X = 0: change.Y = -1: decided = 0: Exit Sub
If change.Y = 1 Then change.Y = 0: change.X = -1: decided = 0: Exit Sub
End If
If decided = 0 Then 'collision with walls
If head.X = sqrsX - 1 Or head.X = 0 Then
state$ = "walls"
If ny = 0 Then
If dy > 0 Then ny = -1 Else ny = 1
End If
change.Y = ny * -1: change.X = 0
decided = 1
Exit Sub
ElseIf head.Y = sqrsY - 1 Or head.Y = 0 Then
state$ = "walls"
If nx = 0 Then
If dx > 0 Then nx = -1 Else nx = 1
End If
change.X = nx * -1: change.Y = 0
decided = 1
Exit Sub
End If
End If
End If
If dx = 0 Then 'when fruit and head in same direction and motion in same axis
If change.Y = 0 Then
state$ = "linear"
If dy > 0 And ny <> 1 Then
change.Y = 1: change.X = 0: decided = 0: Exit Sub
ElseIf dy < 0 And ny <> -1 Then
change.Y = -1: change.X = 0: decided = 0: Exit Sub
End If
End If
End If
If dy = 0 Then
If change.X = 0 Then
state$ = "linear"
If dx > 0 And nx <> 1 Then
change.X = 1: change.Y = 0: decided = 0: Exit Sub
ElseIf dx < 0 And nx <> -1 Then
change.X = -1: change.Y = 0: decided = 0: Exit Sub
End If
End If
End If
state$ = "common"
'common decision
If Abs(dx) < Abs(dy) Then
state$ = "common ny=" + Str$(ny)
If ny = 0 Then
change.X = 0
If dy > 0 Then change.Y = 1 Else change.Y = -1
state$ = "common cy=" + Str$(change.Y)
Exit Sub
End If
If dy > 0 And ny <> 1 Then change.Y = 1: change.X = 0
If dy < 0 And ny <> -1 Then change.Y = -1: change.X = 0
decided = 0
Else
state$ = "common nx=" + Str$(nx)
If nx = 0 Then
change.Y = 0
If dx > 0 Then change.X = 1 Else change.X = -1
state$ = "common cx=" + Str$(change.X)
Exit Sub
End If
If dx > 0 And nx <> 1 Then change.X = 1: change.Y = 0
If dx < 0 And nx <> -1 Then change.X = -1: change.Y = 0
decided = 0
End If
state$ = "rand_common"
If Abs(dx) = Abs(dy) Then 'random choice will be made then, rest code is same as above
If Rnd > 0.5 Then
state$ = "rand_common ny=" + Str$(ny)
If ny = 0 Then
change.X = 0
If dy > 0 Then change.Y = 1 Else change.Y = -1
state$ = "rand_common cy=" + Str$(change.Y)
Exit Sub
End If
If dy > 0 And ny <> 1 Then change.Y = 1: change.X = 0
If dy < 0 And ny <> -1 Then change.Y = -1: change.X = 0
decided = 0
Else
state$ = "rand_common nx=" + Str$(nx)
If nx = 0 Then
change.Y = 0
If dx > 0 Then change.X = 1 Else change.X = -1
state$ = "rand_common cx=" + Str$(change.X)
Exit Sub
End If
If dx > 0 And nx <> 1 Then change.X = 1: change.Y = 0
If dx < 0 And nx <> -1 Then change.X = -1: change.Y = 0
decided = 0
End If
End If
End Sub
Function snakeBodyExists (which%) ' for SUB snakeBrainAshish1 supplemental
If sLen = 1 Then Exit Function
Dim n
For n = 1 To sLen - 1
If which% = 1 Then 'x-direction
If snake(n).X - head.X > 0 And snake(n).Y = head.Y Then snakeBodyExists = 1: Exit Function
If snake(n).X - head.X < 0 And snake(n).Y = head.Y Then snakeBodyExists = -1: Exit Function
ElseIf which% = 2 Then 'y-direction
If snake(n).Y - head.Y > 0 And snake(n).X = head.X Then snakeBodyExists = 1: Exit Function
If snake(n).Y - head.Y < 0 And snake(n).X = head.X Then snakeBodyExists = -1: Exit Function
End If
Next
End Function
Sub snakeBrainBplus3 ' real AI, responds to real time information
'needs FUNCTION max (n AS INTEGER, m AS INTEGER), FUNCTION min (n AS INTEGER, m AS INTEGER)
'from: Pathfinder inside Maze.bas B+ 2019-12-19 only completely overhauled!
Dim x As Integer, y As Integer, i As Integer, changeF As Integer
Dim parentF As Integer, tick As Integer, foundHead As Integer, headMarked As Integer
Dim yStart As Integer, yStop As Integer, xStart As Integer, xStop As Integer
Dim map(sqrsX - 1, sqrsY - 1) As String, map2(sqrsX - 1, sqrsY - 1) As String
For y = 0 To sqrsY - 1
For x = 0 To sqrsX - 1
map(x, y) = " "
Next
Next
For i = 1 To sLen - 1 ' draw snake in map
map(snake(i).X, snake(i).Y) = "S"
Next
map(head.X, head.Y) = "H"
map(fruit.X, fruit.Y) = "F"
tick = 0
While parentF Or headMarked = 0
parentF = 0: tick = tick + 1
yStart = max(fruit.Y - tick, 0): yStop = min(fruit.Y + tick, sqrsY - 1)
ReDim map2(sqrsX - 1, sqrsY - 1) As String ' need a 2nd map to hold all new stuff until
For y = 0 To sqrsY - 1 ' the entire square coverd
For x = 0 To sqrsX - 1
map2(x, y) = " "
Next
Next
For y = yStart To yStop
xStart = max(fruit.X - tick, 0): xStop = min(fruit.X + tick, sqrsX - 1)
For x = xStart To xStop
'check out the neighbors
If map(x, y) = " " Or map(x, y) = "H" Then
If map(x, y) = "H" Then foundHead = -1
If y - 1 >= 0 Then
If InStr("UDLRF", map(x, y - 1)) Then
map2(x, y) = "U": parentF = 1
If foundHead Then headMarked = -1
End If
End If
If y + 1 <= sqrsY - 1 Then
If InStr("UDLRF", map(x, y + 1)) Then
map2(x, y) = "D": parentF = 1
If foundHead Then headMarked = -1
End If
End If
If x + 1 <= sqrsX - 1 Then
If InStr("UDLRF", map(x + 1, y)) Then
map2(x, y) = "R": parentF = 1
If foundHead Then headMarked = -1
End If
End If
If x - 1 >= 0 Then
If InStr("UDLRF", map(x - 1, y)) Then
map2(x, y) = "L": parentF = 1
If foundHead Then headMarked = -1
End If
End If
End If
Next
Next
For y = 0 To sqrsY - 1 'transfer data to map
For x = 0 To sqrsX - 1
If map2(x, y) <> " " Then map(x, y) = map2(x, y): changeF = 1
Next
Next
Wend 'if no ParentF then dead connection to Fruit
Select Case map(head.X, head.Y)
Case "H" ' cause crash because no connection to fruit found
If change.X Then change.X = -change.X Else change.Y = -change.Y 'make Body crash
' change.X = 0: change.Y = 0 ' this will switch auto control off to avoid program hang, dang still hangs!
Case "D": change.X = 0: change.Y = 1
Case "U": change.X = 0: change.Y = -1
Case "R": change.X = 1: change.Y = 0
Case "L": change.X = -1: change.Y = 0
End Select
End SubRE: Smarter than a fb Worm - TempodiBasic - 02-15-2023
Hi Bplus
I like very much your Snake AI demo!
Snake appears very smart in movement and catching food until its lenght stay under 30 blocks...
but I loose something, because some times it appears clearly a collision at the next step between head and body of snake, while in other situations it is very hard to see why does it return collision.
RE: Smarter than a fb Worm - bplus - 02-15-2023
(02-15-2023, 12:30 AM)TempodiBasic Wrote: Hi Bplus
I like very much your Snake AI demo!
Snake appears very smart in movement and catching food until its lenght stay under 30 blocks...
but I loose something, because some times it appears clearly a collision at the next step between head and body of snake, while in other situations it is very hard to see why does it return collision.
The reason for the crash is always in the title bar.
When the head tries to do an 180, go in reverse, you don't see much difference in position. Just notice the fruit is on the opposite side of the snakes body as the head.
RE: Smarter than a fb Worm - bplus - 02-15-2023
Body/Self Awareness, if we coil the snake before it strikes out for food it won't go crashing into itself.
Code: (Select All)
Option _Explicit
_Title "Snake AI-1_8 Trailblazer" 'b+ 2020-03-23 and Ashish SUB snakeBrainAshish1
'2020-03-14 Snake AI-1 first post
'2020-03-16 Snake AI-1_1 there must be overlap of the snake somewhere! Aha!
'2020-03-17 Snake AI-1_2 fix the duplicate segment problem
' Now a new mystery, an ocassional flashing duplicate box
'2020-03-17 Install standard snake rules for testing brain evolving
' First setup XY type and rename and convert variables using XY type.
' 2nd Make snake brain and whole game only dependent sqrsX, sqrsY and sq for screen size
' Got it!!! the code ends with hangup head next to fruit with 99 (1 cell less that whole board)
' cells of snake length, no new place can be found for fruit, perfect finish and no duplicate
' cells! PLUS now can turn on a dime go up one colume and down the next in 2 key press.
' Now add autoPilot on -1 / off 0 toggle control, OK snake rules tested when human pilots snake.
' Help screen & independent speeds for human or AI.
'2020-03-18 "Snake AI-1_4 fix tester" The AI tester needs to save Head(x, y) in case the AI
' does not change the head(x, y) or tries to move it diagonally.
'2020-03-18 Snake AI-1_5 SHARE change AS XY
' DIM SHARE change AS XY or change.x, change.y replaces variables called dx, dy.
' I decided to switch over to human control if AI fails to return a proper change.
' AI must leave change.x, change.y ready for human to take over control which means my changing
' the code for toggling the autopilot and adding change.x, change.y updates in my snakeBrain SUB.
' Rewrite SnakeBrain using only change.X and change.Y now. A BEEP will indicate an AI error and
' signal control returned to human. This noted in Key Help part of screen.
'2020-03-19 Snake AI-1_6 B+brain#2 begin a new snakeBrainBplus2 sub routine
' Add a driver report in title bar along with sLen.
' Oh hey what a fancy snake dance, not the least bit faster than snakeBrainBplus1.
'2020-03-20 Snake AI-1_7 real AI
' RE: snakeBrainBplus2
' Recode snakeBrainBplus2 to be self contained in one SUB, load data for the array it uses inside
' that SUB. It also has to check sqrsX, sqrsY to be sure they are correct, this is pure novelty
' SUB so will set sqrsX, sqrsY back to 20 each for standard game AI setting. OK good!
' RE: sqrsX, sqrsY
' sqrsX, sqrsY reset back to 20, 20 for standard setup for testing AI.
' RE: Ashish first "real AI" very excellent submission!
' Attempt to incorporate Ashish "real AI" as SUB snakeBrainAshish1
' Ashish is using $CONSOLE and DIM SHARED state$ but I don't see why so I made state$ STATIC in
' his SUB and took console out, though I can see it might be needed later. Working here yeah!
' RE: SnakeBrainBplus3, bplus first "real AI" also working pretty well to a point.
' SnakeBrainBplus3 uses real AI and crashes when snake can't get to fruit due to it's length
' either by inaccessible fruit, snakes body blocks head or head buried in body and can't escape.
' Using lessons learned from Pathfinder work.
'2020-03-21 Snake AI-1_8 Trailblazer a Smarter Snake!
' As described at forum today, entice snake to safely coil itself before going after fruit at
' each increase of it's length. Does't look like this will work out.
' 3-22 try Trailblazer square attack pattern, looks simpler can we connect to safe coil map?
' No connection yet: crash, crash, crash.... my brain is broken!
' 3-23 New idea for connnecting square frame pattern for fruit catching to the safe coil map.
' Looking good! 2-320's 2-360s and 2-perfect 399! Generalize variables for any even field and
' try for perfect 399 everytime. Analyzed the few crashes and fixed bodyStack and yHeadLimit
' so even more perfect runs! The bigger sqrsX is the more slack needs to be built into
' bodyStack.
DefInt A-Z '<< new change for this version 2020-03-23
' Snakepit Dimensions: square size = sq, sqrsX = # of squares along x-axis and sqrsY squares down.
Const sq = 20, sqrsX = 10, sqrsY = 30, xmax = sq * sqrsX, ymax = sq * sqrsY
Screen _NewImage(800, 600, 32)
_Delay .25
_ScreenMove _Middle
Randomize Timer
'Usually used to give a point on 2D board a single name that has an X dimension and a Y dimension.
Type XY
X As Integer
Y As Integer
End Type
' SHARED variables for any version of SnakeBrain SUB to act as autoPilot for snake snake.
Dim Shared change As XY ' directs the head direction through AI or Human
Dim Shared head As XY ' leads the way of the snake(body) through snakepit
Dim Shared sLen ' length of snake
Dim Shared snake(1 To sqrsX * sqrsY) As XY ' whole snake, head is at index = sLen
Dim Shared fruit As XY ' as snake eats fruit it grows, object is to grow snake to fill snakepit
' SHARED for screenUpdate
Dim Shared pal(sqrsX * sqrsY) As _Unsigned Long ' for snake colors
'other data needed for program
Dim i, good, KEY$, r As Single, g As Single, b As Single
Dim autoPilot, hSpeed As Single, aSpeed As Single, saveChange As XY, title$
help ' Key Menu
hSpeed = 3: aSpeed = 20 ' autopilot speed is independent of human control speed
restart: ' reinitialize
r = .4 + Rnd * .6: g = r * .5 + Rnd * .4 - .2: b = .5 * r + Rnd * .4 - .2 ' rnd pal color vars
For i = 1 To sqrsX * sqrsY ' enough colors for snake to fill snakepit
pal(i) = _RGB32(84 + 64 * Sin(r + i / 2), 84 + 64 * Sin(g + i / 2), 104 * Sin(b + i / 2))
Next
head.X = sqrsX / 2 - 3: head.Y = sqrsY / 2 - 3 ' head start
fruit.X = sqrsX / 2 + 2: fruit.Y = sqrsY / 2 + 2 ' first fruit
sLen = 1 ' for starters snake is all head
snake(sLen).X = head.X: snake(sLen).Y = head.Y ' head is always at sLen end
autoPilot = 1 ' start snake body count
change.X = 0: change.Y = 1 ' head snake down board, Y direction of first fruit
Do
If autoPilot Then title$ = "AI." Else title$ = "human."
_Title Str$(sLen) + " Current driver is " + title$
Line (0, 0)-(xmax, ymax), &HFF884422, BF ' clear snakepit
If sLen = sqrsX * sqrsY - 1 Then screenUpdate: Exit Do ' game is won! start another
KEY$ = InKey$
If KEY$ = "q" Or KEY$ = Chr$(27) Then ' here is quit
End '
ElseIf KEY$ = "a" Then ' toggle autoPilot
autoPilot = 1 - autoPilot ' it is now up to AI to keep change updated for human take over
ElseIf KEY$ = "p" Then ' pause toggle p starts pause p ends pause
_KeyClear: While InKey$ <> "p": _Limit 60: Wend
ElseIf KEY$ = "s" Then
If autoPilot And aSpeed + 5 < 400 Then aSpeed = aSpeed + 5 'max autopilot speed is 400 !!!
If autoPilot = 0 And hSpeed + .5 < 10 Then hSpeed = hSpeed + .5 ' max human speed is 10
ElseIf KEY$ = "-" Then
If autoPilot And aSpeed - 5 > 0 Then aSpeed = aSpeed - 5
If autoPilot = 0 And hSpeed - .5 > 1 Then hSpeed = hSpeed - .5
End If ' '
If autoPilot Then ' who is piloting the snake?
saveChange.X = change.X: saveChange.Y = change.Y ' if AI screws up then human takes over
' PLUG-IN YOUR Snake Brain AI here
'=========================================================================== AI Auto Pilot
'snakeBrainBplus1 ' dumb track AI but always gets it's fruit! requires even # sqrsX
'snakeBrainBplus2 ' dumb track AI but looks cool! requirescustom sqrsX = 17, sqrsY = 16
'snakeBrainAshish1 ' first "realAI" I would call an heuristic approach, thanks Ashish!
'snakeBrainBplus3 ' bplus "first real AI" uses modified Pathfinder methods
snakeBrainBplus4 ' Trailblazer dont find a path, make a path pattern
'=========================================================================================
'check changes
If Abs(change.X) = 0 Then ' must have diffence in y's
If Abs(change.Y) <> 1 Then autoPilot = 0 ' error switch to human
ElseIf Abs(change.Y) = 0 Then
If Abs(change.X) <> 1 Then autoPilot = 0 ' error switch to human
Else ' must have a 0 in either change.x or change.y but not both
autoPilot = 0 ' error switch to human
End If
If autoPilot = 0 Then ' switching control over to human restore change values
change.X = saveChange.X: change.Y = saveChange.Y: Beep ' alert human
End If
Else ' ======================================================================= human control
If KEY$ = Chr$(0) + Chr$(72) Then ' up arrow
change.X = 0: change.Y = -1
ElseIf KEY$ = Chr$(0) + Chr$(80) Then ' down arrow
change.X = 0: change.Y = 1
ElseIf KEY$ = Chr$(0) + Chr$(77) Then ' right arrow
change.X = 1: change.Y = 0
ElseIf KEY$ = Chr$(0) + Chr$(75) Then ' left arrow
change.X = -1: change.Y = 0
End If
End If
head.X = head.X + change.X: head.Y = head.Y + change.Y ' OK human or AI have spoken
' ============================ check snake head with Rules: ===============================
' 1. Snakepit boundary check, snake hits wall, dies.
If head.X < 0 Or head.X > sqrsX - 1 Or head.Y < 0 Or head.Y > sqrsY - 1 Then
_Title _Trim$(Str$(sLen)) + " Wall Crash": screenUpdate: Exit Do ' wall crash, new game
End If
' 2. Snake eats body part, dies. This should kill snake if turn its head back on itself.
For i = 1 To sLen ' did head just crash into body?
If head.X = snake(i).X And head.Y = snake(i).Y Then
_Title _Trim$(Str$(sLen)) + " Body Crash": screenUpdate: Exit Do ' yes! start new game
End If
Next ' no
' 3. Eats Fruit and grows or just move every segment up 1 space.
If (fruit.X = head.X And fruit.Y = head.Y) Then ' snake eats fruit
sLen = sLen + 1
snake(sLen).X = head.X: snake(sLen).Y = head.Y 'assimilate fruit into head for new segment
Do 'check new apple
fruit.X = Int(Rnd * sqrsX): fruit.Y = Int(Rnd * sqrsY): good = -1
For i = 1 To sLen
If fruit.X = snake(i).X And fruit.Y = snake(i).Y Then good = 0: Exit For
Next
Loop Until good
Else
For i = 1 To sLen ' move the snake data down 1 dropping off last
snake(i).X = snake(i + 1).X: snake(i).Y = snake(i + 1).Y
Next
snake(sLen).X = head.X: snake(sLen).Y = head.Y ' and adding new head position
End If
screenUpdate ' on with the show this is it!
If autoPilot Then _Limit aSpeed Else _Limit hSpeed 'independent speed control for human and AI
Loop
Beep ' wake me up!
If sLen >= sqrsX * sqrsY - 1 Then _Delay 10 Else _Delay 4 ' win or loose, go again
GoTo restart:
Sub screenUpdate ' draw snake and fruit, overlap code debugger
Dim c~&, i, overlap(sqrsX, sqrsY)
For i = 1 To sLen
If i = sLen Then c~& = &HFF000000 Else c~& = pal(sLen - i)
' overlap helps debug duplicate square drawing which indicates a flawed code
overlap(snake(i).X, snake(i).Y) = overlap(snake(i).X, snake(i).Y) + 1
Line (snake(i).X * sq, snake(i).Y * sq)-Step(sq - 2, sq - 2), c~&, BF
If overlap(snake(i).X, snake(i).Y) > 1 Then 'show visually where code flaws effect display
LINE (snake(i).X * sq + .25 * sq, snake(i).Y * sq + .25 * sq)_
-STEP(.5 * sq - 2, .5 * sq - 2), &HFFFFFFFF, BF
End If
Next
Line (fruit.X * sq, fruit.Y * sq)-Step(sq - 2, sq - 2), _RGB32(255, 100, 255), BF
_Display
End Sub
Sub help
_PrintString (610, 20), "Keys:"
_PrintString (610, 40), "p toggles pause on/off"
_PrintString (610, 60), "a toggles autoPilot"
_PrintString (610, 100), "arrows control snake"
_PrintString (610, 80), "q or esc quits"
_PrintString (610, 120), "s increases speed"
_PrintString (610, 140), "- decreases speed"
_PrintString (610, 200), "A BEEP means AI error,"
_PrintString (610, 216), "human put in control"
_PrintString (610, 232), " or"
_PrintString (610, 248), "the run has finished."
End Sub
'basic functions added for snakeBrainBplus3 (bplus first real AI)
Function max (n, m)
If n > m Then max = n Else max = m
End Function
Function min (n, m)
If n < m Then min = n Else min = m
End Function
' ================================================================= end code that runs Snake Games
Sub snakeBrainBplus1 '>>>>>>>>>> B+ SNAKE BRAIN needs sqrsX to be even number <<<<<<<<<<<<<<<
' This will be handy for standard 20x20 snakepit to dove tail real AI towrds.
'todo fix this so that when takeover control won't crash into self
If sqrsX Mod 2 = 1 Then change.X = 0: change.Y = 0: Exit Sub ' throw error for code check to
' discover and switch to human control
If head.X = 0 And head.Y = sqrsY - 1 Then
change.X = 0: change.Y = -1
ElseIf head.X Mod 2 = 0 And head.Y <> 0 And head.Y <> sqrsY - 1 Then
change.X = 0: change.Y = -1
ElseIf head.X Mod 2 = 0 And head.Y = 0 And head.Y <> sqrsY - 1 Then
change.X = 1: change.Y = 0
ElseIf head.X Mod 2 = 1 And head.X <> sqrsX - 1 And head.Y = sqrsY - 2 Then
change.X = 1: change.Y = 0
ElseIf head.X Mod 2 = 1 And head.X <> sqrsX - 1 And head.Y < sqrsY - 1 Then
change.X = 0: change.Y = 1
ElseIf head.X = sqrsX - 1 And head.Y = sqrsY - 1 Then
change.X = -1: change.Y = 0
ElseIf head.Y = sqrsY - 1 And head.X <> 0 Then
change.X = -1: change.Y = 0
ElseIf head.X Mod 2 = 1 And head.Y = 0 And head.Y <> sqrsY - 1 Then
change.X = 0: change.Y = 1
ElseIf head.X = sqrsX - 1 And head.Y < sqrsY - 1 Then
change.X = 0: change.Y = 1
End If
End Sub
Sub snakeBrainBplus2 ' Needs custom sqrsX = 17, sqrsY = 16 This is mainly a novelty SUB for fun!
'A good AI will NOT require a custom sqrsX = 17, sqrsY = 16
If sqrsX <> 17 Or sqrsY <> 16 Then change.X = 0: change.Y = 0: Exit Sub ' throw error for code
' check to discover and switch to human control
Dim x, y, s$, direction$
Static brain2Directions(sqrsX - 1, sqrsY - 1) As String
If brain2Directions(0, 0) <> "R" Then GoSub loadBrain2Directions 'array not loaded yet so load
direction$ = brain2Directions(head.X, head.Y)
Select Case direction$
Case "U": change.X = 0: change.Y = -1
Case "D": change.X = 0: change.Y = 1
Case "L": change.X = -1: change.Y = 0
Case "R": change.X = 1: change.Y = 0
End Select
Exit Sub
loadBrain2Directions:
For y = 0 To sqrsY - 1
Read s$
For x = 0 To sqrsX - 1
brain2Directions(x, y) = Mid$(s$, x + 1, 1)
Next
Next
Return
Data RRRRRRRRRRRRRRRRD
Data UDLLLLLLLLLLLLLLD
Data UDRRRRRRRRRRRRDUD
Data UDUDLLLLLLLLLLDUD
Data UDUDRRRRRRRRDUDUD
Data UDUDUDLLLLLLDUDUD
Data UDUDUDRRRRDUDUDUD
Data UDUDUDUDLLDUDUDUD
Data UDUDUDUDRUDUDUDUD
Data UDUDUDUDULLUDUDUD
Data UDUDUDURRRRUDUDUD
Data UDUDUDULLLLLLUDUD
Data UDUDURRRRRRRRUDUD
Data UDUDULLLLLLLLLLUD
Data UDURRRRRRRRRRRRUD
Data ULULLLLLLLLLLLLLL
' note: I had the following lines in main code delares section in case OPTION _EXPLICIT
' started alerts about DIM the STATIC variable in main but not needed.
'
' I think OPTION _EXPLICIT requires next line but will make snakeBrainBplus2 self contained.
'DIM SHARED brain2Directions(0 TO sqrsX - 1, 0 TO sqrsY - 1) AS STRING ' 4 snakeBrainBplus2 AI
End Sub
Sub snakeBrainAshish1 'needs supplemental FUNCTION snakeBodyExists (which%)
Dim nx, ny, dx, dy 'Ashish AI
Static decided
Static state$ ' bplus added state$ to SUB here and removed from DIM SHARED in Main Declares
dx = fruit.X - head.X
dy = fruit.Y - head.Y
nx = snakeBodyExists(1)
ny = snakeBodyExists(2)
If sLen > 1 Then 'collison at corners of square
If head.X = 0 And head.Y = 0 Then
state$ = "corners"
If change.X = -1 Then change.X = 0: change.Y = 1: decided = 0: Exit Sub
If change.Y = -1 Then change.Y = 0: change.X = 1: decided = 0: Exit Sub
ElseIf head.X = 0 And head.Y = sqrsY - 1 Then
state$ = "corners"
If change.X = -1 Then change.X = 0: change.Y = -1: decided = 0: Exit Sub
If change.Y = 1 Then change.Y = 0: change.X = 1: decided = 0: decided = 0: Exit Sub
ElseIf head.X = sqrsX - 1 And head.Y = 0 Then
state$ = "corners"
If change.X = 1 Then change.X = 0: change.Y = 1: decided = 0: Exit Sub
If change.Y = -1 Then change.Y = 0: change.X = -1: decided = 0: Exit Sub
ElseIf head.X = sqrsX - 1 And head.Y = sqrsY - 1 Then
state$ = "corners"
If change.X = 1 Then change.X = 0: change.Y = -1: decided = 0: Exit Sub
If change.Y = 1 Then change.Y = 0: change.X = -1: decided = 0: Exit Sub
End If
If decided = 0 Then 'collision with walls
If head.X = sqrsX - 1 Or head.X = 0 Then
state$ = "walls"
If ny = 0 Then
If dy > 0 Then ny = -1 Else ny = 1
End If
change.Y = ny * -1: change.X = 0
decided = 1
Exit Sub
ElseIf head.Y = sqrsY - 1 Or head.Y = 0 Then
state$ = "walls"
If nx = 0 Then
If dx > 0 Then nx = -1 Else nx = 1
End If
change.X = nx * -1: change.Y = 0
decided = 1
Exit Sub
End If
End If
End If
If dx = 0 Then 'when fruit and head in same direction and motion in same axis
If change.Y = 0 Then
state$ = "linear"
If dy > 0 And ny <> 1 Then
change.Y = 1: change.X = 0: decided = 0: Exit Sub
ElseIf dy < 0 And ny <> -1 Then
change.Y = -1: change.X = 0: decided = 0: Exit Sub
End If
End If
End If
If dy = 0 Then
If change.X = 0 Then
state$ = "linear"
If dx > 0 And nx <> 1 Then
change.X = 1: change.Y = 0: decided = 0: Exit Sub
ElseIf dx < 0 And nx <> -1 Then
change.X = -1: change.Y = 0: decided = 0: Exit Sub
End If
End If
End If
state$ = "common"
'common decision
If Abs(dx) < Abs(dy) Then
state$ = "common ny=" + Str$(ny)
If ny = 0 Then
change.X = 0
If dy > 0 Then change.Y = 1 Else change.Y = -1
state$ = "common cy=" + Str$(change.Y)
Exit Sub
End If
If dy > 0 And ny <> 1 Then change.Y = 1: change.X = 0
If dy < 0 And ny <> -1 Then change.Y = -1: change.X = 0
decided = 0
Else
state$ = "common nx=" + Str$(nx)
If nx = 0 Then
change.Y = 0
If dx > 0 Then change.X = 1 Else change.X = -1
state$ = "common cx=" + Str$(change.X)
Exit Sub
End If
If dx > 0 And nx <> 1 Then change.X = 1: change.Y = 0
If dx < 0 And nx <> -1 Then change.X = -1: change.Y = 0
decided = 0
End If
state$ = "rand_common"
If Abs(dx) = Abs(dy) Then 'random choice will be made then, rest code is same as above
If Rnd > 0.5 Then
state$ = "rand_common ny=" + Str$(ny)
If ny = 0 Then
change.X = 0
If dy > 0 Then change.Y = 1 Else change.Y = -1
state$ = "rand_common cy=" + Str$(change.Y)
Exit Sub
End If
If dy > 0 And ny <> 1 Then change.Y = 1: change.X = 0
If dy < 0 And ny <> -1 Then change.Y = -1: change.X = 0
decided = 0
Else
state$ = "rand_common nx=" + Str$(nx)
If nx = 0 Then
change.Y = 0
If dx > 0 Then change.X = 1 Else change.X = -1
state$ = "rand_common cx=" + Str$(change.X)
Exit Sub
End If
If dx > 0 And nx <> 1 Then change.X = 1: change.Y = 0
If dx < 0 And nx <> -1 Then change.X = -1: change.Y = 0
decided = 0
End If
End If
End Sub
Function snakeBodyExists (which%) ' for SUB snakeBrainAshish1 supplemental
If sLen = 1 Then Exit Function
Dim n
For n = 1 To sLen - 1
If which% = 1 Then 'x-direction
If snake(n).X - head.X > 0 And snake(n).Y = head.Y Then snakeBodyExists = 1: Exit Function
If snake(n).X - head.X < 0 And snake(n).Y = head.Y Then snakeBodyExists = -1: Exit Function
ElseIf which% = 2 Then 'y-direction
If snake(n).Y - head.Y > 0 And snake(n).X = head.X Then snakeBodyExists = 1: Exit Function
If snake(n).Y - head.Y < 0 And snake(n).X = head.X Then snakeBodyExists = -1: Exit Function
End If
Next
End Function
Sub snakeBrainBplus3 ' real AI, responds to real time information
'needs FUNCTION max (n , m ), FUNCTION min (n , m )
'from: Pathfinder inside Maze.bas B+ 2019-12-19 only completely overhauled!
Dim x, y, i, changeF
Dim parentF, tick, foundHead, headMarked
Dim yStart, yStop, xStart, xStop
Dim map(sqrsX - 1, sqrsY - 1) As String, map2(sqrsX - 1, sqrsY - 1) As String
For y = 0 To sqrsY - 1
For x = 0 To sqrsX - 1
map(x, y) = " "
Next
Next
For i = 1 To sLen - 1 ' draw snake in map
map(snake(i).X, snake(i).Y) = "S"
Next
map(head.X, head.Y) = "H"
map(fruit.X, fruit.Y) = "F"
tick = 0
While parentF Or headMarked = 0
parentF = 0: tick = tick + 1
yStart = max(fruit.Y - tick, 0): yStop = min(fruit.Y + tick, sqrsY - 1)
ReDim map2(sqrsX - 1, sqrsY - 1) As String ' need a 2nd map to hold all new stuff until
For y = 0 To sqrsY - 1 ' the entire square coverd
For x = 0 To sqrsX - 1
map2(x, y) = " "
Next
Next
For y = yStart To yStop
xStart = max(fruit.X - tick, 0): xStop = min(fruit.X + tick, sqrsX - 1)
For x = xStart To xStop
'check out the neighbors
If map(x, y) = " " Or map(x, y) = "H" Then
If map(x, y) = "H" Then foundHead = -1
If y - 1 >= 0 Then
If InStr("UDLRF", map(x, y - 1)) Then
map2(x, y) = "U": parentF = 1
If foundHead Then headMarked = -1
End If
End If
If y + 1 <= sqrsY - 1 Then
If InStr("UDLRF", map(x, y + 1)) Then
map2(x, y) = "D": parentF = 1
If foundHead Then headMarked = -1
End If
End If
If x + 1 <= sqrsX - 1 Then
If InStr("UDLRF", map(x + 1, y)) Then
map2(x, y) = "R": parentF = 1
If foundHead Then headMarked = -1
End If
End If
If x - 1 >= 0 Then
If InStr("UDLRF", map(x - 1, y)) Then
map2(x, y) = "L": parentF = 1
If foundHead Then headMarked = -1
End If
End If
End If
Next
Next
For y = 0 To sqrsY - 1 'transfer data to map
For x = 0 To sqrsX - 1
If map2(x, y) <> " " Then map(x, y) = map2(x, y): changeF = 1
Next
Next
Wend 'if no ParentF then dead connection to Fruit
Select Case map(head.X, head.Y)
Case "H" ' cause crash because no connection to fruit found
If change.X Then change.X = -change.X Else change.Y = -change.Y ' make Body crash
Case "D": change.X = 0: change.Y = 1
Case "U": change.X = 0: change.Y = -1
Case "R": change.X = 1: change.Y = 0
Case "L": change.X = -1: change.Y = 0
End Select
End Sub
Sub snakeBrainBplus4 ' Trailblazer dump Pathfinder and set a path pattern so no finding needed!
Static xLim, yLim, dat$(sqrsX - 1, sqrsY - 1), trackON
Dim x, y, bodyStack, yHeadLimit
xLim = sqrsX - 1: yLim = sqrsY - 1
If sLen < 2 Then trackON = 0 ' in case of crash turn off trackON
If dat$(0, 0) <> "D" Then GoSub setupdat ' haven't been here yet
bodyStack = Int(sLen / (2 * xLim)) ' these are rounded down so be careful to build in slack
yHeadLimit = yLim - bodyStack * 2 + 1 ' + 1 because bodystack is rounded down
If head.X = 0 And head.Y = yHeadLimit Then trackON = -1
If head.X = 0 And head.Y = yHeadLimit - 1 Then trackON = -1
If head.X = 0 And head.Y = yHeadLimit - 2 Then trackON = -1
If head.X = xLim And head.Y = yHeadLimit - 1 Then
If sLen <= sqrsX * sqrsY - 2 * bodyStack Then trackON = 0
End If
If sLen > sqrsX * sqrsY - 2 * bodyStack Then trackON = -1 ' finish last 2 bodystacks in track
If trackON Then ' take orders for safe coil stacking track
Select Case dat$(head.X, head.Y)
Case "D": change.X = 0: change.Y = 1
Case "U": change.X = 0: change.Y = -1
Case "R": change.X = 1: change.Y = 0
Case "L": change.X = -1: change.Y = 0
End Select
Else ' this is the: left down, bottom right, right up, left to fruit and left down... pattern
If head.X = 0 Then ' left side
If head.Y <> yLim Then
change.X = 0: change.Y = 1
Else
change.X = 1: change.Y = 0
End If
ElseIf head.X >= 1 And head.X < xLim Then ' middle rows, left or right including edges
If head.Y = yLim Then
change.X = 1: change.Y = 0 ' bottom row
Else
change.X = -1: change.Y = 0 ' row bearing fruit or top
End If
ElseIf head.X = xLim Then ' right column going up to fruit height
If head.Y = 0 Then
change.X = -1: change.Y = 0 ' here we must turn left
ElseIf head.Y = fruit.Y And fruit.Y < yLim Then ' ah! fruit bearing row not at bottom
change.X = -1: change.Y = 0
Else
change.X = 0: change.Y = -1 ' keep going up
End If
End If
End If
Exit Sub
' This sets up a track pattern to follow until the coils have been safely stacked enough to
' break away and catch fruit.
setupdat:
For y = 0 To yLim
For x = 0 To xLim
If x = 0 And y <> yLim Then ' left side
dat$(x, y) = "D"
ElseIf x = 0 And y = yLim Then ' bottom, left corner
dat$(x, y) = "R"
ElseIf x <> xLim And y = yLim Then ' bottom row
dat$(x, y) = "R"
ElseIf x = xLim And y Mod 2 = 1 Then ' right side up odd
dat$(x, y) = "U"
ElseIf x = xLim And y Mod 2 = 0 Then ' right side left even
dat$(x, y) = "L"
ElseIf y Mod 2 = 0 And x = 1 And y <> 0 Then ' left coil even turn up
dat$(x, y) = "U"
ElseIf y Mod 2 = 0 And x = 1 And y = 0 Then ' left coil even on top row
dat$(x, y) = "L"
ElseIf y Mod 2 = 1 And x <> 1 Then ' coil odd row
dat$(x, y) = "R"
ElseIf y Mod 2 = 1 And x = 1 And y <> yLim Then 'coil odd row
dat$(x, y) = "R"
ElseIf y Mod 2 = 0 And x <> 1 Then ' coil even
dat$(x, y) = "L"
ElseIf y Mod 2 = 0 And x = 1 Then ' coil even
dat$(x, y) = "R"
End If
Next
Next
Return
End SubAnd so the snake never dies until the screen is full of it!