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


-- ClassMultiLineEditbox.chs

-- 

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

-- | return true if the edit box has input focus. 
hasInputFocus :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Bool)
 -- ^ 
hasInputFocus a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  hasInputFocus'_ a1' a2' >>= \res ->
  peekBoolUtil  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 48 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs" #-}

-- | return true if the edit box is read-only. 
isReadOnly :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Bool)
 -- ^ 
isReadOnly a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  isReadOnly'_ a1' a2' >>= \res ->
  peekBoolUtil  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 53 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs" #-}

-- | return the current position of the carat. 
getCaratIndex :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Int)
 -- ^ return value - Index of the insert carat relative to the start of the text.     
getCaratIndex a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getCaratIndex'_ a1' a2' >>= \res ->
  peekIntConv  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 58 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs" #-}

-- | return the current selection start point. 
getSelectionStartIndex :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Int)
 -- ^ return value - Index of the selection start point relative to the start of the text. If no selection is defined this function returns the position of the carat.     
getSelectionStartIndex a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getSelectionStartIndex'_ a1' a2' >>= \res ->
  peekIntConv  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 63 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs" #-}

-- | return the current selection end point. 
getSelectionEndIndex :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Int)
 -- ^ return value - Index of the selection end point relative to the start of the text. If no selection is defined this function returns the position of the carat.     
getSelectionEndIndex a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getSelectionEndIndex'_ a1' a2' >>= \res ->
  peekIntConv  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 68 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs" #-}

-- | return the length of the current selection (in code points / characters). 
getSelectionLength :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Int)
 -- ^ return value - Number of code points (or characters) contained within the currently defined selection.     
getSelectionLength a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getSelectionLength'_ a1' a2' >>= \res ->
  peekIntConv  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 73 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs" #-}

-- | return the maximum text length set for this edit box. 
getMaxTextLength :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Int)
 -- ^ return value - The maximum number of code points (characters) that can be entered into this edit box.     
getMaxTextLength a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getMaxTextLength'_ a1' a2' >>= \res ->
  peekIntConv  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 78 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs" #-}

-- | Return whether the text in the edit box will be word-wrapped. 
isWordWrapped :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Bool)
 -- ^ 
isWordWrapped a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  isWordWrapped'_ a1' a2' >>= \res ->
  peekBoolUtil  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 83 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs" #-}

-- | Return a pointer to the vertical scrollbar component widget for this MultiLineEditbox
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 88 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.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 93 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs" #-}

-- | Return a pointer to the horizontal scrollbar component widget for this MultiLineEditbox
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 98 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs" #-}

-- | Return the line number a given index falls on with the current formatting. Will return last line if index is out of range. 
getLineNumberFromIndex :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ index
  ->  IO (Int)
 -- ^ 
getLineNumberFromIndex a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  getLineNumberFromIndex'_ a1' a2' a3' >>= \res ->
  peekIntConv  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 104 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.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 108 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs" #-}

-- | Specify whether the edit box is read-only. 
setReadOnly :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Bool  -- ^ setting - 
--
--
  ->  IO ()
 -- ^ return value - Nothing.     
setReadOnly a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromBool a2} in 
  setReadOnly'_ a1' a2' >>= \res ->
  return ()
{-# LINE 113 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs" #-}

-- | Set the current position of the carat. 
setCaratIndex :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ carat_pos - New index for the insert carat relative to the start of the text. If the value specified is greater than the number of characters in the edit box, the carat is positioned at the end of the text.
  ->  IO ()
 -- ^ return value - Nothing.     
setCaratIndex a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  setCaratIndex'_ a1' a2' >>= \res ->
  return ()
{-# LINE 118 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs" #-}

-- | Define the current selection for the edit box. 
setSelection :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ start_pos - Index of the starting point for the selection. If this value is greater than the number of characters in the edit box, the selection start will be set to the end of the text.
  ->  Int  -- ^ end_pos - Index of the ending point for the selection. If this value is greater than the number of characters in the edit box, the selection start will be set to the end of the text.
  ->  IO ()
 -- ^ return value - Nothing.     
setSelection a1 a2 a3 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  setSelection'_ a1' a2' a3' >>= \res ->
  return ()
{-# LINE 124 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs" #-}

-- | set the maximum text length for this edit box. 
setMaxTextLength :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ max_len - The maximum number of code points (characters) that can be entered into this Editbox.
  ->  IO ()
 -- ^ return value - Nothing.     
setMaxTextLength a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  setMaxTextLength'_ a1' a2' >>= \res ->
  return ()
{-# LINE 129 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs" #-}

-- | Scroll the view so that the current carat position is visible. 
ensureCaratIsVisible :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO ()
 -- ^ 
ensureCaratIsVisible a1 =
  withHG3DClass a1 $ \a1' -> 
  ensureCaratIsVisible'_ a1' >>= \res ->
  return ()
{-# LINE 133 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs" #-}

-- | Set whether the text will be word wrapped or not. 
setWordWrapping :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Bool  -- ^ setting - 
--
--
  ->  IO ()
 -- ^ return value - Nothing.     
setWordWrapping a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromBool a2} in 
  setWordWrapping'_ a1' a2' >>= \res ->
  return ()
{-# LINE 138 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.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 143 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs" #-}

-- | Constructor for the MultiLineEditbox
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 149 ".\\HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs" #-}

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


foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs.h cegui_mltlnedtbx_hasInputFocus"
  hasInputFocus'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs.h cegui_mltlnedtbx_isReadOnly"
  isReadOnly'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs.h cegui_mltlnedtbx_getCaratIndex"
  getCaratIndex'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs.h cegui_mltlnedtbx_getSelectionStartIndex"
  getSelectionStartIndex'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs.h cegui_mltlnedtbx_getSelectionEndIndex"
  getSelectionEndIndex'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs.h cegui_mltlnedtbx_getSelectionLength"
  getSelectionLength'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs.h cegui_mltlnedtbx_getMaxTextLength"
  getMaxTextLength'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs.h cegui_mltlnedtbx_isWordWrapped"
  isWordWrapped'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

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

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

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

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs.h cegui_mltlnedtbx_getLineNumberFromIndex"
  getLineNumberFromIndex'_ :: ((HG3DClassPtr) -> (CInt -> ((Ptr CInt) -> (IO ()))))

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

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs.h cegui_mltlnedtbx_setReadOnly"
  setReadOnly'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs.h cegui_mltlnedtbx_setCaratIndex"
  setCaratIndex'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs.h cegui_mltlnedtbx_setSelection"
  setSelection'_ :: ((HG3DClassPtr) -> (CInt -> (CInt -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs.h cegui_mltlnedtbx_setMaxTextLength"
  setMaxTextLength'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs.h cegui_mltlnedtbx_ensureCaratIsVisible"
  ensureCaratIsVisible'_ :: ((HG3DClassPtr) -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassMultiLineEditbox.chs.h cegui_mltlnedtbx_setWordWrapping"
  setWordWrapping'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

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

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

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