Skip to content

add keyboard coloring effects #5

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 2 commits into
base: main
Choose a base branch
from
Open

add keyboard coloring effects #5

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
17267f1
add keyboard coloring effects
Dor256 Sep 11, 2025
15bd28d
add missing color change on game over
Dor256 Oct 16, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
9 changes: 5 additions & 4 deletions client/src/Elements.elm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -182,8 +182,7 @@ keyboardContainer =
key : HtmlElement msg
key =
styled div
[ backgroundColor (hex "#818384")
, fontWeight bold
[ fontWeight bold
, margin4 (px 0) (px 6) (px 0) (px 0)
, height (px 58)
, borderRadius (px 4)
Expand All @@ -207,14 +206,16 @@ keyRow =
enterKey : HtmlElement msg
enterKey =
styled key
[ flex (num 1.5)
[ backgroundColor (hex "#818384")
, flex (num 1.5)
, padding2 (px 0) (px 5)
]

deleteKey : HtmlElement msg
deleteKey =
styled key
[ flex (num 1.5)
[ backgroundColor (hex "#818384")
, flex (num 1.5)
, fontSize (px 25)
, padding2 (px 0) (px 5)
]
Expand Down
90 changes: 47 additions & 43 deletions client/src/Main.elm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@ import Keyboard exposing (translateKey)
import Task
import Process
import Storage exposing (guessesStorageKey, dailyWordStorageKey, storageHandlers)
import Model exposing (Model, Msg(..), Guess, Outcome(..))
import Model exposing (Model, Msg(..), Guess, Outcome(..), Score(..), scoreGuess, updateLetterScore)
import Dict

main : Program () Model Msg
Expand All @@ -32,6 +32,7 @@ init _ =
, word = ""
, currentGuess = ""
, gameOutcome = Nothing
, guessedLetters = Dict.empty
}
, Cmd.batch
[ runCmd (OnLoad guessesStorageKey)
Expand All @@ -54,9 +55,15 @@ runCmd msg =
Task.succeed msg
|> Task.perform identity

runDelayedCmd : Float -> msg -> Cmd msg
runDelayedCmd delay msg =
delay
|> Process.sleep
|> Task.perform (always msg)

performDelayedMessage : msg -> Cmd msg
performDelayedMessage msg =
transitionDelayMs * 6 |> Process.sleep |> Task.perform (always msg)
performDelayedMessage =
runDelayedCmd (transitionDelayMs * 6)

update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
Expand Down Expand Up @@ -91,22 +98,30 @@ update msg model =
Submit ->
if String.length model.currentGuess == wordSize then
let
newGuesses = model.guesses ++ [model.currentGuess]
scoredDict = updateLetterScore { model | guesses = newGuesses }
isCorrectGuess = model.currentGuess == model.word
cmd = if isCorrectGuess then
Cmd.batch
[ performDelayedMessage (GameOver Win)
[ runDelayedCmd (transitionDelayMs * 5) (UpdateKeyboard scoredDict)
, performDelayedMessage (GameOver Win)
, LocalStorage.clear ()
]
else if List.length model.guesses + 1 >= maxGuesses then
Cmd.batch
[ performDelayedMessage (GameOver Lose)
[ runDelayedCmd (transitionDelayMs * 5) (UpdateKeyboard scoredDict)
, performDelayedMessage (GameOver Lose)
, LocalStorage.clear ()
]
else runCmd (Save (guessesStorageKey, String.join "," (model.guesses ++ [model.currentGuess])))
else
Cmd.batch
[ runCmd (Save (guessesStorageKey, String.join "," newGuesses))
, runDelayedCmd (transitionDelayMs * 5) (UpdateKeyboard scoredDict)
]
in
( { model
| currentGuess = ""
, guesses = List.take maxGuesses (model.guesses ++ [model.currentGuess])
, guesses = List.take maxGuesses newGuesses
}
, cmd
)
Expand All @@ -119,6 +134,8 @@ update msg model =

_ ->
( model, Cmd.none )
UpdateKeyboard scoredKeys ->
( { model | guessedLetters = scoredKeys }, Cmd.none )
GameOver outcome ->
( { model | gameOutcome = Just outcome }, Cmd.none )

Expand Down Expand Up @@ -155,11 +172,6 @@ renderCurrentGuess guess =
|> List.map toTile
) ++ List.repeat padding emptyTile

type Score
= Hit
| Miss
| Misplaced

renderScoredGuess : String -> Guess -> Html msg
renderScoredGuess word guess =
let
Expand Down Expand Up @@ -205,28 +217,6 @@ removeMisplacedIfHit word scoredGuess =
)
scoredGuess

scoreGuess : String -> Guess -> List ( Char, Score )
scoreGuess word guess =
let
wordChars = String.toList word
wordSet = Set.fromList wordChars
guessChars = String.toList guess
in
List.map2
(\wordChar guessChar ->
( guessChar
, if guessChar == wordChar then
Hit
else if wordSet |> Set.member guessChar then
Misplaced
else
Miss
)
)
wordChars
guessChars


wordleGrid : Model -> Html msg
wordleGrid { guesses, currentGuess, word } =
let
Expand All @@ -241,29 +231,43 @@ wordleGrid { guesses, currentGuess, word } =
, List.repeat unusedGuesses emptyRow
]

toKeys : String -> List (Html Msg)
toKeys keys =
toKeys : String -> Model -> List (Html Msg)
toKeys keys model =
let
toKey letter = key [ onClick <| TypeLetter (translateKey letter) ] [text <| String.fromChar letter]
coloredDict = Dict.map (\_ score ->
case score of
Hit -> hex "#538d4e"
Misplaced -> hex "#b59f3b"
Miss -> hex "#3a3a3c"
) model.guessedLetters
scoreToBackgroundColor letter =
coloredDict
|> Dict.get letter
|> Maybe.map (\color -> backgroundColor color)
|> Maybe.withDefault (backgroundColor (hex "#818384"))
toKey letter =
styled key [scoreToBackgroundColor letter]
[ onClick <| TypeLetter (translateKey letter) ]
[ text <| String.fromChar letter ]
in
keys
|> String.toList
|> List.map toKey

keyboard : Html Msg
keyboard =
keyboard : Model -> Html Msg
keyboard model =
keyboardContainer []
[ keyRow [] <| toKeys "qwertyuiop"
[ keyRow [] <| toKeys "qwertyuiop" model
, keyRow [] <|
List.concat
[ [spacer [] []]
, toKeys "asdfghjkl"
, toKeys "asdfghjkl" model
, [spacer [] []]
]
, keyRow [] <|
List.concat
[ [ enterKey [onClick <| TypeLetter Submit] [text "Enter"] ]
, toKeys "zxcvbnm"
, toKeys "zxcvbnm" model
, [ deleteKey [onClick <| TypeLetter Delete] [text "⌫"] ]
]
]
Expand Down Expand Up @@ -291,7 +295,7 @@ view model =
, text model.word
, gameOverModal model.gameOutcome
, wordleGrid model
, keyboard
, keyboard model
]
]

50 changes: 50 additions & 0 deletions client/src/Model.elm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,16 +2,24 @@ module Model exposing (..)

import Api exposing (WordResponse)
import Keyboard exposing (KeyAction)
import Dict exposing (Dict)
import Set

type alias Guess = String

type Outcome = Win | Lose

type Score
= Hit
| Miss
| Misplaced

type alias Model =
{ guesses : List String
, word : String
, currentGuess : Guess
, gameOutcome : Maybe Outcome
, guessedLetters : Dict Char Score
}

type Msg
Expand All @@ -21,3 +29,45 @@ type Msg
| Load ( String, Maybe String )
| TypeLetter KeyAction
| GameOver Outcome
| UpdateKeyboard (Dict Char Score)


scoreGuess : String -> Guess -> List ( Char, Score )
scoreGuess word guess =
let
wordChars = String.toList word
wordSet = Set.fromList wordChars
guessChars = String.toList guess
in
List.map2
(\wordChar guessChar ->
( guessChar
, if guessChar == wordChar then
Hit
else if wordSet |> Set.member guessChar then
Misplaced
else
Miss
)
)
wordChars
guessChars


updateLetterScore : Model -> Dict.Dict Char Score
updateLetterScore model =
let
scoredLetters = List.concatMap (scoreGuess model.word) model.guesses
in
List.foldl
(\(char, score) dict ->
case Dict.get char dict of
Just Hit ->
dict
Just Misplaced ->
if score == Hit then Dict.insert char score dict else dict
_ ->
Dict.insert char score dict
)
model.guessedLetters
scoredLetters
3 changes: 2 additions & 1 deletion client/src/Storage.elm
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
module Storage exposing (guessesStorageKey, dailyWordStorageKey, storageHandlers)
import Model exposing (Model, Msg)
import Model exposing (Model, Msg, updateLetterScore)
import Model exposing (Msg(..))
import Api exposing (fetchWord)
import Dict exposing (Dict)
Expand All @@ -20,6 +20,7 @@ updateGuesses maybeValue model =
Maybe.map (\value -> { model
| guesses = model.guesses ++ String.split "," value
, currentGuess = ""
, guessedLetters = updateLetterScore { model | guesses = model.guesses ++ String.split "," value }
}) maybeValue
in
( newModel, Cmd.none )
Expand Down