{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Graphics.Blank.Generated where

import           Data.Text (Text)

import           Graphics.Blank.Canvas
import           Graphics.Blank.JavaScript
import           Graphics.Blank.Types
import           Graphics.Blank.Types.Font

import           Prelude.Compat

import           TextShow (TextShow(..), FromTextShow(..), showb, singleton)

instance Show Method where
  showsPrec :: Int -> Method -> ShowS
showsPrec Int
p = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> FromTextShow a
FromTextShow

instance TextShow Method where
  showb :: Method -> Builder
showb (Arc (Double
a1,Double
a2,Double
a3,Double
a4,Double
a5,Bool
a6)) = Builder
"arc("
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a3 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a4 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a5 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Bool -> Builder
jsBool Bool
a6   forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (ArcTo (Double
a1,Double
a2,Double
a3,Double
a4,Double
a5)) = Builder
"arcTo("
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a3 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a4 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a5 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb Method
BeginPath = Builder
"beginPath()"
  showb (BezierCurveTo (Double
a1,Double
a2,Double
a3,Double
a4,Double
a5,Double
a6)) = Builder
"bezierCurveTo("
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a3 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a4 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a5 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a6 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (ClearRect (Double
a1,Double
a2,Double
a3,Double
a4)) = Builder
"clearRect("
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a3 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a4 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb Method
Clip = Builder
"clip()"
  showb Method
ClosePath = Builder
"closePath()"
  showb (DrawImage (image
a1,[Double]
a2)) = Builder
"drawImage(" forall a. Semigroup a => a -> a -> a
<> forall a. Image a => a -> Builder
jsImage image
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Builder) -> [a] -> Builder
jsList Double -> Builder
jsDouble [Double]
a2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb Method
Fill = Builder
"fill()"
  showb (FillRect (Double
a1,Double
a2,Double
a3,Double
a4)) = Builder
"fillRect("
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a3 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a4 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (FillStyle (style
a1)) = Builder
"fillStyle = (" forall a. Semigroup a => a -> a -> a
<> forall a. Style a => a -> Builder
jsStyle style
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (FillText (Text
a1,Double
a2,Double
a3)) = Builder
"fillText(" forall a. Semigroup a => a -> a -> a
<> Text -> Builder
jsText Text
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a3 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (Font (canvasFont
a1)) = Builder
"font = (" forall a. Semigroup a => a -> a -> a
<> forall a. CanvasFont a => a -> Builder
jsCanvasFont canvasFont
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (GlobalAlpha (Double
a1)) = Builder
"globalAlpha = (" forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (GlobalCompositeOperation (Text
a1)) = Builder
"globalCompositeOperation = (" forall a. Semigroup a => a -> a -> a
<> Text -> Builder
jsText Text
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (LineCap (LineEndCap
a1)) = Builder
"lineCap = (" forall a. Semigroup a => a -> a -> a
<> LineEndCap -> Builder
jsLineEndCap LineEndCap
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (LineJoin (LineJoinCorner
a1)) = Builder
"lineJoin = (" forall a. Semigroup a => a -> a -> a
<> LineJoinCorner -> Builder
jsLineJoinCorner LineJoinCorner
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (LineTo (Double
a1,Double
a2)) = Builder
"lineTo(" forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (LineWidth (Double
a1)) = Builder
"lineWidth = (" forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (MiterLimit (Double
a1)) = Builder
"miterLimit = (" forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (MoveTo (Double
a1,Double
a2)) = Builder
"moveTo(" forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (PutImageData (ImageData
a1,[Double]
a2)) = Builder
"putImageData(" forall a. Semigroup a => a -> a -> a
<> ImageData -> Builder
jsImageData ImageData
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Builder) -> [a] -> Builder
jsList Double -> Builder
jsDouble [Double]
a2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (QuadraticCurveTo (Double
a1,Double
a2,Double
a3,Double
a4)) = Builder
"quadraticCurveTo("
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a3 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a4 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (Rect (Double
a1,Double
a2,Double
a3,Double
a4)) = Builder
"rect("
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a3 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a4 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb Method
Restore = Builder
"restore()"
  showb (Rotate (Double
a1)) = Builder
"rotate(" forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb Method
Save = Builder
"save()"
  showb (Scale (Double
a1,Double
a2)) = Builder
"scale(" forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (SetTransform (Double
a1,Double
a2,Double
a3,Double
a4,Double
a5,Double
a6)) = Builder
"setTransform("
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a3 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a4 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a5 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a6 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (ShadowBlur (Double
a1)) = Builder
"shadowBlur = (" forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (ShadowColor (canvasColor
a1)) = Builder
"shadowColor = (" forall a. Semigroup a => a -> a -> a
<> forall color. CanvasColor color => color -> Builder
jsCanvasColor canvasColor
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (ShadowOffsetX (Double
a1)) = Builder
"shadowOffsetX = (" forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (ShadowOffsetY (Double
a1)) = Builder
"shadowOffsetY = (" forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb Method
Stroke = Builder
"stroke()"
  showb (StrokeRect (Double
a1,Double
a2,Double
a3,Double
a4)) = Builder
"strokeRect("
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a3 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a4 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (StrokeStyle (style
a1)) = Builder
"strokeStyle = (" forall a. Semigroup a => a -> a -> a
<> forall a. Style a => a -> Builder
jsStyle style
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (StrokeText (Text
a1,Double
a2,Double
a3)) = Builder
"strokeText(" forall a. Semigroup a => a -> a -> a
<> Text -> Builder
jsText Text
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a3 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (TextAlign (TextAnchorAlignment
a1)) = Builder
"textAlign = (" forall a. Semigroup a => a -> a -> a
<> TextAnchorAlignment -> Builder
jsTextAnchorAlignment TextAnchorAlignment
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (TextBaseline (TextBaselineAlignment
a1)) = Builder
"textBaseline = (" forall a. Semigroup a => a -> a -> a
<> TextBaselineAlignment -> Builder
jsTextBaselineAlignment TextBaselineAlignment
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (Transform (Double
a1,Double
a2,Double
a3,Double
a4,Double
a5,Double
a6)) = Builder
"transform("
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a3 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a4 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a5 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a6 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (Translate (Double
a1,Double
a2)) = Builder
"translate(" forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
a2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'

