.gitignore

elm-stuff

Curve.elm

module Curve exposing (cubicBezier)

-- https://en.wikipedia.org/wiki/Bézier_curve


controlPoint1 =
    1.05


controlPoint2 =
    0.75


cubicBezier : Float -> Float -> Float -> Float
cubicBezier t p0 p3 =
    let
        p1 =
            p0 + controlPoint1 * (p3 - p0)

        p2 =
            p0 + controlPoint2 * (p3 - p0)
    in
    (p0 * ((1 - t) ^ 3))
        + (p1 * 3 * ((1 - t) ^ 2) * t)
        + (p2 * 3 * (1 - t) * (t ^ 2))
        + (p3 * (t ^ 3))

elm.json

{
    "type": "application",
    "source-directories": [
        "."
    ],
    "elm-version": "0.19.0",
    "dependencies": {
        "direct": {
            "elm/browser": "1.0.1",
            "elm/core": "1.0.2",
            "elm/html": "1.0.0",
            "elm/svg": "1.0.1",
            "elm/time": "1.0.0"
        },
        "indirect": {
            "elm/json": "1.1.3",
            "elm/url": "1.0.0",
            "elm/virtual-dom": "1.0.2"
        }
    },
    "test-dependencies": {
        "direct": {},
        "indirect": {}
    }
}

Glyph.elm

module Glyph exposing (Shape(..), view)

import Svg exposing (..)
import Svg.Attributes exposing (..)


size : Float
size =
    0.4


type Shape
    = Dot
    | Star
    | Box


view : Shape -> Float -> ( Int, Int ) -> Svg msg
view shape =
    case shape of
        Dot ->
            dot

        Star ->
            star

        Box ->
            box


dot : Float -> ( Int, Int ) -> Svg msg
dot multiplier ( x, y ) =
    circle
        [ fill "black"
        , cx (String.fromInt x)
        , cy (String.fromInt y)
        , r (String.fromFloat (size * multiplier))
        ]
        []


star : Float -> ( Int, Int ) -> Svg msg
star multiplier ( x, y ) =
    let
        center =
            String.fromFloat (toFloat x)
                ++ " "
                ++ String.fromFloat (toFloat y)
                ++ " "
    in
    Svg.path
        [ fill "transparent"
        , stroke "black"
        , strokeWidth <| String.fromFloat (multiplier * 0.2)
        , d <|
            ("M "
                ++ String.fromFloat (toFloat x - size)
                ++ " "
                ++ String.fromFloat (toFloat y)
            )
                ++ ("Q "
                        ++ center
                        ++ String.fromFloat (toFloat x)
                        ++ " "
                        ++ String.fromFloat (toFloat y - size)
                   )
                ++ ("Q "
                        ++ center
                        ++ String.fromFloat (toFloat x + size)
                        ++ " "
                        ++ String.fromFloat (toFloat y)
                   )
                ++ ("Q "
                        ++ center
                        ++ String.fromFloat (toFloat x)
                        ++ " "
                        ++ String.fromFloat (toFloat y + size)
                   )
                ++ ("Q "
                        ++ center
                        ++ String.fromFloat (toFloat x - size)
                        ++ " "
                        ++ String.fromFloat (toFloat y)
                   )
        ]
        []


box : Float -> ( Int, Int ) -> Svg msg
box multiplier ( x, y ) =
    Svg.path
        [ fill "green"
        , fillOpacity (String.fromFloat multiplier)
        , stroke "black"
        , strokeDasharray "3.3"
        , strokeDashoffset <| String.fromFloat ((1 - multiplier) * 3.3)
        , strokeWidth "0.2"
        , d <|
            ("M "
                ++ String.fromFloat (toFloat x - size)
                ++ " "
                ++ String.fromFloat (toFloat y - size)
            )
                ++ ("H " ++ String.fromFloat (toFloat x + size))
                ++ ("V " ++ String.fromFloat (toFloat y + size))
                ++ ("H " ++ String.fromFloat (toFloat x - size))
                ++ ("V " ++ String.fromFloat (toFloat y - size))
        ]
        []

