{-# LANGUAGE FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, MonoLocalBinds, MultiParamTypeClasses, ScopedTypeVariables, TypeSynonymInstances, UndecidableInstances #-} ---------- GENERATED FILE, EDITS WILL BE LOST ---------- module Graphics.UI.Qtah.Generated.Core.QRectF ( QRectFValue (..), QRectFConstPtr (..), adjusted, bottom, bottomLeft, bottomRight, center, containsPoint, containsRect, height, intersected, intersects, isEmpty, isNull, isValid, left, marginsAdded, marginsRemoved, normalized, right, size, toAlignedRect, top, topLeft, topRight, translated, width, x, y, eQ, nE, QRectFPtr (..), adjust, setBottom, setBottomLeft, setBottomRight, setHeight, setLeft, moveBottom, moveBottomLeft, moveBottomRight, moveCenter, moveLeft, moveRight, moveTo, moveTop, moveTopLeft, moveTopRight, setRight, setCoords, setRect, setSize, setTop, setTopLeft, setTopRight, translate, united, setWidth, setX, setY, aSSIGN, QRectFConst (..), castQRectFToConst, QRectF (..), castQRectFToNonconst, newNull, newFromPoints, newWithPointAndSize, newWithRect, newWithRaw, newCopy, QRectFSuper (..), QRectFSuperConst (..), ) where import Control.Monad ((>=>)) import qualified Foreign as HoppyF import qualified Foreign.C as HoppyFC import qualified Foreign.Hoppy.Runtime as HoppyFHR import qualified Graphics.UI.Qtah.Core.HPointF as HPointF import qualified Graphics.UI.Qtah.Core.HRect as HRect import qualified Graphics.UI.Qtah.Generated.Core.QMarginsF as M70 import qualified Graphics.UI.Qtah.Generated.Core.QPointF as M116 import qualified Graphics.UI.Qtah.Generated.Core.QRect as M122 import qualified Graphics.UI.Qtah.Generated.Core.QSizeF as M136 import Prelude (($), (.), (/=), (=<<), (==), (>>), (>>=)) import qualified Prelude as HoppyP foreign import ccall "genpop__QRectF_newNull" newNull' :: HoppyP.IO (HoppyF.Ptr QRectF) foreign import ccall "genpop__QRectF_newFromPoints" newFromPoints' :: HoppyF.Ptr M116.QPointFConst -> HoppyF.Ptr M116.QPointFConst -> HoppyP.IO (HoppyF.Ptr QRectF) foreign import ccall "genpop__QRectF_newWithPointAndSize" newWithPointAndSize' :: HoppyF.Ptr M116.QPointFConst -> HoppyF.Ptr M136.QSizeFConst -> HoppyP.IO (HoppyF.Ptr QRectF) foreign import ccall "genpop__QRectF_newWithRect" newWithRect' :: HoppyF.Ptr M122.QRectConst -> HoppyP.IO (HoppyF.Ptr QRectF) foreign import ccall "genpop__QRectF_newWithRaw" newWithRaw' :: HoppyFC.CDouble -> HoppyFC.CDouble -> HoppyFC.CDouble -> HoppyFC.CDouble -> HoppyP.IO (HoppyF.Ptr QRectF) foreign import ccall "genpop__QRectF_newCopy" newCopy' :: HoppyF.Ptr QRectFConst -> HoppyP.IO (HoppyF.Ptr QRectF) foreign import ccall "genpop__QRectF_adjust" adjust' :: HoppyF.Ptr QRectF -> HoppyFC.CDouble -> HoppyFC.CDouble -> HoppyFC.CDouble -> HoppyFC.CDouble -> HoppyP.IO () foreign import ccall "genpop__QRectF_adjusted" adjusted' :: HoppyF.Ptr QRectFConst -> HoppyFC.CDouble -> HoppyFC.CDouble -> HoppyFC.CDouble -> HoppyFC.CDouble -> HoppyP.IO (HoppyF.Ptr QRectFConst) foreign import ccall "genpop__QRectF_bottom" bottom' :: HoppyF.Ptr QRectFConst -> HoppyP.IO HoppyFC.CDouble foreign import ccall "genpop__QRectF_setBottom" setBottom' :: HoppyF.Ptr QRectF -> HoppyFC.CDouble -> HoppyP.IO () foreign import ccall "genpop__QRectF_bottomLeft" bottomLeft' :: HoppyF.Ptr QRectFConst -> HoppyP.IO (HoppyF.Ptr M116.QPointFConst) foreign import ccall "genpop__QRectF_setBottomLeft" setBottomLeft' :: HoppyF.Ptr QRectF -> HoppyF.Ptr M116.QPointFConst -> HoppyP.IO () foreign import ccall "genpop__QRectF_bottomRight" bottomRight' :: HoppyF.Ptr QRectFConst -> HoppyP.IO (HoppyF.Ptr M116.QPointFConst) foreign import ccall "genpop__QRectF_setBottomRight" setBottomRight' :: HoppyF.Ptr QRectF -> HoppyF.Ptr M116.QPointFConst -> HoppyP.IO () foreign import ccall "genpop__QRectF_center" center' :: HoppyF.Ptr QRectFConst -> HoppyP.IO (HoppyF.Ptr M116.QPointFConst) foreign import ccall "genpop__QRectF_containsPoint" containsPoint' :: HoppyF.Ptr QRectFConst -> HoppyF.Ptr M116.QPointFConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QRectF_containsRect" containsRect' :: HoppyF.Ptr QRectFConst -> HoppyF.Ptr QRectFConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QRectF_height" height' :: HoppyF.Ptr QRectFConst -> HoppyP.IO HoppyFC.CDouble foreign import ccall "genpop__QRectF_setHeight" setHeight' :: HoppyF.Ptr QRectF -> HoppyFC.CDouble -> HoppyP.IO () foreign import ccall "genpop__QRectF_intersected" intersected' :: HoppyF.Ptr QRectFConst -> HoppyF.Ptr QRectFConst -> HoppyP.IO (HoppyF.Ptr QRectFConst) foreign import ccall "genpop__QRectF_intersects" intersects' :: HoppyF.Ptr QRectFConst -> HoppyF.Ptr QRectFConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QRectF_isEmpty" isEmpty' :: HoppyF.Ptr QRectFConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QRectF_isNull" isNull' :: HoppyF.Ptr QRectFConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QRectF_isValid" isValid' :: HoppyF.Ptr QRectFConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QRectF_left" left' :: HoppyF.Ptr QRectFConst -> HoppyP.IO HoppyFC.CDouble foreign import ccall "genpop__QRectF_setLeft" setLeft' :: HoppyF.Ptr QRectF -> HoppyFC.CDouble -> HoppyP.IO () foreign import ccall "genpop__QRectF_marginsAdded" marginsAdded' :: HoppyF.Ptr QRectFConst -> HoppyF.Ptr M70.QMarginsFConst -> HoppyP.IO (HoppyF.Ptr QRectFConst) foreign import ccall "genpop__QRectF_marginsRemoved" marginsRemoved' :: HoppyF.Ptr QRectFConst -> HoppyF.Ptr M70.QMarginsFConst -> HoppyP.IO (HoppyF.Ptr QRectFConst) foreign import ccall "genpop__QRectF_moveBottom" moveBottom' :: HoppyF.Ptr QRectF -> HoppyFC.CDouble -> HoppyP.IO () foreign import ccall "genpop__QRectF_moveBottomLeft" moveBottomLeft' :: HoppyF.Ptr QRectF -> HoppyF.Ptr M116.QPointFConst -> HoppyP.IO () foreign import ccall "genpop__QRectF_moveBottomRight" moveBottomRight' :: HoppyF.Ptr QRectF -> HoppyF.Ptr M116.QPointFConst -> HoppyP.IO () foreign import ccall "genpop__QRectF_moveCenter" moveCenter' :: HoppyF.Ptr QRectF -> HoppyF.Ptr M116.QPointFConst -> HoppyP.IO () foreign import ccall "genpop__QRectF_moveLeft" moveLeft' :: HoppyF.Ptr QRectF -> HoppyFC.CDouble -> HoppyP.IO () foreign import ccall "genpop__QRectF_moveRight" moveRight' :: HoppyF.Ptr QRectF -> HoppyFC.CDouble -> HoppyP.IO () foreign import ccall "genpop__QRectF_moveTo" moveTo' :: HoppyF.Ptr QRectF -> HoppyF.Ptr M116.QPointFConst -> HoppyP.IO () foreign import ccall "genpop__QRectF_moveTop" moveTop' :: HoppyF.Ptr QRectF -> HoppyFC.CDouble -> HoppyP.IO () foreign import ccall "genpop__QRectF_moveTopLeft" moveTopLeft' :: HoppyF.Ptr QRectF -> HoppyF.Ptr M116.QPointFConst -> HoppyP.IO () foreign import ccall "genpop__QRectF_moveTopRight" moveTopRight' :: HoppyF.Ptr QRectF -> HoppyF.Ptr M116.QPointFConst -> HoppyP.IO () foreign import ccall "genpop__QRectF_normalized" normalized' :: HoppyF.Ptr QRectFConst -> HoppyP.IO (HoppyF.Ptr QRectFConst) foreign import ccall "genpop__QRectF_right" right' :: HoppyF.Ptr QRectFConst -> HoppyP.IO HoppyFC.CDouble foreign import ccall "genpop__QRectF_setRight" setRight' :: HoppyF.Ptr QRectF -> HoppyFC.CDouble -> HoppyP.IO () foreign import ccall "genpop__QRectF_setCoords" setCoords' :: HoppyF.Ptr QRectF -> HoppyFC.CDouble -> HoppyFC.CDouble -> HoppyFC.CDouble -> HoppyFC.CDouble -> HoppyP.IO () foreign import ccall "genpop__QRectF_setRect" setRect' :: HoppyF.Ptr QRectF -> HoppyFC.CDouble -> HoppyFC.CDouble -> HoppyFC.CDouble -> HoppyFC.CDouble -> HoppyP.IO () foreign import ccall "genpop__QRectF_size" size' :: HoppyF.Ptr QRectFConst -> HoppyP.IO (HoppyF.Ptr M136.QSizeFConst) foreign import ccall "genpop__QRectF_setSize" setSize' :: HoppyF.Ptr QRectF -> HoppyF.Ptr M136.QSizeFConst -> HoppyP.IO () foreign import ccall "genpop__QRectF_toAlignedRect" toAlignedRect' :: HoppyF.Ptr QRectFConst -> HoppyP.IO (HoppyF.Ptr M122.QRectConst) foreign import ccall "genpop__QRectF_top" top' :: HoppyF.Ptr QRectFConst -> HoppyP.IO HoppyFC.CDouble foreign import ccall "genpop__QRectF_setTop" setTop' :: HoppyF.Ptr QRectF -> HoppyFC.CDouble -> HoppyP.IO () foreign import ccall "genpop__QRectF_topLeft" topLeft' :: HoppyF.Ptr QRectFConst -> HoppyP.IO (HoppyF.Ptr M116.QPointFConst) foreign import ccall "genpop__QRectF_setTopLeft" setTopLeft' :: HoppyF.Ptr QRectF -> HoppyF.Ptr M116.QPointFConst -> HoppyP.IO () foreign import ccall "genpop__QRectF_topRight" topRight' :: HoppyF.Ptr QRectFConst -> HoppyP.IO (HoppyF.Ptr M116.QPointFConst) foreign import ccall "genpop__QRectF_setTopRight" setTopRight' :: HoppyF.Ptr QRectF -> HoppyF.Ptr M116.QPointFConst -> HoppyP.IO () foreign import ccall "genpop__QRectF_translate" translate' :: HoppyF.Ptr QRectF -> HoppyF.Ptr M116.QPointFConst -> HoppyP.IO () foreign import ccall "genpop__QRectF_translated" translated' :: HoppyF.Ptr QRectFConst -> HoppyF.Ptr M116.QPointFConst -> HoppyP.IO (HoppyF.Ptr QRectFConst) foreign import ccall "genpop__QRectF_united" united' :: HoppyF.Ptr QRectF -> HoppyF.Ptr QRectFConst -> HoppyP.IO (HoppyF.Ptr QRectFConst) foreign import ccall "genpop__QRectF_width" width' :: HoppyF.Ptr QRectFConst -> HoppyP.IO HoppyFC.CDouble foreign import ccall "genpop__QRectF_setWidth" setWidth' :: HoppyF.Ptr QRectF -> HoppyFC.CDouble -> HoppyP.IO () foreign import ccall "genpop__QRectF_x" x' :: HoppyF.Ptr QRectFConst -> HoppyP.IO HoppyFC.CDouble foreign import ccall "genpop__QRectF_setX" setX' :: HoppyF.Ptr QRectF -> HoppyFC.CDouble -> HoppyP.IO () foreign import ccall "genpop__QRectF_y" y' :: HoppyF.Ptr QRectFConst -> HoppyP.IO HoppyFC.CDouble foreign import ccall "genpop__QRectF_setY" setY' :: HoppyF.Ptr QRectF -> HoppyFC.CDouble -> HoppyP.IO () foreign import ccall "genpop__QRectF_EQ" eQ' :: HoppyF.Ptr QRectFConst -> HoppyF.Ptr QRectFConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QRectF_NE" nE' :: HoppyF.Ptr QRectFConst -> HoppyF.Ptr QRectFConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QRectF_ASSIGN" aSSIGN' :: HoppyF.Ptr QRectF -> HoppyF.Ptr QRectFConst -> HoppyP.IO (HoppyF.Ptr QRectF) foreign import ccall "gendel__QRectF" delete'QRectF :: HoppyF.Ptr QRectFConst -> HoppyP.IO () foreign import ccall "&gendel__QRectF" deletePtr'QRectF :: HoppyF.FunPtr (HoppyF.Ptr QRectFConst -> HoppyP.IO ()) class QRectFValue a where withQRectFPtr :: a -> (QRectFConst -> HoppyP.IO b) -> HoppyP.IO b instance {-# OVERLAPPABLE #-} QRectFConstPtr a => QRectFValue a where withQRectFPtr = HoppyP.flip ($) . toQRectFConst class (HoppyFHR.CppPtr this) => QRectFConstPtr this where toQRectFConst :: this -> QRectFConst adjusted :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.Double) -> (HoppyP.Double) -> (HoppyP.Double) -> (HoppyP.Double) -> (HoppyP.IO QRectF) adjusted arg'1 arg'2 arg'3 arg'4 arg'5 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyP.realToFrac ) arg'3 >>= \arg'3' -> ( HoppyP.return . HoppyP.realToFrac ) arg'4 >>= \arg'4' -> ( HoppyP.return . HoppyP.realToFrac ) arg'5 >>= \arg'5' -> (HoppyFHR.decodeAndDelete . QRectFConst) =<< (adjusted' arg'1' arg'2' arg'3' arg'4' arg'5') bottom :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Double) bottom arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) =<< (bottom' arg'1') bottomLeft :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO HPointF.HPointF) bottomLeft arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (HoppyFHR.decodeAndDelete . M116.QPointFConst) =<< (bottomLeft' arg'1') bottomRight :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO HPointF.HPointF) bottomRight arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (HoppyFHR.decodeAndDelete . M116.QPointFConst) =<< (bottomRight' arg'1') center :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO HPointF.HPointF) center arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (HoppyFHR.decodeAndDelete . M116.QPointFConst) =<< (center' arg'1') containsPoint :: (QRectFValue this, M116.QPointFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO HoppyP.Bool) containsPoint arg'1 arg'2 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M116.withQPointFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> ( (HoppyP.return . (/= 0)) ) =<< (containsPoint' arg'1' arg'2') containsRect :: (QRectFValue this, QRectFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO HoppyP.Bool) containsRect arg'1 arg'2 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> withQRectFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> ( (HoppyP.return . (/= 0)) ) =<< (containsRect' arg'1' arg'2') height :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Double) height arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) =<< (height' arg'1') intersected :: (QRectFValue this, QRectFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO QRectF) intersected arg'1 arg'2 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> withQRectFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (HoppyFHR.decodeAndDelete . QRectFConst) =<< (intersected' arg'1' arg'2') intersects :: (QRectFValue this, QRectFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO HoppyP.Bool) intersects arg'1 arg'2 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> withQRectFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> ( (HoppyP.return . (/= 0)) ) =<< (intersects' arg'1' arg'2') isEmpty :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Bool) isEmpty arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( (HoppyP.return . (/= 0)) ) =<< (isEmpty' arg'1') isNull :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Bool) isNull arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( (HoppyP.return . (/= 0)) ) =<< (isNull' arg'1') isValid :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Bool) isValid arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( (HoppyP.return . (/= 0)) ) =<< (isValid' arg'1') left :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Double) left arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) =<< (left' arg'1') marginsAdded :: (QRectFValue this, M70.QMarginsFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO QRectF) marginsAdded arg'1 arg'2 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M70.withQMarginsFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (HoppyFHR.decodeAndDelete . QRectFConst) =<< (marginsAdded' arg'1' arg'2') marginsRemoved :: (QRectFValue this, M70.QMarginsFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO QRectF) marginsRemoved arg'1 arg'2 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M70.withQMarginsFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (HoppyFHR.decodeAndDelete . QRectFConst) =<< (marginsRemoved' arg'1' arg'2') normalized :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO QRectF) normalized arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (HoppyFHR.decodeAndDelete . QRectFConst) =<< (normalized' arg'1') right :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Double) right arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) =<< (right' arg'1') size :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO M136.QSizeF) size arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (HoppyFHR.decodeAndDelete . M136.QSizeFConst) =<< (size' arg'1') toAlignedRect :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO HRect.HRect) toAlignedRect arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (HoppyFHR.decodeAndDelete . M122.QRectConst) =<< (toAlignedRect' arg'1') top :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Double) top arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) =<< (top' arg'1') topLeft :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO HPointF.HPointF) topLeft arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (HoppyFHR.decodeAndDelete . M116.QPointFConst) =<< (topLeft' arg'1') topRight :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO HPointF.HPointF) topRight arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (HoppyFHR.decodeAndDelete . M116.QPointFConst) =<< (topRight' arg'1') translated :: (QRectFValue this, M116.QPointFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO QRectF) translated arg'1 arg'2 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M116.withQPointFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (HoppyFHR.decodeAndDelete . QRectFConst) =<< (translated' arg'1' arg'2') width :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Double) width arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) =<< (width' arg'1') x :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Double) x arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) =<< (x' arg'1') y :: (QRectFValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Double) y arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) =<< (y' arg'1') eQ :: (QRectFValue this, QRectFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO HoppyP.Bool) eQ arg'1 arg'2 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> withQRectFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> ( (HoppyP.return . (/= 0)) ) =<< (eQ' arg'1' arg'2') nE :: (QRectFValue this, QRectFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO HoppyP.Bool) nE arg'1 arg'2 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> withQRectFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> ( (HoppyP.return . (/= 0)) ) =<< (nE' arg'1' arg'2') class (QRectFConstPtr this) => QRectFPtr this where toQRectF :: this -> QRectF adjust :: (QRectFPtr this) => (this) {- ^ this -} -> (HoppyP.Double) -> (HoppyP.Double) -> (HoppyP.Double) -> (HoppyP.Double) -> (HoppyP.IO ()) adjust arg'1 arg'2 arg'3 arg'4 arg'5 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyP.realToFrac ) arg'3 >>= \arg'3' -> ( HoppyP.return . HoppyP.realToFrac ) arg'4 >>= \arg'4' -> ( HoppyP.return . HoppyP.realToFrac ) arg'5 >>= \arg'5' -> (adjust' arg'1' arg'2' arg'3' arg'4' arg'5') setBottom :: (QRectFPtr this) => (this) {- ^ this -} -> (HoppyP.Double) -> (HoppyP.IO ()) setBottom arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) arg'2 >>= \arg'2' -> (setBottom' arg'1' arg'2') setBottomLeft :: (QRectFPtr this, M116.QPointFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) setBottomLeft arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> M116.withQPointFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (setBottomLeft' arg'1' arg'2') setBottomRight :: (QRectFPtr this, M116.QPointFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) setBottomRight arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> M116.withQPointFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (setBottomRight' arg'1' arg'2') setHeight :: (QRectFPtr this) => (this) {- ^ this -} -> (HoppyP.Double) -> (HoppyP.IO ()) setHeight arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) arg'2 >>= \arg'2' -> (setHeight' arg'1' arg'2') setLeft :: (QRectFPtr this) => (this) {- ^ this -} -> (HoppyP.Double) -> (HoppyP.IO ()) setLeft arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) arg'2 >>= \arg'2' -> (setLeft' arg'1' arg'2') moveBottom :: (QRectFPtr this) => (this) {- ^ this -} -> (HoppyP.Double) -> (HoppyP.IO ()) moveBottom arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) arg'2 >>= \arg'2' -> (moveBottom' arg'1' arg'2') moveBottomLeft :: (QRectFPtr this, M116.QPointFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) moveBottomLeft arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> M116.withQPointFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (moveBottomLeft' arg'1' arg'2') moveBottomRight :: (QRectFPtr this, M116.QPointFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) moveBottomRight arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> M116.withQPointFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (moveBottomRight' arg'1' arg'2') moveCenter :: (QRectFPtr this, M116.QPointFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) moveCenter arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> M116.withQPointFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (moveCenter' arg'1' arg'2') moveLeft :: (QRectFPtr this) => (this) {- ^ this -} -> (HoppyP.Double) -> (HoppyP.IO ()) moveLeft arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) arg'2 >>= \arg'2' -> (moveLeft' arg'1' arg'2') moveRight :: (QRectFPtr this) => (this) {- ^ this -} -> (HoppyP.Double) -> (HoppyP.IO ()) moveRight arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) arg'2 >>= \arg'2' -> (moveRight' arg'1' arg'2') moveTo :: (QRectFPtr this, M116.QPointFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) moveTo arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> M116.withQPointFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (moveTo' arg'1' arg'2') moveTop :: (QRectFPtr this) => (this) {- ^ this -} -> (HoppyP.Double) -> (HoppyP.IO ()) moveTop arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) arg'2 >>= \arg'2' -> (moveTop' arg'1' arg'2') moveTopLeft :: (QRectFPtr this, M116.QPointFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) moveTopLeft arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> M116.withQPointFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (moveTopLeft' arg'1' arg'2') moveTopRight :: (QRectFPtr this, M116.QPointFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) moveTopRight arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> M116.withQPointFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (moveTopRight' arg'1' arg'2') setRight :: (QRectFPtr this) => (this) {- ^ this -} -> (HoppyP.Double) -> (HoppyP.IO ()) setRight arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) arg'2 >>= \arg'2' -> (setRight' arg'1' arg'2') setCoords :: (QRectFPtr this) => (this) {- ^ this -} -> (HoppyP.Double) -> (HoppyP.Double) -> (HoppyP.Double) -> (HoppyP.Double) -> (HoppyP.IO ()) setCoords arg'1 arg'2 arg'3 arg'4 arg'5 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyP.realToFrac ) arg'3 >>= \arg'3' -> ( HoppyP.return . HoppyP.realToFrac ) arg'4 >>= \arg'4' -> ( HoppyP.return . HoppyP.realToFrac ) arg'5 >>= \arg'5' -> (setCoords' arg'1' arg'2' arg'3' arg'4' arg'5') setRect :: (QRectFPtr this) => (this) {- ^ this -} -> (HoppyP.Double) -> (HoppyP.Double) -> (HoppyP.Double) -> (HoppyP.Double) -> (HoppyP.IO ()) setRect arg'1 arg'2 arg'3 arg'4 arg'5 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyP.realToFrac ) arg'3 >>= \arg'3' -> ( HoppyP.return . HoppyP.realToFrac ) arg'4 >>= \arg'4' -> ( HoppyP.return . HoppyP.realToFrac ) arg'5 >>= \arg'5' -> (setRect' arg'1' arg'2' arg'3' arg'4' arg'5') setSize :: (QRectFPtr this, M136.QSizeFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) setSize arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> M136.withQSizeFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (setSize' arg'1' arg'2') setTop :: (QRectFPtr this) => (this) {- ^ this -} -> (HoppyP.Double) -> (HoppyP.IO ()) setTop arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) arg'2 >>= \arg'2' -> (setTop' arg'1' arg'2') setTopLeft :: (QRectFPtr this, M116.QPointFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) setTopLeft arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> M116.withQPointFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (setTopLeft' arg'1' arg'2') setTopRight :: (QRectFPtr this, M116.QPointFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) setTopRight arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> M116.withQPointFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (setTopRight' arg'1' arg'2') translate :: (QRectFPtr this, M116.QPointFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) translate arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> M116.withQPointFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (translate' arg'1' arg'2') united :: (QRectFPtr this, QRectFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO QRectF) united arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> withQRectFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (HoppyFHR.decodeAndDelete . QRectFConst) =<< (united' arg'1' arg'2') setWidth :: (QRectFPtr this) => (this) {- ^ this -} -> (HoppyP.Double) -> (HoppyP.IO ()) setWidth arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) arg'2 >>= \arg'2' -> (setWidth' arg'1' arg'2') setX :: (QRectFPtr this) => (this) {- ^ this -} -> (HoppyP.Double) -> (HoppyP.IO ()) setX arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) arg'2 >>= \arg'2' -> (setX' arg'1' arg'2') setY :: (QRectFPtr this) => (this) {- ^ this -} -> (HoppyP.Double) -> (HoppyP.IO ()) setY arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) arg'2 >>= \arg'2' -> (setY' arg'1' arg'2') aSSIGN :: (QRectFPtr this, QRectFValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO QRectF) aSSIGN arg'1 arg'2 = HoppyFHR.withCppPtr (toQRectF arg'1) $ \arg'1' -> withQRectFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> HoppyP.fmap QRectF (aSSIGN' arg'1' arg'2') data QRectFConst = QRectFConst (HoppyF.Ptr QRectFConst) | QRectFConstGc (HoppyF.ForeignPtr ()) (HoppyF.Ptr QRectFConst) deriving (HoppyP.Show) instance HoppyP.Eq QRectFConst where x == y = HoppyFHR.toPtr x == HoppyFHR.toPtr y instance HoppyP.Ord QRectFConst where compare x y = HoppyP.compare (HoppyFHR.toPtr x) (HoppyFHR.toPtr y) castQRectFToConst :: QRectF -> QRectFConst castQRectFToConst (QRectF ptr') = QRectFConst $ HoppyF.castPtr ptr' castQRectFToConst (QRectFGc fptr' ptr') = QRectFConstGc fptr' $ HoppyF.castPtr ptr' instance HoppyFHR.CppPtr QRectFConst where nullptr = QRectFConst HoppyF.nullPtr withCppPtr (QRectFConst ptr') f' = f' ptr' withCppPtr (QRectFConstGc fptr' ptr') f' = HoppyF.withForeignPtr fptr' $ \_ -> f' ptr' toPtr (QRectFConst ptr') = ptr' toPtr (QRectFConstGc _ ptr') = ptr' touchCppPtr (QRectFConst _) = HoppyP.return () touchCppPtr (QRectFConstGc fptr' _) = HoppyF.touchForeignPtr fptr' instance HoppyFHR.Deletable QRectFConst where delete (QRectFConst ptr') = delete'QRectF ptr' delete (QRectFConstGc _ _) = HoppyP.fail $ HoppyP.concat ["Deletable.delete: Asked to delete a GC-managed ", "QRectFConst", " object."] toGc this'@(QRectFConst ptr') = if ptr' == HoppyF.nullPtr then HoppyP.return this' else HoppyP.fmap (HoppyP.flip QRectFConstGc ptr') $ HoppyF.newForeignPtr (HoppyF.castFunPtr deletePtr'QRectF :: HoppyF.FunPtr (HoppyF.Ptr () -> HoppyP.IO ())) (HoppyF.castPtr ptr' :: HoppyF.Ptr ()) toGc this'@(QRectFConstGc {}) = HoppyP.return this' instance HoppyFHR.Copyable QRectFConst QRectF where copy = newCopy instance QRectFConstPtr QRectFConst where toQRectFConst = HoppyP.id data QRectF = QRectF (HoppyF.Ptr QRectF) | QRectFGc (HoppyF.ForeignPtr ()) (HoppyF.Ptr QRectF) deriving (HoppyP.Show) instance HoppyP.Eq QRectF where x == y = HoppyFHR.toPtr x == HoppyFHR.toPtr y instance HoppyP.Ord QRectF where compare x y = HoppyP.compare (HoppyFHR.toPtr x) (HoppyFHR.toPtr y) castQRectFToNonconst :: QRectFConst -> QRectF castQRectFToNonconst (QRectFConst ptr') = QRectF $ HoppyF.castPtr ptr' castQRectFToNonconst (QRectFConstGc fptr' ptr') = QRectFGc fptr' $ HoppyF.castPtr ptr' instance HoppyFHR.CppPtr QRectF where nullptr = QRectF HoppyF.nullPtr withCppPtr (QRectF ptr') f' = f' ptr' withCppPtr (QRectFGc fptr' ptr') f' = HoppyF.withForeignPtr fptr' $ \_ -> f' ptr' toPtr (QRectF ptr') = ptr' toPtr (QRectFGc _ ptr') = ptr' touchCppPtr (QRectF _) = HoppyP.return () touchCppPtr (QRectFGc fptr' _) = HoppyF.touchForeignPtr fptr' instance HoppyFHR.Deletable QRectF where delete (QRectF ptr') = delete'QRectF $ (HoppyF.castPtr ptr' :: HoppyF.Ptr QRectFConst) delete (QRectFGc _ _) = HoppyP.fail $ HoppyP.concat ["Deletable.delete: Asked to delete a GC-managed ", "QRectF", " object."] toGc this'@(QRectF ptr') = if ptr' == HoppyF.nullPtr then HoppyP.return this' else HoppyP.fmap (HoppyP.flip QRectFGc ptr') $ HoppyF.newForeignPtr (HoppyF.castFunPtr deletePtr'QRectF :: HoppyF.FunPtr (HoppyF.Ptr () -> HoppyP.IO ())) (HoppyF.castPtr ptr' :: HoppyF.Ptr ()) toGc this'@(QRectFGc {}) = HoppyP.return this' instance HoppyFHR.Copyable QRectF QRectF where copy = newCopy instance QRectFConstPtr QRectF where toQRectFConst (QRectF ptr') = QRectFConst $ (HoppyF.castPtr :: HoppyF.Ptr QRectF -> HoppyF.Ptr QRectFConst) ptr' toQRectFConst (QRectFGc fptr' ptr') = QRectFConstGc fptr' $ (HoppyF.castPtr :: HoppyF.Ptr QRectF -> HoppyF.Ptr QRectFConst) ptr' instance QRectFPtr QRectF where toQRectF = HoppyP.id newNull :: (HoppyP.IO QRectF) newNull = HoppyP.fmap QRectF (newNull') newFromPoints :: (M116.QPointFValue arg'1, M116.QPointFValue arg'2) => (arg'1) -> (arg'2) -> (HoppyP.IO QRectF) newFromPoints arg'1 arg'2 = M116.withQPointFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M116.withQPointFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> HoppyP.fmap QRectF (newFromPoints' arg'1' arg'2') newWithPointAndSize :: (M116.QPointFValue arg'1, M136.QSizeFValue arg'2) => (arg'1) -> (arg'2) -> (HoppyP.IO QRectF) newWithPointAndSize arg'1 arg'2 = M116.withQPointFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M136.withQSizeFPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> HoppyP.fmap QRectF (newWithPointAndSize' arg'1' arg'2') newWithRect :: (M122.QRectValue arg'1) => (arg'1) -> (HoppyP.IO QRectF) newWithRect arg'1 = M122.withQRectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap QRectF (newWithRect' arg'1') newWithRaw :: (HoppyP.Double) -> (HoppyP.Double) -> (HoppyP.Double) -> (HoppyP.Double) -> (HoppyP.IO QRectF) newWithRaw arg'1 arg'2 arg'3 arg'4 = ( HoppyP.return . HoppyP.realToFrac ) arg'1 >>= \arg'1' -> ( HoppyP.return . HoppyP.realToFrac ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyP.realToFrac ) arg'3 >>= \arg'3' -> ( HoppyP.return . HoppyP.realToFrac ) arg'4 >>= \arg'4' -> HoppyP.fmap QRectF (newWithRaw' arg'1' arg'2' arg'3' arg'4') newCopy :: (QRectFValue arg'1) => (arg'1) -> (HoppyP.IO QRectF) newCopy arg'1 = withQRectFPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap QRectF (newCopy' arg'1') class QRectFSuper a where downToQRectF :: a -> QRectF class QRectFSuperConst a where downToQRectFConst :: a -> QRectFConst instance HoppyFHR.Assignable (HoppyF.Ptr (HoppyF.Ptr QRectF)) QRectF where assign ptr' value' = HoppyF.poke ptr' $ HoppyFHR.toPtr value' instance QRectFValue a => HoppyFHR.Assignable QRectF a where assign x' y' = aSSIGN x' y' >> HoppyP.return () instance HoppyFHR.Decodable (HoppyF.Ptr (HoppyF.Ptr QRectF)) QRectF where decode = HoppyP.fmap QRectF . HoppyF.peek instance HoppyFHR.Decodable QRectF (QRectF) where decode = HoppyFHR.decode . toQRectFConst instance HoppyFHR.Decodable QRectFConst (QRectF) where decode = HoppyFHR.copy >=> HoppyFHR.toGc