Dim matrix(7)
row = 7

' The font contains 128 - 21 = 107 glyphs, each taking 3 bytes = 321 bytes
' Each float element of the array is 4 bytes => 81 * 4 = 324 bytes
Dim font4x6(80)

Dim snake(63)
demo = 0
diff = 1

UP = -8 : RIGHT = 1 : DOWN = 8 : LEFT = -1: SELECT = 10 : START = 20

Mode 2, 3
Cls

Print "SNAKE - Tom Williams 2020"
Print "Cursor keys to move"
Print "S to START"
Print "D to SELECT difficulty"

load_font()
matrix_init()

SetTick 1, matrix_draw
On Key on_key

main_loop()
End

Sub main_loop()
 Do
   matrix_clear()
   game_intro()
   game_init()
   game_loop()
   die()
 Loop
End Sub

Sub game_intro()
 Local s$

 s$ = "SNAKE-Press START or SELECT to increase difficulty-Tom Williams 2020"

 Do
   If cmd = SELECT Then
     diff = 1 + diff Mod 4
     scroll_text(Str$(diff))
   Else
     scroll_text(s$)
     If cmd = 0 Then demo = 1 : cmd = START
   EndIf
 Loop Until cmd <> 0 And cmd <> SELECT
End Sub

Sub game_init()
 Local i

 For i = 0 To 63: snake(i) = 0 : Next i
 snake(0) = 35
 head = 0
 tail = 0
 dir = UP
 pill = 0
 score = 0
 cmd = 0
 matrix_set(snake(head), 1)
 place_pill()
End Sub

Sub game_loop()
 Local p

 Do
   Pause (5 - diff) * 50

   If cmd <> 0 And cmd < 10 Then dir = cmd : cmd = 0
   If demo Then demo_ai()

   If will_die() Then Exit Sub

   p = snake(head) + dir
   head = (head + 1) Mod 64
   snake(head) = p
   matrix_set(p, 1)

   If p <> pill Then
     matrix_set(snake(tail), 0)
     tail = (tail + 1) Mod 64
   Else
     score = score + 1
     pill = -5
   EndIf

   If pill = -1 Then place_pill()
   If pill < -1 Then pill = pill + 1
 Loop

End Sub

Sub demo_ai()
 Local c, p, r

 p = snake(head)
 c = p Mod 8
 r = p \ 8

 If r = pill \ 8 Then
   If pill < p Then dir = LEFT
   If pill > p Then dir = RIGHT
 ElseIf c = pill Mod 8 Then
   If pill < p Then dir = UP
   If pill > p Then dir = DOWN
 ElseIf pill < p Then
   dir = UP
 Else
   dir = down
 EndIf

 If will_die() Then If (r > 3) Then dir = UP Else dir = DOWN
 If will_die() Then If (c > 3) Then dir = LEFT Else dir = RIGHT
 If will_die() Then If (r > 3) Then dir = DOWN Else dir = UP
 If will_die() Then If (c > 3) Then dir = RIGHT Else dir = LEFT

End Sub

Function will_die()
 Local p

 p = snake(head)

 If dir = UP And p < 8 Then
    will_die = 1
 ElseIf dir = DOWN And p > 55 Then
    will_die = 1
 ElseIf dir = LEFT And p Mod 8 = 0 Then
    will_die = 1
 ElseIf dir = RIGHT And p Mod 8 = 7 Then
    will_die = 1
 ElseIf matrix_get(p + dir) And (p + dir) <> pill Then
    will_die = 1
 EndIf

End Function

Sub die()
 Local i, j
 For i = 1 To 4
   matrix_fill()
   Pause 300
   matrix_clear()
   Pause 300
 Next i
 scroll_text("GAME OVER Score:" + Str$(score))
End Sub

Sub place_pill()
 pill = Int(Rnd() * 64)
 If matrix_get(pill) = 0 Then
   matrix_set(pill, 1)
 Else
   pill = -1
 EndIf
End Sub

