Commits: 3
Render svgTree in one pass directly from rules
In tree sample remove Tree type and merge grow and svgTree functions. Use SVG transformations for rotation, scaling and translation, offloading the difficult geometry transformation to the browser.
This way we don't have any union types except for Msg.
The downside is that the branches do not grow linearly. The size of the branch is:
treeAge! / (treeAge ^ (ceil treeAge))index 1939a19..5e5f50b 100644
--- a/src/Tree.elm
+++ b/src/Tree.elm
@@ -4,6 +4,7 @@ import Browser
=import Browser.Events
=import Dict exposing (Dict)
=import Html exposing (Html)
+import Json.Decode exposing (Decoder)
=import Svg exposing (..)
=import Svg.Attributes exposing (..)
=
@@ -29,11 +30,7 @@ type alias Model =
=
=type Msg
= = Progress Float
-
-
-type Tree
- = Tip Segment
- | Node Segment (List Tree)
+ | Regress Float
=
=
=type alias Color =
@@ -53,25 +50,21 @@ type alias Rules =
=
=init : Flags -> ( Model, Cmd Msg )
=init () =
- ( { time = 1
+ ( { time = 0
= , rules =
= Dict.fromList
= [ ( "red"
- , [ Segment "yellow" (degrees 15) 10
- , Segment "yellow" (degrees 175) 10
+ , [ Segment "green" 15 0.2
+ , Segment "green" 175 0.1
+ ]
+ )
+ , ( "green", [ Segment "blue" 15 0.3 ] )
+ , ( "blue"
+ , [ Segment "red" 15 0.7
+ , Segment "purple" 45 0.1
= ]
= )
- , ( "yellow", [ Segment "blue" (degrees 15) 10 ] )
- , ( "blue", [ Segment "red" (degrees 15) 10 ] )
= ]
-
- -- [ ( "red"
- -- , [ Segment "blue" (degrees 90) 10
- -- , Segment "yellow" (degrees -45) 4
- -- ]
- -- )
- -- , ( "yellow", [ Segment "red" (degrees 90) 6 ] )
- -- ]
= }
= , Cmd.none
= )
@@ -81,12 +74,15 @@ view : Model -> Html Msg
=view model =
= Html.div []
= [ Html.h1 [] [ Html.text <| String.fromFloat model.time ]
- , Segment "red" 0 0
- |> Tip
- |> grow model.rules (model.time / 1000)
- |> svgTree
+ , "red"
+ |> svgTree model.rules (model.time / 5000) (model.time / 5000)
+ |> g [ transform ("scale(" ++ String.fromFloat (model.time / 1000) ++ ")") ]
= |> List.singleton
- |> svg [ viewBox "-1000 -1000 2000 2000", height "800px", width "800px" ]
+ |> svg
+ [ viewBox "-1000 -1000 2000 2000"
+ , height "800px"
+ , width "800px"
+ ]
= ]
=
=
@@ -98,82 +94,68 @@ update msg model =
= , Cmd.none
= )
=
+ Regress delta ->
+ ( { model | time = model.time - delta }
+ , Cmd.none
+ )
+
=
=subscriptions : Model -> Sub Msg
=subscriptions model =
- Browser.Events.onAnimationFrameDelta Progress
-
-
-
--- Sub.none
-
-
-htmlTree : Tree -> Html Msg
-htmlTree tree =
- case tree of
- Tip segment ->
- Html.li [] [ Html.text <| "Tip: " ++ Debug.toString segment ]
-
- Node segment trees ->
- Html.li []
- [ Html.text <| "Tip: " ++ Debug.toString segment
- , Html.ul [] <| List.map htmlTree trees
- ]
+ let
+ handleKeyPress : Decoder Msg
+ handleKeyPress =
+ Json.Decode.field "key" Json.Decode.string
+ |> Json.Decode.andThen
+ (\key ->
+ case Debug.log "Key" key of
+ "," ->
+ Json.Decode.succeed (Regress 10)
+
+ "." ->
+ Json.Decode.succeed (Progress 10)
+
+ "<" ->
+ Json.Decode.succeed (Regress 1000)
+
+ ">" ->
+ Json.Decode.succeed (Progress 1000)
+
+ _ ->
+ Json.Decode.fail "Unknown key press"
+ )
+ in
+ Sub.batch
+ [ Browser.Events.onKeyPress handleKeyPress
+ , Browser.Events.onAnimationFrameDelta Progress
+ ]
=
=
-svgTree : Tree -> Html Msg
-svgTree tree =
- case tree of
- Tip segment ->
- circle [ cx "0", cy "0", fill segment.color, r "10" ] []
-
- Node segment trees ->
- let
- x =
- segment.length * cos segment.angle
-
- y =
- segment.length * sin segment.angle
-
- transformation =
- "translate("
- ++ String.fromFloat x
- ++ ", "
- ++ String.fromFloat y
- ++ ")"
- in
- g [ transform transformation ] <|
- circle [ cx "0", cy "0", fill segment.color, r "10" ] []
- :: List.map svgTree trees
-
-
-grow : Rules -> Float -> Tree -> Tree
-grow rules age branch =
- if age > 0 then
- case branch of
- Tip segment ->
- let
- tips =
- rules
- |> Dict.get segment.color
- |> Maybe.withDefault []
- |> List.map
- (\rule ->
- { rule
- | angle = rule.angle + segment.angle
- , length = rule.length * age
- }
- )
- |> List.map Tip
- in
- tips
- |> Node segment
- |> grow rules (age - 1)
-
- Node segment trees ->
- trees
- |> List.map (grow rules age)
- |> Node segment
+svgTree : Rules -> Float -> Float -> Color -> List (Svg Msg)
+svgTree rules treeAge branchAge color =
+ if branchAge > 0 then
+ rules
+ |> Dict.get color
+ |> Maybe.withDefault []
+ |> List.map
+ (\segment ->
+ let
+ transformation =
+ "rotate("
+ ++ String.fromFloat segment.angle
+ ++ ")"
+ ++ ", scale("
+ ++ String.fromFloat ((branchAge - 1) / treeAge)
+ ++ ")"
+ ++ ", translate("
+ ++ String.fromFloat (segment.length * branchAge)
+ ++ ", 0)"
+ in
+ g
+ [ transform transformation ]
+ (svgTree rules treeAge (branchAge - 1) segment.color)
+ )
+ |> (::) (circle [ cx "0", cy "0", fill color, r "1" ] [])
=
= else
- branch
+ []Add more elements to the ViewBox sample
Render the ViewBox indicator () in both pictures.
index 5b77dc1..551db09 100644
--- a/src/ViewBox.elm
+++ b/src/ViewBox.elm
@@ -118,9 +118,9 @@ ui model =
= , y (String.fromFloat model.top)
= , width (String.fromFloat model.width)
= , height (String.fromFloat model.height)
- , opacity "0.8"
+ , opacity "0.3"
= , stroke "white"
- , Svg.Attributes.style "fill: hsl(120, 100%, 85.1%)"
+ , fill "pink"
= ]
= []
= ]
@@ -128,7 +128,6 @@ ui model =
= , Element.el
= [ Element.height Element.fill
= , Element.width Element.fill
- , Background.color <| Element.rgb 0.7 1 0.7
= ]
= (Element.html <|
= svg
@@ -140,6 +139,16 @@ ui model =
= , Svg.Attributes.style "width: 100; height: 100%"
= ]
= [ g [] world
+ , rect
+ [ x (String.fromFloat model.left)
+ , y (String.fromFloat model.top)
+ , width (String.fromFloat model.width)
+ , height (String.fromFloat model.height)
+ , opacity "0.3"
+ , stroke "white"
+ , fill "pink"
+ ]
+ []
= ]
= )
= ]
@@ -237,26 +246,6 @@ ui model =
=world : List (Svg Msg)
=world =
= [ circle [ cx "400", cy "300", r "250", fill "purple" ] []
+ , circle [ cx "200", cy "350", r "50", fill "yellow" ] []
+ , circle [ cx "400", cy "600", r "20", fill "red" ] []
= ]
-
-
-
--- <|
--- Element.html <|
--- graph
--- [ circle
--- [ cx <| String.fromFloat model.x
--- , cy <| String.fromFloat model.y
--- , r "0.01"
--- , fill "magenta"
--- ]
--- []
--- , text_
--- [ x <| String.fromFloat (model.x + 0.03)
--- , y <| String.fromFloat model.y
--- , fontSize "0.05"
--- , dominantBaseline "central"
--- ]
--- [ text <| Debug.toString ( model.x, model.y ) ]
--- ]
--- , ]Set min value of the width and height in the ViewBox examle to 1
index 551db09..de064d5 100644
--- a/src/ViewBox.elm
+++ b/src/ViewBox.elm
@@ -212,7 +212,7 @@ ui model =
= , label =
= Input.labelBelow [ Element.centerX ] <|
= Element.text ("width: " ++ String.fromFloat model.width)
- , min = 0
+ , min = 1
= , max = 1000 - model.left
= , value = model.width
= , thumb = Input.defaultThumb
@@ -234,7 +234,7 @@ ui model =
= , label =
= Input.labelBelow [ Element.centerX ] <|
= Element.text ("height: " ++ String.fromFloat model.height)
- , min = 0
+ , min = 1
= , max = 1000 - model.top
= , value = model.height
= , thumb = Input.defaultThumb