Light.hs

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_HADDOCK hide #-}

-- This source file is part of HGamer3D
-- (A project to enable 3D game development in Haskell)
-- For the latest info, see http://www.hgamer3d.org
--
-- (c) 2011-2014 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.

-- Graphics3D/Internal/Light.hs

-- | Creating and managing Light in Base API. Internal implementation module. Public API is in HGamer3D.Graphics3D.


module HGamer3D.Graphics3D.Internal.Light 
where

import Data.Maybe

import HGamer3D.Data
import HGamer3D.Data.HG3DClass
import HGamer3D.Util

import GHC.Ptr

import HGamer3D.Bindings.Ogre.ClassPtr
import HGamer3D.Bindings.Ogre.Utils

import HGamer3D.Bindings.Ogre.StructColour
import HGamer3D.Bindings.Ogre.StructSharedPtr

import HGamer3D.Bindings.Ogre.EnumSceneType
import HGamer3D.Bindings.Ogre.EnumNodeTransformSpace
import HGamer3D.Bindings.Ogre.EnumLightType

--import HGamer3D.Bindings.Ogre.ClassCamera as Camera
--import HGamer3D.Bindings.Ogre.ClassRoot as Root
import HGamer3D.Bindings.Ogre.ClassLight as Light
import HGamer3D.Bindings.Ogre.ClassNode as Node
import HGamer3D.Bindings.Ogre.ClassSceneManager as SceneManager
import HGamer3D.Bindings.Ogre.ClassSceneNode as SceneNode
import HGamer3D.Bindings.Ogre.ClassRenderTarget as RenderTarget
import HGamer3D.Bindings.Ogre.ClassRenderWindow as RenderWindow
import HGamer3D.Bindings.Ogre.ClassResourceGroupManager as ResourceGroupManager
import HGamer3D.Bindings.Ogre.ClassTextureManager as TextureManager
import HGamer3D.Bindings.Ogre.ClassControllerManager as ControllerManager
import HGamer3D.Bindings.Ogre.ClassViewport as Viewport
import HGamer3D.Bindings.Ogre.ClassFrustum as Frustum
import HGamer3D.Bindings.Ogre.ClassAnimationState as AnimationState
import HGamer3D.Bindings.Ogre.ClassEntity as Entity
import HGamer3D.Bindings.Ogre.ClassControllerManager as ControllerManager
import HGamer3D.Bindings.Ogre.ClassWindowEventUtilities as WindowEventUtilities	

import HGamer3D.Bindings.Ogre.ClassManualObject as ManualObject
import HGamer3D.Bindings.Ogre.EnumRenderOperationOperationType
import HGamer3D.Bindings.Ogre.StructHG3DClass
import HGamer3D.Bindings.Ogre.EnumSceneManagerPrefabType

import HGamer3D.Data.HG3DClass
import HGamer3D.Data.Transform3D
import HGamer3D.Graphics3D.Internal.Base

import Control.Monad
import Control.Monad.Trans
import Control.Monad.IO.Class
import Control.Monad.State.Class

import qualified HGamer3D.Graphics3D.Schema.Light as L


-- | The light.
data Light = Light ONode OLight L.Light

instance HasNode Light where
  getNode (Light node _ _) = node

