Basic Elm canvas API

Author: igagen

.gitignore

@@ -0,0 +1,2 @@
+/elm-stuff
+elm.js

Canvas.elm

@@ -0,0 +1,172 @@
+module Canvas where
+
+import Graphics.Element exposing (Element)
+import Basics exposing (pi)
+import Color exposing (..)
+import Native.Canvas
+import Task exposing (Task)
+
+-- Line Styles
+
+type LineCap = ButtCap | RoundCap | SquareCap
+type LineJoin = RoundJoin | BevelJoin | MiterJoin
+
+-- Composite Operations
+
+type CompositeOperation
+  = SourceOver
+  | SourceIn
+  | SourceOut
+  | SourceAtop
+  | DestinationOver
+  | DestinationIn
+  | DestinationOut
+  | DestinationAtop
+  | Lighter
+  | Copy
+  | Xor
+  | Multiply
+  | Screen
+  | Overlay
+  | Darken
+  | Lighten
+  | ColorDodge
+  | ColorBurn
+  | HardLight
+  | SoftLight
+  | Difference
+  | Exclusion
+  | Hue
+  | Saturation
+  | Color
+  | Luminosity
+
+-- Paths
+
+type alias HasPoint a = { a | x: Float, y: Float }
+type alias HasCircle a = HasPoint { a | r: Float }
+type alias HasRect a = HasPoint { a | w: Float, h: Float }
+type alias Point = HasPoint {}
+type alias Circle = HasCircle {}
+type alias Rectangle = HasRect {}
+
+type PathMethod
+  = MoveTo Point
+  | LineTo Point
+  | Rect Rectangle
+  | Arc { x: Float, y: Float, r: Float, startAngle: Float, endAngle: Float, ccw: Bool }
+  | ArcTo { x1: Float, y1: Float, x2: Float, y2: Float, r: Float }
+  | ClosePath
+
+type alias Path = List PathMethod
+
+-- Images
+
+type Image = Image
+
+-- Commands
+
+type Command
+  -- Draw Commands
+  = Clear Rectangle
+  | FillPath Path
+  | StrokePath Path
+  | FillText String Float Float
+  | StrokeText String Float Float
+  | DrawImage Float Float Image
+
+  -- State Commands
+  | FillColor Color
+  | StrokeColor Color
+  | FillGrad Gradient
+  | StrokeGrad Gradient
+
+  | LineWidth Float
+  | LineCapStyle LineCap
+  | LineJoinStyle LineJoin
+  | LineMiterLimit Float
+
+  | ShadowBlur Float
+  | ShadowColor Color
+  | ShadowOffset Float Float
+
+  | Translate Float Float
+  | Rotate Float
+  | Scale Float Float
+
+  | Font String
+  | Alpha Float
+  | Composite CompositeOperation
+
+  -- Wraps Commands in Save/Restore
+  | Context (List Command)
+
+-- Draw Commands
+
+clearRect rect = Clear rect
+fillRect x y w h = FillPath [Rect (rect x y w h)]
+strokeRect x y w h = StrokePath [Rect (rect x y w h)]
+
+fillPath path = FillPath path
+strokePath path = StrokePath path
+
+fillCircle circle = FillPath [Arc circle]
+strokeCircle circle = StrokePath [Arc circle]
+
+fillText text x y = FillText text x y
+strokeText text x y = StrokeText text x y
+
+-- Style Commands
+
+fillColor color = FillColor color
+strokeColor color = StrokeColor color
+fillGrad grad = FillGrad grad
+strokeGrad grad = StrokeGrad grad
+
+lineWidth width = LineWidth width
+lineCap cap = LineCapStyle cap
+lineJoin join = LineJoinStyle join
+lineMiterLimit length = LineMiterLimit length
+
+shadowBlur blurRadius = ShadowBlur blurRadius
+shadowColor color = ShadowColor color
+shadowOffset offsetX offsetY = ShadowOffset offsetX offsetY
+
+translate x y = Translate x y
+rotate angle = Rotate angle
+scale scaleX scaleY = Scale scaleX scaleY
+
+font fnt = Font fnt
+alpha a = Alpha a
+composite compositeOp = Composite compositeOp
+
+context commands = Context commands
+
+-- Path Methods
+
+moveTo x y = MoveTo { x = x, y = y }
+lineTo x y = LineTo { x = x, y = y }
+
+rect x y w h = { x = x, y = y, w = w, h = h }
+
+circle x y r = arc x y r 0.0 (2.0 * pi)
+
+arcWithDir x y r startAngle endAngle ccw =
+  { x = x, y = y, r = r, startAngle = startAngle, endAngle = endAngle, ccw = ccw }
+
+arc x y r startAngle endAngle = arcWithDir x y r startAngle endAngle False
+
+arcTo x1 y1 x2 y2 r = ArcTo { x1 = x1, y1 = y1, x2 = x2, y2 = y2, r = r }
+
+-- Images
+
+drawImage : Float -> Float -> Image -> Command
+drawImage x y img = DrawImage x y img
+
+loadImage : String -> Task String Image
+loadImage = Native.Canvas.loadImage
+
+-- Canvas
+
+canvas : (Int, Int) -> List Command -> Element
+canvas = Native.Canvas.canvas