Main.elm

module Main exposing (..)

import Browser
import Browser.Events
import Curve
import Glyph
import Html
import Html.Attributes
import Html.Events
import Set exposing (Set)
import Svg exposing (..)
import Svg.Attributes exposing (..)
import Time


blinker : List Cell
blinker =
    [ ( -1, 0 )
    , ( 0, 0 )
    , ( 1, 0 )
    ]


smallSpaceship : List Cell
smallSpaceship =
    [ ( -1, -1 )
    , ( 0, -1 )
    , ( 1, -1 )
    , ( 1, 0 )
    , ( 0, 1 )
    ]


middleSpaceship : List Cell
middleSpaceship =
    [ ( -2, 1 )
    , ( -1, 2 )
    , ( 0, 2 )
    , ( 1, 2 )
    , ( 2, 2 )
    , ( 3, 2 )
    , ( 3, 1 )
    , ( 3, 0 )
    , ( 2, -1 )
    , ( 0, -2 )
    , ( -2, -1 )
    ]


gun : List Cell
gun =
    let
        raw =
            [ "........................O"
            , "......................O.O"
            , "............OO......OO............OO"
            , "...........O...O....OO............OO"
            , "OO........O.....O...OO"
            , "OO........O...O.OO....O.O"
            , "..........O.....O.......O"
            , "...........O...O"
            , "............OO"
            ]

        middle =
            List.length raw // 2

        unRaw y line =
            String.toList line
                |> List.indexedMap
                    (\x char ->
                        if char == '.' then
                            Nothing
                        else
                            Just ( -middle + y, x )
                    )
                |> List.filterMap identity
    in
    List.concat <| List.indexedMap unRaw raw


type alias Model =
    { previous : World
    , current : World
    , delta : Float
    , stepDuration : Float
    , shape : Glyph.Shape
    }


type alias World =
    Set Cell


type alias Cell =
    ( Int, Int )


init : Model
init =
    { previous = Set.empty
    , current = Set.fromList gun
    , delta = 0
    , stepDuration = 450
    , shape = Glyph.Dot
    }


view : Model -> Svg Msg
view model =
    let
        ( ( oldFirstX, oldFirstY ), ( oldLastX, oldLastY ) ) =
            northwestSourtheastCorners 5 model.previous

        ( ( newFirstX, newFirstY ), ( newLastX, newLastY ) ) =
            northwestSourtheastCorners 5 model.current
    in
    Html.main_ []
        [ Html.input
            [ Html.Attributes.type_ "range"
            , Html.Attributes.min "16"
            , Html.Attributes.max "1000"
            , Html.Attributes.style "width" "100%"
            , Html.Attributes.style "direction" "rtl"
            , Html.Events.onInput SetStepDuration
            , Html.Attributes.value (String.fromFloat model.stepDuration)
            ]
            []
        , Html.div
            [ Html.Attributes.attribute "style" """
                display:flex;
                flex-direction:row;
                justify-content:space-between;"""
            ]
            [ Html.button [ Html.Events.onClick (SetShape Glyph.Dot) ] [ text "Dot" ]
            , Html.button [ Html.Events.onClick (SetShape Glyph.Star) ] [ text "Star" ]
            , Html.button [ Html.Events.onClick (SetShape Glyph.Box) ] [ text "Box" ]
            ]
        , svg
            [ viewBox
                (cubicBezier model oldFirstX newFirstX)
                (cubicBezier model oldFirstY newFirstY)
                (cubicBezier model (oldLastX - oldFirstX) (newLastX - newFirstX))
                (cubicBezier model (oldLastY - oldFirstY) (newLastY - newFirstY))
            ]
            (grid (space model) (List.range newFirstX newLastX) (List.range newFirstY newLastY))
        ]


