sunroof-compiler-0.2: Language/Sunroof/JS/Canvas.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
-- | Provides bindings to the Javascript API of the
-- HTML5 canvas element.
--
-- See <http://www.w3schools.com/tags/ref_canvas.asp>.
module Language.Sunroof.JS.Canvas
( JSCanvas
, getContext
, arc, arc', arcTo
, beginPath
, bezierCurveTo
, clearRect, clip
, closePath
, createImageData, createImageData'
, drawImage, drawImage', drawImageClip
, fill, fillRect
, setFillStyle
, fillText, fillText'
, setFont
, getImageData
, setGlobalAlpha
, isPointInPath
, setLineCap, setLineJoin
, lineTo
, setLineWidth
, miterLimit
, setMiterLimit
, measureText
, moveTo
, putImageData
, rect
, restore
, rotate, scale
, save
, setTransform
, setShadowColor, setShadowBlur
, setShadowOffsetX, setShadowOffsetY
, stroke, strokeRect, strokeText
, setStrokeStyle
, setTextAlign, setTextBaseline
, transform, translate
, quadraticCurveTo
, width, height
, data'
, globalAlpha
, shadowColor, shadowBlur
, shadowOffsetX, shadowOffsetY
, strokeStyle
, textAlign, textBaseline
, lineCap, lineJoin, lineWidth
, font
) where
import Data.Boolean ( BooleanOf, IfB(..), EqB(..) )
import Language.Sunroof.Classes ( Sunroof(..) )
import Language.Sunroof.Types
import Language.Sunroof.Selector ( JSSelector, label )
import Language.Sunroof.JS.Bool ( JSBool, jsIfB )
import Language.Sunroof.JS.Object ( JSObject )
import Language.Sunroof.JS.String ( JSString, string )
import Language.Sunroof.JS.Number ( JSNumber )
-- -------------------------------------------------------------
-- JSCanvas Type
-- -------------------------------------------------------------
-- | The type of the canvas drawing context.
newtype JSCanvas = JSCanvas JSObject
-- | Show the Javascript.
instance Show JSCanvas where
show (JSCanvas o) = show o
-- | First-class values in Javascript.
instance Sunroof JSCanvas where
box = JSCanvas . box
unbox (JSCanvas o) = unbox o
-- | Associated boolean is 'JSBool'.
type instance BooleanOf JSCanvas = JSBool
-- | Can be returned in branches.
instance IfB JSCanvas where
ifB = jsIfB
-- | Reference equality, not value equality.
instance EqB JSCanvas where
(JSCanvas a) ==* (JSCanvas b) = a ==* b
-- -------------------------------------------------------------
-- JSCanvas Combinators
-- -------------------------------------------------------------
-- | Returns the canvas drawing context for the canvas element it
-- is called on.
getContext :: JSString -> JSObject -> JS t JSCanvas
getContext nm = invoke "getContext" nm
-- | Draws a circular arc.
arc :: (JSNumber,JSNumber) -- ^ The x and y component of the center point.
-> JSNumber -- ^ The radius.
-> (JSNumber,JSNumber) -- ^ The angle to start and the angle to stop drawing.
-> JSCanvas -> JS t ()
arc (cx,cy) r (sa,ea) =
invoke "arc" (cx, cy, r, sa, ea)
-- | Draws a circular arc.
arc' :: (JSNumber,JSNumber) -- ^ The x and y component of the center point.
-> JSNumber -- ^ The radius.
-> (JSNumber,JSNumber) -- ^ The angle to start and the angle to stop drawing.
-> JSBool -- ^ If the arc shall be drawn counterclockwise.
-> JSCanvas -> JS t ()
arc' (cx,cy) r (sa,ea) cc =
invoke "arc" (cx, cy, r, sa, ea, cc)
-- | Creates an arc between two tangents on the canvas.
arcTo :: (JSNumber, JSNumber) -- ^ The x and y coordinate of the beginning of the arc.
-> (JSNumber, JSNumber) -- ^ The x and y coordinate of the end of the arc.
-> JSNumber -- ^ The radius of the arc.
-> JSCanvas -> JS t ()
arcTo (x1, y1) (x2, y2) r =
invoke "arcTo" (x1, y1, x2, y2, r)
-- | Begins drawing a path or resets the current path
beginPath :: JSCanvas -> JS t ()
beginPath = invoke "beginPath" ()
-- | Draws a bezier curve beginning at the current position of the context.
bezierCurveTo :: (JSNumber,JSNumber) -- ^ The first control point.
-> (JSNumber,JSNumber) -- ^ The second control point.
-> (JSNumber,JSNumber) -- ^ The endpoint of the curve.
-> JSCanvas -> JS t ()
bezierCurveTo (a,b) (c,d) (e,f) =
invoke "bezierCurveTo" (a, b, c, d, e, f)
-- | Clears the rectangle given by its location and size.
clearRect :: (JSNumber,JSNumber) -- ^ The top left corner of the rectanlge to clear.
-> (JSNumber,JSNumber) -- ^ The width and height of the rectangle to clear.
-> JSCanvas -> JS t ()
clearRect (x,y) (w,h) = invoke "clearRect" (x, y, w, h)
-- | Clips a region of any shape and size from the context.
clip :: JSCanvas -> JS t ()
clip = invoke "clip" ()
-- | Closes the current path by drawing a straight line back to its beginning.
closePath :: JSCanvas -> JS t ()
closePath = invoke "closePath" ()
-- | Create a new image data object with the given size.
createImageData :: (JSNumber, JSNumber) -- ^ The width and hight of the new object.
-> JSCanvas -> JS t JSObject -- ^ Returns the new image data object.
createImageData (w,h) = invoke "createImageData" (w, h)
-- | Creates a new image data object with the same dimension as the given
-- image data object. This does not copy the contents of the other object.
createImageData' :: JSObject -- ^ The other image data object.
-> JSCanvas -> JS t JSObject -- ^ Returns the new image data object.
createImageData' imgData = invoke "createImageData" (imgData)
-- | Draws an image, video or canvas to the canvas.
drawImage :: JSObject -- ^ The graphical object to draw.
-> (JSNumber, JSNumber) -- ^ The x and y coordinate of the top left corner.
-> JSCanvas -> JS t ()
drawImage img (x,y) = invoke "drawImage" (img, x, y)
-- | Draws an image, video or canvas to the canvas.
drawImage' :: JSObject -- ^ The graphical object to draw.
-> (JSNumber, JSNumber) -- ^ The x and y coordinate of the top left corner.
-> (JSNumber, JSNumber) -- ^ The width and height to scale the image to.
-> JSCanvas -> JS t ()
drawImage' img (x,y) (w,h) =
invoke "drawImage" (img, x, y, w, h)
-- | Draws an image, video or canvas to the canvas. Clips the drawn object.
drawImageClip :: JSObject -- ^ The graphical object to draw.
-> (JSNumber, JSNumber) -- ^ The x and y coordinate of the top
-- left corner of the clippng area.
-> (JSNumber, JSNumber) -- ^ The width and height of the clipping area
-> (JSNumber, JSNumber) -- ^ The x and y coordinate of the top left corner.
-> (JSNumber, JSNumber) -- ^ The width and height to scale the image to.
-> JSCanvas -> JS t ()
drawImageClip img (cx, cy) (cw, ch) (x,y) (w,h) =
invoke "drawImage" ( img
, cx, cy
, cw, ch
, x, y
, w, h)
-- | Fills the current path with the current fill style.
fill :: JSCanvas -> JS t ()
fill = invoke "fill" ()
-- | Draws a filled rectangle given by its top left corner and size with the
-- current fill style.
fillRect :: (JSNumber,JSNumber) -- ^ The top left corner of the rectangle.
-> (JSNumber,JSNumber) -- ^ The width and height of the rectangle.
-> JSCanvas -> JS t ()
fillRect (x,y) (w,h) = invoke "fillRect" (x, y, w, h)
-- | Sets the fill style of the context. A color value of the form "#XXXXXX"
-- is expected.
setFillStyle :: JSString -> JSCanvas -> JS t ()
-- TODO: Add support for gradients and patterns.
setFillStyle fs = "fillStyle" := fs
-- | Fills a text with the current fill style.
fillText :: JSString -- ^ The text to fill.
-> (JSNumber,JSNumber) -- ^ The x and y position of the
-- bottom left corner of the text.
-> JSCanvas -> JS t ()
fillText s (x,y) = invoke "fillText" (s, x, y)
-- | Fills a text with the current fill style.
fillText' :: JSString -- ^ The text to fill.
-> (JSNumber, JSNumber) -- ^ The x and y position of the
-- bottom left corner of the text.
-> JSNumber -- ^ The maximum allowed width of the text.
-> JSCanvas -> JS t ()
fillText' s (x,y) maxW = invoke "fillText" (s, x, y, maxW)
-- | Sets the font used by the context.
setFont :: JSString -> JSCanvas -> JS t ()
setFont f = "font" := f
-- | Get the image data of the specified rectanlge of the canvas.
getImageData :: (JSNumber, JSNumber) -- ^ The x and y coordinate of the top left
-- corner of the rectangle to extract.
-> (JSNumber, JSNumber) -- ^ The width and height of the rectangle.
-> JSCanvas -> JS t JSObject -- ^ Returns the image data object
-- with the extracted information.
getImageData (x,y) (w,h) =
invoke "getImageData" (x, y, w , h)
-- | Sets the global alpha value.
setGlobalAlpha :: JSNumber -> JSCanvas -> JS t ()
setGlobalAlpha a = "globalAlpha" := a
-- | Returns true if the given point is in the path and false otherwise.
isPointInPath :: (JSNumber, JSNumber) -- ^ The x and y coordinate of the point to check
-> JSCanvas -> JS t JSBool
isPointInPath (x,y) = invoke "isPointInPath" (x, y)
-- | Sets the line cap style to use.
-- Possible values are: "butt", "round", "square";
setLineCap :: JSString -> JSCanvas -> JS t ()
setLineCap lc = "lineCap" := lc
-- | Sets the line join style to use.
-- Possible values are: "bevel", "round", "meter";
setLineJoin :: JSString -> JSCanvas -> JS t ()
setLineJoin lj = "lineJoin" := lj
-- | Create a straight line path from the current point to the given point.
lineTo :: (JSNumber,JSNumber) -- ^ The x and y location the line is drawn to.
-> JSCanvas -> JS t ()
lineTo (x,y) = invoke "lineTo" (x, y)
-- | Sets the line width used when stroking.
setLineWidth :: JSNumber -- ^ The line new line width in pixels.
-> JSCanvas -> JS t ()
setLineWidth lw = "lineWidth" := lw
-- | Returns the miter limit used when drawing a miter line join.
miterLimit :: JSSelector JSNumber
miterLimit = label $ string "miterLimit"
-- | Sets the miter limit used when drawing a miter line join.
setMiterLimit :: JSNumber -- ^ The new miter limit.
-> JSCanvas -> JS t ()
setMiterLimit ml = "miterLimit" := ml
-- | Returns an object that contains the width of the specified text is pixels.
-- See 'width' selector.
measureText :: JSString -- ^ The text to be measured.
-> JSCanvas -> JS t JSObject
measureText s = invoke "measureText" (s)
-- | Move the path to the given location.
moveTo :: (JSNumber,JSNumber) -- ^ The new x and y location of the path.
-> JSCanvas -> JS t ()
moveTo (x,y) = invoke "moveTo" (x, y)
-- | Uses the given image data to replace the rectangle of the
-- canvas at the given position.
putImageData :: JSObject -- ^ The new image data.
-> (JSNumber, JSNumber) -- ^ The x and y coordinate of the top left corner.
-> JSCanvas -> JS t ()
putImageData imgData (x,y) = invoke "putImageData" (imgData, x, y)
-- | Creates a rectangle in the current context.
rect :: (JSNumber,JSNumber) -- ^ The top left corner of the rectangle.
-> (JSNumber,JSNumber) -- ^ The width and height of the rectangle.
-> JSCanvas -> JS t ()
rect (x,y) (w,h) = invoke "rect" (x, y, w, h)
-- | Restores the last saved paths and state of the context.
restore :: JSCanvas -> JS t ()
restore = invoke "restore" ()
-- | Rotates the current drawing. The rotation will only affect drawings
-- made after the rotation.
rotate :: JSNumber -- ^ The rotation angle in radians.
-> JSCanvas -> JS t ()
rotate a = invoke "rotate" (a)
-- | Scales the current drawing.
scale :: (JSNumber,JSNumber) -- ^ The factors to scale the
-- width and the height with.
-> JSCanvas -> JS t ()
scale (sw,sh) = invoke "scale" (sw, sh)
-- | Saves the state of the current context.
save :: JSCanvas -> JS t ()
save = invoke "save" ()
-- | Resets the transformation matrix to identity and then applies
-- 'transform' with the given paramters to it.
setTransform :: JSNumber -- ^ Scales the drawings horizontally.
-> JSNumber -- ^ Skew the drawings horizontally.
-> JSNumber -- ^ Skew the drawings vertically.
-> JSNumber -- ^ Scales the drawings vertically.
-> JSNumber -- ^ Moves the drawings horizontally.
-> JSNumber -- ^ Moves the drawings vertically.
-> JSCanvas -> JS t ()
setTransform a b c d e f =
invoke "setTransform" (a, b, c, d, e, f)
-- | Sets the shadow color property.
-- The given string has to be a valid CSS color value or a
-- color of the form '#XXXXXX'
setShadowColor :: JSString -- ^ The color to use as shadow color.
-> JSCanvas -> JS t ()
setShadowColor c = "shadowColor" := c
-- | Sets the blur level for shadows.
setShadowBlur :: JSNumber -- ^ The blur level for the shadow in pixels.
-> JSCanvas -> JS t ()
setShadowBlur b = "shadowBlur" := b
-- | Sets the x offset of a shadow from a shape.
setShadowOffsetX :: JSNumber -- ^ The x offset of the shadow in pixels.
-> JSCanvas -> JS t ()
setShadowOffsetX x = "shadowOffsetX" := x
-- | Sets the y offset of a shadow from a shape.
setShadowOffsetY :: JSNumber -- ^ The y offset of the shadow in pixels.
-> JSCanvas -> JS t ()
setShadowOffsetY y = "shadowOffsetY" := y
-- | Draws the current path using the current stroke style.
stroke :: JSCanvas -> JS t ()
stroke = invoke "stroke" ()
-- | Strokes a rectanlge using the current stroke style.
strokeRect :: (JSNumber,JSNumber) -- ^ The x and y coordinate of the top left corner.
-> (JSNumber,JSNumber) -- ^ The width and height of the rectangle.
-> JSCanvas -> JS t ()
strokeRect (x,y) (w,h) = invoke "strokeRect" (x, y, w, h)
-- | Strokes a text using the current stroke style.
strokeText :: JSString -- ^ The text to stroke.
-> (JSNumber,JSNumber) -- ^ The x and y coordinate to stroke the text at.
-> JSCanvas -> JS t ()
strokeText s (x,y) = invoke "strokeText" (s, x, y)
-- | Sets the stroke style of the context. A color value of the form "#XXXXXX"
-- is expected.
setStrokeStyle :: JSString -> JSCanvas -> JS t ()
-- TODO: Add support for patterns and gradients.
setStrokeStyle c = "strokeStyle" := c
-- | Sets the text alignment to be used when drawing text.
-- Possible values are: "center", "end", "left", "right", "start"
setTextAlign :: JSString -> JSCanvas -> JS t ()
setTextAlign ta = "textAlign" := ta
-- | Sets the baseline to use when drawing text.
-- Possible values are: "alphabetic", "top", "hanging", "middle", "ideographic", "bottom"
setTextBaseline :: JSString -> JSCanvas -> JS t ()
setTextBaseline tb = "textBaseline" := tb
-- | Alters the current transformation matrix. The current one is
-- multiplied with one of the form:
-- @
-- a b c
-- d e f
-- 0 0 1
-- @
transform :: JSNumber -- ^ The 'a' value.
-> JSNumber -- ^ The 'b' value.
-> JSNumber -- ^ The 'c' value.
-> JSNumber -- ^ The 'd' value.
-> JSNumber -- ^ The 'e' value.
-> JSNumber -- ^ The 'f' value.
-> JSCanvas -> JS t ()
transform a b c d e f =
invoke "transform" (a, b, c, d, e, f)
-- | Translate the current drawing.
translate :: (JSNumber,JSNumber) -- ^ The x and y values to translate by.
-> JSCanvas -> JS t ()
translate (x,y) = invoke "translate" (x, y)
-- | Create a quadratic curve to extend the current path.
quadraticCurveTo :: (JSNumber, JSNumber) -- ^ The control point of the curve.
-> (JSNumber, JSNumber) -- ^ The endpoint of the curve.
-> JSCanvas -> JS t ()
quadraticCurveTo (cx, cy) (ex, ey) =
invoke "quadraticCurveTo" (cx, cy, ex, ey)
-- | Selects the width attribute.
width :: JSSelector JSNumber
width = attr "width"
-- | Selects the height attribute.
height :: JSSelector JSNumber
height = attr "height"
-- | Selects the data attribute.
data' :: JSSelector JSObject
data' = attr "data"
-- | Selects the global alpha attribute.
globalAlpha :: JSSelector JSNumber
globalAlpha = attr "globalAlpha"
-- | Selects the shadow color attribute.
shadowColor :: JSSelector JSString
shadowColor = attr "shadowColor"
-- | Selects the blur level for shadows.
shadowBlur :: JSSelector JSNumber
shadowBlur = attr "shadowBlur"
-- | Selects the x offset of a shadow from a shape.
shadowOffsetX :: JSSelector JSNumber
shadowOffsetX = attr "shadowOffsetX"
-- | Selects the y offset of a shadow from a shape.
shadowOffsetY :: JSSelector JSNumber
shadowOffsetY = attr "shadowOffsetY"
-- | Selects the stroke style of the context.
strokeStyle :: JSSelector JSString
-- TODO: Add support for patterns and gradients.
strokeStyle = attr "strokeStyle"
-- | Selects the text alignment to be used when drawing text.
-- Possible values are: "center", "end", "left", "right", "start"
textAlign :: JSSelector JSString
textAlign = attr "textAlign"
-- | Selects the baseline to use when drawing text.
-- Possible values are: "alphabetic", "top", "hanging", "middle", "ideographic", "bottom"
textBaseline :: JSSelector JSString
textBaseline = attr "textBaseline"
-- | Sets the line cap style to use.
-- Possible values are: "butt", "round", "square";
lineCap :: JSSelector JSString
lineCap = attr "lineCap"
-- | Selects the line join style to use.
-- Possible values are: "bevel", "round", "meter";
lineJoin :: JSSelector JSString
lineJoin = attr "lineJoin"
-- | Selects the line width used when stroking.
lineWidth :: JSSelector JSNumber
lineWidth = attr "lineWidth"
-- | Selects the font used by the context.
font :: JSSelector JSString
font = attr "font"