{-# LANGUAGE FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, MonoLocalBinds, MultiParamTypeClasses, ScopedTypeVariables, TypeSynonymInstances, UndecidableInstances #-} ---------- GENERATED FILE, EDITS WILL BE LOST ---------- module Graphics.UI.Qtah.Generated.Core.QPalette ( QPaletteValue (..), QPaletteConstPtr (..), alternateBase, base, brightText, brushWithGroup, brush, button, buttonText, cacheKey, colorWithGroup, color, currentColorGroup, dark, highlight, highlightedText, isBrushSet, isCopyOf, isEqual, light, link, linkVisited, mid, midlight, placeholderText, shadow, text, toolTipBase, toolTipText, window, windowText, eQ, nE, QPalettePtr (..), setBrush, setBrushWithGroup, setColor, setColorWithGroup, setColorGroup, setCurrentColorGroup, swap, aSSIGN, QPaletteConst (..), castQPaletteToConst, QPalette (..), castQPaletteToNonconst, new, newWithColor, newWithColors, newWithGlobalColor, newWithBrushes, newCopy, QPaletteSuper (..), QPaletteSuperConst (..), QPaletteColorGroup (..), QPaletteColorRole (..), ) 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.Generated.Core.Types as M190 import {-# SOURCE #-} qualified Graphics.UI.Qtah.Generated.Gui.QBrush as M246 import qualified Graphics.UI.Qtah.Generated.Gui.QColor as M252 import Prelude (($), (.), (/=), (=<<), (==), (>>), (>>=)) import qualified Prelude as HoppyP foreign import ccall "genpop__QPalette_new" new' :: HoppyP.IO (HoppyF.Ptr QPalette) foreign import ccall "genpop__QPalette_newWithColor" newWithColor' :: HoppyF.Ptr M252.QColorConst -> HoppyP.IO (HoppyF.Ptr QPalette) foreign import ccall "genpop__QPalette_newWithColors" newWithColors' :: HoppyF.Ptr M252.QColorConst -> HoppyF.Ptr M252.QColorConst -> HoppyP.IO (HoppyF.Ptr QPalette) foreign import ccall "genpop__QPalette_newWithGlobalColor" newWithGlobalColor' :: HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr QPalette) foreign import ccall "genpop__QPalette_newWithBrushes" newWithBrushes' :: HoppyF.Ptr M246.QBrushConst -> HoppyF.Ptr M246.QBrushConst -> HoppyF.Ptr M246.QBrushConst -> HoppyF.Ptr M246.QBrushConst -> HoppyF.Ptr M246.QBrushConst -> HoppyF.Ptr M246.QBrushConst -> HoppyF.Ptr M246.QBrushConst -> HoppyF.Ptr M246.QBrushConst -> HoppyF.Ptr M246.QBrushConst -> HoppyP.IO (HoppyF.Ptr QPalette) foreign import ccall "genpop__QPalette_newCopy" newCopy' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr QPalette) foreign import ccall "genpop__QPalette_alternateBase" alternateBase' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_base" base' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_brightText" brightText' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_brushWithGroup" brushWithGroup' :: HoppyF.Ptr QPaletteConst -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_brush" brush' :: HoppyF.Ptr QPaletteConst -> HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_button" button' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_buttonText" buttonText' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_cacheKey" cacheKey' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO HoppyDI.Int64 foreign import ccall "genpop__QPalette_colorWithGroup" colorWithGroup' :: HoppyF.Ptr QPaletteConst -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr M252.QColorConst) foreign import ccall "genpop__QPalette_color" color' :: HoppyF.Ptr QPaletteConst -> HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr M252.QColorConst) foreign import ccall "genpop__QPalette_currentColorGroup" currentColorGroup' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO HoppyFC.CInt foreign import ccall "genpop__QPalette_dark" dark' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_highlight" highlight' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_highlightedText" highlightedText' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_isBrushSet" isBrushSet' :: HoppyF.Ptr QPaletteConst -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QPalette_isCopyOf" isCopyOf' :: HoppyF.Ptr QPaletteConst -> HoppyF.Ptr QPaletteConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QPalette_isEqual" isEqual' :: HoppyF.Ptr QPaletteConst -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QPalette_light" light' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_link" link' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_linkVisited" linkVisited' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_mid" mid' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_midlight" midlight' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_placeholderText" placeholderText' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_setBrush" setBrush' :: HoppyF.Ptr QPalette -> HoppyFC.CInt -> HoppyF.Ptr M246.QBrushConst -> HoppyP.IO () foreign import ccall "genpop__QPalette_setBrushWithGroup" setBrushWithGroup' :: HoppyF.Ptr QPalette -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyF.Ptr M246.QBrushConst -> HoppyP.IO () foreign import ccall "genpop__QPalette_setColor" setColor' :: HoppyF.Ptr QPalette -> HoppyFC.CInt -> HoppyF.Ptr M252.QColorConst -> HoppyP.IO () foreign import ccall "genpop__QPalette_setColorWithGroup" setColorWithGroup' :: HoppyF.Ptr QPalette -> HoppyFC.CInt -> HoppyFC.CInt -> HoppyF.Ptr M252.QColorConst -> HoppyP.IO () foreign import ccall "genpop__QPalette_setColorGroup" setColorGroup' :: HoppyF.Ptr QPalette -> HoppyFC.CInt -> HoppyF.Ptr M246.QBrushConst -> HoppyF.Ptr M246.QBrushConst -> HoppyF.Ptr M246.QBrushConst -> HoppyF.Ptr M246.QBrushConst -> HoppyF.Ptr M246.QBrushConst -> HoppyF.Ptr M246.QBrushConst -> HoppyF.Ptr M246.QBrushConst -> HoppyF.Ptr M246.QBrushConst -> HoppyF.Ptr M246.QBrushConst -> HoppyP.IO () foreign import ccall "genpop__QPalette_setCurrentColorGroup" setCurrentColorGroup' :: HoppyF.Ptr QPalette -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QPalette_shadow" shadow' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_swap" swap' :: HoppyF.Ptr QPalette -> HoppyF.Ptr QPalette -> HoppyP.IO () foreign import ccall "genpop__QPalette_text" text' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_toolTipBase" toolTipBase' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_toolTipText" toolTipText' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_window" window' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_windowText" windowText' :: HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr M246.QBrushConst) foreign import ccall "genpop__QPalette_EQ" eQ' :: HoppyF.Ptr QPaletteConst -> HoppyF.Ptr QPaletteConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QPalette_NE" nE' :: HoppyF.Ptr QPaletteConst -> HoppyF.Ptr QPaletteConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QPalette_ASSIGN" aSSIGN' :: HoppyF.Ptr QPalette -> HoppyF.Ptr QPaletteConst -> HoppyP.IO (HoppyF.Ptr QPalette) foreign import ccall "gendel__QPalette" delete'QPalette :: HoppyF.Ptr QPaletteConst -> HoppyP.IO () foreign import ccall "&gendel__QPalette" deletePtr'QPalette :: HoppyF.FunPtr (HoppyF.Ptr QPaletteConst -> HoppyP.IO ()) class QPaletteValue a where withQPalettePtr :: a -> (QPaletteConst -> HoppyP.IO b) -> HoppyP.IO b instance {-# OVERLAPPABLE #-} QPaletteConstPtr a => QPaletteValue a where withQPalettePtr = HoppyP.flip ($) . toQPaletteConst class (HoppyFHR.CppPtr this) => QPaletteConstPtr this where toQPaletteConst :: this -> QPaletteConst alternateBase :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) alternateBase arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (alternateBase' arg'1') base :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) base arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (base' arg'1') brightText :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) brightText arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (brightText' arg'1') brushWithGroup :: (QPaletteValue this) => (this) {- ^ this -} -> (QPaletteColorGroup) -> (QPaletteColorRole) -> (HoppyP.IO M246.QBrushConst) brushWithGroup arg'1 arg'2 arg'3 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'3 >>= \arg'3' -> HoppyP.fmap M246.QBrushConst (brushWithGroup' arg'1' arg'2' arg'3') brush :: (QPaletteValue this) => (this) {- ^ this -} -> (QPaletteColorRole) -> (HoppyP.IO M246.QBrushConst) brush arg'1 arg'2 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'2 >>= \arg'2' -> HoppyP.fmap M246.QBrushConst (brush' arg'1' arg'2') button :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) button arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (button' arg'1') buttonText :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) buttonText arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (buttonText' arg'1') cacheKey :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyDI.Int64) cacheKey arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (cacheKey' arg'1') colorWithGroup :: (QPaletteValue this) => (this) {- ^ this -} -> (QPaletteColorGroup) -> (QPaletteColorRole) -> (HoppyP.IO M252.QColorConst) colorWithGroup arg'1 arg'2 arg'3 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'3 >>= \arg'3' -> HoppyP.fmap M252.QColorConst (colorWithGroup' arg'1' arg'2' arg'3') color :: (QPaletteValue this) => (this) {- ^ this -} -> (QPaletteColorRole) -> (HoppyP.IO M252.QColorConst) color arg'1 arg'2 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'2 >>= \arg'2' -> HoppyP.fmap M252.QColorConst (color' arg'1' arg'2') currentColorGroup :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO QPaletteColorGroup) currentColorGroup arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.toCppEnum ) =<< (currentColorGroup' arg'1') dark :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) dark arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (dark' arg'1') highlight :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) highlight arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (highlight' arg'1') highlightedText :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) highlightedText arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (highlightedText' arg'1') isBrushSet :: (QPaletteValue this) => (this) {- ^ this -} -> (QPaletteColorGroup) -> (QPaletteColorRole) -> (HoppyP.IO HoppyP.Bool) isBrushSet arg'1 arg'2 arg'3 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'3 >>= \arg'3' -> ( (HoppyP.return . (/= 0)) ) =<< (isBrushSet' arg'1' arg'2' arg'3') isCopyOf :: (QPaletteValue this, QPaletteValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO HoppyP.Bool) isCopyOf arg'1 arg'2 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> withQPalettePtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> ( (HoppyP.return . (/= 0)) ) =<< (isCopyOf' arg'1' arg'2') isEqual :: (QPaletteValue this) => (this) {- ^ this -} -> (QPaletteColorGroup) -> (QPaletteColorGroup) -> (HoppyP.IO HoppyP.Bool) isEqual arg'1 arg'2 arg'3 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'3 >>= \arg'3' -> ( (HoppyP.return . (/= 0)) ) =<< (isEqual' arg'1' arg'2' arg'3') light :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) light arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (light' arg'1') link :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) link arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (link' arg'1') linkVisited :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) linkVisited arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (linkVisited' arg'1') mid :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) mid arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (mid' arg'1') midlight :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) midlight arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (midlight' arg'1') placeholderText :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) placeholderText arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (placeholderText' arg'1') shadow :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) shadow arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (shadow' arg'1') text :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) text arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (text' arg'1') toolTipBase :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) toolTipBase arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (toolTipBase' arg'1') toolTipText :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) toolTipText arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (toolTipText' arg'1') window :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) window arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (window' arg'1') windowText :: (QPaletteValue this) => (this) {- ^ this -} -> (HoppyP.IO M246.QBrushConst) windowText arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M246.QBrushConst (windowText' arg'1') eQ :: (QPaletteValue this, QPaletteValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO HoppyP.Bool) eQ arg'1 arg'2 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> withQPalettePtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> ( (HoppyP.return . (/= 0)) ) =<< (eQ' arg'1' arg'2') nE :: (QPaletteValue this, QPaletteValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO HoppyP.Bool) nE arg'1 arg'2 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> withQPalettePtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> ( (HoppyP.return . (/= 0)) ) =<< (nE' arg'1' arg'2') class (QPaletteConstPtr this) => QPalettePtr this where toQPalette :: this -> QPalette setBrush :: (QPalettePtr this, M246.QBrushValue arg'3) => (this) {- ^ this -} -> (QPaletteColorRole) -> (arg'3) -> (HoppyP.IO ()) setBrush arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQPalette arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'2 >>= \arg'2' -> M246.withQBrushPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> (setBrush' arg'1' arg'2' arg'3') setBrushWithGroup :: (QPalettePtr this, M246.QBrushValue arg'4) => (this) {- ^ this -} -> (QPaletteColorGroup) -> (QPaletteColorRole) -> (arg'4) -> (HoppyP.IO ()) setBrushWithGroup arg'1 arg'2 arg'3 arg'4 = HoppyFHR.withCppPtr (toQPalette arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'3 >>= \arg'3' -> M246.withQBrushPtr arg'4 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'4' -> (setBrushWithGroup' arg'1' arg'2' arg'3' arg'4') setColor :: (QPalettePtr this, M252.QColorValue arg'3) => (this) {- ^ this -} -> (QPaletteColorRole) -> (arg'3) -> (HoppyP.IO ()) setColor arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQPalette arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'2 >>= \arg'2' -> M252.withQColorPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> (setColor' arg'1' arg'2' arg'3') setColorWithGroup :: (QPalettePtr this, M252.QColorValue arg'4) => (this) {- ^ this -} -> (QPaletteColorGroup) -> (QPaletteColorRole) -> (arg'4) -> (HoppyP.IO ()) setColorWithGroup arg'1 arg'2 arg'3 arg'4 = HoppyFHR.withCppPtr (toQPalette arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'3 >>= \arg'3' -> M252.withQColorPtr arg'4 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'4' -> (setColorWithGroup' arg'1' arg'2' arg'3' arg'4') setColorGroup :: (QPalettePtr this, M246.QBrushValue arg'3, M246.QBrushValue arg'4, M246.QBrushValue arg'5, M246.QBrushValue arg'6, M246.QBrushValue arg'7, M246.QBrushValue arg'8, M246.QBrushValue arg'9, M246.QBrushValue arg'10, M246.QBrushValue arg'11) => (this) {- ^ this -} -> (QPaletteColorGroup) -> (arg'3) -> (arg'4) -> (arg'5) -> (arg'6) -> (arg'7) -> (arg'8) -> (arg'9) -> (arg'10) -> (arg'11) -> (HoppyP.IO ()) setColorGroup arg'1 arg'2 arg'3 arg'4 arg'5 arg'6 arg'7 arg'8 arg'9 arg'10 arg'11 = HoppyFHR.withCppPtr (toQPalette arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'2 >>= \arg'2' -> M246.withQBrushPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> M246.withQBrushPtr arg'4 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'4' -> M246.withQBrushPtr arg'5 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'5' -> M246.withQBrushPtr arg'6 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'6' -> M246.withQBrushPtr arg'7 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'7' -> M246.withQBrushPtr arg'8 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'8' -> M246.withQBrushPtr arg'9 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'9' -> M246.withQBrushPtr arg'10 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'10' -> M246.withQBrushPtr arg'11 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'11' -> (setColorGroup' arg'1' arg'2' arg'3' arg'4' arg'5' arg'6' arg'7' arg'8' arg'9' arg'10' arg'11') setCurrentColorGroup :: (QPalettePtr this) => (this) {- ^ this -} -> (QPaletteColorGroup) -> (HoppyP.IO ()) setCurrentColorGroup arg'1 arg'2 = HoppyFHR.withCppPtr (toQPalette arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'2 >>= \arg'2' -> (setCurrentColorGroup' arg'1' arg'2') swap :: (QPalettePtr this, QPalettePtr arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) swap arg'1 arg'2 = HoppyFHR.withCppPtr (toQPalette arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (toQPalette arg'2) $ \arg'2' -> (swap' arg'1' arg'2') aSSIGN :: (QPalettePtr this, QPaletteValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO QPalette) aSSIGN arg'1 arg'2 = HoppyFHR.withCppPtr (toQPalette arg'1) $ \arg'1' -> withQPalettePtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> HoppyP.fmap QPalette (aSSIGN' arg'1' arg'2') data QPaletteConst = QPaletteConst (HoppyF.Ptr QPaletteConst) | QPaletteConstGc (HoppyF.ForeignPtr ()) (HoppyF.Ptr QPaletteConst) deriving (HoppyP.Show) instance HoppyP.Eq QPaletteConst where x == y = HoppyFHR.toPtr x == HoppyFHR.toPtr y instance HoppyP.Ord QPaletteConst where compare x y = HoppyP.compare (HoppyFHR.toPtr x) (HoppyFHR.toPtr y) castQPaletteToConst :: QPalette -> QPaletteConst castQPaletteToConst (QPalette ptr') = QPaletteConst $ HoppyF.castPtr ptr' castQPaletteToConst (QPaletteGc fptr' ptr') = QPaletteConstGc fptr' $ HoppyF.castPtr ptr' instance HoppyFHR.CppPtr QPaletteConst where nullptr = QPaletteConst HoppyF.nullPtr withCppPtr (QPaletteConst ptr') f' = f' ptr' withCppPtr (QPaletteConstGc fptr' ptr') f' = HoppyF.withForeignPtr fptr' $ \_ -> f' ptr' toPtr (QPaletteConst ptr') = ptr' toPtr (QPaletteConstGc _ ptr') = ptr' touchCppPtr (QPaletteConst _) = HoppyP.return () touchCppPtr (QPaletteConstGc fptr' _) = HoppyF.touchForeignPtr fptr' instance HoppyFHR.Deletable QPaletteConst where delete (QPaletteConst ptr') = delete'QPalette ptr' delete (QPaletteConstGc _ _) = HoppyP.fail $ HoppyP.concat ["Deletable.delete: Asked to delete a GC-managed ", "QPaletteConst", " object."] toGc this'@(QPaletteConst ptr') = if ptr' == HoppyF.nullPtr then HoppyP.return this' else HoppyP.fmap (HoppyP.flip QPaletteConstGc ptr') $ HoppyF.newForeignPtr (HoppyF.castFunPtr deletePtr'QPalette :: HoppyF.FunPtr (HoppyF.Ptr () -> HoppyP.IO ())) (HoppyF.castPtr ptr' :: HoppyF.Ptr ()) toGc this'@(QPaletteConstGc {}) = HoppyP.return this' instance HoppyFHR.Copyable QPaletteConst QPalette where copy = newCopy instance QPaletteConstPtr QPaletteConst where toQPaletteConst = HoppyP.id data QPalette = QPalette (HoppyF.Ptr QPalette) | QPaletteGc (HoppyF.ForeignPtr ()) (HoppyF.Ptr QPalette) deriving (HoppyP.Show) instance HoppyP.Eq QPalette where x == y = HoppyFHR.toPtr x == HoppyFHR.toPtr y instance HoppyP.Ord QPalette where compare x y = HoppyP.compare (HoppyFHR.toPtr x) (HoppyFHR.toPtr y) castQPaletteToNonconst :: QPaletteConst -> QPalette castQPaletteToNonconst (QPaletteConst ptr') = QPalette $ HoppyF.castPtr ptr' castQPaletteToNonconst (QPaletteConstGc fptr' ptr') = QPaletteGc fptr' $ HoppyF.castPtr ptr' instance HoppyFHR.CppPtr QPalette where nullptr = QPalette HoppyF.nullPtr withCppPtr (QPalette ptr') f' = f' ptr' withCppPtr (QPaletteGc fptr' ptr') f' = HoppyF.withForeignPtr fptr' $ \_ -> f' ptr' toPtr (QPalette ptr') = ptr' toPtr (QPaletteGc _ ptr') = ptr' touchCppPtr (QPalette _) = HoppyP.return () touchCppPtr (QPaletteGc fptr' _) = HoppyF.touchForeignPtr fptr' instance HoppyFHR.Deletable QPalette where delete (QPalette ptr') = delete'QPalette $ (HoppyF.castPtr ptr' :: HoppyF.Ptr QPaletteConst) delete (QPaletteGc _ _) = HoppyP.fail $ HoppyP.concat ["Deletable.delete: Asked to delete a GC-managed ", "QPalette", " object."] toGc this'@(QPalette ptr') = if ptr' == HoppyF.nullPtr then HoppyP.return this' else HoppyP.fmap (HoppyP.flip QPaletteGc ptr') $ HoppyF.newForeignPtr (HoppyF.castFunPtr deletePtr'QPalette :: HoppyF.FunPtr (HoppyF.Ptr () -> HoppyP.IO ())) (HoppyF.castPtr ptr' :: HoppyF.Ptr ()) toGc this'@(QPaletteGc {}) = HoppyP.return this' instance HoppyFHR.Copyable QPalette QPalette where copy = newCopy instance QPaletteConstPtr QPalette where toQPaletteConst (QPalette ptr') = QPaletteConst $ (HoppyF.castPtr :: HoppyF.Ptr QPalette -> HoppyF.Ptr QPaletteConst) ptr' toQPaletteConst (QPaletteGc fptr' ptr') = QPaletteConstGc fptr' $ (HoppyF.castPtr :: HoppyF.Ptr QPalette -> HoppyF.Ptr QPaletteConst) ptr' instance QPalettePtr QPalette where toQPalette = HoppyP.id new :: (HoppyP.IO QPalette) new = HoppyP.fmap QPalette (new') newWithColor :: (M252.QColorValue arg'1) => (arg'1) -> (HoppyP.IO QPalette) newWithColor arg'1 = M252.withQColorPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap QPalette (newWithColor' arg'1') newWithColors :: (M252.QColorValue arg'1, M252.QColorValue arg'2) => (arg'1) -> (arg'2) -> (HoppyP.IO QPalette) newWithColors arg'1 arg'2 = M252.withQColorPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M252.withQColorPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> HoppyP.fmap QPalette (newWithColors' arg'1' arg'2') newWithGlobalColor :: (M190.QtGlobalColor) -> (HoppyP.IO QPalette) newWithGlobalColor arg'1 = ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'1 >>= \arg'1' -> HoppyP.fmap QPalette (newWithGlobalColor' arg'1') newWithBrushes :: (M246.QBrushValue arg'1, M246.QBrushValue arg'2, M246.QBrushValue arg'3, M246.QBrushValue arg'4, M246.QBrushValue arg'5, M246.QBrushValue arg'6, M246.QBrushValue arg'7, M246.QBrushValue arg'8, M246.QBrushValue arg'9) => (arg'1) -> (arg'2) -> (arg'3) -> (arg'4) -> (arg'5) -> (arg'6) -> (arg'7) -> (arg'8) -> (arg'9) -> (HoppyP.IO QPalette) newWithBrushes arg'1 arg'2 arg'3 arg'4 arg'5 arg'6 arg'7 arg'8 arg'9 = M246.withQBrushPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M246.withQBrushPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> M246.withQBrushPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> M246.withQBrushPtr arg'4 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'4' -> M246.withQBrushPtr arg'5 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'5' -> M246.withQBrushPtr arg'6 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'6' -> M246.withQBrushPtr arg'7 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'7' -> M246.withQBrushPtr arg'8 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'8' -> M246.withQBrushPtr arg'9 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'9' -> HoppyP.fmap QPalette (newWithBrushes' arg'1' arg'2' arg'3' arg'4' arg'5' arg'6' arg'7' arg'8' arg'9') newCopy :: (QPaletteValue arg'1) => (arg'1) -> (HoppyP.IO QPalette) newCopy arg'1 = withQPalettePtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap QPalette (newCopy' arg'1') class QPaletteSuper a where downToQPalette :: a -> QPalette class QPaletteSuperConst a where downToQPaletteConst :: a -> QPaletteConst instance HoppyFHR.Assignable (HoppyF.Ptr (HoppyF.Ptr QPalette)) QPalette where assign ptr' value' = HoppyF.poke ptr' $ HoppyFHR.toPtr value' instance QPaletteValue a => HoppyFHR.Assignable QPalette a where assign x' y' = aSSIGN x' y' >> HoppyP.return () instance HoppyFHR.Decodable (HoppyF.Ptr (HoppyF.Ptr QPalette)) QPalette where decode = HoppyP.fmap QPalette . HoppyF.peek instance HoppyFHR.Decodable QPalette (QPalette) where decode = HoppyFHR.decode . toQPaletteConst instance HoppyFHR.Decodable QPaletteConst (QPalette) where decode = HoppyFHR.copy >=> HoppyFHR.toGc data QPaletteColorGroup = Disabled | Active | Inactive | Normal | UnknownQPaletteColorGroup (HoppyFC.CInt) deriving (HoppyP.Show) instance HoppyFHR.CppEnum (HoppyFC.CInt) QPaletteColorGroup where fromCppEnum Disabled = 1 fromCppEnum Active = 0 fromCppEnum Inactive = 2 fromCppEnum Normal = 0 fromCppEnum (UnknownQPaletteColorGroup n) = n toCppEnum (0) = Normal toCppEnum (1) = Disabled toCppEnum (2) = Inactive toCppEnum n = UnknownQPaletteColorGroup n instance HoppyP.Eq QPaletteColorGroup where x == y = HoppyFHR.fromCppEnum x == HoppyFHR.fromCppEnum y instance HoppyP.Ord QPaletteColorGroup where compare x y = HoppyP.compare (HoppyFHR.fromCppEnum x) (HoppyFHR.fromCppEnum y) data QPaletteColorRole = Window | WindowText | Base | AlternateBase | ToolTipBase | ToolTipText | Text | Button | ButtonText | BrightText | UnknownQPaletteColorRole (HoppyFC.CInt) deriving (HoppyP.Show) instance HoppyFHR.CppEnum (HoppyFC.CInt) QPaletteColorRole where fromCppEnum Window = 10 fromCppEnum WindowText = 0 fromCppEnum Base = 9 fromCppEnum AlternateBase = 16 fromCppEnum ToolTipBase = 18 fromCppEnum ToolTipText = 19 fromCppEnum Text = 6 fromCppEnum Button = 1 fromCppEnum ButtonText = 8 fromCppEnum BrightText = 7 fromCppEnum (UnknownQPaletteColorRole n) = n toCppEnum (0) = WindowText toCppEnum (1) = Button toCppEnum (6) = Text toCppEnum (7) = BrightText toCppEnum (8) = ButtonText toCppEnum (9) = Base toCppEnum (10) = Window toCppEnum (16) = AlternateBase toCppEnum (18) = ToolTipBase toCppEnum (19) = ToolTipText toCppEnum n = UnknownQPaletteColorRole n instance HoppyP.Eq QPaletteColorRole where x == y = HoppyFHR.fromCppEnum x == HoppyFHR.fromCppEnum y instance HoppyP.Ord QPaletteColorRole where compare x y = HoppyP.compare (HoppyFHR.fromCppEnum x) (HoppyFHR.fromCppEnum y)