-----------------------------------------------------------------------------
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Canvas
-- Copyright   :  (C) 2016-2025 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- [Canvas Example](https://canvas.haskell-miso.org)
-- [Canvas Source](https://github.com/dmjio/miso/blob/master/examples/canvas2d/Main.hs)
--
----------------------------------------------------------------------------
module Miso.Canvas
  ( -- * Types
    Canvas
  , Pattern            (..)
  , Gradient           (..)
  , ImageData          (..)
  , LineCapType        (..)
  , PatternType        (..)
  , LineJoinType       (..)
  , DirectionType      (..)
  , TextAlignType      (..)
  , TextBaselineType   (..)
  , CompositeOperation (..)
  , StyleArg           (..)
  , Coord
   -- * Property
  , canvas
  , canvas_
    -- * API
  , 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
  -- * Smart constructors
  , gradient
  , pattern_
  , color
  ) where
-----------------------------------------------------------------------------
import           Control.Monad.Reader (ReaderT, runReaderT, ask)
import           Language.Javascript.JSaddle ( JSM, JSVal, (#), fromJSVal, MakeArgs (..)
                                             , (<#), toJSVal, (!), fromJSValUnchecked
                                             , liftJSM, FromJSVal, Object (..)
                                             , ToJSVal, MakeObject, (<##)
                                             )
-----------------------------------------------------------------------------
import qualified Miso.FFI as FFI
import           Miso.FFI (Image)
import           Miso.Types
import           Miso.Style (Color, renderColor)
import           Miso.String (MisoString)
-----------------------------------------------------------------------------
-- | Another variant of canvas, this is not specialized to 'ReaderT'. This is
-- useful when building applications w/ three.js, or other libraries where
-- explicit context is not necessary.
canvas_
  :: forall action canvasState
   . (FromJSVal canvasState, ToJSVal canvasState)
  => [ Attribute action ]
  -> (DOMRef -> JSM canvasState)
  -- ^ Init function, takes 'DOMRef' as arg, returns canvas init. state.
  -> (canvasState -> JSM ())
  -- ^ Callback to render graphics using this canvas' context, takes init state as arg.
  -> View action
canvas_ :: forall action canvasState.
(FromJSVal canvasState, ToJSVal canvasState) =>
[Attribute action]
-> (Context -> JSM canvasState)
-> (canvasState -> JSM ())
-> View action
canvas_ [Attribute action]
attributes Context -> JSM canvasState
initialize_ canvasState -> JSM ()
draw_ = 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
initCallback Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: Attribute action
drawCallack Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: [Attribute action]
attributes

    initCallback :: Attribute action
    initCallback :: Attribute action
initCallback = (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
o LogLevel
_ Events
_ -> do
      (Function -> Object -> JSM ()) -> Object -> Function -> JSM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (MisoString -> Function -> Object -> JSM ()
forall v. ToJSVal v => MisoString -> v -> Object -> JSM ()
FFI.set MisoString
"onCreated") Object
o (Function -> JSM ()) -> JSM Function -> JSM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
        (Context -> JSM ()) -> JSM Function
FFI.syncCallback1 ((Context -> JSM ()) -> JSM Function)
-> (Context -> JSM ()) -> JSM Function
forall a b. (a -> b) -> a -> b
$ \Context
domRef -> do
          initialState <- Context -> JSM canvasState
initialize_ Context
domRef
          FFI.set "state" initialState (Object domRef)

    drawCallack :: Attribute action
    drawCallack :: Attribute action
drawCallack = (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
o LogLevel
_ Events
_ -> do
      (Function -> Object -> JSM ()) -> Object -> Function -> JSM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (MisoString -> Function -> Object -> JSM ()
forall v. ToJSVal v => MisoString -> v -> Object -> JSM ()
FFI.set MisoString
"draw") Object
o (Function -> JSM ()) -> JSM Function -> JSM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
        (Context -> JSM ()) -> JSM Function
FFI.syncCallback1 ((Context -> JSM ()) -> JSM Function)
-> (Context -> JSM ()) -> JSM Function
forall a b. (a -> b) -> a -> b
$ \Context
domRef -> do
          state <- Context -> JSM canvasState
forall a. FromJSVal a => Context -> JSM a
fromJSValUnchecked (Context -> JSM canvasState) -> JSM Context -> JSM canvasState
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Context
domRef Context -> MisoString -> JSM Context
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM Context
! (MisoString
"state" :: MisoString)
          draw_ state
-----------------------------------------------------------------------------
-- | Element for drawing on a [\<canvas\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/canvas).
-- This function abstracts over the context and interpret callback,
-- including dimension ("2d" or "3d") canvas.
canvas
  :: forall action canvasState
   . (FromJSVal canvasState, ToJSVal canvasState)
  => [ Attribute action ]
  -> (DOMRef -> Canvas canvasState)
  -- ^ Init function, takes 'DOMRef' as arg, returns canvas init. state.
  -> (canvasState -> Canvas ())
  -- ^ Callback to render graphics using this canvas' context, takes init state as arg.
  -> View action
canvas :: forall action canvasState.
(FromJSVal canvasState, ToJSVal canvasState) =>
[Attribute action]
-> (Context -> Canvas canvasState)
-> (canvasState -> Canvas ())
-> View action
canvas [Attribute action]
attributes Context -> Canvas canvasState
initialize canvasState -> Canvas ()
draw = 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
initCallback Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: Attribute action
drawCallack Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: [Attribute action]
attributes

    initCallback :: Attribute action
    initCallback :: Attribute action
initCallback = (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
_ -> do
      (Function -> Object -> JSM ()) -> Object -> Function -> JSM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (MisoString -> Function -> Object -> JSM ()
forall v. ToJSVal v => MisoString -> v -> Object -> JSM ()
FFI.set MisoString
"onCreated") Object
obj (Function -> JSM ()) -> JSM Function -> JSM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
        (Context -> JSM ()) -> JSM Function
FFI.syncCallback1 ((Context -> JSM ()) -> JSM Function)
-> (Context -> JSM ()) -> JSM Function
forall a b. (a -> b) -> a -> b
$ \Context
domRef -> do
          ctx <- Context
domRef Context -> MisoString -> [MisoString] -> JSM Context
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM Context
# (MisoString
"getContext" :: MisoString) ([MisoString] -> JSM Context) -> [MisoString] -> JSM Context
forall a b. (a -> b) -> a -> b
$ [MisoString
"2d" :: MisoString]
          initialState <- runReaderT (initialize domRef) ctx
          FFI.set "state" initialState (Object domRef)

    drawCallack :: Attribute action
    drawCallack :: Attribute action
drawCallack = (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
_ -> do
      (Function -> Object -> JSM ()) -> Object -> Function -> JSM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (MisoString -> Function -> Object -> JSM ()
forall v. ToJSVal v => MisoString -> v -> Object -> JSM ()
FFI.set MisoString
"draw") Object
obj (Function -> JSM ()) -> JSM Function -> JSM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
        (Context -> JSM ()) -> JSM Function
FFI.syncCallback1 ((Context -> JSM ()) -> JSM Function)
-> (Context -> JSM ()) -> JSM Function
forall a b. (a -> b) -> a -> b
$ \Context
domRef -> do
          jval <- Context
domRef Context -> MisoString -> JSM Context
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM Context
! (MisoString
"state" :: MisoString)
          initialState <- fromJSValUnchecked jval
          ctx <- domRef # ("getContext" :: MisoString) $ ["2d" :: MisoString]
          runReaderT (draw initialState) ctx
-----------------------------------------------------------------------------
data PatternType = Repeat | RepeatX | RepeatY | NoRepeat
-----------------------------------------------------------------------------
instance ToJSVal PatternType where
  toJSVal :: PatternType -> JSM Context
toJSVal = MisoString -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal (MisoString -> JSM Context)
-> (PatternType -> MisoString) -> PatternType -> JSM Context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternType -> MisoString
renderPattern
-----------------------------------------------------------------------------
instance FromJSVal PatternType where
  fromJSVal :: Context -> JSM (Maybe PatternType)
fromJSVal Context
pat =
    forall a. FromJSVal a => Context -> JSM a
fromJSValUnchecked @MisoString Context
pat JSM MisoString
-> (MisoString -> JSM (Maybe PatternType))
-> JSM (Maybe PatternType)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      MisoString
"repeat" -> Maybe PatternType -> JSM (Maybe PatternType)
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PatternType -> Maybe PatternType
forall a. a -> Maybe a
Just PatternType
Repeat)
      MisoString
"repeat-x" -> Maybe PatternType -> JSM (Maybe PatternType)
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PatternType -> Maybe PatternType
forall a. a -> Maybe a
Just PatternType
RepeatX)
      MisoString
"repeat-y" -> Maybe PatternType -> JSM (Maybe PatternType)
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PatternType -> Maybe PatternType
forall a. a -> Maybe a
Just PatternType
RepeatY)
      MisoString
"no-repeat" -> Maybe PatternType -> JSM (Maybe PatternType)
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PatternType -> Maybe PatternType
forall a. a -> Maybe a
Just PatternType
NoRepeat)
      MisoString
_ -> Maybe PatternType -> JSM (Maybe PatternType)
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PatternType
forall a. Maybe a
Nothing
-----------------------------------------------------------------------------
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 Context
renderStyleArg (ColorArg Color
c)    = MisoString -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal (Color -> MisoString
renderColor Color
c)
renderStyleArg (GradientArg Gradient
g) = Gradient -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal Gradient
g
renderStyleArg (PatternArg Pattern
p)  = Pattern -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal Pattern
p
-----------------------------------------------------------------------------
instance MakeArgs StyleArg where
  makeArgs :: StyleArg -> JSM [Context]
makeArgs StyleArg
arg = (Context -> [Context] -> [Context]
forall a. a -> [a] -> [a]
:[]) (Context -> [Context]) -> JSM Context -> JSM [Context]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StyleArg -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal StyleArg
arg
-----------------------------------------------------------------------------
instance ToJSVal StyleArg where
  toJSVal :: StyleArg -> JSM Context
toJSVal = JSM Context -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal (JSM Context -> JSM Context)
-> (StyleArg -> JSM Context) -> StyleArg -> JSM Context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleArg -> JSM Context
renderStyleArg
-----------------------------------------------------------------------------
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)
-----------------------------------------------------------------------------
instance MakeArgs LineCapType where
  makeArgs :: LineCapType -> JSM [Context]
makeArgs LineCapType
arg = (Context -> [Context] -> [Context]
forall a. a -> [a] -> [a]
:[]) (Context -> [Context]) -> JSM Context -> JSM [Context]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LineCapType -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal LineCapType
arg
-----------------------------------------------------------------------------
instance ToJSVal LineCapType where
  toJSVal :: LineCapType -> JSM Context
toJSVal = MisoString -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal (MisoString -> JSM Context)
-> (LineCapType -> MisoString) -> LineCapType -> JSM Context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineCapType -> MisoString
renderLineCapType
-----------------------------------------------------------------------------
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)
-----------------------------------------------------------------------------
instance MakeArgs LineJoinType where
  makeArgs :: LineJoinType -> JSM [Context]
makeArgs LineJoinType
arg = (Context -> [Context] -> [Context]
forall a. a -> [a] -> [a]
:[]) (Context -> [Context]) -> JSM Context -> JSM [Context]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LineJoinType -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal LineJoinType
arg
-----------------------------------------------------------------------------
instance ToJSVal LineJoinType where
  toJSVal :: LineJoinType -> JSM Context
toJSVal = MisoString -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal (MisoString -> JSM Context)
-> (LineJoinType -> MisoString) -> LineJoinType -> JSM Context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineJoinType -> MisoString
renderLineJoinType
-----------------------------------------------------------------------------
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)
-----------------------------------------------------------------------------
instance MakeArgs DirectionType where
  makeArgs :: DirectionType -> JSM [Context]
makeArgs DirectionType
arg = (Context -> [Context] -> [Context]
forall a. a -> [a] -> [a]
:[]) (Context -> [Context]) -> JSM Context -> JSM [Context]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DirectionType -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal DirectionType
arg
-----------------------------------------------------------------------------
instance ToJSVal DirectionType where
  toJSVal :: DirectionType -> JSM Context
toJSVal = MisoString -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal (MisoString -> JSM Context)
-> (DirectionType -> MisoString) -> DirectionType -> JSM Context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirectionType -> MisoString
renderDirectionType
-----------------------------------------------------------------------------
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)
-----------------------------------------------------------------------------
instance MakeArgs TextAlignType where
  makeArgs :: TextAlignType -> JSM [Context]
