aUCBLogo Demos and Tests / snake


to snake
    
; written by David Costanzo
    ;
    ; The author disclaims all copyrights associated with this code (hereafter
    ; referred to as the "Work").
    ;
    ; The author makes this dedication for the benefit of the public at large
    ; and to the detriment of the author's heirs and successors. The author
    ; intends this dedication to be an overt act of relinquishment in
    ; perpetuity of all present and future rights under copyright law,
    ; whether vested or contingent, in the Work. The author understands that
    ; such relinquishment of all rights includes the relinquishment of all
    ; rights to enforce (by lawsuit or otherwise) those copyrights in the
    ; Work.
    ;
    ; The author recognizes that, once placed in the public domain, the
    ; Work may be freely reproduced, distributed, transmitted, used,
    ; modified, built upon, or otherwise exploited by anyone for any
    ; purpose, commercial or non-commercial, and in any way, including by
    ; methods that have not yet been invented or conceived.
   
clearscreen
   
hideturtle
   
ConsoleSetfocus
   
GameLoop
end

to GetBoardSquare x y
   
output item (item y GameBoard)
end

to SetBoardSquare x y value
   
setitem (item y GameBoardvalue
end

to BoardSquareIsBlocked x y
   
local "square
   
square=GetBoardSquare x y
   
output (or (:square == "X) (:square == "S) )
end

to MoveToGrid_LowerLeft X Y
   
penup
   
setxy    GridSize * (GameBoardWidth  2)
         
GridSize * (GameBoardHeight 2)
   
pendown
end

to MoveToGrid_LowerRight X Y
   
penup
   
setxy    GridSize * (GameBoardWidth  2) - 1
         
GridSize * (Y     GameBoardHeight 2)
   
pendown
end

to MoveToGrid_UpperLeft X Y
   
penup
   
setxy    GridSize * (X     GameBoardWidth  2)
         
GridSize * (GameBoardHeight 2) - 1
   
pendown
end

to fillBlock X Y
   
MoveToGrid_LowerLeft X Y
   
setHeading 0
   
fillRect [0 0list GridSize GridSize
   
setPenColor FloodColor
   
repeat [forward GridSize-right 90]
end

to EraseGrid X Y
   
setfloodcolor screencolor
   
fillBlock X Y
end

to DrawWall X Y
   
setfloodcolor 0
   
fillBlock X Y
end

to DrawApple X Y
   
setfloodcolor RGB 1 0 0
   
fillBlock X Y
end

to PlaceApple
   
; places an apple randomly in an open space.
   
local [applex appley appleisplaced foundopenspace]
   
; randomly select places on the game board
   ; until we find an open one
   
foundopenspace=false
   
while [not foundopenspace]
   
[   AppleX=(random GameBoardWidth  2) + 2
      
AppleY=(random GameBoardHeight 2) + 2

      
if (GetBoardSquare AppleX AppleY) == ".
      
[   foundopenspace=true
      
]
   
]
   
; place the apple
   
SetBoardSquare AppleX AppleY "A
   
TotalApplesTotalApples 1
   
DrawApple AppleX AppleY
end

to InitGameBoard
   
local [row boardsquare]
   
; copy the game board template to the live game board
   
GameBoardWidth=40
   
GameBoardHeight=40

   
GameBoard=Array GameBoardHeight
   
for [GameBoardHeight ]
   
[   ; add a new array for this row
      
row=Array GameBoardWidth

      
for [GameBoardWidth]
      
[   ; the game board starts off as an empty space
         
boardsquare=".

         
; put a border around the game board
         
if (or (== 1)
         
(== GameBoardHeight)
         
(== 1)
         
(== GameBoardWidth))
         
[   boardsquare="X
         
]
         
setitem i row boardsquare
      
]
      
; set this row in the game board
      
setitem j GameBoard row
   
]
end

to DrawGameBoard
   
local [gameboard_row boardsquare]
   
; now draw the game board
   
for [GameBoardHeight ]
   
[   gameboard_row=Item j GameBoard
      
for [GameBoardWidth ]
      
[   boardsquare=Item i gameboard_row
         
if boardsquare == "X
         
[   DrawWall i j
         
]
         
if boardsquare == "A
         
[   DrawApple i j
         
]
      
]
   
]
end

to UpKey
   
if not Direction == "down [NextDirection="up]
end

to DownKey
   
if not Direction == "up [NextDirection="down]
end

to LeftKey
   
if not Direction == "right [NextDirection="left]
end

to RightKey
   
if not Direction == "left [NextDirection="right ]
end

to ProcessKeyEvent Key
   
if Key==WXK_UP     [UpKey    ]
   
