Elm SVG/Graphics notes

notes.md

A shared Command type

I wrote a SVG path parser according to the w3c spec to get a better feel for what should be representable and to read up on the edge cases. The main data structure is Command and can be found in PathParser.elm.

notes

By the looks of it, the Command type used in the PathParser module seems to cover everyone's needs in the current packages that I could find.

Packages that use svg path

• terezka/elm-plot
• gampleman/elm-visualization
• mdgriffith/elm-style-animation
• opensolid/svg
• folkertdev/svg-path-dsl

The Command type in the PathParser module is more complete and general than those in elm-visualization and elm-plot. It seems about equivalent to svg-path-dsl and elm-style-animation. opensolid/svg does not have a data structure for expressing svg path commands: it instead uses string concatenation to create the commands in-place.

elm-plot

Only uses the absolute commands (relative ones are not expressable). Its Command type can be found here The same file also defines a function that maps over all the coordinates in the structure (source) which can be generalized to (Coordinate -> Coordinate) -> Command -> Command.

elm-visualization

Only supports a subset of the path instructions, and adds some new ones (ArcCustom, Rect). The main data structure is PathSegment Based on a comment, the drawing commands mirror the Canvas API.

ArcCustom operates with a startAngle and endAngle, a construct that is also defined by elm-style-animation.

svg-path-dsl

This package contains separate instructions for commands with one argument L0,0 and with multiple arguments L1,1 2,3. With a fresh view, having one instruction is obviously better. Otherwise, it is pretty similar to the Command type that I propose.

elm-style-animation

elm-style-animation has a PathCommand type that is rendered by pathCmdValue. It looks like one constructor of the PathCommand type can construct multiple commands.

opensolid/svg

the opensolid/svg package uses polygon and polyline where possible, and draws arcs and curves using manual string concatenation. It also defines curves and polylines in a more abstract way, and implements many mathematical operations on them.

Next steps

• Agree on a common data structure for representing SVG commands
• Agree on an API to interact with that data structure
• Package up the data structure (and most likely also a pretty-printer for it) and test it extensively

further topics

• optimization: grouping the same commands (L20,20 L40,40 becomes L20,20 40,40)

• converting relative to absolute: The first move instruction of a path is always interpreted as absolute source. Therefore, there is always an anchor making it possible to convert relative instructions to their absolute equivalents. See ToAbsolute.elm for a draft of how that would work.

• mathematical operations: Distance along the curve, the y value (values?) at some x (and possibly vice versa), the derivative

  There are some operations that can be defined on a list of svg commands, but for real calculation it might be better to construct mappings to and from more custom data structures.

  • the openshapes package seems to have much of the math already implemented. Constructing conversions to and from the types there (like CubicSpline, QuadraticSpline, LineSegment) seems possible.

  • elm-style-animation has interpolation on a curve defined on svg commands

  • elm-plot has the conversion of a set of points to a monotone cubic bezier

• other backends:

  • The canvas api implements move, line, both types of beziers and arcs, to targetting canvas is trivial (once elm supports the Canvas API better).
  • WebGl is more tricky: rasterizing the curves (converting formulas to pixels) has to be implemented from scratch. In theory also possible though.

• more type-safety

  There are some things we could try, but I don't think any of these options produce a nicer API

  • Use NonEmpty lists to store the points (so for example, type Command = LineTo Mode (NonEmpty Point) | ...). This change encodes that the list of points cannot be empty, but it is a bit cumbersome to work with.

    In particular, the users of our api would need to use nonempty lists for their code as well (or do tedious conversions all the time). On the other hand: A lineto without points is fundamentally wrong, and maybe we should guide api users (just like core make opinionated choices about what list functions to expose, omitting for instance List.atIndex).

  • We could define command to use phantom types (types/type variables that only occur on the left-hand side). For instance

    type Relative = Relative 
    
    type Absolute = Absolute 
    
    
    type Command a = MoveTo Coordinate | LineTo Coordinate | ... 
    
    -- this would make an api like this possible 
    
    moveTo : Command Absolute
    moveTo = MoveTo
    
    moveBy : Command Relative 
    moveBy = MoveTo 
    

    That looks really nice, but we lose the ability to compose relative and absolute commands easily. In haskell there might be able ways around this problem, but in elm it's a dead end.

PathParser.elm

module Svg.PathParser exposing (..)

