{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE JavaScriptFFI #-} -- For HasCallStack compatibility {-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-} module GHCJS.DOM.JSFFI.Generated.SVGSVGElement (js_suspendRedraw, suspendRedraw, suspendRedraw_, js_unsuspendRedraw, unsuspendRedraw, js_unsuspendRedrawAll, unsuspendRedrawAll, js_forceRedraw, forceRedraw, js_pauseAnimations, pauseAnimations, js_unpauseAnimations, unpauseAnimations, js_animationsPaused, animationsPaused, animationsPaused_, js_getCurrentTime, getCurrentTime, getCurrentTime_, js_setCurrentTime, setCurrentTime, js_getIntersectionList, getIntersectionList, getIntersectionList_, getIntersectionListUnsafe, getIntersectionListUnchecked, js_getEnclosureList, getEnclosureList, getEnclosureList_, getEnclosureListUnsafe, getEnclosureListUnchecked, js_checkIntersection, checkIntersection, checkIntersection_, js_checkEnclosure, checkEnclosure, checkEnclosure_, js_deselectAll, deselectAll, js_createSVGNumber, createSVGNumber, createSVGNumber_, createSVGNumberUnsafe, createSVGNumberUnchecked, js_createSVGLength, createSVGLength, createSVGLength_, createSVGLengthUnsafe, createSVGLengthUnchecked, js_createSVGAngle, createSVGAngle, createSVGAngle_, createSVGAngleUnsafe, createSVGAngleUnchecked, js_createSVGPoint, createSVGPoint, createSVGPoint_, createSVGPointUnsafe, createSVGPointUnchecked, js_createSVGMatrix, createSVGMatrix, createSVGMatrix_, createSVGMatrixUnsafe, createSVGMatrixUnchecked, js_createSVGRect, createSVGRect, createSVGRect_, createSVGRectUnsafe, createSVGRectUnchecked, js_createSVGTransform, createSVGTransform, createSVGTransform_, createSVGTransformUnsafe, createSVGTransformUnchecked, js_createSVGTransformFromMatrix, createSVGTransformFromMatrix, createSVGTransformFromMatrix_, createSVGTransformFromMatrixUnsafe, createSVGTransformFromMatrixUnchecked, js_getElementById, getElementById, getElementById_, getElementByIdUnsafe, getElementByIdUnchecked, js_getX, getX, getXUnsafe, getXUnchecked, js_getY, getY, getYUnsafe, getYUnchecked, js_getWidth, getWidth, getWidthUnsafe, getWidthUnchecked, js_getHeight, getHeight, getHeightUnsafe, getHeightUnchecked, js_setContentScriptType, setContentScriptType, js_getContentScriptType, getContentScriptType, js_setContentStyleType, setContentStyleType, js_getContentStyleType, getContentStyleType, js_getViewport, getViewport, getViewportUnsafe, getViewportUnchecked, js_getPixelUnitToMillimeterX, getPixelUnitToMillimeterX, js_getPixelUnitToMillimeterY, getPixelUnitToMillimeterY, js_getScreenPixelToMillimeterX, getScreenPixelToMillimeterX, js_getScreenPixelToMillimeterY, getScreenPixelToMillimeterY, js_getUseCurrentView, getUseCurrentView, js_getCurrentView, getCurrentView, getCurrentViewUnsafe, getCurrentViewUnchecked, js_setCurrentScale, setCurrentScale, js_getCurrentScale, getCurrentScale, js_getCurrentTranslate, getCurrentTranslate, getCurrentTranslateUnsafe, getCurrentTranslateUnchecked, SVGSVGElement(..), gTypeSVGSVGElement) 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[\"suspendRedraw\"]($2)" js_suspendRedraw :: SVGSVGElement -> Word -> IO Word -- | suspendRedraw :: (MonadIO m) => SVGSVGElement -> Word -> m Word suspendRedraw self maxWaitMilliseconds = liftIO (js_suspendRedraw (self) maxWaitMilliseconds) -- | suspendRedraw_ :: (MonadIO m) => SVGSVGElement -> Word -> m () suspendRedraw_ self maxWaitMilliseconds = liftIO (void (js_suspendRedraw (self) maxWaitMilliseconds)) foreign import javascript unsafe "$1[\"unsuspendRedraw\"]($2)" js_unsuspendRedraw :: SVGSVGElement -> Word -> IO () -- | unsuspendRedraw :: (MonadIO m) => SVGSVGElement -> Word -> m () unsuspendRedraw self suspendHandleId = liftIO (js_unsuspendRedraw (self) suspendHandleId) foreign import javascript unsafe "$1[\"unsuspendRedrawAll\"]()" js_unsuspendRedrawAll :: SVGSVGElement -> IO () -- | unsuspendRedrawAll :: (MonadIO m) => SVGSVGElement -> m () unsuspendRedrawAll self = liftIO (js_unsuspendRedrawAll (self)) foreign import javascript unsafe "$1[\"forceRedraw\"]()" js_forceRedraw :: SVGSVGElement -> IO () -- | forceRedraw :: (MonadIO m) => SVGSVGElement -> m () forceRedraw self = liftIO (js_forceRedraw (self)) foreign import javascript unsafe "$1[\"pauseAnimations\"]()" js_pauseAnimations :: SVGSVGElement -> IO () -- | pauseAnimations :: (MonadIO m) => SVGSVGElement -> m () pauseAnimations self = liftIO (js_pauseAnimations (self)) foreign import javascript unsafe "$1[\"unpauseAnimations\"]()" js_unpauseAnimations :: SVGSVGElement -> IO () -- | unpauseAnimations :: (MonadIO m) => SVGSVGElement -> m () unpauseAnimations self = liftIO (js_unpauseAnimations (self)) foreign import javascript unsafe "($1[\"animationsPaused\"]() ? 1 : 0)" js_animationsPaused :: SVGSVGElement -> IO Bool -- | animationsPaused :: (MonadIO m) => SVGSVGElement -> m Bool animationsPaused self = liftIO (js_animationsPaused (self)) -- | animationsPaused_ :: (MonadIO m) => SVGSVGElement -> m () animationsPaused_ self = liftIO (void (js_animationsPaused (self))) foreign import javascript unsafe "$1[\"getCurrentTime\"]()" js_getCurrentTime :: SVGSVGElement -> IO Float -- | getCurrentTime :: (MonadIO m) => SVGSVGElement -> m Float getCurrentTime self = liftIO (js_getCurrentTime (self)) -- | getCurrentTime_ :: (MonadIO m) => SVGSVGElement -> m () getCurrentTime_ self = liftIO (void (js_getCurrentTime (self))) foreign import javascript unsafe "$1[\"setCurrentTime\"]($2)" js_setCurrentTime :: SVGSVGElement -> Float -> IO () -- | setCurrentTime :: (MonadIO m) => SVGSVGElement -> Float -> m () setCurrentTime self seconds = liftIO (js_setCurrentTime (self) seconds) foreign import javascript unsafe "$1[\"getIntersectionList\"]($2,\n$3)" js_getIntersectionList :: SVGSVGElement -> Nullable SVGRect -> Nullable SVGElement -> IO (Nullable NodeList) -- | getIntersectionList :: (MonadIO m, IsSVGElement referenceElement) => SVGSVGElement -> Maybe SVGRect -> Maybe referenceElement -> m (Maybe NodeList) getIntersectionList self rect referenceElement = liftIO (nullableToMaybe <$> (js_getIntersectionList (self) (maybeToNullable rect) (maybeToNullable (fmap toSVGElement referenceElement)))) -- | getIntersectionList_ :: (MonadIO m, IsSVGElement referenceElement) => SVGSVGElement -> Maybe SVGRect -> Maybe referenceElement -> m () getIntersectionList_ self rect referenceElement = liftIO (void (js_getIntersectionList (self) (maybeToNullable rect) (maybeToNullable (fmap toSVGElement referenceElement)))) -- | getIntersectionListUnsafe :: (MonadIO m, IsSVGElement referenceElement, HasCallStack) => SVGSVGElement -> Maybe SVGRect -> Maybe referenceElement -> m NodeList getIntersectionListUnsafe self rect referenceElement = liftIO ((nullableToMaybe <$> (js_getIntersectionList (self) (maybeToNullable rect) (maybeToNullable (fmap toSVGElement referenceElement)))) >>= maybe (Prelude.error "Nothing to return") return) -- | getIntersectionListUnchecked :: (MonadIO m, IsSVGElement referenceElement) => SVGSVGElement -> Maybe SVGRect -> Maybe referenceElement -> m NodeList getIntersectionListUnchecked self rect referenceElement = liftIO (fromJust . nullableToMaybe <$> (js_getIntersectionList (self) (maybeToNullable rect) (maybeToNullable (fmap toSVGElement referenceElement)))) foreign import javascript unsafe "$1[\"getEnclosureList\"]($2, $3)" js_getEnclosureList :: SVGSVGElement -> Nullable SVGRect -> Nullable SVGElement -> IO (Nullable NodeList) -- | getEnclosureList :: (MonadIO m, IsSVGElement referenceElement) => SVGSVGElement -> Maybe SVGRect -> Maybe referenceElement -> m (Maybe NodeList) getEnclosureList self rect referenceElement = liftIO (nullableToMaybe <$> (js_getEnclosureList (self) (maybeToNullable rect) (maybeToNullable (fmap toSVGElement referenceElement)))) -- | getEnclosureList_ :: (MonadIO m, IsSVGElement referenceElement) => SVGSVGElement -> Maybe SVGRect -> Maybe referenceElement -> m () getEnclosureList_ self rect referenceElement = liftIO (void (js_getEnclosureList (self) (maybeToNullable rect) (maybeToNullable (fmap toSVGElement referenceElement)))) -- | getEnclosureListUnsafe :: (MonadIO m, IsSVGElement referenceElement, HasCallStack) => SVGSVGElement -> Maybe SVGRect -> Maybe referenceElement -> m NodeList getEnclosureListUnsafe self rect referenceElement = liftIO ((nullableToMaybe <$> (js_getEnclosureList (self) (maybeToNullable rect) (maybeToNullable (fmap toSVGElement referenceElement)))) >>= maybe (Prelude.error "Nothing to return") return) -- | getEnclosureListUnchecked :: (MonadIO m, IsSVGElement referenceElement) => SVGSVGElement -> Maybe SVGRect -> Maybe referenceElement -> m NodeList getEnclosureListUnchecked self rect referenceElement = liftIO (fromJust . nullableToMaybe <$> (js_getEnclosureList (self) (maybeToNullable rect) (maybeToNullable (fmap toSVGElement referenceElement)))) foreign import javascript unsafe "($1[\"checkIntersection\"]($2,\n$3) ? 1 : 0)" js_checkIntersection :: SVGSVGElement -> Nullable SVGElement -> Nullable SVGRect -> IO Bool -- | checkIntersection :: (MonadIO m, IsSVGElement element) => SVGSVGElement -> Maybe element -> Maybe SVGRect -> m Bool checkIntersection self element rect = liftIO (js_checkIntersection (self) (maybeToNullable (fmap toSVGElement element)) (maybeToNullable rect)) -- | checkIntersection_ :: (MonadIO m, IsSVGElement element) => SVGSVGElement -> Maybe element -> Maybe SVGRect -> m () checkIntersection_ self element rect = liftIO (void (js_checkIntersection (self) (maybeToNullable (fmap toSVGElement element)) (maybeToNullable rect))) foreign import javascript unsafe "($1[\"checkEnclosure\"]($2,\n$3) ? 1 : 0)" js_checkEnclosure :: SVGSVGElement -> Nullable SVGElement -> Nullable SVGRect -> IO Bool -- | checkEnclosure :: (MonadIO m, IsSVGElement element) => SVGSVGElement -> Maybe element -> Maybe SVGRect -> m Bool checkEnclosure self element rect = liftIO (js_checkEnclosure (self) (maybeToNullable (fmap toSVGElement element)) (maybeToNullable rect)) -- | checkEnclosure_ :: (MonadIO m, IsSVGElement element) => SVGSVGElement -> Maybe element -> Maybe SVGRect -> m () checkEnclosure_ self element rect = liftIO (void (js_checkEnclosure (self) (maybeToNullable (fmap toSVGElement element)) (maybeToNullable rect))) foreign import javascript unsafe "$1[\"deselectAll\"]()" js_deselectAll :: SVGSVGElement -> IO () -- | deselectAll :: (MonadIO m) => SVGSVGElement -> m () deselectAll self = liftIO (js_deselectAll (self)) foreign import javascript unsafe "$1[\"createSVGNumber\"]()" js_createSVGNumber :: SVGSVGElement -> IO (Nullable SVGNumber) -- | createSVGNumber :: (MonadIO m) => SVGSVGElement -> m (Maybe SVGNumber) createSVGNumber self = liftIO (nullableToMaybe <$> (js_createSVGNumber (self))) -- | createSVGNumber_ :: (MonadIO m) => SVGSVGElement -> m () createSVGNumber_ self = liftIO (void (js_createSVGNumber (self))) -- | createSVGNumberUnsafe :: (MonadIO m, HasCallStack) => SVGSVGElement -> m SVGNumber createSVGNumberUnsafe self = liftIO ((nullableToMaybe <$> (js_createSVGNumber (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | createSVGNumberUnchecked :: (MonadIO m) => SVGSVGElement -> m SVGNumber createSVGNumberUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_createSVGNumber (self))) foreign import javascript unsafe "$1[\"createSVGLength\"]()" js_createSVGLength :: SVGSVGElement -> IO (Nullable SVGLength) -- | createSVGLength :: (MonadIO m) => SVGSVGElement -> m (Maybe SVGLength) createSVGLength self = liftIO (nullableToMaybe <$> (js_createSVGLength (self))) -- | createSVGLength_ :: (MonadIO m) => SVGSVGElement -> m () createSVGLength_ self = liftIO (void (js_createSVGLength (self))) -- | createSVGLengthUnsafe :: (MonadIO m, HasCallStack) => SVGSVGElement -> m SVGLength createSVGLengthUnsafe self = liftIO ((nullableToMaybe <$> (js_createSVGLength (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | createSVGLengthUnchecked :: (MonadIO m) => SVGSVGElement -> m SVGLength createSVGLengthUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_createSVGLength (self))) foreign import javascript unsafe "$1[\"createSVGAngle\"]()" js_createSVGAngle :: SVGSVGElement -> IO (Nullable SVGAngle) -- | createSVGAngle :: (MonadIO m) => SVGSVGElement -> m (Maybe SVGAngle) createSVGAngle self = liftIO (nullableToMaybe <$> (js_createSVGAngle (self))) -- | createSVGAngle_ :: (MonadIO m) => SVGSVGElement -> m () createSVGAngle_ self = liftIO (void (js_createSVGAngle (self))) -- | createSVGAngleUnsafe :: (MonadIO m, HasCallStack) => SVGSVGElement -> m SVGAngle createSVGAngleUnsafe self = liftIO ((nullableToMaybe <$> (js_createSVGAngle (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | createSVGAngleUnchecked :: (MonadIO m) => SVGSVGElement -> m SVGAngle createSVGAngleUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_createSVGAngle (self))) foreign import javascript unsafe "$1[\"createSVGPoint\"]()" js_createSVGPoint :: SVGSVGElement -> IO (Nullable SVGPoint) -- | createSVGPoint :: (MonadIO m) => SVGSVGElement -> m (Maybe SVGPoint) createSVGPoint self = liftIO (nullableToMaybe <$> (js_createSVGPoint (self))) -- | createSVGPoint_ :: (MonadIO m) => SVGSVGElement -> m () createSVGPoint_ self = liftIO (void (js_createSVGPoint (self))) -- | createSVGPointUnsafe :: (MonadIO m, HasCallStack) => SVGSVGElement -> m SVGPoint createSVGPointUnsafe self = liftIO ((nullableToMaybe <$> (js_createSVGPoint (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | createSVGPointUnchecked :: (MonadIO m) => SVGSVGElement -> m SVGPoint createSVGPointUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_createSVGPoint (self))) foreign import javascript unsafe "$1[\"createSVGMatrix\"]()" js_createSVGMatrix :: SVGSVGElement -> IO (Nullable SVGMatrix) -- | createSVGMatrix :: (MonadIO m) => SVGSVGElement -> m (Maybe SVGMatrix) createSVGMatrix self = liftIO (nullableToMaybe <$> (js_createSVGMatrix (self))) -- | createSVGMatrix_ :: (MonadIO m) => SVGSVGElement -> m () createSVGMatrix_ self = liftIO (void (js_createSVGMatrix (self))) -- | createSVGMatrixUnsafe :: (MonadIO m, HasCallStack) => SVGSVGElement -> m SVGMatrix createSVGMatrixUnsafe self = liftIO ((nullableToMaybe <$> (js_createSVGMatrix (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | createSVGMatrixUnchecked :: (MonadIO m) => SVGSVGElement -> m SVGMatrix createSVGMatrixUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_createSVGMatrix (self))) foreign import javascript unsafe "$1[\"createSVGRect\"]()" js_createSVGRect :: SVGSVGElement -> IO (Nullable SVGRect) -- | createSVGRect :: (MonadIO m) => SVGSVGElement -> m (Maybe SVGRect) createSVGRect self = liftIO (nullableToMaybe <$> (js_createSVGRect (self))) -- | createSVGRect_ :: (MonadIO m) => SVGSVGElement -> m () createSVGRect_ self = liftIO (void (js_createSVGRect (self))) -- | createSVGRectUnsafe :: (MonadIO m, HasCallStack) => SVGSVGElement -> m SVGRect createSVGRectUnsafe self = liftIO ((nullableToMaybe <$> (js_createSVGRect (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | createSVGRectUnchecked :: (MonadIO m) => SVGSVGElement -> m SVGRect createSVGRectUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_createSVGRect (self))) foreign import javascript unsafe "$1[\"createSVGTransform\"]()" js_createSVGTransform :: SVGSVGElement -> IO (Nullable SVGTransform) -- | createSVGTransform :: (MonadIO m) => SVGSVGElement -> m (Maybe SVGTransform) createSVGTransform self = liftIO (nullableToMaybe <$> (js_createSVGTransform (self))) -- | createSVGTransform_ :: (MonadIO m) => SVGSVGElement -> m () createSVGTransform_ self = liftIO (void (js_createSVGTransform (self))) -- | createSVGTransformUnsafe :: (MonadIO m, HasCallStack) => SVGSVGElement -> m SVGTransform createSVGTransformUnsafe self = liftIO ((nullableToMaybe <$> (js_createSVGTransform (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | createSVGTransformUnchecked :: (MonadIO m) => SVGSVGElement -> m SVGTransform createSVGTransformUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_createSVGTransform (self))) foreign import javascript unsafe "$1[\"createSVGTransformFromMatrix\"]($2)" js_createSVGTransformFromMatrix :: SVGSVGElement -> Nullable SVGMatrix -> IO (Nullable SVGTransform) -- | createSVGTransformFromMatrix :: (MonadIO m) => SVGSVGElement -> Maybe SVGMatrix -> m (Maybe SVGTransform) createSVGTransformFromMatrix self matrix = liftIO (nullableToMaybe <$> (js_createSVGTransformFromMatrix (self) (maybeToNullable matrix))) -- | createSVGTransformFromMatrix_ :: (MonadIO m) => SVGSVGElement -> Maybe SVGMatrix -> m () createSVGTransformFromMatrix_ self matrix = liftIO (void (js_createSVGTransformFromMatrix (self) (maybeToNullable matrix))) -- | createSVGTransformFromMatrixUnsafe :: (MonadIO m, HasCallStack) => SVGSVGElement -> Maybe SVGMatrix -> m SVGTransform createSVGTransformFromMatrixUnsafe self matrix = liftIO ((nullableToMaybe <$> (js_createSVGTransformFromMatrix (self) (maybeToNullable matrix))) >>= maybe (Prelude.error "Nothing to return") return) -- | createSVGTransformFromMatrixUnchecked :: (MonadIO m) => SVGSVGElement -> Maybe SVGMatrix -> m SVGTransform createSVGTransformFromMatrixUnchecked self matrix = liftIO (fromJust . nullableToMaybe <$> (js_createSVGTransformFromMatrix (self) (maybeToNullable matrix))) foreign import javascript unsafe "$1[\"getElementById\"]($2)" js_getElementById :: SVGSVGElement -> JSString -> IO (Nullable Element) -- | getElementById :: (MonadIO m, ToJSString elementId) => SVGSVGElement -> elementId -> m (Maybe Element) getElementById self elementId = liftIO (nullableToMaybe <$> (js_getElementById (self) (toJSString elementId))) -- | getElementById_ :: (MonadIO m, ToJSString elementId) => SVGSVGElement -> elementId -> m () getElementById_ self elementId = liftIO (void (js_getElementById (self) (toJSString elementId))) -- | getElementByIdUnsafe :: (MonadIO m, ToJSString elementId, HasCallStack) => SVGSVGElement -> elementId -> m Element getElementByIdUnsafe self elementId = liftIO ((nullableToMaybe <$> (js_getElementById (self) (toJSString elementId))) >>= maybe (Prelude.error "Nothing to return") return) -- | getElementByIdUnchecked :: (MonadIO m, ToJSString elementId) => SVGSVGElement -> elementId -> m Element getElementByIdUnchecked self elementId = liftIO (fromJust . nullableToMaybe <$> (js_getElementById (self) (toJSString elementId))) foreign import javascript unsafe "$1[\"x\"]" js_getX :: SVGSVGElement -> IO (Nullable SVGAnimatedLength) -- | getX :: (MonadIO m) => SVGSVGElement -> m (Maybe SVGAnimatedLength) getX self = liftIO (nullableToMaybe <$> (js_getX (self))) -- | getXUnsafe :: (MonadIO m, HasCallStack) => SVGSVGElement -> m SVGAnimatedLength getXUnsafe self = liftIO ((nullableToMaybe <$> (js_getX (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | getXUnchecked :: (MonadIO m) => SVGSVGElement -> m SVGAnimatedLength getXUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getX (self))) foreign import javascript unsafe "$1[\"y\"]" js_getY :: SVGSVGElement -> IO (Nullable SVGAnimatedLength) -- | getY :: (MonadIO m) => SVGSVGElement -> m (Maybe SVGAnimatedLength) getY self = liftIO (nullableToMaybe <$> (js_getY (self))) -- | getYUnsafe :: (MonadIO m, HasCallStack) => SVGSVGElement -> m SVGAnimatedLength getYUnsafe self = liftIO ((nullableToMaybe <$> (js_getY (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | getYUnchecked :: (MonadIO m) => SVGSVGElement -> m SVGAnimatedLength getYUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getY (self))) foreign import javascript unsafe "$1[\"width\"]" js_getWidth :: SVGSVGElement -> IO (Nullable SVGAnimatedLength) -- | getWidth :: (MonadIO m) => SVGSVGElement -> m (Maybe SVGAnimatedLength) getWidth self = liftIO (nullableToMaybe <$> (js_getWidth (self))) -- | getWidthUnsafe :: (MonadIO m, HasCallStack) => SVGSVGElement -> m SVGAnimatedLength getWidthUnsafe self = liftIO ((nullableToMaybe <$> (js_getWidth (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | getWidthUnchecked :: (MonadIO m) => SVGSVGElement -> m SVGAnimatedLength getWidthUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getWidth (self))) foreign import javascript unsafe "$1[\"height\"]" js_getHeight :: SVGSVGElement -> IO (Nullable SVGAnimatedLength) -- | getHeight :: (MonadIO m) => SVGSVGElement -> m (Maybe SVGAnimatedLength) getHeight self = liftIO (nullableToMaybe <$> (js_getHeight (self))) -- | getHeightUnsafe :: (MonadIO m, HasCallStack) => SVGSVGElement -> m SVGAnimatedLength getHeightUnsafe self = liftIO ((nullableToMaybe <$> (js_getHeight (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | getHeightUnchecked :: (MonadIO m) => SVGSVGElement -> m SVGAnimatedLength getHeightUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getHeight (self))) foreign import javascript unsafe "$1[\"contentScriptType\"] = $2;" js_setContentScriptType :: SVGSVGElement -> JSString -> IO () -- | setContentScriptType :: (MonadIO m, ToJSString val) => SVGSVGElement -> val -> m () setContentScriptType self val = liftIO (js_setContentScriptType (self) (toJSString val)) foreign import javascript unsafe "$1[\"contentScriptType\"]" js_getContentScriptType :: SVGSVGElement -> IO JSString -- | getContentScriptType :: (MonadIO m, FromJSString result) => SVGSVGElement -> m result getContentScriptType self = liftIO (fromJSString <$> (js_getContentScriptType (self))) foreign import javascript unsafe "$1[\"contentStyleType\"] = $2;" js_setContentStyleType :: SVGSVGElement -> JSString -> IO () -- | setContentStyleType :: (MonadIO m, ToJSString val) => SVGSVGElement -> val -> m () setContentStyleType self val = liftIO (js_setContentStyleType (self) (toJSString val)) foreign import javascript unsafe "$1[\"contentStyleType\"]" js_getContentStyleType :: SVGSVGElement -> IO JSString -- | getContentStyleType :: (MonadIO m, FromJSString result) => SVGSVGElement -> m result getContentStyleType self = liftIO (fromJSString <$> (js_getContentStyleType (self))) foreign import javascript unsafe "$1[\"viewport\"]" js_getViewport :: SVGSVGElement -> IO (Nullable SVGRect) -- | getViewport :: (MonadIO m) => SVGSVGElement -> m (Maybe SVGRect) getViewport self = liftIO (nullableToMaybe <$> (js_getViewport (self))) -- | getViewportUnsafe :: (MonadIO m, HasCallStack) => SVGSVGElement -> m SVGRect getViewportUnsafe self = liftIO ((nullableToMaybe <$> (js_getViewport (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | getViewportUnchecked :: (MonadIO m) => SVGSVGElement -> m SVGRect getViewportUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getViewport (self))) foreign import javascript unsafe "$1[\"pixelUnitToMillimeterX\"]" js_getPixelUnitToMillimeterX :: SVGSVGElement -> IO Float -- | getPixelUnitToMillimeterX :: (MonadIO m) => SVGSVGElement -> m Float getPixelUnitToMillimeterX self = liftIO (js_getPixelUnitToMillimeterX (self)) foreign import javascript unsafe "$1[\"pixelUnitToMillimeterY\"]" js_getPixelUnitToMillimeterY :: SVGSVGElement -> IO Float -- | getPixelUnitToMillimeterY :: (MonadIO m) => SVGSVGElement -> m Float getPixelUnitToMillimeterY self = liftIO (js_getPixelUnitToMillimeterY (self)) foreign import javascript unsafe "$1[\"screenPixelToMillimeterX\"]" js_getScreenPixelToMillimeterX :: SVGSVGElement -> IO Float -- | getScreenPixelToMillimeterX :: (MonadIO m) => SVGSVGElement -> m Float getScreenPixelToMillimeterX self = liftIO (js_getScreenPixelToMillimeterX (self)) foreign import javascript unsafe "$1[\"screenPixelToMillimeterY\"]" js_getScreenPixelToMillimeterY :: SVGSVGElement -> IO Float -- | getScreenPixelToMillimeterY :: (MonadIO m) => SVGSVGElement -> m Float getScreenPixelToMillimeterY self = liftIO (js_getScreenPixelToMillimeterY (self)) foreign import javascript unsafe "($1[\"useCurrentView\"] ? 1 : 0)" js_getUseCurrentView :: SVGSVGElement -> IO Bool -- | getUseCurrentView :: (MonadIO m) => SVGSVGElement -> m Bool getUseCurrentView self = liftIO (js_getUseCurrentView (self)) foreign import javascript unsafe "$1[\"currentView\"]" js_getCurrentView :: SVGSVGElement -> IO (Nullable SVGViewSpec) -- | getCurrentView :: (MonadIO m) => SVGSVGElement -> m (Maybe SVGViewSpec) getCurrentView self = liftIO (nullableToMaybe <$> (js_getCurrentView (self))) -- | getCurrentViewUnsafe :: (MonadIO m, HasCallStack) => SVGSVGElement -> m SVGViewSpec getCurrentViewUnsafe self = liftIO ((nullableToMaybe <$> (js_getCurrentView (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | getCurrentViewUnchecked :: (MonadIO m) => SVGSVGElement -> m SVGViewSpec getCurrentViewUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getCurrentView (self))) foreign import javascript unsafe "$1[\"currentScale\"] = $2;" js_setCurrentScale :: SVGSVGElement -> Float -> IO () -- | setCurrentScale :: (MonadIO m) => SVGSVGElement -> Float -> m () setCurrentScale self val = liftIO (js_setCurrentScale (self) val) foreign import javascript unsafe "$1[\"currentScale\"]" js_getCurrentScale :: SVGSVGElement -> IO Float -- | getCurrentScale :: (MonadIO m) => SVGSVGElement -> m Float getCurrentScale self = liftIO (js_getCurrentScale (self)) foreign import javascript unsafe "$1[\"currentTranslate\"]" js_getCurrentTranslate :: SVGSVGElement -> IO (Nullable SVGPoint) -- | getCurrentTranslate :: (MonadIO m) => SVGSVGElement -> m (Maybe SVGPoint) getCurrentTranslate self = liftIO (nullableToMaybe <$> (js_getCurrentTranslate (self))) -- | getCurrentTranslateUnsafe :: (MonadIO m, HasCallStack) => SVGSVGElement -> m SVGPoint getCurrentTranslateUnsafe self = liftIO ((nullableToMaybe <$> (js_getCurrentTranslate (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | getCurrentTranslateUnchecked :: (MonadIO m) => SVGSVGElement -> m SVGPoint getCurrentTranslateUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getCurrentTranslate (self)))