Week 04 of 2023
Development log of Word Snake
9 items
- Make the flames disappear fast after the game
- Write a comment about changing directions
- Animate entities (spawning, decaying, collected)
- Setup tests via Elm Verify Examples
- Make the fire spread on the edge
- Draw a reference SVG for continous snake body
- Give snake a continuous body
- Setup an icon for the website
- Fix missing module
Make the flames disappear fast after the game
On by
This is to prevent a lot of flames being left over from previous game after the snake dies. Technically everything disappears faster, but flames are the really important aspect of it.
index f8906b1..f498b5c 100644
--- a/src/Game.elm
+++ b/src/Game.elm
@@ -707,7 +707,7 @@ update msg model =
=
= ( letters, randomness ) =
= model.letters
- |> randomDecay 0.01
+ |> randomDecay decayRatio
= |> Random.andThen
= (randomSpawn
= model.area
@@ -716,6 +716,13 @@ update msg model =
= )
= |> (\generator -> Random.step generator model.randomness)
=
+ decayRatio =
+ if outcome model == InProgress then
+ 0.01
+
+ else
+ 0.3
+
= goal : Goal
= goal =
= model.goal
@@ -738,7 +745,7 @@ update msg model =
= burn =
= case model.goal of
= CompleteSentence _ _ ->
- Goal.complete goal |> not
+ not (Goal.complete goal) && Snake.isAlive snake
=
= _ ->
= FalseWrite a comment about changing directions
On by
index 16ed718..0368622 100644
--- a/src/Snake.elm
+++ b/src/Snake.elm
@@ -96,6 +96,7 @@ move snake =
=
=setDirection : Direction -> Snake -> Snake
=setDirection direction snake =
+ -- NOTE: This seems too complicated, and it might be tempting to just check if the new direction is opposite to the current. But this would allow the player to quickly change direction twice and collide with the neck.
= let
= neck : Position
= neck =Animate entities (spawning, decaying, collected)
On by
This required a major rework of the entities system. I replaced the previous data structure called Letters with a new, called Entities. Now it contains information about a state of entity, which allows for animation. The Entities type and related logic has it's own module.
index df53946..4de9614 100644
--- a/elm.json
+++ b/elm.json
@@ -16,6 +16,7 @@
= "elm/regex": "1.0.0",
= "elm/svg": "1.0.1",
= "elm/time": "1.0.0",
+ "elm-community/dict-extra": "2.4.0",
= "elm-community/list-extra": "8.7.0",
= "elm-community/maybe-extra": "5.2.0",
= "elm-community/result-extra": "2.4.0",new file mode 100644
index 0000000..ec63603
--- /dev/null
+++ b/src/Entities.elm
@@ -0,0 +1,181 @@
+module Entities exposing
+ ( Entities
+ , Entity
+ , State(..)
+ , decay
+ , isPresent
+ , spawn
+ , step, get, collect, stateAt
+ )
+
+{-| The Entities data structure represents environment that the snake can
+interact with, like letters to collect, poops and flames that can kill it, etc.
+-}
+
+import Dict exposing (Dict)
+import Dict.Extra as Dict
+import Maybe.Extra as Maybe
+import Position exposing (Position)
+
+
+type alias Entities =
+ Dict Position State
+
+
+type State
+ = Empty
+ | Appearing Entity
+ | Present Entity
+ | Disappearing Entity
+ | Replacing Entity Entity
+ | Collected Entity
+
+
+type alias Entity =
+ Char
+
+
+get : Position -> Entities -> List Entity
+get position entities =
+ case stateAt position entities of
+ Empty ->
+ []
+
+ Appearing entity ->
+ [ entity ]
+
+ Present entity ->
+ [ entity ]
+
+ Disappearing entity ->
+ [ entity ]
+
+ Replacing old new ->
+ [ old, new ]
+
+ Collected entity ->
+ [ entity ]
+
+stateAt : Position -> Entities -> State
+stateAt position entities =
+ entities
+ |> Dict.get position
+ |> Maybe.withDefault Empty
+
+
+
+-- UPDATING
+
+
+step : Entities -> Entities
+step entities =
+ Dict.filterMap stepEntity entities
+
+
+stepEntity : Position -> State -> Maybe State
+stepEntity _ state =
+ case state of
+ Empty ->
+ Nothing
+
+ Appearing entity ->
+ Present entity |> Just
+
+ Present _ ->
+ state |> Just
+
+ Disappearing _ ->
+ Empty |> Just
+
+ Replacing old new ->
+ Present new |> Just
+
+ Collected _ ->
+ Nothing
+
+
+spawn : Position -> Entity -> Entities -> Entities
+spawn position entity entities =
+ case stateAt position entities of
+ Empty ->
+ entities
+ |> Dict.insert position (Appearing entity)
+
+ Appearing new ->
+ -- Swap previous new with the new new
+ entities
+ |> Dict.insert position (Appearing entity)
+
+ Present old ->
+ entities
+ |> Dict.insert position (Replacing old entity)
+
+ Disappearing old ->
+ entities
+ |> Dict.insert position (Replacing old entity)
+
+ Replacing old new ->
+ -- Swap previous new with the new new
+ entities
+ |> Dict.insert position (Replacing old entity)
+
+ Collected _ ->
+ -- If something was just collected, ignore the insertion.
+ entities
+
+
+collect : Position -> Entity -> Entities -> Entities
+collect position entity entities =
+ -- NOTE: We trust that the entity was there to collect.
+ Dict.insert position (Collected entity) entities
+
+decay : Position -> Entities -> Entities
+decay position entities =
+ case stateAt position entities of
+ Empty ->
+ entities
+
+ Appearing entity ->
+ entities
+ |> Dict.insert position (Disappearing entity)
+
+ Present entity ->
+ entities
+ |> Dict.insert position (Disappearing entity)
+
+ Disappearing _ ->
+ entities
+
+ Replacing old new ->
+ entities
+ |> Dict.insert position (Disappearing new)
+
+ Collected _ ->
+ entities
+
+
+isPresent : Entity -> Entities -> Bool
+isPresent entity entities =
+ Dict.any (contains entity) entities
+
+
+contains : Entity -> Position -> State -> Bool
+contains searching position state =
+ case state of
+ Empty ->
+ False
+
+ Appearing entity ->
+ searching == entity
+
+ Present entity ->
+ searching == entity
+
+ Disappearing entity ->
+ searching == entity
+
+ Replacing old new ->
+ searching == old && searching == new
+
+ Collected entity ->
+ searching == entityindex f498b5c..25d12d8 100644
--- a/src/Game.elm
+++ b/src/Game.elm
@@ -16,8 +16,9 @@ port module Game exposing
=
=import Area exposing (Area)
=import Browser.Events
-import Dict exposing (Dict)
+import Dict
=import Direction exposing (Direction(..))
+import Entities exposing (Entities, Entity)
=import Goal exposing (Goal(..))
=import Html exposing (Html)
=import Html.Attributes
@@ -32,7 +33,7 @@ import Set exposing (Set)
=import Snake exposing (Snake)
=import Spring exposing (Spring)
=import Svg exposing (Svg)
-import Svg.Attributes exposing (direction)
+import Svg.Attributes
=import Svg.Keyed
=import Tad.Html as Html
=import Time
@@ -49,7 +50,7 @@ type alias Model =
= { area : Area
= , tiles : Set Position
= , pan : Pan
- , letters : Letters
+ , entities : Entities
= , snake : Snake
= , goal : Goal
= , word : String
@@ -65,10 +66,6 @@ type alias Pan =
= }
=
=
-type alias Letters =
- Dict Position Char
-
-
=type alias Swipe =
= { identifier : Int
= , from : ( Float, Float )
@@ -98,7 +95,7 @@ init flags =
= Pan
= (Spring.create { strength = 20, dampness = 3 })
= (Spring.create { strength = 20, dampness = 3 })
- , letters = Dict.empty
+ , entities = Dict.empty
= , snake = Snake.new ( 0, 0 ) East 5
= , goal = flags.goal
= , word = ""
@@ -109,7 +106,7 @@ init flags =
=
=
=continue : Goal -> Model -> Model
-continue goal ({ area, snake, letters } as game) =
+continue goal ({ area, snake, entities } as game) =
= { game
= | goal = goal
= , area = { area | center = game.snake.head }
@@ -130,19 +127,19 @@ continue goal ({ area, snake, letters } as game) =
= snake.head
= }
= , word = ""
- , letters = clearPath snake.head snake.direction 5 letters
+ , entities = clearPath snake.head snake.direction 5 entities
= , countdown = Goal.coundown goal
= }
=
=
-clearPath : Position -> Direction -> Int -> Letters -> Letters
-clearPath from direction length letters =
+clearPath : Position -> Direction -> Int -> Entities -> Entities
+clearPath from direction length entities =
= from
= |> line direction length
- |> List.foldl clearPosition letters
+ |> List.foldl clearPosition entities
=
=
-clearPosition : Position -> Letters -> Letters
+clearPosition : Position -> Entities -> Entities
=clearPosition position =
= Dict.remove position
=
@@ -234,7 +231,7 @@ viewCollectibles collectibles =
= [ "Get " |> Html.text
= , current.label |> Html.text
= , " " |> Html.text
- , current.symbol |> String.fromChar |> Html.text
+ , current.entity |> String.fromChar |> Html.text
= ]
=
= [] ->
@@ -449,7 +446,7 @@ viewArea model =
= let
= entities =
= [ viewBackground model.tiles
- , viewLetters model.letters
+ , viewEntities model.entities
= , viewSnake model.snake
= ]
= |> Svg.g
@@ -505,11 +502,11 @@ viewBackgroundTile ( x, y ) =
= []
=
=
-viewLetters : Letters -> Svg Msg
-viewLetters letters =
- letters
+viewEntities : Entities -> Svg Msg
+viewEntities entities =
+ entities
= |> Dict.toList
- |> List.map viewLetter
+ |> List.map viewPosition
= |> Svg.Keyed.node "g"
= [ Html.Attributes.style "pointer-events" "none"
= ]
@@ -638,8 +635,8 @@ viewSegment shape ( x, y ) =
= ]
=
=
-viewLetter : ( Position, Char ) -> ( String, Svg Msg )
-viewLetter ( ( x, y ), letter ) =
+viewPosition : ( Position, Entities.State ) -> ( String, Svg Msg )
+viewPosition ( ( x, y ), state ) =
= let
= key : String
= key =
@@ -647,17 +644,97 @@ viewLetter ( ( x, y ), letter ) =
= |> List.map String.fromInt
= |> String.join "-"
= in
- letter
- |> String.fromChar
- |> Svg.text
- |> List.singleton
- |> Svg.text_
+ state
+ |> viewState
+ |> Svg.g
= [ Transformations.Translate ""
= (Basics.toFloat x * scale)
= (Basics.toFloat y * scale)
= |> Transformations.toString
= |> Svg.Attributes.transform
- , Html.Attributes.style "text-anchor" "middle"
+ ]
+ |> Tuple.pair key
+
+
+viewState : Entities.State -> List (Svg Msg)
+viewState state =
+ case state of
+ Entities.Empty ->
+ []
+
+ Entities.Appearing entity ->
+ [ entity
+ |> viewEntity
+ |> Html.wrap Svg.g
+ [ Transformations.Scale 0 0
+ |> Transformations.toString
+ |> Html.Attributes.style "transform"
+ , Html.Attributes.style "transition" "transform 200ms"
+ ]
+ ]
+
+ Entities.Present entity ->
+ [ entity
+ |> viewEntity
+ |> Html.wrap Svg.g
+ [ Transformations.Scale 1 1
+ |> Transformations.toString
+ |> Html.Attributes.style "transform"
+ , Html.Attributes.style "transition" "transform 200ms"
+ ]
+ ]
+
+ Entities.Disappearing entity ->
+ [ entity
+ |> viewEntity
+ |> Html.wrap Svg.g
+ [ Transformations.Scale 0 0
+ |> Transformations.toString
+ |> Html.Attributes.style "transform"
+ , Html.Attributes.style "transition" "transform 200ms"
+ ]
+ ]
+
+ Entities.Replacing old new ->
+ [ old
+ |> viewEntity
+ |> Html.wrap Svg.g
+ [ Transformations.Scale 0 0
+ |> Transformations.toString
+ |> Html.Attributes.style "transform"
+ , Html.Attributes.style "transition" "transform 200ms"
+ ]
+ , new
+ |> viewEntity
+ |> Html.wrap Svg.g
+ [ Transformations.Scale 0 0
+ |> Transformations.toString
+ |> Html.Attributes.style "transform"
+ , Html.Attributes.style "transition" "transform 200ms"
+ ]
+ ]
+
+ Entities.Collected entity ->
+ [ entity
+ |> viewEntity
+ |> Html.wrap Svg.g
+ [ Transformations.Scale 20 20
+ |> Transformations.toString
+ |> Html.Attributes.style "transform"
+ , Html.Attributes.style "opacity" "0"
+ , Html.Attributes.style "transition" "transform 200ms, opacity 200ms"
+ ]
+ ]
+
+
+viewEntity : Entity -> Svg Msg
+viewEntity entity =
+ entity
+ |> String.fromChar
+ |> Svg.text
+ |> List.singleton
+ |> Svg.text_
+ [ Html.Attributes.style "text-anchor" "middle"
= , Html.Attributes.style "dominant-baseline" "middle"
= , Svg.Attributes.width (scale |> String.fromFloat)
= , Svg.Attributes.height (scale |> String.fromFloat)
@@ -665,7 +742,6 @@ viewLetter ( ( x, y ), letter ) =
= , Svg.Attributes.fontWeight "bold"
= , Svg.Attributes.fill "hsl(0, 0%, 86%)"
= ]
- |> Tuple.pair key
=
=
=
@@ -705,8 +781,9 @@ update msg model =
= |> Maybe.andThen swipeDirection
= |> Maybe.withDefault model.snake.direction
=
- ( letters, randomness ) =
- model.letters
+ ( entities, randomness ) =
+ model.entities
+ |> Entities.step
= |> randomDecay decayRatio
= |> Random.andThen
= (randomSpawn
@@ -726,13 +803,13 @@ update msg model =
= goal : Goal
= goal =
= model.goal
- |> updateGoal model.snake model.letters
+ |> updateGoal model.snake model.entities
=
= snake : Snake
= snake =
= model.snake
= |> Snake.setDirection direction
- |> updateSnake letters
+ |> updateSnake entities
= |> Snake.move
=
= tiles =
@@ -745,7 +822,7 @@ update msg model =
= burn =
= case model.goal of
= CompleteSentence _ _ ->
- not (Goal.complete goal) && Snake.isAlive snake
+ not (Goal.isCompleted goal) && Snake.isAlive snake
=
= _ ->
= False
@@ -771,9 +848,9 @@ update msg model =
= | goal = goal
= , tiles = tiles
= , pan = pan
- , letters =
- letters
- |> updateLetters model.goal model.snake
+ , entities =
+ entities
+ |> updateEntities model.goal model.snake
= |> burnTheEdge model.area burn
= , randomness = randomness
= , snake = snake
@@ -982,18 +1059,14 @@ update msg model =
= )
=
=
-updateGoal : Snake -> Letters -> Goal -> Goal
-updateGoal snake letters goal =
+updateGoal : Snake -> Entities -> Goal -> Goal
+updateGoal snake entities goal =
= case goal of
= CompleteSentence sentence collected ->
- case Dict.get snake.head letters of
- Nothing ->
- goal
-
- Just letter ->
- collected
- |> Goal.collectLetter letter sentence
- |> CompleteSentence sentence
+ entities
+ |> Entities.get snake.head
+ |> List.foldr (Goal.collectLetter sentence) collected
+ |> CompleteSentence sentence
=
= ReadInstructions _ ->
= goal
@@ -1009,20 +1082,11 @@ updateGoal snake letters goal =
= -- The goal is complete.
= goal
=
- CollectSingle rubbish (collectible :: rest) ->
- case Dict.get snake.head letters of
- Nothing ->
- goal
-
- Just letter ->
- if letter == collectible.symbol then
- CollectSingle rubbish rest
-
- else
- goal
-
- CollectSingle _ [] ->
- goal
+ CollectSingle rubbish collectibles ->
+ entities
+ |> Entities.get snake.head
+ |> List.foldr Goal.collectSingle collectibles
+ |> CollectSingle rubbish
=
=
=
@@ -1061,48 +1125,54 @@ subscriptions model =
=-- UTILS
=
=
-burnTheEdge : Area -> Bool -> Letters -> Letters
-burnTheEdge area burn letters =
+burnTheEdge : Area -> Bool -> Entities -> Entities
+burnTheEdge area burn entities =
= let
- setOnFire : Position -> Letters -> Letters
+ setOnFire : Position -> Entities -> Entities
= setOnFire position =
- Dict.insert position '🔥'
+ if
+ entities
+ |> Entities.get position
+ |> List.member '🔥'
+ then
+ identity
+
+ else
+ Entities.spawn position '🔥'
= in
= if burn then
= area
= |> Area.edge
- |> List.foldl setOnFire letters
+ |> List.foldl setOnFire entities
=
= else
- letters
-
+ entities
=
-updateSnake : Letters -> Snake -> Snake
-updateSnake letters snake =
- case Dict.get snake.head letters of
- Nothing ->
- snake
=
- Just '🔥' ->
- Snake.kill Snake.Burnt snake
+updateSnake : Entities -> Snake -> Snake
+updateSnake entities snake =
+ entities
+ |> Entities.get snake.head
+ |> List.foldr Snake.feed snake
=
- Just '💩' ->
- Snake.kill Snake.CollectedPoo snake
=
- Just _ ->
- Snake.grow snake
+updateEntities : Goal -> Snake -> Entities -> Entities
+updateEntities goal snake entities =
+ entities
+ |> Entities.get snake.head
+ |> List.foldr (processCollected goal snake) entities
=
=
-updateLetters : Goal -> Snake -> Letters -> Letters
-updateLetters goal snake letters =
- case Dict.get snake.head letters of
- Nothing ->
- letters
+processCollected : Goal -> Snake -> Entity -> Entities -> Entities
+processCollected goal snake entity entities =
+ case entity of
+ '🔥' ->
+ Entities.collect snake.head '🔥' entities
=
- Just '🔥' ->
- letters
+ '💩' ->
+ Entities.collect snake.head '💩' entities
=
- Just letter ->
+ _ ->
= case goal of
= CompleteSentence sentence collected ->
= let
@@ -1112,31 +1182,31 @@ updateLetters goal snake letters =
= |> Goal.missingLetters sentence
= |> List.head
= in
- if wanted == Just letter then
- Dict.remove snake.head letters
+ if wanted == Just entity then
+ Entities.collect snake.head entity entities
=
= else
- letters
- |> Dict.remove snake.head
- |> Dict.insert snake.tail '💩'
+ entities
+ |> Entities.decay snake.head
+ |> Entities.spawn snake.tail '💩'
=
= ReadInstructions _ ->
- letters
+ entities
=
= ChangeDirections _ ->
= Dict.empty
=
= CollectSingle _ (collectible :: rest) ->
- if letter == collectible.symbol then
- Dict.remove snake.head letters
+ if entity == collectible.entity then
+ Entities.collect snake.head entity entities
=
= else
- letters
- |> Dict.remove snake.head
- |> Dict.insert snake.tail '💩'
+ entities
+ |> Entities.decay snake.head
+ |> Entities.spawn snake.tail '💩'
=
= CollectSingle _ [] ->
- letters
+ entities
=
=
=
@@ -1151,36 +1221,35 @@ type Outcome
=
=outcome : Model -> Outcome
=outcome model =
- case model.snake.death of
- Just cause ->
- Lost
+ if Snake.isDead model.snake then
+ Lost
=
- Nothing ->
- case model.goal of
- CompleteSentence collected sentence ->
- if snakeEscaped model then
- -- TODO: Check if sentence is collected?
- Won
+ else
+ case model.goal of
+ CompleteSentence collected sentence ->
+ if snakeEscaped model then
+ -- TODO: Check if sentence is collected?
+ Won
=
- else
- InProgress
+ else
+ InProgress
=
- ReadInstructions _ ->
- -- This is always a win
- Won
+ ReadInstructions _ ->
+ -- This is always a win
+ Won
=
- ChangeDirections [] ->
- Won
+ ChangeDirections [] ->
+ Won
=
- ChangeDirections _ ->
- InProgress
+ ChangeDirections _ ->
+ InProgress
=
- CollectSingle _ collectibles ->
- if List.isEmpty collectibles then
- Won
+ CollectSingle _ collectibles ->
+ if List.isEmpty collectibles then
+ Won
=
- else
- InProgress
+ else
+ InProgress
=
=
=passwordCollected : String -> Goal.Sentence -> Bool
@@ -1240,30 +1309,16 @@ swipeDirection swipe =
=-- random generators
=
=
-randomLetter : Char -> Goal.Charset -> Random.Generator Char
-randomLetter promoted charset =
- charset
- |> List.map (Tuple.pair 1)
- |> Random.weighted ( 3, promoted )
-
-
-randomBoolean : Float -> Random.Generator Bool
-randomBoolean probability =
- Random.weighted
- ( probability, True )
- [ ( 1 - probability, False ) ]
-
-
=randomSpawn :
= Area
= -> Goal
= -> Snake
- -> Letters
- -> Random.Generator Letters
-randomSpawn area goal snake letters =
+ -> Entities
+ -> Random.Generator Entities
+randomSpawn area goal snake entities =
= let
- insert : Bool -> Position -> Char -> Letters
- insert spawn position letter =
+ insert : Bool -> Position -> Char -> Entities
+ insert spawn position entity =
= if
= spawn
= && position
@@ -1271,10 +1326,10 @@ randomSpawn area goal snake letters =
= && not (List.member position snake.body)
= -- TODO: Do not spawn right in front of the snake, say 3 positions ahead
= then
- Dict.insert position letter letters
+ Entities.spawn position entity entities
=
= else
- letters
+ entities
= in
= case goal of
= CompleteSentence sentence collected ->
@@ -1287,13 +1342,13 @@ randomSpawn area goal snake letters =
= in
= case Goal.missingLetters sentence collected of
= [] ->
- Random.constant letters
+ Random.constant entities
=
= next :: following ->
= Random.map3 insert
= (randomBoolean probability)
= (Area.randomPosition area)
- (randomLetter next charset)
+ (randomEntity next charset)
=
= ReadInstructions _ ->
= Random.constant Dict.empty
@@ -1306,20 +1361,14 @@ randomSpawn area goal snake letters =
= probability =
= 0.3
=
- present : Bool
- present =
- letters
- |> Dict.values
- |> List.member collectible.symbol
-
- spawnCollectible : Position -> Letters
+ spawnCollectible : Position -> Entities
= spawnCollectible position =
- insert True position collectible.symbol
+ insert True position collectible.entity
= in
- if present then
+ if Entities.isPresent collectible.entity entities then
= case rubbish of
= [] ->
- Random.constant letters
+ Random.constant entities
=
= one :: more ->
= Random.map3 insert
@@ -1337,30 +1386,49 @@ randomSpawn area goal snake letters =
= Random.constant Dict.empty
=
=
-randomDecay : Float -> Letters -> Random.Generator Letters
-randomDecay probability dict =
- Random.list (Dict.size dict) (randomBoolean probability)
- |> Random.map (\decayList -> decay decayList dict)
+hasWon : Model -> Bool
+hasWon game =
+ outcome game == Won
+
=
=
-decay : List Bool -> Dict comparable v -> Dict comparable v
-decay decayList dict =
+-- RANDOM GENERATORS
+-- TODO: Consider moving to Entities module.
+
+
+randomDecay : Float -> Entities -> Random.Generator Entities
+randomDecay probability entities =
= let
- maybeAnnihilate : Bool -> a -> Maybe a
- maybeAnnihilate annihilate value =
- if annihilate then
- Nothing
+ decayMany : List Bool -> Entities
+ decayMany decayList =
+ entities
+ |> Dict.keys
+ |> List.map2 Tuple.pair decayList
+ |> List.foldr maybeDecay entities
+
+ maybeDecay : ( Bool, Position ) -> Entities -> Entities
+ maybeDecay ( isDecaying, position ) =
+ if isDecaying then
+ Entities.decay position
=
= else
- Just value
+ identity
= in
- dict
- |> Dict.toList
- |> List.map2 maybeAnnihilate decayList
- |> Maybe.values
- |> Dict.fromList
+ probability
+ |> randomBoolean
+ |> Random.list (Dict.size entities)
+ |> Random.map decayMany
=
=
-hasWon : Model -> Bool
-hasWon game =
- outcome game == Won
+randomEntity : Entity -> Goal.Charset -> Random.Generator Entity
+randomEntity promoted charset =
+ charset
+ |> List.map (Tuple.pair 1)
+ |> Random.weighted ( 3, promoted )
+
+
+randomBoolean : Float -> Random.Generator Bool
+randomBoolean probability =
+ Random.weighted
+ ( probability, True )
+ [ ( 1 - probability, False ) ]index 0b1a37d..187f7cc 100644
--- a/src/Goal.elm
+++ b/src/Goal.elm
@@ -4,7 +4,8 @@ module Goal exposing
= , Goal(..)
= , Sentence
= , collectLetter
- , complete
+ , collectSingle
+ , isCompleted
= , coundown
= , missingLetters
= , nextLetter
@@ -12,6 +13,7 @@ module Goal exposing
= )
=
=import Direction exposing (Direction(..))
+import Entities exposing (Entity)
=import Html exposing (Html)
=
=
@@ -23,13 +25,29 @@ type Goal
=
=
=type alias Collectible =
- { symbol : Char
+ { entity : Entity
= , label : String
= }
=
=
-complete : Goal -> Bool
-complete goal =
+coundown : Goal -> Int
+coundown goal =
+ case goal of
+ CompleteSentence _ _ ->
+ 5
+
+ ReadInstructions _ ->
+ 0
+
+ ChangeDirections _ ->
+ 0
+
+ CollectSingle _ _ ->
+ 5
+
+
+isCompleted : Goal -> Bool
+isCompleted goal =
= case goal of
= CompleteSentence sentence collected ->
= String.toUpper collected == String.toUpper sentence.password
@@ -95,8 +113,8 @@ missingLetters sentence collected =
= |> List.drop (String.length collected)
=
=
-collectLetter : Char -> Sentence -> String -> String
-collectLetter letter sentence collected =
+collectLetter : Sentence -> Char -> String -> String
+collectLetter sentence letter collected =
= if isNextLetter letter sentence collected then
= collected
= |> String.reverse
@@ -119,17 +137,19 @@ nextLetter sentence collected =
= |> List.head
=
=
-coundown : Goal -> Int
-coundown goal =
- case goal of
- CompleteSentence _ _ ->
- 5
=
- ReadInstructions _ ->
- 0
+-- COLLECT SINGLE
=
- ChangeDirections _ ->
- 0
=
- CollectSingle _ _ ->
- 5
+collectSingle : Entity -> List Collectible -> List Collectible
+collectSingle entity collectibles =
+ case collectibles of
+ collectible :: rest ->
+ if entity == collectible.entity then
+ rest
+
+ else
+ collectibles
+
+ [] ->
+ collectiblesindex 0368622..d09754b 100644
--- a/src/Snake.elm
+++ b/src/Snake.elm
@@ -1,6 +1,7 @@
=module Snake exposing
= ( CauseOfDeath(..)
= , Snake
+ , feed
= , grow
= , isAlive
= , isDead
@@ -11,6 +12,7 @@ module Snake exposing
= )
=
=import Direction exposing (Direction)
+import Entities exposing (Entity)
=import Position exposing (Position)
=
=
@@ -130,6 +132,19 @@ setDirection direction snake =
= { snake | direction = direction }
=
=
+feed : Entity -> Snake -> Snake
+feed entity snake =
+ case entity of
+ '🔥' ->
+ kill Burnt snake
+
+ '💩' ->
+ kill CollectedPoo snake
+
+ _ ->
+ grow snake
+
+
=grow : Snake -> Snake
=grow snake =
= { snakeSetup tests via Elm Verify Examples
On by
Re-implement line helper from Game in Area and expose. Write some examples that are verified. Also, fix and verify examples from the Position module that were written before, but not verified and actually contained errors.
index 71ca668..0767f69 100644
--- a/.gitignore
+++ b/.gitignore
@@ -17,6 +17,7 @@ yarn-error.log*
=dist/
=elm-stuff/
=resources/
+tests/VerifyExamples/
=
=# Nix
=resultindex be8d59d..b5b0b8f 100644
--- a/Makefile
+++ b/Makefile
@@ -4,7 +4,7 @@ public-url ?= /
=include Makefile.d/defaults.mk
=
=all: ## Run unit tests and build the program (DEFAULT)
-all: dist
+all: test dist
=.PHONY: all
=
=help: ## Print this help message
@@ -24,6 +24,12 @@ dist: node_modules $(shell find src/ -type f )
= $(entrypoints)
= touch $@
=
+test: ## Test the program
+test:
+ elm-verify-examples
+ elm-test
+.PHONY: test
+
=install: ## Install the program in the ${prefix} directory
=install: prefix ?= $(out)
=install: distindex 77b6096..9f4e927 100644
--- a/elm-packages.nix
+++ b/elm-packages.nix
@@ -1,8 +1,13 @@
={
=
- "krisajenkins/remotedata" = {
- sha256 = "0m5bk0qhsjv14vajqrkph386696pnhj5rn51kgma8lwyvvx9ihw1";
- version = "6.0.1";
+ "elm-community/dict-extra" = {
+ sha256 = "05ll04wf03m8ic109dz2dbq6pah23m70c4wwyr35026dhmws35n0";
+ version = "2.4.0";
+ };
+
+ "elm-community/list-extra" = {
+ sha256 = "02grd0p5hc2gvdy4n723d1s28pm1grn95jrzic6jcgb26qh16vcc";
+ version = "8.7.0";
= };
=
= "elm-community/maybe-extra" = {
@@ -10,19 +15,19 @@
= version = "5.2.0";
= };
=
- "mpizenberg/elm-pointer-events" = {
- sha256 = "16s14sh01g6ssabwkf2k1xdxnahnkn0s7603cg87wd0h4myg15da";
- version = "4.0.2";
+ "elm-community/result-extra" = {
+ sha256 = "0bwiqjq4cgffbk8a6nqk1k4yhv1hwg96m2fhn5zbniwsm13lrm5m";
+ version = "2.4.0";
= };
=
- "elm/json" = {
- sha256 = "0kjwrz195z84kwywaxhhlnpl3p251qlbm5iz6byd6jky2crmyqyh";
- version = "1.1.3";
+ "elm/browser" = {
+ sha256 = "0nagb9ajacxbbg985r4k9h0jadqpp0gp84nm94kcgbr5sf8i9x13";
+ version = "1.0.2";
= };
=
- "ohanhi/keyboard" = {
- sha256 = "10sbq8v2kydnc3lkydl367g36q2b0xizxl031xyakrgl4zlh07ic";
- version = "2.0.1";
+ "elm/core" = {
+ sha256 = "19w0iisdd66ywjayyga4kv2p1v9rxzqjaxhckp8ni6n8i0fb2dvf";
+ version = "1.0.5";
= };
=
= "elm/html" = {
@@ -30,9 +35,14 @@
= version = "1.0.0";
= };
=
- "elm/svg" = {
- sha256 = "1cwcj73p61q45wqwgqvrvz3aypjyy3fw732xyxdyj6s256hwkn0k";
- version = "1.0.1";
+ "elm/http" = {
+ sha256 = "008bs76mnp48b4dw8qwjj4fyvzbxvlrl4xpa2qh1gg2kfwyw56v1";
+ version = "2.0.0";
+ };
+
+ "elm/json" = {
+ sha256 = "0kjwrz195z84kwywaxhhlnpl3p251qlbm5iz6byd6jky2crmyqyh";
+ version = "1.1.3";
= };
=
= "elm/parser" = {
@@ -40,24 +50,19 @@
= version = "1.1.0";
= };
=
- "elm/browser" = {
- sha256 = "0nagb9ajacxbbg985r4k9h0jadqpp0gp84nm94kcgbr5sf8i9x13";
- version = "1.0.2";
- };
-
- "elm/core" = {
- sha256 = "19w0iisdd66ywjayyga4kv2p1v9rxzqjaxhckp8ni6n8i0fb2dvf";
- version = "1.0.5";
- };
-
= "elm/random" = {
= sha256 = "138n2455wdjwa657w6sjq18wx2r0k60ibpc4frhbqr50sncxrfdl";
= version = "1.0.0";
= };
=
- "elm/http" = {
- sha256 = "008bs76mnp48b4dw8qwjj4fyvzbxvlrl4xpa2qh1gg2kfwyw56v1";
- version = "2.0.0";
+ "elm/regex" = {
+ sha256 = "0lijsp50w7n1n57mjg6clpn9phly8vvs07h0qh2rqcs0f1jqvsa2";
+ version = "1.0.0";
+ };
+
+ "elm/svg" = {
+ sha256 = "1cwcj73p61q45wqwgqvrvz3aypjyy3fw732xyxdyj6s256hwkn0k";
+ version = "1.0.1";
= };
=
= "elm/time" = {
@@ -65,6 +70,26 @@
= version = "1.0.0";
= };
=
+ "krisajenkins/remotedata" = {
+ sha256 = "0m5bk0qhsjv14vajqrkph386696pnhj5rn51kgma8lwyvvx9ihw1";
+ version = "6.0.1";
+ };
+
+ "mpizenberg/elm-pointer-events" = {
+ sha256 = "16s14sh01g6ssabwkf2k1xdxnahnkn0s7603cg87wd0h4myg15da";
+ version = "4.0.2";
+ };
+
+ "ohanhi/keyboard" = {
+ sha256 = "10sbq8v2kydnc3lkydl367g36q2b0xizxl031xyakrgl4zlh07ic";
+ version = "2.0.1";
+ };
+
+ "tad-lispy/springs" = {
+ sha256 = "1zrvgs0mrwbc6rp4asrb0rkrddjwv9ck4g5zz706a36v93y824dp";
+ version = "1.0.5";
+ };
+
= "elm/bytes" = {
= sha256 = "02ywbf52akvxclpxwj9n04jydajcbsbcbsnjs53yjc5lwck3abwj";
= version = "1.0.8";
@@ -84,4 +109,9 @@
= sha256 = "0q1v5gi4g336bzz1lgwpn5b1639lrn63d8y6k6pimcyismp2i1yg";
= version = "1.0.2";
= };
+
+ "elm-explorations/test" = {
+ sha256 = "16lpk71aiw6cz4g804sra0gzssqyp6w1s4c2zdnyywmfwwnxiw4s";
+ version = "2.1.0";
+ };
=}index 4de9614..05ab84d 100644
--- a/elm.json
+++ b/elm.json
@@ -33,7 +33,9 @@
= }
= },
= "test-dependencies": {
- "direct": {},
+ "direct": {
+ "elm-explorations/test": "2.1.0"
+ },
= "indirect": {}
= }
=}index b6249de..f0fb423 100644
--- a/flake.nix
+++ b/flake.nix
@@ -42,6 +42,8 @@
= pkgs.nodejs
= pkgs.elmPackages.elm
= pkgs.utillinux
+ pkgs.elmPackages.elm-test
+ pkgs.elmPackages.elm-verify-examples
= ];
= in rec {
= packages.word-snake = pkgs.stdenv.mkDerivation {index 5414248..6d24bfd 100644
--- a/node-packages.nix
+++ b/node-packages.nix
@@ -1894,6 +1894,15 @@ let
= sha512 = "XMVf3Ip9Iokv0FC3ulN/B0cb5O21qaw0RhUPz7zULQlY794ZpFP9mNtN7HvCVEgjl5/q2sYMcTA8l+5QJ2zZ/Q==";
= };
= };
+ "parcel-reporter-static-files-copy-1.5.0" = {
+ name = "parcel-reporter-static-files-copy";
+ packageName = "parcel-reporter-static-files-copy";
+ version = "1.5.0";
+ src = fetchurl {
+ url = "https://registry.npmjs.org/parcel-reporter-static-files-copy/-/parcel-reporter-static-files-copy-1.5.0.tgz";
+ sha512 = "dsY3MQkbYSgEqS0/22vtD2mZtel8UC0ItH0ok8LmgFeCMTsdhyOtJgvt945ODIzu9lYc/sCIzksM8C77uSE3Fg==";
+ };
+ };
= "parent-module-1.0.1" = {
= name = "parent-module";
= packageName = "parent-module";
@@ -2649,6 +2658,7 @@ let
= sources."once-1.4.0"
= sources."ordered-binary-1.4.0"
= sources."parcel-2.8.2"
+ sources."parcel-reporter-static-files-copy-1.5.0"
= sources."parent-module-1.0.1"
= sources."parse-json-5.2.0"
= sources."path-is-absolute-1.0.1"index e6b3e69..1eb4c6e 100644
--- a/src/Area.elm
+++ b/src/Area.elm
@@ -6,6 +6,7 @@ module Area exposing
= , default
= , edge
= , isOutside
+ , line
= , maxX
= , maxY
= , minX
@@ -14,6 +15,7 @@ module Area exposing
= , viewbox
= )
=
+import Direction exposing (Direction)
=import Position exposing (Position)
=import Random
=
@@ -99,6 +101,42 @@ centerY { center } =
= Tuple.second center
=
=
+{-| Returns a list of consecutive positions in a given direction, starting from a given position
+
+ import Direction exposing (Direction(..))
+
+ line North 3 ( 4, 5 )
+ --> [ ( 4, 5 ), ( 4, 4 ), ( 4, 3 ) ]
+
+Given a length of 0 or negative, will produce an empty list:
+
+ import Direction exposing (Direction(..))
+
+ line South 0 (5, 3)
+ --> []
+
+
+A line with a length of 1 will contain only the original position:
+
+ import Direction exposing (Direction(..))
+
+ line Direction.South 1 (3, -12)
+ --> [ (3, -12)]
+
+-}
+line : Direction -> Int -> Position -> List Position
+line direction length from =
+ if length < 1 then
+ []
+
+ else
+ let
+ shifted =
+ Position.shift direction from
+ in
+ from :: line direction (length - 1) shifted
+
+
=isOutside : Area -> Position -> Bool
=isOutside area ( x, y ) =
= (x < minX area) || (x > maxX area) || (y < minY area) || (y > maxY area)index 25d12d8..323dbaa 100644
--- a/src/Game.elm
+++ b/src/Game.elm
@@ -135,7 +135,7 @@ continue goal ({ area, snake, entities } as game) =
=clearPath : Position -> Direction -> Int -> Entities -> Entities
=clearPath from direction length entities =
= from
- |> line direction length
+ |> Area.line direction length
= |> List.foldl clearPosition entities
=
=
@@ -144,24 +144,6 @@ clearPosition position =
= Dict.remove position
=
=
-{-| Returns a list of consecutive positions in a given direction, starting from a given position
--}
-line : Direction -> Int -> Position -> List Position
-line direction length from =
- direction
- |> List.repeat length
- |> List.foldl prependShifted [ from ]
-
-
-prependShifted : Direction -> List Position -> List Position
-prependShifted direction positions =
- case positions of
- [] ->
- []
-
- head :: rest ->
- Position.shift direction head :: head :: rest
-
=
=
=-- VIEWindex c15f458..7d6f4a6 100644
--- a/src/Position.elm
+++ b/src/Position.elm
@@ -64,11 +64,11 @@ neighborhood ( x, y ) =
= --> ( 0, 0 )
=
=
- sector 4 ( 10 -8 )
+ sector 4 ( 10, -8 )
= --> ( 1, -1 )
=
= sector 8 ( -43, 22 )
- --> ( 1, -1 )
+ --> ( -3, 1 )
=
=-}
=sector : Int -> Position -> Positionnew file mode 100644
index 0000000..0e288b4
--- /dev/null
+++ b/tests/elm-verify-examples.json
@@ -0,0 +1,4 @@
+{
+ "root": "../src",
+ "tests": [ "Area", "Position" ]
+}Make the fire spread on the edge
On by
Instead of starting all at once, like a stove, make it start in one place (in front of the snake) and spread around, like a line of gasoline set on fire.
index ec63603..389953b 100644
--- a/src/Entities.elm
+++ b/src/Entities.elm
@@ -2,10 +2,14 @@ module Entities exposing
= ( Entities
= , Entity
= , State(..)
+ , collect
= , decay
+ , get
= , isPresent
+ , neighbors
= , spawn
- , step, get, collect, stateAt
+ , stateAt
+ , step
= )
=
={-| The Entities data structure represents environment that the snake can
@@ -37,7 +41,7 @@ type alias Entity =
=
=get : Position -> Entities -> List Entity
=get position entities =
- case stateAt position entities of
+ case stateAt position entities of
= Empty ->
= []
=
@@ -48,7 +52,7 @@ get position entities =
= [ entity ]
=
= Disappearing entity ->
- [ entity ]
+ [ entity ]
=
= Replacing old new ->
= [ old, new ]
@@ -56,6 +60,7 @@ get position entities =
= Collected entity ->
= [ entity ]
=
+
=stateAt : Position -> Entities -> State
=stateAt position entities =
= entities
@@ -129,6 +134,7 @@ collect position entity entities =
= -- NOTE: We trust that the entity was there to collect.
= Dict.insert position (Collected entity) entities
=
+
=decay : Position -> Entities -> Entities
=decay position entities =
= case stateAt position entities of
@@ -179,3 +185,10 @@ contains searching position state =
=
= Collected entity ->
= searching == entity
+
+
+neighbors : Position -> Entities -> List Entity
+neighbors position entities =
+ position
+ |> Position.neighborhood
+ |> List.concatMap (\neighbor -> get neighbor entities)index 323dbaa..6a1fe90 100644
--- a/src/Game.elm
+++ b/src/Game.elm
@@ -26,6 +26,7 @@ import Html.Events
=import Html.Events.Extra.Touch as Touch
=import Json.Decode as Decode
=import Keyboard
+import List.Extra as List
=import Maybe.Extra as Maybe
=import Position exposing (Position)
=import Random
@@ -145,7 +146,6 @@ clearPosition position =
=
=
=
-
=-- VIEW
=
=
@@ -833,7 +833,7 @@ update msg model =
= , entities =
= entities
= |> updateEntities model.goal model.snake
- |> burnTheEdge model.area burn
+ |> burnTheEdge model.area burn snake
= , randomness = randomness
= , snake = snake
= , swipe = model.swipe |> Maybe.map (\swipe -> { swipe | from = swipe.to })
@@ -1107,8 +1107,17 @@ subscriptions model =
=-- UTILS
=
=
-burnTheEdge : Area -> Bool -> Entities -> Entities
-burnTheEdge area burn entities =
+{-| Make sure the edge is burning
+
+This function is somewhat (too?) complicated. Basically this is what it does:
+
+- When the snake approaches the edge it sets it on fire in front of the snake.
+- Sets on fire every position on the edge when there is an adjacent flame.
+
+As a result, the edge starts burning in front of the snake and then the fire spreads all around it. If the snake turns, a new fire is started in front of it, so it is impossible to escape. It creates a nice effect.
+-}
+burnTheEdge : Area -> Bool -> Snake -> Entities -> Entities
+burnTheEdge area burn snake entities =
= let
= setOnFire : Position -> Entities -> Entities
= setOnFire position =
@@ -1117,15 +1126,51 @@ burnTheEdge area burn entities =
= |> Entities.get position
= |> List.member '🔥'
= then
+ -- Already burning. Leave it as it is.
= identity
=
= else
= Entities.spawn position '🔥'
+
+ {- Spread the fire from positions that already burn -}
+ spread : Position -> Entities -> Entities
+ spread position =
+ if
+ entities
+ |> Entities.neighbors position
+ |> List.member '🔥'
+ then
+ setOnFire position
+
+ else
+ identity
+
+ {- Start new fire in front of the snake -}
+ ignite : Entities -> Entities
+ ignite =
+ let
+ isAhead : Position -> Bool
+ isAhead position =
+ snake.head
+ |> Area.line snake.direction 6
+ |> List.member position
+ in
+ case
+ area
+ |> Area.edge
+ |> List.find isAhead
+ of
+ Nothing ->
+ identity
+
+ Just position ->
+ setOnFire position
= in
= if burn then
= area
= |> Area.edge
- |> List.foldl setOnFire entities
+ |> List.foldl spread entities
+ |> ignite
=
= else
= entitiesDraw a reference SVG for continous snake body
On by
The file contains head and tail tip as shapes, and also line markers. The idea is to draw an SVG path along the snake body and set start and end markers on it to mark head and tail. This will be implemented in next commit. This file is a reference drawing. In the future it might be automatically imported to the game at build or runtime. I haven't decided yet.
new file mode 100644
index 0000000..5fc203f
--- /dev/null
+++ b/art/snake.svg
@@ -0,0 +1,142 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<svg
+ width="4"
+ height="4"
+ viewBox="0 0 4 4"
+ version="1.1"
+ id="svg8"
+ inkscape:version="1.2.2 (b0a8486541, 2022-12-01)"
+ sodipodi:docname="snake.svg"
+ xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
+ xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
+ xmlns="http://www.w3.org/2000/svg"
+ xmlns:svg="http://www.w3.org/2000/svg"
+ xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+ xmlns:cc="http://creativecommons.org/ns#"
+ xmlns:dc="http://purl.org/dc/elements/1.1/">
+ <defs
+ id="defs2">
+ <marker
+ markerWidth="2.5"
+ markerHeight="1"
+ refX="0.5"
+ refY="0.5"
+ orient="auto"
+ id="marker989"
+ viewBox="0 0 2.5 1"
+ preserveAspectRatio="xMidYMid">
+ <path
+ style="color:#000000;fill:#008000;stroke-linecap:round;stroke-linejoin:round;-inkscape-stroke:none"
+ d="M 2.5,0.5 C 2.5,0.25 1.25,0 0.5,0 0.25,0 0,0.25 0,0.5 0,0.75 0.25,1 0.5,1 c 0.75,0 2,-0.25 2,-0.5 z"
+ id="tip-of-the-tail-3"
+ sodipodi:nodetypes="scscs"
+ inkscape:transform-center-x="-0.75" />
+ </marker>
+ <marker
+ markerWidth="1.7499681"
+ markerHeight="1.2613386"
+ refX="1"
+ refY="0.63099998"
+ orient="auto"
+ id="marker1111"
+ viewBox="0 0 1.7499681 1.2613386"
+ preserveAspectRatio="xMidYMid">
+ <g
+ id="head-6"
+ inkscape:transform-center-x="0.62498405"
+ inkscape:transform-center-y="0.010187537"
+ transform="translate(3.9999681,-0.37951825)">
+ <path
+ id="ellipse38010-7"
+ style="fill:#008000;stroke-width:0.00250406;paint-order:stroke fill markers"
+ d="M -3.0056977,0.39122066 C -2.7499084,0.33493002 -2.75,0.49999998 -2.5,0.49999999 c 0.1540952,2e-8 0.25,0.36855429 0.25,0.50000001 0,0.1753797 -0.1048943,0.5 -0.25,0.5 -0.25,0 -0.2338606,0.1928022 -0.4942705,0.127269 C -3.5,1.5 -3.9999386,1.5 -3.9999681,1.0184896 -4,0.49999999 -3.5,0.50000001 -3.0056977,0.39122066 Z"
+ sodipodi:nodetypes="sssssss" />
+ <path
+ id="ellipse33447-5"
+ style="stroke-width:0.00250406;paint-order:stroke fill markers"
+ d="m -3.4247252,0.70346431 a 0.08485731,0.18134895 74.470359 0 0 0.1974477,0.0332056 0.08485731,0.18134895 74.470359 0 0 0.1520089,-0.13031314 0.08485731,0.18134895 74.470359 0 0 -0.1974478,-0.0332055 0.08485731,0.18134895 74.470359 0 0 -0.1520088,0.13031304 z" />
+ <path
+ id="ellipse33447-9-3"
+ style="stroke-width:0.00250406;paint-order:stroke fill markers"
+ d="m -3.4247288,1.2965332 a 0.18134895,0.08485731 15.52964 0 1 0.1974476,-0.033205 0.18134895,0.08485731 15.52964 0 1 0.1520089,0.1303128 0.18134895,0.08485731 15.52964 0 1 -0.1974475,0.033205 0.18134895,0.08485731 15.52964 0 1 -0.152009,-0.1303128 z" />
+ </g>
+ </marker>
+ </defs>
+ <sodipodi:namedview
+ id="base"
+ pagecolor="#ffffff"
+ bordercolor="#666666"
+ borderopacity="1.0"
+ inkscape:pageopacity="0.0"
+ inkscape:pageshadow="2"
+ inkscape:zoom="128"
+ inkscape:cx="-1.9257813"
+ inkscape:cy="2.125"
+ inkscape:document-units="px"
+ inkscape:current-layer="layer1"
+ inkscape:document-rotation="0"
+ showgrid="true"
+ units="px"
+ scale-x="1"
+ inkscape:showpageshadow="0"
+ inkscape:pagecheckerboard="1"
+ inkscape:deskcolor="#d1d1d1"
+ inkscape:window-width="1920"
+ inkscape:window-height="1011"
+ inkscape:window-x="0"
+ inkscape:window-y="0"
+ inkscape:window-maximized="1">
+ <inkscape:grid
+ type="xygrid"
+ id="grid34366"
+ originx="0"
+ originy="0"
+ spacingx="0.25"
+ spacingy="0.25" />
+ </sodipodi:namedview>
+ <metadata
+ id="metadata5">
+ <rdf:RDF>
+ <cc:Work
+ rdf:about="">
+ <dc:format>image/svg+xml</dc:format>
+ <dc:type
+ rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
+ </cc:Work>
+ </rdf:RDF>
+ </metadata>
+ <g
+ inkscape:label="Layer 1"
+ inkscape:groupmode="layer"
+ id="layer1">
+ <path
+ style="fill:none;stroke:#008000;stroke-width:1px;stroke-linecap:round;stroke-linejoin:round;stroke-opacity:1;font-variation-settings:normal;opacity:1;vector-effect:none;fill-opacity:1;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;-inkscape-stroke:none;stop-color:#000000;stop-opacity:1;marker-end:url(#marker989);marker-start:url(#marker1111)"
+ d="M 1,1 H 2 3 V 2 3 H 2"
+ id="path34368"
+ sodipodi:nodetypes="cccccc" />
+ <path
+ style="color:#000000;fill:#008000;stroke-linecap:round;stroke-linejoin:round;-inkscape-stroke:none"
+ d="m -1.5,3 c 0,-0.25 -1.25,-0.5 -2,-0.5 -0.25,0 -0.5,0.25 -0.5,0.5 0,0.25 0.25,0.5 0.5,0.5 0.75,0 2,-0.25 2,-0.5 z"
+ id="tip-of-the-tail"
+ sodipodi:nodetypes="scscs"
+ inkscape:transform-center-x="-0.75" />
+ <g
+ id="head"
+ inkscape:transform-center-x="0.62498405"
+ inkscape:transform-center-y="0.010187537">
+ <path
+ id="ellipse38010"
+ style="fill:#008000;stroke-width:0.00250406;paint-order:stroke fill markers"
+ d="M -3.0056977,0.39122066 C -2.7499084,0.33493002 -2.75,0.49999998 -2.5,0.49999999 c 0.1540952,2e-8 0.25,0.36855429 0.25,0.50000001 0,0.1753797 -0.1048943,0.5 -0.25,0.5 -0.25,0 -0.2338606,0.1928022 -0.4942705,0.127269 C -3.5,1.5 -3.9999386,1.5 -3.9999681,1.0184896 -4,0.49999999 -3.5,0.50000001 -3.0056977,0.39122066 Z"
+ sodipodi:nodetypes="sssssss" />
+ <path
+ id="ellipse33447"
+ style="stroke-width:0.00250406;paint-order:stroke fill markers"
+ d="m -3.4247252,0.70346431 a 0.08485731,0.18134895 74.470359 0 0 0.1974477,0.0332056 0.08485731,0.18134895 74.470359 0 0 0.1520089,-0.13031314 0.08485731,0.18134895 74.470359 0 0 -0.1974478,-0.0332055 0.08485731,0.18134895 74.470359 0 0 -0.1520088,0.13031304 z" />
+ <path
+ id="ellipse33447-9"
+ style="stroke-width:0.00250406;paint-order:stroke fill markers"
+ d="m -3.4247288,1.2965332 a 0.18134895,0.08485731 15.52964 0 1 0.1974476,-0.033205 0.18134895,0.08485731 15.52964 0 1 0.1520089,0.1303128 0.18134895,0.08485731 15.52964 0 1 -0.1974475,0.033205 0.18134895,0.08485731 15.52964 0 1 -0.152009,-0.1303128 z" />
+ </g>
+ </g>
+</svg>Give snake a continuous body
On by
No more beads. A snake is now displayed as a solid line with a head and tail.
This required a major rework of many parts of the system, with some side benefits.
The transition of the snake is no longer delegated to CSS. Now the game subscribes to animation frame events and updates the snake path directly.
The snake body is now modeled as a list of directions (from head to neck, from neck to torso, and so forth). This drastically simplifies many operations and seems to perform better.
There are many new helper functions, some with tests. Also, a new module for the planned tad-lispy/extra package: Tad.Basics with the applyIf function.
There are minor regressions that are not yet remedied.
The snake visually stops moving before entering a position that killed it. Logically it's there, but to prevent twitching of a dead snake, it's movement stops. It looks off.
There is no visual indicator of snake being dead.
index 1eb4c6e..bf65b3d 100644
--- a/src/Area.elm
+++ b/src/Area.elm
@@ -6,7 +6,6 @@ module Area exposing
= , default
= , edge
= , isOutside
- , line
= , maxX
= , maxY
= , minX
@@ -32,6 +31,23 @@ default =
= Area 16 16 ( 0, 0 )
=
=
+{-| Edge is a collection of positions forming a rectangle around the center
+
+ import Set
+
+ Area 5 5 ( 3, 2 )
+ |> edge
+ |> Set.fromList
+
+ --> [ (1, 0), (2, 0), (3, 0), (4, 0), (5, 0)
+ --> , (1, 1) , (5, 1)
+ --> , (1, 2) {- 3, 2 -} , (5, 2)
+ --> , (1, 3) , (5, 3)
+ --> , (1, 4), (2, 4), (3, 4), (4, 4), (5, 4)
+ --> ]
+ --> |> Set.fromList
+
+-}
=edge : Area -> List Position
=edge area =
= let
@@ -101,42 +117,6 @@ centerY { center } =
= Tuple.second center
=
=
-{-| Returns a list of consecutive positions in a given direction, starting from a given position
-
- import Direction exposing (Direction(..))
-
- line North 3 ( 4, 5 )
- --> [ ( 4, 5 ), ( 4, 4 ), ( 4, 3 ) ]
-
-Given a length of 0 or negative, will produce an empty list:
-
- import Direction exposing (Direction(..))
-
- line South 0 (5, 3)
- --> []
-
-
-A line with a length of 1 will contain only the original position:
-
- import Direction exposing (Direction(..))
-
- line Direction.South 1 (3, -12)
- --> [ (3, -12)]
-
--}
-line : Direction -> Int -> Position -> List Position
-line direction length from =
- if length < 1 then
- []
-
- else
- let
- shifted =
- Position.shift direction from
- in
- from :: line direction (length - 1) shifted
-
-
=isOutside : Area -> Position -> Bool
=isOutside area ( x, y ) =
= (x < minX area) || (x > maxX area) || (y < minY area) || (y > maxY area)index 77762a5..f94f92f 100644
--- a/src/Direction.elm
+++ b/src/Direction.elm
@@ -1,4 +1,9 @@
-module Direction exposing (Direction(..), toString, arrow)
+module Direction exposing
+ ( Direction(..)
+ , arrow
+ , opposite
+ , toString
+ )
=
=
=type Direction
@@ -38,3 +43,19 @@ arrow direction =
=
= West ->
= "👈"
+
+
+opposite : Direction -> Direction
+opposite direction =
+ case direction of
+ North ->
+ South
+
+ East ->
+ West
+
+ South ->
+ North
+
+ West ->
+ Eastindex 6a1fe90..b69de26 100644
--- a/src/Game.elm
+++ b/src/Game.elm
@@ -16,6 +16,7 @@ port module Game exposing
=
=import Area exposing (Area)
=import Browser.Events
+import Coordinates
=import Dict
=import Direction exposing (Direction(..))
=import Entities exposing (Entities, Entity)
@@ -36,6 +37,7 @@ import Spring exposing (Spring)
=import Svg exposing (Svg)
=import Svg.Attributes
=import Svg.Keyed
+import Tad.Basics exposing (..)
=import Tad.Html as Html
=import Time
=import Transformations
@@ -47,6 +49,13 @@ port keydown : (Decode.Value -> msg) -> Sub msg
=port preventDefault : Decode.Value -> Cmd msg
=
=
+{-| Pace is the duration of a step in milliseconds
+-}
+pace : Float
+pace =
+ 250
+
+
=type alias Model =
= { area : Area
= , tiles : Set Position
@@ -58,6 +67,7 @@ type alias Model =
= , randomness : Random.Seed
= , swipe : Maybe Swipe
= , countdown : Int
+ , progress : Float -- TODO: Progress is an amount of time (in ms) since last step. Find a better name.
= }
=
=
@@ -103,6 +113,7 @@ init flags =
= , randomness = flags.randomness
= , swipe = Nothing
= , countdown = Goal.coundown flags.goal
+ , progress = 0
= }
=
=
@@ -112,21 +123,15 @@ continue goal ({ area, snake, entities } as game) =
= | goal = goal
= , area = { area | center = game.snake.head }
= , snake =
- { snake
- | death = Nothing
- , body =
- if Snake.isAlive snake then
- snake.body
-
- else
- List.repeat 3 snake.head
- , tail =
- if Snake.isAlive snake then
- snake.tail
+ if Snake.isAlive snake then
+ snake
=
- else
- snake.head
- }
+ else
+ { snake
+ | death = Nothing
+ , body = []
+ , length = 5
+ }
= , word = ""
= , entities = clearPath snake.head snake.direction 5 entities
= , countdown = Goal.coundown goal
@@ -136,7 +141,7 @@ continue goal ({ area, snake, entities } as game) =
=clearPath : Position -> Direction -> Int -> Entities -> Entities
=clearPath from direction length entities =
= from
- |> Area.line direction length
+ |> Position.line direction length
= |> List.foldl clearPosition entities
=
=
@@ -429,7 +434,7 @@ viewArea model =
= entities =
= [ viewBackground model.tiles
= , viewEntities model.entities
- , viewSnake model.snake
+ , viewSnake model.progress model.snake
= ]
= |> Svg.g
= [ Transformations.Translate "px"
@@ -451,7 +456,8 @@ viewArea model =
= , Touch.onMove TouchMoved
= , Touch.onCancel TouchCanceled
= ]
- [ entities
+ [ viewDefs
+ , entities
= ]
=
=
@@ -494,127 +500,247 @@ viewEntities entities =
= ]
=
=
-viewSnake : Snake -> Svg Msg
-viewSnake snake =
+viewSnake : Float -> Snake -> Svg Msg
+viewSnake progress snake =
= let
- alive =
- Snake.isAlive snake
- in
- [ viewBody alive snake.body
- , viewTail alive snake.tail
- , viewHead alive snake.head
- ]
- |> Svg.g
- [ Html.Attributes.style "pointer-events" "none"
- ]
+ distance : Float
+ distance =
+ -- FIXME: When the snake hits a poop or fire the movement stops before the head moves on the killing position.
+ --
+ -- The snake should move and then die. Otherwise it looks weird. But
+ -- without the condition below, dead snake keeps twitching. I'm not
+ -- yet sure what's the fix. It might be here, or in the step
+ -- function, or somewhere lese.
+ if Snake.isAlive snake then
+ 1 - progress
=
+ else
+ 1
+ in
+ -- TODO: Multiple stripes
+ -- [ viewStripe 0.8 "#133d1a" points
+ -- , viewStripe 0.7 "#106023" points
+ -- , viewStripe 0.5 "#1e7d35" points
+ -- , viewStripe 0.2 "#5bb171" points
+ -- ]
+ -- |> Svg.g []
+ case snake.body of
+ [] ->
+ -- Just the head, so no direction.
+ Svg.circle
+ [ Svg.Attributes.cx "0"
+ , Svg.Attributes.cy "0"
+ , Svg.Attributes.r (String.fromFloat (0.3 * scale))
+ , Svg.Attributes.fill "green"
+ , snake.head
+ |> Coordinates.fromPosition scale
+ |> Coordinates.toTransformation ""
+ |> Transformations.toString
+ |> Svg.Attributes.transform
+ ]
+ []
=
-viewHead : Bool -> Position -> Svg Msg
-viewHead alive position =
- let
- shape =
- if alive then
- Svg.circle
- [ (0.3 * scale)
- |> String.fromFloat
- |> Svg.Attributes.r
- , Svg.Attributes.fill "green"
+ [ neck ] ->
+ -- Snake only has one segment. Head goes straight from it.
+ let
+ d =
+ [ snake.head
+ |> Coordinates.fromPosition scale
+ |> Coordinates.shift (distance * scale) neck
+ |> Coordinates.toString
+ |> String.append "M "
+ , snake.head
+ |> Coordinates.fromPosition scale
+ |> Coordinates.shift scale neck
+ |> Coordinates.toString
+ |> String.append "L "
= ]
- []
+ |> String.join "\n"
+ |> Svg.Attributes.d
+ in
+ Svg.path
+ [ d
+ , 0.3
+ * scale
+ |> String.fromFloat
+ |> Svg.Attributes.strokeWidth
+ , Svg.Attributes.fill "none"
+ , Svg.Attributes.color "green"
+ , Svg.Attributes.stroke "currentColor"
+ , Svg.Attributes.strokeLinecap "round"
+ , Svg.Attributes.strokeLinejoin "round"
+ , Svg.Attributes.markerStart "url(#head-marker)"
+ , Svg.Attributes.markerEnd "url(#tail-marker)"
+ ]
+ []
=
- else
- "☠️"
- |> Svg.text
- |> List.singleton
- |> Svg.text_
- [ (0.8 * scale)
- |> String.fromFloat
- |> Svg.Attributes.fontSize
- , Html.Attributes.style "text-anchor" "middle"
- , Html.Attributes.style "dominant-baseline" "middle"
- ]
- in
- viewSegment shape position
+ neck :: torso :: tail ->
+ -- A proper snake.
+ let
+ d : String
+ d =
+ dHead distance neck snake.head
+ :: dNeck
+ :: dTail tipDistance torsoPosition tail
+ |> String.join "\n"
+
+ dNeck =
+ neckCoordinates
+ |> Coordinates.toString
+ |> String.append "L "
+
+ neckCoordinates =
+ snake.head
+ |> Position.shift neck
+ |> Coordinates.fromPosition scale
+ |> Coordinates.shift (scale * distance) torso
+
+ torsoPosition =
+ snake.head
+ |> Position.shift neck
+ |> Position.shift torso
=
+ tipDistance =
+ if Snake.isGrowing snake then
+ 1
=
-viewBody : Bool -> List Position -> Svg Msg
-viewBody alive segments =
- segments
- |> List.map (viewBodySegment alive)
- |> Svg.g []
+ else
+ distance
+ in
+ Svg.path
+ [ d |> Svg.Attributes.d
+ , 0.3
+ * scale
+ |> String.fromFloat
+ |> Svg.Attributes.strokeWidth
+ , Svg.Attributes.fill "none"
+ , Svg.Attributes.color "green"
+ , Svg.Attributes.stroke "currentColor"
+ , Svg.Attributes.strokeLinecap "round"
+ , Svg.Attributes.strokeLinejoin "round"
+ , Svg.Attributes.markerStart "url(#head-marker)"
+ , Svg.Attributes.markerEnd "url(#tail-marker)"
+ ]
+ []
=
=
-viewTail : Bool -> Position -> Svg Msg
-viewTail alive position =
- let
- shape =
- if alive then
- Svg.circle
- [ (0.1 * scale)
- |> String.fromFloat
- |> Svg.Attributes.r
- , Svg.Attributes.fill "green"
- ]
- []
+dTail : Float -> Position -> List Direction -> List String
+dTail distance start directions =
+ case directions of
+ [] ->
+ [ start
+ |> Coordinates.fromPosition scale
+ |> Coordinates.toString
+ |> String.append "L "
+ ]
=
- else
- "🦴"
- |> Svg.text
- |> List.singleton
- |> Svg.text_
- [ (0.3 * scale)
- |> String.fromFloat
- |> Svg.Attributes.fontSize
- , Html.Attributes.style "text-anchor" "middle"
- , Html.Attributes.style "dominant-baseline" "middle"
- ]
- in
- viewSegment shape position
+ tipDirection :: [] ->
+ [ start
+ |> Coordinates.fromPosition scale
+ |> Coordinates.shift (scale * distance) tipDirection
+ |> Coordinates.toString
+ |> String.append "L "
+ ]
=
+ previousDirection :: tipDirection :: [] ->
+ -- Tip of the tail needs a spacial treatment. It needs to start on start position and be extended in a
+ let
+ next =
+ start
+ |> Position.shift previousDirection
+ in
+ [ start
+ |> Coordinates.fromPosition scale
+ |> Coordinates.toString
+ |> String.append "L "
+ , start
+ |> Coordinates.fromPosition scale
+ |> Coordinates.shift (scale * distance) previousDirection
+ |> Coordinates.toString
+ |> String.append "L "
+ ]
+ ++ dTail distance next [ tipDirection ]
=
-viewBodySegment : Bool -> Position -> Svg Msg
-viewBodySegment alive position =
- let
- shape =
- if alive then
- Svg.circle
- [ (0.2 * scale)
- |> String.fromFloat
- |> Svg.Attributes.r
- , Svg.Attributes.fill "green"
- ]
- []
+ direction :: rest ->
+ let
+ dLine =
+ start
+ |> Coordinates.fromPosition scale
+ |> Coordinates.toString
+ |> String.append "L "
+
+ next =
+ start
+ |> Position.shift direction
+ in
+ dLine :: dTail distance next rest
=
- else
- "🦴"
- |> Svg.text
- |> List.singleton
- |> Svg.text_
- [ (0.6 * scale)
- |> String.fromFloat
- |> Svg.Attributes.fontSize
- , Html.Attributes.style "text-anchor" "middle"
- , Html.Attributes.style "dominant-baseline" "middle"
- ]
- in
- viewSegment shape position
=
+dHead : Float -> Direction -> Position -> String
+dHead distance neck head =
+ head
+ |> Coordinates.fromPosition scale
+ |> Coordinates.shift (distance * scale) neck
+ |> Coordinates.toString
+ |> String.append "M "
=
-viewSegment : Svg Msg -> Position -> Svg Msg
-viewSegment shape ( x, y ) =
- shape
- |> List.singleton
- |> Svg.g
- [ -- I would prefer to have this unitless (after all we are using SVG
- -- for scaling), but Firefox does not apply transition to SVG transform
- -- attribute, and CSS property requires a unit.
- Transformations.Translate "px"
- (Basics.toFloat x * scale)
- (Basics.toFloat y * scale)
- |> Transformations.toString
- |> Html.Attributes.style "transform"
- , Html.Attributes.style "transition" "transform 200ms linear"
+
+viewDefs : Svg Msg
+viewDefs =
+ -- TODO: Find a way to reference SVG line markers from external document.
+ -- This was drawn in Inkscape (see art/snake.svg) and hand-converted to Elm. Not a very maintainable workflow.
+ Svg.defs
+ []
+ [ Svg.marker
+ [ Svg.Attributes.id "tail-marker"
+ , Svg.Attributes.markerWidth "2.5"
+ , Svg.Attributes.markerHeight "1"
+ , Svg.Attributes.refX "0.5"
+ , Svg.Attributes.refY "0.5"
+ , Svg.Attributes.orient "auto"
+ , Svg.Attributes.viewBox "0 0 2.5 1"
+ , Svg.Attributes.preserveAspectRatio "xMidYMid"
+ ]
+ [ Svg.path
+ [ Svg.Attributes.fill "green" -- TODO: context-stroke, currently not supported by Firefox?
+ , Svg.Attributes.d "M 2.5,0.5 C 2.5,0.25 1.25,0 0.5,0 0.25,0 0,0.25 0,0.5 0,0.75 0.25,1 0.5,1 c 0.75,0 2,-0.25 2,-0.5 z"
+ ]
+ []
= ]
+ , Svg.marker
+ [ Svg.Attributes.id "head-marker"
+ , Svg.Attributes.markerWidth "1.7499681"
+ , Svg.Attributes.markerHeight "1.2613386"
+ , Svg.Attributes.refX "1"
+ , Svg.Attributes.refY "0.63099998"
+ , Svg.Attributes.orient "auto"
+ , Svg.Attributes.viewBox "0 0 1.7499681 1.2613386"
+ , Svg.Attributes.preserveAspectRatio "xMidYMid"
+ ]
+ [ Svg.g
+ [ Svg.Attributes.transform "translate(3.9999681,-0.37951825)"
+ ]
+ [ Svg.path
+ [ Svg.Attributes.id "head"
+ , Svg.Attributes.fill "green" -- TODO: context-stroke, currently not supported by Firefox?
+ , Svg.Attributes.d "M -3.0056977,0.39122066 C -2.7499084,0.33493002 -2.75,0.49999998 -2.5,0.49999999 c 0.1540952,2e-8 0.25,0.36855429 0.25,0.50000001 0,0.1753797 -0.1048943,0.5 -0.25,0.5 -0.25,0 -0.2338606,0.1928022 -0.4942705,0.127269 C -3.5,1.5 -3.9999386,1.5 -3.9999681,1.0184896 -4,0.49999999 -3.5,0.50000001 -3.0056977,0.39122066 Z"
+ ]
+ []
+ , Svg.path
+ [ Svg.Attributes.id "right-eye"
+ , Svg.Attributes.fill "black"
+ , Svg.Attributes.d "m -3.4247252,0.70346431 a 0.08485731,0.18134895 74.470359 0 0 0.1974477,0.0332056 0.08485731,0.18134895 74.470359 0 0 0.1520089,-0.13031314 0.08485731,0.18134895 74.470359 0 0 -0.1974478,-0.0332055 0.08485731,0.18134895 74.470359 0 0 -0.1520088,0.13031304 z"
+ ]
+ []
+ , Svg.path
+ [ Svg.Attributes.id "left-eye"
+ , Svg.Attributes.fill "black"
+ , Svg.Attributes.d "m -3.4247288,1.2965332 a 0.18134895,0.08485731 15.52964 0 1 0.1974476,-0.033205 0.18134895,0.08485731 15.52964 0 1 0.1520089,0.1303128 0.18134895,0.08485731 15.52964 0 1 -0.1974475,0.033205 0.18134895,0.08485731 15.52964 0 1 -0.152009,-0.1303128 z"
+ ]
+ []
+ ]
+ ]
+ ]
=
=
=viewPosition : ( Position, Entities.State ) -> ( String, Svg Msg )
@@ -733,7 +859,6 @@ viewEntity entity =
=type Msg
= = NoOp Never
= | CountdownClockTick Time.Posix
- | Step Time.Posix
= | NextFrame Float
= | KeyPressed (Maybe Keyboard.Key)
= | TouchStarted Touch.Event
@@ -755,100 +880,24 @@ update msg model =
= , Cmd.none
= )
=
- Step _ ->
- let
- direction : Direction
- direction =
- model.swipe
- |> Maybe.andThen swipeDirection
- |> Maybe.withDefault model.snake.direction
-
- ( entities, randomness ) =
- model.entities
- |> Entities.step
- |> randomDecay decayRatio
- |> Random.andThen
- (randomSpawn
- model.area
- model.goal
- model.snake
- )
- |> (\generator -> Random.step generator model.randomness)
-
- decayRatio =
- if outcome model == InProgress then
- 0.01
-
- else
- 0.3
-
- goal : Goal
- goal =
- model.goal
- |> updateGoal model.snake model.entities
-
- snake : Snake
- snake =
- model.snake
- |> Snake.setDirection direction
- |> updateSnake entities
- |> Snake.move
-
- tiles =
- snake.head
- |> Position.sector backgroundTileSize
- |> Position.neighborhood
- |> List.foldr Set.insert model.tiles
-
- burn : Bool
- burn =
- case model.goal of
- CompleteSentence _ _ ->
- not (Goal.isCompleted goal) && Snake.isAlive snake
-
- _ ->
- False
-
- panX =
- snake.head
- |> Tuple.first
- |> toFloat
- |> (*) scale
-
- panY =
- snake.head
- |> Tuple.second
- |> toFloat
- |> (*) scale
-
- pan =
- { x = Spring.setTarget panX model.pan.x
- , y = Spring.setTarget panY model.pan.y
- }
- in
- ( { model
- | goal = goal
- , tiles = tiles
- , pan = pan
- , entities =
- entities
- |> updateEntities model.goal model.snake
- |> burnTheEdge model.area burn snake
- , randomness = randomness
- , snake = snake
- , swipe = model.swipe |> Maybe.map (\swipe -> { swipe | from = swipe.to })
- }
- , Cmd.none
- )
-
= NextFrame delta ->
= let
= pan =
= { x = Spring.animate delta model.pan.x
= , y = Spring.animate delta model.pan.y
= }
+
+ progress =
+ model.progress + (delta / pace)
+
+ overflow =
+ progress - (progress |> floor |> toFloat)
= in
- ( { model | pan = pan }
+ ( { model
+ | pan = pan
+ , progress = overflow
+ }
+ |> applyIf (progress > 1) step
= , Cmd.none
= )
=
@@ -1041,6 +1090,92 @@ update msg model =
= )
=
=
+step : Model -> Model
+step model =
+ let
+ direction : Direction
+ direction =
+ model.swipe
+ |> Maybe.andThen swipeDirection
+ |> Maybe.withDefault model.snake.direction
+
+ ( entities, randomness ) =
+ model.entities
+ |> Entities.step
+ |> randomDecay decayRatio
+ |> Random.andThen
+ (randomSpawn
+ model.area
+ model.goal
+ model.snake
+ )
+ |> (\generator -> Random.step generator model.randomness)
+
+ decayRatio =
+ if outcome model == InProgress then
+ 0.01
+
+ else
+ 0.3
+
+ goal : Goal
+ goal =
+ model.goal
+ |> updateGoal model.snake model.entities
+
+ snake : Snake
+ snake =
+ model.snake
+ |> Snake.setDirection direction
+ |> applyIf (Snake.isAlive model.snake) Snake.move
+ |> updateSnake entities
+
+ tiles =
+ snake.head
+ |> Position.sector backgroundTileSize
+ |> Position.neighborhood
+ |> List.foldr Set.insert model.tiles
+
+ burn : Bool
+ burn =
+ case model.goal of
+ CompleteSentence _ _ ->
+ not (Goal.isCompleted goal) && Snake.isAlive snake
+
+ _ ->
+ False
+
+ panX =
+ snake.head
+ |> Tuple.first
+ |> toFloat
+ |> (*) scale
+
+ panY =
+ snake.head
+ |> Tuple.second
+ |> toFloat
+ |> (*) scale
+
+ pan =
+ { x = Spring.setTarget panX model.pan.x
+ , y = Spring.setTarget panY model.pan.y
+ }
+ in
+ { model
+ | goal = goal
+ , tiles = tiles
+ , pan = pan
+ , entities =
+ entities
+ |> updateEntities model.goal model.snake
+ |> burnTheEdge model.area burn snake
+ , randomness = randomness
+ , snake = snake
+ , swipe = model.swipe |> Maybe.map (\swipe -> { swipe | from = swipe.to })
+ }
+
+
=updateGoal : Snake -> Entities -> Goal -> Goal
=updateGoal snake entities goal =
= case goal of
@@ -1091,13 +1226,9 @@ subscriptions model =
= Time.every 1000 CountdownClockTick
=
= else
- Time.every 250 Step
-
- frames =
- Browser.Events.onAnimationFrameDelta NextFrame
+ Browser.Events.onAnimationFrameDelta NextFrame
= in
= [ clock
- , frames
= , keydown decodeKeydown
= ]
= |> Sub.batch
@@ -1111,10 +1242,11 @@ subscriptions model =
=
=This function is somewhat (too?) complicated. Basically this is what it does:
=
-- When the snake approaches the edge it sets it on fire in front of the snake.
-- Sets on fire every position on the edge when there is an adjacent flame.
+ - When the snake approaches the edge it sets it on fire in front of the snake.
+ - Sets on fire every position on the edge when there is an adjacent flame.
=
=As a result, the edge starts burning in front of the snake and then the fire spreads all around it. If the snake turns, a new fire is started in front of it, so it is impossible to escape. It creates a nice effect.
+
=-}
=burnTheEdge : Area -> Bool -> Snake -> Entities -> Entities
=burnTheEdge area burn snake entities =
@@ -1152,7 +1284,7 @@ burnTheEdge area burn snake entities =
= isAhead : Position -> Bool
= isAhead position =
= snake.head
- |> Area.line snake.direction 6
+ |> Position.line snake.direction 6
= |> List.member position
= in
= case
@@ -1215,7 +1347,7 @@ processCollected goal snake entity entities =
= else
= entities
= |> Entities.decay snake.head
- |> Entities.spawn snake.tail '💩'
+ |> Entities.spawn (Snake.tail snake) '💩'
=
= ReadInstructions _ ->
= entities
@@ -1230,7 +1362,7 @@ processCollected goal snake entity entities =
= else
= entities
= |> Entities.decay snake.head
- |> Entities.spawn snake.tail '💩'
+ |> Entities.spawn (Snake.tail snake) '💩'
=
= CollectSingle _ [] ->
= entities
@@ -1344,15 +1476,20 @@ randomSpawn :
= -> Random.Generator Entities
=randomSpawn area goal snake entities =
= let
+ isUnderTheSnake position =
+ snake.body
+ |> Position.trace snake.head
+ |> List.member position
+
+ isInFrontOfTheSnake : Position -> Bool
+ isInFrontOfTheSnake position =
+ snake.head
+ |> Position.line snake.direction 3
+ |> List.member position
+
= insert : Bool -> Position -> Char -> Entities
= insert spawn position entity =
- if
- spawn
- && position
- /= snake.head
- && not (List.member position snake.body)
- -- TODO: Do not spawn right in front of the snake, say 3 positions ahead
- then
+ if spawn && not (isUnderTheSnake position) && not (isInFrontOfTheSnake position) then
= Entities.spawn position entity entities
=
= elseindex 7d6f4a6..343fbf8 100644
--- a/src/Position.elm
+++ b/src/Position.elm
@@ -1,12 +1,15 @@
=module Position exposing
= ( Position
+ , line
= , neighborhood
= , sector
= , sectorLength
= , shift
+ , trace
= )
=
=import Direction exposing (Direction(..))
+import List.Extra as List
=
=
=type alias Position =
@@ -45,6 +48,62 @@ neighborhood ( x, y ) =
= ]
=
=
+{-| Returns a list of consecutive positions in a given direction, starting from a given position
+
+ import Direction exposing (Direction(..))
+
+ line North 3 ( 4, 5 )
+ --> [ ( 4, 5 ), ( 4, 4 ), ( 4, 3 ) ]
+
+Given a length of 0 or negative, will produce an empty list:
+
+ import Direction exposing (Direction(..))
+
+ line South 0 (5, 3)
+ --> []
+
+A line with a length of 1 will contain only the original position:
+
+ import Direction exposing (Direction(..))
+
+ line Direction.South 1 (3, -12)
+ --> [ (3, -12)]
+
+-}
+line : Direction -> Int -> Position -> List Position
+line direction length from =
+ if length < 1 then
+ []
+
+ else
+ let
+ shifted =
+ shift direction from
+ in
+ from :: line direction (length - 1) shifted
+
+
+{-| Given a list of directions returns a list of intermediate positions starting at ( 0, 0 )
+
+ import Direction exposing (Direction(..))
+
+
+ trace (2, -3) [ North, North, East, South ]
+ --> [ (2, -3)
+ --> , (2, -4)
+ --> , (2, -5)
+ --> , (3, -5)
+ --> , (3, -4)
+ --> ]
+
+Useful for analyzing the snake body.
+
+-}
+trace : Position -> List Direction -> List Position
+trace start directions =
+ List.scanl shift start directions
+
+
=
=-- SECTOR
=-- TODO: Move to own module?index d09754b..6ca3d7f 100644
--- a/src/Snake.elm
+++ b/src/Snake.elm
@@ -4,23 +4,27 @@ module Snake exposing
= , feed
= , grow
= , isAlive
+ , isColliding
= , isDead
= , kill
= , move
= , new
= , setDirection
+ , tail, isGrowing
= )
=
=import Direction exposing (Direction)
=import Entities exposing (Entity)
+import List exposing (length)
+import List.Extra as List
=import Position exposing (Position)
=
=
=type alias Snake =
= { head : Position
- , body : List Position -- TODO: body : List Direction
- , tail : Position
= , direction : Direction
+ , body : List Direction
+ , length : Int
= , death : Maybe CauseOfDeath
= }
=
@@ -34,9 +38,12 @@ type CauseOfDeath
=new : Position -> Direction -> Int -> Snake
=new head direction length =
= { head = head
- , body = List.repeat length ( 0, 0 )
- , tail = ( 0, 0 )
= , direction = direction
+ , body =
+ direction
+ |> Direction.opposite
+ |> List.repeat length
+ , length = length
= , death = Nothing
= }
=
@@ -58,78 +65,72 @@ move snake =
= head =
= Position.shift snake.direction snake.head
=
- body : List Position
+ body : List Direction
= body =
- snake.body
- |> List.foldl moveSegments ( snake.head, [] )
- |> Tuple.second
- |> List.reverse
-
- tail : Position
- tail =
- snake.body
- |> List.reverse
- |> List.head
- |> Maybe.withDefault snake.head
-
- moveSegments : Position -> ( Position, List Position ) -> ( Position, List Position )
- moveSegments segment ( target, segments ) =
- ( segment, target :: segments )
+ Direction.opposite snake.direction
+ :: snake.body
+ |> List.take snake.length
=
= death : Maybe CauseOfDeath
= death =
- if List.member head body then
+ if isColliding snake then
= Just CollidedWithThemselves
=
= else
= snake.death
= in
- if isAlive snake then
= { head = head
+ , direction = snake.direction
= , body = body
- , tail = tail
+ , length = snake.length
= , death = death
- , direction = snake.direction
= }
=
- else
- snake
+
+
+{-| Check if the snake is colliding with itself
+
+ import Direction exposing (Direction(..))
+
+ snake : Snake
+ snake =
+ { head = ( 0, 3 )
+ , direction = South
+ , body =
+ [ North
+ , East
+ , South
+ , West -- collision here
+ , West
+ ]
+ , length = 5
+ , death = Nothing
+ }
+
+ isColliding snake
+ --> True
+
+-}
+isColliding : Snake -> Bool
+isColliding snake =
+ snake.body
+ |> Position.trace ( 0, 0 )
+ |> List.drop 1
+ |> List.member ( 0, 0 )
=
=
=setDirection : Direction -> Snake -> Snake
=setDirection direction snake =
- -- NOTE: This seems too complicated, and it might be tempting to just check if the new direction is opposite to the current. But this would allow the player to quickly change direction twice and collide with the neck.
- let
- neck : Position
- neck =
- case snake.body of
- [] ->
- -- The snake has no body - only head and tail. The tail is the neck!
- snake.tail
-
- belly :: [] ->
- -- The snake has a single body segment. Let's call it a belly, but it's also a neck!
- belly
-
- torso :: belly :: _ ->
- -- The snake is looooong now. It has torso, belly and the rest.
- if torso == snake.head then
- -- Immediately after swallowing a letter a new segment
- -- is placed where the head is. This will become neck
- -- soon. But until the head moves away we have to
- -- consider the secod segment of the body (i.e. the
- -- belly) as the neck. Otherwise it would be possible to
- -- reverse the direction and break the neck.
- belly
-
- else
- torso
- in
- if Position.shift direction snake.head == neck then
- snake
+ case List.head snake.body of
+ Nothing ->
+ { snake | direction = direction }
=
- else
- { snake | direction = direction }
+ Just neck ->
+ if direction == neck then
+ snake
+
+ else
+ { snake | direction = direction }
=
=
=feed : Entity -> Snake -> Snake
@@ -147,13 +148,7 @@ feed entity snake =
=
=grow : Snake -> Snake
=grow snake =
- { snake
- | body =
- snake.body
- |> List.reverse
- |> (::) snake.tail
- |> List.reverse
- }
+ { snake | length = snake.length + 1 }
=
=
=kill : CauseOfDeath -> Snake -> Snake
@@ -164,3 +159,35 @@ kill cause snake =
= else
= -- You can't kill a dead snake!
= snake
+
+
+{-| Given a snake, returns the position of it's tail
+
+ import Direction exposing (Direction(..))
+
+ snake : Snake
+ snake =
+ { head = ( 4, -3 )
+ , direction = North
+ , body =
+ [ East
+ , East
+ , North
+ , West
+ , North
+ ]
+ , length = 6 -- growing
+ , death = Nothing
+ }
+
+ tail snake
+ --> (5, -5)
+
+-}
+tail : Snake -> Position
+tail snake =
+ List.foldl Position.shift snake.head snake.body
+
+isGrowing : Snake -> Bool
+isGrowing snake =
+ snake.length > List.length snake.bodynew file mode 100644
index 0000000..7af901b
--- /dev/null
+++ b/src/Tad/Basics.elm
@@ -0,0 +1,14 @@
+module Tad.Basics exposing (applyIf)
+
+{-| Apply a transformation conditionally
+
+Useful in pipelines
+
+-}
+applyIf : Bool -> (a -> a) -> a -> a
+applyIf yes function argument =
+ if yes then
+ function argument
+
+ else
+ argumentindex 0e288b4..b110ade 100644
--- a/tests/elm-verify-examples.json
+++ b/tests/elm-verify-examples.json
@@ -1,4 +1,9 @@
={
= "root": "../src",
- "tests": [ "Area", "Position" ]
+ "tests": [
+ "Area",
+ "Coordinates",
+ "Position",
+ "Snake"
+ ]
=}Setup an icon for the website
On by
index 1d2a49f..4d64c3c 100644
--- a/src/index.html
+++ b/src/index.html
@@ -23,6 +23,9 @@
= content="/word-snake/"
= />
=
+ <link rel="shortcut icon" href="./icon-large.svg" type="image/svg+xml" />
+
+
= <script src="https://hookworm.hornbook.io/script.js" data-site="XRUGIRXN" defer>
= </script>
=Fix missing module
On by
I forgot to stage it for the previous commit.
new file mode 100644
index 0000000..e31f86c
--- /dev/null
+++ b/src/Coordinates.elm
@@ -0,0 +1,90 @@
+module Coordinates exposing
+ ( Coordinates
+ , add
+ , fromPosition
+ , shift
+ , toString
+ , toTransformation
+ )
+
+import Direction exposing (Direction(..))
+import Position exposing (Position)
+import Transformations exposing (Transformation)
+
+
+type alias Coordinates =
+ { x : Float
+ , y : Float
+ }
+
+
+{-| Given a position and scale, returns a coordinate
+
+ fromPosition 200 (3, -5)
+ --> { x = 600
+ --> , y = -1000
+ --> }
+
+-}
+fromPosition : Float -> Position -> Coordinates
+fromPosition scale ( x, y ) =
+ { x = x |> toFloat |> (*) scale
+ , y = y |> toFloat |> (*) scale
+ }
+
+
+{-| Given a displacement and origin, returns displaced coordinates
+
+Basically a 2d vector sum.
+
+ add
+ { x = 100 , y = -300 }
+ { x = -400, y = 500 }
+ --> { x = -300, y = 200 }
+
+-}
+add : Coordinates -> Coordinates -> Coordinates
+add displacement origin =
+ { x = origin.x + displacement.x
+ , y = origin.y + displacement.y
+ }
+
+
+shift : Float -> Direction -> Coordinates -> Coordinates
+shift distance direction coordinates =
+ case direction of
+ North ->
+ add coordinates
+ { x = 0
+ , y = -distance
+ }
+
+ East ->
+ add coordinates
+ { x = distance
+ , y = 0
+ }
+
+ South ->
+ add coordinates
+ { x = 0
+ , y = distance
+ }
+
+ West ->
+ add coordinates
+ { x = -distance
+ , y = 0
+ }
+
+
+toString : Coordinates -> String
+toString { x, y } =
+ [ x, y ]
+ |> List.map String.fromFloat
+ |> String.join ", "
+
+
+toTransformation : String -> Coordinates -> Transformation
+toTransformation unit { x, y } =
+ Transformations.Translate unit x y