-- DSL

-- | @'arc'(x, y, r, sAngle, eAngle, cc)@ creates a circular arc, where
--
-- * @x@ is the x-coordinate of the center of the circle
--
-- * @y@ is the y-coordinate of the center of the circle
--
-- * @r@ is the radius of the circle on which the arc is drawn
--
-- * @sAngle@ is the starting angle (where @0@ at the 3 o'clock position of the circle)
--
-- * @eAngle@ is the ending angle
--
-- * @cc@ is the arc direction, where @True@ indicates counterclockwise and
--   @False@ indicates clockwise.
arc :: (Double, Double, Double, Radians, Radians, Bool) -> Canvas ()
arc :: (Double, Double, Double, Double, Double, Bool) -> Canvas ()
arc = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double, Double, Double, Double, Bool) -> Method
Arc

-- | @'arcTo'(x1, y1, x2, y2, r)@ creates an arc between two tangents,
-- specified by two control points and a radius.
--
-- * @x1@ is the x-coordinate of the first control point
--
-- * @y1@ is the y-coordinate of the first control point
--
-- * @x2@ is the x-coordinate of the second control point
--
-- * @y2@ is the y-coordinate of the second control point
--
-- * @r@ is the arc's radius
arcTo :: (Double, Double, Double, Double, Double) -> Canvas ()
arcTo :: (Double, Double, Double, Double, Double) -> Canvas ()
arcTo = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double, Double, Double, Double) -> Method
ArcTo

-- | Begins drawing a new path. This will empty the current list of subpaths.
--
-- ==== __Example__
--
-- @
-- 'beginPath'()
-- 'moveTo'(20, 20)
-- 'lineTo'(200, 20)
-- 'stroke'()
-- @
beginPath :: () -> Canvas ()
beginPath :: () -> Canvas ()
beginPath () = Method -> Canvas ()
Method Method
BeginPath

