-- 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\\ClassListbox.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.
-- 


-- ClassListbox.chs

-- 

module HGamer3D.Bindings.CEGUI.ClassListbox 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\\ClassListbox.chs" #-}
import HGamer3D.Bindings.CEGUI.ClassPtr
{-# LINE 41 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}
import HGamer3D.Bindings.CEGUI.StructHG3DClass
{-# LINE 42 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Return number of items attached to the list box. 
getItemCount :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Int)
 -- ^ return value - the number of items currently attached to this list box.     
getItemCount a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getItemCount'_ a1' a2' >>= \res ->
  peekIntConv  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 48 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Return the number of selected items in the list box. 
getSelectedCount :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Int)
 -- ^ return value - Total number of attached items that are in the selected state.     
getSelectedCount a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getSelectedCount'_ a1' a2' >>= \res ->
  peekIntConv  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 53 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Return a pointer to the first selected item. 
getFirstSelectedItem :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (HG3DClass)
 -- ^ return value - Pointer to a     
getFirstSelectedItem a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getFirstSelectedItem'_ a1' a2' >>= \res ->
  peek  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 58 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Return a pointer to the next selected item after item start_item
getNextSelected :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  HG3DClass  -- ^ start_item - Pointer to the ListboxItem where the search for the next selected item is to begin. If this parameter is NULL, the search will begin with the first item in the list box.
  ->  IO (HG3DClass)
 -- ^ return value - Pointer to a     
getNextSelected a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  alloca $ \a3' -> 
  getNextSelected'_ a1' a2' a3' >>= \res ->
  peek  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 64 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Return the item at index position index
getListboxItemFromIndex :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ index - Zero based index of the item to be returned.
  ->  IO (HG3DClass)
 -- ^ return value - Pointer to the     
getListboxItemFromIndex a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  getListboxItemFromIndex'_ a1' a2' a3' >>= \res ->
  peek  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 70 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Return the index of ListboxItemitem
getItemIndex :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  HG3DClass  -- ^ item - Pointer to a ListboxItem whos zero based index is to be returned.
  ->  IO (Int)
 -- ^ return value - Zero based index indicating the position of     
getItemIndex a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  alloca $ \a3' -> 
  getItemIndex'_ a1' a2' a3' >>= \res ->
  peekIntConv  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 76 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | return whether list sorting is enabled 
isSortEnabled :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Bool)
 -- ^ return value - true if the list is sorted, false if the list is not sorted     
isSortEnabled a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  isSortEnabled'_ a1' a2' >>= \res ->
  peekBoolUtil  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 81 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | return whether multi-select is enabled 
isMultiselectEnabled :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Bool)
 -- ^ return value - true if multi-select is enabled, false if multi-select is not enabled.     
isMultiselectEnabled a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  isMultiselectEnabled'_ a1' a2' >>= \res ->
  peekBoolUtil  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 86 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | 
isItemTooltipsEnabled :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Bool)
 -- ^ 
isItemTooltipsEnabled a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  isItemTooltipsEnabled'_ a1' a2' >>= \res ->
  peekBoolUtil  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 91 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | return whether the string at index position index
isItemSelected :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ index - Zero based index of the item to be examined.
  ->  IO (Bool)
 -- ^ return value - true if the item at     
isItemSelected a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  isItemSelected'_ a1' a2' a3' >>= \res ->
  peekBoolUtil  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 97 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Search the list for an item with the specified text. 
findItemWithText :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  String  -- ^ text - String object containing the text to be searched for.
  ->  HG3DClass  -- ^ start_item - ListboxItem where the search is to begin, the search will not include item. If item is NULL, the search will begin from the first item in the list.
  ->  IO (HG3DClass)
 -- ^ return value - Pointer to the first     