Main.elm

@@ -0,0 +1,92 @@
+module Main where
+
+import Graphics.Element exposing (..)
+import Time exposing (..)
+import Canvas exposing (..)
+import Mouse
+import Basics exposing (pi)
+import Color exposing (..)
+import Task exposing (Task, andThen, toResult)
+
+w = 1024
+h = 768
+
+c = circle 512 384 32
+
+center = (512, 384)
+
+styleCmds =
+  [ strokeColor red
+  , shadowBlur 10
+  , shadowColor blue
+  , shadowOffset 5 5
+  , lineWidth 2
+  , lineCap ButtCap
+  , lineJoin RoundJoin
+  ]
+
+linGrad = linear (0, 0) (w, h)
+  [ (0, green)
+  , (1, lightBlue)
+  ]
+
+radGrad = radial (75, 50) 5 (90, 60) 100
+  [ (0, red), (1, white) ]
+
+drawCmds =
+  [ fillGrad linGrad
+  , fillRect 0 0 w h
+  , fillColor orange
+  , strokePath
+    [ moveTo 20 20
+    , lineTo 100 20
+    , arcTo 150 20 150 70 50
+    , lineTo 150 120
+    ]
+  , fillCircle c
+  , strokeCircle c
+  , context
+    [ composite HardLight
+    , translate -100 -100
+    , fillCircle c
+    ]
+  , strokeColor purple
+
+  , font "50px Arial"
+  , fillText "Elm-Canvas" 450 100
+  ]
+
+commands = styleCmds ++ drawCmds
+
+type alias Model =
+  { w : Int
+  , h : Int
+  , commands : List Command
+  }
+
+model = Signal.constant
+  { w = 1024
+  , h = 768
+  , commands = commands
+  }
+
+view : Model -> Result String Image -> Element
+view model result =
+  let
+    drawImg = case result of
+      Err _ -> []
+      Ok img -> [drawImage 512 384 img]
+  in
+    canvas (model.w, model.h) (model.commands ++ drawImg)
+
+main : Signal Element
+main = Signal.map2 view model results.signal
+
+results : Signal.Mailbox (Result String Image)
+results = Signal.mailbox (Err "Image not found")
+
+imageSrc = "http://inkarnate.com/images/map-builder/skins/darkfantasy-world/objects/compass.png"
+
+port updateImage : Task String ()
+port updateImage =
+  (loadImage imageSrc |> Task.toResult) `andThen` Signal.send results.address

elm-package.json

@@ -0,0 +1,15 @@
+{
+    "version": "1.0.0",
+    "summary": "helpful summary of your project, less than 80 characters",
+    "repository": "https://github.com/USER/PROJECT.git",
+    "license": "BSD3",
+    "source-directories": [
+        "."
+    ],
+    "exposed-modules": [],
+    "native-modules": true,
+    "dependencies": {
+        "elm-lang/core": "2.1.0 <= v < 3.0.0"
+    },
+    "elm-version": "0.15.1 <= v < 0.16.0"
+}