Sub on_key()
 Local k

 k = KeyDown

 If k = &h64 Then
   cmd = SELECT
 ElseIf k = &h73 Then
   cmd = START
 ElseIf k = &h80 Then
   cmd = UP
 ElseIf k = &h81 Then
   cmd = DOWN
 ElseIf k = &h82 Then
   cmd = LEFT
 ElseIf k = &h83 Then
   cmd = RIGHT
 EndIf
End Sub

Sub matrix_init()
 Local i
 For i = 1 To 8 : SetPin i, dout : Next i
 For i = 11 To 18 : SetPin i, dout : Next i
 matrix_clear()
End Sub

Sub matrix_clear()
 Local i
 For i = 0 To 7 : matrix(i) = 0 : Next i
End Sub

Sub matrix_fill()
 Local i
 For i = 0 To 7 : matrix(i) = &hFF : Next i
End Sub

Function matrix_get(p)
 matrix_get = (matrix(p \ 8) And 2^(p Mod 8)) > 0
End Function

Sub matrix_set(p, x)
 matrix(p \ 8) = matrix(p \ 8) And (&hFF Xor 2^(p Mod 8)) Or x * 2^(p Mod 8)
End Sub

Sub matrix_left()
 Local i
 For i = 0 To 7 : matrix(i) = matrix(i) \ 2 And &hFF : Next i
End Sub

' Pins 1-8 source the columns.
' Pins 11-18 sink the rows.
Sub matrix_draw()
 row = (row + 1) Mod 8
 Port(1, 8, 11, 8) = &hFF00
 Port(1, 8, 11, 8) = matrix(row) Or &hFF00 - 2 ^ (row + 8)
End Sub

Sub load_font()
 Local end, height, i, j, s$, start, x, width

 Open "tt4x6.fnt" For Input As #1

 Input #1, height, width, start, end
 If height <> 6 Then Error
 If width <> 4  Then Error
 If start <> 20 Then Error
 If end <> 126  Then Error

 For i = 0 To (end - start) ' Iterate over glyphs
   For j = 0 To 5 Step 2 ' Iterate over rows, 2 at a time
     x = 0
     Line Input #1, s$
     If Len(s$) <> width Then Error
     If Peek(Var s$, 1) > 32 Then x = x Or &b00000001
     If Peek(Var s$, 2) > 32 Then x = x Or &b00000010
     If Peek(Var s$, 3) > 32 Then x = x Or &b00000100
     If Peek(Var s$, 4) > 32 Then x = x Or &b00001000
     Line Input #1, s$
     If Len(s$) <> width Then Error
     If Peek(Var s$, 1) > 32 Then x = x Or &b00010000
     If Peek(Var s$, 2) > 32 Then x = x Or &b00100000
     If Peek(Var s$, 3) > 32 Then x = x Or &b01000000
     If Peek(Var s$, 4) > 32 Then x = x Or &b10000000
     Poke Var font4x6(0), i * 3 + j \ 2, x
   Next j
 Next i
 Close #1
End Sub

Sub scroll_text(s$)
 Local c, ch, i

 cmd = 0
 For i = 1 To Len(s$)
   ch = Peek(Var s$, i)
   For c = 0 To 3
     ' Poor man's proportional spacing.
     If c = 0 And ch = 105 Then c = 1
     If c = 2 And ch = 105 Then c = 3
     If c = 1 And ch = 32  Then c = 4
     blit_font(Peek(Var s$, i), c)
     Pause 150
     matrix_left()
   Next c
   If cmd <> 0 Then i = Len(s$)
 Next i
 For i = 1 To 7 : Pause 100 : matrix_left() : Next i
End Sub

' Copies column 'c' of glyph 'a' to the last column of the matrix.
Sub blit_font(a, c)
 Local x, i, p, s

 p = 7
 s = (a - 20) * 3
 For i = s To s + 2
   x = Peek(Var font4x6(0), i)
   p = p + 8
   matrix_set(p, (x And 2^c) > 0)
   p = p + 8
   matrix_set(p, (x And 2^(c + 4)) > 0)
 Next i
End Sub