Skip to content

Instantly share code, notes, and snippets.

@kofigumbs
Last active September 26, 2019 01:05
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save kofigumbs/90b42637df629522e7c5ffa06bdb2ffd to your computer and use it in GitHub Desktop.
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))
{
"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": {}
}
}
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))
]
[]
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
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment