-- GENERATED by C->Haskell Compiler, version 0.16.3 Crystal Seed, 24 Jan 2009 (Haskell) -- Edit the ORIGNAL .chs file instead! {-# LINE 1 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-}{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE TypeSynonymInstances #-} -- This source file is part of HGamer3D -- (A project to enable 3D game development in Haskell) -- For the latest info, see http://www.althainz.de/HGamer3D.html -- -- (c) 2011, 2012 Peter Althainz -- -- Licensed under the Apache License, Version 2.0 (the "License"); -- you may not use this file except in compliance with the License. -- You may obtain a copy of the License at -- -- http://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -- See the License for the specific language governing permissions and -- limitations under the License. -- -- ClassListboxItem.chs -- module HGamer3D.Bindings.CEGUI.ClassListboxItem where import Foreign import Foreign.Ptr import Foreign.C import HGamer3D.Data.HG3DClass import HGamer3D.Data.Vector import HGamer3D.Data.Colour import HGamer3D.Data.Angle import HGamer3D.Bindings.CEGUI.Utils {-# LINE 40 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} import HGamer3D.Bindings.CEGUI.ClassPtr {-# LINE 41 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} import HGamer3D.Bindings.CEGUI.StructHG3DClass {-# LINE 42 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} -- | base class destructor delete :: HG3DClass -- ^ classpointer - pointer of Class instance which is going to be deleted. -> IO () -- ^ delete a1 = withHG3DClass a1 $ \a1' -> delete'_ a1' >>= \res -> return () {-# LINE 47 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} -- | return the text string set for this list box item. - Details: Note that even if the item does not render text, the text string can still be useful, since it --is used for sorting list box items. -- getTooltipText :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (String) -- ^ getTooltipText a1 = withHG3DClass a1 $ \a1' -> alloc64k $ \a2' -> getTooltipText'_ a1' a2' >>= \res -> peekCString a2'>>= \a2'' -> return (a2'') {-# LINE 52 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} -- | getText :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (String) -- ^ getText a1 = withHG3DClass a1 $ \a1' -> alloc64k $ \a2' -> getText'_ a1' a2' >>= \res -> peekCString a2'>>= \a2'' -> return (a2'') {-# LINE 57 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} -- | return text string with visual getTextVisual :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (String) -- ^ getTextVisual a1 = withHG3DClass a1 $ \a1' -> alloc64k $ \a2' -> getTextVisual'_ a1' a2' >>= \res -> peekCString a2'>>= \a2'' -> return (a2'') {-# LINE 62 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} -- | Return the current ID assigned to this list box item. - Details: Note that the system does not make use of this value, client code can assign any meaning it --wishes to the ID. -- getID :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Int) -- ^ getID a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getID'_ a1' a2' >>= \res -> peekIntConv a2'>>= \a2'' -> return (a2'') {-# LINE 67 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} -- | return whether this item is selected. isSelected :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Bool) -- ^ return value - true if the item is selected, false if the item is not selected. isSelected a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> isSelected'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 72 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} -- | return whether this item is disabled. isDisabled :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Bool) -- ^ return value - true if the item is disabled, false if the item is enabled. isDisabled a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> isDisabled'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 77 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} -- | return whether this item will be automatically deleted when the list box it is attached to is destroyed, or when the item is removed from the list box. isAutoDeleted :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Bool) -- ^ return value - true if the item object will be deleted by the system when the list box it is attached to is destroyed, or when the item is removed from the list. false if client code must destroy the item after it is removed from the list. isAutoDeleted a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> isAutoDeleted'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 82 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} -- | Get the owner window for this ListboxItem - Details: The owner of a ListboxItem is typically set by the list box widgets when an item is added or inserted. -- getOwnerWindow :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (HG3DClass) -- ^ getOwnerWindow a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getOwnerWindow'_ a1' a2' >>= \res -> peek a2'>>= \a2'' -> return (a2'') {-# LINE 87 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} -- | set the text string for this list box item. - Details: Note that even if the item does not render text, the text string can still be useful, since it --is used for sorting list box items. -- setText :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ text -> IO () -- ^ setText a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> setText'_ a1' a2' >>= \res -> return () {-# LINE 92 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} -- | setTooltipText :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ text -> IO () -- ^ setTooltipText a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> setTooltipText'_ a1' a2' >>= \res -> return () {-# LINE 97 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} -- | Set the ID assigned to this list box item. - Details: Note that the system does not make use of this value, client code can assign any meaning it --wishes to the ID. -- setID :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Int -- ^ item_id -> IO () -- ^ setID a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in setID'_ a1' a2' >>= \res -> return () {-# LINE 102 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} -- | set whether this item is selected. setSelected :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Bool -- ^ setting - true if the item is selected, false if the item is not selected. -> IO () -- ^ return value - Nothing. setSelected a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in setSelected'_ a1' a2' >>= \res -> return () {-# LINE 107 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} -- | set whether this item is disabled. setDisabled :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Bool -- ^ setting - true if the item is disabled, false if the item is enabled. -> IO () -- ^ return value - Nothing. setDisabled a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in setDisabled'_ a1' a2' >>= \res -> return () {-# LINE 112 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} -- | Set whether this item will be automatically deleted when the list box it is attached to is destroyed, or when the item is removed from the list box. setAutoDeleted :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Bool -- ^ setting - true if the item object should be deleted by the system when the list box it is attached to is destroyed, or when the item is removed from the list. false if client code will destroy the item after it is removed from the list. -> IO () -- ^ return value - Nothing. setAutoDeleted a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in setAutoDeleted'_ a1' a2' >>= \res -> return () {-# LINE 117 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} -- | Set the owner window for this ListboxItem setOwnerWindow :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> HG3DClass -- ^ owner - Ponter to the window that should be considered the owner of this ListboxItem. -> IO () -- ^ return value - Nothing setOwnerWindow a1 a2 = withHG3DClass a1 $ \a1' -> withHG3DClass a2 $ \a2' -> setOwnerWindow'_ a1' a2' >>= \res -> return () {-# LINE 122 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} -- | Set the selection highlighting brush image. setSelectionBrushImage2 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ imageset - Name of the imagest containing the image to be used. -> String -- ^ image - Name of the image to be used -> IO () -- ^ return value - Nothing. setSelectionBrushImage2 a1 a2 a3 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> withCString a3 $ \a3' -> setSelectionBrushImage2'_ a1' a2' a3' >>= \res -> return () {-# LINE 128 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs" #-} foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs.h cegui_lstbxitm_destruct" delete'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs.h cegui_lstbxitm_getTooltipText" getTooltipText'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs.h cegui_lstbxitm_getText" getText'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs.h cegui_lstbxitm_getTextVisual" getTextVisual'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs.h cegui_lstbxitm_getID" getID'_ :: ((HG3DClassPtr) -> ((Ptr CUInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs.h cegui_lstbxitm_isSelected" isSelected'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs.h cegui_lstbxitm_isDisabled" isDisabled'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs.h cegui_lstbxitm_isAutoDeleted" isAutoDeleted'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs.h cegui_lstbxitm_getOwnerWindow" getOwnerWindow'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs.h cegui_lstbxitm_setText" setText'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs.h cegui_lstbxitm_setTooltipText" setTooltipText'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs.h cegui_lstbxitm_setID" setID'_ :: ((HG3DClassPtr) -> (CUInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs.h cegui_lstbxitm_setSelected" setSelected'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs.h cegui_lstbxitm_setDisabled" setDisabled'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs.h cegui_lstbxitm_setAutoDeleted" setAutoDeleted'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs.h cegui_lstbxitm_setOwnerWindow" setOwnerWindow'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListboxItem.chs.h cegui_lstbxitm_setSelectionBrushImage2" setSelectionBrushImage2'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((Ptr CChar) -> (IO ()))))