-- | @'bezierCurveTo'(cp1x, cp1y, cp2x, cp2y x, y)@ adds a cubic Bézier curve to the path
-- (whereas 'quadraticCurveTo' adds a quadratic Bézier curve).
--
-- * @cp1x@ is the x-coordinate of the first control point
--
-- * @cp1y@ is the y-coordinate of the first control point
--
-- * @cp2x@ is the x-coordinate of the second control point
--
-- * @cp2y@ is the y-coordinate of the second control point
--
-- * @x@ is the x-coordinate of the end point
--
-- * @y@ is the y-coordinate of the end point
bezierCurveTo :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
bezierCurveTo :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
bezierCurveTo = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double, Double, Double, Double, Double) -> Method
BezierCurveTo

-- | @'clearRect'(x, y, w, h)@ clears all pixels within the rectangle with upper-left
-- corner @(x, y)@, width @w@, and height @h@ (i.e., sets the pixels to transparent black).
--
-- ==== __Example__
--
-- @
-- 'fillStyle' \"red\"
-- 'fillRect'(0, 0, 300, 150)
-- 'clearRect'(20, 20, 100, 50)
-- @
clearRect :: (Double, Double, Double, Double) -> Canvas ()
clearRect :: (Double, Double, Double, Double) -> Canvas ()
clearRect = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double, Double, Double) -> Method
ClearRect

-- | Turns the path currently being built into the current clipping path.
-- Anything drawn after 'clip' is called will only be visible if inside the new
-- clipping path.
--
-- ==== __Example__
--
-- @
-- 'rect'(50, 20, 200, 120)
-- 'stroke'()
-- 'clip'()
-- 'fillStyle' \"red\"
-- 'fillRect'(0, 0, 150, 100)
-- @
clip :: () -> Canvas ()
clip :: () -> Canvas ()
clip () = Method -> Canvas ()
Method Method
Clip

-- | Creates a path from the current point back to the start, to close it.
--
-- ==== __Example__
--
-- @
-- 'beginPath'()
-- 'moveTo'(20, 20)
-- 'lineTo'(200, 20)
-- 'lineTo'(120, 120)
-- 'closePath'()
-- 'stroke'()
-- @
closePath :: () -> Canvas ()
closePath :: () -> Canvas ()
closePath () = Method -> Canvas ()
Method Method
ClosePath

-- | drawImage' takes 2, 4, or 8 'Double' arguments. See 'drawImageAt', 'drawImageSize', and 'drawImageCrop' for variants with exact numbers of arguments.
drawImage :: Image image => (image,[Double]) -> Canvas ()
drawImage :: forall image. Image image => (image, [Double]) -> Canvas ()
drawImage = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall image. Image image => (image, [Double]) -> Method
DrawImage

-- | Fills the current path with the current 'fillStyle'.
--
-- ==== __Example__
--
-- @
-- 'rect'(10, 10, 100, 100)
-- 'fill'()
-- @
fill :: () -> Canvas ()
fill :: () -> Canvas ()
fill () = Method -> Canvas ()
Method Method
Fill

-- | @'fillRect'(x, y, w, h)@ draws a filled rectangle with upper-left
-- corner @(x, y)@, width @w@, and height @h@ using the current 'fillStyle'.
--
-- ==== __Example__
--
-- @
-- 'fillStyle' \"red\"
-- 'fillRect'(0, 0, 300, 150)
-- @
fillRect :: (Double, Double, Double, Double) -> Canvas ()
fillRect :: (Double, Double, Double, Double) -> Canvas ()
fillRect = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double, Double, Double) -> Method
FillRect

-- | Sets the color, gradient, or pattern used to fill a drawing ('black' by default).
--
-- ==== __Examples__
--
-- @
-- 'fillStyle' 'red'
--
-- grd <- 'createLinearGradient'(0, 0, 10, 10)
-- 'fillStyle' grd
--
-- img <- 'newImage' \"/myImage.jpg\"
-- pat <- 'createPattern'(img, 'Repeat')
-- 'fillStyle' pat
-- @
fillStyle :: Style style => style -> Canvas ()
fillStyle :: forall style. Style style => style -> Canvas ()
fillStyle = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall style. Style style => style -> Method
FillStyle