if Key==WXK_LEFT   [LeftKey  ]
   
if Key==WXK_RIGHT  [RightKey ]
   
if Key==WXK_DOWN   [DownKey  ]
   
if Key==WXK_ESCAPE [IsDone=true]
end

to StartKeyboardCapture
   
OnKeyDown [ProcessKeyEvent keyboardvalue]
   
OnChar [ch=readChar]
end

to EndKeyboardCapture
   
OnKeyDown []
   
OnChar []
end

to Move
   
; push the current position onto the list
   
queue "SnakeBody (list SnakeX SnakeY)
   
; mark the space as filled
   
SetBoardSquare SnakeX SnakeY "S

   
if MaxSnakeLength count SnakeBody
   
[   local [tail]
      
tail=dequeue "SnakeBody
      
EraseGrid (item tail) (item tail)

      
; mark the space as empty
      
SetBoardSquare  (item tail) (item tail".
   
]
   
; move the snake
   
Direction=NextDirection

   
if Direction == "left  [SnakeX=SnakeX ]
   
if Direction == "right [SnakeX=SnakeX ]
   
if Direction == "down  [SnakeY=SnakeY ]
   
if Direction == "up    [SnakeY=SnakeY ]

   
; eat the apple, if we're over it
   
if (GetBoardSquare SnakeX SnakeY) == "A
   
[   Score=Score 1
      
MaxSnakeLength=MaxSnakeLength 5
      
TotalApples=TotalApples    1
   
]
end

to CheckIfDead
   
; if the square is blocked by something other than this player's head
   
if BoardSquareIsBlocked SnakeX SnakeY
   
[   ; just died
      
IsAlive=false
      
stop
      
; remove the player's trail from the board
      
for [GameBoardHeight ]
      
[   gameboard_row=Item j GameBoard
         
for [GameBoardWidth ]
         
[   boardsquare=item i gameboard_row
            
if boardsquare == "S
            
[   ; this is the dead player's trail.
               ; remove it by setting it to an empty space
               
setitem i gameboard_row ".
               
EraseGrid i j
            
]
         
]
      
]
   
]
end

to PrintGameBoard
   
; prints the game board to the commander console
   
for [j GameBoardHeight ]
   
[   print item j GameBoard
   
]
end

to DrawBody
   
if IsAlive
   
[   setPenColor BoardColor
      
DrawHead
      
setfloodcolor SnakeColor
      
fillBlock SnakeX SnakeY
   
]
end

to DrawHead
   
if Direction == "right
   
[   MoveToGrid_LowerLeft SnakeX SnakeY
      
setheading 0
      
repeat [forward GridSize right 120]
   
]
   
if Direction == "left
   
[   MoveToGrid_LowerRight SnakeX SnakeY
      
setheading 0
      
repeat [forward GridSize left 120]
   
]
   
if Direction == "up
   
[   MoveToGrid_LowerLeft SnakeX SnakeY
      
setheading 90
      
repeat [forward GridSize left 120]
   
]
   
if Direction == "down
   
[   MoveToGrid_UpperLeft SnakeX SnakeY
      
setheading 90
      
repeat [forward GridSize right 120]
   
]
end

to UpdateNextFrame ; handles a single game tick
   
if TotalApples == 0
   
[   repeat [PlaceApple]
   
]
   
DrawBody   ; replace the old head with the color of the body
   
Move      ; move the snake
   
setpencolor SnakeColor
   
DrawHead   ; draw the snake
   
CheckIfDead   ; remove the dead snakes
   
if not IsAlive
   
[   IsDone=true
   
]
   
updateGraph
end

to GameLoop
   
local [GameBoard GridSize GameBoardWidth GameBoardHeight
      
BoardColor SnakeColor]
   
GridSize=14
   
GameBoardWidth=40
   
GameBoardHeight=40
   
BoardColor=RGB 1 1 1
   
SnakeColor=RGB 0 .8 0
   
disableLineSmooth

   
InitGameBoard
   
local [IsAlive IsDone
      
SnakeBody MaxSnakeLength
      
SnakeX SnakeY
      
Score TotalApples
      
Direction NextDirection]
   
IsAlive=true
   
SnakeBody=[]
   
MaxSnakeLength=10
   
SnakeX=10
   
SnakeY=10
   
Score=0
   
TotalApples=0

   
Direction="right
   
NextDirection="right

   
DrawHead
   
DrawGameBoard
   
StartKeyboardCapture

   
IsDone=false
   
while not IsDone ]
   
[   UpdateNextFrame
      
waitMS 150
      
DispatchMessages
   
]
   
EndKeyboardCapture
   
(print "Game Over.  Score = Score)
end