Commits: 2
Replaced old tree example with new tree
index eaed7b3..26d559e 100644
--- a/src/Examples/Tree.elm
+++ b/src/Examples/Tree.elm
@@ -1,291 +1,189 @@
=module Examples.Tree exposing
- ( Model
- , Msg
- , init
+ ( Axiom
+ , Config
+ , Segment
= , main
- , subscriptions
= , ui
- , update
= )
=
-import Browser
-import Browser.Events
=import Dict exposing (Dict)
=import Element exposing (Element)
-import Html exposing (Html)
-import Json.Decode exposing (Decoder)
-import List.Extra as List
-import Svg exposing (..)
-import Svg.Attributes exposing (..)
+import Svg exposing (Svg)
+import Svg.Attributes
=
=
-main : Program Flags Model Msg
-main =
- Browser.element
- { init = init
- , view = view
- , update = update
- , subscriptions = subscriptions
+defaults : Config
+defaults =
+ { axiom =
+ { color = "brown"
+ , rotation = -90
+ , age = 8
= }
+ , rules =
+ [ ( "brown"
+ , [ { color = "green"
+ , rotation = 45
+ }
+ , { color = "green"
+ , rotation = 20
+ }
+ , { color = "green"
+ , rotation = -20
+ }
+ ]
+ )
+ , ( "green"
+ , [ { color = "purple"
+ , rotation = 0
+ }
+ , { color = "purple"
+ , rotation = -90
+ }
+ , { color = "purple"
+ , rotation = -20
+ }
+ ]
+ )
+ , ( "purple"
+ , [ { color = "orange"
+ , rotation = 0
+ }
+ , { color = "orange"
+ , rotation = 60
+ }
+ , { color = "brown"
+ , rotation = -20
+ }
+ ]
+ )
+ ]
+ }
=
=
-type alias Flags =
- ()
-
-
-type alias Model =
- { time : Float
- , rules : Rules
+type alias Config =
+ { axiom : Axiom
+ , rules : List Rule
= }
=
=
-type Msg
- = Progress Float
- | Regress Float
+type alias Axiom =
+ { color : String
+ , rotation : Float
+ , age : Float
+ }
=
=
-type alias Color =
- String
+type alias Rule =
+ ( String, List Segment )
=
=
=type alias Segment =
- { color : Color
- , angle : Float
- , length : Float
- }
-
+ { color : String, rotation : Float }
=
-type alias Rules =
- Dict Color (List Segment)
=
-
-init : Flags -> ( Model, Cmd Msg )
-init () =
- ( { time = 0
- , rules =
- Dict.fromList
- [ ( "brown"
- , [ Segment "green" -115 1
- , Segment "green" -65 1
- , Segment "saddlebrown" 90 2
+ui : Config -> Element msg
+ui config =
+ let
+ dot age color rotation =
+ Svg.circle
+ [ Svg.Attributes.r (String.fromFloat age)
+ , Svg.Attributes.cx "0"
+ , Svg.Attributes.cy "0"
+ , Svg.Attributes.fill color
+ , Svg.Attributes.transform
+ (String.concat
+ [ "rotate("
+ , String.fromFloat rotation
+ , ") translate("
+ , String.fromFloat (age * 10)
+ , ")"
+ ]
+ )
+ ]
+ []
+
+ line age color rotation =
+ Svg.line
+ [ Svg.Attributes.strokeWidth "1"
+ , Svg.Attributes.x1 "0"
+ , Svg.Attributes.y1 "0"
+ , Svg.Attributes.x2 (String.fromFloat (age * 10))
+ , Svg.Attributes.y2 "0"
+ , Svg.Attributes.stroke color
+ , Svg.Attributes.strokeWidth (String.fromFloat age)
+ , Svg.Attributes.transform
+ (String.concat
+ [ "rotate("
+ , String.fromFloat rotation
+ , ")"
+ ]
+ )
+ ]
+ []
+
+ rules : Dict String (List Segment)
+ rules =
+ Dict.empty
+ |> Dict.insert "brown"
+ [ { color = "green", rotation = 20 }
+ , { color = "green", rotation = -20 }
+ , { color = "brown", rotation = 0 }
= ]
- )
- , ( "green"
- , [ Segment "green" 20 3
- , Segment "green" -20 3
- , Segment "red" 90 1
- , Segment "red" -90 1
+ |> Dict.insert "green"
+ [ { color = "blue", rotation = -25 }
+ , { color = "blue", rotation = -5 }
+ , { color = "blue", rotation = 15 }
= ]
- )
- , ( "saddlebrown"
- , [ Segment "saddlebrown" 20 3
- , Segment "saddlebrown" -20 3
+ |> Dict.insert "blue"
+ [ { color = "brown", rotation = -25 }
+ , { color = "purple", rotation = -5 }
+ , { color = "purple", rotation = 25 }
= ]
- )
- ]
- }
- , Cmd.none
- )
-
-
-view : Model -> Html Msg
-view model =
- Element.layout
- [ Element.width Element.fill
- , Element.height Element.fill
- ]
- (ui model)
-
=
-ui : Model -> Element Msg
-ui model =
- let
- gradients : List (Svg Msg)
- gradients =
- model.rules
- |> Dict.map
- (\parentColor children ->
- children
- |> List.map (\child -> ( parentColor, child.color ))
- )
- |> Dict.values
- |> List.concat
- |> List.unique
- |> List.map
- (\(( start, end ) as colors) ->
- linearGradient
- [ id (gradientId colors)
- , x1 "0"
- , y1 "0"
- , x2 "1"
- , y2 "0"
- , gradientUnits "userSpaceOnUse"
+ segment : Float -> Segment -> Svg msg
+ segment age { color, rotation } =
+ if age <= 0 then
+ Svg.g [] []
+
+ else
+ Svg.g []
+ [ config.rules
+ |> Dict.fromList
+ |> Dict.get color
+ |> Maybe.withDefault []
+ |> List.map (segment (age - 1))
+ |> Svg.g
+ [ Svg.Attributes.transform
+ (String.concat
+ [ "rotate("
+ , String.fromFloat rotation
+ , ") translate("
+ , String.fromFloat (age * 10)
+ , ")"
+ ]
+ )
= ]
- [ stop
- [ stopColor start, offset "0" ]
- []
- , stop
- [ stopColor end, offset "1" ]
- []
- ]
- )
-
- tree =
- "brown"
- |> svgTree model.rules (model.time / 5000)
- |> g
- [ transform
- ("scale("
- ++ String.fromFloat (model.time / 1000)
- ++ ")"
- )
+ , dot age color rotation
+ , line age color rotation
= ]
= in
- Element.html <|
- svg
- [ viewBox "-1000 -1000 2000 2000"
- , height "100%"
- , width "100%"
- ]
- [ defs [] gradients
- , tree
+ [ segment config.axiom.age
+ { color = config.axiom.color
+ , rotation = config.axiom.rotation
+ }
+ ]
+ |> Svg.svg
+ [ Svg.Attributes.height "100%"
+ , Svg.Attributes.width "100%"
+ , Svg.Attributes.style "background: none"
+ , Svg.Attributes.viewBox "-500 -500 1000 1000"
= ]
+ |> Element.html
=
=
-update : Msg -> Model -> ( Model, Cmd Msg )
-update msg model =
- case msg of
- Progress delta ->
- ( { model | time = model.time + delta }
- , Cmd.none
- )
-
- Regress delta ->
- ( { model | time = model.time - delta }
- , Cmd.none
- )
-
-
-subscriptions : Model -> Sub Msg
-subscriptions model =
- let
- handleKeyPress : Decoder Msg
- handleKeyPress =
- Json.Decode.field "key" Json.Decode.string
- |> Json.Decode.andThen
- (\key ->
- case 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 : Rules -> Float -> Color -> List (Svg Msg)
-svgTree rules age color =
- if age <= 0 then
- []
-
- else
- let
- subtrees =
- rules
- |> Dict.get color
- |> Maybe.withDefault []
- |> List.map subtree
-
- subtree segment =
- let
- gradient =
- "url(#" ++ gradientId ( color, segment.color ) ++ ")"
-
- scale =
- age / (age + 1)
- in
- g
- [ applyTransformations
- [ Rotate segment.angle
- , Scale scale scale
- , Translate segment.length 0
- ]
- ]
- (line
- [ stroke gradient
- , x1 "0"
- , x2 "1"
- , y1 "0"
- , y2 "0"
- , strokeWidth "0.2"
- , strokeLinecap "round"
- , applyTransformations
- [ Translate (0 - segment.length) 0
- , Scale segment.length 1
- ]
- ]
- []
- :: svgTree rules (age - 1) segment.color
- )
- in
- subtrees
-
-
-type Transformation
- = Identity
- | Scale Float Float
- | Translate Float Float
- | Rotate Float
-
-
-applyTransformations : List Transformation -> Svg.Attribute Msg
-applyTransformations transformations =
- let
- toString : Transformation -> String
- toString transformation =
- case transformation of
- Identity ->
- ""
-
- Scale x y ->
- "scale("
- ++ String.fromFloat x
- ++ ", "
- ++ String.fromFloat y
- ++ ")"
-
- Translate x y ->
- "translate("
- ++ String.fromFloat x
- ++ ", "
- ++ String.fromFloat y
- ++ ")"
-
- Rotate angle ->
- "rotate("
- ++ String.fromFloat angle
- ++ ")"
- in
- transformations
- |> List.map toString
- |> String.join " "
- |> transform
-
-
-gradientId : ( Color, Color ) -> String
-gradientId ( start, end ) =
- "connection-" ++ start ++ "-" ++ end
+main =
+ ui defaults
+ |> Element.layout
+ [ Element.width Element.fill
+ , Element.height Element.fill
+ ]Replace Code block with a new Edito block supporting highlits
On the way I separated the css function from the Mark.Custom to the Element.Extra module.
new file mode 100644
index 0000000..2553eb0
--- /dev/null
+++ b/src/Editor.elm
@@ -0,0 +1,296 @@
+module Editor exposing (Config, Highlight, defaults, editor)
+
+import Browser
+import Dict exposing (Dict)
+import Element exposing (Element)
+import Element.Background as Background
+import Element.Border as Border
+import Element.Extra as Element
+import Element.Font as Font
+import FeatherIcons exposing (icons)
+import Html exposing (Html)
+import List.Extra as List
+import Svg exposing (Svg)
+import Svg.Attributes
+
+
+type alias Config =
+ { path : String
+ , offset : Int
+ , colors :
+ { annotations : Element.Color
+ , background : Element.Color
+ , primary : Element.Color
+ , secondary : Element.Color
+ , window : Element.Color
+ }
+ }
+
+
+defaults : Config
+defaults =
+ { path = "src/Main.elm"
+ , offset = 1
+ , colors =
+ { primary = Element.rgb 0 0 0
+ , secondary = Element.rgb 0.8 0.8 0.8
+ , annotations = Element.rgb 1 0.6 0.6
+ , background = Element.rgb 1 1 1
+ , window = Element.rgb 0.2 0.2 0.2
+ }
+ }
+
+
+type alias Highlight =
+ { from : Int
+ , to : Int
+ , offset : Int
+ , width : Int
+ }
+
+
+highlight : Highlight -> Element msg
+highlight { from, to, offset, width } =
+ Element.row []
+ [ " "
+ |> String.repeat offset
+ |> Element.text
+ , " "
+ |> String.repeat width
+ |> List.repeat (to - from + 1)
+ |> List.map Element.text
+ |> List.map (Element.el [ Element.padding 10 ])
+ |> Element.column
+ [ Element.inFront
+ (Element.el
+ [ Element.width Element.fill
+ , Element.height Element.fill
+ , Border.color (Element.rgba 1 0 0 0.8)
+ , Border.rounded 10
+ , Border.width 2
+ , Border.dashed
+ , Element.scale 1.1
+ ]
+ Element.none
+ )
+ , Element.css "pointer-events" "none"
+ , Element.css "user-select" "none"
+ , Element.css "-webkit-user-select" "none"
+ , Element.css "-ms-user-select" "none"
+ , Element.css "-webkit-touch-callout" "none"
+ , Element.css "-o-user-select" "none"
+ , Element.css "-moz-user-select" "none"
+ ]
+ ]
+
+
+editor : Config -> List Highlight -> String -> Element msg
+editor { path, offset, colors } highlights contents =
+ let
+ highlighted : Dict Int Highlight
+ highlighted =
+ highlights
+ |> List.foldl extract Dict.empty
+
+ extract item memo =
+ Dict.insert item.from item memo
+ in
+ Element.column
+ [ Border.width 3
+ , Border.rounded 5
+ , Border.color colors.window
+ , Element.css "page-break-inside" "avoid"
+ , Font.family
+ [ Font.typeface "Source Code Pro"
+ , Font.monospace
+ ]
+ , Element.css "page-break-inside" "avoid"
+ , Element.width Element.fill
+ ]
+ [ Element.row
+ [ Element.width Element.fill
+ , Background.color colors.window
+ , Font.color colors.secondary
+ ]
+ [ FeatherIcons.fileText
+ |> FeatherIcons.toHtml []
+ |> Element.html
+ |> Element.el
+ [ Element.height (Element.px 35)
+ , Element.padding 8
+ ]
+ , Element.el
+ [ Element.width Element.fill
+ , Font.size 16
+ , Font.family
+ [ Font.typeface "Source Code Pro"
+ , Font.monospace
+ ]
+ ]
+ (Element.text "src/Main.elm")
+ ]
+ , contents
+ |> String.lines
+ |> List.indexedMap
+ (\n loc ->
+ Element.row []
+ [ Element.el
+ [ Font.color colors.secondary
+ , Font.extraLight
+ , Element.width (Element.px 40)
+ , Element.padding 10
+ , Font.alignRight
+ , Element.css "user-select" "none"
+ , Element.css "-webkit-user-select" "none"
+ , Element.css "-ms-user-select" "none"
+ , Element.css "-webkit-touch-callout" "none"
+ , Element.css "-o-user-select" "none"
+ , Element.css "-moz-user-select" "none"
+ ]
+ ((n + 1)
+ |> String.fromInt
+ |> Element.text
+ )
+ , Element.el
+ [ Element.width Element.fill
+ , Element.padding 10
+ , highlighted
+ |> Dict.get (n + 1)
+ |> Maybe.map highlight
+ |> Maybe.withDefault Element.none
+ |> Element.inFront
+ ]
+ (Element.text loc)
+ ]
+ )
+ |> Element.column
+ [ Element.width Element.fill
+ , Font.size 16
+ , Element.scrollbarY
+ ]
+ ]
+
+
+main : Html msg
+main =
+ """module Main exposing (main)
+
+import Browser
+import Dict
+import Element
+import Svg exposing (Svg)
+import Svg.Attributes
+
+
+main =
+ Browser.element
+ { init = init
+ , view = view
+ , update = update
+ , subscriptions = subscriptions
+ }
+
+
+view age =
+ [ segment (age / 5000) { color = "brown", rotation = -90 } ]
+ |> Svg.svg
+ [ Svg.Attributes.height "100%"
+ , Svg.Attributes.width "100%"
+ , Svg.Attributes.style "background: none"
+ , Svg.Attributes.viewBox "-500 -500 1000 1000"
+ ]
+ |> Element.html
+ |> Element.layout
+ [ Element.width Element.fill
+ , Element.height Element.fill
+ ]
+
+
+rules =
+ Dict.empty
+ |> Dict.insert "brown"
+ [ { color = "brown", rotation = 0 }
+ , { color = "green", rotation = 20 }
+ , { color = "green", rotation = -30 }
+ ]
+ |> Dict.insert "green"
+ [ { color = "red", rotation = -45 }
+ , { color = "red", rotation = -5 }
+ , { color = "red", rotation = 50 }
+ ]
+
+
+segment age { color, rotation } =
+ if age <= 0 then
+ Svg.g [] []
+
+ else
+ Svg.g []
+ [ rules
+ |> Dict.get color
+ |> Maybe.withDefault []
+ |> List.map (segment (age - 1))
+ |> Svg.g
+ [ Svg.Attributes.transform
+ (String.concat
+ [ "rotate("
+ , String.fromFloat rotation
+ , ") translate("
+ , String.fromFloat (age * 10)
+ , ")"
+ ]
+ )
+ ]
+ , dot age color rotation
+ , line age color rotation
+ ]
+
+
+dot age color rotation =
+ Svg.circle
+ [ Svg.Attributes.r (String.fromFloat age)
+ , Svg.Attributes.cx "0"
+ , Svg.Attributes.cy "0"
+ , Svg.Attributes.fill color
+ , Svg.Attributes.transform
+ (String.concat
+ [ "rotate("
+ , String.fromFloat rotation
+ , ") translate("
+ , String.fromFloat (age * 10)
+ , ")"
+ ]
+ )
+ ]
+ []
+
+
+ line age color rotation =
+ Svg.line
+ [ Svg.Attributes.strokeWidth "1"
+ , Svg.Attributes.x1 "0"
+ , Svg.Attributes.y1 "0"
+ , Svg.Attributes.x1 (String.fromFloat (age * 10))
+ , Svg.Attributes.y1 "0"
+ , Svg.Attributes.stroke color
+ , Svg.Attributes.strokeWidth (String.fromFloat age)
+ , Svg.Attributes.transform
+ (String.concat
+ [ "rotate("
+ , String.fromFloat rotation
+ , ")"
+ ]
+ )
+ ]
+ []
+"""
+ |> editor defaults
+ [ Highlight 10 16 0 38
+ , Highlight 3 3 0 15
+ , Highlight 19 19 0 10
+ , Highlight 20 20 15 10
+ ]
+ |> Element.layout
+ [ Element.width Element.fill
+ , Element.height Element.fill
+ ]new file mode 100644
index 0000000..784c614
--- /dev/null
+++ b/src/Element/Extra.elm
@@ -0,0 +1,17 @@
+module Element.Extra exposing (css)
+
+import Element exposing (Element)
+import Element.Background as Background
+import Element.Border as Border
+import Element.Font as Font
+import Html exposing (Html)
+import Html.Attributes
+
+
+css : String -> String -> Element.Attribute msg
+css property value =
+ Element.htmlAttribute
+ (Html.Attributes.style
+ property
+ value
+ )index a0c8d8f..3354f14 100644
--- a/src/Main.elm
+++ b/src/Main.elm
@@ -454,7 +454,7 @@ document =
= ]
=
= widgets =
- [ Mark.Custom.code
+ [ Mark.Custom.editor
= , Mark.Custom.terminal
= , Mark.Custom.note
= ]index ddbec4e..a96ce20 100644
--- a/src/Mark/Custom.elm
+++ b/src/Mark/Custom.elm
@@ -1,7 +1,6 @@
=module Mark.Custom exposing
- ( code
- , colors
- , css
+ ( colors
+ , editor
= , emphasize
= , header
= , icon
@@ -19,9 +18,11 @@ module Mark.Custom exposing
=
=import BrowserWindow
=import Dict
+import Editor
=import Element exposing (Element)
=import Element.Background as Background
=import Element.Border as Border
+import Element.Extra as Element
=import Element.Font as Font
=import FeatherIcons exposing (icons)
=import Html exposing (Html)
@@ -54,8 +55,8 @@ paragraph =
= Element.paragraph
= [ Element.paddingXY 0 10
= , Element.spacing 12
- , css "hyphens" "auto"
- , css "orphans" "3"
+ , Element.css "hyphens" "auto"
+ , Element.css "orphans" "3"
= , Font.justify
= ]
= (content model)
@@ -77,105 +78,37 @@ monospace =
= , Font.monospace
= ]
= , Element.scrollbarY
- , css "page-break-inside" "avoid"
+ , Element.css "page-break-inside" "avoid"
= ]
=
=
-type alias File =
- { path : String
- , line : Int
- }
-
-
-code : Mark.Block (a -> Element msg)
-code =
+editor : Mark.Block (a -> Element msg)
+editor =
= let
- render { path, line } contents model =
- Element.column
- [ Border.width 3
- , Border.rounded 5
- , Border.color colors.charcoal
- , css "page-break-inside" "avoid"
- , Font.family
- [ Font.typeface "Source Code Pro"
- , Font.monospace
- ]
- , css "page-break-inside" "avoid"
- ]
- [ Element.row
- [ Element.width Element.fill
- , Background.color colors.charcoal
- , Font.color colors.gray
- ]
- [ FeatherIcons.fileText
- |> FeatherIcons.toHtml []
- |> Element.html
- |> Element.el
- [ Element.height (Element.px 35)
- , Element.padding 8
- ]
- , Element.el
- [ Element.width Element.fill
- , Font.size 16
- , Font.family
- [ Font.typeface "Source Code Pro"
- , Font.monospace
- ]
- ]
- (Element.text path)
- ]
- , contents
- |> String.split "\n"
- |> List.indexedMap
- (\n loc ->
- Element.row []
- [ Element.el
- [ Font.color colors.gray
- , Font.extraLight
- , Element.width (Element.px 40)
- , Element.padding 10
- , Font.alignRight
- , css "user-select" "none"
- , css "-webkit-user-select" "none"
- , css "-ms-user-select" "none"
- , css "-webkit-touch-callout" "none"
- , css "-o-user-select" "none"
- , css "-moz-user-select" "none"
- ]
- (n
- |> (+) line
- |> String.fromInt
- |> Element.text
- )
- , Element.el
- [ Element.width Element.fill
- , Element.padding 10
- ]
- (Element.text loc)
- ]
- )
- |> Element.column
- [ Element.width Element.fill
- , Font.size 16
- , Element.scrollbarY
- ]
- ]
+ render contents highlights model =
+ Editor.editor Editor.defaults highlights contents
+
+ code : Mark.Block String
+ code =
+ Mark.block "Code"
+ identity
+ Mark.multiline
+
+ highlight : Mark.Block Editor.Highlight
+ highlight =
+ Mark.record4 "Highlight"
+ Editor.Highlight
+ (Mark.field "from" Mark.int)
+ (Mark.field "to" Mark.int)
+ (Mark.field "offset" Mark.int)
+ (Mark.field "width" Mark.int)
= in
- -- FIXME: There is a weird bug where 1st line of contents gets rendered indented 4 spaces
- -- Mark.block "Code"
- -- identity
- -- (Mark.startWith
- -- render
- -- (Mark.record2 "File"
- -- File
- -- (Mark.field "path" Mark.string)
- -- (Mark.field "line" Mark.int)
- -- )
- -- Mark.multiline
- -- )
- Mark.block "Code"
- (render (File "src/Main.elm" 1))
- Mark.multiline
+ Mark.block "Editor"
+ identity
+ (Mark.startWith render
+ code
+ (Mark.manyOf [ highlight ])
+ )
=
=
=terminal : Mark.Block (a -> Element msg)
@@ -187,12 +120,12 @@ terminal =
= , Border.rounded 5
= , Border.color colors.charcoal
= , Background.color colors.charcoal
- , css "page-break-inside" "avoid"
+ , Element.css "page-break-inside" "avoid"
= , Font.family
= [ Font.typeface "Source Code Pro"
= , Font.monospace
= ]
- , css "page-break-inside" "avoid"
+ , Element.css "page-break-inside" "avoid"
= ]
= [ Element.row
= [ Element.width Element.fill
@@ -255,7 +188,7 @@ window block =
= [ Element.height (Element.px 400)
= , Element.width Element.fill
= ]
- |> BrowserWindow.window [ css "page-break-inside" "avoid" ]
+ |> BrowserWindow.window [ Element.css "page-break-inside" "avoid" ]
= in
= Mark.block "Window"
= render
@@ -413,7 +346,7 @@ icon =
= )
= |> Element.el
= [ Element.padding 4
- , css "vertical-align" "middle"
+ , Element.css "vertical-align" "middle"
= ]
= )
= |> Mark.inlineString "name"
@@ -492,19 +425,6 @@ definition =
= |> Mark.inlineString "definiens"
=
=
-
--- Helpers
-
-
-css : String -> String -> Element.Attribute msg
-css property value =
- Element.htmlAttribute
- (Html.Attributes.style
- property
- value
- )
-
-
=colors =
= { maroon = Element.rgb 0.7 0 0
= , gray = Element.rgb 0.8 0.8 0.8