{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

module Graphics.Blank.Canvas where

import           Control.Monad (ap, liftM2)

import           Data.Aeson (FromJSON(..),Value(..),encode)
import           Data.Aeson.Types (Parser, (.:))
import           Data.Text (Text)
import           Data.Text.Lazy.Builder
import           Data.Text.Lazy.Encoding (decodeUtf8)

import           Graphics.Blank.Events
import           Graphics.Blank.JavaScript
import           Graphics.Blank.Types
import           Graphics.Blank.Types.Cursor
import           Graphics.Blank.Types.Font

import           Prelude.Compat

import           TextShow
import           TextShow.TH (deriveTextShow)

data DeviceAttributes = DeviceAttributes Int Int Double deriving Int -> DeviceAttributes -> ShowS
[DeviceAttributes] -> ShowS
DeviceAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeviceAttributes] -> ShowS
$cshowList :: [DeviceAttributes] -> ShowS
show :: DeviceAttributes -> String
$cshow :: DeviceAttributes -> String
showsPrec :: Int -> DeviceAttributes -> ShowS
$cshowsPrec :: Int -> DeviceAttributes -> ShowS
Show
$(deriveTextShow ''DeviceAttributes)

-- | The 'width' argument of 'TextMetrics' can trivially be projected out.
data TextMetrics = TextMetrics Double deriving Int -> TextMetrics -> ShowS
[TextMetrics] -> ShowS
TextMetrics -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextMetrics] -> ShowS
$cshowList :: [TextMetrics] -> ShowS
show :: TextMetrics -> String
$cshow :: TextMetrics -> String
showsPrec :: Int -> TextMetrics -> ShowS
$cshowsPrec :: Int -> TextMetrics -> ShowS
Show
$(deriveTextShow ''TextMetrics)

-----------------------------------------------------------------------------

data Canvas :: * -> * where
        Method    :: Method                      -> Canvas ()     -- <context>.<method>
        Command   :: Command                     -> Canvas ()     -- <command>
        Function  :: TextShow a => Function a    -> Canvas a
        Query     :: TextShow a => Query a       -> Canvas a
        With      :: CanvasContext -> Canvas a   -> Canvas a
        MyContext ::                                Canvas CanvasContext
        Bind      :: Canvas a -> (a -> Canvas b) -> Canvas b
        Return    :: a                           -> Canvas a

instance Monad Canvas where
#if !(MIN_VERSION_base(4,11,0))
        return = Return
#endif
        >>= :: forall a b. Canvas a -> (a -> Canvas b) -> Canvas b
(>>=) = forall a b. Canvas a -> (a -> Canvas b) -> Canvas b
Bind

instance Applicative Canvas where
  pure :: forall a. a -> Canvas a
pure  = forall a. a -> Canvas a
Return
  <*> :: forall a b. Canvas (a -> b) -> Canvas a -> Canvas b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Functor Canvas where
  fmap :: forall a b. (a -> b) -> Canvas a -> Canvas b
fmap a -> b
f Canvas a
c = Canvas a
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

instance Semigroup a => Semigroup (Canvas a) where
  <> :: Canvas a -> Canvas a -> Canvas a
(<>) = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. Semigroup a => a -> a -> a
(<>)

instance Monoid a => Monoid (Canvas a) where
#if !(MIN_VERSION_base(4,11,0))
  mappend = liftM2 mappend
#endif
  mempty :: Canvas a
mempty  = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty

