{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE JavaScriptFFI #-} -- For HasCallStack compatibility {-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-} module GHCJS.DOM.JSFFI.Generated.SVGMatrix (js_multiply, multiply, multiply_, multiplyUnsafe, multiplyUnchecked, js_inverse, inverse, inverse_, inverseUnsafe, inverseUnchecked, js_translate, translate, translate_, translateUnsafe, translateUnchecked, js_scale, scale, scale_, scaleUnsafe, scaleUnchecked, js_scaleNonUniform, scaleNonUniform, scaleNonUniform_, scaleNonUniformUnsafe, scaleNonUniformUnchecked, js_rotate, rotate, rotate_, rotateUnsafe, rotateUnchecked, js_rotateFromVector, rotateFromVector, rotateFromVector_, rotateFromVectorUnsafe, rotateFromVectorUnchecked, js_flipX, flipX, flipX_, flipXUnsafe, flipXUnchecked, js_flipY, flipY, flipY_, flipYUnsafe, flipYUnchecked, js_skewX, skewX, skewX_, skewXUnsafe, skewXUnchecked, js_skewY, skewY, skewY_, skewYUnsafe, skewYUnchecked, js_setA, setA, js_getA, getA, js_setB, setB, js_getB, getB, js_setC, setC, js_getC, getC, js_setD, setD, js_getD, getD, js_setE, setE, js_getE, getE, js_setF, setF, js_getF, getF, SVGMatrix(..), gTypeSVGMatrix) where import Prelude ((.), (==), (>>=), return, IO, Int, Float, Double, Bool(..), Maybe, maybe, fromIntegral, round, fmap, Show, Read, Eq, Ord) import qualified Prelude (error) import Data.Typeable (Typeable) import GHCJS.Types (JSVal(..), JSString) import GHCJS.Foreign (jsNull) import GHCJS.Foreign.Callback (syncCallback, asyncCallback, syncCallback1, asyncCallback1, syncCallback2, asyncCallback2, OnBlocked(..)) import GHCJS.Marshal (ToJSVal(..), FromJSVal(..)) import GHCJS.Marshal.Pure (PToJSVal(..), PFromJSVal(..)) import Control.Monad (void) import Control.Monad.IO.Class (MonadIO(..)) import Data.Int (Int64) import Data.Word (Word, Word64) import Data.Maybe (fromJust) import GHCJS.DOM.Types import Control.Applicative ((<$>)) import GHCJS.DOM.EventTargetClosures (EventName, unsafeEventName) import GHCJS.DOM.JSFFI.Generated.Enums foreign import javascript unsafe "$1[\"multiply\"]($2)" js_multiply :: SVGMatrix -> Nullable SVGMatrix -> IO (Nullable SVGMatrix) -- | multiply :: (MonadIO m) => SVGMatrix -> Maybe SVGMatrix -> m (Maybe SVGMatrix) multiply self secondMatrix = liftIO (nullableToMaybe <$> (js_multiply (self) (maybeToNullable secondMatrix))) -- | multiply_ :: (MonadIO m) => SVGMatrix -> Maybe SVGMatrix -> m () multiply_ self secondMatrix = liftIO (void (js_multiply (self) (maybeToNullable secondMatrix))) -- | multiplyUnsafe :: (MonadIO m, HasCallStack) => SVGMatrix -> Maybe SVGMatrix -> m SVGMatrix multiplyUnsafe self secondMatrix = liftIO ((nullableToMaybe <$> (js_multiply (self) (maybeToNullable secondMatrix))) >>= maybe (Prelude.error "Nothing to return") return) -- | multiplyUnchecked :: (MonadIO m) => SVGMatrix -> Maybe SVGMatrix -> m SVGMatrix multiplyUnchecked self secondMatrix = liftIO (fromJust . nullableToMaybe <$> (js_multiply (self) (maybeToNullable secondMatrix))) foreign import javascript unsafe "$1[\"inverse\"]()" js_inverse :: SVGMatrix -> IO (Nullable SVGMatrix) -- | inverse :: (MonadIO m) => SVGMatrix -> m (Maybe SVGMatrix) inverse self = liftIO (nullableToMaybe <$> (js_inverse (self))) -- | inverse_ :: (MonadIO m) => SVGMatrix -> m () inverse_ self = liftIO (void (js_inverse (self))) -- | inverseUnsafe :: (MonadIO m, HasCallStack) => SVGMatrix -> m SVGMatrix inverseUnsafe self = liftIO ((nullableToMaybe <$> (js_inverse (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | inverseUnchecked :: (MonadIO m) => SVGMatrix -> m SVGMatrix inverseUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_inverse (self))) foreign import javascript unsafe "$1[\"translate\"]($2, $3)" js_translate :: SVGMatrix -> Float -> Float -> IO (Nullable SVGMatrix) -- | translate :: (MonadIO m) => SVGMatrix -> Float -> Float -> m (Maybe SVGMatrix) translate self x y = liftIO (nullableToMaybe <$> (js_translate (self) x y)) -- | translate_ :: (MonadIO m) => SVGMatrix -> Float -> Float -> m () translate_ self x y = liftIO (void (js_translate (self) x y)) -- | translateUnsafe :: (MonadIO m, HasCallStack) => SVGMatrix -> Float -> Float -> m SVGMatrix translateUnsafe self x y = liftIO ((nullableToMaybe <$> (js_translate (self) x y)) >>= maybe (Prelude.error "Nothing to return") return) -- | translateUnchecked :: (MonadIO m) => SVGMatrix -> Float -> Float -> m SVGMatrix translateUnchecked self x y = liftIO (fromJust . nullableToMaybe <$> (js_translate (self) x y)) foreign import javascript unsafe "$1[\"scale\"]($2)" js_scale :: SVGMatrix -> Float -> IO (Nullable SVGMatrix) -- | scale :: (MonadIO m) => SVGMatrix -> Float -> m (Maybe SVGMatrix) scale self scaleFactor = liftIO (nullableToMaybe <$> (js_scale (self) scaleFactor)) -- | scale_ :: (MonadIO m) => SVGMatrix -> Float -> m () scale_ self scaleFactor = liftIO (void (js_scale (self) scaleFactor)) -- | scaleUnsafe :: (MonadIO m, HasCallStack) => SVGMatrix -> Float -> m SVGMatrix scaleUnsafe self scaleFactor = liftIO ((nullableToMaybe <$> (js_scale (self) scaleFactor)) >>= maybe (Prelude.error "Nothing to return") return) -- | scaleUnchecked :: (MonadIO m) => SVGMatrix -> Float -> m SVGMatrix scaleUnchecked self scaleFactor = liftIO (fromJust . nullableToMaybe <$> (js_scale (self) scaleFactor)) foreign import javascript unsafe "$1[\"scaleNonUniform\"]($2, $3)" js_scaleNonUniform :: SVGMatrix -> Float -> Float -> IO (Nullable SVGMatrix) -- | scaleNonUniform :: (MonadIO m) => SVGMatrix -> Float -> Float -> m (Maybe SVGMatrix) scaleNonUniform self scaleFactorX scaleFactorY = liftIO (nullableToMaybe <$> (js_scaleNonUniform (self) scaleFactorX scaleFactorY)) -- | scaleNonUniform_ :: (MonadIO m) => SVGMatrix -> Float -> Float -> m () scaleNonUniform_ self scaleFactorX scaleFactorY = liftIO (void (js_scaleNonUniform (self) scaleFactorX scaleFactorY)) -- | scaleNonUniformUnsafe :: (MonadIO m, HasCallStack) => SVGMatrix -> Float -> Float -> m SVGMatrix scaleNonUniformUnsafe self scaleFactorX scaleFactorY = liftIO ((nullableToMaybe <$> (js_scaleNonUniform (self) scaleFactorX scaleFactorY)) >>= maybe (Prelude.error "Nothing to return") return) -- | scaleNonUniformUnchecked :: (MonadIO m) => SVGMatrix -> Float -> Float -> m SVGMatrix scaleNonUniformUnchecked self scaleFactorX scaleFactorY = liftIO (fromJust . nullableToMaybe <$> (js_scaleNonUniform (self) scaleFactorX scaleFactorY)) foreign import javascript unsafe "$1[\"rotate\"]($2)" js_rotate :: SVGMatrix -> Float -> IO (Nullable SVGMatrix) -- | rotate :: (MonadIO m) => SVGMatrix -> Float -> m (Maybe SVGMatrix) rotate self angle = liftIO (nullableToMaybe <$> (js_rotate (self) angle)) -- | rotate_ :: (MonadIO m) => SVGMatrix -> Float -> m () rotate_ self angle = liftIO (void (js_rotate (self) angle)) -- | rotateUnsafe :: (MonadIO m, HasCallStack) => SVGMatrix -> Float -> m SVGMatrix rotateUnsafe self angle = liftIO ((nullableToMaybe <$> (js_rotate (self) angle)) >>= maybe (Prelude.error "Nothing to return") return) -- | rotateUnchecked :: (MonadIO m) => SVGMatrix -> Float -> m SVGMatrix rotateUnchecked self angle = liftIO (fromJust . nullableToMaybe <$> (js_rotate (self) angle)) foreign import javascript unsafe "$1[\"rotateFromVector\"]($2, $3)" js_rotateFromVector :: SVGMatrix -> Float -> Float -> IO (Nullable SVGMatrix) -- | rotateFromVector :: (MonadIO m) => SVGMatrix -> Float -> Float -> m (Maybe SVGMatrix) rotateFromVector self x y = liftIO (nullableToMaybe <$> (js_rotateFromVector (self) x y)) -- | rotateFromVector_ :: (MonadIO m) => SVGMatrix -> Float -> Float -> m () rotateFromVector_ self x y = liftIO (void (js_rotateFromVector (self) x y)) -- | rotateFromVectorUnsafe :: (MonadIO m, HasCallStack) => SVGMatrix -> Float -> Float -> m SVGMatrix rotateFromVectorUnsafe self x y = liftIO ((nullableToMaybe <$> (js_rotateFromVector (self) x y)) >>= maybe (Prelude.error "Nothing to return") return) -- | rotateFromVectorUnchecked :: (MonadIO m) => SVGMatrix -> Float -> Float -> m SVGMatrix rotateFromVectorUnchecked self x y = liftIO (fromJust . nullableToMaybe <$> (js_rotateFromVector (self) x y)) foreign import javascript unsafe "$1[\"flipX\"]()" js_flipX :: SVGMatrix -> IO (Nullable SVGMatrix) -- | flipX :: (MonadIO m) => SVGMatrix -> m (Maybe SVGMatrix) flipX self = liftIO (nullableToMaybe <$> (js_flipX (self))) -- | flipX_ :: (MonadIO m) => SVGMatrix -> m () flipX_ self = liftIO (void (js_flipX (self))) -- | flipXUnsafe :: (MonadIO m, HasCallStack) => SVGMatrix -> m SVGMatrix flipXUnsafe self = liftIO ((nullableToMaybe <$> (js_flipX (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | flipXUnchecked :: (MonadIO m) => SVGMatrix -> m SVGMatrix flipXUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_flipX (self))) foreign import javascript unsafe "$1[\"flipY\"]()" js_flipY :: SVGMatrix -> IO (Nullable SVGMatrix) -- | flipY :: (MonadIO m) => SVGMatrix -> m (Maybe SVGMatrix) flipY self = liftIO (nullableToMaybe <$> (js_flipY (self))) -- | flipY_ :: (MonadIO m) => SVGMatrix -> m () flipY_ self = liftIO (void (js_flipY (self))) -- | flipYUnsafe :: (MonadIO m, HasCallStack) => SVGMatrix -> m SVGMatrix flipYUnsafe self = liftIO ((nullableToMaybe <$> (js_flipY (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | flipYUnchecked :: (MonadIO m) => SVGMatrix -> m SVGMatrix flipYUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_flipY (self))) foreign import javascript unsafe "$1[\"skewX\"]($2)" js_skewX :: SVGMatrix -> Float -> IO (Nullable SVGMatrix) -- | skewX :: (MonadIO m) => SVGMatrix -> Float -> m (Maybe SVGMatrix) skewX self angle = liftIO (nullableToMaybe <$> (js_skewX (self) angle)) -- | skewX_ :: (MonadIO m) => SVGMatrix -> Float -> m () skewX_ self angle = liftIO (void (js_skewX (self) angle)) -- | skewXUnsafe :: (MonadIO m, HasCallStack) => SVGMatrix -> Float -> m SVGMatrix skewXUnsafe self angle = liftIO ((nullableToMaybe <$> (js_skewX (self) angle)) >>= maybe (Prelude.error "Nothing to return") return) -- | skewXUnchecked :: (MonadIO m) => SVGMatrix -> Float -> m SVGMatrix skewXUnchecked self angle = liftIO (fromJust . nullableToMaybe <$> (js_skewX (self) angle)) foreign import javascript unsafe "$1[\"skewY\"]($2)" js_skewY :: SVGMatrix -> Float -> IO (Nullable SVGMatrix) -- | skewY :: (MonadIO m) => SVGMatrix -> Float -> m (Maybe SVGMatrix) skewY self angle = liftIO (nullableToMaybe <$> (js_skewY (self) angle)) -- | skewY_ :: (MonadIO m) => SVGMatrix -> Float -> m () skewY_ self angle = liftIO (void (js_skewY (self) angle)) -- | skewYUnsafe :: (MonadIO m, HasCallStack) => SVGMatrix -> Float -> m SVGMatrix skewYUnsafe self angle = liftIO ((nullableToMaybe <$> (js_skewY (self) angle)) >>= maybe (Prelude.error "Nothing to return") return) -- | skewYUnchecked :: (MonadIO m) => SVGMatrix -> Float -> m SVGMatrix skewYUnchecked self angle = liftIO (fromJust . nullableToMaybe <$> (js_skewY (self) angle)) foreign import javascript unsafe "$1[\"a\"] = $2;" js_setA :: SVGMatrix -> Double -> IO () -- | setA :: (MonadIO m) => SVGMatrix -> Double -> m () setA self val = liftIO (js_setA (self) val) foreign import javascript unsafe "$1[\"a\"]" js_getA :: SVGMatrix -> IO Double -- | getA :: (MonadIO m) => SVGMatrix -> m Double getA self = liftIO (js_getA (self)) foreign import javascript unsafe "$1[\"b\"] = $2;" js_setB :: SVGMatrix -> Double -> IO () -- | setB :: (MonadIO m) => SVGMatrix -> Double -> m () setB self val = liftIO (js_setB (self) val) foreign import javascript unsafe "$1[\"b\"]" js_getB :: SVGMatrix -> IO Double -- | getB :: (MonadIO m) => SVGMatrix -> m Double getB self = liftIO (js_getB (self)) foreign import javascript unsafe "$1[\"c\"] = $2;" js_setC :: SVGMatrix -> Double -> IO () -- | setC :: (MonadIO m) => SVGMatrix -> Double -> m () setC self val = liftIO (js_setC (self) val) foreign import javascript unsafe "$1[\"c\"]" js_getC :: SVGMatrix -> IO Double -- | getC :: (MonadIO m) => SVGMatrix -> m Double getC self = liftIO (js_getC (self)) foreign import javascript unsafe "$1[\"d\"] = $2;" js_setD :: SVGMatrix -> Double -> IO () -- | setD :: (MonadIO m) => SVGMatrix -> Double -> m () setD self val = liftIO (js_setD (self) val) foreign import javascript unsafe "$1[\"d\"]" js_getD :: SVGMatrix -> IO Double -- | getD :: (MonadIO m) => SVGMatrix -> m Double getD self = liftIO (js_getD (self)) foreign import javascript unsafe "$1[\"e\"] = $2;" js_setE :: SVGMatrix -> Double -> IO () -- | setE :: (MonadIO m) => SVGMatrix -> Double -> m () setE self val = liftIO (js_setE (self) val) foreign import javascript unsafe "$1[\"e\"]" js_getE :: SVGMatrix -> IO Double -- | getE :: (MonadIO m) => SVGMatrix -> m Double getE self = liftIO (js_getE (self)) foreign import javascript unsafe "$1[\"f\"] = $2;" js_setF :: SVGMatrix -> Double -> IO () -- | setF :: (MonadIO m) => SVGMatrix -> Double -> m () setF self val = liftIO (js_setF (self) val) foreign import javascript unsafe "$1[\"f\"]" js_getF :: SVGMatrix -> IO Double -- | getF :: (MonadIO m) => SVGMatrix -> m Double getF self = liftIO (js_getF (self))