findItemWithText a1 a2 a3 =
  withHG3DClass a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  withHG3DClass a3 $ \a3' -> 
  alloca $ \a4' -> 
  findItemWithText'_ a1' a2' a3' a4' >>= \res ->
  peek  a4'>>= \a4'' -> 
  return (a4'')
{-# LINE 104 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Return whether the specified ListboxItem
isListboxItemInList :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  HG3DClass  -- ^ item
  ->  IO (Bool)
 -- ^ return value - true if     
isListboxItemInList a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  alloca $ \a3' -> 
  isListboxItemInList'_ a1' a2' a3' >>= \res ->
  peekBoolUtil  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 110 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Return whether the vertical scroll bar is always shown. 
isVertScrollbarAlwaysShown :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Bool)
 -- ^ 
isVertScrollbarAlwaysShown a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  isVertScrollbarAlwaysShown'_ a1' a2' >>= \res ->
  peekBoolUtil  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 115 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Return whether the horizontal scroll bar is always shown. 
isHorzScrollbarAlwaysShown :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Bool)
 -- ^ 
isHorzScrollbarAlwaysShown a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  isHorzScrollbarAlwaysShown'_ a1' a2' >>= \res ->
  peekBoolUtil  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 120 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Initialise the Window - Details: This must be called for every window created. Normally this is handled automatically by the WindowFactory for each Window
initialiseComponents :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO ()
 -- ^ return value - Nothing     
