Week 03 of 2023
Development log of Word Snake
15 items
- Fix footer not visible on wide screens
- Improve legibility of the header with a sentence during countodown
- Remove Debug.log statement
- Make sure instructions have some padding on narrow screens
- Implement basic movement tutorial
- The viewbox will continuously follow the snake
- Improve the background image (Cartographer)
- Implement collecting lesson in the tutorial
- Update Nix dependencies
- Create a lesson about collecting rubbish
- Fix a typo in the tutorial
- Fix: Not losing in a collecting tutorial
- Rename view functions to viewSomething convention
- Extract the Snake type and logic to own module
- The cause of death will be explained
Fix footer not visible on wide screens
On by
Setting SVG to 100% height in a nested flexbox makes it "expand" the parent. I'm a bit confused about it, but the solution is to set the height to 0 and flex-grow to 1.
index 7a0056f..9a6075e 100644
--- a/src/Game.elm
+++ b/src/Game.elm
@@ -313,11 +313,11 @@ viewInstructions instructions =
= ]
= |> Html.div
= [ Html.Attributes.style "padding" "1rem"
- , Html.Attributes.style "width" "100%"
+ , Html.Attributes.style "width" "100%"
= , Html.Attributes.style "max-width" "48rem"
= , Html.Attributes.style "display" "flex"
= , Html.Attributes.style "flex-direction" "column"
- , Html.Attributes.style "gap" "2rem"
+ , Html.Attributes.style "gap" "2rem"
= ]
=
=
@@ -372,7 +372,8 @@ viewArea model =
= |> Svg.svg
= [ model.area |> Area.viewbox scale |> Svg.Attributes.viewBox
= , Html.Attributes.style "width" "100%"
- , Html.Attributes.style "height" "100%"
+ , Html.Attributes.style "height" "0"
+ , Html.Attributes.style "flex-grow" "1"
= , Touch.onStart TouchStarted
= , Touch.onEnd TouchEnded
= , Touch.onMove TouchMovedImprove legibility of the header with a sentence during countodown
On by
Recent layout changes made the sentence visually behind the curtain. Now it's always on to (z-index 1). The curtain itself is less dark, but makes the backdrop blurry and desaturated. Also win and loose texts cast shadows for better visibility.
index 9a6075e..7765423 100644
--- a/src/Game.elm
+++ b/src/Game.elm
@@ -218,7 +218,8 @@ viewCurtain countdown game =
= , Html.Attributes.style "right" "0"
= , Html.Attributes.style "display" "flex"
= , Html.Attributes.style "justify-content" "center"
- , Html.Attributes.style "background" "hsla(0,0%,0%,80%)"
+ , Html.Attributes.style "background" "hsla(0,0%,0%,20%)"
+ , Html.Attributes.style "backdrop-filter" "blur(3px) saturate(50%)"
= , Html.Attributes.style "animation-name" "overlay"
= , Html.Attributes.style "animation-duration" "1s"
= , Html.Attributes.style "animation-delay" "1s"
@@ -252,9 +253,13 @@ viewCurtain countdown game =
= Lost ->
= [ Html.h2
= [ Html.Attributes.style "font-size" "2em"
+ , Html.Attributes.style "text-shadow" "2px 2px black"
= ]
= [ Html.text "☠️" ]
- , Html.p [] [ Html.text "Oh, no! Your snake is dead." ]
+ , Html.p
+ [ Html.Attributes.style "text-shadow" "2px 2px black"
+ ]
+ [ Html.text "Oh, no! Your snake is dead." ]
= , playAgainButton
= ]
= |> Html.div
@@ -270,9 +275,13 @@ viewCurtain countdown game =
= Won ->
= [ Html.h2
= [ Html.Attributes.style "font-size" "2em"
+ , Html.Attributes.style "text-shadow" "2px 2px black"
+ ]
+ [ Html.text "👏" ]
+ , Html.p
+ [ Html.Attributes.style "text-shadow" "2px 2px black"
= ]
- [ Html.text "🙏" ]
- , Html.p [] [ Html.text "Bravo! The snake is safe." ]
+ [ Html.text "Bravo! The snake is safe." ]
= , playAgainButton
= ]
= |> Html.div
@@ -326,6 +335,7 @@ viewSentence sentence collected =
= Html.h1
= [ Html.Attributes.style "text-align" "center"
= , Html.Attributes.style "font-size" "1rem"
+ , Html.Attributes.style "z-index" "1"
= ]
= [ Html.text sentence.intro
= , Html.spanRemove Debug.log statement
On by
index c9ea1a6..1ac78e1 100644
--- a/src/Main.elm
+++ b/src/Main.elm
@@ -370,7 +370,7 @@ update msg model =
= )
=
= Learning goals game ->
- case Game.outcome game |> Debug.log "Outcome" of
+ case Game.outcome game of
= Game.Won ->
= case goals of
= [] ->Make sure instructions have some padding on narrow screens
On by
index 7765423..3051848 100644
--- a/src/Game.elm
+++ b/src/Game.elm
@@ -322,6 +322,7 @@ viewInstructions instructions =
= ]
= |> Html.div
= [ Html.Attributes.style "padding" "1rem"
+ , Html.Attributes.style "box-sizing" "border-box"
= , Html.Attributes.style "width" "100%"
= , Html.Attributes.style "max-width" "48rem"
= , Html.Attributes.style "display" "flex"Implement basic movement tutorial
On by
Separate Direction and Position into own modules to avoid circular dependencies.
index 6a14085..8ba0aab 100644
--- a/src/Area.elm
+++ b/src/Area.elm
@@ -1,6 +1,5 @@
=module Area exposing
= ( Area
- , Position
= , centerX
= , centerY
= , default
@@ -14,6 +13,7 @@ module Area exposing
= , viewbox
= )
=
+import Position exposing (Position)
=import Random
=
=
@@ -24,12 +24,6 @@ type alias Area =
= }
=
=
-type alias Position =
- ( Int
- , Int
- )
-
-
=default : Area
=default =
= Area 16 16 ( 0, 0 )new file mode 100644
index 0000000..77762a5
--- /dev/null
+++ b/src/Direction.elm
@@ -0,0 +1,40 @@
+module Direction exposing (Direction(..), toString, arrow)
+
+
+type Direction
+ = North
+ | East
+ | South
+ | West
+
+
+toString : Direction -> String
+toString direction =
+ case direction of
+ North ->
+ "north"
+
+ East ->
+ "east"
+
+ South ->
+ "south"
+
+ West ->
+ "west"
+
+
+arrow : Direction -> String
+arrow direction =
+ case direction of
+ North ->
+ "👆"
+
+ East ->
+ "👉"
+
+ South ->
+ "👇"
+
+ West ->
+ "👈"index 3051848..59382d9 100644
--- a/src/Game.elm
+++ b/src/Game.elm
@@ -13,8 +13,9 @@ port module Game exposing
= , viewSentence
= )
=
-import Area exposing (Area, Position)
+import Area exposing (Area)
=import Dict exposing (Dict)
+import Direction exposing (Direction(..))
=import Goal exposing (Goal(..))
=import Html exposing (Html)
=import Html.Attributes
@@ -23,9 +24,10 @@ import Html.Events.Extra.Touch as Touch
=import Json.Decode as Decode
=import Keyboard
=import Maybe.Extra as Maybe
+import Position exposing (Position)
=import Random
=import Svg exposing (Svg)
-import Svg.Attributes
+import Svg.Attributes exposing (direction)
=import Svg.Keyed
=import Tad.Html as Html
=import Time
@@ -56,20 +58,13 @@ type alias Letters =
=
=type alias Snake =
= { head : Position
- , body : List Position
+ , body : List Position -- TODO: body : List Direction
= , tail : Position
= , direction : Direction
= , alive : Bool
= }
=
=
-type Direction
- = North
- | East
- | South
- | West
-
-
=type alias Swipe =
= { identifier : Int
= , from : ( Float, Float )
@@ -91,9 +86,7 @@ type alias Flags =
=init : Flags -> Model
=init flags =
= { area = flags.area
- , letters =
- Dict.empty
- |> burnTheEdge flags.area True
+ , letters = Dict.empty
= , snake =
= { head = ( 0, 0 )
= , body = List.repeat 5 ( 0, 0 )
@@ -159,7 +152,7 @@ prependShifted direction positions =
= []
=
= head :: rest ->
- shiftPosition direction head :: head :: rest
+ Position.shift direction head :: head :: rest
=
=
=
@@ -193,6 +186,12 @@ view model =
= , viewArea model
= , viewCurtain model.countdown model
= ]
+
+ ChangeDirections directions ->
+ [ viewDirections directions
+ , viewArea model
+ , viewCurtain model.countdown model
+ ]
= in
= content
= |> Html.div
@@ -205,6 +204,22 @@ view model =
= ]
=
=
+viewDirections : List Direction -> Html Msg
+viewDirections directions =
+ case directions of
+ current :: following ->
+ viewHeader
+ [ "Turn " |> Html.text
+ , current |> Direction.toString |> Html.text
+ , " " |> Html.text
+ , current |> Direction.arrow |> Html.text
+ ]
+
+ [] ->
+ viewHeader
+ [ "Well done!" |> Html.text ]
+
+
=viewCurtain : Int -> Model -> Html Msg
=viewCurtain countdown game =
= let
@@ -331,13 +346,9 @@ viewInstructions instructions =
= ]
=
=
-viewSentence : Goal.Sentence -> String -> Html msg
+viewSentence : Goal.Sentence -> String -> Html Msg
=viewSentence sentence collected =
- Html.h1
- [ Html.Attributes.style "text-align" "center"
- , Html.Attributes.style "font-size" "1rem"
- , Html.Attributes.style "z-index" "1"
- ]
+ viewHeader
= [ Html.text sentence.intro
= , Html.span
= [ Html.Attributes.style "background" <|
@@ -358,6 +369,18 @@ viewSentence sentence collected =
= ]
=
=
+viewHeader : List (Html Msg) -> Html Msg
+viewHeader contents =
+ Html.div
+ [ Html.Attributes.style "text-align" "center"
+ , Html.Attributes.style "font-size" "1rem"
+ , Html.Attributes.style "font-weight" "bold"
+ , Html.Attributes.style "padding" "2rem"
+ , Html.Attributes.style "z-index" "1"
+ ]
+ contents
+
+
=viewArea : Model -> Html Msg
=viewArea model =
= [ lettersView model.letters
@@ -837,6 +860,17 @@ updateGoal snake letters goal =
= ReadInstructions _ ->
= goal
=
+ ChangeDirections (required :: following) ->
+ if required == snake.direction then
+ ChangeDirections following
+
+ else
+ goal
+
+ ChangeDirections [] ->
+ -- The goal is complete.
+ goal
+
=
=
=-- SUBSCRIPTIONS
@@ -864,6 +898,9 @@ subscriptions model =
=
= ReadInstructions _ ->
= Sub.none
+
+ ChangeDirections _ ->
+ Time.every 250 Step
= in
= [ clock
= , keydown decodeKeydown
@@ -943,6 +980,9 @@ updateLetters goal snake letters =
= ReadInstructions _ ->
= letters
=
+ ChangeDirections _ ->
+ Dict.empty
+
=
=
=-- game state predicates
@@ -972,6 +1012,11 @@ outcome model =
= -- This is always a win
= Won
=
+ ChangeDirections [] ->
+ Won
+
+ ChangeDirections _ ->
+ InProgress
=
=passwordCollected : String -> Goal.Sentence -> Bool
=passwordCollected collected sentence =
@@ -1054,7 +1099,7 @@ setDirection direction snake =
= else
= torso
= in
- if shiftPosition direction snake.head == neck then
+ if Position.shift direction snake.head == neck then
= snake
=
= else
@@ -1070,7 +1115,7 @@ moveSnake snake =
= let
= head : Position
= head =
- shiftPosition snake.direction snake.head
+ Position.shift snake.direction snake.head
=
= body : List Position
= body =
@@ -1106,22 +1151,6 @@ moveSnake snake =
= snake
=
=
-shiftPosition : Direction -> Position -> Position
-shiftPosition direction ( x, y ) =
- case direction of
- North ->
- ( x, y - 1 )
-
- East ->
- ( x + 1, y )
-
- South ->
- ( x, y + 1 )
-
- West ->
- ( x - 1, y )
-
-
=
=-- random generators
=
@@ -1191,6 +1220,9 @@ randomSpawn area goal snake letters =
= ReadInstructions _ ->
= Random.constant Dict.empty
=
+ ChangeDirections _ ->
+ Random.constant Dict.empty
+
=
=randomDecay : Float -> Letters -> Random.Generator Letters
=randomDecay probability dict =index f39a73c..071aeb4 100644
--- a/src/Goal.elm
+++ b/src/Goal.elm
@@ -11,11 +11,13 @@ module Goal exposing
= )
=
=import Html exposing (Html)
+import Direction exposing (Direction(..))
=
=
=type Goal
= = CompleteSentence Sentence String
= | ReadInstructions (List (Html Never))
+ | ChangeDirections (List Direction)
=
=
=complete : Goal -> Bool
@@ -27,6 +29,9 @@ complete goal =
= ReadInstructions _ ->
= True
=
+ ChangeDirections directions ->
+ List.isEmpty directions
+
=
=serialize : Goal -> String
=serialize goal =
@@ -48,6 +53,9 @@ serialize goal =
= ReadInstructions _ ->
= ""
=
+ ChangeDirections _ ->
+ ""
+
=
=
=-- COMPLETE THE SENTENCE
@@ -105,3 +113,6 @@ coundown goal =
=
= ReadInstructions _ ->
= 0
+
+ ChangeDirections _ ->
+ 0new file mode 100644
index 0000000..a09302e
--- /dev/null
+++ b/src/Position.elm
@@ -0,0 +1,25 @@
+module Position exposing (Position, shift)
+
+import Direction exposing (Direction(..))
+
+
+type alias Position =
+ ( Int
+ , Int
+ )
+
+
+shift : Direction -> Position -> Position
+shift direction ( x, y ) =
+ case direction of
+ North ->
+ ( x, y - 1 )
+
+ East ->
+ ( x + 1, y )
+
+ South ->
+ ( x, y + 1 )
+
+ West ->
+ ( x - 1, y )index 642e0b1..7e47711 100644
--- a/src/Tutorial.elm
+++ b/src/Tutorial.elm
@@ -1,8 +1,8 @@
=module Tutorial exposing (goals, intro)
=
+import Direction exposing (Direction(..))
=import Goal exposing (Goal)
=import Html
-import Html.Attributes
=import Tad.Html as Html
=
=
@@ -22,7 +22,13 @@ goals : List Goal
=goals =
= [ Goal.ReadInstructions
= [ "Moving around" |> Html.text |> Html.wrap Html.h1 []
- , "Use W A S D or swipe 👆 on a touch-screen to move around and collect the letters to fill the missing word. Once the password is collected you will be able to escape the fire trap." |> Html.text |> Html.wrap Html.p []
+ , "Use W A S D or swipe 👆 on a touch-screen to move around." |> Html.text |> Html.wrap Html.p []
+ , "Let's practice! In the next lesson you will control the snake. Follow the instructions on top of the screen." |> Html.text |> Html.wrap Html.p []
+ ]
+ , Goal.ChangeDirections [ North, West, East, South ]
+ , Goal.ReadInstructions
+ [ "Collecting letters" |> Html.text |> Html.wrap Html.h1 []
+ , "Navigate the Snake to collect the letters and fill the missing word in a sentence. Once the password is collected you will be able to escape the fire trap." |> Html.text |> Html.wrap Html.p []
= ]
= , Goal.CompleteSentence
= { charset = [ 'A', 'B', 'C' ]The viewbox will continuously follow the snake
On by
Using my Spring module for organic easing of the motion. Also, now there is a background in the game view to provide spatial reference for the movement. This solves the problem of the snake going off-screen in the tutorial, where there is no firewall.
index 30a7184..df53946 100644
--- a/elm.json
+++ b/elm.json
@@ -21,7 +21,8 @@
= "elm-community/result-extra": "2.4.0",
= "krisajenkins/remotedata": "6.0.1",
= "mpizenberg/elm-pointer-events": "4.0.2",
- "ohanhi/keyboard": "2.0.1"
+ "ohanhi/keyboard": "2.0.1",
+ "tad-lispy/springs": "1.0.5"
= },
= "indirect": {
= "elm/bytes": "1.0.8",index 8ba0aab..e6b3e69 100644
--- a/src/Area.elm
+++ b/src/Area.elm
@@ -1,5 +1,6 @@
=module Area exposing
= ( Area
+ , centerAround
= , centerX
= , centerY
= , default
@@ -119,3 +120,8 @@ viewbox scale area =
= ]
= |> List.map String.fromInt
= |> String.join " "
+
+
+centerAround : Position -> Area -> Area
+centerAround center area =
+ { area | center = center }index 59382d9..c27130c 100644
--- a/src/Game.elm
+++ b/src/Game.elm
@@ -14,6 +14,7 @@ port module Game exposing
= )
=
=import Area exposing (Area)
+import Browser.Events
=import Dict exposing (Dict)
=import Direction exposing (Direction(..))
=import Goal exposing (Goal(..))
@@ -26,6 +27,8 @@ import Keyboard
=import Maybe.Extra as Maybe
=import Position exposing (Position)
=import Random
+import Set exposing (Set)
+import Spring exposing (Spring)
=import Svg exposing (Svg)
=import Svg.Attributes exposing (direction)
=import Svg.Keyed
@@ -42,6 +45,8 @@ port preventDefault : Decode.Value -> Cmd msg
=
=type alias Model =
= { area : Area
+ , tiles : Set Position
+ , pan : Pan
= , letters : Letters
= , snake : Snake
= , goal : Goal
@@ -52,6 +57,12 @@ type alias Model =
= }
=
=
+type alias Pan =
+ { x : Spring
+ , y : Spring
+ }
+
+
=type alias Letters =
= Dict Position Char
=
@@ -86,6 +97,14 @@ type alias Flags =
=init : Flags -> Model
=init flags =
= { area = flags.area
+ , tiles =
+ ( 0, 0 )
+ |> Position.neighborhood
+ |> Set.fromList
+ , pan =
+ Pan
+ (Spring.create { strength = 20, dampness = 3 })
+ (Spring.create { strength = 20, dampness = 3 })
= , letters = Dict.empty
= , snake =
= { head = ( 0, 0 )
@@ -172,6 +191,11 @@ scale =
= 1000
=
=
+backgroundTileSize : Int
+backgroundTileSize =
+ 16
+
+
=view : Model -> Html Msg
=view model =
= let
@@ -383,43 +407,72 @@ viewHeader contents =
=
=viewArea : Model -> Html Msg
=viewArea model =
- [ lettersView model.letters
- , snakeView model.snake
- ]
- |> Svg.g
- [ Transformations.Translate "px"
- (model.area
- |> Area.centerX
- |> Basics.toFloat
- |> (*) -scale
- )
- (model.area
- |> Area.centerY
- |> Basics.toFloat
- |> (*) -scale
- )
- |> Transformations.toString
- |> Html.Attributes.style "transform"
- , Html.Attributes.style "transition" "transform 1000ms linear"
- ]
- |> List.singleton
- |> Svg.svg
- [ model.area |> Area.viewbox scale |> Svg.Attributes.viewBox
- , Html.Attributes.style "width" "100%"
- , Html.Attributes.style "height" "0"
- , Html.Attributes.style "flex-grow" "1"
- , Touch.onStart TouchStarted
- , Touch.onEnd TouchEnded
- , Touch.onMove TouchMoved
- , Touch.onCancel TouchCanceled
+ let
+ entities =
+ [ viewBackground model.tiles
+ , lettersView model.letters
+ , snakeView model.snake
= ]
+ |> Svg.g
+ [ Transformations.Translate "px"
+ -(Spring.value model.pan.x)
+ -(Spring.value model.pan.y)
+ |> Transformations.toString
+ |> Html.Attributes.style "transform"
+ , Html.Attributes.style "transition" "transform 200ms linear"
+ ]
+ in
+ Svg.svg
+ [ model.area |> Area.viewbox scale |> Svg.Attributes.viewBox
+ , Html.Attributes.style "width" "100%"
+ , Html.Attributes.style "height" "0"
+ , Html.Attributes.style "flex-grow" "1"
+ , Touch.onStart TouchStarted
+ , Touch.onEnd TouchEnded
+ , Touch.onMove TouchMoved
+ , Touch.onCancel TouchCanceled
+ ]
+ [ entities
+ ]
+
+
+viewBackground : Set Position -> Svg Msg
+viewBackground tiles =
+ tiles
+ |> Set.toList
+ |> List.map viewBackgroundTile
+ |> Svg.g []
+
+
+viewBackgroundTile : Position -> Svg Msg
+viewBackgroundTile ( x, y ) =
+ let
+ length =
+ backgroundTileSize
+ |> Position.sectorLength
+ |> toFloat
+ in
+ Svg.image
+ [ length * scale |> String.fromFloat |> Svg.Attributes.width
+ , length * scale |> String.fromFloat |> Svg.Attributes.height
+ , Svg.Attributes.xlinkHref "/cartographer.webp"
+ , length * scale / -2 |> String.fromFloat |> Svg.Attributes.x
+ , length * scale / -2 |> String.fromFloat |> Svg.Attributes.y
+ , [ Transformations.Translate "px" (toFloat x * scale * length) (toFloat y * scale * length)
+ , Transformations.Scale 1.01 1.01
+ ]
+ |> List.map Transformations.toString
+ |> String.join " "
+ |> Html.Attributes.style "transform"
+ ]
+ []
=
=
=lettersView : Letters -> Svg Msg
=lettersView letters =
= letters
= |> Dict.toList
- |> List.map letterView
+ |> List.map viewLetter
= |> Svg.Keyed.node "g"
= [ Html.Attributes.style "pointer-events" "none"
= ]
@@ -544,8 +597,8 @@ segmentView shape ( x, y ) =
= ]
=
=
-letterView : ( Position, Char ) -> ( String, Svg Msg )
-letterView ( ( x, y ), letter ) =
+viewLetter : ( Position, Char ) -> ( String, Svg Msg )
+viewLetter ( ( x, y ), letter ) =
= let
= key : String
= key =
@@ -569,7 +622,7 @@ letterView ( ( x, y ), letter ) =
= , Svg.Attributes.height (scale |> String.fromFloat)
= , Svg.Attributes.fontSize (0.6 * scale |> String.fromFloat)
= , Svg.Attributes.fontWeight "bold"
- , Svg.Attributes.fill "currentColor"
+ , Svg.Attributes.fill "hsl(0, 0%, 86%)"
= ]
= |> Tuple.pair key
=
@@ -582,6 +635,7 @@ type Msg
= = NoOp Never
= | CountdownClockTick Time.Posix
= | Step Time.Posix
+ | NextFrame Float
= | KeyPressed (Maybe Keyboard.Key)
= | TouchStarted Touch.Event
= | TouchMoved Touch.Event
@@ -633,6 +687,12 @@ update msg model =
= |> updateSnake letters
= |> moveSnake
=
+ tiles =
+ snake.head
+ |> Position.sector backgroundTileSize
+ |> Position.neighborhood
+ |> List.foldr Set.insert model.tiles
+
= burn : Bool
= burn =
= case model.goal of
@@ -641,9 +701,28 @@ update msg model =
=
= _ ->
= 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
= , letters =
= letters
= |> updateLetters model.goal model.snake
@@ -655,6 +734,17 @@ update msg model =
= , Cmd.none
= )
=
+ NextFrame delta ->
+ let
+ pan =
+ { x = Spring.animate delta model.pan.x
+ , y = Spring.animate delta model.pan.y
+ }
+ in
+ ( { model | pan = pan }
+ , Cmd.none
+ )
+
= KeyPressed key ->
= case key of
= Nothing ->
@@ -901,8 +991,12 @@ subscriptions model =
=
= ChangeDirections _ ->
= Time.every 250 Step
+
+ frames =
+ Browser.Events.onAnimationFrameDelta NextFrame
= in
= [ clock
+ , frames
= , keydown decodeKeydown
= ]
= |> Sub.batch
@@ -1018,6 +1112,7 @@ outcome model =
= ChangeDirections _ ->
= InProgress
=
+
=passwordCollected : String -> Goal.Sentence -> Bool
=passwordCollected collected sentence =
= String.toUpper collected == String.toUpper sentence.passwordindex a09302e..c15f458 100644
--- a/src/Position.elm
+++ b/src/Position.elm
@@ -1,4 +1,10 @@
-module Position exposing (Position, shift)
+module Position exposing
+ ( Position
+ , neighborhood
+ , sector
+ , sectorLength
+ , shift
+ )
=
=import Direction exposing (Direction(..))
=
@@ -23,3 +29,62 @@ shift direction ( x, y ) =
=
= West ->
= ( x - 1, y )
+
+
+neighborhood : Position -> List Position
+neighborhood ( x, y ) =
+ [ ( x - 1, y - 1 )
+ , ( x, y - 1 )
+ , ( x + 1, y - 1 )
+ , ( x - 1, y )
+ , ( x, y )
+ , ( x + 1, y )
+ , ( x - 1, y + 1 )
+ , ( x, y + 1 )
+ , ( x + 1, y + 1 )
+ ]
+
+
+
+-- SECTOR
+-- TODO: Move to own module?
+
+
+{-| Given a sector size and a position gives the position of the sector
+
+ Sectors provide a logical division of the game space. They are useful for drawing background. Since the space is unbound (infinite), we only want to draw background where it's needed, i.e. where the player is looking (or was looking in the past).
+
+ A sector is a square area that neighbors 8 other sectors. It's size is the number of positions around it's center in each direction.
+
+ Sector ( 0, 0 ) is always centered at position ( 0, 0 ). Given size of 4, it spans from and including ( -4, -4 ) to ( 4, 4 ). The length of it's edge is 9 (-4, -3, -2, -1, 0, 1, 2, 3, 4) and it contains 81 (9^2) individual positions. To the east lays sector ( 1, 0 ), with center at ( 9, 0 ) that spans 81 fields between (5, -4) and (13, 4). Any position within this range belongs to this sector.
+
+
+
+ sector 4 ( 0, 0 )
+ --> ( 0, 0 )
+
+
+ sector 4 ( 10 -8 )
+ --> ( 1, -1 )
+
+ sector 8 ( -43, 22 )
+ --> ( 1, -1 )
+
+-}
+sector : Int -> Position -> Position
+sector size ( x, y ) =
+ let
+ length =
+ sectorLength size
+
+ coordinate position =
+ round (toFloat position / toFloat length)
+ in
+ ( coordinate x
+ , coordinate y
+ )
+
+
+sectorLength : Int -> Int
+sectorLength size =
+ size * 2 + 1index 29995fb..3348817 100644
--- a/src/credits.html
+++ b/src/credits.html
@@ -7,3 +7,4 @@ Clode</a> on
=<a href="https://unsplash.com/@brookecagle?utm_source=unsplash&utm_medium=referral&utm_content=creditCopyText">Brooke
=Cagle</a> on
=<a href="https://unsplash.com/@brookecagle?utm_source=unsplash&utm_medium=referral&utm_content=creditCopyText">Unsplash</a></p>
+<p>The Cartographer Pattern image used in the background by <a href="https://sam.feyaerts.me/">Sam Feyaerts</a> via <a href="https://www.toptal.com/designers/subtlepatterns/cartographer/">Subtle Patterns</a></p>new file mode 100644
index 0000000..2cd22a0
Binary files /dev/null and b/static/cartographer.webp differImprove the background image (Cartographer)
On by
The image was not square (500x499) which led to some visual artifacts. I added the missing row of pixels. Still, on Firefox there was a thin, but visible line between the tiles. Making the background match the dominant color of the image made it imperceptible. Thanks to this, the scaling hack is no longer needed.
index c27130c..07c5151 100644
--- a/src/Game.elm
+++ b/src/Game.elm
@@ -427,6 +427,7 @@ viewArea model =
= , Html.Attributes.style "width" "100%"
= , Html.Attributes.style "height" "0"
= , Html.Attributes.style "flex-grow" "1"
+ , Html.Attributes.style "background" "#262626" -- From the background image
= , Touch.onStart TouchStarted
= , Touch.onEnd TouchEnded
= , Touch.onMove TouchMoved
@@ -458,11 +459,8 @@ viewBackgroundTile ( x, y ) =
= , Svg.Attributes.xlinkHref "/cartographer.webp"
= , length * scale / -2 |> String.fromFloat |> Svg.Attributes.x
= , length * scale / -2 |> String.fromFloat |> Svg.Attributes.y
- , [ Transformations.Translate "px" (toFloat x * scale * length) (toFloat y * scale * length)
- , Transformations.Scale 1.01 1.01
- ]
- |> List.map Transformations.toString
- |> String.join " "
+ , Transformations.Translate "px" (toFloat x * scale * length) (toFloat y * scale * length)
+ |> Transformations.toString
= |> Html.Attributes.style "transform"
= ]
= []index 2cd22a0..33fbdab 100644
Binary files a/static/cartographer.webp and b/static/cartographer.webp differImplement collecting lesson in the tutorial
On by
index 07c5151..873377b 100644
--- a/src/Game.elm
+++ b/src/Game.elm
@@ -216,6 +216,12 @@ view model =
= , viewArea model
= , viewCurtain model.countdown model
= ]
+
+ CollectSingle collectibles ->
+ [ viewCollectibles collectibles
+ , viewArea model
+ , viewCurtain model.countdown model
+ ]
= in
= content
= |> Html.div
@@ -228,6 +234,22 @@ view model =
= ]
=
=
+viewCollectibles : List Goal.Collectible -> Html Msg
+viewCollectibles collectibles =
+ case collectibles of
+ current :: following ->
+ viewHeader
+ [ "Get " |> Html.text
+ , current.label |> Html.text
+ , " " |> Html.text
+ , current.symbol |> String.fromChar |> Html.text
+ ]
+
+ [] ->
+ viewHeader
+ [ "Well done!" |> Html.text ]
+
+
=viewDirections : List Direction -> Html Msg
=viewDirections directions =
= case directions of
@@ -959,6 +981,21 @@ updateGoal snake letters goal =
= -- The goal is complete.
= goal
=
+ CollectSingle (collectible :: rest) ->
+ case Dict.get snake.head letters of
+ Nothing ->
+ goal
+
+ Just letter ->
+ if letter == collectible.symbol then
+ CollectSingle rest
+
+ else
+ goal
+
+ CollectSingle [] ->
+ goal
+
=
=
=-- SUBSCRIPTIONS
@@ -976,19 +1013,11 @@ subscriptions model =
= |> KeyPressed
=
= clock =
- case model.goal of
- CompleteSentence _ _ ->
- if model.countdown == 0 then
- Time.every 250 Step
+ if model.countdown > 0 then
+ Time.every 1000 CountdownClockTick
=
- else
- Time.every 1000 CountdownClockTick
-
- ReadInstructions _ ->
- Sub.none
-
- ChangeDirections _ ->
- Time.every 250 Step
+ else
+ Time.every 250 Step
=
= frames =
= Browser.Events.onAnimationFrameDelta NextFrame
@@ -1075,6 +1104,18 @@ updateLetters goal snake letters =
= ChangeDirections _ ->
= Dict.empty
=
+ CollectSingle (collectible :: rest) ->
+ if letter == collectible.symbol then
+ Dict.remove snake.head letters
+
+ else
+ letters
+ |> Dict.remove snake.head
+ |> Dict.insert snake.tail '💩'
+
+ CollectSingle [] ->
+ Dict.empty
+
=
=
=-- game state predicates
@@ -1110,6 +1151,13 @@ outcome model =
= ChangeDirections _ ->
= InProgress
=
+ CollectSingle collectibles ->
+ if List.isEmpty collectibles then
+ Won
+
+ else
+ InProgress
+
=
=passwordCollected : String -> Goal.Sentence -> Bool
=passwordCollected collected sentence =
@@ -1316,6 +1364,31 @@ randomSpawn area goal snake letters =
= ChangeDirections _ ->
= Random.constant Dict.empty
=
+ CollectSingle (collectible :: rest) ->
+ let
+ present : Bool
+ present =
+ letters
+ |> Dict.values
+ |> List.member collectible.symbol
+
+ spawn : Position -> Letters
+ spawn position =
+ letters
+ |> Dict.insert position collectible.symbol
+ in
+ if present then
+ Random.constant letters
+
+ else
+ -- Always spawn around the snake. Doesn't matter where the original area was.
+ { area | center = snake.head }
+ |> Area.randomPosition
+ |> Random.map spawn
+
+ CollectSingle [] ->
+ Random.constant Dict.empty
+
=
=randomDecay : Float -> Letters -> Random.Generator Letters
=randomDecay probability dict =index 071aeb4..cc0394c 100644
--- a/src/Goal.elm
+++ b/src/Goal.elm
@@ -1,5 +1,6 @@
=module Goal exposing
= ( Charset
+ , Collectible
= , Goal(..)
= , Sentence
= , collectLetter
@@ -10,14 +11,21 @@ module Goal exposing
= , serialize
= )
=
-import Html exposing (Html)
=import Direction exposing (Direction(..))
+import Html exposing (Html)
=
=
=type Goal
= = CompleteSentence Sentence String
= | ReadInstructions (List (Html Never))
= | ChangeDirections (List Direction)
+ | CollectSingle (List Collectible)
+
+
+type alias Collectible =
+ { symbol : Char
+ , label : String
+ }
=
=
=complete : Goal -> Bool
@@ -32,6 +40,9 @@ complete goal =
= ChangeDirections directions ->
= List.isEmpty directions
=
+ CollectSingle collectibles ->
+ List.isEmpty collectibles
+
=
=serialize : Goal -> String
=serialize goal =
@@ -56,6 +67,9 @@ serialize goal =
= ChangeDirections _ ->
= ""
=
+ CollectSingle _ ->
+ ""
+
=
=
=-- COMPLETE THE SENTENCE
@@ -116,3 +130,6 @@ coundown goal =
=
= ChangeDirections _ ->
= 0
+
+ CollectSingle _ ->
+ 5index 7e47711..7b37086 100644
--- a/src/Tutorial.elm
+++ b/src/Tutorial.elm
@@ -26,6 +26,16 @@ goals =
= , "Let's practice! In the next lesson you will control the snake. Follow the instructions on top of the screen." |> Html.text |> Html.wrap Html.p []
= ]
= , Goal.ChangeDirections [ North, West, East, South ]
+ , Goal.ReadInstructions
+ [ "Collecting stuff" |> Html.text |> Html.wrap Html.h1 []
+ , "The main goal of the game is to collect the letters and complete sentences. Let's practice collecting on fruits for now." |> Html.text |> Html.wrap Html.p []
+ , "Navigate the Snake to collect an apple 🍏, some grapes 🍇 and a delicious pear 🍐." |> Html.text |> Html.wrap Html.p []
+ ]
+ , Goal.CollectSingle
+ [ Goal.Collectible '🍏' "an apple"
+ , Goal.Collectible '🍇' "grapes"
+ , Goal.Collectible '🍐' "a pear"
+ ]
= , Goal.ReadInstructions
= [ "Collecting letters" |> Html.text |> Html.wrap Html.h1 []
= , "Navigate the Snake to collect the letters and fill the missing word in a sentence. Once the password is collected you will be able to escape the fire trap." |> Html.text |> Html.wrap Html.p []Update Nix dependencies
On by
index fdef1b5..80590e2 100644
--- a/flake.lock
+++ b/flake.lock
@@ -3,11 +3,11 @@
= "flake-compat": {
= "flake": false,
= "locked": {
- "lastModified": 1668681692,
- "narHash": "sha256-Ht91NGdewz8IQLtWZ9LCeNXMSXHUss+9COoqu6JLmXU=",
+ "lastModified": 1673956053,
+ "narHash": "sha256-4gtG9iQuiKITOjNQQeQIpoIB6b16fm+504Ch3sNKLd8=",
= "owner": "edolstra",
= "repo": "flake-compat",
- "rev": "009399224d5e398d03b22badca40a37ac85412a1",
+ "rev": "35bb57c0c8d8b62bbfd284272c928ceb64ddbde9",
= "type": "github"
= },
= "original": {
@@ -33,11 +33,11 @@
= },
= "nixpkgs": {
= "locked": {
- "lastModified": 1672249180,
- "narHash": "sha256-ipos/gTMHqxS39asqNWEJZ7nXdcTHa0TB0AIZXkGapg=",
+ "lastModified": 1673947312,
+ "narHash": "sha256-xx/2nRwRy3bXrtry6TtydKpJpqHahjuDB5sFkQ/XNDE=",
= "owner": "NixOS",
= "repo": "nixpkgs",
- "rev": "e58a7747db96c23b8a977e7c1bbfc5753b81b6fa",
+ "rev": "2d38b664b4400335086a713a0036aafaa002c003",
= "type": "github"
= },
= "original": {Create a lesson about collecting rubbish
On by
Technically I did it by adding a "rubbish" parameter to the CollectSingle goal. It contains a list of "rubbish" entities, i.e. entities different than the collectible. During the lesson, if there is already a valid collectible, the rubbish will be randomly spawned around the snake.
If the rubbish list is empty, only the collectible will be spawned, and only one at a time (like before).
While doing this, I had to change the way random entities are spawned. Basically they were always including the flame. This was a kind of lazy hack to make sure Random.weighted always has a default option. For this lesson I want the junk to be spawned around, but not the flame. So now the randomLetter function takes a promoted character as the firs argument and the flame has to be passed within the second argument if needed.
Also, I lowered the probability of random spawn from 0.5 to 0.3. The game seems less chaotic this way.
index 873377b..120998f 100644
--- a/src/Game.elm
+++ b/src/Game.elm
@@ -217,7 +217,7 @@ view model =
= , viewCurtain model.countdown model
= ]
=
- CollectSingle collectibles ->
+ CollectSingle _ collectibles ->
= [ viewCollectibles collectibles
= , viewArea model
= , viewCurtain model.countdown model
@@ -981,19 +981,19 @@ updateGoal snake letters goal =
= -- The goal is complete.
= goal
=
- CollectSingle (collectible :: rest) ->
+ CollectSingle rubbish (collectible :: rest) ->
= case Dict.get snake.head letters of
= Nothing ->
= goal
=
= Just letter ->
= if letter == collectible.symbol then
- CollectSingle rest
+ CollectSingle rubbish rest
=
= else
= goal
=
- CollectSingle [] ->
+ CollectSingle _ [] ->
= goal
=
=
@@ -1104,7 +1104,7 @@ updateLetters goal snake letters =
= ChangeDirections _ ->
= Dict.empty
=
- CollectSingle (collectible :: rest) ->
+ CollectSingle _ (collectible :: rest) ->
= if letter == collectible.symbol then
= Dict.remove snake.head letters
=
@@ -1113,8 +1113,8 @@ updateLetters goal snake letters =
= |> Dict.remove snake.head
= |> Dict.insert snake.tail '💩'
=
- CollectSingle [] ->
- Dict.empty
+ CollectSingle _ [] ->
+ letters
=
=
=
@@ -1151,7 +1151,7 @@ outcome model =
= ChangeDirections _ ->
= InProgress
=
- CollectSingle collectibles ->
+ CollectSingle _ collectibles ->
= if List.isEmpty collectibles then
= Won
=
@@ -1296,25 +1296,11 @@ moveSnake snake =
=-- random generators
=
=
-randomLetter : List Char -> Goal.Charset -> Random.Generator Char
+randomLetter : Char -> Goal.Charset -> Random.Generator Char
=randomLetter promoted charset =
- let
- weights : List Float
- weights =
- charset
- |> List.map
- (\letter ->
- if List.member letter promoted then
- 2
-
- else
- 1
- )
-
- weightmap =
- List.map2 Tuple.pair weights charset
- in
- Random.weighted ( 1, '🔥' ) weightmap
+ charset
+ |> List.map (Tuple.pair 1)
+ |> Random.weighted ( 3, promoted )
=
=
=randomBoolean : Float -> Random.Generator Bool
@@ -1331,32 +1317,39 @@ randomSpawn :
= -> Letters
= -> Random.Generator Letters
=randomSpawn area goal snake letters =
+ let
+ insert : Bool -> Position -> Char -> Letters
+ insert spawn position letter =
+ 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
+ Dict.insert position letter letters
+
+ else
+ letters
+ in
= case goal of
= CompleteSentence sentence collected ->
= let
= probability =
- 0.5
-
- needed =
- Goal.missingLetters sentence collected
-
- perform : Bool -> Position -> Char -> Letters
- perform spawn position letter =
- if
- spawn
- && position
- /= snake.head
- && not (List.member position snake.body)
- then
- Dict.insert position letter letters
+ 0.3
=
- else
- letters
+ charset =
+ '🔥' :: sentence.charset
= in
- Random.map3 perform
- (randomBoolean probability)
- (Area.randomPosition area)
- (randomLetter needed sentence.charset)
+ case Goal.missingLetters sentence collected of
+ [] ->
+ Random.constant letters
+
+ next :: following ->
+ Random.map3 insert
+ (randomBoolean probability)
+ (Area.randomPosition area)
+ (randomLetter next charset)
=
= ReadInstructions _ ->
= Random.constant Dict.empty
@@ -1364,29 +1357,39 @@ randomSpawn area goal snake letters =
= ChangeDirections _ ->
= Random.constant Dict.empty
=
- CollectSingle (collectible :: rest) ->
+ CollectSingle rubbish (collectible :: rest) ->
= let
+ probability =
+ 0.3
+
= present : Bool
= present =
= letters
= |> Dict.values
= |> List.member collectible.symbol
=
- spawn : Position -> Letters
- spawn position =
- letters
- |> Dict.insert position collectible.symbol
+ spawnCollectible : Position -> Letters
+ spawnCollectible position =
+ insert True position collectible.symbol
= in
= if present then
- Random.constant letters
+ case rubbish of
+ [] ->
+ Random.constant letters
+
+ one :: more ->
+ Random.map3 insert
+ (randomBoolean probability)
+ (Area.randomPosition { area | center = snake.head })
+ (Random.uniform one more)
=
= else
= -- Always spawn around the snake. Doesn't matter where the original area was.
= { area | center = snake.head }
= |> Area.randomPosition
- |> Random.map spawn
+ |> Random.map spawnCollectible
=
- CollectSingle [] ->
+ CollectSingle _ [] ->
= Random.constant Dict.empty
=
=index cc0394c..0b1a37d 100644
--- a/src/Goal.elm
+++ b/src/Goal.elm
@@ -19,7 +19,7 @@ type Goal
= = CompleteSentence Sentence String
= | ReadInstructions (List (Html Never))
= | ChangeDirections (List Direction)
- | CollectSingle (List Collectible)
+ | CollectSingle Charset (List Collectible)
=
=
=type alias Collectible =
@@ -40,7 +40,7 @@ complete goal =
= ChangeDirections directions ->
= List.isEmpty directions
=
- CollectSingle collectibles ->
+ CollectSingle _ collectibles ->
= List.isEmpty collectibles
=
=
@@ -67,7 +67,7 @@ serialize goal =
= ChangeDirections _ ->
= ""
=
- CollectSingle _ ->
+ CollectSingle _ _ ->
= ""
=
=
@@ -131,5 +131,5 @@ coundown goal =
= ChangeDirections _ ->
= 0
=
- CollectSingle _ ->
+ CollectSingle _ _ ->
= 5index 7b37086..8906de3 100644
--- a/src/Tutorial.elm
+++ b/src/Tutorial.elm
@@ -32,9 +32,21 @@ goals =
= , "Navigate the Snake to collect an apple 🍏, some grapes 🍇 and a delicious pear 🍐." |> Html.text |> Html.wrap Html.p []
= ]
= , Goal.CollectSingle
+ []
= [ Goal.Collectible '🍏' "an apple"
= , Goal.Collectible '🍇' "grapes"
- , Goal.Collectible '🍐' "a pear"
+ , Goal.Collectible '🍐' "a pear"
+ ]
+ , Goal.ReadInstructions
+ [ "Eating healthy" |> Html.text |> Html.wrap Html.h1 []
+ , "Did you notice how the Snake grew as they were collecting fruits? That's right! Each time they collect something, their length increases by one. But not everything is ther right thing to collect at a given time. Because the longer the snake gets, the more difficult it is to navigate, try to avoid collecting useless stuff. In addition to making the snake longer, collecting junk will also make them poop. Running into a poo is deadly!" |> Html.text |> Html.wrap Html.p []
+ , "In the next exercise you will be tasked with collecting fruits again, but this time there will also be mushrooms. Do not collect them!" |> Html.text |> Html.wrap Html.p []
+ ]
+ , Goal.CollectSingle
+ [ '🍄', '🍄', '🍄', '🍄', '🍄' ]
+ [ Goal.Collectible '🍏' "an apple"
+ , Goal.Collectible '🍇' "grapes"
+ , Goal.Collectible '🍐' "a pear"
= ]
= , Goal.ReadInstructions
= [ "Collecting letters" |> Html.text |> Html.wrap Html.h1 []Fix a typo in the tutorial
On by
index 8906de3..d473c9b 100644
--- a/src/Tutorial.elm
+++ b/src/Tutorial.elm
@@ -39,7 +39,7 @@ goals =
= ]
= , Goal.ReadInstructions
= [ "Eating healthy" |> Html.text |> Html.wrap Html.h1 []
- , "Did you notice how the Snake grew as they were collecting fruits? That's right! Each time they collect something, their length increases by one. But not everything is ther right thing to collect at a given time. Because the longer the snake gets, the more difficult it is to navigate, try to avoid collecting useless stuff. In addition to making the snake longer, collecting junk will also make them poop. Running into a poo is deadly!" |> Html.text |> Html.wrap Html.p []
+ , "Did you notice how the Snake grew as they were collecting fruits? That's right! Each time they collect something, their length increases by one. But not everything is the right thing to collect at a given time. Because the longer the snake gets, the more difficult it is to navigate, try to avoid collecting useless stuff. In addition to making the snake longer, collecting junk will also make them poop. Running into a poo is deadly!" |> Html.text |> Html.wrap Html.p []
= , "In the next exercise you will be tasked with collecting fruits again, but this time there will also be mushrooms. Do not collect them!" |> Html.text |> Html.wrap Html.p []
= ]
= , Goal.CollectSingleFix: Not losing in a collecting tutorial
On by
When the snake dies in a collecting tutorial the losing screen was not displayed. Now, whenever the snake is dead, the game is lost, irrespective of the current goal variant.
index 120998f..f0c735f 100644
--- a/src/Game.elm
+++ b/src/Game.elm
@@ -1129,17 +1129,17 @@ type Outcome
=
=outcome : Model -> Outcome
=outcome model =
+ if not model.snake.alive then
+ Lost
+ else
= case model.goal of
= CompleteSentence collected sentence ->
= if snakeEscaped model then
= -- TODO: Check if sentence is collected?
= Won
=
- else if model.snake.alive then
- InProgress
-
= else
- Lost
+ InProgress
=
= ReadInstructions _ ->
= -- This is always a winRename view functions to viewSomething convention
On by
Recently I'm of the opinion that view functions should be named in a verb form (view snake body) as opposed to noun form (snake body view). Most functions were already following this convention, but few old ones remained. Now it's all good.
index f0c735f..d041a14 100644
--- a/src/Game.elm
+++ b/src/Game.elm
@@ -432,8 +432,8 @@ viewArea model =
= let
= entities =
= [ viewBackground model.tiles
- , lettersView model.letters
- , snakeView model.snake
+ , viewLetters model.letters
+ , viewSnake model.snake
= ]
= |> Svg.g
= [ Transformations.Translate "px"
@@ -488,8 +488,8 @@ viewBackgroundTile ( x, y ) =
= []
=
=
-lettersView : Letters -> Svg Msg
-lettersView letters =
+viewLetters : Letters -> Svg Msg
+viewLetters letters =
= letters
= |> Dict.toList
= |> List.map viewLetter
@@ -498,19 +498,19 @@ lettersView letters =
= ]
=
=
-snakeView : Snake -> Svg Msg
-snakeView snake =
- [ bodyView snake.alive snake.body
- , tailView snake.alive snake.tail
- , headView snake.alive snake.head
+viewSnake : Snake -> Svg Msg
+viewSnake snake =
+ [ viewBody snake.alive snake.body
+ , viewTail snake.alive snake.tail
+ , viewHead snake.alive snake.head
= ]
= |> Svg.g
= [ Html.Attributes.style "pointer-events" "none"
= ]
=
=
-headView : Bool -> Position -> Svg Msg
-headView alive position =
+viewHead : Bool -> Position -> Svg Msg
+viewHead alive position =
= let
= shape =
= if alive then
@@ -534,18 +534,18 @@ headView alive position =
= , Html.Attributes.style "dominant-baseline" "middle"
= ]
= in
- segmentView shape position
+ viewSegment shape position
=
=
-bodyView : Bool -> List Position -> Svg Msg
-bodyView alive segments =
+viewBody : Bool -> List Position -> Svg Msg
+viewBody alive segments =
= segments
- |> List.map (bodySegmentView alive)
+ |> List.map (viewBodySegment alive)
= |> Svg.g []
=
=
-tailView : Bool -> Position -> Svg Msg
-tailView alive position =
+viewTail : Bool -> Position -> Svg Msg
+viewTail alive position =
= let
= shape =
= if alive then
@@ -569,11 +569,11 @@ tailView alive position =
= , Html.Attributes.style "dominant-baseline" "middle"
= ]
= in
- segmentView shape position
+ viewSegment shape position
=
=
-bodySegmentView : Bool -> Position -> Svg Msg
-bodySegmentView alive position =
+viewBodySegment : Bool -> Position -> Svg Msg
+viewBodySegment alive position =
= let
= shape =
= if alive then
@@ -597,11 +597,11 @@ bodySegmentView alive position =
= , Html.Attributes.style "dominant-baseline" "middle"
= ]
= in
- segmentView shape position
+ viewSegment shape position
=
=
-segmentView : Svg Msg -> Position -> Svg Msg
-segmentView shape ( x, y ) =
+viewSegment : Svg Msg -> Position -> Svg Msg
+viewSegment shape ( x, y ) =
= shape
= |> List.singleton
= |> Svg.gExtract the Snake type and logic to own module
On by
I intend to rework this code and having it in one place makes sense as a first step.
index d041a14..f6e9448 100644
--- a/src/Game.elm
+++ b/src/Game.elm
@@ -28,6 +28,7 @@ import Maybe.Extra as Maybe
=import Position exposing (Position)
=import Random
=import Set exposing (Set)
+import Snake exposing (Snake)
=import Spring exposing (Spring)
=import Svg exposing (Svg)
=import Svg.Attributes exposing (direction)
@@ -67,15 +68,6 @@ type alias Letters =
= Dict Position Char
=
=
-type alias Snake =
- { head : Position
- , body : List Position -- TODO: body : List Direction
- , tail : Position
- , direction : Direction
- , alive : Bool
- }
-
-
=type alias Swipe =
= { identifier : Int
= , from : ( Float, Float )
@@ -106,13 +98,7 @@ init flags =
= (Spring.create { strength = 20, dampness = 3 })
= (Spring.create { strength = 20, dampness = 3 })
= , letters = Dict.empty
- , snake =
- { head = ( 0, 0 )
- , body = List.repeat 5 ( 0, 0 )
- , tail = ( 0, 0 )
- , direction = East
- , alive = True
- }
+ , snake = Snake.new ( 0, 0 ) East 5
= , goal = flags.goal
= , word = ""
= , randomness = flags.randomness
@@ -703,9 +689,9 @@ update msg model =
= snake : Snake
= snake =
= model.snake
- |> setDirection direction
+ |> Snake.setDirection direction
= |> updateSnake letters
- |> moveSnake
+ |> Snake.move
=
= tiles =
= snake.head
@@ -771,42 +757,42 @@ update msg model =
= ( model, Cmd.none )
=
= Just Keyboard.ArrowUp ->
- ( { model | snake = setDirection North model.snake }
+ ( { model | snake = Snake.setDirection North model.snake }
= , Cmd.none
= )
=
= Just (Keyboard.Character "W") ->
- ( { model | snake = setDirection North model.snake }
+ ( { model | snake = Snake.setDirection North model.snake }
= , Cmd.none
= )
=
= Just Keyboard.ArrowRight ->
- ( { model | snake = setDirection East model.snake }
+ ( { model | snake = Snake.setDirection East model.snake }
= , Cmd.none
= )
=
= Just (Keyboard.Character "D") ->
- ( { model | snake = setDirection East model.snake }
+ ( { model | snake = Snake.setDirection East model.snake }
= , Cmd.none
= )
=
= Just Keyboard.ArrowDown ->
- ( { model | snake = setDirection South model.snake }
+ ( { model | snake = Snake.setDirection South model.snake }
= , Cmd.none
= )
=
= Just (Keyboard.Character "S") ->
- ( { model | snake = setDirection South model.snake }
+ ( { model | snake = Snake.setDirection South model.snake }
= , Cmd.none
= )
=
= Just Keyboard.ArrowLeft ->
- ( { model | snake = setDirection West model.snake }
+ ( { model | snake = Snake.setDirection West model.snake }
= , Cmd.none
= )
=
= Just (Keyboard.Character "A") ->
- ( { model | snake = setDirection West model.snake }
+ ( { model | snake = Snake.setDirection West model.snake }
= , Cmd.none
= )
=
@@ -915,7 +901,7 @@ update msg model =
= , snake =
= { swipe | to = touch.clientPos }
= |> swipeDirection
- |> Maybe.map (\direction -> setDirection direction model.snake)
+ |> Maybe.map (\direction -> Snake.setDirection direction model.snake)
= |> Maybe.withDefault model.snake
= }
= , Cmd.none
@@ -1131,33 +1117,34 @@ outcome : Model -> Outcome
=outcome model =
= if not model.snake.alive then
= Lost
- else
- case model.goal of
- CompleteSentence collected sentence ->
- if snakeEscaped model then
- -- TODO: Check if sentence is collected?
- Won
=
- else
- InProgress
-
- ReadInstructions _ ->
- -- This is always a win
- Won
+ else
+ case model.goal of
+ CompleteSentence collected sentence ->
+ if snakeEscaped model then
+ -- TODO: Check if sentence is collected?
+ Won
=
- ChangeDirections [] ->
- Won
+ else
+ InProgress
=
- ChangeDirections _ ->
- InProgress
+ ReadInstructions _ ->
+ -- This is always a win
+ Won
=
- CollectSingle _ collectibles ->
- if List.isEmpty collectibles then
+ ChangeDirections [] ->
= Won
=
- else
+ ChangeDirections _ ->
= InProgress
=
+ CollectSingle _ collectibles ->
+ if List.isEmpty collectibles then
+ Won
+
+ else
+ InProgress
+
=
=passwordCollected : String -> Goal.Sentence -> Bool
=passwordCollected collected sentence =
@@ -1212,86 +1199,6 @@ swipeDirection swipe =
= West
=
=
-setDirection : Direction -> Snake -> Snake
-setDirection direction snake =
- 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
-
- else
- { snake | direction = direction }
-
-
-
--- snake movement
-
-
-moveSnake : Snake -> Snake
-moveSnake snake =
- let
- head : Position
- head =
- Position.shift snake.direction snake.head
-
- body : List Position
- 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 )
-
- alive : Bool
- alive =
- List.member head body |> not
- in
- if snake.alive then
- { head = head
- , body = body
- , tail = tail
- , alive = alive
- , direction = snake.direction
- }
-
- else
- snake
-
-
=
=-- random generators
=new file mode 100644
index 0000000..7817670
--- /dev/null
+++ b/src/Snake.elm
@@ -0,0 +1,99 @@
+module Snake exposing (Snake, move, new, setDirection)
+
+import Direction exposing (Direction)
+import Position exposing (Position)
+
+
+type alias Snake =
+ { head : Position
+ , body : List Position -- TODO: body : List Direction
+ , tail : Position
+ , direction : Direction
+ , alive : Bool
+ }
+
+
+new : Position -> Direction -> Int -> Snake
+new head direction length =
+ { head = head
+ , body = List.repeat length ( 0, 0 )
+ , tail = ( 0, 0 )
+ , direction = direction
+ , alive = True
+ }
+
+
+move : Snake -> Snake
+move snake =
+ let
+ head : Position
+ head =
+ Position.shift snake.direction snake.head
+
+ body : List Position
+ 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 )
+
+ alive : Bool
+ alive =
+ List.member head body |> not
+ in
+ if snake.alive then
+ { head = head
+ , body = body
+ , tail = tail
+ , alive = alive
+ , direction = snake.direction
+ }
+
+ else
+ snake
+
+
+setDirection : Direction -> Snake -> Snake
+setDirection direction snake =
+ 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
+
+ else
+ { snake | direction = direction }The cause of death will be explained
On by
When the game is lost a screen is displayed. Now it contains an explanation of why it was lost.
index f6e9448..f8906b1 100644
--- a/src/Game.elm
+++ b/src/Game.elm
@@ -3,6 +3,7 @@ port module Game exposing
= , Msg(..)
= , Outcome(..)
= , continue
+ , hasWon
= , init
= , outcome
= , snakeEscaped
@@ -114,14 +115,19 @@ continue goal ({ area, snake, letters } as game) =
= , area = { area | center = game.snake.head }
= , snake =
= { snake
- | alive = True
+ | death = Nothing
= , body =
- -- TODO: Reconsider
- if snake.alive then
+ if Snake.isAlive snake then
= snake.body
=
= else
= List.repeat 3 snake.head
+ , tail =
+ if Snake.isAlive snake then
+ snake.tail
+
+ else
+ snake.head
= }
= , word = ""
= , letters = clearPath snake.head snake.direction 5 letters
@@ -299,19 +305,44 @@ viewCurtain countdown game =
=
= Lost ->
= [ Html.h2
- [ Html.Attributes.style "font-size" "2em"
+ [ Html.Attributes.style "font-size" "4em"
= , Html.Attributes.style "text-shadow" "2px 2px black"
= ]
= [ Html.text "☠️" ]
= , Html.p
- [ Html.Attributes.style "text-shadow" "2px 2px black"
+ [ Html.Attributes.style "font-size" "2rem"
+ , Html.Attributes.style "text-shadow" "2px 2px black"
= ]
= [ Html.text "Oh, no! Your snake is dead." ]
+ , case game.snake.death of
+ Nothing ->
+ -- Can't happen?
+ "" |> Html.text
+
+ Just Snake.CollidedWithThemselves ->
+ "The snake have collided with their own body. You need to make sure it doesn't happen!"
+ |> Html.text
+ |> Html.wrap Html.p
+ [ Html.Attributes.style "text-shadow" "2px 2px black"
+ ]
+
+ Just Snake.Burnt ->
+ "Your snake got into a hot flame! Don't play with fire - it's deadly 🔥🔥🔥"
+ |> Html.text
+ |> Html.wrap Html.p
+ [ Html.Attributes.style "text-shadow" "2px 2px black"
+ ]
+
+ Just Snake.CollectedPoo ->
+ "The snake collected a poo and died! That's just disgusting."
+ |> Html.text
+ |> Html.wrap Html.p
+ [ Html.Attributes.style "text-shadow" "2px 2px black"
+ ]
= , playAgainButton
= ]
= |> Html.div
- [ Html.Attributes.style "font-size" "2rem"
- , Html.Attributes.style "font-weight" "bold"
+ [ Html.Attributes.style "font-weight" "bold"
= , Html.Attributes.style "color" "white"
= , Html.Attributes.style "text-align" "center"
= , Html.Attributes.style "align-self" "center"
@@ -486,9 +517,13 @@ viewLetters letters =
=
=viewSnake : Snake -> Svg Msg
=viewSnake snake =
- [ viewBody snake.alive snake.body
- , viewTail snake.alive snake.tail
- , viewHead snake.alive snake.head
+ 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"
@@ -1042,19 +1077,13 @@ updateSnake letters snake =
= snake
=
= Just '🔥' ->
- { snake | alive = False }
+ Snake.kill Snake.Burnt snake
=
= Just '💩' ->
- { snake | alive = False }
+ Snake.kill Snake.CollectedPoo snake
=
= Just _ ->
- { snake
- | body =
- snake.body
- |> List.reverse
- |> (::) snake.tail
- |> List.reverse
- }
+ Snake.grow snake
=
=
=updateLetters : Goal -> Snake -> Letters -> Letters
@@ -1115,36 +1144,37 @@ type Outcome
=
=outcome : Model -> Outcome
=outcome model =
- if not model.snake.alive then
- Lost
+ case model.snake.death of
+ Just cause ->
+ Lost
=
- else
- case model.goal of
- CompleteSentence collected sentence ->
- if snakeEscaped model then
- -- TODO: Check if sentence is collected?
- Won
-
- else
- InProgress
-
- ReadInstructions _ ->
- -- This is always a win
- Won
+ Nothing ->
+ case model.goal of
+ CompleteSentence collected sentence ->
+ if snakeEscaped model then
+ -- TODO: Check if sentence is collected?
+ Won
=
- ChangeDirections [] ->
- Won
+ else
+ InProgress
=
- ChangeDirections _ ->
- InProgress
+ ReadInstructions _ ->
+ -- This is always a win
+ Won
=
- CollectSingle _ collectibles ->
- if List.isEmpty collectibles then
+ ChangeDirections [] ->
= Won
=
- else
+ ChangeDirections _ ->
= InProgress
=
+ CollectSingle _ collectibles ->
+ if List.isEmpty collectibles then
+ Won
+
+ else
+ InProgress
+
=
=passwordCollected : String -> Goal.Sentence -> Bool
=passwordCollected collected sentence =
@@ -1153,7 +1183,7 @@ passwordCollected collected sentence =
=
=snakeEscaped : Model -> Bool
=snakeEscaped model =
- model.snake.alive && Area.isOutside model.area model.snake.head
+ Snake.isAlive model.snake && Area.isOutside model.area model.snake.head
=
=
=
@@ -1322,3 +1352,8 @@ decay decayList dict =
= |> List.map2 maybeAnnihilate decayList
= |> Maybe.values
= |> Dict.fromList
+
+
+hasWon : Model -> Bool
+hasWon game =
+ outcome game == Wonindex 1ac78e1..1e6d81f 100644
--- a/src/Main.elm
+++ b/src/Main.elm
@@ -592,14 +592,18 @@ rescheduleLevels outcomes levels =
= levels
= |> List.indexedMap
= (\index level ->
- case Dict.get (Goal.serialize level) outcomes of
- Just Game.Won ->
+ case
+ outcomes
+ |> Dict.get (Goal.serialize level)
+ |> Maybe.withDefault Game.InProgress
+ of
+ Game.Won ->
= ( index + List.length levels, level )
=
- Just Game.Lost ->
+ Game.Lost ->
= ( index + 5, level )
=
- _ ->
+ Game.InProgress ->
= ( index, level )
= )
= |> List.sortBy Tuple.firstindex 7817670..16ed718 100644
--- a/src/Snake.elm
+++ b/src/Snake.elm
@@ -1,4 +1,14 @@
-module Snake exposing (Snake, move, new, setDirection)
+module Snake exposing
+ ( CauseOfDeath(..)
+ , Snake
+ , grow
+ , isAlive
+ , isDead
+ , kill
+ , move
+ , new
+ , setDirection
+ )
=
=import Direction exposing (Direction)
=import Position exposing (Position)
@@ -9,20 +19,36 @@ type alias Snake =
= , body : List Position -- TODO: body : List Direction
= , tail : Position
= , direction : Direction
- , alive : Bool
+ , death : Maybe CauseOfDeath
= }
=
=
+type CauseOfDeath
+ = CollidedWithThemselves
+ | Burnt
+ | CollectedPoo
+
+
=new : Position -> Direction -> Int -> Snake
=new head direction length =
= { head = head
= , body = List.repeat length ( 0, 0 )
= , tail = ( 0, 0 )
= , direction = direction
- , alive = True
+ , death = Nothing
= }
=
=
+isAlive : Snake -> Bool
+isAlive snake =
+ snake.death == Nothing
+
+
+isDead : Snake -> Bool
+isDead =
+ not << isAlive
+
+
=move : Snake -> Snake
=move snake =
= let
@@ -48,15 +74,19 @@ move snake =
= moveSegments segment ( target, segments ) =
= ( segment, target :: segments )
=
- alive : Bool
- alive =
- List.member head body |> not
+ death : Maybe CauseOfDeath
+ death =
+ if List.member head body then
+ Just CollidedWithThemselves
+
+ else
+ snake.death
= in
- if snake.alive then
+ if isAlive snake then
= { head = head
= , body = body
= , tail = tail
- , alive = alive
+ , death = death
= , direction = snake.direction
= }
=
@@ -97,3 +127,24 @@ setDirection direction snake =
=
= else
= { snake | direction = direction }
+
+
+grow : Snake -> Snake
+grow snake =
+ { snake
+ | body =
+ snake.body
+ |> List.reverse
+ |> (::) snake.tail
+ |> List.reverse
+ }
+
+
+kill : CauseOfDeath -> Snake -> Snake
+kill cause snake =
+ if isAlive snake then
+ { snake | death = Just cause }
+
+ else
+ -- You can't kill a dead snake!
+ snake