Skip to content

Instantly share code, notes, and snippets.

@skensell
Created May 30, 2014 15:46
Show Gist options
  • Star 4 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save skensell/66f18bdc1c2b604ab93f to your computer and use it in GitHub Desktop.
Save skensell/66f18bdc1c2b604ab93f to your computer and use it in GitHub Desktop.
snake game in Elm
--- module ScottsSnake where
import Keyboard
import Random
import String
import Set
type Position = {x: Int, y: Int }
type Board = {w: Int, h: Int, wall: [Position]}
type Apple = Position
type Snake = { cells: [Position], direction:Direction}
type Score = Int
data Direction = Up | Down | Left | Right
data GameState = GameOn Snake Apple | GameOver Score
board = makeBoard 20 20
startApple = {x = 4, y = 6}
startDirection=Up
startSnake = { cells = [{x = 4, y = 3}], direction=startDirection}
difficulty = 7
renderInterval = 550 - 50*difficulty -- in ms
makeBoard w h =
{w = w, h = h,
wall = concat [ map (\s -> {x=0,y=s}) [0..h-1],
map (\s -> {x=w-1,y=s}) [0..h-1],
map (\s -> {x=s,y=0}) [0..w-1],
map (\s -> {x=s,y=h-1}) [0..w-1]]}
---------- GEOMETRY HELPERS
sameCell: Position -> Position -> Bool
sameCell c d = c.x == d.x && c.y == d.y
cartesianProduct: [a] -> [b] -> [(a,b)]
cartesianProduct l1 l2 =
let allXs = concat (map (repeat (length l2)) l1)
allYs = concat (repeat (length l1) l2)
in zip allXs allYs
freeCells:Board -> Snake -> [Position]
freeCells board snake =
let boardCells = Set.fromList (cartesianProduct [1..(board.w-2)] [1..(board.h-2)])
snakeCells = Set.fromList (map (\c -> (c.x, c.y)) (snake.cells))
in map (\(cx,cy) -> {x=cx,y=cy}) (Set.toList (Set.diff boardCells snakeCells))
pickCell : Int -> [Position] -> Position
pickCell i l = head (drop (mod i (length l)) l)
containsCell : Position -> [Position] -> Bool
containsCell c cells = length (filter (\cell -> sameCell c cell) cells) >= 1
adjacentCell : Position -> Direction -> Position
adjacentCell cell direction =
case direction of
Left -> { x = cell.x-1, y = cell.y }
Right -> { x = cell.x+1, y = cell.y }
Down -> { x = cell.x, y = cell.y-1 }
Up -> { x = cell.x, y = cell.y+1 }
cutTheLast : [Position] -> [Position]
cutTheLast l = take ((length l)-1) l
---------- GAME LOGIC
nextState:Board -> (Direction, Int) -> GameState -> GameState
nextState board (direction,rand) gameState =
case gameState of
GameOver score -> gameState
GameOn snake apple ->
let nextHead = adjacentCell (head snake.cells) direction
in
if | containsCell nextHead board.wall -> GameOver (length snake.cells)
| containsCell nextHead (tail snake.cells) -> GameOver (length snake.cells)
| not (sameCell nextHead apple)
-> GameOn { snake | cells <- nextHead :: cutTheLast snake.cells } apple
| otherwise
-> GameOn { snake | cells <- nextHead :: snake.cells } (pickCell rand (freeCells board snake))
------------ SIGNAL HELPERS
directionFromArrows:{x:Int, y:Int} -> Direction -> Direction
directionFromArrows arrows direction =
if | arrows.x < 0 -> Left
| arrows.x > 0 -> Right
| arrows.y > 0 -> Up
| arrows.y < 0 -> Down
| otherwise -> direction
flipDirection : Direction -> Direction
flipDirection direction =
case direction of
Up -> Down
Down -> Up
Left -> Right
Right -> Left
noBackwards : Direction -> Direction -> Direction
noBackwards new old = if new == flipDirection old then old else new
------------- SIGNALS
main = lift render gameStateSignal
gameStateSignal : Signal GameState
gameStateSignal = foldp (nextState board) (GameOn startSnake startApple) wrappedSignal
wrappedSignal : Signal (Direction, Int)
wrappedSignal = lift2 (\dir rand -> (dir, rand)) timedDirectionSignal randomSignal
randomSignal : Signal Int
randomSignal = Random.range 0 (board.w*board.h) timedDirectionSignal
timedDirectionSignal : Signal Direction
timedDirectionSignal = foldp noBackwards startDirection (sampleOn (every renderInterval) requestedDirectionSignal)
requestedDirectionSignal : Signal Direction
requestedDirectionSignal = foldp directionFromArrows startDirection (Keyboard.arrows)
--port log : Signal String
--port log = lift show gameStateSignal
--- RENDERING BELOW
drawCell: Color -> Position -> Form
drawCell color cell = rect 10 10 |> filled color
|> move (toFloat cell.x*10, toFloat cell.y*10)
|> move (-92,0)
drawCells snakeCells apple =
collage 400 400 (concat [ map (drawCell red) [apple],
map (drawCell green) snakeCells,
map (drawCell black) board.wall ])
render:GameState -> Element
render state = case state of
GameOn snake apple -> drawCells snake.cells apple
GameOver score -> asText ("GameOver. Snake Length: " ++ (show score))
@dptole
Copy link

dptole commented Feb 16, 2016

What is the version of Elm in which you compiled this code?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment