-----------------------------------------------------------------------------
{-# 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)
--
----------------------------------------------------------------------------
module Miso.Canvas
  ( -- * Types
    Canvas
  , CanvasContext2D
  , Pattern            (..)
  , Gradient           (..)
  , ImageData          (..)
  , LineCapType        (..)
  , PatternType        (..)
  , LineJoinType       (..)
  , DirectionType      (..)
  , TextAlignType      (..)
  , TextBaselineType   (..)
  , CompositeOperation (..)
  , StyleArg           (..)
  , Coord
   -- * Property
  , canvas
  , canvas_
    -- * API
  , set
  , 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.IO.Class (liftIO)
import           Control.Monad.Reader (ReaderT, runReaderT, ask)
-----------------------------------------------------------------------------
import           Miso.DSL hiding (call)
import qualified Miso.FFI as FFI
import           Miso.FFI (Image)
import           Miso.Types
import           Miso.CSS (Color, renderColor)
-----------------------------------------------------------------------------
-- | Another variant of canvas, this is not specialized to 'ReaderT'. This is
-- useful when building applications with three.js, or other libraries where
-- explicit context is not necessary.
canvas_
  :: forall model action canvasState
   . (FromJSVal canvasState, ToJSVal canvasState)
  => [ Attribute action ]
  -> (DOMRef -> IO canvasState)
  -- ^ Init function, takes 'DOMRef' as arg, returns canvas init. state.
  -> (canvasState -> IO ())
  -- ^ Callback to render graphics using this canvas' context, takes init state as arg.
  -> View model action
canvas_ :: forall model action canvasState.
(FromJSVal canvasState, ToJSVal canvasState) =>
[Attribute action]
-> (CanvasContext2D -> IO canvasState)
-> (canvasState -> IO ())
-> View model action
canvas_ [Attribute action]
attributes CanvasContext2D -> IO canvasState
initialize_ canvasState -> IO ()
draw_ = NS
-> MisoString
-> [Attribute action]
-> [View model action]
-> View model action
forall action model.
NS
-> MisoString
-> [Attribute action]
-> [View model action]
-> View model 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 -> VTree -> LogLevel -> Events -> IO ())
-> Attribute action
forall action.
(Sink action -> VTree -> LogLevel -> Events -> IO ())
-> Attribute action
On ((Sink action -> VTree -> LogLevel -> Events -> IO ())
 -> Attribute action)
-> (Sink action -> VTree -> LogLevel -> Events -> IO ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
_ (VTree Object
vtree) LogLevel
_ Events
_ -> do
      (CanvasContext2D -> Object -> IO ())
-> Object -> CanvasContext2D -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (MisoString -> CanvasContext2D -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"onCreated") Object
vtree (CanvasContext2D -> IO ()) -> IO CanvasContext2D -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
        (CanvasContext2D -> IO ()) -> IO CanvasContext2D
FFI.syncCallback1 ((CanvasContext2D -> IO ()) -> IO CanvasContext2D)
-> (CanvasContext2D -> IO ()) -> IO CanvasContext2D
forall a b. (a -> b) -> a -> b
$ \CanvasContext2D
domRef -> do
          initialState <- CanvasContext2D -> IO canvasState
initialize_ CanvasContext2D
domRef
          FFI.set "state" initialState (Object domRef)

    drawCallack :: Attribute action
    drawCallack :: Attribute action
drawCallack = (Sink action -> VTree -> LogLevel -> Events -> IO ())
-> Attribute action
forall action.
(Sink action -> VTree -> LogLevel -> Events -> IO ())
-> Attribute action
On ((Sink action -> VTree -> LogLevel -> Events -> IO ())
 -> Attribute action)
-> (Sink action -> VTree -> LogLevel -> Events -> IO ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
_ (VTree Object
vtree) LogLevel
_ Events
_ -> do
      (CanvasContext2D -> Object -> IO ())
-> Object -> CanvasContext2D -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (MisoString -> CanvasContext2D -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"draw") Object
vtree (CanvasContext2D -> IO ()) -> IO CanvasContext2D -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
        (CanvasContext2D -> IO ()) -> IO CanvasContext2D
FFI.syncCallback1 ((CanvasContext2D -> IO ()) -> IO CanvasContext2D)
-> (CanvasContext2D -> IO ()) -> IO CanvasContext2D
forall a b. (a -> b) -> a -> b
$ \CanvasContext2D
domRef -> do
          state <- CanvasContext2D -> IO canvasState
forall a. FromJSVal a => CanvasContext2D -> IO a
fromJSValUnchecked (CanvasContext2D -> IO canvasState)
-> IO CanvasContext2D -> IO canvasState
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CanvasContext2D
domRef CanvasContext2D -> MisoString -> IO CanvasContext2D
forall o. ToObject o => o -> MisoString -> IO CanvasContext2D
! (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 model 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 model action
canvas :: forall model action canvasState.
(FromJSVal canvasState, ToJSVal canvasState) =>
[Attribute action]
-> (CanvasContext2D -> Canvas canvasState)
-> (canvasState -> Canvas ())
-> View model action
canvas [Attribute action]
attributes CanvasContext2D -> Canvas canvasState
initialize canvasState -> Canvas ()
draw = NS
-> MisoString
-> [Attribute action]
-> [View model action]
-> View model action
forall action model.
NS
-> MisoString
-> [Attribute action]
-> [View model action]
-> View model 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 -> VTree -> LogLevel -> Events -> IO ())
-> Attribute action
forall action.
(Sink action -> VTree -> LogLevel -> Events -> IO ())
-> Attribute action
On ((Sink action -> VTree -> LogLevel -> Events -> IO ())
 -> Attribute action)
-> (Sink action -> VTree -> LogLevel -> Events -> IO ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
_ (VTree Object
vtree) LogLevel
_ Events
_ -> do
      (CanvasContext2D -> Object -> IO ())
-> Object -> CanvasContext2D -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (MisoString -> CanvasContext2D -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"onCreated") Object
vtree (CanvasContext2D -> IO ()) -> IO CanvasContext2D -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
        (CanvasContext2D -> IO ()) -> IO CanvasContext2D
FFI.syncCallback1 ((CanvasContext2D -> IO ()) -> IO CanvasContext2D)
-> (CanvasContext2D -> IO ()) -> IO CanvasContext2D
forall a b. (a -> b) -> a -> b
$ \CanvasContext2D
domRef -> do
          ctx <- CanvasContext2D
domRef CanvasContext2D -> MisoString -> [MisoString] -> IO CanvasContext2D
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO CanvasContext2D
# (MisoString
"getContext" :: MisoString) ([MisoString] -> IO CanvasContext2D)
-> [MisoString] -> IO CanvasContext2D
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 -> VTree -> LogLevel -> Events -> IO ())
-> Attribute action
forall action.
(Sink action -> VTree -> LogLevel -> Events -> IO ())
-> Attribute action
On ((Sink action -> VTree -> LogLevel -> Events -> IO ())
 -> Attribute action)
-> (Sink action -> VTree -> LogLevel -> Events -> IO ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
_ (VTree Object
vtree) LogLevel
_ Events
_ -> do
      (CanvasContext2D -> Object -> IO ())
-> Object -> CanvasContext2D -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (MisoString -> CanvasContext2D -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"draw") Object
vtree (CanvasContext2D -> IO ()) -> IO CanvasContext2D -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
        (CanvasContext2D -> IO ()) -> IO CanvasContext2D
FFI.syncCallback1 ((CanvasContext2D -> IO ()) -> IO CanvasContext2D)
-> (CanvasContext2D -> IO ()) -> IO CanvasContext2D
forall a b. (a -> b) -> a -> b
$ \CanvasContext2D
domRef -> do
          jval <- CanvasContext2D
domRef CanvasContext2D -> MisoString -> IO CanvasContext2D
forall o. ToObject o => o -> MisoString -> IO CanvasContext2D
! (MisoString
"state" :: MisoString)
          initialState <- fromJSValUnchecked jval
          ctx <- domRef # ("getContext" :: MisoString) $ ["2d" :: MisoString]
          runReaderT (draw initialState) ctx
-----------------------------------------------------------------------------
-- | Various patterns used in the canvas API
data PatternType = Repeat | RepeatX | RepeatY | NoRepeat
-----------------------------------------------------------------------------
instance ToJSVal PatternType where
  toJSVal :: PatternType -> IO CanvasContext2D
toJSVal = MisoString -> IO CanvasContext2D
forall a. ToJSVal a => a -> IO CanvasContext2D
toJSVal (MisoString -> IO CanvasContext2D)
-> (PatternType -> MisoString) -> PatternType -> IO CanvasContext2D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternType -> MisoString
renderPattern
-----------------------------------------------------------------------------
instance FromJSVal PatternType where
  fromJSVal :: CanvasContext2D -> IO (Maybe PatternType)
fromJSVal CanvasContext2D
pat =
    forall a. FromJSVal a => CanvasContext2D -> IO a
fromJSValUnchecked @MisoString CanvasContext2D
pat IO MisoString
-> (MisoString -> IO (Maybe PatternType)) -> IO (Maybe PatternType)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      MisoString
"repeat" -> Maybe PatternType -> IO (Maybe PatternType)
forall a. a -> IO 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 -> IO (Maybe PatternType)
forall a. a -> IO 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 -> IO (Maybe PatternType)
forall a. a -> IO 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 -> IO (Maybe PatternType)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PatternType -> Maybe PatternType
forall a. a -> Maybe a
Just PatternType
NoRepeat)
      MisoString
_ -> Maybe PatternType -> IO (Maybe PatternType)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PatternType
forall a. Maybe a
Nothing
-----------------------------------------------------------------------------
-- | Color, Gradient or Pattern styling
data StyleArg
  = ColorArg Color
  | GradientArg Gradient
  | PatternArg Pattern
-----------------------------------------------------------------------------
-- | Smart constructor for 'Color' when using 'StyleArg'
color :: Color -> StyleArg
color :: Color -> StyleArg
color = Color -> StyleArg
ColorArg
-----------------------------------------------------------------------------
-- | Smart constructor for t'Gradient' when using t'StyleArg'
gradient :: Gradient -> StyleArg
gradient :: Gradient -> StyleArg
gradient = Gradient -> StyleArg
GradientArg
-----------------------------------------------------------------------------
-- | Smart constructor for t'Pattern' when using t'StyleArg'
pattern_ :: Pattern -> StyleArg
pattern_ :: Pattern -> StyleArg
pattern_ = Pattern -> StyleArg
PatternArg
-----------------------------------------------------------------------------
-- | Renders a t'StyleArg' to a 'JSVal'
renderStyleArg :: StyleArg -> IO JSVal
renderStyleArg :: StyleArg -> IO CanvasContext2D
renderStyleArg = \case
  ColorArg Color
c -> MisoString -> IO CanvasContext2D
forall a. ToJSVal a => a -> IO CanvasContext2D
toJSVal (Color -> MisoString
renderColor Color
c)
  GradientArg Gradient
g -> Gradient -> IO CanvasContext2D
forall a. ToJSVal a => a -> IO CanvasContext2D
toJSVal Gradient
g
  PatternArg Pattern
p -> Pattern -> IO CanvasContext2D
forall a. ToJSVal a => a -> IO CanvasContext2D
toJSVal Pattern
p
-----------------------------------------------------------------------------
instance ToArgs StyleArg where
  toArgs :: StyleArg -> IO [CanvasContext2D]
toArgs StyleArg
arg = (CanvasContext2D -> [CanvasContext2D] -> [CanvasContext2D]
forall a. a -> [a] -> [a]
:[]) (CanvasContext2D -> [CanvasContext2D])
-> IO CanvasContext2D -> IO [CanvasContext2D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StyleArg -> IO CanvasContext2D
forall a. ToJSVal a => a -> IO CanvasContext2D
toJSVal StyleArg
arg
-----------------------------------------------------------------------------
instance ToJSVal StyleArg where
  toJSVal :: StyleArg -> IO CanvasContext2D
toJSVal = StyleArg -> IO CanvasContext2D
renderStyleArg
-----------------------------------------------------------------------------
-- | Pretty-prints a t'PatternType' as 'Miso.String.MisoString'
renderPattern :: PatternType -> MisoString
renderPattern :: PatternType -> MisoString
renderPattern = \case
  PatternType
Repeat -> MisoString
"repeat"
  PatternType
RepeatX -> MisoString
"repeat-x"
  PatternType
RepeatY -> MisoString
"repeat-y"
  PatternType
NoRepeat -> MisoString
"no-repeat"
-----------------------------------------------------------------------------
-- | [LineCap](https://www.w3schools.com/tags/canvas_linecap.asp)
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 ToArgs LineCapType where
  toArgs :: LineCapType -> IO [CanvasContext2D]
toArgs LineCapType
arg = (CanvasContext2D -> [CanvasContext2D] -> [CanvasContext2D]
forall a. a -> [a] -> [a]
:[]) (CanvasContext2D -> [CanvasContext2D])
-> IO CanvasContext2D -> IO [CanvasContext2D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LineCapType -> IO CanvasContext2D
forall a. ToJSVal a => a -> IO CanvasContext2D
toJSVal LineCapType
arg
-----------------------------------------------------------------------------
instance ToJSVal LineCapType where
  toJSVal :: LineCapType -> IO CanvasContext2D
toJSVal = MisoString -> IO CanvasContext2D
forall a. ToJSVal a => a -> IO CanvasContext2D
toJSVal (MisoString -> IO CanvasContext2D)
-> (LineCapType -> MisoString) -> LineCapType -> IO CanvasContext2D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineCapType -> MisoString
renderLineCapType
-----------------------------------------------------------------------------
-- | Pretty-printing for 'LineCapType'
renderLineCapType :: LineCapType -> MisoString
renderLineCapType :: LineCapType -> MisoString
renderLineCapType = \case
  LineCapType
LineCapButt -> MisoString
"butt"
  LineCapType
LineCapRound -> MisoString
"round"
  LineCapType
LineCapSquare -> MisoString
"square"
-----------------------------------------------------------------------------
-- | [LineJoin](https://www.w3schools.com/tags/canvas_linejoin.asp)
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 ToArgs LineJoinType where
  toArgs :: LineJoinType -> IO [CanvasContext2D]
toArgs LineJoinType
arg = (CanvasContext2D -> [CanvasContext2D] -> [CanvasContext2D]
forall a. a -> [a] -> [a]
:[]) (CanvasContext2D -> [CanvasContext2D])
-> IO CanvasContext2D -> IO [CanvasContext2D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LineJoinType -> IO CanvasContext2D
forall a. ToJSVal a => a -> IO CanvasContext2D
toJSVal LineJoinType
arg
-----------------------------------------------------------------------------
instance ToJSVal LineJoinType where
  toJSVal :: LineJoinType -> IO CanvasContext2D
toJSVal = MisoString -> IO CanvasContext2D
forall a. ToJSVal a => a -> IO CanvasContext2D
toJSVal (MisoString -> IO CanvasContext2D)
-> (LineJoinType -> MisoString)
-> LineJoinType
-> IO CanvasContext2D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineJoinType -> MisoString
renderLineJoinType
-----------------------------------------------------------------------------
-- | Pretty-print a 'LineJoinType'
renderLineJoinType :: LineJoinType -> MisoString
renderLineJoinType :: LineJoinType -> MisoString
renderLineJoinType = \case
 LineJoinType
LineJoinBevel -> MisoString
"bevel"
 LineJoinType
LineJoinRound -> MisoString
"round"
 LineJoinType
LineJoinMiter -> MisoString
"miter"
-----------------------------------------------------------------------------
-- | Left-to-right, right-to-left, or inherit direction type.
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 ToArgs DirectionType where
  toArgs :: DirectionType -> IO [CanvasContext2D]
toArgs DirectionType
arg = (CanvasContext2D -> [CanvasContext2D] -> [CanvasContext2D]
forall a. a -> [a] -> [a]
:[]) (CanvasContext2D -> [CanvasContext2D])
-> IO CanvasContext2D -> IO [CanvasContext2D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DirectionType -> IO CanvasContext2D
forall a. ToJSVal a => a -> IO CanvasContext2D
toJSVal DirectionType
arg
-----------------------------------------------------------------------------
instance ToJSVal DirectionType where
  toJSVal :: DirectionType -> IO CanvasContext2D
toJSVal = MisoString -> IO CanvasContext2D
forall a. ToJSVal a => a -> IO CanvasContext2D
toJSVal (MisoString -> IO CanvasContext2D)
-> (DirectionType -> MisoString)
-> DirectionType
-> IO CanvasContext2D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirectionType -> MisoString
renderDirectionType
-----------------------------------------------------------------------------
-- | Pretty-printing for 'DirectionType'
renderDirectionType :: DirectionType -> MisoString
renderDirectionType :: DirectionType -> MisoString
renderDirectionType = \case
  DirectionType
LTR -> MisoString
"ltr"
  DirectionType
RTL -> MisoString
"rtl"
  DirectionType
Inherit -> MisoString
"inherit"
-----------------------------------------------------------------------------
-- | Text alignment type
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 ToArgs TextAlignType where
  toArgs :: TextAlignType -> IO [CanvasContext2D]
toArgs TextAlignType
arg = (CanvasContext2D -> [CanvasContext2D] -> [CanvasContext2D]
forall a. a -> [a] -> [a]
:[]) (CanvasContext2D -> [CanvasContext2D])
-> IO CanvasContext2D -> IO [CanvasContext2D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextAlignType -> IO CanvasContext2D
forall a. ToJSVal a => a -> IO CanvasContext2D
toJSVal TextAlignType
arg
-----------------------------------------------------------------------------
instance ToJSVal TextAlignType where
  toJSVal :: TextAlignType -> IO CanvasContext2D
toJSVal = MisoString -> IO CanvasContext2D
forall a. ToJSVal a => a -> IO CanvasContext2D
toJSVal (MisoString -> IO CanvasContext2D)
-> (TextAlignType -> MisoString)
-> TextAlignType
-> IO CanvasContext2D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextAlignType -> MisoString
renderTextAlignType
-----------------------------------------------------------------------------
-- | Pretty-print 'TextAlignType'
renderTextAlignType :: TextAlignType -> MisoString
renderTextAlignType :: TextAlignType -> MisoString
renderTextAlignType = \case
  TextAlignType
TextAlignCenter -> MisoString
"center"
  TextAlignType
TextAlignEnd -> MisoString
"end"
  TextAlignType
TextAlignLeft -> MisoString
"left"
  TextAlignType
TextAlignRight -> MisoString
"right"
  TextAlignType
TextAlignStart -> MisoString
"start"
-----------------------------------------------------------------------------
-- | TextBaselineType
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 ToArgs TextBaselineType where
  toArgs :: TextBaselineType -> IO [CanvasContext2D]
toArgs TextBaselineType
arg = (CanvasContext2D -> [CanvasContext2D] -> [CanvasContext2D]
forall a. a -> [a] -> [a]
:[]) (CanvasContext2D -> [CanvasContext2D])
-> IO CanvasContext2D -> IO [CanvasContext2D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextBaselineType -> IO CanvasContext2D
forall a. ToJSVal a => a -> IO CanvasContext2D
toJSVal TextBaselineType
arg
-----------------------------------------------------------------------------
instance ToJSVal TextBaselineType where
  toJSVal :: TextBaselineType -> IO CanvasContext2D
toJSVal = MisoString -> IO CanvasContext2D
forall a. ToJSVal a => a -> IO CanvasContext2D
toJSVal (MisoString -> IO CanvasContext2D)
-> (TextBaselineType -> MisoString)
-> TextBaselineType
-> IO CanvasContext2D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextBaselineType -> MisoString
renderTextBaselineType
-----------------------------------------------------------------------------
-- | Pretty-printing for 'TextBaselineType'
renderTextBaselineType :: TextBaselineType -> MisoString
renderTextBaselineType :: TextBaselineType -> MisoString
renderTextBaselineType = \case
  TextBaselineType
TextBaselineAlphabetic -> MisoString
"alphabetic"
  TextBaselineType
TextBaselineTop -> MisoString
"top"
  TextBaselineType
TextBaselineHanging -> MisoString
"hanging"
  TextBaselineType
TextBaselineMiddle -> MisoString
"middle"
  TextBaselineType
TextBaselineIdeographic -> MisoString
"ideographic"
  TextBaselineType
TextBaselineBottom -> MisoString
"bottom"
-----------------------------------------------------------------------------
-- | CompositeOperation
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 ToArgs CompositeOperation where
  toArgs :: CompositeOperation -> IO [CanvasContext2D]
toArgs CompositeOperation
arg = (CanvasContext2D -> [CanvasContext2D] -> [CanvasContext2D]
forall a. a -> [a] -> [a]
:[]) (CanvasContext2D -> [CanvasContext2D])
-> IO CanvasContext2D -> IO [CanvasContext2D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompositeOperation -> IO CanvasContext2D
forall a. ToJSVal a => a -> IO CanvasContext2D
toJSVal CompositeOperation
arg
-----------------------------------------------------------------------------
instance ToJSVal CompositeOperation where
  toJSVal :: CompositeOperation -> IO CanvasContext2D
toJSVal = MisoString -> IO CanvasContext2D
forall a. ToJSVal a => a -> IO CanvasContext2D
toJSVal (MisoString -> IO CanvasContext2D)
-> (CompositeOperation -> MisoString)
-> CompositeOperation
-> IO CanvasContext2D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompositeOperation -> MisoString
renderCompositeOperation
-----------------------------------------------------------------------------
-- | Pretty-print a 'CompositeOperation'
renderCompositeOperation :: CompositeOperation -> MisoString
renderCompositeOperation :: CompositeOperation -> MisoString
renderCompositeOperation = \case
  CompositeOperation
SourceOver -> MisoString
"source-over"
  CompositeOperation
SourceAtop -> MisoString
"source-atop"
  CompositeOperation
SourceIn -> MisoString
"source-in"
  CompositeOperation
SourceOut -> MisoString
"source-out"
  CompositeOperation
DestinationOver -> MisoString
"destination-over"
  CompositeOperation
DestinationAtop -> MisoString
"destination-atop"
  CompositeOperation
DestinationIn -> MisoString
"destination-in"
  CompositeOperation
DestinationOut -> MisoString
"destination-out"
  CompositeOperation
Lighter -> MisoString
"lighter"
  CompositeOperation
Copy -> MisoString
"copy"
  CompositeOperation
Xor -> MisoString
"xor"
-----------------------------------------------------------------------------
-- | Type used to hold a canvas Pattern
newtype Pattern = Pattern JSVal deriving (Pattern -> IO CanvasContext2D
(Pattern -> IO CanvasContext2D) -> ToJSVal Pattern
forall a. (a -> IO CanvasContext2D) -> ToJSVal a
$ctoJSVal :: Pattern -> IO CanvasContext2D
toJSVal :: Pattern -> IO CanvasContext2D
ToJSVal)
-----------------------------------------------------------------------------
instance FromJSVal Pattern where
  fromJSVal :: CanvasContext2D -> IO (Maybe Pattern)
fromJSVal = Maybe Pattern -> IO (Maybe Pattern)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Pattern -> IO (Maybe Pattern))
-> (CanvasContext2D -> Maybe Pattern)
-> CanvasContext2D
-> IO (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)
-> (CanvasContext2D -> Pattern) -> CanvasContext2D -> Maybe Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CanvasContext2D -> Pattern
Pattern
-----------------------------------------------------------------------------
-- | Type used to hold a Gradient
newtype Gradient = Gradient JSVal deriving (Gradient -> IO CanvasContext2D
(Gradient -> IO CanvasContext2D) -> ToJSVal Gradient
forall a. (a -> IO CanvasContext2D) -> ToJSVal a
$ctoJSVal :: Gradient -> IO CanvasContext2D
toJSVal :: Gradient -> IO CanvasContext2D
ToJSVal, Gradient -> IO [CanvasContext2D]
(Gradient -> IO [CanvasContext2D]) -> ToArgs Gradient
forall args. (args -> IO [CanvasContext2D]) -> ToArgs args
$ctoArgs :: Gradient -> IO [CanvasContext2D]
toArgs :: Gradient -> IO [CanvasContext2D]
ToArgs)
-----------------------------------------------------------------------------
instance FromJSVal Gradient where
  fromJSVal :: CanvasContext2D -> IO (Maybe Gradient)
fromJSVal = Maybe Gradient -> IO (Maybe Gradient)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Gradient -> IO (Maybe Gradient))
-> (CanvasContext2D -> Maybe Gradient)
-> CanvasContext2D
-> IO (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)
-> (CanvasContext2D -> Gradient)
-> CanvasContext2D
-> Maybe Gradient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CanvasContext2D -> Gradient
Gradient
-----------------------------------------------------------------------------
-- | Type used to hold t'ImageData'
newtype ImageData = ImageData JSVal deriving (ImageData -> IO CanvasContext2D
(ImageData -> IO CanvasContext2D) -> ToJSVal ImageData
forall a. (a -> IO CanvasContext2D) -> ToJSVal a
$ctoJSVal :: ImageData -> IO CanvasContext2D
toJSVal :: ImageData -> IO CanvasContext2D
ToJSVal, ImageData -> IO Object
(ImageData -> IO Object) -> ToObject ImageData
forall a. (a -> IO Object) -> ToObject a
$ctoObject :: ImageData -> IO Object
toObject :: ImageData -> IO Object
ToObject)
-----------------------------------------------------------------------------
instance ToArgs ImageData where
  toArgs :: ImageData -> IO [CanvasContext2D]
toArgs ImageData
args = (CanvasContext2D -> [CanvasContext2D] -> [CanvasContext2D]
forall a. a -> [a] -> [a]
:[]) (CanvasContext2D -> [CanvasContext2D])
-> IO CanvasContext2D -> IO [CanvasContext2D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImageData -> IO CanvasContext2D
forall a. ToJSVal a => a -> IO CanvasContext2D
toJSVal ImageData
args
-----------------------------------------------------------------------------
instance FromJSVal ImageData where
  fromJSVal :: CanvasContext2D -> IO (Maybe ImageData)
fromJSVal = Maybe ImageData -> IO (Maybe ImageData)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ImageData -> IO (Maybe ImageData))
-> (CanvasContext2D -> Maybe ImageData)
-> CanvasContext2D
-> IO (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)
-> (CanvasContext2D -> ImageData)
-> CanvasContext2D
-> Maybe ImageData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CanvasContext2D -> ImageData
ImageData
-----------------------------------------------------------------------------
-- | An (x,y) coordinate.
type Coord = (Double, Double)
-----------------------------------------------------------------------------
-- | The canvas t'CanvasContext2D'
type CanvasContext2D = JSVal
-----------------------------------------------------------------------------
call :: (FromJSVal a, ToArgs args) => MisoString -> args -> Canvas a
call :: forall a args.
(FromJSVal a, ToArgs args) =>
MisoString -> args -> Canvas a
call MisoString
name args
arg = do
  ctx <- ReaderT CanvasContext2D IO CanvasContext2D
forall r (m :: * -> *). MonadReader r m => m r
ask
  liftIO $ fromJSValUnchecked =<< do
    ctx # name $ arg
-----------------------------------------------------------------------------
-- | Property setter specialized to t'Canvas'.
--
-- @
-- globalCompositeOperation :: CompositeOperation -> Canvas ()
-- globalCompositeOperation = set "globalCompositeOperation"
-- @
--
set :: ToArgs args => MisoString -> args -> Canvas ()
set :: forall args. ToArgs args => MisoString -> args -> Canvas ()
set MisoString
name args
args = do
  ctx <- ReaderT CanvasContext2D IO CanvasContext2D
forall r (m :: * -> *). MonadReader r m => m r
ask
  liftIO $ setField ctx name (toArgs args)
-----------------------------------------------------------------------------
-- | DSL for expressing operations on 'canvas_'
type Canvas a = ReaderT CanvasContext2D IO 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. ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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. ToArgs 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, ToArgs 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. ToArgs 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, ToArgs 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. ToArgs 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. ToArgs args => MisoString -> args -> Canvas ()
set MisoString
"textBaseline"
-----------------------------------------------------------------------------
-- | [gradient.addColorStop(stop,color)](https://www.w3schools.com/tags/canvas_addcolorstop.asp)
addColorStop :: (Double, Color) -> Gradient -> Canvas ()
addColorStop :: (Double, Color) -> Gradient -> Canvas ()
addColorStop (Double, Color)
args (Gradient CanvasContext2D
g) = do
  _ <- IO CanvasContext2D -> ReaderT CanvasContext2D IO CanvasContext2D
forall a. IO a -> ReaderT CanvasContext2D IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CanvasContext2D -> ReaderT CanvasContext2D IO CanvasContext2D)
-> IO CanvasContext2D -> ReaderT CanvasContext2D IO CanvasContext2D
forall a b. (a -> b) -> a -> b
$ CanvasContext2D
g CanvasContext2D
-> MisoString -> (Double, Color) -> IO CanvasContext2D
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO CanvasContext2D
# (MisoString
"addColorStop" :: MisoString) ((Double, Color) -> IO CanvasContext2D)
-> (Double, Color) -> IO CanvasContext2D
forall a b. (a -> b) -> a -> b
$ (Double, Color)
args
  pure ()
-----------------------------------------------------------------------------
-- | [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, ToArgs 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, ToArgs 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, ToArgs 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. ToArgs 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. ToArgs 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. ToArgs 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. ToArgs 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. ToArgs 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. ToArgs 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. ToArgs 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. ToArgs 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. ToArgs 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. ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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, ToArgs 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) = IO () -> Canvas ()
forall a. IO a -> ReaderT CanvasContext2D IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Canvas ()) -> IO () -> Canvas ()
forall a b. (a -> b) -> a -> b
$ do
   o <- ImageData
imgData ImageData -> MisoString -> IO CanvasContext2D
forall o. ToObject o => o -> MisoString -> IO CanvasContext2D
! (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 CanvasContext2D
imgData) = IO Double -> Canvas Double
forall a. IO a -> ReaderT CanvasContext2D IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> Canvas Double) -> IO Double -> Canvas Double
forall a b. (a -> b) -> a -> b
$ do
  CanvasContext2D -> IO Double
forall a. FromJSVal a => CanvasContext2D -> IO a
fromJSValUnchecked (CanvasContext2D -> IO Double) -> IO CanvasContext2D -> IO Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CanvasContext2D
imgData CanvasContext2D -> MisoString -> IO CanvasContext2D
forall o. ToObject o => o -> MisoString -> IO CanvasContext2D
! (MisoString
"height" :: MisoString)
-----------------------------------------------------------------------------
-- | [imageData.width](https://www.w3schools.com/tags/canvas_imagedata_width.asp)
width :: ImageData -> Canvas Double
width :: ImageData -> Canvas Double
width (ImageData CanvasContext2D
imgData) = IO Double -> Canvas Double
forall a. IO a -> ReaderT CanvasContext2D IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> Canvas Double) -> IO Double -> Canvas Double
forall a b. (a -> b) -> a -> b
$
  CanvasContext2D -> IO Double
forall a. FromJSVal a => CanvasContext2D -> IO a
fromJSValUnchecked (CanvasContext2D -> IO Double) -> IO CanvasContext2D -> IO Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CanvasContext2D
imgData CanvasContext2D -> MisoString -> IO CanvasContext2D
forall o. ToObject o => o -> MisoString -> IO CanvasContext2D
! (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, ToArgs 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. ToArgs 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, ToArgs 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, ToArgs 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, ToArgs args) =>
MisoString -> args -> Canvas a
call MisoString
"restore"
-----------------------------------------------------------------------------