{-| Module for parsing SVG path syntax, using [elm-tools/parser](http://package.elm-lang.org/packages/elm-tools/parser/latest)

The data structure and parser is modeled according to [this W3C grammar](https://www.w3.org/TR/SVG/paths.html#PathDataBNF)

### data

The building blocks are

* moveto - contains `M` and `m` commands. 
* drawto - the other commands (lineto, elliptical arc, bezier curve)

The basic structure:

* a `path` is a list of `moveto-drawto-command-group`s (and the empty path `""` is valid).
* a **moveto-drawto-command-group** is a moveto command followed by a list of drawto commands (also called a subpath)


The parsers themselves often have three parts

* `*` parses the full command  `L20,20 40,40`
* `*ArgumentSequence` parses a list of arguments (`20, 20 40,40` in `L20,20 40,40`)
* `*Argument` parses a single argument (`20, 20` in `L20,20 40,40`)

### parsing

This parser is more strict than the linked parser above, because the SVG has to be well-typed. Specifically,
the W3C grammar allows "coordinates" that consist of only one number. Thus it accepts `M100-200` (and equivalently `M100 M-200`), whereas this parser will not..

-}

import Parser exposing (..)
import Char





type alias Coordinate =
    ( Float, Float )


type Sign
    = Plus
    | Minus


type Command
    = MoveTo Mode Coordinate
    | LineTo Mode (List Coordinate)
    | Horizontal Mode (List Float)
    | Vertical Mode (List Float)
    | CurveTo Mode (List ( Coordinate, Coordinate, Coordinate ))
    | SmoothCurveTo Mode (List ( Coordinate, Coordinate ))
    | QuadraticBezierCurveTo Mode (List ( Coordinate, Coordinate ))
    | SmoothQuadraticBezierCurveTo Mode (List Coordinate)
    | EllipticArc Mode (List EllipticalArcArgument)
    | ClosePath


type Mode
    = Relative
    | Absolute


type alias EllipticalArcArgument =
    { radii : ( Float, Float )
    , xAxisRotate : Float
    , arcFlag : ArcFlag
    , direction : Direction
    , target : Coordinate
    }


type ArcFlag
    = SmallestArc
    | LargestArc


type Direction
    = Clockwise
    | AntiClockwise


svgPath : Parser (List MoveToDrawToCommandGroup)
svgPath =
    let
        -- The first MoveTo command is always interpreted as absolute. Better make that explicit
        makeFirstMovetoAbsolute commandGroups =
            case commandGroups of
                [] ->
                    []

                { move, drawtos } :: rest ->
                    case move of
                        MoveTo Relative coordinate ->
                            { move = MoveTo Absolute coordinate, drawtos = drawtos } :: rest

                        _ ->
                            commandGroups
    in
        succeed identity
            |. Parser.ignore zeroOrMore isWhitespace
            |= withDefault [] moveToDrawToCommandGroups
            |. Parser.ignore zeroOrMore isWhitespace
            |. Parser.end
            |> Parser.map makeFirstMovetoAbsolute


moveToDrawToCommandGroups : Parser (List MoveToDrawToCommandGroup)
moveToDrawToCommandGroups =
    delimited { item = moveToDrawToCommandGroup, delimiter = Parser.ignore zeroOrMore isWhitespace }


type alias MoveToDrawToCommandGroup =
    { move : Command, drawtos : List Command }


moveToDrawToCommandGroup : Parser MoveToDrawToCommandGroup
moveToDrawToCommandGroup =
    inContext "moveto drawto command group" <|
        succeed
            (\( move, linetos ) drawtos ->
                case linetos of
                    Nothing ->
                        MoveToDrawToCommandGroup move drawtos

                    Just lt ->
                        MoveToDrawToCommandGroup move (lt :: drawtos)
            )
            |= moveto
            |. Parser.ignore zeroOrMore isWhitespace
            |= withDefault [] drawtoCommands


drawtoCommands : Parser (List Command)
drawtoCommands =
    inContext "drawto commands" <|
        delimited { item = drawtoCommand, delimiter = Parser.ignore zeroOrMore isWhitespace }


drawtoCommand : Parser Command
drawtoCommand =
    oneOf
        [ closepath
        , lineto
        , horizontalLineto
        , verticalLineto
        , curveto
        , smoothCurveto
        , quadraticBezierCurveto
        , smoothQuadraticBezierCurveto
        , ellipticalArc
        ]



-- command : { constructor : Mode -> args -> command, character : Char, arguments : Parser args } -> Parser command


moveto : Parser ( Command, Maybe Command )
moveto =
    {- moveto has some corner cases

       * if a moveto is followed by extra coordinate pairs, they are interpreted as lineto commands (relative when the moveto is relative, absolute otherwise).
       * the first moveto in a path is always interpreted as absolute (but following linetos are still relative)
    -}
    inContext "moveto" <|
        command
            { constructor =
                \mode coordinates ->
                    case coordinates of
                        [] ->
                            Debug.crash "movetoArgumentSequence succeeded but parsed no coordinates"

                        [ c ] ->
                            ( MoveTo mode c, Nothing )

                        c :: cs ->
                            -- cs has at least size 1
                            ( MoveTo mode c, Just (LineTo mode cs) )
            , character = 'm'
            , arguments = movetoArgumentSequence
            }


movetoArgumentSequence : Parser (List Coordinate)
movetoArgumentSequence =
    delimited { item = coordinatePair, delimiter = withDefault () wsp }


closepath : Parser Command
closepath =
    -- per the w3c spec "Since the Z and z commands take no parameters, they have an identical effect."
    inContext "closepath" <|
        oneOf
            [ symbol "z"
                |- succeed ClosePath
            , symbol "Z"
                |- succeed ClosePath
            ]


lineto : Parser Command
lineto =
    inContext "lineto" <|
        command
            { constructor = LineTo
            , character = 'l'
            , arguments = linetoArgumentSequence
            }


linetoArgumentSequence : Parser (List Coordinate)
linetoArgumentSequence =
    delimited { item = coordinatePair, delimiter = withDefault () wsp }


horizontalLineto : Parser Command
horizontalLineto =
    inContext "horizontal lineto" <|
        command
            { constructor = Horizontal
            , character = 'h'
            , arguments = horizontalLinetoArgumentSequence
            }


horizontalLinetoArgumentSequence : Parser (List Float)
horizontalLinetoArgumentSequence =
    delimited { item = number, delimiter = withDefault () wsp }


verticalLineto : Parser Command
verticalLineto =
    inContext "vertical lineto" <|
        command
            { constructor = Vertical
            , character = 'v'
            , arguments = verticalLinetoArgumentSequence
            }


verticalLinetoArgumentSequence : Parser (List Float)
verticalLinetoArgumentSequence =
    delimited { item = number, delimiter = withDefault () wsp }


curveto : Parser Command
curveto =
    inContext "curveto" <|
        command
            { constructor = CurveTo
            , character = 'c'
            , arguments = curvetoArgumentSequence
            }


curvetoArgumentSequence : Parser (List ( Coordinate, Coordinate, Coordinate ))
curvetoArgumentSequence =
    delimited { item = curvetoArgument, delimiter = withDefault () wsp }


curvetoArgument : Parser ( Coordinate, Coordinate, Coordinate )
curvetoArgument =
    succeed (,,)
        |= coordinatePair
        |. withDefault () wsp
        |= coordinatePair
        |. withDefault () wsp
        |= coordinatePair


smoothCurveto : Parser Command
smoothCurveto =
    inContext "smooth curveto" <|
        command
            { constructor = SmoothCurveTo
            , character = 's'
            , arguments = smoothCurvetoArgumentSequence
            }


smoothCurvetoArgumentSequence : Parser (List ( Coordinate, Coordinate ))
smoothCurvetoArgumentSequence =
    delimited { item = smoothCurvetoArgument, delimiter = withDefault () wsp }


smoothCurvetoArgument : Parser ( Coordinate, Coordinate )
smoothCurvetoArgument =
    succeed (,)
        |= coordinatePair
        |. withDefault () wsp
        |= coordinatePair


quadraticBezierCurveto : Parser Command
quadraticBezierCurveto =
    inContext "quadratic bezier curveto" <|
        command
            { constructor = QuadraticBezierCurveTo
            , character = 'q'
            , arguments = quadraticBezierCurvetoArgumentSequence
            }


quadraticBezierCurvetoArgumentSequence : Parser (List ( Coordinate, Coordinate ))
quadraticBezierCurvetoArgumentSequence =
    delimited { item = quadraticBezierCurvetoArgument, delimiter = withDefault () wsp }


quadraticBezierCurvetoArgument : Parser ( Coordinate, Coordinate )
quadraticBezierCurvetoArgument =
    succeed (,)
        |= coordinatePair
        |. withDefault () wsp
        |= coordinatePair


smoothQuadraticBezierCurveto : Parser Command
smoothQuadraticBezierCurveto =
    inContext "smooth quadratic bezier curveto" <|
        command
            { constructor = SmoothQuadraticBezierCurveTo
            , character = 't'
            , arguments = smoothQuadraticBezierCurvetoArgumentSequence
            }


smoothQuadraticBezierCurvetoArgumentSequence : Parser (List Coordinate)
smoothQuadraticBezierCurvetoArgumentSequence =
    delimited { item = coordinatePair, delimiter = withDefault () wsp }


ellipticalArc : Parser Command
ellipticalArc =
    inContext "elliptical arc" <|
        command
            { constructor = EllipticArc
            , character = 'a'
            , arguments = ellipticalArcArgumentSequence
            }


ellipticalArcArgumentSequence : Parser (List EllipticalArcArgument)
ellipticalArcArgumentSequence =
    delimited { item = ellipticalArcArgument, delimiter = withDefault () wsp }


ellipticalArcArgument : Parser EllipticalArcArgument
ellipticalArcArgument =
    let
        helper rx ry xAxisRotate arcFlag direction target =
            { radii = ( rx, ry )
            , xAxisRotate = xAxisRotate
            , arcFlag =
                if arcFlag then
                    LargestArc
                else
                    SmallestArc
            , direction =
                if direction then
                    Clockwise
                else
                    AntiClockwise
            , target = target
            }
    in
        succeed helper
            |= nonNegativeNumber
            |. optional commaWsp
            |= nonNegativeNumber
            |. withDefault () commaWsp
            |= number
            |. commaWsp
            |= flag
            |. withDefault () commaWsp
            |= flag
            |. withDefault () commaWsp
            |= coordinatePair


{-| Parse a sequence of values separated by a delimiter

This parser is used to for example parse the comma or whitespace-delimited arguments for a horizontal move

    Parser.run (delimited { delimiter = optional commaWsp, item = number }) "1 2 3 4" == [1,2,3,4]
-}
delimited : { delimiter : Parser (), item : Parser a } -> Parser (List a)
delimited { delimiter, item } =
    oneOf
        [ item
            |> Parser.andThen (\first -> delimitedEndForbidden item delimiter [ first ])
        , Parser.succeed []
        ]


delimitedEndForbidden : Parser a -> Parser () -> List a -> Parser (List a)
delimitedEndForbidden parseItem delimiter revItems =
    let
        chompRest item =
            delimitedEndForbidden parseItem delimiter (item :: revItems)
    in
        oneOf
            [ delayedCommit delimiter <|
                andThen chompRest parseItem
            , succeed (List.reverse revItems)
            ]


{-| Construct both the absolute and relative parser for a command.
-}
command : { constructor : Mode -> args -> command, character : Char, arguments : Parser args } -> Parser command
command { constructor, character, arguments } =
    oneOf
        [ succeed (constructor Absolute)
            |. symbol (String.fromChar <| Char.toUpper character)
            |. Parser.ignore zeroOrMore isWhitespace
            |= arguments
        , succeed (constructor Relative)
            |. symbol (String.fromChar <| Char.toLower character)
            |. Parser.ignore zeroOrMore isWhitespace
            |= arguments
        ]



-- Primitives


sign : Parser Sign
sign =
    oneOf
        [ symbol "-"
            |- succeed Minus
        , symbol "+"
            |- succeed Plus
        ]


digitSequence : Parser Int
digitSequence =
    Parser.int


type Exponent
    = Exponent Int


exponent : Parser Exponent
exponent =
    Parser.map Exponent <|
        succeed applySign
            |. oneOf [ symbol "e", symbol "E" ]
            |= withDefault Plus sign
            |= digitSequence


fractionalConstant : Parser Float
fractionalConstant =
    let
        helper left right =
            case String.toFloat (toString left ++ "." ++ toString right) of
                Err e ->
                    fail e

                Ok v ->
                    succeed v
    in
        join <|
            oneOf
                [ succeed helper
                    |= withDefault 0 digitSequence
                    |. symbol "."
                    |= digitSequence
                , succeed (\left -> helper left 0)
                    |= digitSequence
                    |. symbol "."
                ]


join : Parser (Parser a) -> Parser a
join =
    Parser.andThen identity


applyExponent : Float -> Exponent -> Parser Float
applyExponent float (Exponent exp) =
    case String.toFloat (toString float ++ "e" ++ toString exp) of
        Err e ->
            fail e

        Ok v ->
            succeed v


floatingPointConstant : Parser Float
floatingPointConstant =
    join <|
        oneOf
            [ succeed applyExponent
                |= fractionalConstant
                |= withDefault (Exponent 0) exponent
            , succeed applyExponent
                |= Parser.map toFloat digitSequence
                |= exponent
            ]


integerConstant : Parser Int
integerConstant =
    Parser.int


comma : Parser ()
comma =
    symbol ","


wsp : Parser ()
wsp =
    inContext "whitespace" <|
        -- (#x20 | #x9 | #xD | #xA)
        oneOf [ symbol " ", symbol "\t", symbol "\x0D", symbol "\n" ]


isWhitespace char =
    char == ' ' || char == '\t' || char == '\x0D' || char == '\n'


commaWsp : Parser ()
commaWsp =
    inContext "comma or whitespace" <|
        oneOf
            [ succeed ()
                |. Parser.ignore oneOrMore isWhitespace
                |. withDefault () comma
                |. Parser.ignore zeroOrMore isWhitespace
            , succeed ()
                |. comma
                |. Parser.ignore zeroOrMore isWhitespace
            ]


flag : Parser Bool
flag =
    inContext "flag" <|
        oneOf
            [ symbol "1"
                |> Parser.map (\_ -> True)
            , symbol "0"
                |> Parser.map (\_ -> False)
            ]


applySign : Sign -> number -> number
applySign sign num =
    case sign of
        Plus ->
            num

        Minus ->
            -num


number : Parser Float
number =
    inContext "number" <|
        oneOf
            [ succeed applySign
                |= withDefault Plus sign
                |= integerConstant
                |> Parser.map toFloat
            , succeed applySign
                |= withDefault Plus sign
                |= floatingPointConstant
            ]


nonNegativeNumber : Parser Float
nonNegativeNumber =
    inContext "non-negative number" <|
        oneOf
            [ Parser.map toFloat integerConstant
            , floatingPointConstant
            ]


coordinatePair : Parser Coordinate
coordinatePair =
    inContext "coordinate pair" <|
        succeed (,)
            |= number
            |. commaWsp
            |= number



-- Parser Helpers


{-| Try a parser. If it fails, give back the default value
-}
withDefault : a -> Parser a -> Parser a
withDefault default parser =
    oneOf [ parser, succeed default ]


{-| Parse zero or one values of a given parser.
This function is often written as a `?` in grammars, so `int?` is `optional int`
-}
optional : Parser a -> Parser ()
optional parser =
    oneOf
        [ parser
            |- succeed ()
        , succeed ()
        ]


{-| Ignore everything that came before, start fresh
-}
(|-) : Parser ignore -> Parser keep -> Parser keep
(|-) ignoreParser keepParser =
    map2 (\_ keep -> keep) ignoreParser keepParser

ToAbsolute.elm

module ToAbsolute exposing (..) 

{- converts relative instructions to absolute
-- making use of the fact that the first moveto instruction is always interpreted as absolute, 
 thus providing an anchor for all further instructions
-}
type alias CursorState =
    { subPathStart : Coordinate, cursor : Coordinate }


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

        [ x ] ->
            Just x

        x :: xs ->
            last xs


sumCoordinates ( a, b ) ( c, d ) =
    ( a + c, b + d )


toAbsolute_ : CursorState -> Command -> ( Command, Coordinate )
toAbsolute_ { cursor } command =
    case command of
        MoveTo Absolute coordinate ->
            ( command
            , coordinate
            )

        MoveTo Relative ( dx, dy ) ->
            let
                newLocation =
                    sumCoordinates cursor ( dx, dy )
            in
                ( MoveTo Absolute newLocation
                , newLocation
                )

        LineTo Absolute coordinates ->
            ( command
            , Maybe.withDefault cursor (last coordinates)
            )

        LineTo Relative coordinates ->
            let
                helper delta ( position, accum ) =
                    let
                        newLocation =
                            sumCoordinates position delta
                    in
                        ( newLocation, newLocation :: accum )

                ( newLocation, newCoordinates ) =
                    List.foldr helper ( cursor, [] ) coordinates
            in
                ( LineTo Absolute newCoordinates
                , newLocation
                )

        Horizontal Absolute coordinates ->
            let
                ( x, y ) =
                    cursor
            in
                ( command
                , ( Maybe.withDefault x (last coordinates), y )
                )

        Horizontal Relative coordinates ->
            let
                helper dx ( ( x, y ), accum ) =
                    ( ( dx + x, y ), dx + x :: accum )

                ( newLocation, newCoordinates ) =
                    List.foldr helper ( cursor, [] ) coordinates
            in
                ( Horizontal Absolute newCoordinates
                , newLocation
                )

        _ ->
            ( command
            , cursor
            )


toAbsolute : CursorState -> Command -> Command
toAbsolute cursorState =
    toAbsolute_ cursorState >> Tuple.first


step : Command -> CursorState -> CursorState
step command cursorState =
    let
        ( _, newLocation ) =
            toAbsolute_ cursorState command
    in
        case command of
            MoveTo _ _ ->
                { cursorState | subPathStart = newLocation, cursor = newLocation }

            _ ->
                { cursorState | cursor = newLocation }