-- HTML5 Canvas assignments: FillStyle, Font, GlobalAlpha, GlobalCompositeOperation, LineCap, LineJoin, LineWidth, MiterLimit, ShadowBlur, ShadowColor, ShadowOffsetX, ShadowOffsetY, StrokeStyle, TextAlign, TextBaseline
data Method
        -- regular HTML5 canvas commands
        = Arc (Double, Double, Double, Radians, Radians, Bool)
        | ArcTo (Double, Double, Double, Double, Double)
        | BeginPath
        | BezierCurveTo (Double, Double, Double, Double, Double, Double)
        | ClearRect (Double, Double, Double, Double)
        | Clip
        | ClosePath
        | forall image . Image image => DrawImage (image,[Double]) -- drawImage' takes 2, 4, or 8 'Double' arguments. See 'drawImageAt', 'drawImageSize', and 'drawImageCrop' for variants with exact numbers of arguments.
        | Fill
        | FillRect (Double, Double, Double, Double)
        | forall style . Style style => FillStyle style
        | FillText (Text, Double, Double)
        | forall canvasFont . CanvasFont canvasFont => Font canvasFont
        | GlobalAlpha Alpha
        | GlobalCompositeOperation Text
        | LineCap LineEndCap
        | LineJoin LineJoinCorner
        | LineTo (Double, Double)
        | LineWidth Double
        | MiterLimit Double
        | MoveTo (Double, Double)
        | PutImageData (ImageData, [Double]) -- 'putImageData' takes 2 or 6 'Double' arguments. See `putImageDataAt' and `putImageDataDirty' for variants with exact numbers of arguments.
        | QuadraticCurveTo (Double, Double, Double, Double)
        | Rect (Double, Double, Double, Double)
        | Restore
        | Rotate Radians
        | Save
        | Scale (Interval, Interval)
        | SetTransform (Double, Double, Double, Double, Double, Double)
        | ShadowBlur Double
        | forall canvasColor . CanvasColor canvasColor => ShadowColor canvasColor
        | ShadowOffsetX Double
        | ShadowOffsetY Double
        | Stroke
        | StrokeRect (Double, Double, Double, Double)
        | forall style . Style style => StrokeStyle style
        | StrokeText (Text,Double, Double)
        | TextAlign TextAnchorAlignment
        | TextBaseline TextBaselineAlignment
        | Transform (Double, Double, Double, Double, Double, Double)
        | Translate (Double, Double)

data Command
  = Trigger Event
  | forall color . CanvasColor color => AddColorStop (Interval, color) CanvasGradient
  | forall msg . JSArg msg => Log msg
  | Eval Text

instance Show Command where
  showsPrec :: Int -> Command -> 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 Command where
  showb :: Command -> Builder
showb (Trigger Event
e) = Builder
"Trigger(" forall a. Semigroup a => a -> a -> a
<> (Text -> Builder
fromLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode Event
e) forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (AddColorStop (Double
off,color
rep) CanvasGradient
g) = CanvasGradient -> Builder
jsCanvasGradient CanvasGradient
g forall a. Semigroup a => a -> a -> a
<> Builder
".addColorStop("
         forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
off forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> forall color. CanvasColor color => color -> Builder
jsCanvasColor color
rep
         forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (Log msg
msg) = Builder
"console.log(" forall a. Semigroup a => a -> a -> a
<> forall a. JSArg a => a -> Builder
showbJS msg
msg forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (Eval Text
cmd) = Text -> Builder
fromText Text
cmd -- no escaping or interpretation

-----------------------------------------------------------------------------

-- | 'with' runs a set of canvas commands in the context
-- of a specific canvas buffer.
with :: CanvasContext -> Canvas a -> Canvas a
with :: forall a. CanvasContext -> Canvas a -> Canvas a
with = forall a. CanvasContext -> Canvas a -> Canvas a
With

-- | 'myCanvasContext' returns the current 'CanvasContext'.
myCanvasContext :: Canvas CanvasContext
myCanvasContext :: Canvas CanvasContext
myCanvasContext = Canvas CanvasContext
MyContext

-----------------------------------------------------------------------------

-- | Triggers a specific named event.
trigger :: Event -> Canvas ()
trigger :: Event -> Canvas ()
trigger = Command -> Canvas ()
Command forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Command
Trigger

-- | Adds a color and stop position in a 'CanvasGradient'. A stop position is a
-- number between 0.0 and 1.0 that represents the position between start and stop
-- in a gradient.
--
-- ==== __Example__
--
-- @
-- grd <- 'createLinearGradient'(0, 0, 10, 10)
-- grd # 'addColorStop'(0, 'red')
-- @
addColorStop :: CanvasColor color => (Interval, color) -> CanvasGradient -> Canvas ()
addColorStop :: forall color.
CanvasColor color =>
(Double, color) -> CanvasGradient -> Canvas ()
addColorStop (Double
off,color
rep) = Command -> Canvas ()
Command forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall color.
CanvasColor color =>
(Double, color) -> CanvasGradient -> Command
AddColorStop (Double
off,color
rep)