makeArgs TextAlignType
arg = (Context -> [Context] -> [Context]
forall a. a -> [a] -> [a]
:[]) (Context -> [Context]) -> JSM Context -> JSM [Context]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextAlignType -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal TextAlignType
arg
-----------------------------------------------------------------------------
instance ToJSVal TextAlignType where
  toJSVal :: TextAlignType -> JSM Context
toJSVal = MisoString -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal (MisoString -> JSM Context)
-> (TextAlignType -> MisoString) -> TextAlignType -> JSM Context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextAlignType -> MisoString
renderTextAlignType
-----------------------------------------------------------------------------
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)
-----------------------------------------------------------------------------
instance MakeArgs TextBaselineType where
  makeArgs :: TextBaselineType -> JSM [Context]
makeArgs TextBaselineType
arg = (Context -> [Context] -> [Context]
forall a. a -> [a] -> [a]
:[]) (Context -> [Context]) -> JSM Context -> JSM [Context]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextBaselineType -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal TextBaselineType
arg
-----------------------------------------------------------------------------
instance ToJSVal TextBaselineType where
  toJSVal :: TextBaselineType -> JSM Context
toJSVal = MisoString -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal (MisoString -> JSM Context)
-> (TextBaselineType -> MisoString)
-> TextBaselineType
-> JSM Context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextBaselineType -> MisoString
renderTextBaselineType
-----------------------------------------------------------------------------
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)
-----------------------------------------------------------------------------
instance MakeArgs CompositeOperation where
  makeArgs :: CompositeOperation -> JSM [Context]
