Galton box animation: Difference between revisions

Content added Content deleted
(→‎{{header|Perl 6}}: replace overly defensive code for list-of-list clone with code several times faster, and use .chrs instead of >>.chr.join)
(→‎{{header|Elm}}: Updated to work with Elm 0.17.0)
Line 851: Line 851:
+---------------------------------------+</pre>
+---------------------------------------+</pre>
=={{header|Elm}}==
=={{header|Elm}}==
<lang elm>import StartApp exposing (..)
<lang elm>import Html.App exposing (program)
import Effects exposing (Effects)
import Time exposing (Time, every, millisecond)
import Time exposing (Time, every)
import Color exposing (Color, black, red, blue, green)
import Graphics.Collage exposing (collage, polygon, filled, move, Form, circle)
import Collage exposing (collage)
import Html exposing (Attribute, Html, fromElement, text, div, input, button)
import Collage exposing (collage,polygon, filled, move, Form, circle)
import Element exposing (toHtml)
import Html exposing (Attribute, Html, text, div, input, button)
import Html.Attributes as A exposing (type', min, placeholder, value, style, disabled)
import Html.Attributes as A exposing (type', min, placeholder, value, style, disabled)
import Html.Events exposing (on, targetValue, onClick)
import Html.Events exposing (onInput, targetValue, onClick)
import Dict exposing (Dict, get, insert)
import Dict exposing (Dict, get, insert)
import String exposing (toInt)
import String exposing (toInt)
import Result exposing (withDefault)
import Result exposing (withDefault)
import Random.PCG as Random exposing (Seed, initialSeed, split, bool, generate, map)
import Random.Pcg as Random exposing (Seed, bool, initialSeed, independentSeed, step, map)
import Color exposing (Color, black, red, blue, green)


width = 500
width = 500
Line 948: Line 949:
InBox level shift seed ->
InBox level shift seed ->
let deltaShift = map (\b -> if b then 1 else -1) bool
let deltaShift = map (\b -> if b then 1 else -1) bool
(delta, newSeed) = generate deltaShift seed
(delta, newSeed) = step deltaShift seed
newShift = shift+delta
newShift = shift+delta
newLevel = (level)+1
newLevel = (level)+1
Line 966: Line 967:


Landed _ _ -> (coin, bins) -- unchanged
Landed _ _ -> (coin, bins) -- unchanged




type alias Model =
type alias Model =
Line 978: Line 977:
}
}


init : Model
init : (Model, Cmd Msg)
init =
init =
{ coins = []
( { coins = []
, bins = Dict.empty
, bins = Dict.empty
, count = 0
, count = 0
, started = False
, started = False
, seedInitialized = False
, seedInitialized = False
, seed = initialSeed 45 -- This will not get used. Actual seed used is time dependent and set when the first coin drops.
, seed = initialSeed 45 -- This will not get used. Actual seed used is time dependent and set when the first coin drops.
}, Cmd.none)
}

type Action = Drop Int | Tick | SetCount String | Go

drop : Signal Action
drop = Signal.map (\t -> Drop (round t)) (every 200)


type Msg = Drop Time | Tick Time | SetCount String | Go
tick : Signal Action
tick = Signal.map (\t -> Tick) (every 40)


update : Action -> Model -> (Model, Effects Action)
update : Msg -> Model -> (Model, Cmd Msg)
update action model =
update action model =
case action of
case action of
Go ->
Go ->
({model | started = model.count > 0}, Effects.none)
({model | started = model.count > 0}, Cmd.none)


SetCount countString ->
SetCount countString ->
({ model | count = toInt countString |> withDefault 0 }, Effects.none)
({ model | count = toInt countString |> withDefault 0 }, Cmd.none)


Drop t ->
Drop t ->
if (model.started && model.count > 0) then
if (model.started && model.count > 0) then
let newcount = model.count - 1
let newcount = model.count - 1
seed' = if model.seedInitialized then model.seed else initialSeed t
seed' = if model.seedInitialized then model.seed else initialSeed (truncate t)
(seed'', coinSeed) = split seed'
(seed'', coinSeed) = step independentSeed seed'
in ({ model
in ({ model
| coins = initCoin t coinSeed :: model.coins
| coins = initCoin (truncate t) coinSeed :: model.coins
, count = newcount
, count = newcount
, started = newcount > 0
, started = newcount > 0
, seedInitialized = True
, seedInitialized = True
, seed = seed''}, Effects.none)
, seed = seed''}, Cmd.none)
else
else
(model, Effects.none)
(model, Cmd.none)


Tick ->
Tick _ ->
-- foldr to execute update, append to coins, replace bins
-- foldr to execute update, append to coins, replace bins
let (updatedCoins, updatedBins) =
let (updatedCoins, updatedBins) =
Line 1,027: Line 1,020:
([], model.bins)
([], model.bins)
model.coins
model.coins
in ({ model | coins = updatedCoins, bins = updatedBins}, Effects.none)
in ({ model | coins = updatedCoins, bins = updatedBins}, Cmd.none)


view : Signal.Address Action -> Model -> Html
view : Model -> Html Msg
view address model =
view model =
div []
div []
[ input
[ input
Line 1,036: Line 1,029:
, let showString = if model.count > 0 then model.count |> toString else ""
, let showString = if model.count > 0 then model.count |> toString else ""
in value showString
in value showString
, on "input" targetValue (Signal.message address << SetCount)
, onInput SetCount
, disabled model.started
, disabled model.started
, style [ ("height", "20px") ]
, style [ ("height", "20px") ]
Line 1,045: Line 1,038:


, button
, button
[ onClick address Go
[ onClick Go
, disabled model.started
, disabled model.started
, style [ ("height", "20px") ]
, style [ ("height", "20px") ]
]
]
[ text "GO!" ]
[ Html.text "GO!" ]


, let coinForms = (List.map (drawCoin) model.coins)
, let coinForms = (List.map (drawCoin) model.coins)
in collage width height (coinForms ++ drawGaltonBox) |> fromElement
in collage width height (coinForms ++ drawGaltonBox) |> toHtml
]
]


subscriptions model =
app : StartApp.App Model
Sub.batch
app = StartApp.start
[ every (40*millisecond) Tick
{ init = (init, Effects.none)
, every (200*millisecond) Drop
, update = update
, view = view
]
, inputs = [ drop , tick ]
}


main : Signal Html
main =
program
main = app.html</lang>
{ init = init
, view = view
, update = update
, subscriptions = subscriptions
}</lang>


Link to live demo: http://dc25.github.io/galtonBoxAnimationElm/ . Follow the link, enter a number and press the GO button.
Link to live demo: http://dc25.github.io/galtonBoxAnimationElm/ . Follow the link, enter a number and press the GO button.