-- | 'console_log' aids debugging by sending the argument to the browser @console.log@.
console_log :: JSArg msg => msg -> Canvas ()
console_log :: forall msg. JSArg msg => msg -> Canvas ()
console_log = Command -> Canvas ()
Command forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall msg. JSArg msg => msg -> Command
Log

-- | 'eval' executes the argument in JavaScript directly.
eval :: Text -> Canvas ()
eval :: Text -> Canvas ()
eval = Command -> Canvas ()
Command forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Command
Eval

-----------------------------------------------------------------------------

data Function :: * -> * where
  CreateLinearGradient :: (Double,Double,Double,Double)               -> Function CanvasGradient
  CreateRadialGradient :: (Double,Double,Double,Double,Double,Double) -> Function CanvasGradient
  CreatePattern        :: Image image => (image, RepeatDirection)     -> Function CanvasPattern


instance Show (Function a) where
  showsPrec :: Int -> Function a -> 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 (Function a) where
  showb :: Function a -> Builder
showb (CreateLinearGradient (Double
x0,Double
y0,Double
x1,Double
y1)) = Builder
"createLinearGradient("
        forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
x0 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
y0 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
        forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
x1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
y1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (CreateRadialGradient (Double
x0,Double
y0,Double
r0,Double
x1,Double
y1,Double
r1)) = Builder
"createRadialGradient("
        forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
x0 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
y0 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
r0 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
        forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
x1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
y1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
r1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (CreatePattern (image
img,RepeatDirection
dir)) = Builder
"createPattern("
        forall a. Semigroup a => a -> a -> a
<> forall a. Image a => a -> Builder
jsImage image
img forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> RepeatDirection -> Builder
jsRepeatDirection RepeatDirection
dir forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'

-----------------------------------------------------------------------------

data Query :: * -> * where
        Device               ::                                            Query DeviceAttributes
        ToDataURL            ::                                            Query Text
        MeasureText          :: Text                                    -> Query TextMetrics
        IsPointInPath        :: (Double, Double)                        -> Query Bool
        NewImage             :: Text                                    -> Query CanvasImage
        NewAudio             :: Text                                    -> Query CanvasAudio
        NewCanvas            :: (Int, Int)                              -> Query CanvasContext
        GetImageData         :: (Double, Double, Double, Double)        -> Query ImageData
        Cursor               :: CanvasCursor cursor => cursor           -> Query ()
        Sync                 ::                                            Query ()

instance Show (Query a) where
  showsPrec :: Int -> Query a -> 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 (Query a) where
  showb :: Query a -> Builder
showb Query a
Device                       = Builder
"Device"
  showb Query a
ToDataURL                    = Builder
"ToDataURL"
  showb (MeasureText Text
txt)            = Builder
"MeasureText(" forall a. Semigroup a => a -> a -> a
<> Text -> Builder
jsText Text
txt forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (IsPointInPath (Double
x,Double
y))        = Builder
"IsPointInPath(" forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
x forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
                                                        forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
y forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (NewImage Text
url')              = Builder
"NewImage(" forall a. Semigroup a => a -> a -> a
<> Text -> Builder
jsText Text
url' forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (NewAudio Text
txt)               = Builder
"NewAudio(" forall a. Semigroup a => a -> a -> a
<> Text -> Builder
jsText Text
txt  forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'

  showb (NewCanvas (Int
x,Int
y))            = Builder
"NewCanvas(" forall a. Semigroup a => a -> a -> a
<> Int -> Builder
jsInt Int
x forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
                                                    forall a. Semigroup a => a -> a -> a
<> Int -> Builder
jsInt Int
y forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (GetImageData (Double
sx,Double
sy,Double
sw,Double
sh)) = Builder
"GetImageData(" forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
sx forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
                                                       forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
sy forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
                                                       forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
sw forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
','
                                                       forall a. Semigroup a => a -> a -> a
<> Double -> Builder
jsDouble Double
sh forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb (Cursor cursor
cur)                 = Builder
"Cursor(" forall a. Semigroup a => a -> a -> a
<> forall a. CanvasCursor a => a -> Builder
jsCanvasCursor cursor
cur forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
  showb Query a
