-- 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\\Ogre\\ClassRoot.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. -- -- ClassRoot.chs -- module HGamer3D.Bindings.Ogre.ClassRoot where import C2HS import Foreign import Foreign.Ptr import Foreign.C import Monad (liftM, liftM2) import HGamer3D.Data.HG3DClass import HGamer3D.Data.Vector import HGamer3D.Data.Colour import HGamer3D.Data.Angle import HGamer3D.Bindings.Ogre.Utils {-# LINE 42 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} import HGamer3D.Bindings.Ogre.ClassPtr {-# LINE 43 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} import HGamer3D.Bindings.Ogre.StructHG3DClass {-# LINE 44 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} import HGamer3D.Bindings.Ogre.StructColour {-# LINE 45 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Constructor new :: String -- ^ pluginFileName - The file that contains plugins information. Defaults to "plugins.cfg", may be left blank to ignore. -> String -- ^ configFileName - The file that contains the configuration to be loaded. Defaults to "ogre.cfg", may be left blank to load nothing. -> String -- ^ logFileName - The logfile to create, defaults to Ogre.log, may be left blank if you've already set up LogManager & Log yourself -> IO (HG3DClass) -- ^ new a1 a2 a3 = withCString a1 $ \a1' -> withCString a2 $ \a2' -> withCString a3 $ \a3' -> alloca $ \a4' -> new'_ a1' a2' a3' a4' >>= \res -> peek a4'>>= \a4'' -> return (a4'') {-# LINE 53 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | delete :: HG3DClass -- ^ classpointer - pointer of Class instance which is going to be deleted. -> IO () -- ^ delete a1 = withHG3DClass a1 $ \a1' -> delete'_ a1' >>= \res -> return () {-# LINE 57 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Saves the details of the current configuration Stores details of the current configuration so it may be restored later on. saveConfig :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO () -- ^ saveConfig a1 = withHG3DClass a1 $ \a1' -> saveConfig'_ a1' >>= \res -> return () {-# LINE 61 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Checks for saved video/sound/etc settings This method checks to see if there is a valid saved configuration from a previous run. If there is, the state of the system will be restored to that configuration.If there is no saved configuration, or if the system failed with the last config settings, false restoreConfig :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Bool) -- ^ return value - If a valid configuration was found, restoreConfig a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> restoreConfig'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 66 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Displays a dialog asking the user to choose system settings. This method displays the default dialog allowing the user to choose the rendering system, video mode etc. If there is are any settings saved already, they will be restored automatically before displaying the dialogue. When the user accepts a group of settings, this will automatically call Root::setRenderSystemRenderSystem::setConfigOptionRoot::saveConfigIf they clicked 'Cancel' (in which case the app should strongly consider terminating), false showConfigDialog :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Bool) -- ^ return value - If the user clicked 'Ok', showConfigDialog a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> showConfigDialog'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 71 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Adds a new rendering subsystem to the list of available renderers. Intended for use by advanced users and plugin writers only! Calling this method with a pointer to a valid RenderSystem -- addRenderSystem :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> HG3DClass -- ^ newRend -> IO () -- ^ addRenderSystem a1 a2 = withHG3DClass a1 $ \a1' -> withHG3DClass a2 $ \a2' -> addRenderSystem'_ a1' a2' >>= \res -> return () {-# LINE 76 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Retrieve a pointer to the render system by the given name getRenderSystemByName :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ name - Name of the render system intend to retrieve. -> IO (HG3DClass) -- ^ return value - A pointer to the render system, getRenderSystemByName a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> alloca $ \a3' -> getRenderSystemByName'_ a1' a2' a3' >>= \res -> peek a3'>>= \a3'' -> return (a3'') {-# LINE 82 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Sets the rendering subsystem to be used. This method indicates to OGRE which rendering system is to be used (e.g. Direct3D, OpenGL etc). This is called automatically by the default config dialog, and when settings are restored from a previous configuraion. If used manually it could be used to set the renderer from a custom settings dialog. Once this has been done, the renderer can be initialised using Root::initialiseThis method is also called by render systems if they are initialised directly. RenderSystem setRenderSystem :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> HG3DClass -- ^ system - Pointer to the render system to use. -> IO () -- ^ setRenderSystem a1 a2 = withHG3DClass a1 $ \a1' -> withHG3DClass a2 $ \a2' -> setRenderSystem'_ a1' a2' >>= \res -> return () {-# LINE 87 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Retrieve a pointer to the currently selected render system. getRenderSystem :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (HG3DClass) -- ^ getRenderSystem a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getRenderSystem'_ a1' a2' >>= \res -> peek a2'>>= \a2'' -> return (a2'') {-# LINE 92 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Initialises the renderer. This method can only be called after a renderer has been selected with Root::setRenderSystem initialise :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Bool -- ^ autoCreateWindow - If true, a rendering window will automatically be created (saving a call to Root::createRenderWindow). The window will be created based on the options currently set on the render system. -> String -- ^ windowTitle -> String -- ^ customCapabilitiesConfig -> IO (HG3DClass) -- ^ return value - A pointer to the automatically created window, if requested, otherwise initialise a1 a2 a3 a4 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in withCString a3 $ \a3' -> withCString a4 $ \a4' -> alloca $ \a5' -> initialise'_ a1' a2' a3' a4' a5' >>= \res -> peek a5'>>= \a5'' -> return (a5'') {-# LINE 100 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Returns whether the system is initialised or not. isInitialised :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Bool) -- ^ isInitialised a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> isInitialised'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 105 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Get whether the entire render queue structure should be emptied on clearing, or whether just the objects themselves should be cleared. getRemoveRenderQueueStructuresOnClear :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Bool) -- ^ getRemoveRenderQueueStructuresOnClear a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getRemoveRenderQueueStructuresOnClear'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 110 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Set whether the entire render queue structure should be emptied on clearing, or whether just the objects themselves should be cleared. setRemoveRenderQueueStructuresOnClear :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Bool -- ^ r -> IO () -- ^ setRemoveRenderQueueStructuresOnClear a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in setRemoveRenderQueueStructuresOnClear'_ a1' a2' >>= \res -> return () {-# LINE 115 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Register a new SceneManagerFactoryPlugins should call this to register as new SceneManager addSceneManagerFactory :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> HG3DClass -- ^ fact -> IO () -- ^ addSceneManagerFactory a1 a2 = withHG3DClass a1 $ \a1' -> withHG3DClass a2 $ \a2' -> addSceneManagerFactory'_ a1' a2' >>= \res -> return () {-# LINE 120 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Unregister a SceneManagerFactory removeSceneManagerFactory :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> HG3DClass -- ^ fact -> IO () -- ^ removeSceneManagerFactory a1 a2 = withHG3DClass a1 $ \a1' -> withHG3DClass a2 $ \a2' -> removeSceneManagerFactory'_ a1' a2' >>= \res -> return () {-# LINE 125 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Create a SceneManagerYou can use this method to create a SceneManagerThis method throws an exception if the named type is not found. createSceneManager :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ typeName - String identifying a unique SceneManager type -> String -- ^ instanceName - Optional name to given the new instance that is created. If you leave this blank, an auto name will be assigned. -> IO (HG3DClass) -- ^ createSceneManager a1 a2 a3 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> withCString a3 $ \a3' -> alloca $ \a4' -> createSceneManager'_ a1' a2' a3' a4' >>= \res -> peek a4'>>= \a4'' -> return (a4'') {-# LINE 132 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Destroy an instance of a SceneManager destroySceneManager :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> HG3DClass -- ^ sm -> IO () -- ^ destroySceneManager a1 a2 = withHG3DClass a1 $ \a1' -> withHG3DClass a2 $ \a2' -> destroySceneManager'_ a1' a2' >>= \res -> return () {-# LINE 137 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Get an existing SceneManager getSceneManager :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ instanceName - The name of the instance to retrieve. -> IO (HG3DClass) -- ^ getSceneManager a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> alloca $ \a3' -> getSceneManager'_ a1' a2' a3' >>= \res -> peek a3'>>= \a3'' -> return (a3'') {-# LINE 143 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Determines if a given SceneManager hasSceneManager :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ instanceName - The name of the instance to retrieve. -> IO (Bool) -- ^ hasSceneManager a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> alloca $ \a3' -> hasSceneManager'_ a1' a2' a3' >>= \res -> peekBoolUtil a3'>>= \a3'' -> return (a3'') {-# LINE 149 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Retrieves a reference to the current TextureManagerThis performs the same function as TextureManager::getSingletonNote that a TextureManagerOgreRenderSystemRoot::initialise getTextureManager :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (HG3DClass) -- ^ getTextureManager a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getTextureManager'_ a1' a2' >>= \res -> peek a2'>>= \a2'' -> return (a2'') {-# LINE 154 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Retrieves a reference to the current MeshManagerThis performs the same function as MeshManager::getSingleton getMeshManager :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (HG3DClass) -- ^ getMeshManager a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getMeshManager'_ a1' a2' >>= \res -> peek a2'>>= \a2'' -> return (a2'') {-# LINE 159 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Utility function for getting a better description of an error code. getErrorDescription :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Int -- ^ errorNumber -> IO (String) -- ^ getErrorDescription a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in alloc64k $ \a3' -> getErrorDescription'_ a1' a2' a3' >>= \res -> peekCString a3'>>= \a3'' -> return (a3'') {-# LINE 165 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Queues the end of rendering. This method will do nothing unless startRendering()RootRoot::startRendering queueEndRendering :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO () -- ^ queueEndRendering a1 = withHG3DClass a1 $ \a1' -> queueEndRendering'_ a1' >>= \res -> return () {-# LINE 169 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Starts / restarts the automatic rendering cycle. This method begins the automatic rendering of the scene. It will NOTDuring rendering, any FrameListener classes registered using addFrameListener will be called back for each frame that is to be rendered, These classes can tell OGRE to halt the rendering if required, which will cause this method to return. --RenderTarget::updateRoot::renderOneFrame --This frees up the CPU to do other things in between refreshes, since in this case frame rate is less important. --This method can only be called after Root::initialise startRendering :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO () -- ^ startRendering a1 = withHG3DClass a1 $ \a1' -> startRendering'_ a1' >>= \res -> return () {-# LINE 173 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Render one frame. Updates all the render targets automatically and then returns, raising frame events before and after. renderOneFrame :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Bool) -- ^ renderOneFrame a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> renderOneFrame'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 178 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Render one frame, with custom frame time information. Updates all the render targets automatically and then returns, raising frame events before and after - all per-frame times are based on the time value you pass in. renderOneFrame2 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Float -- ^ timeSinceLastFrame -> IO (Bool) -- ^ renderOneFrame2 a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in alloca $ \a3' -> renderOneFrame2'_ a1' a2' a3' >>= \res -> peekBoolUtil a3'>>= \a3'' -> return (a3'') {-# LINE 184 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Shuts down the system manually. This is normally done by OgreOgre shutdown :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO () -- ^ shutdown a1 = withHG3DClass a1 $ \a1' -> shutdown'_ a1' >>= \res -> return () {-# LINE 188 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Adds a location to the list of searchable locations for a ResourceResourceLocations can be folders, compressed archives, even perhaps remote locations. Facilities for loading from different locations are provided by plugins which provide implementations of the ArchiveOgreYou can also supply the name of a resource group which should have this location applied to it. The ResourceGroupManager::DEFAULT_RESOURCE_GROUP_NAMEArchive addResourceLocation :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ name - The name of the location, e.g. './data' or '/compressed/gamedata.zip' -> String -- ^ locType - A string identifying the location type, e.g. 'FileSystem' (for folders), 'Zip' etc. Must map to a registered plugin which deals with this type (FileSystem and Zip should always be available) -> String -- ^ groupName - Type of name of the resource group which this location should apply to; defaults to the General group which applies to all non-specific resources. -> Bool -- ^ recursive - If the resource location has a concept of recursive directory traversal, enabling this option will mean you can load resources in subdirectories using only their unqualified name. The default is to disable this so that resources in subdirectories with the same name are still unique. -> IO () -- ^ addResourceLocation a1 a2 a3 a4 a5 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> withCString a3 $ \a3' -> withCString a4 $ \a4' -> let {a5' = fromBool a5} in addResourceLocation'_ a1' a2' a3' a4' a5' >>= \res -> return () {-# LINE 196 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Removes a resource location from the list. addResourceLocation removeResourceLocation :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ name - The name of the resource location as specified in addResourceLocation -> String -- ^ groupName - The name of the resource group to which this location was assigned. -> IO () -- ^ removeResourceLocation a1 a2 a3 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> withCString a3 $ \a3' -> removeResourceLocation'_ a1' a2' a3' >>= \res -> return () {-# LINE 202 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Generates a packed data version of the passed in ColourValue suitable for use with the current RenderSystemSince different render systems have different colour data formats (eg RGBA for GL, ARGB for D3D) this method allows you to use 1 method for all. convertColourValue :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Colour -- ^ colour - The colour to convert -> IO (Int) -- ^ pDest - Pointer to location to put the result. convertColourValue a1 a2 = withHG3DClass a1 $ \a1' -> withColour a2 $ \a2' -> alloca $ \a3' -> convertColourValue'_ a1' a2' a3' >>= \res -> peekIntConv a3'>>= \a3'' -> return (a3'') {-# LINE 208 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Retrieves a pointer to the window that was created automatically When Rootreturns a null pointer when Root getAutoCreatedWindow :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (HG3DClass) -- ^ getAutoCreatedWindow a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getAutoCreatedWindow'_ a1' a2' >>= \res -> peek a2'>>= \a2'' -> return (a2'') {-# LINE 213 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Detaches a RenderTarget detachRenderTarget :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> HG3DClass -- ^ pWin -> IO () -- ^ detachRenderTarget a1 a2 = withHG3DClass a1 $ \a1' -> withHG3DClass a2 $ \a2' -> detachRenderTarget'_ a1' a2' >>= \res -> return () {-# LINE 218 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Detaches a named RenderTarget detachRenderTarget2 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ name -> IO () -- ^ detachRenderTarget2 a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> detachRenderTarget2'_ a1' a2' >>= \res -> return () {-# LINE 223 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Destroys the given RenderTarget destroyRenderTarget :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> HG3DClass -- ^ target -> IO () -- ^ destroyRenderTarget a1 a2 = withHG3DClass a1 $ \a1' -> withHG3DClass a2 $ \a2' -> destroyRenderTarget'_ a1' a2' >>= \res -> return () {-# LINE 228 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Destroys the given named RenderTarget destroyRenderTarget2 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ name -> IO () -- ^ destroyRenderTarget2 a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> destroyRenderTarget2'_ a1' a2' >>= \res -> return () {-# LINE 233 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Retrieves a pointer to the a named render window. getRenderTarget :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ name -> IO (HG3DClass) -- ^ getRenderTarget a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> alloca $ \a3' -> getRenderTarget'_ a1' a2' a3' >>= \res -> peek a3'>>= \a3'' -> return (a3'') {-# LINE 239 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Manually load a Plugin contained in a DLL / DSO. Plugins embedded in DLLs can be loaded at startup using the plugin configuration file specified when you create RootRoot::installPluginRoot::unloadPlugin loadPlugin :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ pluginName - Name of the plugin library to load -> IO () -- ^ loadPlugin a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> loadPlugin'_ a1' a2' >>= \res -> return () {-# LINE 244 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Manually unloads a Plugin contained in a DLL / DSO. Plugin DLLs are unloaded at shutdown automatically. This method allows you to unload plugins in code, but make sure their dependencies are decoupled first. This method will call the dllStopPlugin method defined in the DLL, which in turn should call Root::uninstallPlugin unloadPlugin :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ pluginName - Name of the plugin library to unload -> IO () -- ^ unloadPlugin a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> unloadPlugin'_ a1' a2' >>= \res -> return () {-# LINE 249 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Destroy a RenderQueueInvocationSequence. You must ensure that no Viewports are using this sequence. destroyRenderQueueInvocationSequence :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ name - The name to identify the sequence -> IO () -- ^ destroyRenderQueueInvocationSequence a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> destroyRenderQueueInvocationSequence'_ a1' a2' >>= \res -> return () {-# LINE 254 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Destroy all RenderQueueInvocationSequences. You must ensure that no Viewports are using custom sequences. destroyAllRenderQueueInvocationSequences :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO () -- ^ destroyAllRenderQueueInvocationSequences a1 = withHG3DClass a1 $ \a1' -> destroyAllRenderQueueInvocationSequences'_ a1' >>= \res -> return () {-# LINE 258 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Clears the history of all event times. OGRE stores a history of the last few event times in order to smooth out any inaccuracies and temporary fluctuations. However, if you pause or don't render for a little while this can cause a lurch, so if you're resuming rendering after a break, call this method to reset the stored times clearEventTimes :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO () -- ^ clearEventTimes a1 = withHG3DClass a1 $ \a1' -> clearEventTimes'_ a1' >>= \res -> return () {-# LINE 262 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Sets the period over which OGRE smooths out fluctuations in frame times. OGRE by default gives you the raw frame time, but can optionally smooths it out over several frames, in order to reduce the noticeable effect of occasional hiccups in framerate. These smoothed values are passed back as parameters to FrameListener calls. This method allow you to tweak the smoothing period, and is expressed in seconds. Setting it to 0 will result in completely unsmoothed frame times (the default). setFrameSmoothingPeriod :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Float -- ^ period -> IO () -- ^ setFrameSmoothingPeriod a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in setFrameSmoothingPeriod'_ a1' a2' >>= \res -> return () {-# LINE 267 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Gets the period over which OGRE smooths out fluctuations in frame times. getFrameSmoothingPeriod :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Float) -- ^ getFrameSmoothingPeriod a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getFrameSmoothingPeriod'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 272 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Register a new MovableObjectFactoryMovableObjectPlugin creators can create subclasses of MovableObjectFactoryMovableObject addMovableObjectFactory :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> HG3DClass -- ^ fact - Pointer to the factory instance -> Bool -- ^ overrideExisting - Set this to true to override any existing factories which are registered for the same type. You should only change this if you are very sure you know what you're doing. -> IO () -- ^ addMovableObjectFactory a1 a2 a3 = withHG3DClass a1 $ \a1' -> withHG3DClass a2 $ \a2' -> let {a3' = fromBool a3} in addMovableObjectFactory'_ a1' a2' a3' >>= \res -> return () {-# LINE 278 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Removes a previously registered MovableObjectFactoryAll instances of objects created by this factory will be destroyed before removing the factory (by calling back the factories 'destroyInstance' method). The plugin writer is responsible for actually destroying the factory. removeMovableObjectFactory :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> HG3DClass -- ^ fact -> IO () -- ^ removeMovableObjectFactory a1 a2 = withHG3DClass a1 $ \a1' -> withHG3DClass a2 $ \a2' -> removeMovableObjectFactory'_ a1' a2' >>= \res -> return () {-# LINE 283 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Checks whether a factory is registered for a given MovableObject hasMovableObjectFactory :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ typeName -> IO (Bool) -- ^ hasMovableObjectFactory a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> alloca $ \a3' -> hasMovableObjectFactory'_ a1' a2' a3' >>= \res -> peekBoolUtil a3'>>= \a3'' -> return (a3'') {-# LINE 289 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Get a MovableObjectFactory getMovableObjectFactory :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ typeName -> IO (HG3DClass) -- ^ getMovableObjectFactory a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> alloca $ \a3' -> getMovableObjectFactory'_ a1' a2' a3' >>= \res -> peek a3'>>= \a3'' -> return (a3'') {-# LINE 295 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Gets the number of display monitors. getDisplayMonitorCount :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Int) -- ^ getDisplayMonitorCount a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getDisplayMonitorCount'_ a1' a2' >>= \res -> peekIntConv a2'>>= \a2'' -> return (a2'') {-# LINE 300 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} -- | Override standard Singleton retrieval. Why do we do this? Well, it's because the Singleton implementation is in a .h file, which means it gets compiled into anybody who includes it. This is needed for the Singleton template to work, but we actually only want it compiled into the implementation of the class based on the Singleton, not all of them. If we don't change this, we get link errors when trying to use the Singleton-based class from an outside dll. This method just delegates to the template version anyway, but the implementation stays in this single compilation unit, preventing link errors. getSingletonPtr :: IO (HG3DClass) -- ^ getSingletonPtr = alloca $ \a1' -> getSingletonPtr'_ a1' >>= \res -> peek a1'>>= \a1'' -> return (a1'') {-# LINE 304 ".\\HGamer3D\\Bindings\\Ogre\\ClassRoot.chs" #-} foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_construct" new'_ :: ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((HG3DClassPtr) -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_destruct" delete'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_saveConfig" saveConfig'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_restoreConfig" restoreConfig'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_showConfigDialog" showConfigDialog'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_addRenderSystem" addRenderSystem'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_getRenderSystemByName" getRenderSystemByName'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_setRenderSystem" setRenderSystem'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_getRenderSystem" getRenderSystem'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_initialise" initialise'_ :: ((HG3DClassPtr) -> (CInt -> ((Ptr CChar) -> ((Ptr CChar) -> ((HG3DClassPtr) -> (IO ())))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_isInitialised" isInitialised'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_getRemoveRenderQueueStructuresOnClear" getRemoveRenderQueueStructuresOnClear'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_setRemoveRenderQueueStructuresOnClear" setRemoveRenderQueueStructuresOnClear'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_addSceneManagerFactory" addSceneManagerFactory'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_removeSceneManagerFactory" removeSceneManagerFactory'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_createSceneManager" createSceneManager'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((Ptr CChar) -> ((HG3DClassPtr) -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_destroySceneManager" destroySceneManager'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_getSceneManager" getSceneManager'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_hasSceneManager" hasSceneManager'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((Ptr CInt) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_getTextureManager" getTextureManager'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_getMeshManager" getMeshManager'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_getErrorDescription" getErrorDescription'_ :: ((HG3DClassPtr) -> (CInt -> ((Ptr CChar) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_queueEndRendering" queueEndRendering'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_startRendering" startRendering'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_renderOneFrame" renderOneFrame'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_renderOneFrame2" renderOneFrame2'_ :: ((HG3DClassPtr) -> (CFloat -> ((Ptr CInt) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_shutdown" shutdown'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_addResourceLocation" addResourceLocation'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> (CInt -> (IO ())))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_removeResourceLocation" removeResourceLocation'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((Ptr CChar) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_convertColourValue" convertColourValue'_ :: ((HG3DClassPtr) -> ((ColourPtr) -> ((Ptr CUInt) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_getAutoCreatedWindow" getAutoCreatedWindow'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_detachRenderTarget" detachRenderTarget'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_detachRenderTarget2" detachRenderTarget2'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_destroyRenderTarget" destroyRenderTarget'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_destroyRenderTarget2" destroyRenderTarget2'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_getRenderTarget" getRenderTarget'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_loadPlugin" loadPlugin'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_unloadPlugin" unloadPlugin'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_destroyRenderQueueInvocationSequence" destroyRenderQueueInvocationSequence'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_destroyAllRenderQueueInvocationSequences" destroyAllRenderQueueInvocationSequences'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_clearEventTimes" clearEventTimes'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_setFrameSmoothingPeriod" setFrameSmoothingPeriod'_ :: ((HG3DClassPtr) -> (CFloat -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_getFrameSmoothingPeriod" getFrameSmoothingPeriod'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_addMovableObjectFactory" addMovableObjectFactory'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (CInt -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_removeMovableObjectFactory" removeMovableObjectFactory'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_hasMovableObjectFactory" hasMovableObjectFactory'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((Ptr CInt) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_getMovableObjectFactory" getMovableObjectFactory'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_getDisplayMonitorCount" getDisplayMonitorCount'_ :: ((HG3DClassPtr) -> ((Ptr CUInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassRoot.chs.h ogre_rt_getSingletonPtr" getSingletonPtr'_ :: ((HG3DClassPtr) -> (IO ()))