aUCBLogo Demos and Tests / snakes

to snakes
   ; 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 BoardSquareIsBlocked x y
   local [square]
   square=GetBoardSquare x y
   output (or (:square == "X) (numberp :square) )
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
         ]
      ]
   ]
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 DrawWall X Y
   setfloodcolor 0
   fillBlock X Y
end

to EraseGrid X Y
   setfloodcolor screencolor
   fillBlock X Y
end

to GameLoop
   local [GameBoardTemplate GameBoard GameBoardWidth GameBoardHeight]
   local [Player1 Player2 Player3 Player4  GridSize]
   GridSize=11

   disableLineSmooth
   InitGameBoard

   Player_MarkHeadPosition Player1
   Player_MarkHeadPosition Player2
   Player_MarkHeadPosition Player3
   Player_MarkHeadPosition Player4

   Player_DrawHead Player1
   Player_DrawHead Player2
   Player_DrawHead Player3
   Player_DrawHead Player4

   Player_MarkPosition Player1
   Player_MarkPosition Player2
   Player_MarkPosition Player3
   Player_MarkPosition Player4

   DrawGameBoard

   StartKeyboardCapture

   local [IsDone]
   IsDone="false
   while [ not IsDone ]
   [   UpdateNextFrame
      waitMS 150
      dispatchMessages
   ]
   if Player_IsAlive Player1 [ (print Player_Name Player1 "Wins) ]
   if Player_IsAlive Player2 [ (print Player_Name Player2 "Wins) ]
   if Player_IsAlive Player3 [ (print Player_Name Player3 "Wins) ]
   if Player_IsAlive Player4 [ (print Player_Name Player4 "Wins) ]

   if (and (not Player_IsAlive Player1)
         (not Player_IsAlive Player2)
         (not Player_IsAlive Player3)
         (not Player_IsAlive Player4))
   [   print [No one wins]
   ]
   EndKeyboardCapture
end

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

to InitGameBoard
   local [gameboardtemplate_row row_array boardsquare]

   GameBoardTemplate=
   {
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
X....................................................................X
X....................................................................X
X....................................................................X
X....................................................................X
X....................................................................X
X...........1............................................4...........X
X....................................................................X
X....................................................................X
X....................................................................X
X.................................X..................................X
X.................................X..................................X
X.................................X..................................X
X.................................X..................................X
X.................................X..................................X
X.................................X..................................X
X.................................X..................................X
X.................................X..................................X
X.................................X..................................X
X....................XXXXXXXXXXXXXXXXXXXXXXXXXXX.....................X
X.................................X..................................X
X.................................X..................................X
X.................................X..................................X
X.................................X..................................X
X.................................X..................................X
X.................................X..................................X
X.................................X..................................X
X.................................X..................................X
X.................................X..................................X
X....................................................................X
X....................................................................X
X....................................................................X
X....................................................................X
X...........3............................................2...........X
X....................................................................X
X....................................................................X
X....................................................................X
X....................................................................X
X....................................................................X
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   }

   ; Index, Name, X, Y, Direction, Next Direction, Color, IsHuman, IsAlive
   Player1={1 Red    0 0 right right [1  0  0] false false}
   Player2={2 Green  0 0 right right [0  1  0] false false}
   Player3={3 Blue   0 0 right right [0  0  1] false false}
   Player4={4 Brown  0 0 right right [.5 .5 0] false false}

   ; copy the game board template to the live game board
   GameBoardWidth=0
   GameBoardHeight= count GameBoardTemplate

   GameBoard=array GameBoardHeight
   for [j 1 GameBoardHeight ]
   [   gameboardtemplate_row=item j GameBoardTemplate

      ; add a new array for this row
      row_array=array count gameboardtemplate_row

      ; update the board width
      if GameBoardWidth < (count gameboardtemplate_row)
      [   GameBoardWidth=(count gameboardtemplate_row)
      ]
      for [i 1 [count gameboardtemplate_row] ]
      [   boardsquare=item i gameboardtemplate_row
         setitem i row_array boardsquare

         if boardsquare == "1
         [   Player_SetX         Player1 i
            Player_SetY         Player1 GameBoardHeight + 1 - j
            Player_SetDirection Player1 pick [left right up down]
            Player_SetIsHuman   Player1 "false
            Player_SetIsAlive   Player1 "true
         ]
         if boardsquare == "2
         [   Player_SetX         Player2 i
            Player_SetY         Player2 GameBoardHeight + 1 - j
            Player_SetDirection Player2 pick [left right up down]
            Player_SetIsHuman   Player2 "false
            Player_SetIsAlive   Player2 "true
         ]
         if boardsquare == "3
         [   Player_SetX         Player3 i
            Player_SetY         Player3 GameBoardHeight + 1 - j
            Player_SetDirection Player3 pick [left right up down]
            Player_SetIsHuman   Player3 "false
            Player_SetIsAlive   Player3 "true
         ]
         if boardsquare == "4
         [   Player_SetX         Player4 i
            Player_SetY         Player4 GameBoardHeight + 1 - j
            Player_SetDirection Player4 pick [left right up down]
            Player_SetIsHuman   Player4 "false
            Player_SetIsAlive   Player4 "true
         ]
      ]
      ; set this row in the game board (and flip the board vertically)
      setitem GameBoardHeight - j + 1 GameBoard row_array
   ]
end

to Player_CheckIfDead Player
   local [gameboard_row boardsquare]

   ; already dead
   if not (Player_IsAlive Player)
   [   stop
   ]

   ; if the sqaure is blocked by something other than this player's head
   if (and (BoardSquareIsBlocked (Player_X Player) (Player_Y Player))
   (not (GetBoardSquare (Player_X Player) (Player_Y Player))
      == (Player_HeadIndex Player)))
   [   ; just died
      Player_SetIsAlive Player "false

      ; 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 (or    (boardsquare == (Player_Index     Player))
                  (boardsquare == (Player_HeadIndex Player)))
            [   ; 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 Player_Collision PlayerA PlayerB
   output (and (Player_X PlayerA) == (Player_X PlayerB)
            (Player_Y PlayerA) == (Player_Y PlayerB)
            (Player_IsAlive PlayerA)
            (Player_IsAlive PlayerB))
end

to Player_Color Player
   output item 7 Player
end

to Player_ComputerControl Player
   if Player_IsHuman Player
   [   ; commit to the direction set by the keyboard_
      Player_SetDirection Player (Player_NextDirection Player)
      stop
   ]
   ; 1 in 20 chance of missing the turn
   ;if (RANDOM 50) == 1 [ stop ]

   ; AI players tend to move in the same direction, unless the path is obstructed
   if (Player_Direction Player) == "left
   [   if BoardSquareIsBlocked (Player_X Player) - 1  (Player_Y Player)
      [   RUN PICK
         [   [TryRight Player TryDown Player TryUp   Player ]
            [TryRight Player TryUp   Player TryDown Player ]
         ]
      ]
      stop
   ]
   if (Player_Direction Player) == "up
   [   if BoardSquareIsBlocked (Player_X Player) (Player_Y Player) + 1
      [   RUN PICK
         [   [TryDown  Player TryLeft  Player TryRight Player ]
            [TryDown  Player TryRight Player TryLeft  Player ]
         ]
      ]
      stop
   ]
   if (Player_Direction Player) == "right
   [   if BoardSquareIsBlocked (Player_X Player) + 1  (Player_Y Player)
      [   RUN PICK
         [   [TryLeft  Player TryDown Player TryUp   Player ]
            [TryLeft  Player TryUp   Player TryDown Player ]
         ]
      ]
      stop
   ]
   if (Player_Direction Player) == "down
   [   if BoardSquareIsBlocked (Player_X Player) (Player_Y Player) - 1
      [   RUN PICK
         [   [TryUp Player  TryLeft  Player TryRight Player ]
            [TryUp Player  TryRight Player TryLeft  Player ]
         ]
      ]
      stop
   ]
end

to Player_Direction Player
   output item 5 Player
end

to Player_DownKey Player
   ; responds to a "down" direction press
   Player_SetIsHuman Player "true

   ; disallow doubling-back on oneself
   if not (Player_Direction Player) == "up
   [   Player_SetNextDirection Player "down
   ]
end

to Player_DrawBody Player
   if Player_IsAlive Player
   [   setfloodcolor Player_Color Player
      fillBlock (Player_X Player) (Player_Y Player)
   ]
end

to Player_DrawHead Player
   if Player_IsAlive Player
   [   setpencolor Player_Color Player

      if (Player_Direction Player) == "right
      [   MoveToGrid_LowerLeft (Player_X Player) (Player_Y Player)
         setheading 0
         repeat 3
         [    forward GridSize - 1
            right 120
         ]
      ]
      if (Player_Direction Player) == "left
      [   MoveToGrid_LowerRight (Player_X Player) (Player_Y Player)
         setheading 0
         repeat 3
         [   forward GridSize - 1
            left 120
         ]
      ]
      if (Player_Direction Player) == "up
      [   MoveToGrid_LowerLeft (Player_X Player) (Player_Y Player)
         setheading 90
         repeat 3
         [   forward GridSize - 1
            left 120
         ]
      ]
      if (Player_Direction Player) == "down
      [   MoveToGrid_UpperLeft (Player_X Player) (Player_Y Player)
         setheading 90
         repeat 3
         [   forward GridSize - 1
            right 120
         ]
      ]
   ]
end

to Player_HeadIndex Player
   output (item 1 Player) + 4
end

to Player_Index Player
   output item 1 Player
end

to Player_IsAlive Player
   output item 9 Player
end

to Player_IsHuman Player
   output item 8 Player
end

to Player_LeftKey Player
   ; responds to a "left" direction press
   Player_SetIsHuman Player "true

   ; disallow doubling-back on oneself
   if not (Player_Direction Player) == "right
   [   Player_SetNextDirection Player "left
   ]
end

to Player_MarkHeadPosition Player
   ; the head can only move into an open position
   if Player_IsAlive Player
   [   if (GetBoardSquare (Player_X Player) (Player_Y Player)) == ".
      [   SetBoardSquare (Player_X Player) (Player_Y Player) (Player_HeadIndex Player)
      ]
   ]
end

to Player_MarkPosition Player
   if Player_IsAlive Player
   [   if (GetBoardSquare (Player_X Player) (Player_Y Player)) == (Player_HeadIndex Player)
      [   SetBoardSquare (Player_X Player) (Player_Y Player) (Player_Index Player)
      ]
   ]
end

to Player_Move Player
   if (Player_Direction Player) == "left
   [   Player_SetX Player (Player_X Player) - 1
   ]
   if (Player_Direction Player) == "right
   [   Player_SetX Player (Player_X Player) + 1
   ]
   if (Player_Direction Player) == "up
   [   Player_SetY Player (Player_Y Player) + 1
   ]
   if (Player_Direction Player) == "down
   [   Player_SetY Player (Player_Y Player) - 1
   ]
end

to Player_Name Player
   output (item 2 Player)
end

to Player_NextDirection Player
   output item 6 Player
end

to Player_RightKey Player
   ; responds to a "right" direction press
   Player_SetIsHuman Player "true

   ; disallow doubling-back on oneself
   if not (Player_Direction Player) == "left
   [   Player_SetNextDirection Player "right
   ]
end

to Player_SetColor Player Color
   setitem 7 Player Color
end

to Player_SetDirection Player Direction
   setitem 5 Player Direction
end

to Player_SetIsAlive Player IsAlive
   setitem 9 Player IsAlive
end

to Player_SetIsHuman Player IsHuman
   setitem 8 Player IsHuman
end

to Player_SetNextDirection Player Direction
   setitem 6 Player Direction
end

to Player_SetX Player X
   setitem 3 Player X
end

to Player_SetY Player Y
   setitem 4 Player Y
end

to Player_UpKey Player
   ; responds to an "up" direction press
   Player_SetIsHuman Player "true

   ; disallow doubling-back on oneself
   if not (Player_Direction Player) == "down
   [   Player_SetNextDirection Player "up
   ]
end

to Player_X Player
   output item 3 Player
end

to Player_Y Player
   output item 4 Player
end

to PrintGameBoard
   ; prints the game board to the commander console

   for [j GameBoardHeight 1 ]
   [   print item j GameBoard
   ]
end

to ProcessKeyEvent Key
   if Key=="w [ Player_UpKey    Player1 ]
   if Key=="a [ Player_LeftKey  Player1 ]
   if Key=="d [ Player_RightKey Player1 ]
   if Key=="s [ Player_DownKey  Player1 ]

   if Key==WXK_UP    [ Player_UpKey    Player2 ]
   if Key==WXK_LEFT  [ Player_LeftKey  Player2 ]
   if Key==WXK_RIGHT [ Player_RightKey Player2 ]
   if Key==WXK_DOWN  [ Player_DownKey  Player2 ]

   if Key==WXK_ESCAPE [ IsDone="true ]
end

to SetBoardSquare x y value
   setitem x (item y GameBoard) value
end

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

to EndKeyboardCapture
   OnKeyDown []
   OnChar []
end

to TryDown Player
   if not BoardSquareIsBlocked (Player_X Player) (Player_Y Player) - 1
   [   Player_SetDirection Player "down
   ]
end

to TryLeft Player
   if not BoardSquareIsBlocked (Player_X Player) - 1 (Player_Y Player)
   [   Player_SetDirection Player "left
   ]
end

to TryRight Player
   if not BoardSquareIsBlocked (Player_X Player) + 1 (Player_Y Player)
   [   Player_SetDirection Player "right
   ]
end

to TryUp Player
   if not BoardSquareIsBlocked (Player_X Player) (Player_Y Player) + 1
   [   Player_SetDirection Player "up
   ]
end

to UpdateNextFrame
   ; control non-human players
   Player_ComputerControl Player1
   Player_ComputerControl Player2
   Player_ComputerControl Player3
   Player_ComputerControl Player4

   ; replace the old head with the color of the body
   Player_DrawBody Player1
   Player_DrawBody Player2
   Player_DrawBody Player3
   Player_DrawBody Player4

   ; move everyone
   Player_Move Player1
   Player_Move Player2
   Player_Move Player3
   Player_Move Player4

   ; draw the snake
   Player_MarkHeadPosition Player1
   Player_MarkHeadPosition Player2
   Player_MarkHeadPosition Player3
   Player_MarkHeadPosition Player4

   ; remove the dead snakes
   Player_CheckIfDead Player1
   Player_CheckIfDead Player2
   Player_CheckIfDead Player3
   Player_CheckIfDead Player4

   ; draw the snake
   Player_DrawHead Player1
   Player_DrawHead Player2
   Player_DrawHead Player3
   Player_DrawHead Player4

   ; draw the snake
   Player_MarkPosition Player1
   Player_MarkPosition Player2
   Player_MarkPosition Player3
   Player_MarkPosition Player4

   local [TotalLivingPlayers]
   TotalLivingPlayers=0
   if Player_IsAlive Player1 [TotalLivingPlayers=TotalLivingPlayers + 1 ]
   if Player_IsAlive Player2 [TotalLivingPlayers=TotalLivingPlayers + 1 ]
   if Player_IsAlive Player3 [TotalLivingPlayers=TotalLivingPlayers + 1 ]
   if Player_IsAlive Player4 [TotalLivingPlayers=TotalLivingPlayers + 1 ]

   if (TotalLivingPlayers < 2)
   [   IsDone="true
   ]
   updateGraph
end