instance HasPosition Light where
	position obj = Node.getPosition (getNode' obj)
	positionTo obj pos = Node.setPosition  (getNode' obj) pos
	
instance HasOrientation Light where
	orientation obj = do
		q <- Node.getOrientation  (getNode' obj)
		let uq = mkNormal q
		return uq
	orientationTo obj uq = do
		Node.setOrientation  (getNode' obj) (fromNormal uq)
		return ()

addLight :: Graphics3DSystem -> L.Light -> IO Light
addLight g3ds schema = do
  let (SceneManager scm) = (g3dsSceneManager g3ds)
  let (L.Light diffuse@(Colour r g b _) specular@(Colour r' g' b' _) ltype) = schema
  lightName <- nextUniqueName (g3dsUniqueName g3ds)
  light <- SceneManager.createLight scm lightName
  Light.setDiffuseColour light r g b 
  Light.setSpecularColour light r' g' b' 
  case ltype of      
    L.PointLight -> Light.setType light LT_POINT
    L.DirectionalLight dir -> do
      Light.setType light LT_DIRECTIONAL
      Light.setDirection2 light dir
    L.SpotLight dir inner outer -> do
      Light.setType light LT_SPOTLIGHT
      Light.setDirection2 light dir
      Light.setSpotlightInnerAngle light (fromAngle inner)
      Light.setSpotlightOuterAngle light (fromAngle outer)
  let l = OL light
  rn <- _getRootNode g3ds
  n <- _createSubNode rn
  attachToNode l n
  return $ Light n l schema

removeLight :: Graphics3DSystem -> Light -> IO ()
removeLight g3ds (Light n@(ON node) l@(OL light) schema) = do
  let (SceneManager scm) = (g3dsSceneManager g3ds)
  detachFromNode l n
  (ON rn) <- _getRootNode g3ds
  Node.removeChild2 rn node
  SceneManager.destroyLight2 scm light 

updateLight :: Graphics3DSystem -> Light -> L.Light -> IO Light
updateLight  g3ds l schema = do
  let (SceneManager scm) = (g3dsSceneManager g3ds)
  removeLight g3ds l
  addLight g3ds schema
    
-- | Ambient light is present everywhere, this function creates it and sets the colour of it.
-- There is no light object, since movement, rotation, scaling would make no sense anyhow.
setAmbientLight :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D
                   -> Colour -> IO () 
setAmbientLight g3ds colour = do
	let (SceneManager scm) = (g3dsSceneManager g3ds)
        SceneManager.setAmbientLight scm colour

-- | creates a point light at a specific location
pointLight :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D
                    -> Colour -- ^ diffuse Color of the light
                    -> Colour -- ^ specular Color of the light
                    -> Vec3 -- ^ Position, where light is created
                    -> IO (Light) -- ^ The light object
pointLight g3ds diffuse specular pos = do
  let schema = L.Light diffuse specular L.PointLight
  light <- addLight g3ds schema
  positionTo light pos
  return $ light

-- | creates a spot light at a specific location
spotLight :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D
                    -> Colour -- ^ diffuse Colour of the light
                    -> Colour -- ^ specular Colour of the light
                    -> Vec3 -- ^ Position, where light is created
                    -> Vec3 -- ^ Direction, where light points
                    -> Angle -- ^ inner Angle of cone (5..355 degrees)
                    -> Angle -- ^ outer Angle of cone (5..355 degrees)
                    -> IO Light -- ^ The light object
spotLight g3ds diffuse specular pos dir inner outer = do
  let schema = L.Light diffuse specular (L.SpotLight dir inner outer)
  light <- addLight g3ds schema
  positionTo light pos
  return $ light

-- | sets spotlight direction
spotLightSetDirection :: Graphics3DSystem -> Light -> Vec3 -> IO Light
spotLightSetDirection g3ds light dir' = do
  let (Light n l schema) = light
  let (L.Light diffuse@(Colour r g b _) specular@(Colour r' g' b' _) ltype) = schema
  case ltype of
    (L.SpotLight dir inner outer) -> updateLight g3ds light (L.Light diffuse specular (L.SpotLight dir' inner outer))
    _ -> return light

-- | creates a directional light at a specific location
directionalLight :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D
                    -> Colour -- ^ diffuse Colour of the light
                    -> Colour -- ^ specular Colour of light
                    -> Vec3 -- ^ direction of light
                    -> IO (Light) -- ^ The light object
directionalLight g3ds diffuse specular dir = do
  let schema = L.Light diffuse specular (L.DirectionalLight dir)
  light <- addLight g3ds schema
  return $ light