makeArgs CompositeOperation
arg = (Context -> [Context] -> [Context]
forall a. a -> [a] -> [a]
:[]) (Context -> [Context]) -> JSM Context -> JSM [Context]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompositeOperation -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal CompositeOperation
arg
-----------------------------------------------------------------------------
instance ToJSVal CompositeOperation where
  toJSVal :: CompositeOperation -> JSM Context
toJSVal = MisoString -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal (MisoString -> JSM Context)
-> (CompositeOperation -> MisoString)
-> CompositeOperation
-> JSM Context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompositeOperation -> MisoString
renderCompositeOperation
-----------------------------------------------------------------------------
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 Context
Pattern -> JSM Context
(Pattern -> JSM Context)
-> ([Pattern] -> JSM Context) -> ToJSVal Pattern
forall a. (a -> JSM Context) -> ([a] -> JSM Context) -> ToJSVal a
$ctoJSVal :: Pattern -> JSM Context
toJSVal :: Pattern -> JSM Context
$ctoJSValListOf :: [Pattern] -> JSM Context
toJSValListOf :: [Pattern] -> JSM Context
ToJSVal)
-----------------------------------------------------------------------------
instance FromJSVal Pattern where
  fromJSVal :: Context -> JSM (Maybe Pattern)
fromJSVal = Maybe Pattern -> JSM (Maybe Pattern)
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Pattern -> JSM (Maybe Pattern))
-> (Context -> Maybe Pattern) -> Context -> JSM (Maybe Pattern)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> Maybe Pattern
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern -> Maybe Pattern)
-> (Context -> Pattern) -> Context -> Maybe Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> Pattern
Pattern
-----------------------------------------------------------------------------
newtype Gradient = Gradient JSVal deriving ([Gradient] -> JSM Context
Gradient -> JSM Context
(Gradient -> JSM Context)
-> ([Gradient] -> JSM Context) -> ToJSVal Gradient
forall a. (a -> JSM Context) -> ([a] -> JSM Context) -> ToJSVal a
$ctoJSVal :: Gradient -> JSM Context
toJSVal :: Gradient -> JSM Context
$ctoJSValListOf :: [Gradient] -> JSM Context
toJSValListOf :: [Gradient] -> JSM Context
ToJSVal)
-----------------------------------------------------------------------------
instance FromJSVal Gradient where
  fromJSVal :: Context -> JSM (Maybe Gradient)
