-
-
Save alex-lew/c3ad074980503b98a08267c504a2ac40 to your computer and use it in GitHub Desktop.
A version of GifGame that works on elm-lang.org/try
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import Html exposing (Html, div, text, p, button, input, br, img) | |
import Html.App exposing (program) | |
import Html.Attributes exposing (style, src) | |
import Html.Events exposing (onClick, onInput) | |
import Http | |
import Random | |
import Task | |
import Json.Decode as Json | |
type alias GModel = | |
{ gifUrl : String | |
, currentTopic : String | |
, currentGuess : String | |
, guessesLeft : Int | |
} | |
type GInternalMsg | |
= TextChanged String | |
| MakeGuess | |
| GifError Http.Error | |
| NewTopic String | |
| NewGif String | |
type GOutMsg | |
= PlayerWin Int | |
| PlayerLoss | |
type GMsg | |
= ForSelf GInternalMsg | |
| ForParent GOutMsg | |
type alias GTranslationDictionary parentMsg = | |
{ onInternalMessage : GInternalMsg -> parentMsg | |
, onPlayerWin : Int -> parentMsg | |
, onPlayerLose : parentMsg | |
} | |
type alias GTranslator parentMsg = | |
GMsg -> parentMsg | |
gtranslator : GTranslationDictionary parentMsg -> GTranslator parentMsg | |
gtranslator { onInternalMessage, onPlayerWin, onPlayerLose } msg = | |
case msg of | |
ForSelf internal -> | |
onInternalMessage internal | |
ForParent (PlayerWin score) -> | |
onPlayerWin score | |
ForParent PlayerLoss -> | |
onPlayerLose | |
-- INIT | |
initialModel = | |
{ gifUrl = "waiting.gif", currentTopic = "", currentGuess = "", guessesLeft = 10 } | |
ginit : GTranslator parentMsg -> ( GModel, Cmd parentMsg ) | |
ginit translator = | |
initialModel ! [ Cmd.map translator getRandomTopic ] | |
-- VIEW | |
{-| Note the use of composition here to chain the `TextChanged` constructor function with `ForSelf` | |
-} | |
view' : GModel -> Html GMsg | |
view' model = | |
div [ style [ ( "display", "block" ), ( "padding", "20px" ) ] ] | |
[ img [ src model.gifUrl ] [] | |
, br [] [] | |
, input [ onInput (ForSelf << TextChanged) ] [] | |
, button [ onClick (ForSelf MakeGuess) ] [ text "Guess!" ] | |
, p [] [ text ("Guesses left: " ++ toString model.guessesLeft) ] | |
] | |
gview : GModel -> GTranslator parentMsg -> Html parentMsg | |
gview model translator = | |
Html.App.map translator (view' model) | |
-- UPDATE | |
update' : GInternalMsg -> GModel -> ( GModel, Cmd GMsg ) | |
update' msg model = | |
case msg of | |
TextChanged newText -> | |
{ model | currentGuess = newText } ! [] | |
GifError _ -> | |
model ! [] | |
NewTopic topic -> | |
{ model | currentTopic = topic } ! [ getRandomGif topic ] | |
NewGif gifUrl -> | |
{ model | gifUrl = gifUrl } ! [] | |
MakeGuess -> | |
let | |
newGame = | |
{ initialModel | currentGuess = model.currentGuess } | |
in | |
if model.currentGuess == model.currentTopic then | |
newGame ! [ getRandomTopic, generateParentMsg (PlayerWin model.guessesLeft) ] | |
else if model.guessesLeft == 1 then | |
newGame ! [ getRandomTopic, generateParentMsg PlayerLoss ] | |
else | |
{ model | guessesLeft = model.guessesLeft - 1 } ! [] | |
gupdate : GInternalMsg -> GModel -> GTranslator parentMsg -> ( GModel, Cmd parentMsg ) | |
gupdate msg model translator = | |
let | |
( model', cmd ) = | |
update' msg model | |
in | |
( model', Cmd.map translator cmd ) | |
never : Never -> a | |
never n = | |
never n | |
generateParentMsg : GOutMsg -> Cmd GMsg | |
generateParentMsg outMsg = | |
Task.perform never ForParent (Task.succeed outMsg) | |
randomConstant : a -> Random.Generator a | |
randomConstant value = Random.map (\_ -> value) Random.bool | |
listGetIndex lst i = | |
case (lst, i) of | |
([], _) -> Debug.crash "Empty list" | |
(x :: _, 0) -> x | |
(_ :: xs, n) -> listGetIndex xs (n - 1) | |
randomChoices : List (Random.Generator a) -> Random.Generator a | |
randomChoices lst = Random.int 0 (List.length lst) `Random.andThen` | |
\index -> listGetIndex lst index | |
getRandomTopic : Cmd GMsg | |
getRandomTopic = | |
let | |
-- Just some things I like... | |
topics = | |
[ "cats", "dogs", "orphan black", "elm", "translation", "pets" ] | |
topicGenerators = | |
List.map randomConstant topics | |
randomTopicGenerator = | |
randomChoices topicGenerators | |
in | |
Random.generate (ForSelf << NewTopic) randomTopicGenerator | |
getRandomGif : String -> Cmd GMsg | |
getRandomGif topic = | |
let | |
decodeGifUrl : Json.Decoder String | |
decodeGifUrl = | |
Json.at [ "data", "image_url" ] Json.string | |
url = | |
"http://api.giphy.com/v1/gifs/random?api_key=dc6zaTOxFJmzC&tag=" ++ topic | |
in | |
Cmd.map ForSelf <| Task.perform GifError NewGif (Http.get decodeGifUrl url) | |
type alias Model = | |
{ p1Game : GModel | |
, p2Game : GModel | |
, p1Score : Int | |
, p2Score : Int | |
} | |
type Player | |
= P1 | |
| P2 | |
{-| We can _increase_ a player's score by a certain (variable) amount when she wins; we can penalize a player when she loses, and we can reset the game for both players at once. | |
The IncreaseScore and Penalize messages will be generated from within the GifGame component, whereas the Reset message will be generated from Main. The beauty of the Translator pattern is that this doesn't matter: we just list all the messages we will have to handle. | |
-} | |
type Msg | |
= GameMsg Player GInternalMsg | |
| IncreaseScore Player Int | |
| Penalize Player | |
| Reset | |
{-| Here we present a slight variation on the pattern described in the article. Since we have two players, and therefore two active instances of the GifGame component, we will provide two different translators, one that translates GifGame messages into messages about player 1, and one that translates them into messages about player 2. | |
The `translator` function is where this happens -- it takes in a player, and creates a custom translator for that player. Note that the child component doesn't know anything about the Player type, or that it has more than one instance. | |
-} | |
translator : Player -> GTranslator Msg | |
translator pl = | |
let | |
translationDictionary = | |
{ onInternalMessage = GameMsg pl | |
, onPlayerWin = IncreaseScore pl | |
, onPlayerLose = Penalize pl | |
} | |
in | |
gtranslator translationDictionary | |
p1Translator = | |
translator P1 | |
p2Translator = | |
translator P2 | |
{-| As in any Elm app, we need to get initial state and commands from our component. Note that instead of using `Cmd.map` on the resulting commands, though, we pass in a translator to the child's `init` function. This allows the child to return ready-to-use `Cmd Msg` values. | |
-} | |
init : ( Model, Cmd Msg ) | |
init = | |
let | |
( p1Init, p1Commands ) = | |
ginit p1Translator | |
( p2Init, p2Commands ) = | |
ginit p2Translator | |
in | |
{ p1Game = p1Init | |
, p2Game = p2Init | |
, p1Score = 0 | |
, p2Score = 0 | |
} | |
! [ p1Commands, p2Commands ] | |
{-| In the view, we calculate the background color based on the scores of the two players, then create a simple div that renders the two child components. Incorporating those components is very lightweight: we simply pass our translators into `G.view`, and we get ready-to-use `Html Msg` values to stick into our program. | |
-} | |
view : Model -> Html Msg | |
view model = | |
let | |
backgroundColor = | |
if model.p1Score > model.p2Score then | |
"lightblue" | |
else if model.p2Score > model.p1Score then | |
"pink" | |
else | |
"white" | |
bgColorStyle = | |
style [ ( "background-color", backgroundColor ) ] | |
in | |
div [ bgColorStyle ] | |
[ gview model.p1Game p1Translator | |
, gview model.p2Game p2Translator | |
, button [ onClick Reset ] [ text "Reset everything" ] | |
] | |
update : Msg -> Model -> ( Model, Cmd Msg ) | |
update msg model = | |
case msg of | |
IncreaseScore P1 amt -> | |
{ model | p1Score = model.p1Score + amt } ! [] | |
IncreaseScore P2 amt -> | |
{ model | p2Score = model.p2Score + amt } ! [] | |
Penalize P1 -> | |
{ model | p1Score = model.p1Score - 5 } ! [] | |
Penalize P2 -> | |
{ model | p2Score = model.p2Score - 5 } ! [] | |
Reset -> | |
init | |
GameMsg P1 internal -> | |
let | |
( p1Game', cmd ) = | |
gupdate internal model.p1Game p1Translator | |
in | |
{ model | p1Game = p1Game' } ! [ cmd ] | |
GameMsg P2 internal -> | |
let | |
( p2Game', cmd ) = | |
gupdate internal model.p2Game p2Translator | |
in | |
{ model | p2Game = p2Game' } ! [ cmd ] | |
main = | |
program { init = init, view = view, update = update, subscriptions = \_ -> Sub.none } |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment