{-# LANGUAGE FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, MonoLocalBinds, MultiParamTypeClasses, ScopedTypeVariables, TypeSynonymInstances, UndecidableInstances #-} ---------- GENERATED FILE, EDITS WILL BE LOST ---------- module Graphics.UI.Qtah.Generated.Gui.QIcon ( QIconValue (..), QIconConstPtr (..), actualSize, actualSizeAll, actualSizeWithWindow, actualSizeWithWindowAll, availableSizes, availableSizesAll, cacheKey, isMask, isNull, name, paintWithRect, paintWithRectAll, paintWithRaw, paintWithRawAll, pixmapExtent, pixmapExtentAll, pixmapRaw, pixmapRawAll, pixmapSize, pixmapSizeAll, QIconPtr (..), addFile, addFileAll, addPixmap, addPixmapAll, setIsMask, swap, aSSIGN, fromTheme, fromThemeWithFallback, hasThemeIcon, setThemeName, setThemeSearchPaths, themeName, themeSearchPaths, QIconConst (..), castQIconToConst, QIcon (..), castQIconToNonconst, new, newWithFile, newWithPixmap, newCopy, QIconSuper (..), QIconSuperConst (..), QIconMode (..), QIconState (..), ) where import Control.Monad ((>=>)) import qualified Data.Int as HoppyDI import qualified Foreign as HoppyF import qualified Foreign.C as HoppyFC import qualified Foreign.Hoppy.Runtime as HoppyFHR import qualified Graphics.UI.Qtah.Core.HSize as HSize import qualified Graphics.UI.Qtah.Flags as QtahFlags import qualified Graphics.UI.Qtah.Generated.Core.QList.QSize as M204 import qualified Graphics.UI.Qtah.Generated.Core.QRect as M122 import qualified Graphics.UI.Qtah.Generated.Core.QSize as M134 import qualified Graphics.UI.Qtah.Generated.Core.QString as M142 import qualified Graphics.UI.Qtah.Generated.Core.QStringList as M144 import qualified Graphics.UI.Qtah.Generated.Core.Types as M190 import {-# SOURCE #-} qualified Graphics.UI.Qtah.Generated.Gui.QPainter as M310 import {-# SOURCE #-} qualified Graphics.UI.Qtah.Generated.Gui.QPixmap as M316 import {-# SOURCE #-} qualified Graphics.UI.Qtah.Generated.Gui.QWindow as M342 import Prelude (($), (.), (/=), (=<<), (==), (>>), (>>=)) import qualified Prelude as HoppyP import qualified Prelude as QtahP foreign import ccall "genpop__QIcon_new" new' :: HoppyP.IO (HoppyF.Ptr QIcon) foreign import ccall "genpop__QIcon_newWithFile" newWithFile' :: HoppyF.Ptr M142.QStringConst -> HoppyP.IO (HoppyF.Ptr QIcon) foreign import ccall "genpop__QIcon_newWithPixmap" newWithPixmap' :: HoppyF.Ptr M316.QPixmapConst -> HoppyP.IO (HoppyF.Ptr QIcon) foreign import ccall "genpop__QIcon_newCopy" newCopy' :: HoppyF.Ptr QIconConst -> HoppyP.IO (HoppyF.Ptr QIcon) foreign import ccall "genpop__QIcon_actualSize" actualSize' :: HoppyF.Ptr QIconConst -> HoppyF.Ptr M134.QSizeConst -> HoppyP.IO (HoppyF.Ptr M134.QSizeConst) foreign import ccall "genpop__QIcon_actualSizeAll" actualSizeAll' :: HoppyF.Ptr QIconConst -> HoppyF.Ptr M134.QSizeConst -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr M134.QSizeConst) foreign import ccall "genpop__QIcon_actualSizeWithWindow" actualSizeWithWindow' :: HoppyF.Ptr QIconConst -> HoppyF.Ptr M342.QWindow -> HoppyF.Ptr M134.QSizeConst -> HoppyP.IO (HoppyF.Ptr M134.QSizeConst) foreign import ccall "genpop__QIcon_actualSizeWithWindowAll" actualSizeWithWindowAll' :: HoppyF.Ptr QIconConst -> HoppyF.Ptr M342.QWindow -> HoppyF.Ptr M134.QSizeConst -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr M134.QSizeConst) foreign import ccall "genpop__QIcon_addFile" addFile' :: HoppyF.Ptr QIcon -> HoppyF.Ptr M142.QStringConst -> HoppyP.IO () foreign import ccall "genpop__QIcon_addFileAll" addFileAll' :: HoppyF.Ptr QIcon -> HoppyF.Ptr M142.QStringConst -> HoppyF.Ptr M134.QSizeConst -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QIcon_addPixmap" addPixmap' :: HoppyF.Ptr QIcon -> HoppyF.Ptr M316.QPixmapConst -> HoppyP.IO () foreign import ccall "genpop__QIcon_addPixmapAll" addPixmapAll' :: HoppyF.Ptr QIcon -> HoppyF.Ptr M316.QPixmapConst -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QIcon_availableSizes" availableSizes' :: HoppyF.Ptr QIconConst -> HoppyP.IO (HoppyF.Ptr M204.QListQSizeConst) foreign import ccall "genpop__QIcon_availableSizesAll" availableSizesAll' :: HoppyF.Ptr QIconConst -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr M204.QListQSizeConst) foreign import ccall "genpop__QIcon_cacheKey" cacheKey' :: HoppyF.Ptr QIconConst -> HoppyP.IO HoppyDI.Int64 foreign import ccall "genpop__QIcon_fromTheme" fromTheme' :: HoppyF.Ptr M142.QStringConst -> HoppyP.IO (HoppyF.Ptr QIconConst) foreign import ccall "genpop__QIcon_fromThemeWithFallback" fromThemeWithFallback' :: HoppyF.Ptr M142.QStringConst -> HoppyF.Ptr QIconConst -> HoppyP.IO (HoppyF.Ptr QIconConst) foreign import ccall "genpop__QIcon_hasThemeIcon" hasThemeIcon' :: HoppyF.Ptr M142.QStringConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QIcon_isMask" isMask' :: HoppyF.Ptr QIconConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QIcon_isNull" isNull' :: HoppyF.Ptr QIconConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QIcon_name" name' :: HoppyF.Ptr QIconConst -> HoppyP.IO (HoppyF.Ptr M142.QStringConst) foreign import ccall "genpop__QIcon_paintWithRect" paintWithRect' :: HoppyF.Ptr QIconConst -> HoppyF.Ptr M310.QPainter -> HoppyF.Ptr M122.QRectConst -> HoppyP.IO () foreign import ccall "genpop__QIcon_paintWithRectAll" paintWithRectAll' :: HoppyF.Ptr QIconConst -> HoppyF.Ptr M310.QPainter -> HoppyF.Ptr M122.QRectConst -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QIcon_paintWithRaw" paintWithRaw' :: HoppyF.Ptr QIconConst -> HoppyF.Ptr M310.QPainter -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QIcon_paintWithRawAll" paintWithRawAll' :: HoppyF.Ptr QIconConst -> HoppyF.Ptr M310.QPainter -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QIcon_pixmapExtent" pixmapExtent' :: HoppyF.Ptr QIconConst -> HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr M316.QPixmapConst) foreign import ccall "genpop__QIcon_pixmapExtentAll" pixmapExtentAll' :: HoppyF.Ptr QIconConst -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr M316.QPixmapConst) foreign import ccall "genpop__QIcon_pixmapRaw" pixmapRaw' :: HoppyF.Ptr QIconConst -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr M316.QPixmapConst) foreign import ccall "genpop__QIcon_pixmapRawAll" pixmapRawAll' :: HoppyF.Ptr QIconConst -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr M316.QPixmapConst) foreign import ccall "genpop__QIcon_pixmapSize" pixmapSize' :: HoppyF.Ptr QIconConst -> HoppyF.Ptr M134.QSizeConst -> HoppyP.IO (HoppyF.Ptr M316.QPixmapConst) foreign import ccall "genpop__QIcon_pixmapSizeAll" pixmapSizeAll' :: HoppyF.Ptr QIconConst -> HoppyF.Ptr M134.QSizeConst -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr M316.QPixmapConst) foreign import ccall "genpop__QIcon_setIsMask" setIsMask' :: HoppyF.Ptr QIcon -> HoppyFC.CBool -> HoppyP.IO () foreign import ccall "genpop__QIcon_setThemeName" setThemeName' :: HoppyF.Ptr M142.QStringConst -> HoppyP.IO () foreign import ccall "genpop__QIcon_setThemeSearchPaths" setThemeSearchPaths' :: HoppyF.Ptr M144.QStringListConst -> HoppyP.IO () foreign import ccall "genpop__QIcon_swap" swap' :: HoppyF.Ptr QIcon -> HoppyF.Ptr QIcon -> HoppyP.IO () foreign import ccall "genpop__QIcon_themeName" themeName' :: HoppyP.IO (HoppyF.Ptr M142.QStringConst) foreign import ccall "genpop__QIcon_themeSearchPaths" themeSearchPaths' :: HoppyP.IO (HoppyF.Ptr M144.QStringListConst) foreign import ccall "genpop__QIcon_ASSIGN" aSSIGN' :: HoppyF.Ptr QIcon -> HoppyF.Ptr QIconConst -> HoppyP.IO (HoppyF.Ptr QIcon) foreign import ccall "gendel__QIcon" delete'QIcon :: HoppyF.Ptr QIconConst -> HoppyP.IO () foreign import ccall "&gendel__QIcon" deletePtr'QIcon :: HoppyF.FunPtr (HoppyF.Ptr QIconConst -> HoppyP.IO ()) class QIconValue a where withQIconPtr :: a -> (QIconConst -> HoppyP.IO b) -> HoppyP.IO b instance {-# OVERLAPPABLE #-} QIconConstPtr a => QIconValue a where withQIconPtr = HoppyP.flip ($) . toQIconConst class (HoppyFHR.CppPtr this) => QIconConstPtr this where toQIconConst :: this -> QIconConst actualSize :: (QIconValue this, M134.QSizeValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO HSize.HSize) actualSize arg'1 arg'2 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M134.withQSizePtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (HoppyFHR.decodeAndDelete . M134.QSizeConst) =<< (actualSize' arg'1' arg'2') actualSizeAll :: (QIconValue this, M134.QSizeValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (QIconMode) -> (QIconState) -> (HoppyP.IO HSize.HSize) actualSizeAll arg'1 arg'2 arg'3 arg'4 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M134.withQSizePtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'3 >>= \arg'3' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'4 >>= \arg'4' -> (HoppyFHR.decodeAndDelete . M134.QSizeConst) =<< (actualSizeAll' arg'1' arg'2' arg'3' arg'4') actualSizeWithWindow :: (QIconValue this, M342.QWindowPtr arg'2, M134.QSizeValue arg'3) => (this) {- ^ this -} -> (arg'2) -> (arg'3) -> (HoppyP.IO HSize.HSize) actualSizeWithWindow arg'1 arg'2 arg'3 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyFHR.withCppPtr (M342.toQWindow arg'2) $ \arg'2' -> M134.withQSizePtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> (HoppyFHR.decodeAndDelete . M134.QSizeConst) =<< (actualSizeWithWindow' arg'1' arg'2' arg'3') actualSizeWithWindowAll :: (QIconValue this, M342.QWindowPtr arg'2, M134.QSizeValue arg'3) => (this) {- ^ this -} -> (arg'2) -> (arg'3) -> (QIconMode) -> (QIconState) -> (HoppyP.IO HSize.HSize) actualSizeWithWindowAll arg'1 arg'2 arg'3 arg'4 arg'5 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyFHR.withCppPtr (M342.toQWindow arg'2) $ \arg'2' -> M134.withQSizePtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'4 >>= \arg'4' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'5 >>= \arg'5' -> (HoppyFHR.decodeAndDelete . M134.QSizeConst) =<< (actualSizeWithWindowAll' arg'1' arg'2' arg'3' arg'4' arg'5') availableSizes :: (QIconValue this) => (this) {- ^ this -} -> (HoppyP.IO [HSize.HSize]) availableSizes arg'1 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (HoppyFHR.decodeAndDelete . M204.QListQSizeConst) =<< (availableSizes' arg'1') availableSizesAll :: (QIconValue this) => (this) {- ^ this -} -> (QIconMode) -> (QIconState) -> (HoppyP.IO [HSize.HSize]) availableSizesAll arg'1 arg'2 arg'3 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'3 >>= \arg'3' -> (HoppyFHR.decodeAndDelete . M204.QListQSizeConst) =<< (availableSizesAll' arg'1' arg'2' arg'3') cacheKey :: (QIconValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyDI.Int64) cacheKey arg'1 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (cacheKey' arg'1') isMask :: (QIconValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Bool) isMask arg'1 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( (HoppyP.return . (/= 0)) ) =<< (isMask' arg'1') isNull :: (QIconValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Bool) isNull arg'1 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( (HoppyP.return . (/= 0)) ) =<< (isNull' arg'1') name :: (QIconValue this) => (this) {- ^ this -} -> (HoppyP.IO QtahP.String) name arg'1 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (HoppyFHR.decodeAndDelete . M142.QStringConst) =<< (name' arg'1') paintWithRect :: (QIconValue this, M310.QPainterPtr arg'2, M122.QRectValue arg'3) => (this) {- ^ this -} -> (arg'2) -> (arg'3) -> (HoppyP.IO ()) paintWithRect arg'1 arg'2 arg'3 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyFHR.withCppPtr (M310.toQPainter arg'2) $ \arg'2' -> M122.withQRectPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> (paintWithRect' arg'1' arg'2' arg'3') paintWithRectAll :: (QIconValue this, M310.QPainterPtr arg'2, M122.QRectValue arg'3, M190.IsQtAlignment arg'4) => (this) {- ^ this -} -> (arg'2) -> (arg'3) -> (arg'4) -> (QIconMode) -> (QIconState) -> (HoppyP.IO ()) paintWithRectAll arg'1 arg'2 arg'3 arg'4 arg'5 arg'6 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyFHR.withCppPtr (M310.toQPainter arg'2) $ \arg'2' -> M122.withQRectPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> ( QtahP.return . QtahFlags.flagsToNum . M190.toQtAlignment ) arg'4 >>= \arg'4' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'5 >>= \arg'5' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'6 >>= \arg'6' -> (paintWithRectAll' arg'1' arg'2' arg'3' arg'4' arg'5' arg'6') paintWithRaw :: (QIconValue this, M310.QPainterPtr arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.Int) -> (HoppyP.Int) -> (HoppyP.Int) -> (HoppyP.Int) -> (HoppyP.IO ()) paintWithRaw arg'1 arg'2 arg'3 arg'4 arg'5 arg'6 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyFHR.withCppPtr (M310.toQPainter arg'2) $ \arg'2' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'3 >>= \arg'3' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'4 >>= \arg'4' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'5 >>= \arg'5' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'6 >>= \arg'6' -> (paintWithRaw' arg'1' arg'2' arg'3' arg'4' arg'5' arg'6') paintWithRawAll :: (QIconValue this, M310.QPainterPtr arg'2, M190.IsQtAlignment arg'7) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.Int) -> (HoppyP.Int) -> (HoppyP.Int) -> (HoppyP.Int) -> (arg'7) -> (QIconMode) -> (QIconState) -> (HoppyP.IO ()) paintWithRawAll arg'1 arg'2 arg'3 arg'4 arg'5 arg'6 arg'7 arg'8 arg'9 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyFHR.withCppPtr (M310.toQPainter arg'2) $ \arg'2' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'3 >>= \arg'3' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'4 >>= \arg'4' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'5 >>= \arg'5' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'6 >>= \arg'6' -> ( QtahP.return . QtahFlags.flagsToNum . M190.toQtAlignment ) arg'7 >>= \arg'7' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'8 >>= \arg'8' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'9 >>= \arg'9' -> (paintWithRawAll' arg'1' arg'2' arg'3' arg'4' arg'5' arg'6' arg'7' arg'8' arg'9') pixmapExtent :: (QIconValue this) => (this) {- ^ this -} -> (HoppyP.Int) -> (HoppyP.IO M316.QPixmap) pixmapExtent arg'1 arg'2 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> (HoppyFHR.decodeAndDelete . M316.QPixmapConst) =<< (pixmapExtent' arg'1' arg'2') pixmapExtentAll :: (QIconValue this) => (this) {- ^ this -} -> (HoppyP.Int) -> (QIconMode) -> (QIconState) -> (HoppyP.IO M316.QPixmap) pixmapExtentAll arg'1 arg'2 arg'3 arg'4 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'3 >>= \arg'3' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'4 >>= \arg'4' -> (HoppyFHR.decodeAndDelete . M316.QPixmapConst) =<< (pixmapExtentAll' arg'1' arg'2' arg'3' arg'4') pixmapRaw :: (QIconValue this) => (this) {- ^ this -} -> (HoppyP.Int) -> (HoppyP.Int) -> (HoppyP.IO M316.QPixmap) pixmapRaw arg'1 arg'2 arg'3 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'3 >>= \arg'3' -> (HoppyFHR.decodeAndDelete . M316.QPixmapConst) =<< (pixmapRaw' arg'1' arg'2' arg'3') pixmapRawAll :: (QIconValue this) => (this) {- ^ this -} -> (HoppyP.Int) -> (HoppyP.Int) -> (QIconMode) -> (QIconState) -> (HoppyP.IO M316.QPixmap) pixmapRawAll arg'1 arg'2 arg'3 arg'4 arg'5 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'3 >>= \arg'3' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'4 >>= \arg'4' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'5 >>= \arg'5' -> (HoppyFHR.decodeAndDelete . M316.QPixmapConst) =<< (pixmapRawAll' arg'1' arg'2' arg'3' arg'4' arg'5') pixmapSize :: (QIconValue this, M134.QSizeValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO M316.QPixmap) pixmapSize arg'1 arg'2 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M134.withQSizePtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (HoppyFHR.decodeAndDelete . M316.QPixmapConst) =<< (pixmapSize' arg'1' arg'2') pixmapSizeAll :: (QIconValue this, M134.QSizeValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (QIconMode) -> (QIconState) -> (HoppyP.IO M316.QPixmap) pixmapSizeAll arg'1 arg'2 arg'3 arg'4 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M134.withQSizePtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'3 >>= \arg'3' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'4 >>= \arg'4' -> (HoppyFHR.decodeAndDelete . M316.QPixmapConst) =<< (pixmapSizeAll' arg'1' arg'2' arg'3' arg'4') class (QIconConstPtr this) => QIconPtr this where toQIcon :: this -> QIcon addFile :: (QIconPtr this, M142.QStringValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) addFile arg'1 arg'2 = HoppyFHR.withCppPtr (toQIcon arg'1) $ \arg'1' -> M142.withQStringPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (addFile' arg'1' arg'2') addFileAll :: (QIconPtr this, M142.QStringValue arg'2, M134.QSizeValue arg'3) => (this) {- ^ this -} -> (arg'2) -> (arg'3) -> (QIconMode) -> (QIconState) -> (HoppyP.IO ()) addFileAll arg'1 arg'2 arg'3 arg'4 arg'5 = HoppyFHR.withCppPtr (toQIcon arg'1) $ \arg'1' -> M142.withQStringPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> M134.withQSizePtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'4 >>= \arg'4' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'5 >>= \arg'5' -> (addFileAll' arg'1' arg'2' arg'3' arg'4' arg'5') addPixmap :: (QIconPtr this, M316.QPixmapValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) addPixmap arg'1 arg'2 = HoppyFHR.withCppPtr (toQIcon arg'1) $ \arg'1' -> M316.withQPixmapPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (addPixmap' arg'1' arg'2') addPixmapAll :: (QIconPtr this, M316.QPixmapValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (QIconMode) -> (QIconState) -> (HoppyP.IO ()) addPixmapAll arg'1 arg'2 arg'3 arg'4 = HoppyFHR.withCppPtr (toQIcon arg'1) $ \arg'1' -> M316.withQPixmapPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'3 >>= \arg'3' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'4 >>= \arg'4' -> (addPixmapAll' arg'1' arg'2' arg'3' arg'4') setIsMask :: (QIconPtr this) => (this) {- ^ this -} -> (HoppyP.Bool) -> (HoppyP.IO ()) setIsMask arg'1 arg'2 = HoppyFHR.withCppPtr (toQIcon arg'1) $ \arg'1' -> ( \x -> HoppyP.return $ if x then 1 else 0 ) arg'2 >>= \arg'2' -> (setIsMask' arg'1' arg'2') swap :: (QIconPtr this, QIconPtr arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) swap arg'1 arg'2 = HoppyFHR.withCppPtr (toQIcon arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (toQIcon arg'2) $ \arg'2' -> (swap' arg'1' arg'2') aSSIGN :: (QIconPtr this, QIconValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO QIcon) aSSIGN arg'1 arg'2 = HoppyFHR.withCppPtr (toQIcon arg'1) $ \arg'1' -> withQIconPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> HoppyP.fmap QIcon (aSSIGN' arg'1' arg'2') fromTheme :: (M142.QStringValue arg'1) => (arg'1) -> (HoppyP.IO QIcon) fromTheme arg'1 = M142.withQStringPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (HoppyFHR.decodeAndDelete . QIconConst) =<< (fromTheme' arg'1') fromThemeWithFallback :: (M142.QStringValue arg'1, QIconValue arg'2) => (arg'1) -> (arg'2) -> (HoppyP.IO QIcon) fromThemeWithFallback arg'1 arg'2 = M142.withQStringPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> withQIconPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (HoppyFHR.decodeAndDelete . QIconConst) =<< (fromThemeWithFallback' arg'1' arg'2') hasThemeIcon :: (M142.QStringValue arg'1) => (arg'1) -> (HoppyP.IO HoppyP.Bool) hasThemeIcon arg'1 = M142.withQStringPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( (HoppyP.return . (/= 0)) ) =<< (hasThemeIcon' arg'1') setThemeName :: (M142.QStringValue arg'1) => (arg'1) -> (HoppyP.IO ()) setThemeName arg'1 = M142.withQStringPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (setThemeName' arg'1') setThemeSearchPaths :: (M144.QStringListValue arg'1) => (arg'1) -> (HoppyP.IO ()) setThemeSearchPaths arg'1 = M144.withQStringListPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (setThemeSearchPaths' arg'1') themeName :: (HoppyP.IO QtahP.String) themeName = (HoppyFHR.decodeAndDelete . M142.QStringConst) =<< (themeName') themeSearchPaths :: (HoppyP.IO [QtahP.String]) themeSearchPaths = (HoppyFHR.decodeAndDelete . M144.QStringListConst) =<< (themeSearchPaths') data QIconConst = QIconConst (HoppyF.Ptr QIconConst) | QIconConstGc (HoppyF.ForeignPtr ()) (HoppyF.Ptr QIconConst) deriving (HoppyP.Show) instance HoppyP.Eq QIconConst where x == y = HoppyFHR.toPtr x == HoppyFHR.toPtr y instance HoppyP.Ord QIconConst where compare x y = HoppyP.compare (HoppyFHR.toPtr x) (HoppyFHR.toPtr y) castQIconToConst :: QIcon -> QIconConst castQIconToConst (QIcon ptr') = QIconConst $ HoppyF.castPtr ptr' castQIconToConst (QIconGc fptr' ptr') = QIconConstGc fptr' $ HoppyF.castPtr ptr' instance HoppyFHR.CppPtr QIconConst where nullptr = QIconConst HoppyF.nullPtr withCppPtr (QIconConst ptr') f' = f' ptr' withCppPtr (QIconConstGc fptr' ptr') f' = HoppyF.withForeignPtr fptr' $ \_ -> f' ptr' toPtr (QIconConst ptr') = ptr' toPtr (QIconConstGc _ ptr') = ptr' touchCppPtr (QIconConst _) = HoppyP.return () touchCppPtr (QIconConstGc fptr' _) = HoppyF.touchForeignPtr fptr' instance HoppyFHR.Deletable QIconConst where delete (QIconConst ptr') = delete'QIcon ptr' delete (QIconConstGc _ _) = HoppyP.fail $ HoppyP.concat ["Deletable.delete: Asked to delete a GC-managed ", "QIconConst", " object."] toGc this'@(QIconConst ptr') = if ptr' == HoppyF.nullPtr then HoppyP.return this' else HoppyP.fmap (HoppyP.flip QIconConstGc ptr') $ HoppyF.newForeignPtr (HoppyF.castFunPtr deletePtr'QIcon :: HoppyF.FunPtr (HoppyF.Ptr () -> HoppyP.IO ())) (HoppyF.castPtr ptr' :: HoppyF.Ptr ()) toGc this'@(QIconConstGc {}) = HoppyP.return this' instance HoppyFHR.Copyable QIconConst QIcon where copy = newCopy instance QIconConstPtr QIconConst where toQIconConst = HoppyP.id data QIcon = QIcon (HoppyF.Ptr QIcon) | QIconGc (HoppyF.ForeignPtr ()) (HoppyF.Ptr QIcon) deriving (HoppyP.Show) instance HoppyP.Eq QIcon where x == y = HoppyFHR.toPtr x == HoppyFHR.toPtr y instance HoppyP.Ord QIcon where compare x y = HoppyP.compare (HoppyFHR.toPtr x) (HoppyFHR.toPtr y) castQIconToNonconst :: QIconConst -> QIcon castQIconToNonconst (QIconConst ptr') = QIcon $ HoppyF.castPtr ptr' castQIconToNonconst (QIconConstGc fptr' ptr') = QIconGc fptr' $ HoppyF.castPtr ptr' instance HoppyFHR.CppPtr QIcon where nullptr = QIcon HoppyF.nullPtr withCppPtr (QIcon ptr') f' = f' ptr' withCppPtr (QIconGc fptr' ptr') f' = HoppyF.withForeignPtr fptr' $ \_ -> f' ptr' toPtr (QIcon ptr') = ptr' toPtr (QIconGc _ ptr') = ptr' touchCppPtr (QIcon _) = HoppyP.return () touchCppPtr (QIconGc fptr' _) = HoppyF.touchForeignPtr fptr' instance HoppyFHR.Deletable QIcon where delete (QIcon ptr') = delete'QIcon $ (HoppyF.castPtr ptr' :: HoppyF.Ptr QIconConst) delete (QIconGc _ _) = HoppyP.fail $ HoppyP.concat ["Deletable.delete: Asked to delete a GC-managed ", "QIcon", " object."] toGc this'@(QIcon ptr') = if ptr' == HoppyF.nullPtr then HoppyP.return this' else HoppyP.fmap (HoppyP.flip QIconGc ptr') $ HoppyF.newForeignPtr (HoppyF.castFunPtr deletePtr'QIcon :: HoppyF.FunPtr (HoppyF.Ptr () -> HoppyP.IO ())) (HoppyF.castPtr ptr' :: HoppyF.Ptr ()) toGc this'@(QIconGc {}) = HoppyP.return this' instance HoppyFHR.Copyable QIcon QIcon where copy = newCopy instance QIconConstPtr QIcon where toQIconConst (QIcon ptr') = QIconConst $ (HoppyF.castPtr :: HoppyF.Ptr QIcon -> HoppyF.Ptr QIconConst) ptr' toQIconConst (QIconGc fptr' ptr') = QIconConstGc fptr' $ (HoppyF.castPtr :: HoppyF.Ptr QIcon -> HoppyF.Ptr QIconConst) ptr' instance QIconPtr QIcon where toQIcon = HoppyP.id new :: (HoppyP.IO QIcon) new = HoppyP.fmap QIcon (new') newWithFile :: (M142.QStringValue arg'1) => (arg'1) -> (HoppyP.IO QIcon) newWithFile arg'1 = M142.withQStringPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap QIcon (newWithFile' arg'1') newWithPixmap :: (M316.QPixmapValue arg'1) => (arg'1) -> (HoppyP.IO QIcon) newWithPixmap arg'1 = M316.withQPixmapPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap QIcon (newWithPixmap' arg'1') newCopy :: (QIconValue arg'1) => (arg'1) -> (HoppyP.IO QIcon) newCopy arg'1 = withQIconPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap QIcon (newCopy' arg'1') class QIconSuper a where downToQIcon :: a -> QIcon class QIconSuperConst a where downToQIconConst :: a -> QIconConst instance HoppyFHR.Assignable (HoppyF.Ptr (HoppyF.Ptr QIcon)) QIcon where assign ptr' value' = HoppyF.poke ptr' $ HoppyFHR.toPtr value' instance QIconValue a => HoppyFHR.Assignable QIcon a where assign x' y' = aSSIGN x' y' >> HoppyP.return () instance HoppyFHR.Decodable (HoppyF.Ptr (HoppyF.Ptr QIcon)) QIcon where decode = HoppyP.fmap QIcon . HoppyF.peek instance HoppyFHR.Decodable QIcon (QIcon) where decode = HoppyFHR.decode . toQIconConst instance HoppyFHR.Decodable QIconConst (QIcon) where decode = HoppyFHR.copy >=> HoppyFHR.toGc data QIconMode = Normal | Disabled | Active | Selected | UnknownQIconMode (HoppyFC.CInt) deriving (HoppyP.Show) instance HoppyFHR.CppEnum (HoppyFC.CInt) QIconMode where fromCppEnum Normal = 0 fromCppEnum Disabled = 1 fromCppEnum Active = 2 fromCppEnum Selected = 3 fromCppEnum (UnknownQIconMode n) = n toCppEnum (0) = Normal toCppEnum (1) = Disabled toCppEnum (2) = Active toCppEnum (3) = Selected toCppEnum n = UnknownQIconMode n instance HoppyP.Eq QIconMode where x == y = HoppyFHR.fromCppEnum x == HoppyFHR.fromCppEnum y instance HoppyP.Ord QIconMode where compare x y = HoppyP.compare (HoppyFHR.fromCppEnum x) (HoppyFHR.fromCppEnum y) data QIconState = On | Off | UnknownQIconState (HoppyFC.CInt) deriving (HoppyP.Show) instance HoppyFHR.CppEnum (HoppyFC.CInt) QIconState where fromCppEnum On = 0 fromCppEnum Off = 1 fromCppEnum (UnknownQIconState n) = n toCppEnum (0) = On toCppEnum (1) = Off toCppEnum n = UnknownQIconState n instance HoppyP.Eq QIconState where x == y = HoppyFHR.fromCppEnum x == HoppyFHR.fromCppEnum y instance HoppyP.Ord QIconState where compare x y = HoppyP.compare (HoppyFHR.fromCppEnum x) (HoppyFHR.fromCppEnum y)