-- | @'fillText'(t, x, y)@ fills the text @t@ at position @(x, y)@
-- using the current 'fillStyle'.
--
-- ==== __Example__
--
-- @
-- 'font' \"48px serif\"
-- 'fillText'(\"Hello, World!\", 50, 100)
-- @
fillText :: (Text, Double, Double) -> Canvas ()
fillText :: (Text, Double, Double) -> Canvas ()
fillText = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Double, Double) -> Method
FillText

-- | Sets the text context's font properties.
--
-- ==== __Examples__
--
-- @
-- 'font' ('defFont' "Gill Sans Extrabold") { 'fontSize' = 40 # 'pt' }
-- 'font' ('defFont' 'sansSerif') { 'fontSize' = 80 # 'percent' }
-- 'font' ('defFont' 'serif') {
--     'fontWeight' = 'bold'
--   , 'fontStyle'  = 'italic'
--   , 'fontSize'   = 'large'
-- }
-- @
font :: CanvasFont canvasFont => canvasFont -> Canvas ()
font :: forall canvasFont. CanvasFont canvasFont => canvasFont -> Canvas ()
font = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall canvasFont. CanvasFont canvasFont => canvasFont -> Method
Font

-- | Set the alpha value that is applied to shapes before they are drawn onto the canvas.
globalAlpha :: Alpha -> Canvas ()
globalAlpha :: Double -> Canvas ()
globalAlpha = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Method
GlobalAlpha

-- | Sets how new shapes should be drawn over existing shapes.
--
-- ==== __Examples__
--
-- @
-- 'globalCompositeOperation' \"source-over\"
-- 'globalCompositeOperation' \"destination-atop\"
-- @
globalCompositeOperation :: Text -> Canvas ()
globalCompositeOperation :: Text -> Canvas ()
globalCompositeOperation = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Method
GlobalCompositeOperation

-- | Sets the 'LineEndCap' to use when drawing the endpoints of lines.
lineCap :: LineEndCap -> Canvas ()
lineCap :: LineEndCap -> Canvas ()
lineCap = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineEndCap -> Method
LineCap

-- | Sets the 'LineJoinCorner' to use when drawing two connected lines.
lineJoin :: LineJoinCorner -> Canvas ()
lineJoin :: LineJoinCorner -> Canvas ()
lineJoin = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineJoinCorner -> Method
LineJoin

-- | @'lineTo'(x, y)@ connects the last point in the subpath to the given @(x, y)@
-- coordinates (without actually drawing it).
--
-- ==== __Example__
--
-- @
-- 'beginPath'()
-- 'moveTo'(50, 50)
-- 'lineTo'(200, 50)
-- 'stroke'()
-- @
lineTo :: (Double, Double) -> Canvas ()
lineTo :: (Double, Double) -> Canvas ()
lineTo = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double) -> Method
LineTo

-- | Sets the thickness of lines in pixels (@1.0@ by default).
lineWidth :: Double -> Canvas ()
lineWidth :: Double -> Canvas ()
lineWidth = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Method
LineWidth

-- | Sets the maximum miter length (@10.0@ by default) to use when the
-- 'lineWidth' is 'miter'.
miterLimit :: Double -> Canvas ()
miterLimit :: Double -> Canvas ()
miterLimit = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Method
MiterLimit

-- | @'moveTo'(x, y)@ moves the starting point of a new subpath to the given @(x, y)@ coordinates.
--
-- ==== __Example__
--
-- @
-- 'beginPath'()
-- 'moveTo'(50, 50)
-- 'lineTo'(200, 50)
-- 'stroke'()
-- @
moveTo :: (Double, Double) -> Canvas ()
moveTo :: (Double, Double) -> Canvas ()
moveTo = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double) -> Method
MoveTo

-- | 'putImageData' takes 2 or 6 'Double' arguments. See `putImageDataAt' and `putImageDataDirty' for variants with exact numbers of arguments.
putImageData :: (ImageData, [Double]) -> Canvas ()
putImageData :: (ImageData, [Double]) -> Canvas ()
putImageData = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ImageData, [Double]) -> Method
PutImageData

