Camera.hs

{-# 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/Camera.hs

module HGamer3D.Graphics3D.Internal.Camera
where

import HGamer3D.Data
import HGamer3D.Data.HG3DClass
import HGamer3D.Data.Window

import HGamer3D.Util

import qualified HGamer3D.Bindings.Ogre.ClassRoot as Root
import HGamer3D.Bindings.Ogre.ClassCamera as Camera
import HGamer3D.Bindings.Ogre.ClassNode as Node
import HGamer3D.Bindings.Ogre.ClassSceneManager as SceneManager
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.ClassLogManager as LogManager
import HGamer3D.Bindings.Ogre.ClassLog as Log
import HGamer3D.Bindings.Ogre.ClassHG3DUtilities as Util
import HGamer3D.Bindings.Ogre.ClassRenderTarget as RenderTarget
import HGamer3D.Bindings.Ogre.ClassManualObject as ManualObject
import HGamer3D.Bindings.Ogre.EnumRenderOperationOperationType
import HGamer3D.Bindings.Ogre.StructHG3DClass
import HGamer3D.Bindings.Ogre.EnumSceneManagerPrefabType
import HGamer3D.Bindings.Ogre.ClassWindowEventUtilities as WindowEventUtilities

import Control.Monad
import Control.Monad.Trans
import Control.Monad.IO.Class
import Control.Monad.State.Class
import qualified System.Info as SI

import Control.Concurrent
import Data.Maybe

import HGamer3D.Data
import HGamer3D.Util

import HGamer3D.Graphics3D.Schema.Material
import HGamer3D.Graphics3D.Schema.Geometry
import HGamer3D.Graphics3D.Schema.Figure
import qualified HGamer3D.Graphics3D.Schema.Camera as Cam
import HGamer3D.Graphics3D.Internal.Base


{- ----------------------------------------------------------------
   Camera
   ---------------------------------------------------------------- -}

-- |  Camera, internal data object for engine
data Camera = Camera {
  cameraCamObject :: HG3DClass,
  cameraViewportObject :: HG3DClass,
  cameraSchema :: Cam.Camera
 }

-- | add a camera, you probably want to do this at least once
addCamera :: Graphics3DSystem -- ^ the graphics system
             -> Cam.Camera   -- ^ the Schema data for the camera
             -> IO Camera    -- ^ the resulting engine object
addCamera g3ds schema = do
  let (SceneManager sceneManager) = g3dsSceneManager g3ds
  let uname = g3dsUniqueName g3ds
  let (RenderTarget renderWindow) = g3dsRenderTarget g3ds
  let Cam.Camera (Cam.Frustum nd fd fov) (Cam.Viewport z pos bgr) = schema
  -- create camera
  cameraName <- (nextUniqueName uname) >>= (\n -> return ("Camera"++n))
  camera <- SceneManager.createCamera sceneManager cameraName
  -- add Viewport
  viewport <- RenderTarget.addViewport renderWindow camera z (rectX pos) (rectY pos) (rectWidth pos) (rectHeight pos)
  -- set Viewport parameters
  Viewport.setBackgroundColour viewport bgr
  -- set Frustum parameters
  Frustum.setNearClipDistance camera nd
  Frustum.setFarClipDistance camera fd
  Frustum.setFOVy camera (fromAngle fov)
  -- create camera return value
  let cam = Camera camera viewport schema
  -- adapt aspect ratio
  cameraAdaptAspectRatio cam

  return cam

-- | remove a camera 
removeCamera :: Graphics3DSystem -> Camera -> IO ()
removeCamera g3ds (Camera camera viewport schema) = do
  let (SceneManager sceneManager) = g3dsSceneManager g3ds
  let (RenderTarget renderWindow) = g3dsRenderTarget g3ds
  let Cam.Camera (Cam.Frustum nd fd fov) (Cam.Viewport z pos bgr) = schema
  RenderTarget.removeViewport renderWindow z
  SceneManager.destroyCamera sceneManager camera

-- | update an existing camera with new parameters
updateCamera :: Graphics3DSystem -> Camera -> Cam.Camera -> IO Camera
updateCamera g3ds cam@(Camera camera viewport schema) schema' = do
 
  let Cam.Camera (Cam.Frustum nd fd fov) (Cam.Viewport z pos bgr) = schema
  let Cam.Camera (Cam.Frustum nd' fd' fov') (Cam.Viewport z' pos' bgr') = schema'
  -- if zorder or position are not equal, we need to rebuild
  if (z /= z') || (pos /= pos') then do
    removeCamera g3ds cam
    addCamera g3ds schema'
    else do
      -- adapt single values, as needed
      if nd /= nd' then Frustum.setNearClipDistance camera nd' else return ()
      if fd /= fd' then Frustum.setFarClipDistance camera fd' else return ()
      if fov /= fov' then Frustum.setFOVy camera (fromAngle fov') else return ()
      if bgr /= bgr' then Viewport.setBackgroundColour viewport bgr' else return ()
      return (Camera camera viewport schema')
  
-- | adapt the aspect ration, in case the window size and aspect ratio changes, this
--   is called inside the engine automatically.
cameraAdaptAspectRatio :: Camera -> IO ()
cameraAdaptAspectRatio cam = do
  let (Camera camera viewport schema) = cam
  height <- Viewport.getActualHeight viewport
  width <- Viewport.getActualWidth viewport
  Frustum.setAspectRatio camera ((fromIntegral width) / (fromIntegral height))
  return ()
	
instance HasPosition Camera where
	position (Camera c _ _) = Camera.getPosition c
	positionTo (Camera c _ _) pos = Camera.setPosition2 c  pos
	
instance HasOrientation Camera where
	orientation (Camera c _ _) = do
		q <- Camera.getOrientation c
		let uq = mkNormal q
		return uq
	orientationTo (Camera c _ _) uq = do
		Camera.setOrientation c (fromNormal uq)
		return ()

-- | set the direction in a way, that the camera looks toward a specified point
cameraLookAt :: Camera -> Vec3 -> IO ()
cameraLookAt (Camera c _ _) v = do
	Camera.lookAt c v
	return ()

-- | Background colour of the 3d drawing window
setBackgroundColour :: Graphics3DSystem -> Camera -> Colour -> IO Camera
setBackgroundColour g3ds cam@(Camera camera viewport schema) bgColour = do
  let Cam.Camera (Cam.Frustum nd fd fov) (Cam.Viewport z pos bgr) = schema
  let schema' = Cam.Camera (Cam.Frustum nd fd fov) (Cam.Viewport z pos bgColour)
  updateCamera g3ds cam schema'