{-# LANGUAGE FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, MonoLocalBinds, MultiParamTypeClasses, ScopedTypeVariables, TypeSynonymInstances, UndecidableInstances #-} ---------- GENERATED FILE, EDITS WILL BE LOST ---------- module Graphics.UI.Qtah.Generated.Widgets.QBoxLayout ( castQBoxLayoutToQLayout, castQLayoutToQBoxLayout, castQBoxLayoutToQObject, castQObjectToQBoxLayout, castQBoxLayoutToQLayoutItem, castQLayoutItemToQBoxLayout, QBoxLayoutValue (..), QBoxLayoutConstPtr (..), direction, spacing, QBoxLayoutPtr (..), addLayout, addLayoutWithStretch, addSpacing, addStretch, addStretchOf, addStrut, addWidget, addWidgetWithStretch, addWidgetWithStretchAndAlignment, setDirection, insertLayout, insertLayoutWithStretch, insertSpacing, insertStretch, insertStretchOf, insertWidget, insertWidgetWithStretch, insertWidgetWithStretchAndAlignment, setStretch, setWidgetStretchFactor, setLayoutStretchFactor, setSpacing, QBoxLayoutConst (..), castQBoxLayoutToConst, QBoxLayout (..), castQBoxLayoutToNonconst, new, newWithParent, QBoxLayoutSuper (..), QBoxLayoutSuperConst (..), QBoxLayoutDirection (..), ) where import qualified Foreign as HoppyF import qualified Foreign.C as HoppyFC import qualified Foreign.Hoppy.Runtime as HoppyFHR import qualified Graphics.UI.Qtah.Flags as QtahFlags import qualified Graphics.UI.Qtah.Generated.Core.QObject as M94 import qualified Graphics.UI.Qtah.Generated.Core.Types as M190 import qualified Graphics.UI.Qtah.Generated.Widgets.QLayout as M432 import qualified Graphics.UI.Qtah.Generated.Widgets.QLayoutItem as M434 import qualified Graphics.UI.Qtah.Generated.Widgets.QWidget as M506 import Prelude (($), (.), (/=), (=<<), (==), (>>=)) import qualified Prelude as HoppyP import qualified Prelude as QtahP foreign import ccall "genpop__QBoxLayout_new" new' :: HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr QBoxLayout) foreign import ccall "genpop__QBoxLayout_newWithParent" newWithParent' :: HoppyFC.CInt -> HoppyF.Ptr M506.QWidget -> HoppyP.IO (HoppyF.Ptr QBoxLayout) foreign import ccall "genpop__QBoxLayout_addLayout" addLayout' :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr M432.QLayout -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_addLayoutWithStretch" addLayoutWithStretch' :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr M432.QLayout -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_addSpacing" addSpacing' :: HoppyF.Ptr QBoxLayout -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_addStretch" addStretch' :: HoppyF.Ptr QBoxLayout -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_addStretchOf" addStretchOf' :: HoppyF.Ptr QBoxLayout -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_addStrut" addStrut' :: HoppyF.Ptr QBoxLayout -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_addWidget" addWidget' :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr M506.QWidget -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_addWidgetWithStretch" addWidgetWithStretch' :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr M506.QWidget -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_addWidgetWithStretchAndAlignment" addWidgetWithStretchAndAlignment' :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr M506.QWidget -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_direction" direction' :: HoppyF.Ptr QBoxLayoutConst -> HoppyP.IO HoppyFC.CInt foreign import ccall "genpop__QBoxLayout_setDirection" setDirection' :: HoppyF.Ptr QBoxLayout -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_insertLayout" insertLayout' :: HoppyF.Ptr QBoxLayout -> HoppyFC.CInt -> HoppyF.Ptr M432.QLayout -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_insertLayoutWithStretch" insertLayoutWithStretch' :: HoppyF.Ptr QBoxLayout -> HoppyFC.CInt -> HoppyF.Ptr M432.QLayout -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_insertSpacing" insertSpacing' :: HoppyF.Ptr QBoxLayout -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_insertStretch" insertStretch' :: HoppyF.Ptr QBoxLayout -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_insertStretchOf" insertStretchOf' :: HoppyF.Ptr QBoxLayout -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_insertWidget" insertWidget' :: HoppyF.Ptr QBoxLayout -> HoppyFC.CInt -> HoppyF.Ptr M506.QWidget -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_insertWidgetWithStretch" insertWidgetWithStretch' :: HoppyF.Ptr QBoxLayout -> HoppyFC.CInt -> HoppyF.Ptr M506.QWidget -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_insertWidgetWithStretchAndAlignment" insertWidgetWithStretchAndAlignment' :: HoppyF.Ptr QBoxLayout -> HoppyFC.CInt -> HoppyF.Ptr M506.QWidget -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_setStretch" setStretch' :: HoppyF.Ptr QBoxLayout -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QBoxLayout_setWidgetStretchFactor" setWidgetStretchFactor' :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr M506.QWidget -> HoppyFC.CInt -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QBoxLayout_setLayoutStretchFactor" setLayoutStretchFactor' :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr M432.QLayout -> HoppyFC.CInt -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QBoxLayout_spacing" spacing' :: HoppyF.Ptr QBoxLayoutConst -> HoppyP.IO HoppyFC.CInt foreign import ccall "genpop__QBoxLayout_setSpacing" setSpacing' :: HoppyF.Ptr QBoxLayout -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "gencast__QBoxLayout__QLayout" castQBoxLayoutToQLayout :: HoppyF.Ptr QBoxLayoutConst -> HoppyF.Ptr M432.QLayoutConst foreign import ccall "gencast__QLayout__QBoxLayout" castQLayoutToQBoxLayout :: HoppyF.Ptr M432.QLayoutConst -> HoppyF.Ptr QBoxLayoutConst foreign import ccall "gencast__QBoxLayout__QObject" castQBoxLayoutToQObject :: HoppyF.Ptr QBoxLayoutConst -> HoppyF.Ptr M94.QObjectConst foreign import ccall "gencast__QObject__QBoxLayout" castQObjectToQBoxLayout :: HoppyF.Ptr M94.QObjectConst -> HoppyF.Ptr QBoxLayoutConst foreign import ccall "gencast__QBoxLayout__QLayoutItem" castQBoxLayoutToQLayoutItem :: HoppyF.Ptr QBoxLayoutConst -> HoppyF.Ptr M434.QLayoutItemConst foreign import ccall "gencast__QLayoutItem__QBoxLayout" castQLayoutItemToQBoxLayout :: HoppyF.Ptr M434.QLayoutItemConst -> HoppyF.Ptr QBoxLayoutConst foreign import ccall "gendel__QBoxLayout" delete'QBoxLayout :: HoppyF.Ptr QBoxLayoutConst -> HoppyP.IO () foreign import ccall "&gendel__QBoxLayout" deletePtr'QBoxLayout :: HoppyF.FunPtr (HoppyF.Ptr QBoxLayoutConst -> HoppyP.IO ()) class QBoxLayoutValue a where withQBoxLayoutPtr :: a -> (QBoxLayoutConst -> HoppyP.IO b) -> HoppyP.IO b instance {-# OVERLAPPABLE #-} QBoxLayoutConstPtr a => QBoxLayoutValue a where withQBoxLayoutPtr = HoppyP.flip ($) . toQBoxLayoutConst class (M432.QLayoutConstPtr this) => QBoxLayoutConstPtr this where toQBoxLayoutConst :: this -> QBoxLayoutConst direction :: (QBoxLayoutValue this) => (this) {- ^ this -} -> (HoppyP.IO QBoxLayoutDirection) direction arg'1 = withQBoxLayoutPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.toCppEnum ) =<< (direction' arg'1') spacing :: (QBoxLayoutValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Int) spacing arg'1 = withQBoxLayoutPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) =<< (spacing' arg'1') class (QBoxLayoutConstPtr this, M432.QLayoutPtr this) => QBoxLayoutPtr this where toQBoxLayout :: this -> QBoxLayout addLayout :: (QBoxLayoutPtr this, M432.QLayoutPtr arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) addLayout arg'1 arg'2 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (M432.toQLayout arg'2) $ \arg'2' -> (addLayout' arg'1' arg'2') addLayoutWithStretch :: (QBoxLayoutPtr this, M432.QLayoutPtr arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.Int) -> (HoppyP.IO ()) addLayoutWithStretch arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (M432.toQLayout arg'2) $ \arg'2' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'3 >>= \arg'3' -> (addLayoutWithStretch' arg'1' arg'2' arg'3') addSpacing :: (QBoxLayoutPtr this) => (this) {- ^ this -} -> (HoppyP.Int) -> (HoppyP.IO ()) addSpacing arg'1 arg'2 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> (addSpacing' arg'1' arg'2') addStretch :: (QBoxLayoutPtr this) => (this) {- ^ this -} -> (HoppyP.IO ()) addStretch arg'1 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> (addStretch' arg'1') addStretchOf :: (QBoxLayoutPtr this) => (this) {- ^ this -} -> (HoppyP.Int) -> (HoppyP.IO ()) addStretchOf arg'1 arg'2 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> (addStretchOf' arg'1' arg'2') addStrut :: (QBoxLayoutPtr this) => (this) {- ^ this -} -> (HoppyP.Int) -> (HoppyP.IO ()) addStrut arg'1 arg'2 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> (addStrut' arg'1' arg'2') addWidget :: (QBoxLayoutPtr this, M506.QWidgetPtr arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) addWidget arg'1 arg'2 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (M506.toQWidget arg'2) $ \arg'2' -> (addWidget' arg'1' arg'2') addWidgetWithStretch :: (QBoxLayoutPtr this, M506.QWidgetPtr arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.Int) -> (HoppyP.IO ()) addWidgetWithStretch arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (M506.toQWidget arg'2) $ \arg'2' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'3 >>= \arg'3' -> (addWidgetWithStretch' arg'1' arg'2' arg'3') addWidgetWithStretchAndAlignment :: (QBoxLayoutPtr this, M506.QWidgetPtr arg'2, M190.IsQtAlignment arg'4) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.Int) -> (arg'4) -> (HoppyP.IO ()) addWidgetWithStretchAndAlignment arg'1 arg'2 arg'3 arg'4 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (M506.toQWidget arg'2) $ \arg'2' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'3 >>= \arg'3' -> ( QtahP.return . QtahFlags.flagsToNum . M190.toQtAlignment ) arg'4 >>= \arg'4' -> (addWidgetWithStretchAndAlignment' arg'1' arg'2' arg'3' arg'4') setDirection :: (QBoxLayoutPtr this) => (this) {- ^ this -} -> (QBoxLayoutDirection) -> (HoppyP.IO ()) setDirection arg'1 arg'2 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'2 >>= \arg'2' -> (setDirection' arg'1' arg'2') insertLayout :: (QBoxLayoutPtr this, M432.QLayoutPtr arg'3) => (this) {- ^ this -} -> (HoppyP.Int) -> (arg'3) -> (HoppyP.IO ()) insertLayout arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> HoppyFHR.withCppPtr (M432.toQLayout arg'3) $ \arg'3' -> (insertLayout' arg'1' arg'2' arg'3') insertLayoutWithStretch :: (QBoxLayoutPtr this, M432.QLayoutPtr arg'3) => (this) {- ^ this -} -> (HoppyP.Int) -> (arg'3) -> (HoppyP.Int) -> (HoppyP.IO ()) insertLayoutWithStretch arg'1 arg'2 arg'3 arg'4 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> HoppyFHR.withCppPtr (M432.toQLayout arg'3) $ \arg'3' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'4 >>= \arg'4' -> (insertLayoutWithStretch' arg'1' arg'2' arg'3' arg'4') insertSpacing :: (QBoxLayoutPtr this) => (this) {- ^ this -} -> (HoppyP.Int) -> (HoppyP.Int) -> (HoppyP.IO ()) insertSpacing arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'3 >>= \arg'3' -> (insertSpacing' arg'1' arg'2' arg'3') insertStretch :: (QBoxLayoutPtr this) => (this) {- ^ this -} -> (HoppyP.Int) -> (HoppyP.IO ()) insertStretch arg'1 arg'2 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> (insertStretch' arg'1' arg'2') insertStretchOf :: (QBoxLayoutPtr this) => (this) {- ^ this -} -> (HoppyP.Int) -> (HoppyP.Int) -> (HoppyP.IO ()) insertStretchOf arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'3 >>= \arg'3' -> (insertStretchOf' arg'1' arg'2' arg'3') insertWidget :: (QBoxLayoutPtr this, M506.QWidgetPtr arg'3) => (this) {- ^ this -} -> (HoppyP.Int) -> (arg'3) -> (HoppyP.IO ()) insertWidget arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> HoppyFHR.withCppPtr (M506.toQWidget arg'3) $ \arg'3' -> (insertWidget' arg'1' arg'2' arg'3') insertWidgetWithStretch :: (QBoxLayoutPtr this, M506.QWidgetPtr arg'3) => (this) {- ^ this -} -> (HoppyP.Int) -> (arg'3) -> (HoppyP.Int) -> (HoppyP.IO ()) insertWidgetWithStretch arg'1 arg'2 arg'3 arg'4 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> HoppyFHR.withCppPtr (M506.toQWidget arg'3) $ \arg'3' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'4 >>= \arg'4' -> (insertWidgetWithStretch' arg'1' arg'2' arg'3' arg'4') insertWidgetWithStretchAndAlignment :: (QBoxLayoutPtr this, M506.QWidgetPtr arg'3, M190.IsQtAlignment arg'5) => (this) {- ^ this -} -> (HoppyP.Int) -> (arg'3) -> (HoppyP.Int) -> (arg'5) -> (HoppyP.IO ()) insertWidgetWithStretchAndAlignment arg'1 arg'2 arg'3 arg'4 arg'5 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> HoppyFHR.withCppPtr (M506.toQWidget arg'3) $ \arg'3' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'4 >>= \arg'4' -> ( QtahP.return . QtahFlags.flagsToNum . M190.toQtAlignment ) arg'5 >>= \arg'5' -> (insertWidgetWithStretchAndAlignment' arg'1' arg'2' arg'3' arg'4' arg'5') setStretch :: (QBoxLayoutPtr this) => (this) {- ^ this -} -> (HoppyP.Int) -> (HoppyP.Int) -> (HoppyP.IO ()) setStretch arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'3 >>= \arg'3' -> (setStretch' arg'1' arg'2' arg'3') setWidgetStretchFactor :: (QBoxLayoutPtr this, M506.QWidgetPtr arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.Int) -> (HoppyP.IO HoppyP.Bool) setWidgetStretchFactor arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (M506.toQWidget arg'2) $ \arg'2' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'3 >>= \arg'3' -> ( (HoppyP.return . (/= 0)) ) =<< (setWidgetStretchFactor' arg'1' arg'2' arg'3') setLayoutStretchFactor :: (QBoxLayoutPtr this, M432.QLayoutPtr arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.Int) -> (HoppyP.IO HoppyP.Bool) setLayoutStretchFactor arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (M432.toQLayout arg'2) $ \arg'2' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'3 >>= \arg'3' -> ( (HoppyP.return . (/= 0)) ) =<< (setLayoutStretchFactor' arg'1' arg'2' arg'3') setSpacing :: (QBoxLayoutPtr this) => (this) {- ^ this -} -> (HoppyP.Int) -> (HoppyP.IO ()) setSpacing arg'1 arg'2 = HoppyFHR.withCppPtr (toQBoxLayout arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> (setSpacing' arg'1' arg'2') data QBoxLayoutConst = QBoxLayoutConst (HoppyF.Ptr QBoxLayoutConst) | QBoxLayoutConstGc (HoppyF.ForeignPtr ()) (HoppyF.Ptr QBoxLayoutConst) deriving (HoppyP.Show) instance HoppyP.Eq QBoxLayoutConst where x == y = HoppyFHR.toPtr x == HoppyFHR.toPtr y instance HoppyP.Ord QBoxLayoutConst where compare x y = HoppyP.compare (HoppyFHR.toPtr x) (HoppyFHR.toPtr y) castQBoxLayoutToConst :: QBoxLayout -> QBoxLayoutConst castQBoxLayoutToConst (QBoxLayout ptr') = QBoxLayoutConst $ HoppyF.castPtr ptr' castQBoxLayoutToConst (QBoxLayoutGc fptr' ptr') = QBoxLayoutConstGc fptr' $ HoppyF.castPtr ptr' instance HoppyFHR.CppPtr QBoxLayoutConst where nullptr = QBoxLayoutConst HoppyF.nullPtr withCppPtr (QBoxLayoutConst ptr') f' = f' ptr' withCppPtr (QBoxLayoutConstGc fptr' ptr') f' = HoppyF.withForeignPtr fptr' $ \_ -> f' ptr' toPtr (QBoxLayoutConst ptr') = ptr' toPtr (QBoxLayoutConstGc _ ptr') = ptr' touchCppPtr (QBoxLayoutConst _) = HoppyP.return () touchCppPtr (QBoxLayoutConstGc fptr' _) = HoppyF.touchForeignPtr fptr' instance HoppyFHR.Deletable QBoxLayoutConst where delete (QBoxLayoutConst ptr') = delete'QBoxLayout ptr' delete (QBoxLayoutConstGc _ _) = HoppyP.fail $ HoppyP.concat ["Deletable.delete: Asked to delete a GC-managed ", "QBoxLayoutConst", " object."] toGc this'@(QBoxLayoutConst ptr') = if ptr' == HoppyF.nullPtr then HoppyP.return this' else HoppyP.fmap (HoppyP.flip QBoxLayoutConstGc ptr') $ HoppyF.newForeignPtr (HoppyF.castFunPtr deletePtr'QBoxLayout :: HoppyF.FunPtr (HoppyF.Ptr () -> HoppyP.IO ())) (HoppyF.castPtr ptr' :: HoppyF.Ptr ()) toGc this'@(QBoxLayoutConstGc {}) = HoppyP.return this' instance QBoxLayoutConstPtr QBoxLayoutConst where toQBoxLayoutConst = HoppyP.id instance M432.QLayoutConstPtr QBoxLayoutConst where toQLayoutConst (QBoxLayoutConst ptr') = M432.QLayoutConst $ castQBoxLayoutToQLayout ptr' toQLayoutConst (QBoxLayoutConstGc fptr' ptr') = M432.QLayoutConstGc fptr' $ castQBoxLayoutToQLayout ptr' instance M94.QObjectConstPtr QBoxLayoutConst where toQObjectConst (QBoxLayoutConst ptr') = M94.QObjectConst $ castQBoxLayoutToQObject ptr' toQObjectConst (QBoxLayoutConstGc fptr' ptr') = M94.QObjectConstGc fptr' $ castQBoxLayoutToQObject ptr' instance M434.QLayoutItemConstPtr QBoxLayoutConst where toQLayoutItemConst (QBoxLayoutConst ptr') = M434.QLayoutItemConst $ castQBoxLayoutToQLayoutItem ptr' toQLayoutItemConst (QBoxLayoutConstGc fptr' ptr') = M434.QLayoutItemConstGc fptr' $ castQBoxLayoutToQLayoutItem ptr' data QBoxLayout = QBoxLayout (HoppyF.Ptr QBoxLayout) | QBoxLayoutGc (HoppyF.ForeignPtr ()) (HoppyF.Ptr QBoxLayout) deriving (HoppyP.Show) instance HoppyP.Eq QBoxLayout where x == y = HoppyFHR.toPtr x == HoppyFHR.toPtr y instance HoppyP.Ord QBoxLayout where compare x y = HoppyP.compare (HoppyFHR.toPtr x) (HoppyFHR.toPtr y) castQBoxLayoutToNonconst :: QBoxLayoutConst -> QBoxLayout castQBoxLayoutToNonconst (QBoxLayoutConst ptr') = QBoxLayout $ HoppyF.castPtr ptr' castQBoxLayoutToNonconst (QBoxLayoutConstGc fptr' ptr') = QBoxLayoutGc fptr' $ HoppyF.castPtr ptr' instance HoppyFHR.CppPtr QBoxLayout where nullptr = QBoxLayout HoppyF.nullPtr withCppPtr (QBoxLayout ptr') f' = f' ptr' withCppPtr (QBoxLayoutGc fptr' ptr') f' = HoppyF.withForeignPtr fptr' $ \_ -> f' ptr' toPtr (QBoxLayout ptr') = ptr' toPtr (QBoxLayoutGc _ ptr') = ptr' touchCppPtr (QBoxLayout _) = HoppyP.return () touchCppPtr (QBoxLayoutGc fptr' _) = HoppyF.touchForeignPtr fptr' instance HoppyFHR.Deletable QBoxLayout where delete (QBoxLayout ptr') = delete'QBoxLayout $ (HoppyF.castPtr ptr' :: HoppyF.Ptr QBoxLayoutConst) delete (QBoxLayoutGc _ _) = HoppyP.fail $ HoppyP.concat ["Deletable.delete: Asked to delete a GC-managed ", "QBoxLayout", " object."] toGc this'@(QBoxLayout ptr') = if ptr' == HoppyF.nullPtr then HoppyP.return this' else HoppyP.fmap (HoppyP.flip QBoxLayoutGc ptr') $ HoppyF.newForeignPtr (HoppyF.castFunPtr deletePtr'QBoxLayout :: HoppyF.FunPtr (HoppyF.Ptr () -> HoppyP.IO ())) (HoppyF.castPtr ptr' :: HoppyF.Ptr ()) toGc this'@(QBoxLayoutGc {}) = HoppyP.return this' instance QBoxLayoutConstPtr QBoxLayout where toQBoxLayoutConst (QBoxLayout ptr') = QBoxLayoutConst $ (HoppyF.castPtr :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr QBoxLayoutConst) ptr' toQBoxLayoutConst (QBoxLayoutGc fptr' ptr') = QBoxLayoutConstGc fptr' $ (HoppyF.castPtr :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr QBoxLayoutConst) ptr' instance QBoxLayoutPtr QBoxLayout where toQBoxLayout = HoppyP.id instance M432.QLayoutConstPtr QBoxLayout where toQLayoutConst (QBoxLayout ptr') = M432.QLayoutConst $ castQBoxLayoutToQLayout $ (HoppyF.castPtr :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr QBoxLayoutConst) ptr' toQLayoutConst (QBoxLayoutGc fptr' ptr') = M432.QLayoutConstGc fptr' $ castQBoxLayoutToQLayout $ (HoppyF.castPtr :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr QBoxLayoutConst) ptr' instance M432.QLayoutPtr QBoxLayout where toQLayout (QBoxLayout ptr') = M432.QLayout $ (HoppyF.castPtr :: HoppyF.Ptr M432.QLayoutConst -> HoppyF.Ptr M432.QLayout) $ castQBoxLayoutToQLayout $ (HoppyF.castPtr :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr QBoxLayoutConst) ptr' toQLayout (QBoxLayoutGc fptr' ptr') = M432.QLayoutGc fptr' $ (HoppyF.castPtr :: HoppyF.Ptr M432.QLayoutConst -> HoppyF.Ptr M432.QLayout) $ castQBoxLayoutToQLayout $ (HoppyF.castPtr :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr QBoxLayoutConst) ptr' instance M94.QObjectConstPtr QBoxLayout where toQObjectConst (QBoxLayout ptr') = M94.QObjectConst $ castQBoxLayoutToQObject $ (HoppyF.castPtr :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr QBoxLayoutConst) ptr' toQObjectConst (QBoxLayoutGc fptr' ptr') = M94.QObjectConstGc fptr' $ castQBoxLayoutToQObject $ (HoppyF.castPtr :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr QBoxLayoutConst) ptr' instance M94.QObjectPtr QBoxLayout where toQObject (QBoxLayout ptr') = M94.QObject $ (HoppyF.castPtr :: HoppyF.Ptr M94.QObjectConst -> HoppyF.Ptr M94.QObject) $ castQBoxLayoutToQObject $ (HoppyF.castPtr :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr QBoxLayoutConst) ptr' toQObject (QBoxLayoutGc fptr' ptr') = M94.QObjectGc fptr' $ (HoppyF.castPtr :: HoppyF.Ptr M94.QObjectConst -> HoppyF.Ptr M94.QObject) $ castQBoxLayoutToQObject $ (HoppyF.castPtr :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr QBoxLayoutConst) ptr' instance M434.QLayoutItemConstPtr QBoxLayout where toQLayoutItemConst (QBoxLayout ptr') = M434.QLayoutItemConst $ castQBoxLayoutToQLayoutItem $ (HoppyF.castPtr :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr QBoxLayoutConst) ptr' toQLayoutItemConst (QBoxLayoutGc fptr' ptr') = M434.QLayoutItemConstGc fptr' $ castQBoxLayoutToQLayoutItem $ (HoppyF.castPtr :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr QBoxLayoutConst) ptr' instance M434.QLayoutItemPtr QBoxLayout where toQLayoutItem (QBoxLayout ptr') = M434.QLayoutItem $ (HoppyF.castPtr :: HoppyF.Ptr M434.QLayoutItemConst -> HoppyF.Ptr M434.QLayoutItem) $ castQBoxLayoutToQLayoutItem $ (HoppyF.castPtr :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr QBoxLayoutConst) ptr' toQLayoutItem (QBoxLayoutGc fptr' ptr') = M434.QLayoutItemGc fptr' $ (HoppyF.castPtr :: HoppyF.Ptr M434.QLayoutItemConst -> HoppyF.Ptr M434.QLayoutItem) $ castQBoxLayoutToQLayoutItem $ (HoppyF.castPtr :: HoppyF.Ptr QBoxLayout -> HoppyF.Ptr QBoxLayoutConst) ptr' new :: (QBoxLayoutDirection) -> (HoppyP.IO QBoxLayout) new arg'1 = ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'1 >>= \arg'1' -> HoppyP.fmap QBoxLayout (new' arg'1') newWithParent :: (M506.QWidgetPtr arg'2) => (QBoxLayoutDirection) -> (arg'2) -> (HoppyP.IO QBoxLayout) newWithParent arg'1 arg'2 = ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'1 >>= \arg'1' -> HoppyFHR.withCppPtr (M506.toQWidget arg'2) $ \arg'2' -> HoppyP.fmap QBoxLayout (newWithParent' arg'1' arg'2') class QBoxLayoutSuper a where downToQBoxLayout :: a -> QBoxLayout instance QBoxLayoutSuper M432.QLayout where downToQBoxLayout = castQBoxLayoutToNonconst . cast' . M432.castQLayoutToConst where cast' (M432.QLayoutConst ptr') = QBoxLayoutConst $ castQLayoutToQBoxLayout ptr' cast' (M432.QLayoutConstGc fptr' ptr') = QBoxLayoutConstGc fptr' $ castQLayoutToQBoxLayout ptr' instance QBoxLayoutSuper M94.QObject where downToQBoxLayout = castQBoxLayoutToNonconst . cast' . M94.castQObjectToConst where cast' (M94.QObjectConst ptr') = QBoxLayoutConst $ castQObjectToQBoxLayout ptr' cast' (M94.QObjectConstGc fptr' ptr') = QBoxLayoutConstGc fptr' $ castQObjectToQBoxLayout ptr' instance QBoxLayoutSuper M434.QLayoutItem where downToQBoxLayout = castQBoxLayoutToNonconst . cast' . M434.castQLayoutItemToConst where cast' (M434.QLayoutItemConst ptr') = QBoxLayoutConst $ castQLayoutItemToQBoxLayout ptr' cast' (M434.QLayoutItemConstGc fptr' ptr') = QBoxLayoutConstGc fptr' $ castQLayoutItemToQBoxLayout ptr' class QBoxLayoutSuperConst a where downToQBoxLayoutConst :: a -> QBoxLayoutConst instance QBoxLayoutSuperConst M432.QLayoutConst where downToQBoxLayoutConst = cast' where cast' (M432.QLayoutConst ptr') = QBoxLayoutConst $ castQLayoutToQBoxLayout ptr' cast' (M432.QLayoutConstGc fptr' ptr') = QBoxLayoutConstGc fptr' $ castQLayoutToQBoxLayout ptr' instance QBoxLayoutSuperConst M94.QObjectConst where downToQBoxLayoutConst = cast' where cast' (M94.QObjectConst ptr') = QBoxLayoutConst $ castQObjectToQBoxLayout ptr' cast' (M94.QObjectConstGc fptr' ptr') = QBoxLayoutConstGc fptr' $ castQObjectToQBoxLayout ptr' instance QBoxLayoutSuperConst M434.QLayoutItemConst where downToQBoxLayoutConst = cast' where cast' (M434.QLayoutItemConst ptr') = QBoxLayoutConst $ castQLayoutItemToQBoxLayout ptr' cast' (M434.QLayoutItemConstGc fptr' ptr') = QBoxLayoutConstGc fptr' $ castQLayoutItemToQBoxLayout ptr' instance HoppyFHR.Assignable (HoppyF.Ptr (HoppyF.Ptr QBoxLayout)) QBoxLayout where assign ptr' value' = HoppyF.poke ptr' $ HoppyFHR.toPtr value' instance HoppyFHR.Decodable (HoppyF.Ptr (HoppyF.Ptr QBoxLayout)) QBoxLayout where decode = HoppyP.fmap QBoxLayout . HoppyF.peek data QBoxLayoutDirection = LeftToRight | RightToLeft | TopToBottom | BottomToTop | UnknownQBoxLayoutDirection (HoppyFC.CInt) deriving (HoppyP.Show) instance HoppyFHR.CppEnum (HoppyFC.CInt) QBoxLayoutDirection where fromCppEnum LeftToRight = 0 fromCppEnum RightToLeft = 1 fromCppEnum TopToBottom = 2 fromCppEnum BottomToTop = 3 fromCppEnum (UnknownQBoxLayoutDirection n) = n toCppEnum (0) = LeftToRight toCppEnum (1) = RightToLeft toCppEnum (2) = TopToBottom toCppEnum (3) = BottomToTop toCppEnum n = UnknownQBoxLayoutDirection n instance HoppyP.Eq QBoxLayoutDirection where x == y = HoppyFHR.fromCppEnum x == HoppyFHR.fromCppEnum y instance HoppyP.Ord QBoxLayoutDirection where compare x y = HoppyP.compare (HoppyFHR.fromCppEnum x) (HoppyFHR.fromCppEnum y)