-- | @'quadraticCurveTo'(cpx, cpy, x, y)@ adds a quadratic Bézier curve to the path
-- (whereas 'bezierCurveTo' adds a cubic Bézier curve).
--
-- * @cpx@ is the x-coordinate of the control point
--
-- * @cpy@ is the y-coordinate of the control point
--
-- * @x@ is the x-coordinate of the end point
--
-- * @y@ is the y-coordinate of the end point
quadraticCurveTo :: (Double, Double, Double, Double) -> Canvas ()
quadraticCurveTo :: (Double, Double, Double, Double) -> Canvas ()
quadraticCurveTo = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double, Double, Double) -> Method
QuadraticCurveTo

-- | @'rect'(x, y, w, h)@ creates a rectangle with an upper-left corner at position
-- @(x, y)@, width @w@, and height @h@ (where width and height are in pixels).
--
-- ==== __Example__
--
-- @
-- 'rect'(10, 10, 100, 100)
-- 'fill'()
-- @
rect :: (Double, Double, Double, Double) -> Canvas ()
rect :: (Double, Double, Double, Double) -> Canvas ()
rect = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double, Double, Double) -> Method
Rect

-- | Restores the most recently saved canvas by popping the top entry off of the
-- drawing state stack. If there is no state, do nothing.
restore :: () -> Canvas ()
restore :: () -> Canvas ()
restore () = Method -> Canvas ()
Method Method
Restore

-- | Applies a rotation transformation to the canvas. When you call functions
-- such as 'fillRect' after 'rotate', the drawings will be rotated clockwise by
-- the angle given to 'rotate' (in radians).
--
-- ==== __Example__
--
-- @
-- 'rotate' ('pi'/2)        -- Rotate the canvas 90°
-- 'fillRect'(0, 0, 20, 10) -- Draw a 10x20 rectangle
-- @
rotate :: Radians -> Canvas ()
rotate :: Double -> Canvas ()
rotate = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Method
Rotate

-- | Saves the entire canvas by pushing the current state onto a stack.
save :: () -> Canvas ()
save :: () -> Canvas ()
save () = Method -> Canvas ()
Method Method
Save

-- | Applies a scaling transformation to the canvas units, where the first argument
-- is the percent to scale horizontally, and the second argument is the percent to
-- scale vertically. By default, one canvas unit is one pixel.
--
-- ==== __Examples__
--
-- @
-- 'scale'(0.5, 0.5)        -- Halve the canvas units
-- 'fillRect'(0, 0, 20, 20) -- Draw a 10x10 square
-- 'scale'(-1, 1)           -- Flip the context horizontally
-- @
scale :: (Interval, Interval) -> Canvas ()
scale :: (Double, Double) -> Canvas ()
scale = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double) -> Method
Scale

-- | Resets the canvas's transformation matrix to the identity matrix,
-- then calls 'transform' with the given arguments.
setTransform :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
setTransform :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
setTransform = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double, Double, Double, Double, Double) -> Method
SetTransform

-- | Sets the blur level for shadows (@0.0@ by default).
shadowBlur :: Double -> Canvas ()
shadowBlur :: Double -> Canvas ()
shadowBlur = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Method
ShadowBlur

-- | Sets the color used for shadows.
--
-- ==== __Examples__
--
-- @
-- 'shadowColor' 'red'
-- 'shadowColor' $ 'rgb' 0 255 0
-- @
shadowColor :: CanvasColor canvasColor => canvasColor -> Canvas ()
shadowColor :: forall canvasColor.
CanvasColor canvasColor =>
canvasColor -> Canvas ()
shadowColor = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall canvasColor.
CanvasColor canvasColor =>
canvasColor -> Method
ShadowColor

-- | Sets the horizontal distance that a shadow will be offset (@0.0@ by default).
shadowOffsetX :: Double -> Canvas ()
shadowOffsetX :: Double -> Canvas ()
shadowOffsetX = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Method
ShadowOffsetX

