One.hs

-- 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
--
-- Copyright 2011 Dr. 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.

-- One.hs

-- |This module is the first attempt, to provide an abstracted interface
-- to the HGamer3D API Bindings. It is named 'One' on purpose, since it is
-- assumed, that there will be additional APIs in the future, which then 
-- might be named 'APIs.Two', 'APIs.Three' and so on. Also note the plural
-- in 'APIs'!
--
-- It should be possible, to write 3D applications, by using the API of 
-- this module alone. Anyhow, to enable a mixture also with the code
-- of the underlying bindings, the constructors of the data types are made
-- public.
module HGamer3D.APIs.One

(
	-- Data types
	-------------
	
	ColourValue (ColourValue),
	Quaternion (Quaternion),
	Vector3 (Vector3),
	Radian (Radian),
	Degree (Degree),


	-- Data types - basic systems
	
	EngineSystem (EngineSystem, esRoot, esSceneManager, esResourceGroupManager, esTextureManager, esControllerManager),
	ViewSystem (ViewSystem, vsCamera, vsRenderWindow, vsViewport),
	InputSystem (InputSystem, isInputManager, isKeyboard, isMouse),
	
	
	-- Data types - internal objects
	-- The consctructores are provided, in case, extension on the base
	-- of the pure wrapping is used
	
	Light (Light),
	Object (ManualObject, Mesh),
	Node (Node),
	Time (Time),
	Animation (Animation),
	GraphicsObject (GraphicsObject, LightObject, CombinedObject),
	
	-- Enums
	--------
	
	module HGamer3D.Bindings.OIS.EnumKeyCode,
	module HGamer3D.Bindings.Ogre.EnumTransformSpace,
	
	-- Functions
	------------
	
	-- Initialize
	initializeHG3D,	
	
	-- Camera
	setCameraPos,
	setCameraLookAt,
	
	-- Light Creation
	createAmbientLight,
	createLight,
	
	-- Graphics Object Creation
	createLine,
	createCube,
	createMesh,


	-- Graphics Object Functions
	scale,
	translate,
	roll,
	pitch,
	yaw,
	rotate,
	
	getPosition,
	setPosition,
	getOrientation,
	setOrientation,
	getScale,
	setScale,
	combineGraphicsObjects,
	
	-- helper function
	getGraphicsObject,
	
	-- Animation Functions
	getAnimation,
	startAnimation,
	stopAnimation,
	setAnimationTime,
	
	-- Time Functions
	getTime,
	
	-- Event Functions
	isKeyDown,
	
	-- run it
	renderLoop,
	
)

where

import GHC.Ptr

import HGamer3D.Bindings.Ogre.ClassPtr
import HGamer3D.Bindings.OIS.ClassPtr

import HGamer3D.Bindings.Ogre.Utils

import HGamer3D.Data.ColourValue
import HGamer3D.Data.Quaternion
import HGamer3D.Data.Vector3
import HGamer3D.Data.Radian
import HGamer3D.Data.Degree

import HGamer3D.Bindings.Ogre.TypeColourValue
import HGamer3D.Bindings.Ogre.TypeQuaternion
import HGamer3D.Bindings.Ogre.TypeVector3

import HGamer3D.Bindings.Ogre.EnumSceneType
import HGamer3D.Bindings.Ogre.EnumTransformSpace

import HGamer3D.Bindings.Ogre.ClassCamera
import HGamer3D.Bindings.Ogre.ClassRoot
import HGamer3D.Bindings.Ogre.ClassLight
import HGamer3D.Bindings.Ogre.ClassNode
import HGamer3D.Bindings.Ogre.ClassSceneManager
import HGamer3D.Bindings.Ogre.ClassSceneNode
import HGamer3D.Bindings.Ogre.ClassRenderTarget
import HGamer3D.Bindings.Ogre.ClassRenderWindow
import HGamer3D.Bindings.Ogre.ClassResourceGroupManager
import HGamer3D.Bindings.Ogre.ClassTextureManager
import HGamer3D.Bindings.Ogre.ClassControllerManager
import HGamer3D.Bindings.Ogre.ClassViewport
import HGamer3D.Bindings.Ogre.ClassFrustum
import HGamer3D.Bindings.Ogre.ClassAnimationState
import HGamer3D.Bindings.Ogre.ClassEntity
import HGamer3D.Bindings.Ogre.ClassControllerManager