fromJSVal = Maybe Gradient -> JSM (Maybe Gradient)
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Gradient -> JSM (Maybe Gradient))
-> (Context -> Maybe Gradient) -> Context -> JSM (Maybe Gradient)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gradient -> Maybe Gradient
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Gradient -> Maybe Gradient)
-> (Context -> Gradient) -> Context -> Maybe Gradient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> Gradient
Gradient
-----------------------------------------------------------------------------
newtype ImageData = ImageData JSVal deriving ([ImageData] -> JSM Context
ImageData -> JSM Context
(ImageData -> JSM Context)
-> ([ImageData] -> JSM Context) -> ToJSVal ImageData
forall a. (a -> JSM Context) -> ([a] -> JSM Context) -> ToJSVal a
$ctoJSVal :: ImageData -> JSM Context
toJSVal :: ImageData -> JSM Context
$ctoJSValListOf :: [ImageData] -> JSM Context
toJSValListOf :: [ImageData] -> JSM Context
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)
-----------------------------------------------------------------------------
instance MakeArgs ImageData where
  makeArgs :: ImageData -> JSM [Context]
makeArgs ImageData
args = (Context -> [Context] -> [Context]
forall a. a -> [a] -> [a]
:[]) (Context -> [Context]) -> JSM Context -> JSM [Context]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImageData -> JSM Context
forall a. ToJSVal a => a -> JSM Context
toJSVal ImageData
args
-----------------------------------------------------------------------------
instance FromJSVal ImageData where
  fromJSVal :: Context -> JSM (Maybe ImageData)
fromJSVal = Maybe ImageData -> JSM (Maybe ImageData)
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ImageData -> JSM (Maybe ImageData))
-> (Context -> Maybe ImageData) -> Context -> JSM (Maybe ImageData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImageData -> Maybe ImageData
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImageData -> Maybe ImageData)
-> (Context -> ImageData) -> Context -> Maybe ImageData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> ImageData
ImageData
-----------------------------------------------------------------------------
type Coord = (Double, Double)
-----------------------------------------------------------------------------
type Context = JSVal
-----------------------------------------------------------------------------
call :: (FromJSVal a, MakeArgs args) => MisoString -> args -> Canvas a
call :: forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
name args
arg = do
  ctx <- ReaderT Context JSM Context
forall r (m :: * -> *). MonadReader r m => m r
ask
  liftJSM $ fromJSValUnchecked =<< do
    ctx # name $ arg
-----------------------------------------------------------------------------
set :: MakeArgs args => MisoString -> args -> Canvas ()
set :: forall args. MakeArgs args => MisoString -> args -> Canvas ()
set MisoString
name args
arg = do
  ctx <- ReaderT Context JSM Context
