Shapes.hs

{-# LANGUAGE FlexibleInstances #-}
{-# 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-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.

-- Graphics3D/Internal/Object3D.hs

-- | Creating and managing 3D objects functionality for Graphics3D module, internal implemenatation module. Public API is HGamer3D.Graphics3D.
module HGamer3D.Graphics3D.Internal.Shapes 

where

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.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.Transform3D
import HGamer3D.Graphics3D.Internal.Base

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

import HGamer3D.Graphics3D.Schema.Material
import HGamer3D.Graphics3D.Schema.Geometry
import HGamer3D.Graphics3D.Schema.Figure
import HGamer3D.Graphics3D.Internal.PlatonShapes


{- -------------------------------------------------------------------------------
   EngineItem for Geometry
   ------------------------------------------------------------------------------- -}

-- helper functions

_createGeometry :: Graphics3DSystem -> Geometry -> IO OEntity
_createGeometry g3ds geo = do
  let (SceneManager scm) = (g3dsSceneManager g3ds)
  entity <- case geo of
    ResourceGeometry s -> SceneManager.createEntity3 scm s
    Cube -> SceneManager.createEntity6 scm PT_CUBE
    Sphere -> SceneManager.createEntity6 scm PT_SPHERE
    Ikosaeder -> ikosaederE g3ds white
    Dodekaeder -> dodekaederE g3ds white
    Plane -> SceneManager.createEntity6 scm PT_PLANE
    _ -> error "HGamer3D.Graphics3D.Internal.Shapes._createMesh: Geo not implemented"
  let rE = OE entity
  if (geo /= Dodekaeder) && (geo /= Ikosaeder) then
      _buildTV rE
      else return ()
  return $ rE

_buildTV :: OEntity -> IO ()
_buildTV (OE entity) = HG3DUtils.buildTangentVectors entity


{- -------------------------------------------------------------------------------
   EngineItem for Figure
   ------------------------------------------------------------------------------- -}

_createResourceFigure :: Graphics3DSystem -> String -> IO OEntity
_createResourceFigure g3ds name = do
  let (SceneManager scm) = (g3dsSceneManager g3ds)
  -- create the entity from the mesh
  entity <- SceneManager.createEntity3 scm name
  return $ OE entity

_setMaterial :: OEntity -> Material -> IO ()
_setMaterial (OE entity) material = do
  case material of
    (ResourceMaterial name) -> do
	Entity.setMaterialName entity name "General"
    _ -> error "HGamer3D.Graphics3D.Internal.Shapes._setMaterial: Material not implemented"

_setNodePOS n pos ori siz = do
  setNodePos n pos
  setNodeOri n ori
  setNodeSiz n siz
  
_createFigure :: Graphics3DSystem -> ONode -> Figure -> IO (EngineData)
_createFigure g3ds parent fig = do
  node <- _createSubNode parent
  case fig of
    SimpleFigure geo mat -> do
      meshEntity <- _createGeometry g3ds geo
      _setMaterial meshEntity mat
      _addEntityToNode g3ds node meshEntity
      return (EDEntityNode meshEntity node)
    ResourceFigure name -> do
      meshEntity <- _createResourceFigure g3ds name
      _buildTV meshEntity
      _addEntityToNode g3ds node meshEntity
      return (EDEntityNode meshEntity node)
    CombinedFigure arrSubs -> do
      resArr <- mapM (\(pos, ori, size, fig) -> do
                         newData <- _createFigure g3ds node fig
                         _setNodePOS newData pos ori size
                         return newData) arrSubs
      return (EDNodeAndSub node resArr)

data UpdateActions = ResetMaterial
                   | ResetGeometry
                   | ResetResource
                   | CompareSub
                   | Rebuild
                   | DoNothing
                     
                     deriving (Eq, Show)


_updateFigure :: Graphics3DSystem -> ONode -> EngineData -> Figure -> Figure -> IO (EngineData)
_updateFigure g3ds parent edata oldFig newFig = do
  let node = getNode edata

  -- check, which action is needed
  
  let action = case oldFig of
        SimpleFigure oldGeo oldMat -> case newFig of
          SimpleFigure newGeo newMat -> if newGeo == oldGeo
                                           then
                                             if newMat == oldMat
                                                then DoNothing
                                                else ResetMaterial
                                           else ResetGeometry
          ResourceFigure name -> ResetResource
          CombinedFigure _ -> Rebuild
        ResourceFigure oldName -> case newFig of
          ResourceFigure newName -> if newName == oldName
                                       then DoNothing
                                       else ResetResource
          SimpleFigure newGeo newMat -> ResetGeometry
          CombinedFigure _ -> Rebuild
        CombinedFigure oldSubs -> case newFig of
          SimpleFigure _ _ -> Rebuild
          ResourceFigure _ -> Rebuild
          CombinedFigure newSubs -> if (length oldSubs) == (length newSubs)
                                       then CompareSub
                                       else Rebuild
          
  edataNew <-
        
        -- perform the single actions, we can keep existing node and single EngineData item form
        if action == ResetMaterial || action == ResetGeometry || action == ResetResource
           then do
             let (EDEntityNode eOld nOld) = edata
             case action of
               ResetMaterial -> do
                 let (SimpleFigure geo mat) = newFig
                 _setMaterial eOld mat
                 return edata
               ResetGeometry -> do
                 let (SimpleFigure geo mat) = newFig
                 eNew <- _createGeometry g3ds geo
                 _setMaterial eNew mat
                 _exchangeEntityInNode g3ds nOld eOld eNew
                 return (EDEntityNode eNew nOld)
               ResetResource -> do
                 let (ResourceFigure name) = newFig
                 eNew <- _createResourceFigure g3ds name
                 -- _buildTV eNew
                 _exchangeEntityInNode g3ds nOld eOld eNew
                 return (EDEntityNode eNew nOld)

           -- perform the actions, we compare two equal length subarrays
           else if action == CompareSub
             then do
               let (CombinedFigure oldSubs) = oldFig
               let (CombinedFigure newSubs) = newFig
               let (EDNodeAndSub node' edOldArr) = edata
               outArr <- mapM ( \(oldED, (posO, oriO, sizeO, oldFig), (posN, oriN, sizeN, newFig)) -> do
                                   newED <- _updateFigure g3ds node' oldED oldFig newFig
                                   if posO /= posN then setNodePos newED posN else return ()
                                   if oriO /= oriN then setNodeOri newED oriN else return ()
                                   if sizeO /= sizeN then setNodeSiz newED sizeN else return ()
                                   return newED
                              ) (zip3 edOldArr oldSubs newSubs)
               return (EDNodeAndSub node' outArr)

             -- perform the actions, do a complete rebuild, since structure does not match
             else if action == Rebuild
                     then do
                       -- delete old structure (to be done)
                       _removeFigure g3ds parent edata
                       -- create new structure, this is the easy part
                       _createFigure g3ds parent newFig

                     -- no action needed, all the same
                     else if action == DoNothing
                          then return edata

                          else return $ error ("HGamer3D.Graphics3D.Internal.Shapes._updateFigure: build action not known " ++ (show action))
             
  return edataNew
               
_removeFigure :: Graphics3DSystem -> ONode -> EngineData -> IO ()
_removeFigure g3ds parent edata = do
  case edata of
    EDEntityNode e n -> _removeEntityAndNode g3ds parent e n
    EDNodeAndSub n subs -> (mapM (\edata' -> _removeFigure g3ds n edata') subs) >> return ()
      
instance Graphics3DItem Figure where
  
  object3D g3ds fig = do
    rootNode <- _getRootNode g3ds
    edata <- _createFigure g3ds rootNode fig
    return $ Object3D edata fig

  update3D g3ds ob3d newFig = do
    rootNode <- _getRootNode g3ds
    let (Object3D oldEdata oldFig) = ob3d
    newEdata <- _updateFigure g3ds rootNode oldEdata oldFig newFig
    return $ Object3D newEdata newFig

  remove3D g3ds ob3d = do
    rootNode <- _getRootNode g3ds
    let (Object3D edata fig) = ob3d
    _removeFigure g3ds rootNode edata
    return ()


{- -------------------------------------------------------------------------------
   intelligent constructors for simple geometries
   ------------------------------------------------------------------------------- -}

sphere :: Graphics3DSystem -> Float -> Material -> IO (Object3D Figure)
sphere g3ds radius material = object3D g3ds (CombinedFigure [
                 (zeroVec3, unitU, Vec3 radius radius radius,
                  SimpleFigure Sphere material) ])

cube :: Graphics3DSystem -> Float -> Material -> IO (Object3D Figure)
cube g3ds len material = object3D g3ds (CombinedFigure [
                 (zeroVec3, unitU, Vec3 len len len,
                  SimpleFigure Cube material) ])

cuboid :: Graphics3DSystem -> Vec3 -> Material -> IO (Object3D Figure)
cuboid g3ds vec material = object3D g3ds (CombinedFigure [
                 (zeroVec3, unitU, vec, SimpleFigure Cube material) ])
                           
dodekaeder :: Graphics3DSystem -> Float -> Material -> IO (Object3D Figure)
dodekaeder g3ds len material = object3D g3ds (CombinedFigure [
                 (zeroVec3, unitU, Vec3 len len len, SimpleFigure Dodekaeder material) ])
                           
ikosaeder :: Graphics3DSystem -> Float -> Material -> IO (Object3D Figure)
ikosaeder g3ds len material = object3D g3ds (CombinedFigure [
                 (zeroVec3, unitU, Vec3 len len len, SimpleFigure Ikosaeder material) ])
                           
instance HasPosition (Object3D Figure)  where
	position obj = Node.getPosition (getNode' obj)
	positionTo obj pos = Node.setPosition  (getNode' obj) pos
	
instance HasSize (Object3D Figure) where
	size obj = Node.getScale  (getNode' obj)
	sizeTo obj pos = Node.setScale  (getNode' obj) pos
	
instance HasOrientation (Object3D Figure) 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 ()