Post by bplus on Jun 28, 2024 15:53:36 GMT -5
This is dumbest Smart Snake, I've made because it covers every square of whole fields before cycling back and doing it again.
But it is Smart because it never crashes into wall or itself and always gets the fruit!
THUS it eventually fills the whole field with it's body.
Did you ever see that in all your BASIC experience?
So you think you can make a Smarter snake? create your own plug-in code for Snake Brain!
BONUS: the snake has pretty colors
But it is Smart because it never crashes into wall or itself and always gets the fruit!
THUS it eventually fills the whole field with it's body.
Did you ever see that in all your BASIC experience?
Option _Explicit
_Title "Snake AI-1_3 wRules" 'b+ 2020-03-17
'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.
'snakepit constraints Snake Brain currently needs sqrsX to be even
Const sq = 20, sqrsX = 20, sqrsY = 20, xmax = sq * sqrsX, ymax = sq * sqrsY
Screen _NewImage(800, 600, 32)
_Delay .25
_ScreenMove _Middle
Randomize Timer
'teach UDV
Type XY
X As Integer
Y As Integer
End Type
'shared for screenUpdate
Dim Shared fruit As XY, snake(1 To sqrsX * sqrsY) As XY, sLen As Integer '< sLen = length of snake
Dim Shared overlap(sqrsX, sqrsY) As Integer, pal(sqrsX * sqrsY) As _Unsigned Long, head As XY
'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, dx As Integer, dy As Integer, hSpeed, aSpeed
help
hSpeed = 3: aSpeed = 20
restart: 'reinitialize
r = .3 + Rnd * .7: g = r * .5 + Rnd * .3 - .15: b = .5 * r + Rnd * .3 - .15
For i = 1 To sqrsX * sqrsY
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 - 2: head.Y = sqrsY / 2 - 2
fruit.X = sqrsX / 2 + 2: fruit.Y = sqrsY / 2 + 2
sLen = 1
snake(sLen).X = head.X: snake(sLen).Y = head.Y
autoPilot = 1
dx = 0: dy = 1
Do
_Title Str$(sLen)
Line (0, 0)-(xmax, ymax), &HFF884422, BF 'clear snakepit
If sLen = sqrsX * sqrsY - 1 Then screenUpdate: Exit Do
KEY$ = InKey$
If KEY$ = "q" Or KEY$ = Chr$(27) Then ' here is quit
End '
ElseIf KEY$ = "a" Then ' toggle autoPilot
autoPilot = 1 - autoPilot
If autoPilot = 0 Then 'try to handover to human without immdeiate body crash
dx = 0: If head.X Mod 2 Then dy = 1 Else dy = -1
End If
ElseIf KEY$ = "p" Then ' pause
_KeyClear
While InKey$ <> "p": _Limit 60: Wend
ElseIf KEY$ = "s" Then
If autoPilot And aSpeed + 5 < 400 Then aSpeed = aSpeed + 5
If autoPilot = 0 And hSpeed + .5 < 10 Then hSpeed = hSpeed + .5
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?
' PLUG-IN YOUR Snake Brain AI here
'=========================================================================== AI Auto Pilot
snakeBrain
'=========================================================================================
Else ' '======================================================================= human control
If KEY$ = Chr$(0) + Chr$(72) Then ' up arrow
dx = 0: dy = -1
ElseIf KEY$ = Chr$(0) + Chr$(80) Then ' down arrow
dx = 0: dy = 1
ElseIf KEY$ = Chr$(0) + Chr$(77) Then ' right arrow
dx = 1: dy = 0
ElseIf KEY$ = Chr$(0) + Chr$(75) Then ' left arrow
dx = -1: dy = 0
End If
head.X = head.X + dx: head.Y = head.Y + dy
End If
' 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
End If
' 2. Snake eats body part, dies. This should kill snake if turn its head back on itself.
For i = 1 To sLen 'start 1 up from tail segment about to be dropped
If head.X = snake(i).X And head.Y = snake(i).Y Then
_Title _Trim$(Str$(sLen)) + " Body Crash": screenUpdate: Exit Do
End If
Next
' 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 apple
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
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
End If
screenUpdate
If autoPilot Then
'IF sLen < 80 THEN _LIMIT 40 ELSE _LIMIT 10
_Limit aSpeed
Else
_Limit hSpeed
End If
Loop
_Delay 3
GoTo restart:
Sub screenUpdate ' draw snake and fruit, overlap code debugger
Dim c~&, i As Integer
Erase overlap
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
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 snakeBrain '>>>>>>>>>> B+ SNAKE BRAIN needs sqrsX to be even number <<<<<<<<<<<<<<<
If head.X = 0 And head.Y = sqrsY - 1 Then
head.Y = head.Y - 1
ElseIf head.X Mod 2 = 0 And head.Y <> 0 And head.Y <> sqrsY - 1 Then
head.Y = head.Y - 1
ElseIf head.X Mod 2 = 0 And head.Y = 0 And head.Y <> sqrsY - 1 Then
head.X = head.X + 1
ElseIf head.X Mod 2 = 1 And head.X <> sqrsX - 1 And head.Y = sqrsY - 2 Then
head.X = head.X + 1
ElseIf head.X Mod 2 = 1 And head.X <> sqrsX - 1 And head.Y < sqrsY - 1 Then
head.Y = head.Y + 1
ElseIf head.X = sqrsX - 1 And head.Y = sqrsY - 1 Then
head.X = head.X - 1
ElseIf head.Y = sqrsY - 1 And head.X <> 0 Then
head.X = head.X - 1
ElseIf head.X Mod 2 = 1 And head.Y = 0 And head.Y <> sqrsY - 1 Then
head.Y = head.Y + 1
ElseIf head.X = sqrsX - 1 And head.Y < sqrsY - 1 Then
head.Y = head.Y + 1
End If
End Sub
Sub help
_PrintString (600, 20), "Keys:"
_PrintString (600, 40), "p toggles pause on/off"
_PrintString (600, 60), "a toggles autoPilot"
_PrintString (600, 100), "arrows control snake"
_PrintString (600, 80), "q or esc quits"
_PrintString (600, 120), "s increases speed"
_PrintString (600, 140), "- decreases speed"
End Sub
So you think you can make a Smarter snake? create your own plug-in code for Snake Brain!
BONUS: the snake has pretty colors