Sync                         = Builder
"Sync"

-- This is how we take our value to bits
parseQueryResult :: Query a -> Value -> Parser a
parseQueryResult :: forall a. Query a -> Value -> Parser a
parseQueryResult (Device {}) Value
o                = forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 Int -> Int -> Double -> DeviceAttributes
DeviceAttributes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
o
parseQueryResult (ToDataURL {}) Value
o             = forall a. FromJSON a => Value -> Parser a
parseJSON Value
o
parseQueryResult (MeasureText {}) (Object Object
v)  = Double -> TextMetrics
TextMetrics forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"width"
parseQueryResult (IsPointInPath {}) Value
o         = forall a. FromJSON a => Value -> Parser a
parseJSON Value
o
parseQueryResult (NewImage {}) Value
o              = forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 Int -> Int -> Int -> CanvasImage
CanvasImage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
o
parseQueryResult (NewAudio {}) Value
o              = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Double -> CanvasAudio
CanvasAudio forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
o
parseQueryResult (NewCanvas {}) Value
o             = forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 Int -> Int -> Int -> CanvasContext
CanvasContext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
o
parseQueryResult (GetImageData {}) (Object Object
o) = Int -> Int -> Vector Word8 -> ImageData
ImageData
                                           forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"width")
                                           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"height")
                                           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data")
parseQueryResult (Cursor {}) Value
_                = forall (m :: * -> *) a. Monad m => a -> m a
return ()
parseQueryResult (Sync {}) Value
_                  = forall (m :: * -> *) a. Monad m => a -> m a
return () -- we just accept anything; empty list sent
parseQueryResult Query a
_ Value
_                          = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no parse in blank-canvas server (internal error)"

uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 :: forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 a -> b -> c -> d
f (a
a,b
b,c
c) = a -> b -> c -> d
f a
a b
b c
c

device :: Canvas DeviceAttributes
device :: Canvas DeviceAttributes
device = forall a. TextShow a => Query a -> Canvas a
Query Query DeviceAttributes
Device

-- | Turn the canvas into a PNG data stream / data URL.
--
-- > "data:image/png;base64,iVBORw0KGgo.."
--
toDataURL :: () -> Canvas Text
toDataURL :: () -> Canvas Text
toDataURL () = forall a. TextShow a => Query a -> Canvas a
Query Query Text
ToDataURL

-- | Queries the measured width of the text argument.
--
-- ==== __Example__
--
-- @
-- 'TextMetrics' w <- 'measureText' \"Hello, World!\"
-- @
measureText :: Text -> Canvas TextMetrics
measureText :: Text -> Canvas TextMetrics
measureText = forall a. TextShow a => Query a -> Canvas a
Query forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Query TextMetrics
MeasureText

-- | @'isPointInPath'(x, y)@ queries whether point @(x, y)@ is within the current path.
--
-- ==== __Example__
--
-- @
-- 'rect'(10, 10, 100, 100)
-- 'stroke'()
-- b <- 'isPointInPath'(10, 10) -- b == True
-- @
isPointInPath :: (Double, Double) -> Canvas Bool
isPointInPath :: (Double, Double) -> Canvas Bool
isPointInPath = forall a. TextShow a => Query a -> Canvas a
Query forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double) -> Query Bool
IsPointInPath

-- | 'newImage' takes a URL (perhaps a data URL), and returns the 'CanvasImage' handle
-- /after/ loading.
-- If you are using local images, loading should be near instant.
newImage :: Text -> Canvas CanvasImage
newImage :: Text -> Canvas CanvasImage
newImage = forall a. TextShow a => Query a -> Canvas a
Query forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Query CanvasImage
NewImage

-- | 'newAudio' takes an URL to an audio file and returs the 'CanvasAudio' handle
-- /after/ loading.
-- If you are using local audio files, loading should be near instant.
newAudio :: Text -> Canvas CanvasAudio
newAudio :: Text -> Canvas CanvasAudio
newAudio = forall a. TextShow a => Query a -> Canvas a
Query forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Query CanvasAudio
NewAudio

