-- 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\\ClassPass.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 -- -- Copyright 2011 Dr. 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. -- -- ClassPass.chs -- -- -- -- -- File for type, method, enum or function stubs -- in: "..\OgreSDK_vc10_v1-7-3\include\OGRE\OgrePass.h" -- -- each stub combines the following files: -- a C++ implementation file, transforming cpp calls into C-functions -- a C-header file, making this C-functions available for the C2HS parser -- a chs file, give instructions to the C2HS parser. -- -- module HGamer3D.Bindings.Ogre.ClassPass where import C2HS import Foreign import Foreign.Ptr import Foreign.C import Monad (liftM, liftM2) import HGamer3D.Data.HG3DClass import HGamer3D.Data.Vector2 import HGamer3D.Data.Vector3 import HGamer3D.Data.Vector4 import HGamer3D.Data.Quaternion import HGamer3D.Data.ColourValue import HGamer3D.Data.Radian import HGamer3D.Data.Degree import HGamer3D.Data.Angle import HGamer3D.Bindings.Ogre.TypeHG3DClass {-# LINE 54 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} import HGamer3D.Bindings.Ogre.ClassPtr {-# LINE 55 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} import HGamer3D.Bindings.Ogre.Utils {-# LINE 56 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} import HGamer3D.Bindings.Ogre.TypeColourValue {-# LINE 57 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} import HGamer3D.Bindings.Ogre.EnumSceneBlendFactor {-# LINE 58 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} import HGamer3D.Bindings.Ogre.EnumSceneBlendOperation {-# LINE 59 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} import HGamer3D.Bindings.Ogre.EnumCompareFunction {-# LINE 60 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} import HGamer3D.Bindings.Ogre.EnumCullingMode {-# LINE 61 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} import HGamer3D.Bindings.Ogre.EnumManualCullingMode {-# LINE 62 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} import HGamer3D.Bindings.Ogre.EnumShadeOptions {-# LINE 63 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} import HGamer3D.Bindings.Ogre.EnumPolygonMode {-# LINE 64 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} import HGamer3D.Bindings.Ogre.EnumFogMode {-# LINE 65 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} import HGamer3D.Bindings.Ogre.EnumLightTypes {-# LINE 66 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} import HGamer3D.Bindings.Ogre.EnumContentType {-# LINE 67 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} import HGamer3D.Bindings.Ogre.EnumTextureFilterOptions {-# LINE 68 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} import HGamer3D.Bindings.Ogre.EnumIlluminationStage {-# LINE 69 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} cPIsProgrammable :: HG3DClass -> IO (Bool) cPIsProgrammable a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPIsProgrammable'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 75 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPHasVertexProgram :: HG3DClass -> IO (Bool) cPHasVertexProgram a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPHasVertexProgram'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 79 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPHasFragmentProgram :: HG3DClass -> IO (Bool) cPHasFragmentProgram a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPHasFragmentProgram'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 83 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPHasGeometryProgram :: HG3DClass -> IO (Bool) cPHasGeometryProgram a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPHasGeometryProgram'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 87 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPHasShadowCasterVertexProgram :: HG3DClass -> IO (Bool) cPHasShadowCasterVertexProgram a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPHasShadowCasterVertexProgram'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 91 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPHasShadowReceiverVertexProgram :: HG3DClass -> IO (Bool) cPHasShadowReceiverVertexProgram a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPHasShadowReceiverVertexProgram'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 95 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPHasShadowReceiverFragmentProgram :: HG3DClass -> IO (Bool) cPHasShadowReceiverFragmentProgram a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPHasShadowReceiverFragmentProgram'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 99 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetIndex :: HG3DClass -> IO (Int) cPGetIndex a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetIndex'_ a1' a2' >>= \res -> peekIntConv a2'>>= \a2'' -> return (a2'') {-# LINE 103 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetName :: HG3DClass -> IO (String) cPGetName a1 = withHG3DClass a1 $ \a1' -> alloc64k $ \a2' -> cPGetName'_ a1' a2' >>= \res -> peekCString a2'>>= \a2'' -> return (a2'') {-# LINE 107 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetAmbient :: HG3DClass -> Float -> Float -> Float -> IO () cPSetAmbient a1 a2 a3 a4 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in let {a3' = realToFrac a3} in let {a4' = realToFrac a4} in cPSetAmbient'_ a1' a2' a3' a4' >>= \res -> return () {-# LINE 113 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetAmbient2 :: HG3DClass -> ColourValue -> IO () cPSetAmbient2 a1 a2 = withHG3DClass a1 $ \a1' -> withColourValue a2 $ \a2' -> cPSetAmbient2'_ a1' a2' >>= \res -> return () {-# LINE 117 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetDiffuse :: HG3DClass -> Float -> Float -> Float -> Float -> IO () cPSetDiffuse a1 a2 a3 a4 a5 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in let {a3' = realToFrac a3} in let {a4' = realToFrac a4} in let {a5' = realToFrac a5} in cPSetDiffuse'_ a1' a2' a3' a4' a5' >>= \res -> return () {-# LINE 124 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetDiffuse2 :: HG3DClass -> ColourValue -> IO () cPSetDiffuse2 a1 a2 = withHG3DClass a1 $ \a1' -> withColourValue a2 $ \a2' -> cPSetDiffuse2'_ a1' a2' >>= \res -> return () {-# LINE 128 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetSpecular :: HG3DClass -> Float -> Float -> Float -> Float -> IO () cPSetSpecular a1 a2 a3 a4 a5 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in let {a3' = realToFrac a3} in let {a4' = realToFrac a4} in let {a5' = realToFrac a5} in cPSetSpecular'_ a1' a2' a3' a4' a5' >>= \res -> return () {-# LINE 135 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetSpecular2 :: HG3DClass -> ColourValue -> IO () cPSetSpecular2 a1 a2 = withHG3DClass a1 $ \a1' -> withColourValue a2 $ \a2' -> cPSetSpecular2'_ a1' a2' >>= \res -> return () {-# LINE 139 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetShininess :: HG3DClass -> Float -> IO () cPSetShininess a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in cPSetShininess'_ a1' a2' >>= \res -> return () {-# LINE 143 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetSelfIllumination :: HG3DClass -> Float -> Float -> Float -> IO () cPSetSelfIllumination a1 a2 a3 a4 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in let {a3' = realToFrac a3} in let {a4' = realToFrac a4} in cPSetSelfIllumination'_ a1' a2' a3' a4' >>= \res -> return () {-# LINE 149 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetSelfIllumination2 :: HG3DClass -> ColourValue -> IO () cPSetSelfIllumination2 a1 a2 = withHG3DClass a1 $ \a1' -> withColourValue a2 $ \a2' -> cPSetSelfIllumination2'_ a1' a2' >>= \res -> return () {-# LINE 153 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetPointSize :: HG3DClass -> IO (Float) cPGetPointSize a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetPointSize'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 157 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetPointSize :: HG3DClass -> Float -> IO () cPSetPointSize a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in cPSetPointSize'_ a1' a2' >>= \res -> return () {-# LINE 161 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetPointSpritesEnabled :: HG3DClass -> Bool -> IO () cPSetPointSpritesEnabled a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in cPSetPointSpritesEnabled'_ a1' a2' >>= \res -> return () {-# LINE 165 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetPointSpritesEnabled :: HG3DClass -> IO (Bool) cPGetPointSpritesEnabled a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetPointSpritesEnabled'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 169 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetPointAttenuation :: HG3DClass -> Bool -> Float -> Float -> Float -> IO () cPSetPointAttenuation a1 a2 a3 a4 a5 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in let {a3' = realToFrac a3} in let {a4' = realToFrac a4} in let {a5' = realToFrac a5} in cPSetPointAttenuation'_ a1' a2' a3' a4' a5' >>= \res -> return () {-# LINE 176 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPIsPointAttenuationEnabled :: HG3DClass -> IO (Bool) cPIsPointAttenuationEnabled a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPIsPointAttenuationEnabled'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 180 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetPointAttenuationConstant :: HG3DClass -> IO (Float) cPGetPointAttenuationConstant a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetPointAttenuationConstant'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 184 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetPointAttenuationLinear :: HG3DClass -> IO (Float) cPGetPointAttenuationLinear a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetPointAttenuationLinear'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 188 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetPointAttenuationQuadratic :: HG3DClass -> IO (Float) cPGetPointAttenuationQuadratic a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetPointAttenuationQuadratic'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 192 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetPointMinSize :: HG3DClass -> Float -> IO () cPSetPointMinSize a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in cPSetPointMinSize'_ a1' a2' >>= \res -> return () {-# LINE 196 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetPointMinSize :: HG3DClass -> IO (Float) cPGetPointMinSize a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetPointMinSize'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 200 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetPointMaxSize :: HG3DClass -> Float -> IO () cPSetPointMaxSize a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in cPSetPointMaxSize'_ a1' a2' >>= \res -> return () {-# LINE 204 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetPointMaxSize :: HG3DClass -> IO (Float) cPGetPointMaxSize a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetPointMaxSize'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 208 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetAmbient :: HG3DClass -> IO (ColourValue) cPGetAmbient a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetAmbient'_ a1' a2' >>= \res -> peek a2'>>= \a2'' -> return (a2'') {-# LINE 212 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetDiffuse :: HG3DClass -> IO (ColourValue) cPGetDiffuse a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetDiffuse'_ a1' a2' >>= \res -> peek a2'>>= \a2'' -> return (a2'') {-# LINE 216 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetSpecular :: HG3DClass -> IO (ColourValue) cPGetSpecular a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetSpecular'_ a1' a2' >>= \res -> peek a2'>>= \a2'' -> return (a2'') {-# LINE 220 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetSelfIllumination :: HG3DClass -> IO (ColourValue) cPGetSelfIllumination a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetSelfIllumination'_ a1' a2' >>= \res -> peek a2'>>= \a2'' -> return (a2'') {-# LINE 224 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetShininess :: HG3DClass -> IO (Float) cPGetShininess a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetShininess'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 228 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPCreateTextureUnitState :: HG3DClass -> IO (HG3DClass) cPCreateTextureUnitState a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPCreateTextureUnitState'_ a1' a2' >>= \res -> peek a2'>>= \a2'' -> return (a2'') {-# LINE 232 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPCreateTextureUnitState2 :: HG3DClass -> String -> Int -> IO (HG3DClass) cPCreateTextureUnitState2 a1 a2 a3 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> let {a3' = fromIntegral a3} in alloca $ \a4' -> cPCreateTextureUnitState2'_ a1' a2' a3' a4' >>= \res -> peek a4'>>= \a4'' -> return (a4'') {-# LINE 238 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPAddTextureUnitState :: HG3DClass -> HG3DClass -> IO () cPAddTextureUnitState a1 a2 = withHG3DClass a1 $ \a1' -> withHG3DClass a2 $ \a2' -> cPAddTextureUnitState'_ a1' a2' >>= \res -> return () {-# LINE 242 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetTextureUnitState :: HG3DClass -> Int -> IO (HG3DClass) cPGetTextureUnitState a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in alloca $ \a3' -> cPGetTextureUnitState'_ a1' a2' a3' >>= \res -> peek a3'>>= \a3'' -> return (a3'') {-# LINE 247 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetTextureUnitState2 :: HG3DClass -> String -> IO (HG3DClass) cPGetTextureUnitState2 a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> alloca $ \a3' -> cPGetTextureUnitState2'_ a1' a2' a3' >>= \res -> peek a3'>>= \a3'' -> return (a3'') {-# LINE 252 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPRemoveTextureUnitState :: HG3DClass -> Int -> IO () cPRemoveTextureUnitState a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in cPRemoveTextureUnitState'_ a1' a2' >>= \res -> return () {-# LINE 256 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPRemoveAllTextureUnitStates :: HG3DClass -> IO () cPRemoveAllTextureUnitStates a1 = withHG3DClass a1 $ \a1' -> cPRemoveAllTextureUnitStates'_ a1' >>= \res -> return () {-# LINE 259 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetNumTextureUnitStates :: HG3DClass -> IO (Int) cPGetNumTextureUnitStates a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetNumTextureUnitStates'_ a1' a2' >>= \res -> peekIntConv a2'>>= \a2'' -> return (a2'') {-# LINE 263 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPHasSeparateSceneBlending :: HG3DClass -> IO (Bool) cPHasSeparateSceneBlending a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPHasSeparateSceneBlending'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 267 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetSourceBlendFactor :: HG3DClass -> IO (EnumSceneBlendFactor) cPGetSourceBlendFactor a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetSourceBlendFactor'_ a1' a2' >>= \res -> peekEnumUtil a2'>>= \a2'' -> return (a2'') {-# LINE 271 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetDestBlendFactor :: HG3DClass -> IO (EnumSceneBlendFactor) cPGetDestBlendFactor a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetDestBlendFactor'_ a1' a2' >>= \res -> peekEnumUtil a2'>>= \a2'' -> return (a2'') {-# LINE 275 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetSourceBlendFactorAlpha :: HG3DClass -> IO (EnumSceneBlendFactor) cPGetSourceBlendFactorAlpha a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetSourceBlendFactorAlpha'_ a1' a2' >>= \res -> peekEnumUtil a2'>>= \a2'' -> return (a2'') {-# LINE 279 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetDestBlendFactorAlpha :: HG3DClass -> IO (EnumSceneBlendFactor) cPGetDestBlendFactorAlpha a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetDestBlendFactorAlpha'_ a1' a2' >>= \res -> peekEnumUtil a2'>>= \a2'' -> return (a2'') {-# LINE 283 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetSceneBlendingOperation :: HG3DClass -> EnumSceneBlendOperation -> IO () cPSetSceneBlendingOperation a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = cIntFromEnum a2} in cPSetSceneBlendingOperation'_ a1' a2' >>= \res -> return () {-# LINE 287 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetSeparateSceneBlendingOperation :: HG3DClass -> EnumSceneBlendOperation -> EnumSceneBlendOperation -> IO () cPSetSeparateSceneBlendingOperation a1 a2 a3 = withHG3DClass a1 $ \a1' -> let {a2' = cIntFromEnum a2} in let {a3' = cIntFromEnum a3} in cPSetSeparateSceneBlendingOperation'_ a1' a2' a3' >>= \res -> return () {-# LINE 292 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPHasSeparateSceneBlendingOperations :: HG3DClass -> IO (Bool) cPHasSeparateSceneBlendingOperations a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPHasSeparateSceneBlendingOperations'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 296 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetSceneBlendingOperation :: HG3DClass -> IO (EnumSceneBlendOperation) cPGetSceneBlendingOperation a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetSceneBlendingOperation'_ a1' a2' >>= \res -> peekEnumUtil a2'>>= \a2'' -> return (a2'') {-# LINE 300 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetSceneBlendingOperationAlpha :: HG3DClass -> IO (EnumSceneBlendOperation) cPGetSceneBlendingOperationAlpha a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetSceneBlendingOperationAlpha'_ a1' a2' >>= \res -> peekEnumUtil a2'>>= \a2'' -> return (a2'') {-# LINE 304 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPIsTransparent :: HG3DClass -> IO (Bool) cPIsTransparent a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPIsTransparent'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 308 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetDepthCheckEnabled :: HG3DClass -> Bool -> IO () cPSetDepthCheckEnabled a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in cPSetDepthCheckEnabled'_ a1' a2' >>= \res -> return () {-# LINE 312 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetDepthCheckEnabled :: HG3DClass -> IO (Bool) cPGetDepthCheckEnabled a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetDepthCheckEnabled'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 316 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetDepthWriteEnabled :: HG3DClass -> Bool -> IO () cPSetDepthWriteEnabled a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in cPSetDepthWriteEnabled'_ a1' a2' >>= \res -> return () {-# LINE 320 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetDepthWriteEnabled :: HG3DClass -> IO (Bool) cPGetDepthWriteEnabled a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetDepthWriteEnabled'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 324 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetDepthFunction :: HG3DClass -> EnumCompareFunction -> IO () cPSetDepthFunction a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = cIntFromEnum a2} in cPSetDepthFunction'_ a1' a2' >>= \res -> return () {-# LINE 328 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetDepthFunction :: HG3DClass -> IO (EnumCompareFunction) cPGetDepthFunction a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetDepthFunction'_ a1' a2' >>= \res -> peekEnumUtil a2'>>= \a2'' -> return (a2'') {-# LINE 332 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetColourWriteEnabled :: HG3DClass -> Bool -> IO () cPSetColourWriteEnabled a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in cPSetColourWriteEnabled'_ a1' a2' >>= \res -> return () {-# LINE 336 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetColourWriteEnabled :: HG3DClass -> IO (Bool) cPGetColourWriteEnabled a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetColourWriteEnabled'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 340 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetCullingMode :: HG3DClass -> EnumCullingMode -> IO () cPSetCullingMode a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = cIntFromEnum a2} in cPSetCullingMode'_ a1' a2' >>= \res -> return () {-# LINE 344 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetCullingMode :: HG3DClass -> IO (EnumCullingMode) cPGetCullingMode a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetCullingMode'_ a1' a2' >>= \res -> peekEnumUtil a2'>>= \a2'' -> return (a2'') {-# LINE 348 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetManualCullingMode :: HG3DClass -> EnumManualCullingMode -> IO () cPSetManualCullingMode a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = cIntFromEnum a2} in cPSetManualCullingMode'_ a1' a2' >>= \res -> return () {-# LINE 352 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetManualCullingMode :: HG3DClass -> IO (EnumManualCullingMode) cPGetManualCullingMode a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetManualCullingMode'_ a1' a2' >>= \res -> peekEnumUtil a2'>>= \a2'' -> return (a2'') {-# LINE 356 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetLightingEnabled :: HG3DClass -> Bool -> IO () cPSetLightingEnabled a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in cPSetLightingEnabled'_ a1' a2' >>= \res -> return () {-# LINE 360 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetLightingEnabled :: HG3DClass -> IO (Bool) cPGetLightingEnabled a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetLightingEnabled'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 364 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetMaxSimultaneousLights :: HG3DClass -> Int -> IO () cPSetMaxSimultaneousLights a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in cPSetMaxSimultaneousLights'_ a1' a2' >>= \res -> return () {-# LINE 368 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetMaxSimultaneousLights :: HG3DClass -> IO (Int) cPGetMaxSimultaneousLights a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetMaxSimultaneousLights'_ a1' a2' >>= \res -> peekIntConv a2'>>= \a2'' -> return (a2'') {-# LINE 372 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetStartLight :: HG3DClass -> Int -> IO () cPSetStartLight a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in cPSetStartLight'_ a1' a2' >>= \res -> return () {-# LINE 376 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetStartLight :: HG3DClass -> IO (Int) cPGetStartLight a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetStartLight'_ a1' a2' >>= \res -> peekIntConv a2'>>= \a2'' -> return (a2'') {-# LINE 380 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetShadingMode :: HG3DClass -> EnumShadeOptions -> IO () cPSetShadingMode a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = cIntFromEnum a2} in cPSetShadingMode'_ a1' a2' >>= \res -> return () {-# LINE 384 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetShadingMode :: HG3DClass -> IO (EnumShadeOptions) cPGetShadingMode a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetShadingMode'_ a1' a2' >>= \res -> peekEnumUtil a2'>>= \a2'' -> return (a2'') {-# LINE 388 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetPolygonMode :: HG3DClass -> EnumPolygonMode -> IO () cPSetPolygonMode a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = cIntFromEnum a2} in cPSetPolygonMode'_ a1' a2' >>= \res -> return () {-# LINE 392 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetPolygonMode :: HG3DClass -> IO (EnumPolygonMode) cPGetPolygonMode a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetPolygonMode'_ a1' a2' >>= \res -> peekEnumUtil a2'>>= \a2'' -> return (a2'') {-# LINE 396 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetPolygonModeOverrideable :: HG3DClass -> Bool -> IO () cPSetPolygonModeOverrideable a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in cPSetPolygonModeOverrideable'_ a1' a2' >>= \res -> return () {-# LINE 400 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetPolygonModeOverrideable :: HG3DClass -> IO (Bool) cPGetPolygonModeOverrideable a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetPolygonModeOverrideable'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 404 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetFog :: HG3DClass -> Bool -> EnumFogMode -> ColourValue -> Float -> Float -> Float -> IO () cPSetFog a1 a2 a3 a4 a5 a6 a7 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in let {a3' = cIntFromEnum a3} in withColourValue a4 $ \a4' -> let {a5' = realToFrac a5} in let {a6' = realToFrac a6} in let {a7' = realToFrac a7} in cPSetFog'_ a1' a2' a3' a4' a5' a6' a7' >>= \res -> return () {-# LINE 413 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetFogOverride :: HG3DClass -> IO (Bool) cPGetFogOverride a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetFogOverride'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 417 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetFogMode :: HG3DClass -> IO (EnumFogMode) cPGetFogMode a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetFogMode'_ a1' a2' >>= \res -> peekEnumUtil a2'>>= \a2'' -> return (a2'') {-# LINE 421 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetFogColour :: HG3DClass -> IO (ColourValue) cPGetFogColour a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetFogColour'_ a1' a2' >>= \res -> peek a2'>>= \a2'' -> return (a2'') {-# LINE 425 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetFogStart :: HG3DClass -> IO (Float) cPGetFogStart a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetFogStart'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 429 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetFogEnd :: HG3DClass -> IO (Float) cPGetFogEnd a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetFogEnd'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 433 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetFogDensity :: HG3DClass -> IO (Float) cPGetFogDensity a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetFogDensity'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 437 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetDepthBias :: HG3DClass -> Float -> Float -> IO () cPSetDepthBias a1 a2 a3 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in let {a3' = realToFrac a3} in cPSetDepthBias'_ a1' a2' a3' >>= \res -> return () {-# LINE 442 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetDepthBiasConstant :: HG3DClass -> IO (Float) cPGetDepthBiasConstant a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetDepthBiasConstant'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 446 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetDepthBiasSlopeScale :: HG3DClass -> IO (Float) cPGetDepthBiasSlopeScale a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetDepthBiasSlopeScale'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 450 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetIterationDepthBias :: HG3DClass -> Float -> IO () cPSetIterationDepthBias a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in cPSetIterationDepthBias'_ a1' a2' >>= \res -> return () {-# LINE 454 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetIterationDepthBias :: HG3DClass -> IO (Float) cPGetIterationDepthBias a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetIterationDepthBias'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 458 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetAlphaRejectFunction :: HG3DClass -> EnumCompareFunction -> IO () cPSetAlphaRejectFunction a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = cIntFromEnum a2} in cPSetAlphaRejectFunction'_ a1' a2' >>= \res -> return () {-# LINE 462 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetAlphaRejectFunction :: HG3DClass -> IO (EnumCompareFunction) cPGetAlphaRejectFunction a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetAlphaRejectFunction'_ a1' a2' >>= \res -> peekEnumUtil a2'>>= \a2'' -> return (a2'') {-# LINE 466 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetAlphaToCoverageEnabled :: HG3DClass -> Bool -> IO () cPSetAlphaToCoverageEnabled a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in cPSetAlphaToCoverageEnabled'_ a1' a2' >>= \res -> return () {-# LINE 470 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPIsAlphaToCoverageEnabled :: HG3DClass -> IO (Bool) cPIsAlphaToCoverageEnabled a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPIsAlphaToCoverageEnabled'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 474 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetTransparentSortingEnabled :: HG3DClass -> Bool -> IO () cPSetTransparentSortingEnabled a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in cPSetTransparentSortingEnabled'_ a1' a2' >>= \res -> return () {-# LINE 478 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetTransparentSortingEnabled :: HG3DClass -> IO (Bool) cPGetTransparentSortingEnabled a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetTransparentSortingEnabled'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 482 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetTransparentSortingForced :: HG3DClass -> Bool -> IO () cPSetTransparentSortingForced a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in cPSetTransparentSortingForced'_ a1' a2' >>= \res -> return () {-# LINE 486 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetTransparentSortingForced :: HG3DClass -> IO (Bool) cPGetTransparentSortingForced a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetTransparentSortingForced'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 490 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetIteratePerLight :: HG3DClass -> Bool -> Bool -> EnumLightTypes -> IO () cPSetIteratePerLight a1 a2 a3 a4 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in let {a3' = fromBool a3} in let {a4' = cIntFromEnum a4} in cPSetIteratePerLight'_ a1' a2' a3' a4' >>= \res -> return () {-# LINE 496 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetIteratePerLight :: HG3DClass -> IO (Bool) cPGetIteratePerLight a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetIteratePerLight'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 500 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetRunOnlyForOneLightType :: HG3DClass -> IO (Bool) cPGetRunOnlyForOneLightType a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetRunOnlyForOneLightType'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 504 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetOnlyLightType :: HG3DClass -> IO (EnumLightTypes) cPGetOnlyLightType a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetOnlyLightType'_ a1' a2' >>= \res -> peekEnumUtil a2'>>= \a2'' -> return (a2'') {-# LINE 508 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetLightCountPerIteration :: HG3DClass -> Int -> IO () cPSetLightCountPerIteration a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in cPSetLightCountPerIteration'_ a1' a2' >>= \res -> return () {-# LINE 512 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetLightCountPerIteration :: HG3DClass -> IO (Int) cPGetLightCountPerIteration a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetLightCountPerIteration'_ a1' a2' >>= \res -> peekIntConv a2'>>= \a2'' -> return (a2'') {-# LINE 516 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetParent :: HG3DClass -> IO (HG3DClass) cPGetParent a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetParent'_ a1' a2' >>= \res -> peek a2'>>= \a2'' -> return (a2'') {-# LINE 520 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetResourceGroup :: HG3DClass -> IO (String) cPGetResourceGroup a1 = withHG3DClass a1 $ \a1' -> alloc64k $ \a2' -> cPGetResourceGroup'_ a1' a2' >>= \res -> peekCString a2'>>= \a2'' -> return (a2'') {-# LINE 524 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetVertexProgram :: HG3DClass -> String -> Bool -> IO () cPSetVertexProgram a1 a2 a3 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> let {a3' = fromBool a3} in cPSetVertexProgram'_ a1' a2' a3' >>= \res -> return () {-# LINE 529 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetVertexProgramName :: HG3DClass -> IO (String) cPGetVertexProgramName a1 = withHG3DClass a1 $ \a1' -> alloc64k $ \a2' -> cPGetVertexProgramName'_ a1' a2' >>= \res -> peekCString a2'>>= \a2'' -> return (a2'') {-# LINE 533 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetShadowCasterVertexProgram :: HG3DClass -> String -> IO () cPSetShadowCasterVertexProgram a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> cPSetShadowCasterVertexProgram'_ a1' a2' >>= \res -> return () {-# LINE 537 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetShadowCasterVertexProgramName :: HG3DClass -> IO (String) cPGetShadowCasterVertexProgramName a1 = withHG3DClass a1 $ \a1' -> alloc64k $ \a2' -> cPGetShadowCasterVertexProgramName'_ a1' a2' >>= \res -> peekCString a2'>>= \a2'' -> return (a2'') {-# LINE 541 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetShadowReceiverVertexProgram :: HG3DClass -> String -> IO () cPSetShadowReceiverVertexProgram a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> cPSetShadowReceiverVertexProgram'_ a1' a2' >>= \res -> return () {-# LINE 545 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetShadowReceiverFragmentProgram :: HG3DClass -> String -> IO () cPSetShadowReceiverFragmentProgram a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> cPSetShadowReceiverFragmentProgram'_ a1' a2' >>= \res -> return () {-# LINE 549 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetShadowReceiverVertexProgramName :: HG3DClass -> IO (String) cPGetShadowReceiverVertexProgramName a1 = withHG3DClass a1 $ \a1' -> alloc64k $ \a2' -> cPGetShadowReceiverVertexProgramName'_ a1' a2' >>= \res -> peekCString a2'>>= \a2'' -> return (a2'') {-# LINE 553 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetShadowReceiverFragmentProgramName :: HG3DClass -> IO (String) cPGetShadowReceiverFragmentProgramName a1 = withHG3DClass a1 $ \a1' -> alloc64k $ \a2' -> cPGetShadowReceiverFragmentProgramName'_ a1' a2' >>= \res -> peekCString a2'>>= \a2'' -> return (a2'') {-# LINE 557 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetFragmentProgram :: HG3DClass -> String -> Bool -> IO () cPSetFragmentProgram a1 a2 a3 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> let {a3' = fromBool a3} in cPSetFragmentProgram'_ a1' a2' a3' >>= \res -> return () {-# LINE 562 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetFragmentProgramName :: HG3DClass -> IO (String) cPGetFragmentProgramName a1 = withHG3DClass a1 $ \a1' -> alloc64k $ \a2' -> cPGetFragmentProgramName'_ a1' a2' >>= \res -> peekCString a2'>>= \a2'' -> return (a2'') {-# LINE 566 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetGeometryProgram :: HG3DClass -> String -> Bool -> IO () cPSetGeometryProgram a1 a2 a3 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> let {a3' = fromBool a3} in cPSetGeometryProgram'_ a1' a2' a3' >>= \res -> return () {-# LINE 571 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetGeometryProgramName :: HG3DClass -> IO (String) cPGetGeometryProgramName a1 = withHG3DClass a1 $ \a1' -> alloc64k $ \a2' -> cPGetGeometryProgramName'_ a1' a2' >>= \res -> peekCString a2'>>= \a2'' -> return (a2'') {-# LINE 575 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSplit :: HG3DClass -> Int -> IO (HG3DClass) cPSplit a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in alloca $ \a3' -> cPSplit'_ a1' a2' a3' >>= \res -> peek a3'>>= \a3'' -> return (a3'') {-# LINE 580 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPNotifyIndex :: HG3DClass -> Int -> IO () cPNotifyIndex a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in cPNotifyIndex'_ a1' a2' >>= \res -> return () {-# LINE 584 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPPrepare :: HG3DClass -> IO () cPPrepare a1 = withHG3DClass a1 $ \a1' -> cPPrepare'_ a1' >>= \res -> return () {-# LINE 587 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPUnprepare :: HG3DClass -> IO () cPUnprepare a1 = withHG3DClass a1 $ \a1' -> cPUnprepare'_ a1' >>= \res -> return () {-# LINE 590 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPLoad :: HG3DClass -> IO () cPLoad a1 = withHG3DClass a1 $ \a1' -> cPLoad'_ a1' >>= \res -> return () {-# LINE 593 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPUnload :: HG3DClass -> IO () cPUnload a1 = withHG3DClass a1 $ \a1' -> cPUnload'_ a1' >>= \res -> return () {-# LINE 596 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPIsLoaded :: HG3DClass -> IO (Bool) cPIsLoaded a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPIsLoaded'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 600 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetHash :: HG3DClass -> IO (Int) cPGetHash a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetHash'_ a1' a2' >>= \res -> peekIntConv a2'>>= \a2'' -> return (a2'') {-# LINE 604 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPDirtyHash :: HG3DClass -> IO () cPDirtyHash a1 = withHG3DClass a1 $ \a1' -> cPDirtyHash'_ a1' >>= \res -> return () {-# LINE 607 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPRecalculateHash :: HG3DClass -> IO () cPRecalculateHash a1 = withHG3DClass a1 $ \a1' -> cPRecalculateHash'_ a1' >>= \res -> return () {-# LINE 610 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPNotifyNeedsRecompile :: HG3DClass -> IO () cPNotifyNeedsRecompile a1 = withHG3DClass a1 $ \a1' -> cPNotifyNeedsRecompile'_ a1' >>= \res -> return () {-# LINE 613 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetTextureUnitWithContentTypeIndex :: HG3DClass -> EnumContentType -> Int -> IO (Int) cPGetTextureUnitWithContentTypeIndex a1 a2 a3 = withHG3DClass a1 $ \a1' -> let {a2' = cIntFromEnum a2} in let {a3' = fromIntegral a3} in alloca $ \a4' -> cPGetTextureUnitWithContentTypeIndex'_ a1' a2' a3' a4' >>= \res -> peekIntConv a4'>>= \a4'' -> return (a4'') {-# LINE 619 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetTextureFiltering :: HG3DClass -> EnumTextureFilterOptions -> IO () cPSetTextureFiltering a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = cIntFromEnum a2} in cPSetTextureFiltering'_ a1' a2' >>= \res -> return () {-# LINE 623 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetTextureAnisotropy :: HG3DClass -> Int -> IO () cPSetTextureAnisotropy a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in cPSetTextureAnisotropy'_ a1' a2' >>= \res -> return () {-# LINE 627 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetNormaliseNormals :: HG3DClass -> Bool -> IO () cPSetNormaliseNormals a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in cPSetNormaliseNormals'_ a1' a2' >>= \res -> return () {-# LINE 631 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetNormaliseNormals :: HG3DClass -> IO (Bool) cPGetNormaliseNormals a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetNormaliseNormals'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 635 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPQueueForDeletion :: HG3DClass -> IO () cPQueueForDeletion a1 = withHG3DClass a1 $ \a1' -> cPQueueForDeletion'_ a1' >>= \res -> return () {-# LINE 638 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPIsAmbientOnly :: HG3DClass -> IO (Bool) cPIsAmbientOnly a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPIsAmbientOnly'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 642 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetPassIterationCount :: HG3DClass -> Int -> IO () cPSetPassIterationCount a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in cPSetPassIterationCount'_ a1' a2' >>= \res -> return () {-# LINE 646 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetPassIterationCount :: HG3DClass -> IO (Int) cPGetPassIterationCount a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetPassIterationCount'_ a1' a2' >>= \res -> peekIntConv a2'>>= \a2'' -> return (a2'') {-# LINE 650 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetLightScissoringEnabled :: HG3DClass -> Bool -> IO () cPSetLightScissoringEnabled a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in cPSetLightScissoringEnabled'_ a1' a2' >>= \res -> return () {-# LINE 654 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetLightScissoringEnabled :: HG3DClass -> IO (Bool) cPGetLightScissoringEnabled a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetLightScissoringEnabled'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 658 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetLightClipPlanesEnabled :: HG3DClass -> Bool -> IO () cPSetLightClipPlanesEnabled a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in cPSetLightClipPlanesEnabled'_ a1' a2' >>= \res -> return () {-# LINE 662 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetLightClipPlanesEnabled :: HG3DClass -> IO (Bool) cPGetLightClipPlanesEnabled a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetLightClipPlanesEnabled'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 666 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPSetIlluminationStage :: HG3DClass -> EnumIlluminationStage -> IO () cPSetIlluminationStage a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = cIntFromEnum a2} in cPSetIlluminationStage'_ a1' a2' >>= \res -> return () {-# LINE 670 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; cPGetIlluminationStage :: HG3DClass -> IO (EnumIlluminationStage) cPGetIlluminationStage a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> cPGetIlluminationStage'_ a1' a2' >>= \res -> peekEnumUtil a2'>>= \a2'' -> return (a2'') {-# LINE 674 "HGamer3D\\Bindings\\Ogre\\ClassPass.chs" #-} ; foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_isProgrammable_c" cPIsProgrammable'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_hasVertexProgram_c" cPHasVertexProgram'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_hasFragmentProgram_c" cPHasFragmentProgram'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_hasGeometryProgram_c" cPHasGeometryProgram'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_hasShadowCasterVertexProgram_c" cPHasShadowCasterVertexProgram'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_hasShadowReceiverVertexProgram_c" cPHasShadowReceiverVertexProgram'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_hasShadowReceiverFragmentProgram_c" cPHasShadowReceiverFragmentProgram'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getIndex_c" cPGetIndex'_ :: ((HG3DClassPtr) -> ((Ptr CUInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getName_c" cPGetName'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setAmbient_c" cPSetAmbient'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setAmbient2_c" cPSetAmbient2'_ :: ((HG3DClassPtr) -> ((ColourValuePtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setDiffuse_c" cPSetDiffuse'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (CFloat -> (IO ())))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setDiffuse2_c" cPSetDiffuse2'_ :: ((HG3DClassPtr) -> ((ColourValuePtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setSpecular_c" cPSetSpecular'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (CFloat -> (IO ())))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setSpecular2_c" cPSetSpecular2'_ :: ((HG3DClassPtr) -> ((ColourValuePtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setShininess_c" cPSetShininess'_ :: ((HG3DClassPtr) -> (CFloat -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setSelfIllumination_c" cPSetSelfIllumination'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setSelfIllumination2_c" cPSetSelfIllumination2'_ :: ((HG3DClassPtr) -> ((ColourValuePtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getPointSize_c" cPGetPointSize'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setPointSize_c" cPSetPointSize'_ :: ((HG3DClassPtr) -> (CFloat -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setPointSpritesEnabled_c" cPSetPointSpritesEnabled'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getPointSpritesEnabled_c" cPGetPointSpritesEnabled'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setPointAttenuation_c" cPSetPointAttenuation'_ :: ((HG3DClassPtr) -> (CInt -> (CFloat -> (CFloat -> (CFloat -> (IO ())))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_isPointAttenuationEnabled_c" cPIsPointAttenuationEnabled'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getPointAttenuationConstant_c" cPGetPointAttenuationConstant'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getPointAttenuationLinear_c" cPGetPointAttenuationLinear'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getPointAttenuationQuadratic_c" cPGetPointAttenuationQuadratic'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setPointMinSize_c" cPSetPointMinSize'_ :: ((HG3DClassPtr) -> (CFloat -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getPointMinSize_c" cPGetPointMinSize'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setPointMaxSize_c" cPSetPointMaxSize'_ :: ((HG3DClassPtr) -> (CFloat -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getPointMaxSize_c" cPGetPointMaxSize'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getAmbient_c" cPGetAmbient'_ :: ((HG3DClassPtr) -> ((ColourValuePtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getDiffuse_c" cPGetDiffuse'_ :: ((HG3DClassPtr) -> ((ColourValuePtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getSpecular_c" cPGetSpecular'_ :: ((HG3DClassPtr) -> ((ColourValuePtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getSelfIllumination_c" cPGetSelfIllumination'_ :: ((HG3DClassPtr) -> ((ColourValuePtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getShininess_c" cPGetShininess'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_createTextureUnitState_c" cPCreateTextureUnitState'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_createTextureUnitState2_c" cPCreateTextureUnitState2'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (CUInt -> ((HG3DClassPtr) -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_addTextureUnitState_c" cPAddTextureUnitState'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getTextureUnitState_c" cPGetTextureUnitState'_ :: ((HG3DClassPtr) -> (CUInt -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getTextureUnitState2_c" cPGetTextureUnitState2'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_removeTextureUnitState_c" cPRemoveTextureUnitState'_ :: ((HG3DClassPtr) -> (CUInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_removeAllTextureUnitStates_c" cPRemoveAllTextureUnitStates'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getNumTextureUnitStates_c" cPGetNumTextureUnitStates'_ :: ((HG3DClassPtr) -> ((Ptr CUInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_hasSeparateSceneBlending_c" cPHasSeparateSceneBlending'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getSourceBlendFactor_c" cPGetSourceBlendFactor'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getDestBlendFactor_c" cPGetDestBlendFactor'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getSourceBlendFactorAlpha_c" cPGetSourceBlendFactorAlpha'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getDestBlendFactorAlpha_c" cPGetDestBlendFactorAlpha'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setSceneBlendingOperation_c" cPSetSceneBlendingOperation'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setSeparateSceneBlendingOperation_c" cPSetSeparateSceneBlendingOperation'_ :: ((HG3DClassPtr) -> (CInt -> (CInt -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_hasSeparateSceneBlendingOperations_c" cPHasSeparateSceneBlendingOperations'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getSceneBlendingOperation_c" cPGetSceneBlendingOperation'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getSceneBlendingOperationAlpha_c" cPGetSceneBlendingOperationAlpha'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_isTransparent_c" cPIsTransparent'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setDepthCheckEnabled_c" cPSetDepthCheckEnabled'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getDepthCheckEnabled_c" cPGetDepthCheckEnabled'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setDepthWriteEnabled_c" cPSetDepthWriteEnabled'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getDepthWriteEnabled_c" cPGetDepthWriteEnabled'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setDepthFunction_c" cPSetDepthFunction'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getDepthFunction_c" cPGetDepthFunction'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setColourWriteEnabled_c" cPSetColourWriteEnabled'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getColourWriteEnabled_c" cPGetColourWriteEnabled'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setCullingMode_c" cPSetCullingMode'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getCullingMode_c" cPGetCullingMode'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setManualCullingMode_c" cPSetManualCullingMode'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getManualCullingMode_c" cPGetManualCullingMode'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setLightingEnabled_c" cPSetLightingEnabled'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getLightingEnabled_c" cPGetLightingEnabled'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setMaxSimultaneousLights_c" cPSetMaxSimultaneousLights'_ :: ((HG3DClassPtr) -> (CUInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getMaxSimultaneousLights_c" cPGetMaxSimultaneousLights'_ :: ((HG3DClassPtr) -> ((Ptr CUInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setStartLight_c" cPSetStartLight'_ :: ((HG3DClassPtr) -> (CUInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getStartLight_c" cPGetStartLight'_ :: ((HG3DClassPtr) -> ((Ptr CUInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setShadingMode_c" cPSetShadingMode'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getShadingMode_c" cPGetShadingMode'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setPolygonMode_c" cPSetPolygonMode'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getPolygonMode_c" cPGetPolygonMode'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setPolygonModeOverrideable_c" cPSetPolygonModeOverrideable'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getPolygonModeOverrideable_c" cPGetPolygonModeOverrideable'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setFog_c" cPSetFog'_ :: ((HG3DClassPtr) -> (CInt -> (CInt -> ((ColourValuePtr) -> (CFloat -> (CFloat -> (CFloat -> (IO ())))))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getFogOverride_c" cPGetFogOverride'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getFogMode_c" cPGetFogMode'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getFogColour_c" cPGetFogColour'_ :: ((HG3DClassPtr) -> ((ColourValuePtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getFogStart_c" cPGetFogStart'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getFogEnd_c" cPGetFogEnd'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getFogDensity_c" cPGetFogDensity'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setDepthBias_c" cPSetDepthBias'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getDepthBiasConstant_c" cPGetDepthBiasConstant'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getDepthBiasSlopeScale_c" cPGetDepthBiasSlopeScale'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setIterationDepthBias_c" cPSetIterationDepthBias'_ :: ((HG3DClassPtr) -> (CFloat -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getIterationDepthBias_c" cPGetIterationDepthBias'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setAlphaRejectFunction_c" cPSetAlphaRejectFunction'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getAlphaRejectFunction_c" cPGetAlphaRejectFunction'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setAlphaToCoverageEnabled_c" cPSetAlphaToCoverageEnabled'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_isAlphaToCoverageEnabled_c" cPIsAlphaToCoverageEnabled'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setTransparentSortingEnabled_c" cPSetTransparentSortingEnabled'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getTransparentSortingEnabled_c" cPGetTransparentSortingEnabled'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setTransparentSortingForced_c" cPSetTransparentSortingForced'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getTransparentSortingForced_c" cPGetTransparentSortingForced'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setIteratePerLight_c" cPSetIteratePerLight'_ :: ((HG3DClassPtr) -> (CInt -> (CInt -> (CInt -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getIteratePerLight_c" cPGetIteratePerLight'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getRunOnlyForOneLightType_c" cPGetRunOnlyForOneLightType'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getOnlyLightType_c" cPGetOnlyLightType'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setLightCountPerIteration_c" cPSetLightCountPerIteration'_ :: ((HG3DClassPtr) -> (CUInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getLightCountPerIteration_c" cPGetLightCountPerIteration'_ :: ((HG3DClassPtr) -> ((Ptr CUInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getParent_c" cPGetParent'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getResourceGroup_c" cPGetResourceGroup'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setVertexProgram_c" cPSetVertexProgram'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (CInt -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getVertexProgramName_c" cPGetVertexProgramName'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setShadowCasterVertexProgram_c" cPSetShadowCasterVertexProgram'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getShadowCasterVertexProgramName_c" cPGetShadowCasterVertexProgramName'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setShadowReceiverVertexProgram_c" cPSetShadowReceiverVertexProgram'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setShadowReceiverFragmentProgram_c" cPSetShadowReceiverFragmentProgram'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getShadowReceiverVertexProgramName_c" cPGetShadowReceiverVertexProgramName'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getShadowReceiverFragmentProgramName_c" cPGetShadowReceiverFragmentProgramName'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setFragmentProgram_c" cPSetFragmentProgram'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (CInt -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getFragmentProgramName_c" cPGetFragmentProgramName'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setGeometryProgram_c" cPSetGeometryProgram'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (CInt -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getGeometryProgramName_c" cPGetGeometryProgramName'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP__split_c" cPSplit'_ :: ((HG3DClassPtr) -> (CUInt -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP__notifyIndex_c" cPNotifyIndex'_ :: ((HG3DClassPtr) -> (CUInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP__prepare_c" cPPrepare'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP__unprepare_c" cPUnprepare'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP__load_c" cPLoad'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP__unload_c" cPUnload'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_isLoaded_c" cPIsLoaded'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getHash_c" cPGetHash'_ :: ((HG3DClassPtr) -> ((Ptr CUInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP__dirtyHash_c" cPDirtyHash'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP__recalculateHash_c" cPRecalculateHash'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP__notifyNeedsRecompile_c" cPNotifyNeedsRecompile'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP__getTextureUnitWithContentTypeIndex_c" cPGetTextureUnitWithContentTypeIndex'_ :: ((HG3DClassPtr) -> (CInt -> (CUInt -> ((Ptr CUInt) -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setTextureFiltering_c" cPSetTextureFiltering'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setTextureAnisotropy_c" cPSetTextureAnisotropy'_ :: ((HG3DClassPtr) -> (CUInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setNormaliseNormals_c" cPSetNormaliseNormals'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getNormaliseNormals_c" cPGetNormaliseNormals'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_queueForDeletion_c" cPQueueForDeletion'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_isAmbientOnly_c" cPIsAmbientOnly'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setPassIterationCount_c" cPSetPassIterationCount'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getPassIterationCount_c" cPGetPassIterationCount'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setLightScissoringEnabled_c" cPSetLightScissoringEnabled'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getLightScissoringEnabled_c" cPGetLightScissoringEnabled'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setLightClipPlanesEnabled_c" cPSetLightClipPlanesEnabled'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getLightClipPlanesEnabled_c" cPGetLightClipPlanesEnabled'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_setIlluminationStage_c" cPSetIlluminationStage'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassPass.chs.h cP_getIlluminationStage_c" cPGetIlluminationStage'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))