module Diagrams.Backend.HsQML.DiagramObj.Type where
import Diagrams.Backend.HsQML.DiagramObj.Signals
import Control.Applicative
import Control.Monad.IO.Class
import Data.Monoid
import Data.Typeable
import Graphics.QML
import Graphics.QML.Objects.ParamNames
newtype DiagramObj a = DiagramObj {
reload :: ObjRef (DiagramObj ()) -> IO a
}
deriving (Functor, Typeable)
instance Monoid a => Monoid (DiagramObj a) where
mempty = DiagramObj $ \_ -> return mempty
(DiagramObj r1) `mappend` (DiagramObj r2) =
DiagramObj $ \this -> do
a <- r1 this
b <- r2 this
return $ a `mappend` b
instance Applicative DiagramObj where
pure a = DiagramObj $ \_ -> return a
(DiagramObj f') <*> (DiagramObj x') =
DiagramObj $ \this -> do
f <- f' this
x <- x' this
return $ f x
instance Monad DiagramObj where
return a = DiagramObj $ \_ -> return a
(DiagramObj a') >>= f' =
DiagramObj $ \this -> do
a <- a' this
let DiagramObj f = f' a
f this
instance MonadIO DiagramObj where
liftIO m = DiagramObj $ \_ -> m
instance DefaultClass (DiagramObj ()) where
classMembers =
[ defMethod' "reload" $ \this -> reload (fromObjRef this) this
, defSignal "save" save
, defSignal "restore" restore
, defSignal "stroke" stroke
, defSignal "fill" fill
, defSignal "beginPath" beginPath
, defSignal "closePath" closePath
, defSignal "setLineGradient" setLineGradient
, defSignal "setFillGradient" setFillGradient
, defSignal "oddEvenFill" oddEvenFill
, defSignal "windingFill" windingFill
, defSignalNamedParams "text" renderText
$ fstName "text" `plusName` "x" `plusName` "y"
, defSignalNamedParams "moveTo" moveTo
$ fstName "x" `plusName` "y"
, defSignalNamedParams "lineTo" lineTo
$ fstName "x" `plusName` "y"
, defSignalNamedParams "bezierCurveTo" bezierCurveTo
$ fstName "cp1x" `plusName` "cp1y"
`plusName` "cp2x" `plusName` "cp2y"
`plusName` "x" `plusName` "y"
, defSignalNamedParams "connectLinearGradient" connectLinearGradient
$ fstName "gradient"
`plusName` "x0" `plusName` "yo"
`plusName` "x1" `plusName` "y1"
, defSignalNamedParams "connectRadialGradient" connectRadialGradient
$ fstName "gradient"
`plusName` "x0" `plusName` "yo" `plusName` "r0"
`plusName` "x1" `plusName` "y1" `plusName` "r1"
, defSignalNamedParams "setStrokeColour" setStrokeColour
$ fstName "r" `plusName` "g" `plusName` "b" `plusName` "a"
, defSignalNamedParams "setFillColour" setFillColour
$ fstName "r" `plusName` "g" `plusName` "b" `plusName` "a"
, defSignalNamedParams "setFont" setFont
$ fstName "font"
, defSignalNamedParams "setLineWidth" setLineWidth
$ fstName "setLineWidth"
]