{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} -- | Provides bindings to the Javascript API of the -- HTML5 canvas element. -- -- See . 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"