Object3D.hs

{-# LANGUAGE FlexibleContexts #-}

-- 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-2013 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.

-- Object3D.hs

-- | Creating and managing 3D objects functionality for Graphics3D module
module HGamer3D.Graphics3D.Object3D (

    -- * Mesh creation functions, standard meshes
	sphereMesh,
	cubeMesh,
        planeMesh,
	resourceMesh,
        
    -- * Mesh creation functions, special meshes    
	colouredCubeMesh,
	colouredLineMesh,
	rainbowCubeMesh,
	
    -- * clone objects from meshes    
        object3DFromMesh,
        object3DFromObjects,
        
    -- * Special movements
	yaw3D,
	roll3D,
	pitch3D
) 

where

import HGamer3D.Data
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.ClassHG3DUtilities as HG3DUtils

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.Operation3D
import HGamer3D.Graphics3D.Types
import HGamer3D.Graphics3D.Engine

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


				
-- set the material of an Ogre entity, used during mesh creation
_setMaterial :: HG3DClass -- ^ 3d object
                     -> Material -- ^ material
                     -> IO ()
_setMaterial entity material = do
  case material of
    (ResourceMaterial name) -> do
	Entity.setMaterialName entity name "General"
	return ()
        

-- | creates a Sphere Mesh, from which Spheres can be cloned
sphereMesh :: Mesh -- ^ the mesh created
sphereMesh = SphereMesh
  
-- | creates a Cube Mesh, from which Cubes can be cloned
cubeMesh :: Mesh -- ^ the mesh created
cubeMesh = CubeMesh

-- | creates a Plane Mesh, from which Planes can be cloned
planeMesh :: Mesh -- ^ the mesh created
planeMesh = PlaneMesh

-- | creates a Plane Mesh, from which Planes can be cloned
resourceMesh :: String -- ^ the name of the resource
                -> Mesh -- ^ the mesh created
resourceMesh resourceName = ResourceMesh resourceName
        
-- | clones a 3D object from a mesh
object3DFromMesh :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D
                          -> Mesh -- ^ mesh used for creation
                          -> Maybe Material -- ^ a material to be applied, if needed
                          -> Bool -- ^ flag, build tangent vectors, if set
                          -> IO Object3D -- ^ created 3d object
object3DFromMesh g3ds mesh mbMaterial buildTV = do
	let (SceneManager scm) = (g3dsSceneManager g3ds)
        -- create the entity from the mesh
        entity <- case mesh of
          CubeMesh -> SceneManager.createEntity6 scm PT_CUBE
          SphereMesh -> SceneManager.createEntity6 scm PT_SPHERE
          PlaneMesh -> SceneManager.createEntity6 scm PT_PLANE
          ResourceMesh resourceName -> SceneManager.createEntity3 scm resourceName
          ManualMesh meshName -> SceneManager.createEntity3 scm meshName
        -- create tangent vectors
        if buildTV then 
          HG3DUtils.buildTangentVectors entity
          else
            return ()
        -- apply material, if needed, wanted
        case mbMaterial of
          Just material -> _setMaterial entity material
          Nothing -> return ()
	-- now create node and attach entity to it
	rootNode <- SceneManager.getRootSceneNode scm
	let vzero = Vec3 0.0 0.0 0.0
	let qident = Q (Vec4 1.0 0.0 0.0 0.0)
	node <- SceneNode.createChildSceneNode rootNode vzero qident
	SceneNode.attachObject node entity
	-- return object
	return (SingleObject3D mesh node)
		
_getNode :: Object3D -> HG3DClass
_getNode (SingleObject3D entity node) = node
_getNode (CombinedObject3D objects node) = node

-- | combine 3D objects to a new object
object3DFromObjects :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D
                       ->[Object3D] -- ^ A list of objects, to be grouped
                       -> IO Object3D -- ^ The return value is a new 3d object.
object3DFromObjects g3ds listObjects = do
	let (SceneManager scm) = (g3dsSceneManager g3ds)
	rootNode <- SceneManager.getRootSceneNode scm
	let vzero = Vec3 0.0 0.0 0.0
	let qident = Q (Vec4 1.0 0.0 0.0 0.0)
	node <- SceneNode.createChildSceneNode rootNode vzero qident
	sequence_ (map ( \object -> do
                            let objectnode = _getNode object
                            parent <- Node.getParent objectnode
                            Node.removeChild2 parent objectnode
                            Node.addChild node objectnode
                            return ()   )                     listObjects)
	return ( CombinedObject3D listObjects node)
		
-- | Creates a line with a colour from start and end point (mesh as object template)
colouredLineMesh :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D
                          -> Vec3 -- ^ start point
                          -> Vec3 -- ^ end point 
                          -> Colour -- ^ colour
                          -> IO Mesh -- ^ line mesh
colouredLineMesh g3ds vStart vEnd colour = do
	uid <- nextUniqueName (g3dsUniqueName g3ds)
	let (SceneManager scm) = (g3dsSceneManager g3ds)
	let lineName = "L" ++ uid
	let meshName = "M" ++ uid
        
	mo <- SceneManager.createManualObject scm lineName
	ManualObject.begin mo "BaseWhiteNoLighting" OT_LINE_LIST "General"
	ManualObject.position mo vStart
	ManualObject.colour mo colour
	ManualObject.position mo vEnd
	ManualObject.colour mo colour
	ManualObject.end mo
	ManualObject.convertToMesh mo meshName "General"
	return $ ManualMesh meshName

-- |Creates a coloured cube mesh
colouredCubeMesh :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D
                          -> Colour -- ^ colour
                          -> IO Mesh -- ^ cube mesh
colouredCubeMesh g3ds colour = do
	uid <- nextUniqueName (g3dsUniqueName g3ds)
	let (SceneManager scm) = (g3dsSceneManager g3ds)
	let cubeName = "C" ++ uid
	let meshName = "M" ++ uid
        
	mo <- SceneManager.createManualObject scm cubeName
	
	-- basic parameters
	let lsize = 1.0
	let cp = 1.0 * lsize
	let cm = -1.0 * lsize
	
	ManualObject.begin mo "BaseWhiteNoLighting" OT_TRIANGLE_LIST "General"
	
	ManualObject.position2 mo cm cp cm   -- a vertex
	ManualObject.colour mo colour
	ManualObject.position2 mo cp cp cm   -- a vertex
	ManualObject.colour mo colour
	ManualObject.position2 mo cp cm cm   -- a vertex
	ManualObject.colour mo colour
	ManualObject.position2 mo cm cm cm   -- a vertex
	ManualObject.colour mo colour
	
	ManualObject.position2 mo cm cp cp   -- a vertex
	ManualObject.colour mo colour
	ManualObject.position2 mo cp cp cp   -- a vertex
	ManualObject.colour mo colour
	ManualObject.position2 mo cp cm cp   -- a vertex
	ManualObject.colour mo colour
	ManualObject.position2 mo cm cm cp   -- a vertex
	ManualObject.colour mo colour
	
	ManualObject.triangle mo 0 1 2
	ManualObject.triangle mo 2 3 0
	ManualObject.triangle mo 4 6 5
	ManualObject.triangle mo 6 4 7
	
	ManualObject.triangle mo 0 4 5 
	ManualObject.triangle mo 5 1 0
	ManualObject.triangle mo 2 6 7
	ManualObject.triangle mo 7 3 2

	ManualObject.triangle mo 0 7 4
	ManualObject.triangle mo 7 0 3
	ManualObject.triangle mo 1 5 6
	ManualObject.triangle mo 6 2 1
	
	ManualObject.end mo
	
	ManualObject.convertToMesh mo meshName "General"
	return $ ManualMesh meshName


-- | Creates a rainbow coloured cube mesh
rainbowCubeMesh :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D
                   -> IO Mesh
rainbowCubeMesh  g3ds = do
	uid <- nextUniqueName (g3dsUniqueName g3ds)
	let (SceneManager scm) = (g3dsSceneManager g3ds)
	let cubeName = "C" ++ uid
	let meshName = "M" ++ uid
	let materialName = "BaseWhiteNoLighting"
	
	mo <- SceneManager.createManualObject scm cubeName
	
	-- basic parameters
	let lsize = 1.0
	let cp = 1.0 * lsize
	let cm = -1.0 * lsize

	ManualObject.begin mo "BaseWhiteNoLighting" OT_TRIANGLE_LIST "General"
	
	sequence $ map (\(x, y, z, c) -> liftIO (ManualObject.position2 mo x y z) >> liftIO (ManualObject.colour mo c) ) [
		(cm, cp, cm, (Colour 0.0 1.0 0.0 1.0) ),
		(cp, cp, cm, (Colour 1.0 1.0 0.0 1.0) ),
		(cp, cm, cm, (Colour 1.0 0.0 0.0 1.0) ),
		(cm, cm, cm, (Colour 0.0 0.0 0.0 1.0) ),
		
		(cm, cp, cp, (Colour 0.0 1.0 1.0 1.0) ),
		(cp, cp, cp, (Colour 1.0 1.0 1.0 1.0) ),
		(cp, cm, cp, (Colour 1.0 0.0 1.0 1.0) ),
		(cm, cm, cp, (Colour 0.0 0.0 1.0 1.0) )   ]
	
	sequence $ map (\(x,y,z) -> ManualObject.triangle mo x y z) [
		(0, 1, 2),
		(2, 3, 0),
		(4, 6, 5),
		(6, 4, 7),
		
		(0, 4, 5),
		(5, 1, 0),
		(2, 6, 7),
		(7, 3, 2),
		
		(0, 7, 4),
		(7, 0, 3),
		(1, 5, 6),
		(6, 2, 1) ]
	
	ManualObject.end mo
	ManualObject.convertToMesh mo meshName "General"
	return $ ManualMesh meshName
        
instance Position3D Object3D where

	position3D obj = do
		pos <- Node.getPosition (_getNode obj)
		return (pos)
		
	positionTo3D obj pos = do
		Node.setPosition  (_getNode obj) pos
		return ()
	
instance Scale3D Object3D where

	scale3D obj = do
		pos <- Node.getScale  (_getNode obj)
		return (pos)
		
	scaleTo3D obj pos = do
		Node.setScale  (_getNode obj) pos
		return ()
	
instance Orientation3D Object3D where

	orientation3D obj = do
		q <- Node.getOrientation  (_getNode obj)
		let uq = mkNormal q
		return uq
	
	orientationTo3D obj uq = do
		Node.setOrientation  (_getNode obj) (fromNormal uq)
		return ()