space : Model -> Cell -> Maybe (Svg msg)
space model cell =
    let
        nowAlive =
            alive model.current cell

        wasAlive =
            alive model.previous cell
    in
    if nowAlive && wasAlive {- STAYING ALIIIIVE -} then
        Just <| Glyph.view model.shape 1 cell
    else if nowAlive {- REVIVING -} then
        Just <| Glyph.view model.shape (cubicBezier model 0 1) cell
    else if wasAlive {- DYING -} then
        Just <| Glyph.view model.shape (cubicBezier model 1 0) cell
    else
        Nothing


type Msg
    = NewAnimationFrameDelta Float
    | SetShape Glyph.Shape
    | SetStepDuration String
    | Next


update : Msg -> Model -> Model
update msg model =
    case msg of
        NewAnimationFrameDelta value ->
            { model | delta = value + model.delta }

        SetShape shape ->
            { model | shape = shape }

        SetStepDuration raw ->
            case String.toFloat raw of
                Nothing ->
                    model

                Just value ->
                    { model | stepDuration = value }

        Next ->
            let
                ( ( firstX, firstY ), ( lastX, lastY ) ) =
                    northwestSourtheastCorners 1 model.current
            in
            { current =
                Set.fromList <|
                    grid (next model.current)
                        (List.range firstX lastX)
                        (List.range firstY lastY)
            , previous = model.current
            , delta = 0
            , stepDuration = model.stepDuration
            , shape = model.shape
            }


next : World -> Cell -> Maybe Cell
next world cell =
    let
        count =
            List.length <| List.filter (alive world) (neighbors cell)
    in
    if count == 3 || count == 2 && alive world cell then
        Just cell
    else
        Nothing


alive : World -> Cell -> Bool
alive world cell =
    Set.member cell world


neighbors : Cell -> List Cell
neighbors ( x, y ) =
    -- ABOVE
    [ ( x - 1, y - 1 )
    , ( x + 0, y - 1 )
    , ( x + 1, y - 1 )

    -- BESIDE
    , ( x - 1, y + 0 )
    , ( x + 1, y + 0 )

    -- BELOW
    , ( x - 1, y + 1 )
    , ( x + 0, y + 1 )
    , ( x + 1, y + 1 )
    ]



-- BOX STUFF


northwestSourtheastCorners : Int -> World -> ( Cell, Cell )
northwestSourtheastCorners padding world =
    let
        ( xs, ys ) =
            Set.foldl (\( x, y ) -> Tuple.mapBoth ((::) x) ((::) y)) ( [], [] ) world

        zeroOr =
            Maybe.withDefault 0
    in
    ( ( zeroOr (List.minimum xs) - padding, zeroOr (List.minimum ys) - padding )
    , ( zeroOr (List.maximum xs) + padding, zeroOr (List.maximum ys) + padding )
    )


cubicBezier : Model -> Int -> Int -> Float
cubicBezier model from to =
    Curve.cubicBezier (clamp 0 1 (model.delta / model.stepDuration)) (toFloat from) (toFloat to)


grid : (Cell -> Maybe a) -> List Int -> List Int -> List a
grid f rangeX rangeY =
    List.concatMap (\x -> List.filterMap (\y -> f ( x, y )) rangeY) rangeX


viewBox : Float -> Float -> Float -> Float -> Svg.Attribute msg
viewBox x1 x2 x3 x4 =
    Svg.Attributes.viewBox <|
        String.fromFloat x1
            ++ " "
            ++ String.fromFloat x2
            ++ " "
            ++ String.fromFloat x3
            ++ " "
            ++ String.fromFloat x4


last : List a -> Maybe a
last list =
    case list of
        [] ->
            Nothing

        _ :: x :: [] ->
            Just x

        _ :: rest ->
            last rest



-- PROGRAM


subscriptions model =
    Sub.batch
        [ Time.every model.stepDuration (\_ -> Next)
        , Browser.Events.onAnimationFrameDelta NewAnimationFrameDelta
        ]


main =
    Browser.element
        { init = \() -> ( init, Cmd.none )
        , update = \msg model -> ( update msg model, Cmd.none )
        , subscriptions = subscriptions
        , view = view
        }