-- 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\\ClassScrollablePane.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. -- -- ClassScrollablePane.chs -- module HGamer3D.Bindings.CEGUI.ClassScrollablePane 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\\ClassScrollablePane.chs" #-} import HGamer3D.Bindings.CEGUI.ClassPtr {-# LINE 41 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} import HGamer3D.Bindings.CEGUI.StructHG3DClass {-# LINE 42 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Constructor for the ScrollablePane 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 49 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Destructor for the ScrollablePane delete :: HG3DClass -- ^ classpointer - pointer of Class instance which is going to be deleted. -> IO () -- ^ delete a1 = withHG3DClass a1 $ \a1' -> delete'_ a1' >>= \res -> return () {-# LINE 53 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Returns a pointer to the window holding the pane contents. - Details: The purpose of this is so that attached windows may be inspected, --client code may not modify the returned window in any way. -- getContentPane :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (HG3DClass) -- ^ getContentPane a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getContentPane'_ a1' a2' >>= \res -> peek a2'>>= \a2'' -> return (a2'') {-# LINE 58 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.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 63 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.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 - -- -- -> IO () -- ^ return value - Nothing. setShowVertScrollbar a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in setShowVertScrollbar'_ a1' a2' >>= \res -> return () {-# LINE 68 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.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 73 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.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 - -- -- -> IO () -- ^ return value - Nothing. setShowHorzScrollbar a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in setShowHorzScrollbar'_ a1' a2' >>= \res -> return () {-# LINE 78 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Return whether the content pane is auto sized. isContentPaneAutoSized :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Bool) -- ^ isContentPaneAutoSized a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> isContentPaneAutoSized'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 83 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Set whether the content pane should be auto-sized. setContentPaneAutoSized :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Bool -- ^ setting - -- -- -> IO () -- ^ return value - Nothing. setContentPaneAutoSized a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in setContentPaneAutoSized'_ a1' a2' >>= \res -> return () {-# LINE 88 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Returns the horizontal scrollbar step size as a fraction of one complete view page. getHorizontalStepSize :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Float) -- ^ return value - float value specifying the step size where 1.0f would be the width of the viewing area. getHorizontalStepSize a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getHorizontalStepSize'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 93 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Sets the horizontal scrollbar step size as a fraction of one complete view page. setHorizontalStepSize :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Float -- ^ step - float value specifying the step size, where 1.0f would be the width of the viewing area. -> IO () -- ^ return value - Nothing. setHorizontalStepSize a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in setHorizontalStepSize'_ a1' a2' >>= \res -> return () {-# LINE 98 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Returns the horizontal scrollbar overlap size as a fraction of one complete view page. getHorizontalOverlapSize :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Float) -- ^ return value - float value specifying the overlap size where 1.0f would be the width of the viewing area. getHorizontalOverlapSize a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getHorizontalOverlapSize'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 103 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Sets the horizontal scrollbar overlap size as a fraction of one complete view page. setHorizontalOverlapSize :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Float -- ^ overlap - float value specifying the overlap size, where 1.0f would be the width of the viewing area. -> IO () -- ^ return value - Nothing. setHorizontalOverlapSize a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in setHorizontalOverlapSize'_ a1' a2' >>= \res -> return () {-# LINE 108 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Returns the horizontal scroll position as a fraction of the complete scrollable width. getHorizontalScrollPosition :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Float) -- ^ return value - float value specifying the scroll position. getHorizontalScrollPosition a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getHorizontalScrollPosition'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 113 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Sets the horizontal scroll position as a fraction of the complete scrollable width. setHorizontalScrollPosition :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Float -- ^ position - float value specifying the new scroll position. -> IO () -- ^ return value - Nothing. setHorizontalScrollPosition a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in setHorizontalScrollPosition'_ a1' a2' >>= \res -> return () {-# LINE 118 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Returns the vertical scrollbar step size as a fraction of one complete view page. getVerticalStepSize :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Float) -- ^ return value - float value specifying the step size where 1.0f would be the height of the viewing area. getVerticalStepSize a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getVerticalStepSize'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 123 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Sets the vertical scrollbar step size as a fraction of one complete view page. setVerticalStepSize :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Float -- ^ step - float value specifying the step size, where 1.0f would be the height of the viewing area. -> IO () -- ^ return value - Nothing. setVerticalStepSize a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in setVerticalStepSize'_ a1' a2' >>= \res -> return () {-# LINE 128 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Returns the vertical scrollbar overlap size as a fraction of one complete view page. getVerticalOverlapSize :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Float) -- ^ return value - float value specifying the overlap size where 1.0f would be the height of the viewing area. getVerticalOverlapSize a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getVerticalOverlapSize'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 133 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Sets the vertical scrollbar overlap size as a fraction of one complete view page. setVerticalOverlapSize :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Float -- ^ overlap - float value specifying the overlap size, where 1.0f would be the height of the viewing area. -> IO () -- ^ return value - Nothing. setVerticalOverlapSize a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in setVerticalOverlapSize'_ a1' a2' >>= \res -> return () {-# LINE 138 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Returns the vertical scroll position as a fraction of the complete scrollable height. getVerticalScrollPosition :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Float) -- ^ return value - float value specifying the scroll position. getVerticalScrollPosition a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getVerticalScrollPosition'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 143 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Sets the vertical scroll position as a fraction of the complete scrollable height. setVerticalScrollPosition :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Float -- ^ position - float value specifying the new scroll position. -> IO () -- ^ return value - Nothing. setVerticalScrollPosition a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in setVerticalScrollPosition'_ a1' a2' >>= \res -> return () {-# LINE 148 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Return a pointer to the vertical scrollbar component widget for this ScrollablePane 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 153 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Return a pointer to the horizontal scrollbar component widget for this ScrollablePane 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 158 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Initialises the Window - Details: This must be called for every window created. Normally this is handled automatically by the WindowManager 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 162 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} -- | Internal destroy method which actually just adds the window and any parent destructed child windows to the dead pool. - Details: This is virtual to allow for specialised cleanup which may be required --in some advanced cases. If you override this for the above reason, you --MUST call this base class version. -- destroy :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO () -- ^ destroy a1 = withHG3DClass a1 $ \a1' -> destroy'_ a1' >>= \res -> return () {-# LINE 166 ".\\HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs" #-} foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_construct" new'_ :: ((Ptr CChar) -> ((Ptr CChar) -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_destruct" delete'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_getContentPane" getContentPane'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_isVertScrollbarAlwaysShown" isVertScrollbarAlwaysShown'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_setShowVertScrollbar" setShowVertScrollbar'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_isHorzScrollbarAlwaysShown" isHorzScrollbarAlwaysShown'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_setShowHorzScrollbar" setShowHorzScrollbar'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_isContentPaneAutoSized" isContentPaneAutoSized'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_setContentPaneAutoSized" setContentPaneAutoSized'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_getHorizontalStepSize" getHorizontalStepSize'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_setHorizontalStepSize" setHorizontalStepSize'_ :: ((HG3DClassPtr) -> (CFloat -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_getHorizontalOverlapSize" getHorizontalOverlapSize'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_setHorizontalOverlapSize" setHorizontalOverlapSize'_ :: ((HG3DClassPtr) -> (CFloat -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_getHorizontalScrollPosition" getHorizontalScrollPosition'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_setHorizontalScrollPosition" setHorizontalScrollPosition'_ :: ((HG3DClassPtr) -> (CFloat -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_getVerticalStepSize" getVerticalStepSize'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_setVerticalStepSize" setVerticalStepSize'_ :: ((HG3DClassPtr) -> (CFloat -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_getVerticalOverlapSize" getVerticalOverlapSize'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_setVerticalOverlapSize" setVerticalOverlapSize'_ :: ((HG3DClassPtr) -> (CFloat -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_getVerticalScrollPosition" getVerticalScrollPosition'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_setVerticalScrollPosition" setVerticalScrollPosition'_ :: ((HG3DClassPtr) -> (CFloat -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_getVertScrollbar" getVertScrollbar'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_getHorzScrollbar" getHorzScrollbar'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_initialiseComponents" initialiseComponents'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\CEGUI\\ClassScrollablePane.chs.h cegui_scrlpn_destroy" destroy'_ :: ((HG3DClassPtr) -> (IO ()))