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


-- ClassMaterial.chs

-- 

module HGamer3D.Bindings.Ogre.ClassMaterial where

import Foreign
import Foreign.Ptr
import Foreign.C

import HGamer3D.Data.HG3DClass
import HGamer3D.Data.Vector
import HGamer3D.Data.Colour
import HGamer3D.Data.Angle

import HGamer3D.Bindings.Ogre.Utils
{-# LINE 40 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}
import HGamer3D.Bindings.Ogre.ClassPtr
{-# LINE 41 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}
import HGamer3D.Bindings.Ogre.StructHG3DClass
{-# LINE 42 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}
import HGamer3D.Bindings.Ogre.StructSharedPtr
{-# LINE 43 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}
import HGamer3D.Bindings.Ogre.StructColour
{-# LINE 44 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.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 49 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Determines if the material has any transparency with the rest of the scene (derived from whether any Techniques say they involve transparency). 
isTransparent :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Bool)
 -- ^ 
isTransparent a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  isTransparent'_ a1' a2' >>= \res ->
  peekBoolUtil  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 54 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Sets whether objects using this material will receive shadows. This method allows a material to opt out of receiving shadows, if it would otherwise do so. Shadows will not be cast on any objects unless the scene is set up to support shadows (SceneManager::setShadowTechniqueTransparent materials never receive shadows despite this setting. The default is to receive shadows. 
setReceiveShadows :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Bool  -- ^ enabled
  ->  IO ()
 -- ^ 
setReceiveShadows a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromBool a2} in 
  setReceiveShadows'_ a1' a2' >>= \res ->
  return ()
{-# LINE 59 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Returns whether or not objects using this material will receive shadows. 
getReceiveShadows :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Bool)
 -- ^ 
getReceiveShadows a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getReceiveShadows'_ a1' a2' >>= \res ->
  peekBoolUtil  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 64 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Sets whether objects using this material be classified as opaque to the shadow caster system. This method allows a material to cast a shadow, even if it is transparent. By default, transparent materials neither cast nor receive shadows. Shadows will not be cast on any objects unless the scene is set up to support shadows (SceneManager::setShadowTechnique
setTransparencyCastsShadows :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Bool  -- ^ enabled
  ->  IO ()
 -- ^ 
setTransparencyCastsShadows a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromBool a2} in 
  setTransparencyCastsShadows'_ a1' a2' >>= \res ->
  return ()
{-# LINE 69 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Returns whether or not objects using this material be classified as opaque to the shadow caster system. 
getTransparencyCastsShadows :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Bool)
 -- ^ 
getTransparencyCastsShadows a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getTransparencyCastsShadows'_ a1' a2' >>= \res ->
  peekBoolUtil  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 74 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Retrieves the number of techniques. 
getNumTechniques :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Int)
 -- ^ 
getNumTechniques a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getNumTechniques'_ a1' a2' >>= \res ->
  peekIntConv  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 79 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Removes the technique at the given index. 
removeTechnique :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ index
  ->  IO ()
 -- ^ 
removeTechnique a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  removeTechnique'_ a1' a2' >>= \res ->
  return ()
{-# LINE 84 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Removes all the techniques in this Material
removeAllTechniques :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO ()
 -- ^ 
removeAllTechniques a1 =
  withHG3DClass a1 $ \a1' -> 
  removeAllTechniques'_ a1' >>= \res ->
  return ()
{-# LINE 88 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Retrieves the number of supported techniques. 
getNumSupportedTechniques :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Int)
 -- ^ 
getNumSupportedTechniques a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getNumSupportedTechniques'_ a1' a2' >>= \res ->
  peekIntConv  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 93 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Gets a string explaining why any techniques are not supported. 
getUnsupportedTechniquesExplanation :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (String)
 -- ^ 
getUnsupportedTechniquesExplanation a1 =
  withHG3DClass a1 $ \a1' -> 
  alloc64k $ \a2' -> 
  getUnsupportedTechniquesExplanation'_ a1' a2' >>= \res ->
  peekCString  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 98 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Gets the number of levels-of-detail this material has in the given scheme, based on Technique::setLodIndex. Note that this will not be up to date until the material has been compiled. 
getNumLodLevels :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ schemeIndex
  ->  IO (Int)
 -- ^ 
getNumLodLevels a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  getNumLodLevels'_ a1' a2' a3' >>= \res ->
  peekIntConv  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 104 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Gets the number of levels-of-detail this material has in the given scheme, based on Technique::setLodIndex. Note that this will not be up to date until the material has been compiled. 
getNumLodLevels2 :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  String  -- ^ schemeName
  ->  IO (Int)
 -- ^ 
getNumLodLevels2 a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  getNumLodLevels2'_ a1' a2' a3' >>= \res ->
  peekIntConv  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 110 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Creates a new copy of this material with the same settings but a new name. 
clone :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  String  -- ^ newName - The name for the cloned material 
  ->  Bool  -- ^ changeGroup - If true, the resource group of the clone is changed 
  ->  String  -- ^ newGroup - Only required if changeGroup is true; the new group to assign 
  ->  IO (SharedPtr)
 -- ^ 
clone a1 a2 a3 a4 =
  withHG3DClass a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  let {a3' = fromBool a3} in 
  withCString a4 $ \a4' -> 
  alloca $ \a5' -> 
  clone'_ a1' a2' a3' a4' a5' >>= \res ->
  peekSharedPtr  a5'>>= \a5'' -> 
  return (a5'')
{-# LINE 118 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Copies the details of this material into another, preserving the target's handle and name (unlike operator=) but copying everything else. 
copyDetailsTo :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (SharedPtr)
 -- ^ mat - Weak reference to material which will receive this material's settings. 
copyDetailsTo a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  copyDetailsTo'_ a1' a2' >>= \res ->
  peekSharedPtr  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 123 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | 'Compiles' this MaterialCompiling a material involves determining which Techniques are supported on the card on which OGRE is currently running, and for fixed-function Passes within those Techniques, splitting the passes down where they contain more TextureUnitState instances than the current card has texture units. This process is automatically done when the Material
compile :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Bool  -- ^ autoManageTextureUnits - If true, when a fixed function pass has too many TextureUnitState entries than the card has texture units, the Pass in question will be split into more than one Pass in order to emulate the Pass. If you set this to false and this situation arises, an Exception will be thrown. 
  ->  IO ()
 -- ^ 
compile a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromBool a2} in 
  compile'_ a1' a2' >>= \res ->
  return ()
{-# LINE 128 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Sets the point size properties for every Pass in every Technique. This property has been moved to the Pass class, which is accessible via the Technique. For simplicity, this method allows you to set these properties for every current Technique, and for every current Pass within those Techniques. If you need more precision, retrieve the Technique and Pass instances and set the property there. Pass::setPointSize 
setPointSize :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Float  -- ^ ps
  ->  IO ()
 -- ^ 
setPointSize a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = realToFrac a2} in 
  setPointSize'_ a1' a2' >>= \res ->
  return ()
{-# LINE 133 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Sets the ambient colour reflectance properties for every Pass in every Technique. This property has been moved to the Pass class, which is accessible via the Technique. For simplicity, this method allows you to set these properties for every current Technique, and for every current Pass within those Techniques. If you need more precision, retrieve the Technique and Pass instances and set the property there. Pass::setAmbient 
setAmbient :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Float  -- ^ red
  ->  Float  -- ^ green
  ->  Float  -- ^ blue
  ->  IO ()
 -- ^ 
setAmbient a1 a2 a3 a4 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = realToFrac a2} in 
  let {a3' = realToFrac a3} in 
  let {a4' = realToFrac a4} in 
  setAmbient'_ a1' a2' a3' a4' >>= \res ->
  return ()
{-# LINE 140 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Sets the ambient colour reflectance properties for every Pass in every Technique. This property has been moved to the Pass class, which is accessible via the Technique. For simplicity, this method allows you to set these properties for every current Technique, and for every current Pass within those Techniques. If you need more precision, retrieve the Technique and Pass instances and set the property there. Pass::setAmbient 
setAmbient2 :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Colour  -- ^ ambient
  ->  IO ()
 -- ^ 
setAmbient2 a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withColour a2 $ \a2' -> 
  setAmbient2'_ a1' a2' >>= \res ->
  return ()
{-# LINE 145 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Sets the diffuse colour reflectance properties of every Pass in every Technique. This property has been moved to the Pass class, which is accessible via the Technique. For simplicity, this method allows you to set these properties for every current Technique, and for every current Pass within those Techniques. If you need more precision, retrieve the Technique and Pass instances and set the property there. Pass::setDiffuse 
setDiffuse :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Float  -- ^ red
  ->  Float  -- ^ green
  ->  Float  -- ^ blue
  ->  Float  -- ^ alpha
  ->  IO ()
 -- ^ 
setDiffuse 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 
  setDiffuse'_ a1' a2' a3' a4' a5' >>= \res ->
  return ()
{-# LINE 153 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Sets the diffuse colour reflectance properties of every Pass in every Technique. This property has been moved to the Pass class, which is accessible via the Technique. For simplicity, this method allows you to set these properties for every current Technique, and for every current Pass within those Techniques. If you need more precision, retrieve the Technique and Pass instances and set the property there. Pass::setDiffuse 
setDiffuse2 :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Colour  -- ^ diffuse
  ->  IO ()
 -- ^ 
setDiffuse2 a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withColour a2 $ \a2' -> 
  setDiffuse2'_ a1' a2' >>= \res ->
  return ()
{-# LINE 158 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Sets the specular colour reflectance properties of every Pass in every Technique. This property has been moved to the Pass class, which is accessible via the Technique. For simplicity, this method allows you to set these properties for every current Technique, and for every current Pass within those Techniques. If you need more precision, retrieve the Technique and Pass instances and set the property there. Pass::setSpecular 
setSpecular :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Float  -- ^ red
  ->  Float  -- ^ green
  ->  Float  -- ^ blue
  ->  Float  -- ^ alpha
  ->  IO ()
 -- ^ 
setSpecular 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 
  setSpecular'_ a1' a2' a3' a4' a5' >>= \res ->
  return ()
{-# LINE 166 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Sets the specular colour reflectance properties of every Pass in every Technique. This property has been moved to the Pass class, which is accessible via the Technique. For simplicity, this method allows you to set these properties for every current Technique, and for every current Pass within those Techniques. If you need more precision, retrieve the Technique and Pass instances and set the property there. Pass::setSpecular 
setSpecular2 :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Colour  -- ^ specular
  ->  IO ()
 -- ^ 
setSpecular2 a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withColour a2 $ \a2' -> 
  setSpecular2'_ a1' a2' >>= \res ->
  return ()
{-# LINE 171 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Sets the shininess properties of every Pass in every Technique. This property has been moved to the Pass class, which is accessible via the Technique. For simplicity, this method allows you to set these properties for every current Technique, and for every current Pass within those Techniques. If you need more precision, retrieve the Technique and Pass instances and set the property there. Pass::setShininess 
setShininess :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Float  -- ^ val
  ->  IO ()
 -- ^ 
setShininess a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = realToFrac a2} in 
  setShininess'_ a1' a2' >>= \res ->
  return ()
{-# LINE 176 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Sets the amount of self-illumination of every Pass in every Technique. This property has been moved to the Pass class, which is accessible via the Technique. For simplicity, this method allows you to set these properties for every current Technique, and for every current Pass within those Techniques. If you need more precision, retrieve the Technique and Pass instances and set the property there. Pass::setSelfIllumination 
setSelfIllumination :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Float  -- ^ red
  ->  Float  -- ^ green
  ->  Float  -- ^ blue
  ->  IO ()
 -- ^ 
setSelfIllumination a1 a2 a3 a4 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = realToFrac a2} in 
  let {a3' = realToFrac a3} in 
  let {a4' = realToFrac a4} in 
  setSelfIllumination'_ a1' a2' a3' a4' >>= \res ->
  return ()
{-# LINE 183 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Sets the amount of self-illumination of every Pass in every Technique. This property has been moved to the Pass class, which is accessible via the Technique. For simplicity, this method allows you to set these properties for every current Technique, and for every current Pass within those Techniques. If you need more precision, retrieve the Technique and Pass instances and set the property there. Pass::setSelfIllumination 
setSelfIllumination2 :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Colour  -- ^ selfIllum
  ->  IO ()
 -- ^ 
setSelfIllumination2 a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withColour a2 $ \a2' -> 
  setSelfIllumination2'_ a1' a2' >>= \res ->
  return ()
{-# LINE 188 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Sets whether or not each Pass renders with depth-buffer checking on or not. This property has been moved to the Pass class, which is accessible via the Technique. For simplicity, this method allows you to set these properties for every current Technique, and for every current Pass within those Techniques. If you need more precision, retrieve the Technique and Pass instances and set the property there. Pass::setDepthCheckEnabled 
setDepthCheckEnabled :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Bool  -- ^ enabled
  ->  IO ()
 -- ^ 
setDepthCheckEnabled a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromBool a2} in 
  setDepthCheckEnabled'_ a1' a2' >>= \res ->
  return ()
{-# LINE 193 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Sets whether or not each Pass renders with depth-buffer writing on or not. This property has been moved to the Pass class, which is accessible via the Technique. For simplicity, this method allows you to set these properties for every current Technique, and for every current Pass within those Techniques. If you need more precision, retrieve the Technique and Pass instances and set the property there. Pass::setDepthWriteEnabled 
setDepthWriteEnabled :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Bool  -- ^ enabled
  ->  IO ()
 -- ^ 
setDepthWriteEnabled a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromBool a2} in 
  setDepthWriteEnabled'_ a1' a2' >>= \res ->
  return ()
{-# LINE 198 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Sets whether or not colour buffer writing is enabled for each Pass. This property has been moved to the Pass class, which is accessible via the Technique. For simplicity, this method allows you to set these properties for every current Technique, and for every current Pass within those Techniques. If you need more precision, retrieve the Technique and Pass instances and set the property there. Pass::setColourWriteEnabled 
setColourWriteEnabled :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Bool  -- ^ enabled
  ->  IO ()
 -- ^ 
setColourWriteEnabled a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromBool a2} in 
  setColourWriteEnabled'_ a1' a2' >>= \res ->
  return ()
{-# LINE 203 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Sets whether or not dynamic lighting is enabled for every Pass. This property has been moved to the Pass class, which is accessible via the Technique. For simplicity, this method allows you to set these properties for every current Technique, and for every current Pass within those Techniques. If you need more precision, retrieve the Technique and Pass instances and set the property there. Pass::setLightingEnabled 
setLightingEnabled :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Bool  -- ^ enabled
  ->  IO ()
 -- ^ 
setLightingEnabled a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromBool a2} in 
  setLightingEnabled'_ a1' a2' >>= \res ->
  return ()
{-# LINE 208 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Sets the depth bias to be used for each Pass. This property has been moved to the Pass class, which is accessible via the Technique. For simplicity, this method allows you to set these properties for every current Technique, and for every current Pass within those Techniques. If you need more precision, retrieve the Technique and Pass instances and set the property there. Pass::setDepthBias 
setDepthBias :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Float  -- ^ constantBias
  ->  Float  -- ^ slopeScaleBias
  ->  IO ()
 -- ^ 
setDepthBias a1 a2 a3 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = realToFrac a2} in 
  let {a3' = realToFrac a3} in 
  setDepthBias'_ a1' a2' a3' >>= \res ->
  return ()
{-# LINE 214 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Sets the anisotropy level to be used for all textures. This property has been moved to the TextureUnitState class, which is accessible via the Technique and Pass. For simplicity, this method allows you to set these properties for every current TeextureUnitState, If you need more precision, retrieve the Technique, Pass and TextureUnitState instances and set the property there. TextureUnitState::setTextureAnisotropy 
setTextureAnisotropy :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ maxAniso
  ->  IO ()
 -- ^ 
setTextureAnisotropy a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  setTextureAnisotropy'_ a1' a2' >>= \res ->
  return ()
{-# LINE 219 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | 'Touches' the resource to indicate it has been used. 
touch :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO ()
 -- ^ 
touch a1 =
  withHG3DClass a1 $ \a1' -> 
  touch'_ a1' >>= \res ->
  return ()
{-# LINE 223 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}

-- | Gets the compilation status of the material. 
getCompilationRequired :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Bool)
 -- ^ return value - True if the material needs recompilation.     
getCompilationRequired a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getCompilationRequired'_ a1' a2' >>= \res ->
  peekBoolUtil  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 228 ".\\HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs" #-}


foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_destruct"
  delete'_ :: ((HG3DClassPtr) -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_isTransparent"
  isTransparent'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_setReceiveShadows"
  setReceiveShadows'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_getReceiveShadows"
  getReceiveShadows'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_setTransparencyCastsShadows"
  setTransparencyCastsShadows'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_getTransparencyCastsShadows"
  getTransparencyCastsShadows'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_getNumTechniques"
  getNumTechniques'_ :: ((HG3DClassPtr) -> ((Ptr CUShort) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_removeTechnique"
  removeTechnique'_ :: ((HG3DClassPtr) -> (CUShort -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_removeAllTechniques"
  removeAllTechniques'_ :: ((HG3DClassPtr) -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_getNumSupportedTechniques"
  getNumSupportedTechniques'_ :: ((HG3DClassPtr) -> ((Ptr CUShort) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_getUnsupportedTechniquesExplanation"
  getUnsupportedTechniquesExplanation'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_getNumLodLevels"
  getNumLodLevels'_ :: ((HG3DClassPtr) -> (CUShort -> ((Ptr CUShort) -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_getNumLodLevels2"
  getNumLodLevels2'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((Ptr CUShort) -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_clone"
  clone'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (CInt -> ((Ptr CChar) -> ((SharedPtrPtr) -> (IO ()))))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_copyDetailsTo"
  copyDetailsTo'_ :: ((HG3DClassPtr) -> ((SharedPtrPtr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_compile"
  compile'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_setPointSize"
  setPointSize'_ :: ((HG3DClassPtr) -> (CFloat -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_setAmbient"
  setAmbient'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (IO ())))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_setAmbient2"
  setAmbient2'_ :: ((HG3DClassPtr) -> ((ColourPtr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_setDiffuse"
  setDiffuse'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (CFloat -> (IO ()))))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_setDiffuse2"
  setDiffuse2'_ :: ((HG3DClassPtr) -> ((ColourPtr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_setSpecular"
  setSpecular'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (CFloat -> (IO ()))))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_setSpecular2"
  setSpecular2'_ :: ((HG3DClassPtr) -> ((ColourPtr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_setShininess"
  setShininess'_ :: ((HG3DClassPtr) -> (CFloat -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_setSelfIllumination"
  setSelfIllumination'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (IO ())))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_setSelfIllumination2"
  setSelfIllumination2'_ :: ((HG3DClassPtr) -> ((ColourPtr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_setDepthCheckEnabled"
  setDepthCheckEnabled'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_setDepthWriteEnabled"
  setDepthWriteEnabled'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_setColourWriteEnabled"
  setColourWriteEnabled'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_setLightingEnabled"
  setLightingEnabled'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_setDepthBias"
  setDepthBias'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_setTextureAnisotropy"
  setTextureAnisotropy'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_touch"
  touch'_ :: ((HG3DClassPtr) -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassMaterial.chs.h ogre_mtrl_getCompilationRequired"
  getCompilationRequired'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))