-- | Sets the vertical distance that a shadow will be offset (@0.0@ by default).
shadowOffsetY :: Double -> Canvas ()
shadowOffsetY :: Double -> Canvas ()
shadowOffsetY = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Method
ShadowOffsetY

-- | Draws the current path's strokes with the current 'strokeStyle' ('black' by default).
--
-- ==== __Example__
--
-- @
-- 'rect'(10, 10, 100, 100)
-- 'stroke'()
-- @
stroke :: () -> Canvas ()
stroke :: () -> Canvas ()
stroke () = Method -> Canvas ()
Method Method
Stroke

-- | @'strokeRect'(x, y, w, h)@ draws a rectangle (no fill) with upper-left
-- corner @(x, y)@, width @w@, and height @h@ using the current 'strokeStyle'.
--
-- ==== __Example__
--
-- @
-- 'strokeStyle' \"red\"
-- 'strokeRect'(0, 0, 300, 150)
-- @
strokeRect :: (Double, Double, Double, Double) -> Canvas ()
strokeRect :: (Double, Double, Double, Double) -> Canvas ()
strokeRect = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double, Double, Double) -> Method
StrokeRect

-- | Sets the color, gradient, or pattern used for strokes.
--
-- ==== __Examples__
--
-- @
-- 'strokeStyle' 'red'
--
-- grd <- 'createLinearGradient'(0, 0, 10, 10)
-- 'strokeStyle' grd
--
-- img <- 'newImage' \"/myImage.jpg\"
-- pat <- 'createPattern'(img, 'Repeat')
-- 'strokeStyle' pat
-- @
strokeStyle :: Style style => style -> Canvas ()
strokeStyle :: forall style. Style style => style -> Canvas ()
strokeStyle = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall style. Style style => style -> Method
StrokeStyle

-- | @'strokeText'(t, x, y)@ draws text @t@ (with no fill) at position @(x, y)@
-- using the current 'strokeStyle'.
--
-- ==== __Example__
--
-- @
-- 'font' \"48px serif\"
-- 'strokeText'(\"Hello, World!\", 50, 100)
-- @
strokeText :: (Text,Double, Double) -> Canvas ()
strokeText :: (Text, Double, Double) -> Canvas ()
strokeText = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Double, Double) -> Method
StrokeText

-- | Sets the 'TextAnchorAlignment' to use when drawing text.
textAlign :: TextAnchorAlignment -> Canvas ()
textAlign :: TextAnchorAlignment -> Canvas ()
textAlign = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextAnchorAlignment -> Method
TextAlign

-- | Sets the 'TextBaselineAlignment' to use when drawing text.
textBaseline :: TextBaselineAlignment -> Canvas ()
textBaseline :: TextBaselineAlignment -> Canvas ()
textBaseline = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextBaselineAlignment -> Method
TextBaseline

-- | Applies a transformation by multiplying a matrix to the canvas's
-- current transformation. If @'transform'(a, b, c, d, e, f)@ is called, the matrix
--
-- @
-- ( a c e )
-- ( b d f )
-- ( 0 0 1 )
-- @
--
-- is multiplied by the current transformation. The parameters are:
--
-- * @a@ is the horizontal scaling
--
-- * @b@ is the horizontal skewing
--
-- * @c@ is the vertical skewing
--
-- * @d@ is the vertical scaling
--
-- * @e@ is the horizontal movement
--
-- * @f@ is the vertical movement
transform :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
transform :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
transform = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double, Double, Double, Double, Double) -> Method
Transform

-- | Applies a translation transformation by remapping the origin (i.e., the (0,0)
-- position) on the canvas. When you call functions such as 'fillRect' after
-- 'translate', the values passed to 'translate' are added to the x- and
-- y-coordinate values.
--
-- ==== __Example__
--
-- @
-- 'translate'(20, 20)
-- 'fillRect'(0, 0, 40, 40) -- Draw a 40x40 square, starting in position (20, 20)
-- @
translate :: (Double, Double) -> Canvas ()
translate :: (Double, Double) -> Canvas ()
translate = Method -> Canvas ()
Method forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double) -> Method
Translate