import HGamer3D.Bindings.OIS.Utils
import HGamer3D.Bindings.OIS.ClassInputManager
import HGamer3D.Bindings.OIS.EnumType
import HGamer3D.Bindings.OIS.EnumKeyCode
import HGamer3D.Bindings.OIS.ClassObject
import HGamer3D.Bindings.OIS.ClassKeyboard

import HGamer3D.Bindings.Ogre.ClassManualObject
import HGamer3D.Bindings.Ogre.EnumOperationType


import HGamer3D.Bindings.Ogre.TypeHG3DClass
import HGamer3D.Bindings.OIS.TypeHG3DClass

import HGamer3D.Data.Vector3
import HGamer3D.Data.Quaternion
import HGamer3D.Data.HG3DClass


---
-- data declarations for basic API
---


-- |The encapsulation of the state of input devices, like keyboard, mouse, ...
data InputSystem = InputSystem {
	isMouse::HG3DClass, 
	isKeyboard::HG3DClass,
	isInputManager::HG3DClass
} deriving (Show, Eq)

-- |The encapsulation of the state of the view, camera, window and viewport
data ViewSystem = ViewSystem {
	vsCamera::HG3DClass,
	vsRenderWindow::HG3DClass,
	vsViewport::HG3DClass
} deriving (Show, Eq)

-- |The encapsulation of the state of the graphics engine
data EngineSystem = EngineSystem {
	esRoot::HG3DClass,
	esSceneManager::HG3DClass,
	esResourceGroupManager::HG3DClass,
	esTextureManager::HG3DClass,
	esControllerManager::HG3DClass 
} deriving (Show, Eq)


-- common 3D objects, internal data objects (to get typesafety, later to be done with typed pointers)

-- | Encapsulation of a Light Object
data Light = Light HG3DClass
-- | An Object is a basic graphical structure, without connection to a position
data Object = ManualObject HG3DClass -- ^The Ogre ManualObject, which is an Object, drawn by single statements
			  | Mesh HG3DClass -- ^A 3D Mesh
			  
-- | A Node gives position, rotation and connection to other nodes and child parent relationships
-- this is a Ogre abstration, which is used in the One API, to generate the 'GraphicsObject' below
data Node = Node HG3DClass

-- | The time as abstracted type, to recognize it in the api
data Time = Time Float

-- | An Animation, the encapsulation of simple types has the usual reason, to
-- get a better type checking in the API
data Animation = Animation HG3DClass

-- | The graphics object
data GraphicsObject = GraphicsObject Object Node | LightObject Light | CombinedObject Node

--


-- basic initialize function

-- | With this function, the graphics system is being initialized. The return 
-- value consists of the three state types, which carry the state for 
-- the graphics engine, the input system and the view
initializeHG3D :: String -- ^Name of the window, displayed
			-> String  -- ^SceneManager type used
			-> IO (EngineSystem, ViewSystem, InputSystem)
