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 x (item y GameBoard)
end

to SetBoardSquare x y value
   setitem x (item y GameBoard) value
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 * (X - GameBoardWidth  / 2)
         GridSize * (Y - GameBoardHeight / 2)
   pendown
end

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

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

to fillBlock X Y
   MoveToGrid_LowerLeft X Y
   setHeading 0
   fillRect [0 0] list GridSize GridSize
   setPenColor FloodColor
   repeat 4 [forward GridSize-1 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
   TotalApples= TotalApples + 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 [j 1 GameBoardHeight ]
   [   ; add a new array for this row
      row=Array GameBoardWidth

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

         ; put a border around the game board
         if (or (j == 1)
         (j == GameBoardHeight)
         (i == 1)
         (i == 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 [j 1 GameBoardHeight ]
   [   gameboard_row=Item j GameBoard
      for [i 1 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 1 tail) (item 2 tail)

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

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

   ; 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 [j 1 GameBoardHeight ]
      [   gameboard_row=Item j GameBoard
         for [i 1 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 1 ]
   [   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 3 [forward GridSize - 1 right 120]
   ]
   if Direction == "left
   [   MoveToGrid_LowerRight SnakeX SnakeY
      setheading 0
      repeat 3 [forward GridSize - 1 left 120]
   ]
   if Direction == "up
   [   MoveToGrid_LowerLeft SnakeX SnakeY
      setheading 90
      repeat 3 [forward GridSize - 1 left 120]
   ]
   if Direction == "down
   [   MoveToGrid_UpperLeft SnakeX SnakeY
      setheading 90
      repeat 3 [forward GridSize - 1 right 120]
   ]
end

to UpdateNextFrame ; handles a single game tick
   if TotalApples == 0
   [   repeat 5 [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