forall r (m :: * -> *). MonadReader r m => m r
ask
  liftJSM (ctx <# name $ makeArgs arg)
-----------------------------------------------------------------------------
-- | DSL for expressing operations on 'canvas_'
type Canvas a = ReaderT Context JSM a
-----------------------------------------------------------------------------
-- | [ctx.globalCompositeOperation = "source-over"](https://www.w3schools.com/tags/canvas_globalcompositeoperation.asp)
globalCompositeOperation :: CompositeOperation -> Canvas ()
globalCompositeOperation :: CompositeOperation -> Canvas ()
globalCompositeOperation = MisoString -> CompositeOperation -> Canvas ()
forall args. MakeArgs args => MisoString -> args -> Canvas ()
set MisoString
"globalCompositeOperation"
-----------------------------------------------------------------------------
-- | [ctx.clearRect(x,y,width,height)](https://www.w3schools.com/tags/canvas_clearrect.asp)
clearRect :: (Double, Double, Double, Double) -> Canvas ()
clearRect :: (Double, Double, Double, Double) -> Canvas ()
clearRect = MisoString -> (Double, Double, Double, Double) -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"clearRect"
-----------------------------------------------------------------------------
-- | [ctx.fillRect(x,y,width,height)](https://www.w3schools.com/tags/canvas_fillrect.asp)
fillRect :: (Double, Double, Double, Double) -> Canvas ()
fillRect :: (Double, Double, Double, Double) -> Canvas ()
fillRect = MisoString -> (Double, Double, Double, Double) -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"fillRect"
-----------------------------------------------------------------------------
-- | [ctx.strokeRect(x,y,width,height)](https://www.w3schools.com/tags/canvas_strokerect.asp)
strokeRect :: (Double, Double, Double, Double) -> Canvas ()
strokeRect :: (Double, Double, Double, Double) -> Canvas ()
strokeRect = MisoString -> (Double, Double, Double, Double) -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"strokeRect"
-----------------------------------------------------------------------------
-- | [ctx.beginPath()](https://www.w3schools.com/tags/canvas_beginpath.asp)
beginPath :: () -> Canvas ()
beginPath :: () -> Canvas ()
beginPath = MisoString -> () -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"beginPath"
-----------------------------------------------------------------------------
-- | [ctx.closePath()](https://www.w3schools.com/tags/canvas_closepath.asp)
closePath :: () -> Canvas ()
closePath :: () -> Canvas ()
closePath = MisoString -> () -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"closePath"
-----------------------------------------------------------------------------
-- | [ctx.moveTo(x,y)](https://www.w3schools.com/tags/canvas_moveto.asp)
moveTo :: Coord -> Canvas ()
moveTo :: Coord -> Canvas ()
moveTo = MisoString -> Coord -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"moveTo"
-----------------------------------------------------------------------------
-- | [ctx.lineTo(x,y)](https://www.w3schools.com/tags/canvas_lineto.asp)
lineTo :: Coord -> Canvas ()
lineTo :: Coord -> Canvas ()
lineTo = MisoString -> Coord -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"lineTo"
-----------------------------------------------------------------------------
-- | [ctx.fill()](https://www.w3schools.com/tags/canvas_fill.asp)
fill :: () -> Canvas ()
fill :: () -> Canvas ()
fill = MisoString -> () -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"fill"
-----------------------------------------------------------------------------
-- | [ctx.rect(x,y,width,height)](https://www.w3schools.com/tags/canvas_rect.asp)
rect :: (Double, Double, Double, Double) -> Canvas ()
rect :: (Double, Double, Double, Double) -> Canvas ()
rect = MisoString -> (Double, Double, Double, Double) -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"rect"
-----------------------------------------------------------------------------
-- | [ctx.stroke()](https://www.w3schools.com/tags/canvas_stroke.asp)
stroke :: () -> Canvas ()
stroke :: () -> Canvas ()
stroke = MisoString -> () -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"stroke"
-----------------------------------------------------------------------------
-- | [ctx.bezierCurveTo(cp1x,cp1y,cp2x,cp2y,x,y)](https://www.w3schools.com/tags/canvas_beziercurveto.asp)
bezierCurveTo :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
bezierCurveTo :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
bezierCurveTo = MisoString
-> (Double, Double, Double, Double, Double, Double) -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"bezierCurveTo"
-----------------------------------------------------------------------------
-- | [context.arc(x, y, r, sAngle, eAngle, counterclockwise)](https://www.w3schools.com/tags/canvas_arc.asp)
arc :: (Double, Double, Double, Double, Double) -> Canvas ()
arc :: (Double, Double, Double, Double, Double) -> Canvas ()
arc = MisoString -> (Double, Double, Double, Double, Double) -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"arc"
-----------------------------------------------------------------------------
-- | [context.arcTo(x1, y1, x2, y2, r)](https://www.w3schools.com/tags/canvas_arcto.asp)
arcTo :: (Double, Double, Double, Double, Double) -> Canvas ()
arcTo :: (Double, Double, Double, Double, Double) -> Canvas ()
arcTo = MisoString -> (Double, Double, Double, Double, Double) -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"arcTo"
-----------------------------------------------------------------------------
-- | [context.quadraticCurveTo(cpx,cpy,x,y)](https://www.w3schools.com/tags/canvas_quadraticcurveto.asp)
quadraticCurveTo :: (Double, Double, Double, Double) -> Canvas ()
quadraticCurveTo :: (Double, Double, Double, Double) -> Canvas ()
quadraticCurveTo = MisoString -> (Double, Double, Double, Double) -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"quadraticCurveTo"
-----------------------------------------------------------------------------
-- | [context.direction = "ltr"](https://www.w3schools.com/tags/canvas_direction.asp)
direction :: DirectionType -> Canvas ()
direction :: DirectionType -> Canvas ()
direction = MisoString -> DirectionType -> Canvas ()
forall args. MakeArgs args => MisoString -> args -> Canvas ()
set MisoString
"direction"
-----------------------------------------------------------------------------
-- | [context.fillText(text,x,y)](https://www.w3schools.com/tags/canvas_filltext.asp)
fillText :: (MisoString, Double, Double) -> Canvas ()
fillText :: (MisoString, Double, Double) -> Canvas ()
fillText = MisoString -> (MisoString, Double, Double) -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"fillText"
-----------------------------------------------------------------------------
-- | [context.font = "italic small-caps bold 12px arial"](https://www.w3schools.com/tags/canvas_font.asp)
font :: MisoString -> Canvas ()
font :: MisoString -> Canvas ()
font = MisoString -> MisoString -> Canvas ()
forall args. MakeArgs args => MisoString -> args -> Canvas ()
set MisoString
"font"
-----------------------------------------------------------------------------
-- | [ctx.strokeText()](https://www.w3schools.com/tags/canvas_stroketext.asp)
strokeText :: (MisoString, Double, Double) -> Canvas ()
strokeText :: (MisoString, Double, Double) -> Canvas ()
strokeText = MisoString -> (MisoString, Double, Double) -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"strokeText"
-----------------------------------------------------------------------------
-- | [ctx.textAlign = "start"](https://www.w3schools.com/tags/canvas_textalign.asp)
textAlign :: TextAlignType -> Canvas ()
textAlign :: TextAlignType -> Canvas ()
textAlign = MisoString -> TextAlignType -> Canvas ()
forall args. MakeArgs args => MisoString -> args -> Canvas ()
set MisoString
"textAlign"
-----------------------------------------------------------------------------
-- | [ctx.textBaseline = "top"](https://www.w3schools.com/tags/canvas_textBaseLine.asp)
textBaseline :: TextBaselineType -> Canvas ()
textBaseline :: TextBaselineType -> Canvas ()
textBaseline = MisoString -> TextBaselineType -> Canvas ()
forall args. MakeArgs args => MisoString -> args -> Canvas ()
set MisoString
"textBaseline"
-----------------------------------------------------------------------------
-- | [gradient.addColorStop(stop,color)](https://www.w3schools.com/tags/canvas_addcolorstop.asp)
addColorStop :: (Gradient, Double, Color) -> Canvas ()
addColorStop :: (Gradient, Double, Color) -> Canvas ()
addColorStop = MisoString -> (Gradient, Double, Color) -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"addColorStop"
-----------------------------------------------------------------------------
-- | [ctx.createLinearGradient(x0,y0,x1,y1)](https://www.w3schools.com/tags/canvas_createlineargradient.asp)
createLinearGradient :: (Double, Double, Double, Double) -> Canvas Gradient
createLinearGradient :: (Double, Double, Double, Double) -> Canvas Gradient
createLinearGradient = MisoString -> (Double, Double, Double, Double) -> Canvas Gradient
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"createLinearGradient"
-----------------------------------------------------------------------------
-- | [ctx.createPattern(image, "repeat")](https://www.w3schools.com/tags/canvas_createpattern.asp)
createPattern :: (Image, PatternType) -> Canvas Pattern
createPattern :: (Image, PatternType) -> Canvas Pattern
createPattern = MisoString -> (Image, PatternType) -> Canvas Pattern
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"createPattern"
-----------------------------------------------------------------------------
-- | [ctx.createRadialGradient(x0,y0,r0,x1,y1,r1)](https://www.w3schools.com/tags/canvas_createradialgradient.asp)
createRadialGradient :: (Double,Double,Double,Double,Double,Double) -> Canvas Gradient
createRadialGradient :: (Double, Double, Double, Double, Double, Double) -> Canvas Gradient
createRadialGradient = MisoString
-> (Double, Double, Double, Double, Double, Double)
-> Canvas Gradient
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"createRadialGradient"
-----------------------------------------------------------------------------
-- | [ctx.fillStyle = "red"](https://www.w3schools.com/tags/canvas_fillstyle.asp)
fillStyle :: StyleArg -> Canvas ()
fillStyle :: StyleArg -> Canvas ()
fillStyle = MisoString -> StyleArg -> Canvas ()
forall args. MakeArgs args => MisoString -> args -> Canvas ()
set MisoString
"fillStyle"
-----------------------------------------------------------------------------
-- | [ctx.lineCap = "butt"](https://www.w3schools.com/tags/canvas_lineCap.asp)
lineCap :: LineCapType -> Canvas ()
lineCap :: LineCapType -> Canvas ()
lineCap = MisoString -> LineCapType -> Canvas ()
forall args. MakeArgs args => MisoString -> args -> Canvas ()
set MisoString
"lineCap"
-----------------------------------------------------------------------------
-- | [ctx.lineJoin = "bevel"](https://www.w3schools.com/tags/canvas_lineJoin.asp)
lineJoin :: LineJoinType -> Canvas ()
lineJoin :: LineJoinType -> Canvas ()
lineJoin = MisoString -> LineJoinType -> Canvas ()
forall args. MakeArgs args => MisoString -> args -> Canvas ()
set MisoString
"lineJoin"
-----------------------------------------------------------------------------
-- | [ctx.lineWidth = 10](https://www.w3schools.com/tags/canvas_lineWidth.asp)
lineWidth :: Double -> Canvas ()
lineWidth :: Double -> Canvas ()
lineWidth = MisoString -> Double -> Canvas ()
forall args. MakeArgs args => MisoString -> args -> Canvas ()
set MisoString
"lineWidth"
-----------------------------------------------------------------------------
-- | [ctx.miterLimit = 10](https://www.w3schools.com/tags/canvas_miterLimit.asp)
miterLimit :: Double -> Canvas ()
miterLimit :: Double -> Canvas ()
miterLimit = MisoString -> Double -> Canvas ()
forall args. MakeArgs args => MisoString -> args -> Canvas ()
set MisoString
"miterLimit"
-----------------------------------------------------------------------------
-- | [ctx.shadowBlur = 10](https://www.w3schools.com/tags/canvas_shadowBlur.asp)
shadowBlur :: Double -> Canvas ()
shadowBlur :: Double -> Canvas ()
shadowBlur = MisoString -> Double -> Canvas ()
forall args. MakeArgs args => MisoString -> args -> Canvas ()
set MisoString
"shadowBlur"
-----------------------------------------------------------------------------
-- | [ctx.shadowColor = "red"](https://www.w3schools.com/tags/canvas_shadowColor.asp)
shadowColor :: Color -> Canvas ()
shadowColor :: Color -> Canvas ()
shadowColor = MisoString -> Color -> Canvas ()
forall args. MakeArgs args => MisoString -> args -> Canvas ()
set MisoString
"shadowColor"
-----------------------------------------------------------------------------
-- | [ctx.shadowOffsetX = 20](https://www.w3schools.com/tags/canvas_shadowOffsetX.asp)
shadowOffsetX :: Double -> Canvas ()
shadowOffsetX :: Double -> Canvas ()
shadowOffsetX = MisoString -> Double -> Canvas ()
forall args. MakeArgs args => MisoString -> args -> Canvas ()
set MisoString
"shadowOffsetX"
-----------------------------------------------------------------------------
-- | [ctx.shadowOffsetY = 20](https://www.w3schools.com/tags/canvas_shadowOffsetY.asp)
shadowOffsetY :: Double -> Canvas ()
shadowOffsetY :: Double -> Canvas ()
shadowOffsetY = MisoString -> Double -> Canvas ()
forall args. MakeArgs args => MisoString -> args -> Canvas ()
set MisoString
"shadowOffsetY"
-----------------------------------------------------------------------------
-- | [ctx.strokeStyle = "red"](https://www.w3schools.com/tags/canvas_strokeStyle.asp)
strokeStyle :: StyleArg -> Canvas ()
strokeStyle :: StyleArg -> Canvas ()
strokeStyle = MisoString -> StyleArg -> Canvas ()
forall args. MakeArgs args => MisoString -> args -> Canvas ()
set MisoString
"strokeStyle"
-----------------------------------------------------------------------------
-- | [ctx.scale(width,height)](https://www.w3schools.com/tags/canvas_scale.asp)
scale :: (Double, Double) -> Canvas ()
scale :: Coord -> Canvas ()
scale = MisoString -> Coord -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"scale"
-----------------------------------------------------------------------------
-- | [ctx.rotate(angle)](https://www.w3schools.com/tags/canvas_rotate.asp)
rotate :: Double -> Canvas ()
rotate :: Double -> Canvas ()
rotate = MisoString -> Double -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"rotate"
-----------------------------------------------------------------------------
-- | [ctx.translate(angle)](https://www.w3schools.com/tags/canvas_translate.asp)
translate :: Coord -> Canvas ()
translate :: Coord -> Canvas ()
translate = MisoString -> Coord -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"translate"
-----------------------------------------------------------------------------
-- | [ctx.transform(a,b,c,d,e,f)](https://www.w3schools.com/tags/canvas_transform.asp)
transform :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
transform :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
transform = MisoString
-> (Double, Double, Double, Double, Double, Double) -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"transform"
-----------------------------------------------------------------------------
-- | [ctx.setTransform(a,b,c,d,e,f)](https://www.w3schools.com/tags/canvas_setTransform.asp)
setTransform :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
setTransform :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
setTransform = MisoString
-> (Double, Double, Double, Double, Double, Double) -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"setTransform"
----------------------------------------------------------------------------
-- | [ctx.drawImage(image,x,y)](https://www.w3schools.com/tags/canvas_drawImage.asp)
drawImage :: (Image, Double, Double) -> Canvas ()
drawImage :: (Image, Double, Double) -> Canvas ()
drawImage = MisoString -> (Image, Double, Double) -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"drawImage"
-----------------------------------------------------------------------------
-- | [ctx.drawImage(image,x,y)](https://www.w3schools.com/tags/canvas_drawImage.asp)
drawImage' :: (Image, Double, Double, Double, Double) -> Canvas ()
drawImage' :: (Image, Double, Double, Double, Double) -> Canvas ()
drawImage' = MisoString -> (Image, Double, Double, Double, Double) -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"drawImage"
-----------------------------------------------------------------------------
-- | [ctx.createImageData(width,height)](https://www.w3schools.com/tags/canvas_createImageData.asp)
createImageData :: (Double, Double) -> Canvas ImageData
createImageData :: Coord -> Canvas ImageData
createImageData = MisoString -> Coord -> Canvas ImageData
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"createImageData"
-----------------------------------------------------------------------------
-- | [ctx.getImageData(w,x,y,z)](https://www.w3schools.com/tags/canvas_getImageData.asp)
getImageData :: (Double, Double, Double, Double) -> Canvas ImageData
getImageData :: (Double, Double, Double, Double) -> Canvas ImageData
getImageData = MisoString -> (Double, Double, Double, Double) -> Canvas ImageData
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"getImageData"
-----------------------------------------------------------------------------
-- | [imageData.data[index] = 255](https://www.w3schools.com/tags/canvas_imagedata_data.asp)
setImageData :: (ImageData, Int, Double) -> Canvas ()
setImageData :: (ImageData, Int, Double) -> Canvas ()
setImageData (ImageData
imgData, Int
index, Double
value) = JSM () -> Canvas ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> Canvas ()) -> JSM () -> Canvas ()
forall a b. (a -> b) -> a -> b
$ do
   o <- ImageData
imgData ImageData -> MisoString -> JSM Context
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM Context
! (MisoString
"data" :: MisoString)
   (o <## index) value
-----------------------------------------------------------------------------
-- | [imageData.height](https://www.w3schools.com/tags/canvas_imagedata_height.asp)
height :: ImageData -> Canvas Double
height :: ImageData -> Canvas Double
height (ImageData Context
imgData) = JSM Double -> Canvas Double
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM Double -> Canvas Double) -> JSM Double -> Canvas Double
forall a b. (a -> b) -> a -> b
$ do
  Context -> JSM Double
forall a. FromJSVal a => Context -> JSM a
fromJSValUnchecked (Context -> JSM Double) -> JSM Context -> JSM Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Context
imgData Context -> MisoString -> JSM Context
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM Context
! (MisoString
"height" :: MisoString)
-----------------------------------------------------------------------------
-- | [imageData.width](https://www.w3schools.com/tags/canvas_imagedata_width.asp)
width :: ImageData -> Canvas Double
width :: ImageData -> Canvas Double
width (ImageData Context
imgData) = JSM Double -> Canvas Double
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM Double -> Canvas Double) -> JSM Double -> Canvas Double
forall a b. (a -> b) -> a -> b
$ do
  Context -> JSM Double
forall a. FromJSVal a => Context -> JSM a
fromJSValUnchecked (Context -> JSM Double) -> JSM Context -> JSM Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Context
imgData Context -> MisoString -> JSM Context
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM Context
! (MisoString
"width" :: MisoString)
-----------------------------------------------------------------------------
-- | [ctx.putImageData(imageData,x,y)](https://www.w3schools.com/tags/canvas_putImageData.asp)
putImageData :: (ImageData, Double, Double) -> Canvas ()
putImageData :: (ImageData, Double, Double) -> Canvas ()
putImageData = MisoString -> (ImageData, Double, Double) -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"putImageData"
-----------------------------------------------------------------------------
-- | [ctx.globalAlpha = 0.2](https://www.w3schools.com/tags/canvas_globalAlpha.asp)
globalAlpha :: Double -> Canvas ()
globalAlpha :: Double -> Canvas ()
globalAlpha = MisoString -> Double -> Canvas ()
forall args. MakeArgs args => MisoString -> args -> Canvas ()
set MisoString
"globalAlpha"
-----------------------------------------------------------------------------
-- | [ctx.clip()](https://www.w3schools.com/tags/canvas_clip.asp)
clip :: () -> Canvas ()
clip :: () -> Canvas ()
clip = MisoString -> () -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"clip"
-----------------------------------------------------------------------------
-- | [ctx.save()](https://www.w3schools.com/tags/canvas_save.asp)
save :: () -> Canvas ()
save :: () -> Canvas ()
save = MisoString -> () -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"save"
-----------------------------------------------------------------------------
-- | [ctx.restore()](https://www.w3schools.com/tags/canvas_restore.asp)
restore :: () -> Canvas ()
restore :: () -> Canvas ()
restore = MisoString -> () -> Canvas ()
forall a args.
(FromJSVal a, MakeArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"restore"
-----------------------------------------------------------------------------