initializeHG3D windowName sceneManagerType = do

		root <- cRNew
		cRShowConfigDialog root
		fUAddResourceLocations "resources.cfg"
		renderWindow <-cRInitialise root True windowName ""
		
		(inputManager, keyboard, mouse) <- fUInitializeOis renderWindow
		
		sceneManager <- cRCreateSceneManager root sceneManagerType "SceneManager"
		
		camera <- cSmCreateCamera sceneManager "SimpleCamera"
		cFSetNearClipDistance camera 5.0
		cFSetFarClipDistance camera 5000.0
		
	
		viewport <- cRtAddViewport renderWindow camera 0 0.0 0.0 1.0 1.0
		let bgColor = ColourValue 0.0 0.0 0.0 1.0
		cVpSetBackgroundColour viewport bgColor
		
		height <- cVpGetActualHeight viewport
		width <- cVpGetActualWidth viewport
		
		cFSetAspectRatio camera ((fromIntegral width) / (fromIntegral height))
		
		tm <- cTmGetSingletonPtr
		cTmSetDefaultNumMipmaps tm 20
		
		rgm <- cRgmGetSingletonPtr
		cRgmInitialiseAllResourceGroups rgm
		
		cm <- cCmNew

		return (
			EngineSystem root sceneManager rgm tm cm,
			ViewSystem  camera renderWindow viewport,
			InputSystem mouse keyboard inputManager
			)


-- camera functions

-- |Postions the camera
setCameraPos :: ViewSystem -> Vector3 -> IO ()
setCameraPos vs pos = do
	cCSetPosition2 (vsCamera vs)  pos

-- |Sets the camera view direction
setCameraLookAt :: ViewSystem -> Vector3 -> IO ()
setCameraLookAt vs vec3 = do
	cCLookAt (vsCamera vs) vec3


-- light functions

-- | creates a light, which fills all the room with similar strength
createAmbientLight :: EngineSystem -> ColourValue -> IO () 
createAmbientLight es colour = do
	cSmSetAmbientLight (esSceneManager es) colour
	return ()
	
-- | creates a point light at a specific location
createLight :: EngineSystem -> String -- ^Name of the light
		-> ColourValue -- ^Color of the light
		-> Vector3 -- ^Position, where light is created
		-> IO (GraphicsObject) -- ^Return value is a graphics object
createLight es lightName colour (Vector3 x y z) = do
	cSmSetAmbientLight (esSceneManager es) colour
	light <- cSmCreateLight (esSceneManager es) lightName
	cLSetPosition light x y z
	return (LightObject (Light light))
	

-- helper functions, not exported

getNodeFromGraphicsObject :: GraphicsObject -> HG3DClass
getNodeFromGraphicsObject (GraphicsObject _ (Node node)) = node
getNodeFromGraphicsObject (CombinedObject (Node node)) = node

getObjectFromGraphicsObject :: GraphicsObject -> HG3DClass
getObjectFromGraphicsObject (GraphicsObject (ManualObject object) (Node node)) = object
getObjectFromGraphicsObject (GraphicsObject (Mesh mesh) (Node node)) = mesh

getNewNode :: EngineSystem -> IO (HG3DClass)
getNewNode es = do
	rootNode <- cSmGetRootSceneNode (esSceneManager es)
	let vzero = Vector3 0.0 0.0 0.0
	let qident = Quaternion 1.0 0.0 0.0 0.0
	node <- cSnCreateChildSceneNode rootNode vzero qident
	return (node)

getGraphicsObject :: EngineSystem -> Object -> IO (GraphicsObject)
getGraphicsObject es (ManualObject object) = do
	node <- getNewNode es
	cSnAttachObject node object
	return (GraphicsObject (ManualObject object) (Node node) )
getGraphicsObject es (Mesh mesh) = do
	node <- getNewNode es
	cSnAttachObject node mesh
	return (GraphicsObject (Mesh mesh) (Node node) )


-- use "BaseWhiteNoLighting" Material

-- |Creates a line by using the ManualObject functionality of Ogre
createLine :: EngineSystem -- ^The engine system
		-> String -- ^The name of the line object
		-> String -- ^The material used for the line
		-> ColourValue -- ^The color of the line
		-> Vector3 -- ^The start point of the line
		-> Vector3 -- ^The end point of the line
		-> IO (GraphicsObject) -- ^Return value is a graphics object
createLine es lineName materialName colour vStart vEnd = do
	mo <- cSmCreateManualObject (esSceneManager es) lineName
	cMnoBegin mo materialName OtLineList "General"
	cMnoPosition mo vStart
	cMnoColour mo colour
	cMnoPosition mo vEnd
	cMnoColour mo colour
	cMnoEnd mo

	go <- getGraphicsObject es (ManualObject mo)
	return (go)