initialiseComponents a1 =
  withHG3DClass a1 $ \a1' -> 
  initialiseComponents'_ a1' >>= \res ->
  return ()
{-# LINE 124 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Remove all items from the list.  - Details: Note that this will cause 'AutoDelete' items to be deleted. 
resetList :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO ()
 -- ^ 
resetList a1 =
  withHG3DClass a1 $ \a1' -> 
  resetList'_ a1' >>= \res ->
  return ()
{-# LINE 128 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Add the given ListboxItem
addItem :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  HG3DClass  -- ^ item - Pointer to the ListboxItem to be added to the list. Note that it is the passed object that is added to the list, a copy is not made. If this parameter is NULL, nothing happens.
  ->  IO ()
 -- ^ return value - Nothing.     
addItem a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  addItem'_ a1' a2' >>= \res ->
  return ()
{-# LINE 133 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Insert an item into the list box before a specified item already in the list.  - Details: Note that if the list is sorted, the item may not end up in the
--requested position.
--
insertItem :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  HG3DClass  -- ^ item
  ->  HG3DClass  -- ^ position
  ->  IO ()
 -- ^ 
insertItem a1 a2 a3 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  withHG3DClass a3 $ \a3' -> 
  insertItem'_ a1' a2' a3' >>= \res ->
  return ()
{-# LINE 139 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Removes the given item from the list box. If the item is has the auto delete state set, the item will be deleted. 
removeItem :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  HG3DClass  -- ^ item - Pointer to the ListboxItem that is to be removed. If item is not attached to this list box then nothing will happen.
  ->  IO ()
 -- ^ return value - Nothing.     
removeItem a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  removeItem'_ a1' a2' >>= \res ->
  return ()
{-# LINE 144 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Clear the selected state for all items. 
clearAllSelections :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO ()
 -- ^ return value - Nothing.     
clearAllSelections a1 =
  withHG3DClass a1 $ \a1' -> 
  clearAllSelections'_ a1' >>= \res ->
  return ()
{-# LINE 148 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Set whether the list should be sorted. 
setSortingEnabled :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Bool  -- ^ setting - true if the list should be sorted, false if the list should not be sorted.
  ->  IO ()
 -- ^ return value - Nothing.     
setSortingEnabled a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromBool a2} in 
  setSortingEnabled'_ a1' a2' >>= \res ->
  return ()
{-# LINE 153 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Set whether the list should allow multiple selections or just a single selection. 
setMultiselectEnabled :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Bool  -- ^ setting - true if the widget should allow multiple items to be selected, false if the widget should only allow a single selection.
  ->  IO ()
 -- ^ return value - Nothing.     
setMultiselectEnabled a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromBool a2} in 
  setMultiselectEnabled'_ a1' a2' >>= \res ->
  return ()
{-# LINE 158 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Set whether the vertical scroll bar should always be shown. 
setShowVertScrollbar :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Bool  -- ^ setting - true if the vertical scroll bar should be shown even when it is not required. false if the vertical scroll bar should only be shown when it is required.
  ->  IO ()
 -- ^ return value - Nothing.     
setShowVertScrollbar a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromBool a2} in 
  setShowVertScrollbar'_ a1' a2' >>= \res ->
  return ()
{-# LINE 163 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Set whether the horizontal scroll bar should always be shown. 
setShowHorzScrollbar :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Bool  -- ^ setting - true if the horizontal scroll bar should be shown even when it is not required. false if the horizontal scroll bar should only be shown when it is required.
  ->  IO ()
 -- ^ return value - Nothing.     
setShowHorzScrollbar a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromBool a2} in 
  setShowHorzScrollbar'_ a1' a2' >>= \res ->
  return ()
{-# LINE 168 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | 
setItemTooltipsEnabled :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Bool  -- ^ setting
  ->  IO ()
 -- ^ 
setItemTooltipsEnabled a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromBool a2} in 
  setItemTooltipsEnabled'_ a1' a2' >>= \res ->
  return ()
{-# LINE 173 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Set the select state of an attached ListboxItem - Details: This is the recommended way of selecting and deselecting items attached to a list box as it respects the
--multi-select mode setting.  It is possible to modify the setting on ListboxItems directly, but that approach
--does not respect the settings of the list box.
--
setItemSelectState :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  HG3DClass  -- ^ item
  ->  Bool  -- ^ state
  ->  IO ()
 -- ^ 
setItemSelectState a1 a2 a3 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  let {a3' = fromBool a3} in 
  setItemSelectState'_ a1' a2' a3' >>= \res ->
  return ()
{-# LINE 179 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Set the select state of an attached ListboxItem - Details: This is the recommended way of selecting and deselecting items attached to a list box as it respects the
--multi-select mode setting.  It is possible to modify the setting on ListboxItems directly, but that approach
--does not respect the settings of the list box.
--
setItemSelectState2 :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ item_index
  ->  Bool  -- ^ state
  ->  IO ()
 -- ^ 
setItemSelectState2 a1 a2 a3 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromBool a3} in 
  setItemSelectState2'_ a1' a2' a3' >>= \res ->
  return ()
{-# LINE 185 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Causes the list box to update it's internal state after changes have been made to one or more attached ListboxItem - Details: Client code must call this whenever it has made any changes to ListboxItem objects already attached to the
--list box.  If you are just adding items, or removed items to update them prior to re-adding them, there is
--no need to call this method.
--
handleUpdatedItemData :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO ()
 -- ^ 
handleUpdatedItemData a1 =
  withHG3DClass a1 $ \a1' -> 
  handleUpdatedItemData'_ a1' >>= \res ->
  return ()
{-# LINE 189 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Ensure the item at the specified index is visible within the list box. 
ensureItemIsVisible :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ item_index - Zero based index of the item to be made visible in the list box. If this value is out of range, the list is always scrolled to the bottom.
  ->  IO ()
 -- ^ return value - Nothing.     
ensureItemIsVisible a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  ensureItemIsVisible'_ a1' a2' >>= \res ->
  return ()
{-# LINE 194 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Ensure the item at the specified index is visible within the list box. 
ensureItemIsVisible2 :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  HG3DClass  -- ^ item - Pointer to the ListboxItem to be made visible in the list box.
  ->  IO ()
 -- ^ return value - Nothing.    
ensureItemIsVisible2 a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  ensureItemIsVisible2'_ a1' a2' >>= \res ->
  return ()
{-# LINE 199 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Return a pointer to the vertical scrollbar component widget for this Listbox
getVertScrollbar :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (HG3DClass)
 -- ^ return value - Pointer to a     
getVertScrollbar a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getVertScrollbar'_ a1' a2' >>= \res ->
  peek  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 204 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Return a pointer to the horizontal scrollbar component widget for this Listbox
getHorzScrollbar :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (HG3DClass)
 -- ^ return value - Pointer to a     
getHorzScrollbar a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getHorzScrollbar'_ a1' a2' >>= \res ->
  peek  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 209 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Return the sum of all item heights. 
getTotalItemsHeight :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Float)
 -- ^ 
getTotalItemsHeight a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getTotalItemsHeight'_ a1' a2' >>= \res ->
  peekFloatConv  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 214 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Return the width of the widest item. 
getWidestItemWidth :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Float)
 -- ^ 
getWidestItemWidth a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getWidestItemWidth'_ a1' a2' >>= \res ->
  peekFloatConv  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 219 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Constructor for Listbox
new :: String  -- ^ type
  ->  String  -- ^ name
  ->  IO (HG3DClass)
 -- ^ 
new a1 a2 =
  withCString a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  new'_ a1' a2' a3' >>= \res ->
  peek  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 225 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}

-- | Destructor for Listbox
delete :: HG3DClass  -- ^ classpointer - pointer of Class instance which is going to be deleted.
  ->  IO ()
 -- ^ 
delete a1 =
  withHG3DClass a1 $ \a1' -> 
  delete'_ a1' >>= \res ->
  return ()
{-# LINE 229 ".\\HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs" #-}


foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_getItemCount"
  getItemCount'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_getSelectedCount"
  getSelectedCount'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_getFirstSelectedItem"
  getFirstSelectedItem'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_getNextSelected"
  getNextSelected'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_getListboxItemFromIndex"
  getListboxItemFromIndex'_ :: ((HG3DClassPtr) -> (CInt -> ((HG3DClassPtr) -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_getItemIndex"
  getItemIndex'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_isSortEnabled"
  isSortEnabled'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_isMultiselectEnabled"
  isMultiselectEnabled'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_isItemTooltipsEnabled"
  isItemTooltipsEnabled'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_isItemSelected"
  isItemSelected'_ :: ((HG3DClassPtr) -> (CInt -> ((Ptr CInt) -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_findItemWithText"
  findItemWithText'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ())))))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_isListboxItemInList"
  isListboxItemInList'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_isVertScrollbarAlwaysShown"
  isVertScrollbarAlwaysShown'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_isHorzScrollbarAlwaysShown"
  isHorzScrollbarAlwaysShown'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_initialiseComponents"
  initialiseComponents'_ :: ((HG3DClassPtr) -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_resetList"
  resetList'_ :: ((HG3DClassPtr) -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_addItem"
  addItem'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_insertItem"
  insertItem'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_removeItem"
  removeItem'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_clearAllSelections"
  clearAllSelections'_ :: ((HG3DClassPtr) -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_setSortingEnabled"
  setSortingEnabled'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_setMultiselectEnabled"
  setMultiselectEnabled'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_setShowVertScrollbar"
  setShowVertScrollbar'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_setShowHorzScrollbar"
  setShowHorzScrollbar'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_setItemTooltipsEnabled"
  setItemTooltipsEnabled'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_setItemSelectState"
  setItemSelectState'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (CInt -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_setItemSelectState2"
  setItemSelectState2'_ :: ((HG3DClassPtr) -> (CInt -> (CInt -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_handleUpdatedItemData"
  handleUpdatedItemData'_ :: ((HG3DClassPtr) -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_ensureItemIsVisible"
  ensureItemIsVisible'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_ensureItemIsVisible2"
  ensureItemIsVisible2'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_getVertScrollbar"
  getVertScrollbar'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_getHorzScrollbar"
  getHorzScrollbar'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_getTotalItemsHeight"
  getTotalItemsHeight'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_getWidestItemWidth"
  getWidestItemWidth'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_construct"
  new'_ :: ((Ptr CChar) -> ((Ptr CChar) -> ((HG3DClassPtr) -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassListbox.chs.h cegui_lstbx_destruct"
  delete'_ :: ((HG3DClassPtr) -> (IO ()))