Commits: 1

Make transformations example interactive

Separate axes from CartesianPlane.graph.

index 6e4ad58..6029a39 100644
--- a/src/CartesianPlane.elm
+++ b/src/CartesianPlane.elm
@@ -1,25 +1,19 @@
-module CartesianPlane exposing (graph)
+module CartesianPlane exposing (axes, graph)
=
+import Direction2d
+import Geometry.Svg
=import Html exposing (Html)
+import LineSegment2d
+import Point2d exposing (Point2d)
=import Svg exposing (..)
=import Svg.Attributes exposing (..)
+import Triangle2d
+import Vector2d
=
=
=graph : Float -> List (Svg msg) -> Html msg
=graph size shapes =
=    let
-        top =
-            0 - size / 2
-
-        left =
-            0 - size / 2
-
-        bottom =
-            size / 2
-
-        right =
-            size / 2
-
=        hairline =
=            size / 1000
=
@@ -27,29 +21,14 @@ graph size shapes =
=            size / 200
=
=        background =
-            g []
-                [ line
-                    [ x1 (String.fromFloat left)
-                    , y1 "0"
-                    , x2 (String.fromFloat right)
-                    , y2 "0"
-                    , stroke "black"
-                    , strokeWidth (String.fromFloat hairline)
-                    ]
-                    []
-                , line
-                    [ x1 "0"
-                    , x2 "0"
-                    , y1 (String.fromFloat top)
-                    , y2 (String.fromFloat bottom)
-                    , stroke "black"
-                    , strokeWidth (String.fromFloat hairline)
-                    ]
-                    []
+            axes
+                [ stroke "gray"
+                , fill "gray"
=                ]
+                size
=    in
=    svg
-        [ [ left, top, size, size ]
+        [ [ negate size / 2, negate size / 2, size, size ]
=            |> List.map String.fromFloat
=            |> String.join " "
=            |> viewBox
@@ -59,3 +38,85 @@ graph size shapes =
=        , Svg.Attributes.style "width: 100%, height: 100%"
=        ]
=        (background :: shapes)
+
+
+axes attributes size =
+    let
+        max =
+            size / 2
+
+        min =
+            negate max
+
+        xAxis =
+            { start = Point2d.fromCoordinates ( min, 0 )
+            , end = Point2d.fromCoordinates ( max, 0 )
+            }
+
+        yAxis =
+            { start = Point2d.fromCoordinates ( 0, min )
+            , end = Point2d.fromCoordinates ( 0, max )
+            }
+    in
+    g []
+        [ arrow
+            attributes
+            xAxis.start
+            xAxis.end
+        , arrow
+            attributes
+            yAxis.start
+            yAxis.end
+        , label [ fontSize "8", color "gray" ] (xAxis.end |> Point2d.translateIn (Direction2d.fromAngle (degrees -135)) 10) "x"
+        , label [ fontSize "8", color "gray" ] (yAxis.end |> Point2d.translateIn (Direction2d.fromAngle (degrees -45)) 10) "y"
+        , label [ fontSize "8", color "gray" ] (Point2d.origin |> Point2d.translateIn (Direction2d.fromAngle (degrees 135)) 10) "O"
+        ]
+
+
+arrow : List (Svg.Attribute msg) -> Point2d -> Point2d -> Svg msg
+arrow attributes start end =
+    let
+        origin =
+            Point2d.fromCoordinates ( 0, 0 )
+
+        direction =
+            Direction2d.from start end
+
+        triangle =
+            Triangle2d.fromVertices
+                ( Point2d.fromCoordinates ( 0, 0 )
+                , Point2d.fromCoordinates ( -4, -2 )
+                , Point2d.fromCoordinates ( -4, 2 )
+                )
+
+        vector =
+            Vector2d.from origin end
+    in
+    case direction of
+        Nothing ->
+            g [] []
+
+        Just dir ->
+            g []
+                [ triangle
+                    |> Triangle2d.rotateAround origin (Direction2d.toAngle dir)
+                    |> Triangle2d.translateBy vector
+                    |> Geometry.Svg.triangle2d ([ strokeWidth "0" ] ++ attributes)
+                , end
+                    |> Point2d.translateIn dir -4
+                    |> LineSegment2d.from start
+                    |> Geometry.Svg.lineSegment2d attributes
+                ]
+
+
+label : List (Svg.Attribute msg) -> Point2d -> String -> Svg msg
+label attributes center content =
+    text_
+        ([ x <| String.fromFloat (Point2d.xCoordinate center)
+         , y <| String.fromFloat (Point2d.yCoordinate center)
+         , dominantBaseline "central"
+         , textAnchor "middle"
+         ]
+            ++ attributes
+        )
+        [ text content ]
index 80a3718..744c43a 100644
--- a/src/Transformations.elm
+++ b/src/Transformations.elm
@@ -1,13 +1,20 @@
=module Transformations exposing (main)
=
+import Array exposing (Array)
=import Browser
=import Browser.Events
=import CartesianPlane
=import Dict exposing (Dict)
-import Element
+import Element exposing (Element)
+import Element.Background as Background
+import Element.Border as Border
+import Element.Input as Input
+import Geometry.Svg
=import Html exposing (Html)
=import Json.Decode exposing (Decoder)
+import LineSegment2d
=import List.Extra as List
+import Point2d
=import Svg exposing (..)
=import Svg.Attributes exposing (..)
=
@@ -26,7 +33,7 @@ type alias Flags =
=
=
=type alias Model =
-    List Transformation
+    Array Transformation
=
=
=type Transformation
@@ -37,16 +44,14 @@ type Transformation
=
=
=type Msg
-    = Progress Float
-    | Regress Float
+    = AddTransformation Transformation
+    | DeleteTransformation Int
+    | SetTransformation Int Transformation
=
=
=init : Flags -> ( Model, Cmd Msg )
=init () =
-    ( [ Identity
-      , Scale 2 2
-      , Translate 20 0
-      ]
+    ( Array.empty
=    , Cmd.none
=    )
=
@@ -54,13 +59,23 @@ init () =
=view : Model -> Html Msg
=view model =
=    let
+        transformations =
+            Array.toList model
+
=        wrapper element =
-            Element.el
-                [ Element.width (Element.maximum 600 Element.fill), Element.centerX ]
-                (Element.html element)
+            Element.column
+                [ Element.width (Element.maximum 600 Element.fill)
+                , Element.centerX
+                , Element.spacing 20
+                ]
+                [ Element.el
+                    [ Element.width Element.fill ]
+                    (Element.html element)
+                , transformationsUI transformations
+                ]
=
=        shape =
-            g [ transform (apply model) ]
+            g [ transform (apply transformations) ]
=                [ line
=                    [ x1 "0"
=                    , x2 "100"
@@ -71,13 +86,20 @@ view model =
=                    ]
=                    []
=                , circle [ cx "0", cy "0", r "2", fill "red" ] []
+                , grid
+                    [ stroke "pink"
+                    , fill "pink"
+                    , strokeWidth "0.3"
+                    ]
+                    10
+                    30
=
=                -- , rect [ x "", y "-2", width "1", height "4" ] []
=                ]
=    in
=    shape
=        |> List.singleton
-        |> CartesianPlane.graph 600
+        |> CartesianPlane.graph 300
=        |> wrapper
=        |> Element.layout
=            [ Element.height Element.fill
@@ -85,16 +107,187 @@ view model =
=            ]
=
=
+transformationsUI : List Transformation -> Element Msg
+transformationsUI transformations =
+    let
+        addButtons =
+            [ Input.button []
+                { onPress = Just (AddTransformation (Translate 0 0))
+                , label = Element.text "Translate"
+                }
+            , Input.button []
+                { onPress = Just (AddTransformation (Scale 1 1))
+                , label = Element.text "Scale"
+                }
+            , Input.button []
+                { onPress = Just (AddTransformation (Rotate 0))
+                , label = Element.text "Rotate"
+                }
+            ]
+
+        currentTrasformations =
+            transformations
+                |> List.indexedMap transformationUI
+    in
+    Element.column
+        [ Element.width Element.fill
+        , Element.spacing 10
+        ]
+        [ Element.row
+            [ Element.width Element.fill
+            , Element.spacing 10
+            ]
+            addButtons
+        , Element.column
+            [ Element.width Element.fill
+            , Element.spacing 10
+            ]
+            currentTrasformations
+        ]
+
+
+transformationUI : Int -> Transformation -> Element Msg
+transformationUI index transformation =
+    let
+        sliderBackground =
+            Element.el
+                [ Element.width Element.fill
+                , Element.height (Element.px 2)
+                , Element.centerY
+                , Background.color <| Element.rgb 0.7 0.7 0.7
+                , Border.rounded 2
+                ]
+                Element.none
+
+        controls =
+            case transformation of
+                Identity ->
+                    [ Element.text <| Debug.toString transformation ]
+
+                Scale horizontal vertical ->
+                    [ Input.slider
+                        [ Element.behindContent sliderBackground
+                        ]
+                        { onChange =
+                            \x ->
+                                SetTransformation index (Scale x vertical)
+                        , label = Input.labelLeft [] (Element.text "horizontal")
+                        , min = 0
+                        , max = 10
+                        , value = horizontal
+                        , thumb = Input.defaultThumb
+                        , step = Nothing
+                        }
+                    , Input.slider
+                        [ Element.behindContent sliderBackground
+                        ]
+                        { onChange =
+                            \y ->
+                                SetTransformation index (Scale horizontal y)
+                        , label = Input.labelLeft [] (Element.text "vertical")
+                        , min = 0
+                        , max = 10
+                        , value = vertical
+                        , thumb = Input.defaultThumb
+                        , step = Nothing
+                        }
+                    ]
+
+                Translate x y ->
+                    [ Input.slider
+                        [ Element.behindContent sliderBackground
+                        ]
+                        { onChange =
+                            \value ->
+                                SetTransformation index (Translate value y)
+                        , label = Input.labelLeft [] (Element.text "x")
+                        , min = -100
+                        , max = 100
+                        , value = x
+                        , thumb = Input.defaultThumb
+                        , step = Nothing
+                        }
+                    , Input.slider
+                        [ Element.behindContent sliderBackground
+                        ]
+                        { onChange =
+                            \value ->
+                                SetTransformation index (Translate x value)
+                        , label = Input.labelLeft [] (Element.text "y")
+                        , min = -100
+                        , max = 100
+                        , value = y
+                        , thumb = Input.defaultThumb
+                        , step = Nothing
+                        }
+                    ]
+
+                Rotate angle ->
+                    [ Input.slider
+                        [ Element.behindContent sliderBackground
+                        ]
+                        { onChange =
+                            \value ->
+                                SetTransformation index (Rotate value)
+                        , label = Input.labelLeft [] (Element.text "angle")
+                        , min = -360
+                        , max = 360
+                        , value = angle
+                        , thumb = Input.defaultThumb
+                        , step = Nothing
+                        }
+                    ]
+    in
+    Element.column
+        [ Element.width Element.fill
+        , Background.color (Element.rgb 0.9 0.9 0.9)
+        , Element.padding 5
+        , Element.spacing 20
+        ]
+        [ Element.row [ Element.width Element.fill ]
+            [ transformation
+                |> List.singleton
+                |> apply
+                |> Element.text
+                |> Element.el [ Element.width Element.fill ]
+            , Input.button []
+                { onPress = Just (DeleteTransformation index)
+                , label = Element.text "X"
+                }
+            ]
+        , Element.column
+            [ Element.width Element.fill
+            , Element.spacing 20
+            ]
+            controls
+        ]
+
+
=update : Msg -> Model -> ( Model, Cmd Msg )
=update msg model =
=    case msg of
-        Progress delta ->
-            ( model
+        AddTransformation transformation ->
+            ( Array.push transformation model
=            , Cmd.none
=            )
=
-        Regress delta ->
-            ( model
+        DeleteTransformation index ->
+            let
+                end =
+                    Array.length model
+
+                front =
+                    Array.slice 0 index model
+
+                back =
+                    Array.slice (index + 1) end model
+            in
+            ( Array.append front back
+            , Cmd.none
+            )
+
+        SetTransformation index transformation ->
+            ( Array.set index transformation model
=            , Cmd.none
=            )
=
@@ -135,3 +328,43 @@ apply transformations =
=    transformations
=        |> List.map toString
=        |> String.join " "
+
+
+grid : List (Svg.Attribute msg) -> Float -> Float -> Svg msg
+grid attributes unit size =
+    let
+        positiveValues =
+            size
+                / 2
+                |> floor
+                |> List.range 1
+                |> List.map toFloat
+                |> List.map ((*) unit)
+
+        negativeValues =
+            positiveValues
+                |> List.map negate
+
+        max =
+            unit * size / 2
+
+        min =
+            negate max
+    in
+    ((positiveValues ++ negativeValues)
+        |> List.map
+            (\value ->
+                [ ( Point2d.fromCoordinates ( value, min )
+                  , Point2d.fromCoordinates ( value, max )
+                  )
+                , ( Point2d.fromCoordinates ( min, value )
+                  , Point2d.fromCoordinates ( max, value )
+                  )
+                ]
+            )
+        |> List.concat
+        |> List.map LineSegment2d.fromEndpoints
+        |> List.map (Geometry.Svg.lineSegment2d attributes)
+    )
+        |> (::) (CartesianPlane.axes attributes (size * unit))
+        |> g []