-- |Creates a cube by using the ManualObject functionality of Ogre
createCube :: EngineSystem -- ^The engine system 
		-> String -- ^The name of the cube object 
		-> String -- ^The material used for the cube 
		-> ColourValue -- ^The color of the line 
		-> Vector3 -- ^The initial position, where the cube is created
				   -- it is measured to the center of the cube
		-> IO (GraphicsObject) -- ^Return value is a graphics object
createCube es cubeName materialName colour pos = do
	mo <- cSmCreateManualObject (esSceneManager es) cubeName
	-- set Dynamic to false
	cMnoSetDynamic mo False
	
	-- basic parameters
	let lsize = 1.0
	let cp = 1.0 * lsize
	let cm = -1.0 * lsize
	
	cMnoBegin mo materialName OtTriangleList "General"
	
	cMnoPosition2 mo cm cp cm   -- a vertex
	cMnoColour mo colour
	cMnoPosition2 mo cp cp cm   -- a vertex
	cMnoColour mo colour
	cMnoPosition2 mo cp cm cm   -- a vertex
	cMnoColour mo colour
	cMnoPosition2 mo cm cm cm   -- a vertex
	cMnoColour mo colour
	
	cMnoPosition2 mo cm cp cp   -- a vertex
	cMnoColour mo colour
	cMnoPosition2 mo cp cp cp   -- a vertex
	cMnoColour mo colour
	cMnoPosition2 mo cp cm cp   -- a vertex
	cMnoColour mo colour
	cMnoPosition2 mo cm cm cp   -- a vertex
	cMnoColour mo colour
	
	cMnoTriangle mo 0 1 2
	cMnoTriangle mo 2 3 0
	cMnoTriangle mo 4 6 5
	cMnoTriangle mo 6 4 7
	
	cMnoTriangle mo 0 4 5 
	cMnoTriangle mo 5 1 0
	cMnoTriangle mo 2 6 7
	cMnoTriangle mo 7 3 2

	cMnoTriangle mo 0 7 4
	cMnoTriangle mo 7 0 3
	cMnoTriangle mo 1 5 6
	cMnoTriangle mo 6 2 1
	
	cMnoEnd mo
	
	go <- getGraphicsObject es (ManualObject mo)
	setPosition go pos
	return (go)

-- |This function creates a graphics object, by loading a mesh
createMesh :: EngineSystem -- ^The engine system
		-> String -- ^The name of the created mesh object
		-> String -- ^The filename of the mesh, from the resources
		-> IO (GraphicsObject) -- ^Return value is a graphics object
createMesh es meshName meshFile = do

	entity <- cSmCreateEntity (esSceneManager es) meshName meshFile "General"
	go <- getGraphicsObject es (Mesh entity)
	return (go)
	

-- |This function groups objects into a new object
-- it is not perfoming any geometric operations, it just groups the 
-- input objects. Can be used, to move and rotate a group.
combineGraphicsObjects :: EngineSystem -- ^The engine system
		-> [GraphicsObject] -- ^A list of objects, to be grouped
		-> IO (GraphicsObject) -- ^The return value is a new GraphicsObject
combineGraphicsObjects es listObjects = do

	node <- getNewNode es
	sequence_ (map ( \object -> do
						let objectnode = getNodeFromGraphicsObject object
						parent <- cNGetParent objectnode
						-- currently no check here, if parent exists!
						-- no parent is only valid for root node and this is not accessible to the
						-- user of this api (should not be used, at least)
						cNRemoveChild2 parent objectnode
						cNAddChild node objectnode
						return ()
						)
								listObjects)
	return ( CombinedObject (Node node) )
	

--
-- GraphicsObject functions
--

--	scale

-- |Scales a GraphicsObject by multiplying a scale to the existing one
scale :: GraphicsObject -> Vector3 -> IO ()
scale go sc  = do
	cNScale (getNodeFromGraphicsObject go) sc
	return () 