-- | @'createLinearGradient'(x0, y0, x1, y1)@ creates a linear gradient along a line,
-- which can be used to fill other shapes.
--
-- * @x0@ is the starting x-coordinate of the gradient
--
-- * @y0@ is the starting y-coordinate of the gradient
--
-- * @x1@ is the ending y-coordinate of the gradient
--
-- * @y1@ is the ending y-coordinate of the gradient
--
-- ==== __Example__
--
-- @
-- grd <- 'createLinearGradient'(0, 0, 10, 10)
-- grd # 'addColorStop'(0, \"blue\")
-- grd # 'addColorStop'(1, \"red\")
-- 'fillStyle' grd
-- @
createLinearGradient :: (Double, Double, Double, Double) -> Canvas CanvasGradient
createLinearGradient :: (Double, Double, Double, Double) -> Canvas CanvasGradient
createLinearGradient = forall a. TextShow a => Function a -> Canvas a
Function forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double, Double, Double) -> Function CanvasGradient
CreateLinearGradient

-- | @'createRadialGradient'(x0, y0, r0, x1, y1, r1)@ creates a radial gradient given
-- by the coordinates of two circles, which can be used to fill other shapes.
--
-- * @x0@ is the x-axis of the coordinate of the start circle
--
-- * @y0@ is the y-axis of the coordinate of the start circle
--
-- * @r0@ is the radius of the start circle
--
-- * @x1@ is the x-axis of the coordinate of the end circle
--
-- * @y1@ is the y-axis of the coordinate of the end circle
--
-- * @r1@ is the radius of the end circle
--
-- ==== __Example__
--
-- @
-- grd <- 'createRadialGradient'(100,100,100,100,100,0)
-- grd # 'addColorStop'(0, \"blue\")
-- grd # 'addColorStop'(1, \"red\")
-- 'fillStyle' grd
-- @
createRadialGradient :: (Double, Double, Double, Double, Double, Double) -> Canvas CanvasGradient
createRadialGradient :: (Double, Double, Double, Double, Double, Double)
-> Canvas CanvasGradient
createRadialGradient = forall a. TextShow a => Function a -> Canvas a
Function forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double, Double, Double, Double, Double)
-> Function CanvasGradient
CreateRadialGradient

-- | Creates a pattern using a 'CanvasImage' and a 'RepeatDirection'.
--
-- ==== __Example__
--
-- @
-- img <- newImage \"cat.jpg\"
-- pat <- 'createPattern'(img, 'repeatX')
-- 'fillStyle' pat
-- @
createPattern :: (CanvasImage, RepeatDirection) -> Canvas CanvasPattern
createPattern :: (CanvasImage, RepeatDirection) -> Canvas CanvasPattern
createPattern = forall a. TextShow a => Function a -> Canvas a
Function forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cursor.
Image cursor =>
(cursor, RepeatDirection) -> Function CanvasPattern
CreatePattern

-- | Create a new, off-screen canvas buffer. Takes width and height as arguments.
newCanvas :: (Int, Int) -> Canvas CanvasContext
newCanvas :: (Int, Int) -> Canvas CanvasContext
newCanvas = forall a. TextShow a => Query a -> Canvas a
Query forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Query CanvasContext
NewCanvas

-- | @'getImageData'(x, y, w, h)@ capture 'ImageData' from the rectangle with
-- upper-left corner @(x, y)@, width @w@, and height @h@.
getImageData :: (Double, Double, Double, Double) -> Canvas ImageData
getImageData :: (Double, Double, Double, Double) -> Canvas ImageData
getImageData = forall a. TextShow a => Query a -> Canvas a
Query forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double, Double, Double) -> Query ImageData
GetImageData

-- | Change the canvas cursor to the specified URL or keyword.
--
-- ==== __Examples__
--
-- @
-- cursor $ 'url' \"image.png\" 'default_'
-- cursor 'crosshair'
-- @
cursor :: CanvasCursor cursor => cursor -> Canvas ()
cursor :: forall cursor. CanvasCursor cursor => cursor -> Canvas ()
cursor = forall a. TextShow a => Query a -> Canvas a
Query forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cursor. CanvasCursor cursor => cursor -> Query ()
Cursor

-- | Send all commands to the browser, wait for the browser to act, then continue.
sync :: Canvas ()
sync :: Canvas ()
sync = forall a. TextShow a => Query a -> Canvas a
Query Query ()
Sync