Skip to content

Instantly share code, notes, and snippets.

@sgronblo
Created March 29, 2016 07:31
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save sgronblo/2c85dc04468a4f28286d to your computer and use it in GitHub Desktop.
Snake game in Elm
import Color
import Debug
import Effects exposing (..)
import Graphics.Collage exposing (..)
import Graphics.Element exposing (..)
import Html exposing (div, Html)
import Keyboard exposing (..)
import Random
import StartApp
import Text
import Time
type alias Input = { x : Int, y : Int }
type Action =
Tick |
DirectionInput Input
type alias Coordinate = { x : Int, y : Int }
type Direction = Left | Right | Up | Down
type alias Dimensions = { rows : Int, cols : Int}
type alias Model =
{
snakeIsAlive : Bool,
dimensions : Dimensions,
direction : Direction,
foods : List Coordinate,
inputBuffer : List Direction,
points : Int,
randomSeed : Random.Seed,
snakeLength : Int,
snakePieces : List Coordinate
}
initialModel =
{
dimensions = { cols = 30, rows = 30 },
direction = Left,
foods = [{ x = 1, y = 1}],
inputBuffer = [],
points = 0,
randomSeed = Random.initialSeed 0,
snakeIsAlive = True,
snakeLength = 1,
snakePieces = [{ x = 15, y = 15}]
}
init = (initialModel, Effects.none)
makeForm : Color.Color -> Float -> Coordinate -> Form
makeForm c size position =
let halfSide = sideSize / 2
in filled c (rect size size)
|> move (toFloat position.x * sideSize - 150 + halfSide, toFloat position.y * sideSize - 150 + halfSide)
sideSize = 10
bgColor = Color.rgb 182 194 0
fgColor = Color.rgb 114 107 0
textLineStyle =
{
color = Color.black,
width = 0.5,
cap = Flat,
join = Smooth,
dashing = [],
dashOffset = 0
}
filledOutlinedText : String -> Float -> Form
filledOutlinedText s size =
let basicText = Text.fromString s |> Text.height size |> Text.color fgColor
filledT = text basicText
outlinedT = outlinedText textLineStyle basicText
in group [filledT, outlinedT]
snakeScreen : Model -> Element
snakeScreen m =
let background = filled bgColor (rect (toFloat m.dimensions.rows * sideSize) (toFloat m.dimensions.cols * sideSize))
snakePieces = List.map (\p -> makeForm fgColor sideSize p) m.snakePieces
fruits = List.map (\p -> makeForm Color.red sideSize p) m.foods
gameOverText = filledOutlinedText "Game Over" 50
|> move (0, 45)
scoreText = filledOutlinedText ("Score: " ++ toString m.points) 30
playAgainText = filledOutlinedText "Press a key to play again" 20
|> move (0, -35)
gameOver = if m.snakeIsAlive then toForm empty else group [gameOverText, scoreText, playAgainText]
in collage 300 300 (background :: fruits ++ snakePieces ++ [gameOver])
view : Signal.Address Action -> Model -> Html
view _ m =
div [] [Html.fromElement (snakeScreen m)]
getSnakeHead : Model -> Coordinate
getSnakeHead m =
case List.head m.snakePieces of
Just c -> c
Nothing -> Debug.crash "No snake head found"
getSnakeTail : Model -> List Coordinate
getSnakeTail m =
case List.tail m.snakePieces of
Just t -> t
Nothing -> Debug.crash "No snake tail found"
moveSnake : Model -> Model
moveSnake m =
let snakeHead = getSnakeHead m
newSnakeHead =
case m.direction of
Left -> { snakeHead | x = snakeHead.x - 1 }
Right -> { snakeHead | x = snakeHead.x + 1 }
Down -> { snakeHead | y = snakeHead.y - 1 }
Up -> { snakeHead | y = snakeHead.y + 1 }
in { m | snakePieces = List.take m.snakeLength (newSnakeHead :: m.snakePieces) }
snakeHasDied : Model -> Bool
snakeHasDied m =
let snakeHead = getSnakeHead m
in snakeHasMovedOutside snakeHead m.dimensions || snakeBitItself snakeHead (getSnakeTail m)
snakeBitItself : Coordinate -> List Coordinate -> Bool
snakeBitItself head tail = List.any (\b -> b == head) tail
snakeHasMovedOutside : Coordinate -> Dimensions -> Bool
snakeHasMovedOutside head dimensions =
head.x < 0 || head.x >= dimensions.rows || head.y < 0 || head.y >= dimensions.cols
find : List a -> (a -> Bool) -> Maybe a
find l p =
case l of
[] -> Nothing
e :: es -> if p e then Just e else find es p
snakeEatsFood : Coordinate -> List Coordinate -> Maybe Coordinate
snakeEatsFood head foods = find foods (\f -> f == head)
coordinateGenerator : Random.Generator Coordinate
coordinateGenerator = Random.map2 (\x y -> { x = x, y = y }) (Random.int 0 29) (Random.int 0 29)
range : Int -> Int -> List Int
range l h =
let go l h current =
if l > h then current
else l :: range (l + 1) h
in go l h []
allPositions : Dimensions -> List Coordinate
allPositions d =
let rows = range 0 (d.rows - 1)
cols = range 0 (d.cols - 1)
in List.concat <| List.map (\ri -> List.map (\ci -> { y = ri, x = ci }) cols) rows
listGet : Int -> List a -> Maybe a
listGet i l = List.drop i l |> List.head
pickFromList : List a -> Random.Seed -> (a, Random.Seed)
pickFromList l seed =
let indexGenerator = Random.int 0 (List.length l)
(randomIndex, newSeed) = Random.generate indexGenerator seed
in case listGet randomIndex l of
Just e -> (e, newSeed)
Nothing -> Debug.crash "Called pick with list on empty list"
{- TODO Full Screen not handled -}
generateNewFood : Model -> (Coordinate, Random.Seed)
generateNewFood m =
let freePositions = List.filter (\pos -> not (List.member pos m.snakePieces)) (allPositions m.dimensions)
in pickFromList freePositions m.randomSeed
advanceState : Model -> Model
advanceState m =
if m.snakeIsAlive then
let withMovedSnake = moveSnake m
in
if snakeHasDied withMovedSnake then
{m | snakeIsAlive = False }
else
case snakeEatsFood (getSnakeHead m) m.foods of
Just _ ->
let (newFood, newRandomSeed) = generateNewFood m
in { withMovedSnake |
snakeLength = withMovedSnake.snakeLength + 2,
foods = [newFood],
points = withMovedSnake.points,
randomSeed = newRandomSeed
}
Nothing ->
withMovedSnake
else m
directionFromArrows : { x : Int, y : Int } -> Maybe Direction
directionFromArrows { x, y } =
if x == -1 then Just Left
else if x == 1 then Just Right
else if y == -1 then Just Down
else if y == 1 then Just Up
else Nothing
opposite : Direction -> Direction -> Bool
opposite d1 d2 =
case (d1, d2) of
(Left, Right) -> True
(Right, Left) -> True
(Up, Down) -> True
(Down, Up) -> True
otherwise -> False
updateDirection : Model -> Model
updateDirection m =
case m.inputBuffer of
newDirection :: rest ->
let updatedDirection = if (m.direction `opposite` newDirection) then m.direction else newDirection
in { m | direction = updatedDirection, inputBuffer = rest }
[] -> m
updateInputBuffer : List Direction -> Direction -> List Direction
updateInputBuffer current next =
case current of
[] -> [next]
buffer ->
case
let updatedBuffer = if next == d then d :: ds else next :: d :: ds
in List.take 2 (updatedDirection
update : Action -> Model -> (Model, Effects Action)
update a m =
case a of
Tick -> (updateDirection m |> advanceState, Effects.none)
DirectionInput arrows ->
if m.snakeIsAlive then
case directionFromArrows arrows of
Nothing -> (m, Effects.none)
Just newDirection ->
let newInputBuffer = Debug.log "inputBuffer" <| List.take 2 (m.inputBuffer ++ [newDirection])
in ({ m | inputBuffer = newInputBuffer }, Effects.none)
else
(initialModel, Effects.none)
ticks = Signal.map (always Tick) (Time.fps 8)
arrowSignal = Signal.map DirectionInput arrows
app = StartApp.start {init = init, update = update, view = view, inputs = [arrowSignal, ticks]}
main = app.html
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment