{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE CPP #-}
module Miso.Canvas
(
Canvas (..)
, Pattern (..)
, Gradient (..)
, ImageData (..)
, LineCapType (..)
, PatternType (..)
, LineJoinType (..)
, DirectionType (..)
, TextAlignType (..)
, TextBaselineType (..)
, CompositeOperation (..)
, StyleArg (..)
, Coord
, canvas
, canvas_
, globalCompositeOperation
, clearRect
, fillRect
, strokeRect
, beginPath
, closePath
, moveTo
, lineTo
, fill
, rect
, stroke
, bezierCurveTo
, arc
, arcTo
, quadraticCurveTo
, direction
, fillText
, font
, strokeText
, textAlign
, textBaseline
, addColorStop
, createLinearGradient
, createPattern
, createRadialGradient
, fillStyle
, lineCap
, lineJoin
, lineWidth
, miterLimit
, shadowBlur
, shadowColor
, shadowOffsetX
, shadowOffsetY
, strokeStyle
, scale
, rotate
, translate
, transform
, setTransform
, drawImage
, drawImage'
, createImageData
, getImageData
, setImageData
, height
, width
, putImageData
, globalAlpha
, clip
, save
, restore
, gradient
, pattern_
, color
) where
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad (void, liftM, ap, liftM2)
import Data.Kind (Type)
import Language.Javascript.JSaddle ( JSM, JSVal, (#), fromJSVal
, (<#), toJSVal, (!)
, liftJSM, Function
, ToJSVal, MakeObject, (<##)
#ifndef GHCJS_BOTH
, MonadJSM(..)
#endif
)
import qualified Miso.FFI as FFI
import Miso.FFI (Image)
import Miso.Types
import Miso.Style (Color, renderColor)
import Miso.String (MisoString)
canvas
:: forall action
. [ Attribute action ]
-> JSM Function
-> View action
canvas :: forall action. [Attribute action] -> JSM Function -> View action
canvas [Attribute action]
attributes JSM Function
callback = NS
-> MisoString -> [Attribute action] -> [View action] -> View action
forall action.
NS
-> MisoString -> [Attribute action] -> [View action] -> View action
node NS
HTML MisoString
"canvas" [Attribute action]
attrs []
where
attrs :: [ Attribute action ]
attrs :: [Attribute action]
attrs = (Attribute action -> [Attribute action] -> [Attribute action])
-> [Attribute action] -> Attribute action -> [Attribute action]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:) [Attribute action]
attributes (Attribute action -> [Attribute action])
-> Attribute action -> [Attribute action]
forall a b. (a -> b) -> a -> b
$ (Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
Event ((Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action)
-> (Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
_ Object
obj LogLevel
_ Events
_ ->
(JSVal -> Object -> JSM ()) -> Object -> JSVal -> JSM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (MisoString -> JSVal -> Object -> JSM ()
forall v. ToJSVal v => MisoString -> v -> Object -> JSM ()
FFI.set MisoString
"draw") Object
obj (JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Function -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal (Function -> JSM JSVal) -> JSM Function -> JSM JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSM Function
callback
canvas_
:: [ Attribute action ]
-> Canvas a
-> View action
canvas_ :: forall action a. [Attribute action] -> Canvas a -> View action
canvas_ [Attribute action]
attributes Canvas a
canvas' =
[Attribute action] -> JSM Function -> View action
forall action. [Attribute action] -> JSM Function -> View action
canvas [Attribute action]
attributes (JSM Function -> View action) -> JSM Function -> View action
forall a b. (a -> b) -> a -> b
$
(JSVal -> JSM ()) -> JSM Function
FFI.syncCallback1 ((JSVal -> JSM ()) -> JSM Function)
-> (JSVal -> JSM ()) -> JSM Function
forall a b. (a -> b) -> a -> b
$ \JSVal
domRef -> do
ctx <- JSVal
domRef JSVal -> MisoString -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"getContext" :: MisoString) ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [MisoString
"2d" :: MisoString]
void (interpret ctx canvas')
data PatternType = Repeat | RepeatX | RepeatY | NoRepeat
data StyleArg
= ColorArg Color
| GradientArg Gradient
| PatternArg Pattern
color :: Color -> StyleArg
color :: Color -> StyleArg
color = Color -> StyleArg
ColorArg
gradient :: Gradient -> StyleArg
gradient :: Gradient -> StyleArg
gradient = Gradient -> StyleArg
GradientArg
pattern_ :: Pattern -> StyleArg
pattern_ :: Pattern -> StyleArg
pattern_ = Pattern -> StyleArg
PatternArg
renderStyleArg :: StyleArg -> JSM JSVal
renderStyleArg :: StyleArg -> JSM JSVal
renderStyleArg (ColorArg Color
c) = MisoString -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal (Color -> MisoString
renderColor Color
c)
renderStyleArg (GradientArg Gradient
g) = Gradient -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Gradient
g
renderStyleArg (PatternArg Pattern
p) = Pattern -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Pattern
p
renderPattern :: PatternType -> MisoString
renderPattern :: PatternType -> MisoString
renderPattern PatternType
Repeat = MisoString
"repeat"
renderPattern PatternType
RepeatX = MisoString
"repeat-x"
renderPattern PatternType
RepeatY = MisoString
"repeat-y"
renderPattern PatternType
NoRepeat = MisoString
"no-repeat"
data LineCapType
= LineCapButt
| LineCapRound
| LineCapSquare
deriving (Int -> LineCapType -> ShowS
[LineCapType] -> ShowS
LineCapType -> String
(Int -> LineCapType -> ShowS)
-> (LineCapType -> String)
-> ([LineCapType] -> ShowS)
-> Show LineCapType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LineCapType -> ShowS
showsPrec :: Int -> LineCapType -> ShowS
$cshow :: LineCapType -> String
show :: LineCapType -> String
$cshowList :: [LineCapType] -> ShowS
showList :: [LineCapType] -> ShowS
Show, LineCapType -> LineCapType -> Bool
(LineCapType -> LineCapType -> Bool)
-> (LineCapType -> LineCapType -> Bool) -> Eq LineCapType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LineCapType -> LineCapType -> Bool
== :: LineCapType -> LineCapType -> Bool
$c/= :: LineCapType -> LineCapType -> Bool
/= :: LineCapType -> LineCapType -> Bool
Eq)
renderLineCapType :: LineCapType -> MisoString
renderLineCapType :: LineCapType -> MisoString
renderLineCapType LineCapType
LineCapButt = MisoString
"butt"
renderLineCapType LineCapType
LineCapRound = MisoString
"round"
renderLineCapType LineCapType
LineCapSquare = MisoString
"square"
data LineJoinType = LineJoinBevel | LineJoinRound | LineJoinMiter
deriving (Int -> LineJoinType -> ShowS
[LineJoinType] -> ShowS
LineJoinType -> String
(Int -> LineJoinType -> ShowS)
-> (LineJoinType -> String)
-> ([LineJoinType] -> ShowS)
-> Show LineJoinType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LineJoinType -> ShowS
showsPrec :: Int -> LineJoinType -> ShowS
$cshow :: LineJoinType -> String
show :: LineJoinType -> String
$cshowList :: [LineJoinType] -> ShowS
showList :: [LineJoinType] -> ShowS
Show, LineJoinType -> LineJoinType -> Bool
(LineJoinType -> LineJoinType -> Bool)
-> (LineJoinType -> LineJoinType -> Bool) -> Eq LineJoinType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LineJoinType -> LineJoinType -> Bool
== :: LineJoinType -> LineJoinType -> Bool
$c/= :: LineJoinType -> LineJoinType -> Bool
/= :: LineJoinType -> LineJoinType -> Bool
Eq)
renderLineJoinType :: LineJoinType -> MisoString
renderLineJoinType :: LineJoinType -> MisoString
renderLineJoinType LineJoinType
LineJoinBevel = MisoString
"bevel"
renderLineJoinType LineJoinType
LineJoinRound = MisoString
"round"
renderLineJoinType LineJoinType
LineJoinMiter = MisoString
"miter"
data DirectionType = LTR | RTL | Inherit
deriving (Int -> DirectionType -> ShowS
[DirectionType] -> ShowS
DirectionType -> String
(Int -> DirectionType -> ShowS)
-> (DirectionType -> String)
-> ([DirectionType] -> ShowS)
-> Show DirectionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DirectionType -> ShowS
showsPrec :: Int -> DirectionType -> ShowS
$cshow :: DirectionType -> String
show :: DirectionType -> String
$cshowList :: [DirectionType] -> ShowS
showList :: [DirectionType] -> ShowS
Show, DirectionType -> DirectionType -> Bool
(DirectionType -> DirectionType -> Bool)
-> (DirectionType -> DirectionType -> Bool) -> Eq DirectionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DirectionType -> DirectionType -> Bool
== :: DirectionType -> DirectionType -> Bool
$c/= :: DirectionType -> DirectionType -> Bool
/= :: DirectionType -> DirectionType -> Bool
Eq)
renderDirectionType :: DirectionType -> MisoString
renderDirectionType :: DirectionType -> MisoString
renderDirectionType DirectionType
LTR = MisoString
"ltr"
renderDirectionType DirectionType
RTL = MisoString
"rtl"
renderDirectionType DirectionType
Inherit = MisoString
"inherit"
data TextAlignType
= TextAlignCenter
| TextAlignEnd
| TextAlignLeft
| TextAlignRight
| TextAlignStart
deriving (Int -> TextAlignType -> ShowS
[TextAlignType] -> ShowS
TextAlignType -> String
(Int -> TextAlignType -> ShowS)
-> (TextAlignType -> String)
-> ([TextAlignType] -> ShowS)
-> Show TextAlignType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextAlignType -> ShowS
showsPrec :: Int -> TextAlignType -> ShowS
$cshow :: TextAlignType -> String
show :: TextAlignType -> String
$cshowList :: [TextAlignType] -> ShowS
showList :: [TextAlignType] -> ShowS
Show, TextAlignType -> TextAlignType -> Bool
(TextAlignType -> TextAlignType -> Bool)
-> (TextAlignType -> TextAlignType -> Bool) -> Eq TextAlignType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextAlignType -> TextAlignType -> Bool
== :: TextAlignType -> TextAlignType -> Bool
$c/= :: TextAlignType -> TextAlignType -> Bool
/= :: TextAlignType -> TextAlignType -> Bool
Eq)
renderTextAlignType :: TextAlignType -> MisoString
renderTextAlignType :: TextAlignType -> MisoString
renderTextAlignType TextAlignType
TextAlignCenter = MisoString
"center"
renderTextAlignType TextAlignType
TextAlignEnd = MisoString
"end"
renderTextAlignType TextAlignType
TextAlignLeft = MisoString
"left"
renderTextAlignType TextAlignType
TextAlignRight = MisoString
"right"
renderTextAlignType TextAlignType
TextAlignStart = MisoString
"start"
data TextBaselineType
= TextBaselineAlphabetic
| TextBaselineTop
| TextBaselineHanging
| TextBaselineMiddle
| TextBaselineIdeographic
| TextBaselineBottom
deriving (Int -> TextBaselineType -> ShowS
[TextBaselineType] -> ShowS
TextBaselineType -> String
(Int -> TextBaselineType -> ShowS)
-> (TextBaselineType -> String)
-> ([TextBaselineType] -> ShowS)
-> Show TextBaselineType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextBaselineType -> ShowS
showsPrec :: Int -> TextBaselineType -> ShowS
$cshow :: TextBaselineType -> String
show :: TextBaselineType -> String
$cshowList :: [TextBaselineType] -> ShowS
showList :: [TextBaselineType] -> ShowS
Show, TextBaselineType -> TextBaselineType -> Bool
(TextBaselineType -> TextBaselineType -> Bool)
-> (TextBaselineType -> TextBaselineType -> Bool)
-> Eq TextBaselineType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextBaselineType -> TextBaselineType -> Bool
== :: TextBaselineType -> TextBaselineType -> Bool
$c/= :: TextBaselineType -> TextBaselineType -> Bool
/= :: TextBaselineType -> TextBaselineType -> Bool
Eq)
renderTextBaselineType :: TextBaselineType -> MisoString
renderTextBaselineType :: TextBaselineType -> MisoString
renderTextBaselineType TextBaselineType
TextBaselineAlphabetic = MisoString
"alphabetic"
renderTextBaselineType TextBaselineType
TextBaselineTop = MisoString
"top"
renderTextBaselineType TextBaselineType
TextBaselineHanging = MisoString
"hanging"
renderTextBaselineType TextBaselineType
TextBaselineMiddle = MisoString
"middle"
renderTextBaselineType TextBaselineType
TextBaselineIdeographic = MisoString
"ideographic"
renderTextBaselineType TextBaselineType
TextBaselineBottom = MisoString
"bottom"
data CompositeOperation
= SourceOver
| SourceAtop
| SourceIn
| SourceOut
| DestinationOver
| DestinationAtop
| DestinationIn
| DestinationOut
| Lighter
| Copy
| Xor
deriving (Int -> CompositeOperation -> ShowS
[CompositeOperation] -> ShowS
CompositeOperation -> String
(Int -> CompositeOperation -> ShowS)
-> (CompositeOperation -> String)
-> ([CompositeOperation] -> ShowS)
-> Show CompositeOperation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompositeOperation -> ShowS
showsPrec :: Int -> CompositeOperation -> ShowS
$cshow :: CompositeOperation -> String
show :: CompositeOperation -> String
$cshowList :: [CompositeOperation] -> ShowS
showList :: [CompositeOperation] -> ShowS
Show, CompositeOperation -> CompositeOperation -> Bool
(CompositeOperation -> CompositeOperation -> Bool)
-> (CompositeOperation -> CompositeOperation -> Bool)
-> Eq CompositeOperation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompositeOperation -> CompositeOperation -> Bool
== :: CompositeOperation -> CompositeOperation -> Bool
$c/= :: CompositeOperation -> CompositeOperation -> Bool
/= :: CompositeOperation -> CompositeOperation -> Bool
Eq)
renderCompositeOperation :: CompositeOperation -> MisoString
renderCompositeOperation :: CompositeOperation -> MisoString
renderCompositeOperation CompositeOperation
SourceOver = MisoString
"source-over"
renderCompositeOperation CompositeOperation
SourceAtop = MisoString
"source-atop"
renderCompositeOperation CompositeOperation
SourceIn = MisoString
"source-in"
renderCompositeOperation CompositeOperation
SourceOut = MisoString
"source-out"
renderCompositeOperation CompositeOperation
DestinationOver = MisoString
"destination-over"
renderCompositeOperation CompositeOperation
DestinationAtop = MisoString
"destination-atop"
renderCompositeOperation CompositeOperation
DestinationIn = MisoString
"destination-in"
renderCompositeOperation CompositeOperation
DestinationOut = MisoString
"destination-out"
renderCompositeOperation CompositeOperation
Lighter = MisoString
"lighter"
renderCompositeOperation CompositeOperation
Copy = MisoString
"copy"
renderCompositeOperation CompositeOperation
Xor = MisoString
"xor"
newtype Pattern = Pattern JSVal deriving ([Pattern] -> JSM JSVal
Pattern -> JSM JSVal
(Pattern -> JSM JSVal)
-> ([Pattern] -> JSM JSVal) -> ToJSVal Pattern
forall a. (a -> JSM JSVal) -> ([a] -> JSM JSVal) -> ToJSVal a
$ctoJSVal :: Pattern -> JSM JSVal
toJSVal :: Pattern -> JSM JSVal
$ctoJSValListOf :: [Pattern] -> JSM JSVal
toJSValListOf :: [Pattern] -> JSM JSVal
ToJSVal)
newtype Gradient = Gradient JSVal deriving ([Gradient] -> JSM JSVal
Gradient -> JSM JSVal
(Gradient -> JSM JSVal)
-> ([Gradient] -> JSM JSVal) -> ToJSVal Gradient
forall a. (a -> JSM JSVal) -> ([a] -> JSM JSVal) -> ToJSVal a
$ctoJSVal :: Gradient -> JSM JSVal
toJSVal :: Gradient -> JSM JSVal
$ctoJSValListOf :: [Gradient] -> JSM JSVal
toJSValListOf :: [Gradient] -> JSM JSVal
ToJSVal)
newtype ImageData = ImageData JSVal deriving ([ImageData] -> JSM JSVal
ImageData -> JSM JSVal
(ImageData -> JSM JSVal)
-> ([ImageData] -> JSM JSVal) -> ToJSVal ImageData
forall a. (a -> JSM JSVal) -> ([a] -> JSM JSVal) -> ToJSVal a
$ctoJSVal :: ImageData -> JSM JSVal
toJSVal :: ImageData -> JSM JSVal
$ctoJSValListOf :: [ImageData] -> JSM JSVal
toJSValListOf :: [ImageData] -> JSM JSVal
ToJSVal, ImageData -> JSM Object
(ImageData -> JSM Object) -> MakeObject ImageData
forall this. (this -> JSM Object) -> MakeObject this
$cmakeObject :: ImageData -> JSM Object
makeObject :: ImageData -> JSM Object
MakeObject)
type Coord = (Double, Double)
data Canvas :: Type -> Type where
Bind :: Canvas a -> (a -> Canvas b) -> Canvas b
Pure :: a -> Canvas a
LiftIO :: IO a -> Canvas a
LiftJSM :: JSM a -> Canvas a
IsPointInPath :: Coord -> Canvas Bool
MeasureText :: MisoString -> Canvas Double
ClearRect :: (Double, Double, Double, Double) -> Canvas ()
FillRect :: (Double, Double, Double, Double) -> Canvas ()
StrokeRect :: (Double, Double, Double, Double) -> Canvas ()
BeginPath :: Canvas ()
ClosePath :: Canvas ()
MoveTo :: (Double, Double) -> Canvas ()
LineTo :: (Double, Double) -> Canvas ()
Fill :: Canvas ()
Rect :: (Double, Double, Double, Double) -> Canvas ()
Stroke :: Canvas ()
BezierCurveTo :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
Arc :: (Double, Double, Double, Double, Double) -> Canvas ()
ArcTo :: (Double, Double, Double, Double, Double) -> Canvas ()
QuadraticCurveTo :: (Double, Double, Double, Double) -> Canvas ()
Direction :: DirectionType -> Canvas ()
FillText :: (MisoString, Double, Double) -> Canvas ()
Font :: MisoString -> Canvas ()
StrokeText :: (MisoString, Double, Double) -> Canvas ()
TextAlign :: TextAlignType -> Canvas ()
TextBaseline :: TextBaselineType -> Canvas ()
AddColorStop :: Gradient -> Double -> Color -> Canvas ()
CreateLinearGradient :: (Double, Double, Double, Double) -> Canvas Gradient
CreatePattern :: Image -> PatternType -> Canvas Pattern
CreateRadialGradient :: (Double, Double, Double, Double, Double, Double) -> Canvas Gradient
FillStyle :: StyleArg -> Canvas ()
LineCap :: LineCapType -> Canvas ()
LineJoin :: LineJoinType -> Canvas ()
LineWidth :: Double -> Canvas ()
MiterLimit :: Double -> Canvas ()
ShadowBlur :: Double -> Canvas ()
ShadowColor :: Color -> Canvas ()
ShadowOffsetX :: Double -> Canvas ()
ShadowOffsetY :: Double -> Canvas ()
StrokeStyle :: StyleArg -> Canvas ()
Scale :: (Double, Double) -> Canvas ()
Rotate :: Double -> Canvas ()
Translate :: Coord -> Canvas ()
Transform :: (Double,Double,Double,Double,Double,Double) -> Canvas ()
SetTransform :: (Double,Double,Double,Double,Double,Double) -> Canvas ()
DrawImage :: (Image,Double,Double) -> Canvas ()
DrawImage' :: (Image, Double, Double, Double, Double) -> Canvas ()
CreateImageData :: (Double, Double) -> Canvas ImageData
GetImageData :: (Double, Double, Double, Double) -> Canvas ImageData
SetImageData :: ImageData -> Int -> Double -> Canvas ()
ImageDataHeight :: ImageData -> Canvas Double
ImageDataWidth :: ImageData -> Canvas Double
PutImageData :: (ImageData, Double, Double) -> Canvas ()
GlobalAlpha :: Double -> Canvas ()
GlobalCompositeOperation :: CompositeOperation -> Canvas ()
Clip :: Canvas ()
Save :: Canvas ()
Restore :: Canvas ()
instance MonadIO Canvas where
liftIO :: forall a. IO a -> Canvas a
liftIO = IO a -> Canvas a
forall a. IO a -> Canvas a
LiftIO
#ifndef GHCJS_BOTH
instance MonadJSM Canvas where
liftJSM' :: forall a. JSM a -> Canvas a
liftJSM' = JSM a -> Canvas a
forall a. JSM a -> Canvas a
LiftJSM
#endif
instance Monad Canvas where
>>= :: forall a b. Canvas a -> (a -> Canvas b) -> Canvas b
(>>=) = Canvas a -> (a -> Canvas b) -> Canvas b
forall a b. Canvas a -> (a -> Canvas b) -> Canvas b
Bind
return :: forall a. a -> Canvas a
return = a -> Canvas a
forall a. a -> Canvas a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance Applicative Canvas where
<*> :: forall a b. Canvas (a -> b) -> Canvas a -> Canvas b
(<*>) = Canvas (a -> b) -> Canvas a -> Canvas b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
pure :: forall a. a -> Canvas a
pure = a -> Canvas a
forall a. a -> Canvas a
Pure
instance Functor Canvas where
fmap :: forall a b. (a -> b) -> Canvas a -> Canvas b
fmap = (a -> b) -> Canvas a -> Canvas b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Semigroup a => Semigroup (Canvas a) where
<> :: Canvas a -> Canvas a -> Canvas a
(<>) = (a -> a -> a) -> Canvas a -> Canvas a -> Canvas a
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
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 = a -> Canvas a
forall a. a -> Canvas a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
interpret :: JSVal -> Canvas a -> JSM a
interpret :: forall a. JSVal -> Canvas a -> JSM a
interpret JSVal
ctx (Bind Canvas a
m a -> Canvas a
f) =
JSVal -> Canvas a -> JSM a
forall a. JSVal -> Canvas a -> JSM a
interpret JSVal
ctx (Canvas a -> JSM a) -> JSM (Canvas a) -> JSM a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> Canvas a
f (a -> Canvas a) -> JSM a -> JSM (Canvas a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal -> Canvas a -> JSM a
forall a. JSVal -> Canvas a -> JSM a
interpret JSVal
ctx Canvas a
m
interpret JSVal
_ (LiftIO IO a
io) =
IO a -> JSM a
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
io
interpret JSVal
_ (LiftJSM JSM a
jsm) =
JSM a -> JSM a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM a
jsm
interpret JSVal
_ (Pure a
m) =
a -> JSM a
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
m
interpret JSVal
ctx (ClearRect (Double
x,Double
y,Double
h,Double
w)) =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"clearRect" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [ Double
x, Double
y, Double
h, Double
w ]
interpret JSVal
ctx (FillRect (Double
x,Double
y,Double
h,Double
w)) =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"fillRect" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [ Double
x, Double
y, Double
h, Double
w ]
interpret JSVal
ctx (StrokeRect (Double
x,Double
y,Double
h,Double
w)) =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"strokeRect" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [ Double
x, Double
y, Double
h, Double
w ]
interpret JSVal
ctx Canvas a
BeginPath =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"beginPath" :: MisoString) ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ([] :: [MisoString])
interpret JSVal
ctx Canvas a
ClosePath =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"closePath" :: MisoString) ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ([] :: [MisoString])
interpret JSVal
ctx Canvas a
Clip =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"clip" :: MisoString) ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ([] :: [MisoString])
interpret JSVal
ctx Canvas a
Save =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"save" :: MisoString) ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ([] :: [MisoString])
interpret JSVal
ctx Canvas a
Restore =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"restore" :: MisoString) ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ([] :: [MisoString])
interpret JSVal
ctx (MoveTo (Double
x,Double
y)) =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"moveTo" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [Double
x,Double
y]
interpret JSVal
ctx (LineTo (Double
x,Double
y)) =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"lineTo" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [Double
x,Double
y]
interpret JSVal
ctx Canvas a
Stroke =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"stroke" :: MisoString) ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ([] :: [MisoString])
interpret JSVal
ctx Canvas a
Fill =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"fill" :: MisoString) ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ([] :: [MisoString])
interpret JSVal
ctx (Rect (Double
x,Double
y,Double
h,Double
w)) =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"rect" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [Double
x,Double
y,Double
h,Double
w]
interpret JSVal
ctx (BezierCurveTo (Double
a,Double
b,Double
c,Double
d,Double
e,Double
f)) =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"bezierCurveTo" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [Double
a,Double
b,Double
c,Double
d,Double
e,Double
f]
interpret JSVal
ctx (Arc (Double
a,Double
b,Double
c,Double
d,Double
e)) =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"arc" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [Double
a,Double
b,Double
c,Double
d,Double
e]
interpret JSVal
ctx (ArcTo (Double
a,Double
b,Double
c,Double
d,Double
e)) =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"arcTo" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [Double
a,Double
b,Double
c,Double
d,Double
e]
interpret JSVal
ctx (QuadraticCurveTo (Double
a,Double
b,Double
c,Double
d)) =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"quadraticCurveTo" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [Double
a,Double
b,Double
c,Double
d]
interpret JSVal
ctx (IsPointInPath (Double
x,Double
y)) = do
Just result <- JSVal -> JSM (Maybe a)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal (JSVal -> JSM (Maybe a)) -> JSM JSVal -> JSM (Maybe a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"isPointInPath" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [Double
x,Double
y]
pure result
interpret JSVal
ctx (Direction DirectionType
d) =
JSM () -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ (JSVal
ctx JSVal -> MisoString -> MisoString -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# (MisoString
"direction" :: MisoString)) (DirectionType -> MisoString
renderDirectionType DirectionType
d)
interpret JSVal
ctx (TextAlign TextAlignType
t) =
JSM () -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ (JSVal
ctx JSVal -> MisoString -> MisoString -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# (MisoString
"textAlign" :: MisoString)) (TextAlignType -> MisoString
renderTextAlignType TextAlignType
t)
interpret JSVal
ctx (TextBaseline TextBaselineType
t) =
JSM () -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ (JSVal
ctx JSVal -> MisoString -> MisoString -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# (MisoString
"textBaseline" :: MisoString)) (TextBaselineType -> MisoString
renderTextBaselineType TextBaselineType
t)
interpret JSVal
ctx (Font MisoString
f) =
JSM () -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ (JSVal
ctx JSVal -> MisoString -> MisoString -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# (MisoString
"font" :: MisoString)) MisoString
f
interpret JSVal
ctx (FillStyle StyleArg
style) =
JSM () -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ (JSVal
ctx JSVal -> MisoString -> JSVal -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# (MisoString
"fillStyle" :: MisoString)) (JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StyleArg -> JSM JSVal
renderStyleArg StyleArg
style
interpret JSVal
ctx (GlobalCompositeOperation CompositeOperation
s) =
JSM () -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ (JSVal
ctx JSVal -> MisoString -> MisoString -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# (MisoString
"globalCompositeOperation" :: MisoString)) (CompositeOperation -> MisoString
renderCompositeOperation CompositeOperation
s)
interpret JSVal
ctx (FillText (MisoString
txt', Double
x' , Double
y')) = do
txt <- MisoString -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal MisoString
txt'
x <- toJSVal x'
y <- toJSVal y'
void $ (ctx # ("fillText" :: MisoString)) [txt, x, y]
interpret JSVal
ctx (StrokeText (MisoString
txt', Double
x', Double
y')) = do
txt <- MisoString -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal MisoString
txt'
x <- toJSVal x'
y <- toJSVal y'
void $ (ctx # ("strokeText" :: MisoString)) [txt, x, y]
interpret JSVal
ctx (MeasureText MisoString
txt) = do
o <- JSVal
ctx JSVal -> MisoString -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"measureText" :: MisoString) ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [MisoString
txt]
Just w <- fromJSVal =<< o ! ("width" :: MisoString)
pure w
interpret JSVal
ctx (Translate (Double
x,Double
y)) =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"translate" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [ Double
x, Double
y ]
interpret JSVal
_ (AddColorStop (Gradient JSVal
grd) Double
x' Color
color') = do
x <- Double -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Double
x'
c <- toJSVal (renderColor color')
void $ grd # ("addColorStop" :: MisoString) $ [ x, c ]
interpret JSVal
ctx (CreateLinearGradient (Double
w,Double
x,Double
y,Double
z)) =
JSVal -> a
JSVal -> Gradient
Gradient (JSVal -> a) -> JSM JSVal -> JSM a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"createLinearGradient" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$
[Double
w,Double
x,Double
y,Double
z]
interpret JSVal
ctx (CreatePattern Image
image PatternType
patternType) = do
img <- Image -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Image
image
pt <- toJSVal (renderPattern patternType)
Pattern <$> do
ctx # ("createPattern" :: MisoString) $
[ img, pt ]
interpret JSVal
ctx (CreateRadialGradient (Double
w,Double
x,Double
y,Double
z,Double
k,Double
j)) =
JSVal -> a
JSVal -> Gradient
Gradient (JSVal -> a) -> JSM JSVal -> JSM a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"createRadialGradient" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$
[Double
w,Double
x,Double
y,Double
z,Double
k,Double
j]
interpret JSVal
ctx (LineCap LineCapType
typ) = do
t <- MisoString -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal (LineCapType -> MisoString
renderLineCapType LineCapType
typ)
void $ do
ctx <# ("lineCap" :: MisoString) $ t
interpret JSVal
ctx (LineJoin LineJoinType
ljt') = do
ljt <- MisoString -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal (LineJoinType -> MisoString
renderLineJoinType LineJoinType
ljt')
void $ do ctx <# ("lineJoin" :: MisoString) $ ljt
interpret JSVal
ctx (LineWidth Double
w) =
JSM () -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do JSVal
ctx JSVal -> MisoString -> Double -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# (MisoString
"lineWidth" :: MisoString) (Double -> JSM ()) -> Double -> JSM ()
forall a b. (a -> b) -> a -> b
$ Double
w
interpret JSVal
ctx (MiterLimit Double
w) =
JSM () -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do JSVal
ctx JSVal -> MisoString -> Double -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# (MisoString
"miterLimit" :: MisoString) (Double -> JSM ()) -> Double -> JSM ()
forall a b. (a -> b) -> a -> b
$ Double
w
interpret JSVal
ctx (ShadowBlur Double
w) =
JSM () -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do JSVal
ctx JSVal -> MisoString -> Double -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# (MisoString
"shadowBlur" :: MisoString) (Double -> JSM ()) -> Double -> JSM ()
forall a b. (a -> b) -> a -> b
$ Double
w
interpret JSVal
ctx (ShadowColor Color
c) =
JSM () -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do JSVal
ctx JSVal -> MisoString -> MisoString -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# (MisoString
"shadowColor" :: MisoString) (MisoString -> JSM ()) -> MisoString -> JSM ()
forall a b. (a -> b) -> a -> b
$ Color -> MisoString
renderColor Color
c
interpret JSVal
ctx (ShadowOffsetX Double
x) =
JSM () -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do JSVal
ctx JSVal -> MisoString -> Double -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# (MisoString
"shadowOffsetX" :: MisoString) (Double -> JSM ()) -> Double -> JSM ()
forall a b. (a -> b) -> a -> b
$ Double
x
interpret JSVal
ctx (ShadowOffsetY Double
y) =
JSM () -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do JSVal
ctx JSVal -> MisoString -> Double -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# (MisoString
"shadowOffsetY" :: MisoString) (Double -> JSM ()) -> Double -> JSM ()
forall a b. (a -> b) -> a -> b
$ Double
y
interpret JSVal
ctx (StrokeStyle StyleArg
s) =
(JSVal
ctx JSVal -> MisoString -> JSVal -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# (MisoString
"strokeStyle" :: MisoString)) (JSVal -> JSM a) -> JSM JSVal -> JSM a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StyleArg -> JSM JSVal
renderStyleArg StyleArg
s
interpret JSVal
ctx (Scale (Double
w,Double
h)) = do
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"scale" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [Double
w,Double
h]
interpret JSVal
ctx (Rotate Double
x) =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"rotate" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [Double
x]
interpret JSVal
ctx (Transform (Double
a,Double
b,Double
c,Double
d,Double
e,Double
f)) =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"transform" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [Double
a,Double
b,Double
c,Double
d,Double
e,Double
f]
interpret JSVal
ctx (SetTransform (Double
a,Double
b,Double
c,Double
d,Double
e,Double
f)) =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"setTransform" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [Double
a,Double
b,Double
c,Double
d,Double
e,Double
f]
interpret JSVal
ctx (DrawImage (Image
img', Double
x',Double
y')) = do
img <- Image -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Image
img'
x <- toJSVal x'
y <- toJSVal y'
void $ ctx # ("drawImage" :: MisoString) $ [img,x,y]
interpret JSVal
ctx (DrawImage' (Image
img', Double
w',Double
x',Double
y',Double
z')) = do
img <- Image -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Image
img'
w <- toJSVal w'
x <- toJSVal x'
y <- toJSVal y'
z <- toJSVal z'
void $ ctx # ("drawImage" :: MisoString) $ [img,w,x,y,z]
interpret JSVal
ctx (CreateImageData (Double
x,Double
y)) =
JSVal -> a
JSVal -> ImageData
ImageData (JSVal -> a) -> JSM JSVal -> JSM a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"createImageData" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$
[Double
x,Double
y]
interpret JSVal
ctx (GetImageData (Double
w,Double
x,Double
y,Double
z)) =
JSVal -> a
JSVal -> ImageData
ImageData (JSVal -> a) -> JSM JSVal -> JSM a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
JSVal
ctx JSVal -> MisoString -> [Double] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"getImageData" :: MisoString) ([Double] -> JSM JSVal) -> [Double] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$
[Double
w,Double
x,Double
y,Double
z]
interpret JSVal
ctx (PutImageData (ImageData
imgData, Double
x',Double
y')) = do
img <- ImageData -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ImageData
imgData
x <- toJSVal x'
y <- toJSVal y'
void $
ctx # ("putImageData" :: MisoString) $
[img,x,y]
interpret JSVal
_ (SetImageData ImageData
imgData Int
index Double
value) = do
o <- ImageData
imgData ImageData -> MisoString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (MisoString
"data" :: MisoString)
(o <## index) value
interpret JSVal
_ (ImageDataHeight ImageData
imgData) = do
Just h <- JSVal -> JSM (Maybe a)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal (JSVal -> JSM (Maybe a)) -> JSM JSVal -> JSM (Maybe a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ImageData
imgData ImageData -> MisoString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (MisoString
"height" :: MisoString)
pure h
interpret JSVal
_ (ImageDataWidth ImageData
imgData) = do
Just w <- JSVal -> JSM (Maybe a)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal (JSVal -> JSM (Maybe a)) -> JSM JSVal -> JSM (Maybe a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ImageData
imgData ImageData -> MisoString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (MisoString
"width" :: MisoString)
pure w
interpret JSVal
ctx (GlobalAlpha Double
alpha) =
JSVal
ctx JSVal -> MisoString -> Double -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# (MisoString
"globalAlpha" :: MisoString) (Double -> JSM ()) -> Double -> JSM ()
forall a b. (a -> b) -> a -> b
$ Double
alpha
globalCompositeOperation :: CompositeOperation -> Canvas ()
globalCompositeOperation :: CompositeOperation -> Canvas ()
globalCompositeOperation = CompositeOperation -> Canvas ()
GlobalCompositeOperation
clearRect :: (Double, Double, Double, Double) -> Canvas ()
clearRect :: (Double, Double, Double, Double) -> Canvas ()
clearRect = (Double, Double, Double, Double) -> Canvas ()
ClearRect
fillRect :: (Double, Double, Double, Double) -> Canvas ()
fillRect :: (Double, Double, Double, Double) -> Canvas ()
fillRect = (Double, Double, Double, Double) -> Canvas ()
FillRect
strokeRect :: (Double, Double, Double, Double) -> Canvas ()
strokeRect :: (Double, Double, Double, Double) -> Canvas ()
strokeRect = (Double, Double, Double, Double) -> Canvas ()
StrokeRect
beginPath :: () -> Canvas ()
beginPath :: () -> Canvas ()
beginPath () = Canvas ()
BeginPath
closePath :: Canvas ()
closePath :: Canvas ()
closePath = Canvas ()
ClosePath
moveTo :: Coord -> Canvas ()
moveTo :: (Double, Double) -> Canvas ()
moveTo = (Double, Double) -> Canvas ()
MoveTo
lineTo :: Coord -> Canvas ()
lineTo :: (Double, Double) -> Canvas ()
lineTo = (Double, Double) -> Canvas ()
LineTo
fill :: Canvas ()
fill :: Canvas ()
fill = Canvas ()
Fill
rect :: (Double, Double, Double, Double) -> Canvas ()
rect :: (Double, Double, Double, Double) -> Canvas ()
rect = (Double, Double, Double, Double) -> Canvas ()
Rect
stroke :: () -> Canvas ()
stroke :: () -> Canvas ()
stroke () = Canvas ()
Stroke
bezierCurveTo :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
bezierCurveTo :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
bezierCurveTo = (Double, Double, Double, Double, Double, Double) -> Canvas ()
BezierCurveTo
arc :: (Double, Double, Double, Double, Double) -> Canvas ()
arc :: (Double, Double, Double, Double, Double) -> Canvas ()
arc = (Double, Double, Double, Double, Double) -> Canvas ()
Arc
arcTo :: (Double, Double, Double, Double, Double) -> Canvas ()
arcTo :: (Double, Double, Double, Double, Double) -> Canvas ()
arcTo = (Double, Double, Double, Double, Double) -> Canvas ()
ArcTo
quadraticCurveTo :: (Double, Double, Double, Double) -> Canvas ()
quadraticCurveTo :: (Double, Double, Double, Double) -> Canvas ()
quadraticCurveTo = (Double, Double, Double, Double) -> Canvas ()
QuadraticCurveTo
direction :: DirectionType -> Canvas ()
direction :: DirectionType -> Canvas ()
direction = DirectionType -> Canvas ()
Direction
fillText :: (MisoString, Double, Double) -> Canvas ()
fillText :: (MisoString, Double, Double) -> Canvas ()
fillText = (MisoString, Double, Double) -> Canvas ()
FillText
font :: MisoString -> Canvas ()
font :: MisoString -> Canvas ()
font = MisoString -> Canvas ()
Font
strokeText :: (MisoString, Double, Double) -> Canvas ()
strokeText :: (MisoString, Double, Double) -> Canvas ()
strokeText = (MisoString, Double, Double) -> Canvas ()
StrokeText
textAlign :: TextAlignType -> Canvas ()
textAlign :: TextAlignType -> Canvas ()
textAlign = TextAlignType -> Canvas ()
TextAlign
textBaseline :: TextBaselineType -> Canvas ()
textBaseline :: TextBaselineType -> Canvas ()
textBaseline = TextBaselineType -> Canvas ()
TextBaseline
addColorStop :: Gradient -> Double -> Color -> Canvas ()
addColorStop :: Gradient -> Double -> Color -> Canvas ()
addColorStop = Gradient -> Double -> Color -> Canvas ()
AddColorStop
createLinearGradient :: (Double, Double, Double, Double) -> Canvas Gradient
createLinearGradient :: (Double, Double, Double, Double) -> Canvas Gradient
createLinearGradient = (Double, Double, Double, Double) -> Canvas Gradient
CreateLinearGradient
createPattern :: Image -> PatternType -> Canvas Pattern
createPattern :: Image -> PatternType -> Canvas Pattern
createPattern = Image -> PatternType -> Canvas Pattern
CreatePattern
createRadialGradient :: (Double,Double,Double,Double,Double,Double) -> Canvas Gradient
createRadialGradient :: (Double, Double, Double, Double, Double, Double) -> Canvas Gradient
createRadialGradient = (Double, Double, Double, Double, Double, Double) -> Canvas Gradient
CreateRadialGradient
fillStyle :: StyleArg -> Canvas ()
fillStyle :: StyleArg -> Canvas ()
fillStyle = StyleArg -> Canvas ()
FillStyle
lineCap :: LineCapType -> Canvas ()
lineCap :: LineCapType -> Canvas ()
lineCap = LineCapType -> Canvas ()
LineCap
lineJoin :: LineJoinType -> Canvas ()
lineJoin :: LineJoinType -> Canvas ()
lineJoin = LineJoinType -> Canvas ()
LineJoin
lineWidth :: Double -> Canvas ()
lineWidth :: Double -> Canvas ()
lineWidth = Double -> Canvas ()
LineWidth
miterLimit :: Double -> Canvas ()
miterLimit :: Double -> Canvas ()
miterLimit = Double -> Canvas ()
MiterLimit
shadowBlur :: Double -> Canvas ()
shadowBlur :: Double -> Canvas ()
shadowBlur = Double -> Canvas ()
ShadowBlur
shadowColor :: Color -> Canvas ()
shadowColor :: Color -> Canvas ()
shadowColor = Color -> Canvas ()
ShadowColor
shadowOffsetX :: Double -> Canvas ()
shadowOffsetX :: Double -> Canvas ()
shadowOffsetX = Double -> Canvas ()
ShadowOffsetX
shadowOffsetY :: Double -> Canvas ()
shadowOffsetY :: Double -> Canvas ()
shadowOffsetY = Double -> Canvas ()
ShadowOffsetY
strokeStyle :: StyleArg -> Canvas ()
strokeStyle :: StyleArg -> Canvas ()
strokeStyle = StyleArg -> Canvas ()
StrokeStyle
scale :: (Double, Double) -> Canvas ()
scale :: (Double, Double) -> Canvas ()
scale = (Double, Double) -> Canvas ()
Scale
rotate :: Double -> Canvas ()
rotate :: Double -> Canvas ()
rotate = Double -> Canvas ()
Rotate
translate :: Coord -> Canvas ()
translate :: (Double, Double) -> Canvas ()
translate = (Double, Double) -> Canvas ()
Translate
transform :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
transform :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
transform = (Double, Double, Double, Double, Double, Double) -> Canvas ()
Transform
setTransform
:: (Double, Double, Double, Double, Double, Double)
-> Canvas ()
setTransform :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
setTransform = (Double, Double, Double, Double, Double, Double) -> Canvas ()
SetTransform
drawImage :: (Image, Double, Double) -> Canvas ()
drawImage :: (Image, Double, Double) -> Canvas ()
drawImage = (Image, Double, Double) -> Canvas ()
DrawImage
drawImage' :: (Image, Double, Double, Double, Double) -> Canvas ()
drawImage' :: (Image, Double, Double, Double, Double) -> Canvas ()
drawImage' = (Image, Double, Double, Double, Double) -> Canvas ()
DrawImage'
createImageData :: (Double, Double) -> Canvas ImageData
createImageData :: (Double, Double) -> Canvas ImageData
createImageData = (Double, Double) -> Canvas ImageData
CreateImageData
getImageData :: (Double, Double, Double, Double) -> Canvas ImageData
getImageData :: (Double, Double, Double, Double) -> Canvas ImageData
getImageData = (Double, Double, Double, Double) -> Canvas ImageData
GetImageData
setImageData :: ImageData -> Int -> Double -> Canvas ()
setImageData :: ImageData -> Int -> Double -> Canvas ()
setImageData = ImageData -> Int -> Double -> Canvas ()
SetImageData
height :: ImageData -> Canvas Double
height :: ImageData -> Canvas Double
height = ImageData -> Canvas Double
ImageDataHeight
width :: ImageData -> Canvas Double
width :: ImageData -> Canvas Double
width = ImageData -> Canvas Double
ImageDataWidth
putImageData :: (ImageData, Double, Double) -> Canvas ()
putImageData :: (ImageData, Double, Double) -> Canvas ()
putImageData = (ImageData, Double, Double) -> Canvas ()
PutImageData
globalAlpha :: Double -> Canvas ()
globalAlpha :: Double -> Canvas ()
globalAlpha = Double -> Canvas ()
GlobalAlpha
clip :: () -> Canvas ()
clip :: () -> Canvas ()
clip () = Canvas ()
Clip
save :: () -> Canvas ()
save :: () -> Canvas ()
save () = Canvas ()
Save
restore :: () -> Canvas ()
restore :: () -> Canvas ()
restore () = Canvas ()
Restore