--	| Translate a GraphicsObject from its current position
translate :: GraphicsObject -> Vector3 -> EnumTransformSpace -> IO ()
translate go v ets = do
	cNTranslate (getNodeFromGraphicsObject go) v ets
	return () 

--	roll
roll :: GraphicsObject -> Radian -> EnumTransformSpace -> IO ()
roll go r ets = do
	cNRoll (getNodeFromGraphicsObject go) r ets
	return () 

--	pitch
pitch :: GraphicsObject -> Radian -> EnumTransformSpace -> IO ()
pitch go r ets = do
	cNPitch (getNodeFromGraphicsObject go) r ets
	return () 

--	yaw
yaw :: GraphicsObject -> Radian -> EnumTransformSpace -> IO ()
yaw go r ets = do
	cNYaw (getNodeFromGraphicsObject go) r ets
	return () 

--	rotate
rotate :: GraphicsObject -> Vector3 -> Radian -> EnumTransformSpace -> IO ()
rotate go v r ets = do
	cNRotate (getNodeFromGraphicsObject go) v r ets
	return () 

	

getPosition :: GraphicsObject -> IO (Vector3)
getPosition go = do
	pos <- cNGetPosition (getNodeFromGraphicsObject go)
	return (pos) 

setPosition :: GraphicsObject -> Vector3 -> IO ()
setPosition go pos = do
	cNSetPosition (getNodeFromGraphicsObject go) pos
	return ()

setLightPos :: Light -> Float -> Float -> Float -> IO ()
setLightPos (Light light) x y z = do
	cLSetPosition light x y z

getOrientation :: GraphicsObject -> IO (Quaternion)
getOrientation go = do
	quat <- cNGetOrientation (getNodeFromGraphicsObject go)
	return (quat) 

setOrientation :: GraphicsObject -> Quaternion -> IO ()
setOrientation go quat = do
	cNSetOrientation (getNodeFromGraphicsObject go) quat
	return ()

getScale :: GraphicsObject -> IO (Vector3)
getScale go = do
	scale <- cNGetScale (getNodeFromGraphicsObject go)
	return (scale) 

setScale :: GraphicsObject -> Vector3 -> IO ()
setScale go scale = do
	cNSetScale (getNodeFromGraphicsObject go) scale
	return ()


-- Animation Functions
getAnimation :: GraphicsObject -> String -> IO (Animation)
getAnimation (GraphicsObject (Mesh mesh) _ ) animName = do
	anim <- cEGetAnimationState mesh animName
	return (Animation anim)
	
startAnimation :: Animation -> IO ()
startAnimation (Animation anim) = do
	cAnsSetEnabled anim True
	cAnsSetLoop anim True

stopAnimation :: Animation -> IO ()
stopAnimation (Animation anim) = do
	cAnsSetEnabled anim False
	cAnsSetLoop anim False

setAnimationTime :: Animation -> Time -> IO ()
setAnimationTime (Animation anim) (Time time) = do
	cAnsSetTimePosition anim time

-- Time Functions
getTime :: EngineSystem -> IO (Time)
getTime es = do
	time <- cCmGetElapsedTime (esControllerManager es)
	return (Time time)


-- event functions

isKeyDown :: InputSystem -> EnumKeyCode -> IO (Bool)
isKeyDown is keycode = do
	isdown <- cOISKIsKeyDown (isKeyboard is) keycode
	return (isdown)



-- renderLoop function

renderLoop :: EngineSystem -> ViewSystem -> InputSystem -> (EngineSystem -> ViewSystem -> InputSystem -> IO ()) -> IO ()
renderLoop es vs is stepFunc = do
	fUMessagePump
	closed <- cRwIsClosed (vsRenderWindow vs)
	if (closed) then
		return ()
		else do
			cRRenderOneFrame (esRoot es)
			cOISOCapture (isKeyboard is)
			stepFunc es vs is
			renderLoop es vs is stepFunc