Elm svg freehand

elm.package.json

{
    "version": "1.0.0",
    "summary": "Freehand drawing",
    "repository": "https://github.com/rundis/freehand.git",
    "license": "BSD3",
    "source-directories": [
        "."
    ],
    "exposed-modules": [],
    "dependencies": {
        "elm-lang/core": "3.0.0 <= v < 4.0.0",
        "evancz/elm-effects": "2.0.1 <= v < 3.0.0",
        "evancz/elm-html": "4.0.2 <= v < 5.0.0",
        "evancz/elm-svg": "2.0.1 <= v < 3.0.0",
        "evancz/start-app": "2.0.2 <= v < 3.0.0",
        "jvoigtlaender/elm-drag": "1.0.0 <= v < 2.0.0"
    },
    "elm-version": "0.16.0 <= v < 0.17.0"
}

Freehand.elm

module Freehand where

import String
import List
import Svg
import Svg.Attributes exposing (..)
import Html exposing (Html)
import Html.Events exposing (onClick)
import Effects exposing (Effects)
import StartApp

import Drag exposing (mouseEvents, Action (..))


type alias Coord = (Int, Int)
type alias Stroke = List Coord
type alias Model =
  { strokes : List Stroke
  , newStroke : Stroke
  }


strokes : List Stroke
strokes = [ [ (323, 143)
            , (80, 290)
            , (20, 300)
            ]
          , [ (100, 200)
            , (40, 70)
            , (129, 140)
            ]
          ]


init : (Model, Effects Action)
init =
  ( { strokes = strokes
    , newStroke = []
    }
  , Effects.none
  )


type Action
  = StartStroke Int Int
  | ContinueStroke Int Int
  | EndStroke Int Int
  | UndoLastStroke
  | ClearAllStrokes


update : Action -> Model -> (Model, Effects Action)
update action model =
  let
    _ =
      Debug.log "Action" action
  in
    case action of
      ClearAllStrokes ->
        ( { model | strokes = [] }, Effects.none )

      UndoLastStroke ->
        ( { model | strokes = List.take (List.length model.strokes - 1) model.strokes }
        , Effects.none
        )

      StartStroke x y ->
        ( { model | newStroke = [ ( x, y ) ] }, Effects.none )

      ContinueStroke x y ->
        ( { model | newStroke = model.newStroke ++ [ ( x, y ) ] }, Effects.none )

      EndStroke x y ->
        let
          newStroke =
            model.newStroke ++ [ ( x, y ) ]
        in
          ( { model
              | newStroke = []
              , strokes = model.strokes ++ [ newStroke ]
            }
          , Effects.none
          )


coordToString : Coord -> String
coordToString (a,b) =
  (toString a) ++ " " ++ (toString b)


coordsToPathString : Stroke -> String
coordsToPathString listOfCoords =
  case listOfCoords of
    [] -> ""
    xs -> "M" ++ String.join " L " (List.map coordToString xs)


coordsToPath : Stroke -> Svg.Svg
coordsToPath listOfCoords =
    Svg.path [ fill "none"
             , stroke "#000"
             , strokeWidth "3px"
             , strokeLinejoin "round"
             , strokeLinecap "round"
             , d (coordsToPathString listOfCoords)
             ] []


view : Signal.Address Action -> Model -> Html.Html
view address model =
  Html.div
    []
    [ Svg.svg
        [ width "800"
        , height "600"
        ]
        (List.map coordsToPath (model.strokes ++ [ model.newStroke ]))
    , Html.button [ onClick address UndoLastStroke ] [ Html.text "Undo Previous" ]
    , Html.span [] [ Html.text " " ]
    , Html.button [ onClick address ClearAllStrokes ] [ Html.text "Reset" ]
    ]


app : StartApp.App Model
app =
  StartApp.start
    { init = init
    , update = update
    , view = view
    , inputs = [strokesSignal]
    }

strokesSignal : Signal Action
strokesSignal =
  let
    fn evt = case evt of
               Drag.StartAt (x,y) ->
                 StartStroke x  y

               Drag.MoveFromTo (_,_) (x2, y2) ->
                 ContinueStroke x2 y2

               Drag.EndAt (x,y) ->
                 EndStroke x y

  in
    Signal.map fn Drag.mouseEvents


main : Signal Html
main =
  app.html