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 provides a simple, generic API into the HGamer3D functionality.

module HGamer3D.APIs.One

(
	-- types
	ColourValue (ColourValue),
	Quaternion (Quaternion),
	Vector3 (Vector3),

	-- Enums
	module HGamer3D.Bindings.OIS.EnumKeyCode,
	
	-- Data types
	Entity (Entity),
	EngineStatus (EngineStatus),
	Light (Light),
	
	-- Functions
	--
	
	-- Initialize
	initializeHG3D,	
	
	-- Camera
	setCameraPos,
	setCameraLookAt,
	
	-- Light
	createLight,
	setLightPos,
	
	-- Entities
	loadEntity,
	getEntityOrientation,
	setEntityOrientation,
	getEntityFromObject,
	
	-- Object functions
	createLineObject,
	
	-- 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.Bindings.Ogre.TypeColourValue
import HGamer3D.Bindings.Ogre.TypeQuaternion
import HGamer3D.Bindings.Ogre.TypeVector3

import HGamer3D.Bindings.Ogre.EnumSceneType

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.ClassViewport
import HGamer3D.Bindings.Ogre.ClassFrustum

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

-- data EngineStatus = EngineStatus ClassRoot ClassSceneManager ClassResourceGroupManager ClassInputManager  ClassRenderWindow ClassCamera ClassViewport ClassKeyboard
data EngineStatus = EngineStatus HG3DClass HG3DClass HG3DClass HG3DClass HG3DClass HG3DClass HG3DClass HG3DClass
data Light = Light HG3DClass
data Entity = Entity HG3DClass HG3DClass

-- basic initialize function

initializeHG3D :: String -> String -> IO (EngineStatus)
initializeHG3D windowName sceneManagerType = do

		root <- cRNew
		let (HG3DClass ptr fptr) = root
		print ptr
		print fptr 
		cRShowConfigDialog root
		fUAddResourceLocations "resources.cfg"
		renderWindow <-cRInitialise root True windowName ""
		
		(inputManager, keyboard, mouse) <- fUInitializeOis renderWindow
--		keyboard <- cOISImCreateInputObject inputManager Oiskeyboard False ""
		
		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 5
		
		rgm <- cRgmGetSingletonPtr
		cRgmInitialiseAllResourceGroups rgm

		return (EngineStatus root sceneManager rgm inputManager renderWindow camera viewport keyboard)


-- camera functions

setCameraPos :: EngineStatus -> Vector3 -> IO ()
setCameraPos (EngineStatus _ _ _ _ _ camera _ _) pos = do
	cCSetPosition2 camera pos

setCameraLookAt :: EngineStatus -> Vector3 -> IO ()
setCameraLookAt (EngineStatus _ _ _ _ _ camera _ _) vec3 = do
	cCLookAt camera vec3


-- light functions

createLight :: EngineStatus -> ColourValue -> Float -> Float -> Float -> String -> IO (Light) 
createLight (EngineStatus _ sceneManager _ _ _ _ _ _) colour x y z name = do
	cSmSetAmbientLight sceneManager colour
	light <- cSmCreateLight sceneManager name
	cLSetPosition light x y z
	return (Light light)
	
setLightPos :: Light -> Float -> Float -> Float -> IO ()
setLightPos (Light light) x y z = do
	cLSetPosition light x y z


-- entity functions

loadEntity :: EngineStatus -> String -> String -> IO (Entity)
loadEntity (EngineStatus _ sceneManager _ _ _ _ _ _) name mesh = do

	entity <- cSmCreateEntity sceneManager name mesh "General"
	rootNode <- cSmGetRootSceneNode sceneManager
	let vzero = Vector3 0.0 0.0 0.0
	let qident = Quaternion 1.0 0.0 0.0 0.0
	entityNode <- cSnCreateChildSceneNode rootNode vzero qident
	cSnAttachObject entityNode entity
	return (Entity entity entityNode)

getEntityFromObject :: EngineStatus -> HG3DClass -> IO (Entity)
getEntityFromObject (EngineStatus _ sceneManager _ _ _ _ _ _) object = do

	rootNode <- cSmGetRootSceneNode sceneManager
	let vzero = Vector3 0.0 0.0 0.0
	let qident = Quaternion 1.0 0.0 0.0 0.0
	entityNode <- cSnCreateChildSceneNode rootNode vzero qident
	cSnAttachObject entityNode object
	return (Entity object entityNode)


getEntityOrientation :: Entity -> IO (Quaternion)
getEntityOrientation (Entity entity entityNode) = do
	quat <- cNGetOrientation entityNode
	return (quat) 

setEntityOrientation :: Entity -> Quaternion -> IO ()
setEntityOrientation (Entity entity entityNode) quat = do
	cNSetOrientation entityNode quat
	return ()


-- object functions
createLineObject :: EngineStatus -> String -> String -> Vector3 -> Vector3 -> IO ()
createLineObject (EngineStatus _ sceneManager _ _ _ _ _ _) name materialName vStart vEnd = do
	mo <- cSmCreateManualObject sceneManager name
	cMnoBegin mo materialName OtLineList "General"
	cMnoPosition mo vStart
	cMnoPosition mo vEnd
	cMnoEnd mo
	rootNode <- cSmGetRootSceneNode sceneManager
	cSnAttachObject rootNode mo
	return ()


-- event functions

isKeyDown :: EngineStatus -> EnumKeyCode -> IO (Bool)
isKeyDown (EngineStatus _ _ _ _ _ _ _ keyboard) keycode = do
	isdown <- cOISKIsKeyDown keyboard keycode
	return (isdown)



-- renderLoop function

renderLoop :: EngineStatus -> (EngineStatus -> IO ()) -> IO ()
renderLoop (EngineStatus root sceneManager rgm inputManager window camera viewport keyboard) stepFunc = do
	fUMessagePump
	closed <- cRwIsClosed window
	if (closed) then
		return ()
		else do
			cRRenderOneFrame root
			cOISOCapture keyboard
			stepFunc (EngineStatus root sceneManager rgm inputManager window camera viewport keyboard)
			renderLoop (EngineStatus root sceneManager rgm inputManager window camera viewport keyboard) stepFunc