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 |
<lang elm>import Html.App exposing (program) |
||
import |
import Time exposing (Time, every, millisecond) |
||
import |
import Color exposing (Color, black, red, blue, green) |
||
import |
import Collage exposing (collage) |
||
import |
import Collage exposing (collage,polygon, filled, move, Form, circle) |
||
import Element exposing (toHtml) |
|||
⚫ | |||
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 ( |
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. |
import Random.Pcg as Random exposing (Seed, bool, initialSeed, independentSeed, step, map) |
||
⚫ | |||
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) = |
(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) |
|||
} |
|||
⚫ | |||
drop : Signal Action |
|||
drop = Signal.map (\t -> Drop (round t)) (every 200) |
|||
⚫ | |||
tick : Signal Action |
|||
tick = Signal.map (\t -> Tick) (every 40) |
|||
update : |
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}, |
({model | started = model.count > 0}, Cmd.none) |
||
SetCount countString -> |
SetCount countString -> |
||
({ model | count = toInt countString |> withDefault 0 }, |
({ 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) = |
(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''}, |
, seed = seed''}, Cmd.none) |
||
else |
else |
||
(model, |
(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}, |
in ({ model | coins = updatedCoins, bins = updatedBins}, Cmd.none) |
||
view : |
view : Model -> Html Msg |
||
view |
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 |
||
, |
, onInput SetCount |
||
, disabled model.started |
, disabled model.started |
||
, style [ ("height", "20px") ] |
, style [ ("height", "20px") ] |
||
Line 1,045: | Line 1,038: | ||
, button |
, button |
||
[ onClick |
[ 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) |> |
in collage width height (coinForms ++ drawGaltonBox) |> toHtml |
||
] |
] |
||
subscriptions model = |
|||
app : StartApp.App Model |
|||
Sub.batch |
|||
app = StartApp.start |
|||
[ every (40*millisecond) Tick |
|||
⚫ | |||
, every (200*millisecond) Drop |
|||
⚫ | |||
] |
|||
, inputs = [ drop , tick ] |
|||
} |
|||
main |
main = |
||
program |
|||
⚫ | |||
⚫ | |||
, view = view |
|||
⚫ | |||
, subscriptions = subscriptions |
|||
⚫ | |||
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. |