{- Main.hs; Mun Hon Cheong (mhch295@cse.unsw.edu.au) 2005

Main module

-}

module Main where


import TextureFonts
import Graphics.UI.GLUT
import Graphics.Rendering.OpenGL
import System.Time
import Data.IORef
import Data.Maybe
import Monad
import qualified HGL as HGL
import AFRP
import AFRPInternals
import AFRPForceable
import Game
import IdentityList
import Random
import Parser
import Object
import BSP
import Camera
import Foreign.Marshal.Array
import System(ExitCode(..), exitWith)
import Matrix
import MD3
import Data.HashTable
import Frustum
import Data.List (find)
import Textures
import Collision
import MapCfg
import Visibility
import Render

msInterval :: Int
msInterval = 16

clkRes :: Double
clkRes = 1000

data Input
  = KBMInput  { key :: Key,
			 keyState :: KeyState,
			 modifiers :: Modifiers,
			 pos :: Position}
  | MouseMove { pos :: Position }
 deriving Show

type OGLInput = Maybe Input
type WinInput = Event HGL.Event






main = do
   (progName,names) <-getArgsAndInitialize
   case names of
    []     -> printUsage progName
    [name] -> do createAWindow "FRAG" name
                 mainLoop
    _      -> printUsage progName

printUsage n = do putStrLn $ "Usage: "   ++ n ++ " <level>"
                  putStrLn $ "Example: " ++ n ++ " leveleg"

createAWindow windowName level = do
   initialDisplayMode $= [WithDepthBuffer, DoubleBuffered, RGBAMode]
   drawBuffer		  $= BackBuffers
   initialWindowSize  $= (Size 640 480)
   createWindow windowName
   clear [ColorBuffer]
   viewport		  $= ((Position 0 0), Size 640 480)
   matrixMode		  $= Projection
   loadIdentity
   perspective 70.0 (640/480) 10.0  4000.0
   matrixMode		  $= Modelview 0
   loadIdentity
   depthFunc		  $= Just Less
   texture Texture2D  $=  Enabled
   cullFace		  $= Just Front
   cursor 		  $= None

   --load our level objects from the *.cfg file
   iobjs <- readMapCfg (level++".cfg")

   let cam = initCamera (80,611,60) (80,611,59) (0,1,0)
   camRef <- newIORef(cam)

   --read the BSP files and player models specififed in the *.med files
   (mapRef,modls) <- readMapMedia (level++".med")

   listModels <- toList modls
   animList   <- mapM getAnims listModels

   --complete the objects
   let objs = toCompleteObjects animList iobjs

   --build the fonts
   (tex,base)<- buildFonts
   numbase <- buildBigNums

   --create a hashmap  for textures
   texs <- fromList hashString []

   --create the crosshair
   crosshair <- getAndCreateTexture "crosshaira"
   insert texs "crosshair" crosshair

   --set up the variables needed by our callbacks and game loop
   time		   <- get elapsedTime
   lastTime	   <- newIORef(time)
   lastDTime	   <- newIORef(time)
   lastDTime2	   <- newIORef(time)
   fpsc1		   <- newIORef(0,0)
   fps1		   <- newIORef(0,0,0)
   currentfps	   <- newIORef(0)
   lastSecond	   <- newIORef(time)
   --hold new keyboard input
   newInput	   <- newIORef(Nothing)
   inpState	   <- newIORef (False)
   --hold the new mouse input
   newMouseInput  <- newIORef(Nothing)
   --lock the mouse or not
   lck		   <- newIORef(True)
   (dt, inp)	   <- getWinInput
				    (lastTime, (newInput,newMouseInput)) inpState True time
   hasReact	   <- newIORef(False)
   map		   <- readIORef mapRef

   let gd = GameData {
	  gamemap 	 = mapRef,
	  models		 = modls,
	  textures	 = texs,
	  camera		 = camRef,
	  lastDrawTime  = lastDTime,
	  lastDrawTime2 = lastDTime2,
	  hasReacted	 = hasReact,
	  fonts		 = (tex,base),
	  nbase		 = numbase,
	  lock		 = lck,
	  fpsc		 = fpsc1,
	  fpss		 = fps1,
	  nems		 = ((length objs)-1)
   }


   rh <-
	 reactInit
	    (initr lastTime (newInput,newMouseInput) inpState)
	    (actuate gd)
	    (repeatedly (0.016) () &&&(parseWinInput >>> game map objs))


   --set up the callbacks
   displayCallback		$= display
   keyboardMouseCallback $= Just (keyboardMouse newInput newMouseInput lck)
   motionCallback		$= Just (dragMotion    newMouseInput)
   passiveMotionCallback $= Just (mouseMotion   newMouseInput)
   idleCallback		$=
	Just (idle lastTime (newInput,newMouseInput)
	   hasReact (tex,base) inpState rh)


   where getAnims (x,y) = do
	    us <- readIORef (upperState y)
	    ls <- readIORef (lowerState y)
	    return (x,us,ls)




-------------------------------------------------------------------------------
-- functions to connect Haskell and Yampa


actuate :: GameData -> ReactHandle a b ->
   Bool -> (Event (), [ObsObjState]) -> IO Bool
actuate  gd _ _ (e, noos) = do
   when (force (noos) `seq` isEvent e)
	(render gd noos)
   return False


initr :: IORef(Int) -> (IORef(OGLInput),IORef(OGLInput)) ->
   (IORef(Bool))  -> IO (WinInput,WinInput)
initr lastTime newInput inpState = do
	 time	  <- get elapsedTime
	 writeIORef lastTime 1
	 (dt, inp) <- getWinInput (lastTime, newInput)  inpState True time
	 case inp of
	    Just i -> return i
	    Nothing -> return (noEvent,noEvent)




-------------------------------------------------------------------------------
--graphics


render :: GameData -> [ObsObjState] -> IO()
render gd oos = do
  --get the last time we drew the screen
  lastTime <- readIORef (lastDrawTime gd)
  --the current time
  time	 <- get elapsedTime
  l <- readIORef (lock gd)

  --if the last time is at leat greater than 0.016
  --seconds and the mouse is locked reset the position
  --to the middle of the screen
  case (((realToFrac (time - lastTime))/1000) >= (1/60) && l == True) of
	True -> do
	   pointerPosition	$= (Position 320 240)
	   writeIORef (lastDrawTime gd) time
	_ -> return ()

  lastTime2 <- readIORef (lastDrawTime2 gd)
  r <- readIORef (hasReacted gd)

  --case (((realToFrac (time - lastTime2))/1000) <= (1/60)) of
  case (True) of
	True -> do
		    -- initial setup
		    clear [ ColorBuffer, DepthBuffer ]
		    loadIdentity

		    --find the camera and set our view
		    let playerState = findCam oos
		    case (cood playerState) of
			 [] -> do return ()
			 _ -> print (getPos (cood playerState))
		    let cam = setCam $ playerState
		    writeIORef (camera gd) cam
		    cameraLook cam

		    --render the map
		    renderBSP (gamemap gd) (cpos cam)

		    --render the objects
		    map <- readIORef (gamemap gd)
		    frust <- getFrustum
		    mapM_ (renderObjects (camera gd) (models gd) frust map) oos

		    --render the gun
		    renderGun cam (models gd)

		    --set up orthographics mode so we can draw the fonts
		    renderHud gd playerState (length oos) time

		    writeIORef (lastDrawTime2 gd) time
		    writeIORef (hasReacted gd) False
		    swapBuffers
	_	-> do
		    writeIORef (lastDrawTime2 gd) time
		    return()


getPos :: [(Double,Double,Double)] -> [(Int,Int,Int)]
getPos coords = map ints l
	where
	  l = map (vectorAdd (0,90,0)) coords
	  ints (x,y,z)= (truncate x,truncate y,truncate z)


findCam :: [ObsObjState] -> ObsObjState
findCam states = fromJust $ find (\x -> (isCamera x)) states


setCam :: ObsObjState -> Camera
setCam (OOSCamera {oldCam = cam, newCam = x}) =  cam




-------------------------------------------------------------------------------
--callbacks

display = do
  return ()


keyboardMouse ::
   IORef(OGLInput) -> IORef(OGLInput) -> IORef(Bool) ->  KeyboardMouseCallback
keyboardMouse _ _ lock (Char 'z') c d e  = do
   l <- readIORef lock
   writeIORef lock (False)
keyboardMouse _ _ lock (Char 'x') c d e  = do
   l <- readIORef lock
   writeIORef lock (True)
keyboardMouse _ _ lock  (Char '\27') c d e  = do exitWith ExitSuccess
keyboardMouse newInput newMouse lock newKey@(MouseButton x)
   newKeyState newModifiers newPosition = do
	 writeIORef  newMouse (Just KBMInput{
							key		= newKey,
							keyState	= newKeyState,
							modifiers = newModifiers,
							pos		= newPosition})
keyboardMouse newInput newMouse lock newKey
   newKeyState newModifiers newPosition = do
	 writeIORef newInput (Just KBMInput{
							key		 = newKey,
							keyState	 = newKeyState,
							modifiers  = newModifiers,
							pos		 = newPosition})


mouseMotion :: IORef(OGLInput) -> MotionCallback
mouseMotion newInput newCursorPos = do
   last <- readIORef newInput
   case last of
	 (Just inp) -> do writeIORef newInput (Just inp)
	 _		  -> do writeIORef newInput (Just MouseMove {pos=newCursorPos})


dragMotion :: IORef(OGLInput) -> MotionCallback
dragMotion newInput newCursorPos = do
   last <- readIORef newInput
   case last of
	 (Just inp) -> do writeIORef newInput (Just inp)
	 _		  -> do writeIORef newInput (Just MouseMove {pos=newCursorPos})


idle :: IORef(Int) -> (IORef(OGLInput),IORef(OGLInput)) ->IORef(Bool) ->
  (Maybe TextureObject,DisplayList) -> (IORef(Bool)) ->
	ReactHandle (WinInput,WinInput) (Event (), ([Object.ObsObjState])) -> IO()
idle lastTime newInput hasReacted font inputState rh = do
   lTime <- readIORef lastTime
   currentTime <- get elapsedTime
   case (currentTime - lTime >= 16) of
	 True -> do
	    (dt, input) <-
		  getWinInput (lastTime,newInput) inputState True currentTime
	    status	 <- react rh (dt,input)
	    writeIORef hasReacted True
	    writeIORef lastTime currentTime
	    return ()
	 _ -> do return ()





-------------------------------------------------------------------------------
--input handling
--mimic HGL so the parser from SPace Invaders can be used


getWinInput ::
   (IORef(Int),(IORef(OGLInput),IORef(OGLInput))) ->
	 (IORef(Bool)) -> Bool -> Int-> IO(DTime,(Maybe (WinInput,WinInput)))
getWinInput (lastTime, (newInput,newMouseInput)) inpState _ currentTime = do
   lTime <- readIORef lastTime
   newIn <- readIORef newInput
   newMouseIn <- readIORef newMouseInput
   writeIORef newInput Nothing
   writeIORef newMouseInput Nothing

   --we try to get rid of redundant events
   hasReset <- readIORef inpState
   mmin <-
	 case (coalesce newIn, coalesce newMouseIn,hasReset) of
	   (NoEvent, NoEvent,_) -> do return Nothing
	   (NoEvent, Event HGL.MouseMove {HGL.pt =HGL.Point (320,240)},False)-> do
		  writeIORef inpState False
		  return Nothing
	   (NoEvent, Event HGL.MouseMove {HGL.pt =HGL.Point (320,240)},True) -> do
		  writeIORef inpState False
		  return $  Just (coalesce newIn,coalesce newMouseIn)
	   (NoEvent, Event HGL.MouseMove {HGL.pt = _ },True) -> do
		  writeIORef inpState True
		  return $ Just (coalesce newIn,coalesce newMouseIn)
	   (NoEvent, Event HGL.MouseMove {HGL.pt = _ },False) -> do
		  writeIORef inpState True
		  return $ Just (coalesce newIn,coalesce newMouseIn)
	   (Event _, Event HGL.MouseMove {HGL.pt =HGL.Point (320,240)},False)-> do
		  writeIORef inpState False
		  return $ Just (coalesce newIn,noEvent)
	   (Event _, Event HGL.MouseMove {HGL.pt =HGL.Point (320,240)},True) -> do
		  writeIORef inpState False
		  return $ Just (coalesce newIn,coalesce newMouseIn)
	   (Event _, Event HGL.MouseMove {HGL.pt = _},True) -> do
		  writeIORef inpState True
		  return $ Just (coalesce newIn,coalesce newMouseIn)
	   (Event _, Event HGL.MouseMove {HGL.pt = _},False) -> do
		  writeIORef inpState True
		  return $ Just (coalesce newIn,coalesce newMouseIn)
	   (_,_,_) -> do
		  writeIORef inpState True
		  return $ Just (coalesce newIn,coalesce newMouseIn)

   return ((fromIntegral (currentTime-lTime))/clkRes, mmin)


coalesce :: OGLInput -> WinInput
coalesce Nothing = NoEvent
coalesce (Just KBMInput {key		= (MouseButton button),
					keyState	= ks,
					modifiers = m,
					pos		= p}) =
   (Event HGL.Button {
	  HGL.pt	   = (pos2Point p),
	  HGL.isLeft = (isMBLeft (MouseButton button)),
	  HGL.isDown = (isKeyDown ks)})
coalesce (Just KBMInput {key		= (Char a),
					keyState	= ks,
					modifiers = m,
					pos		= p}) =
   (Event HGL.Char {HGL.char = a,
				HGL.isDown = (isKeyDown ks)})
coalesce (Just MouseMove {pos= p}) =
   (Event HGL.MouseMove { HGL.pt = pos2Point p })
coalesce _ = NoEvent


pos2Point :: Position -> HGL.Point
pos2Point (Position a b) = HGL.Point (fromIntegral a, fromIntegral b)


isMBLeft :: Key -> Bool
isMBLeft (MouseButton LeftButton) = True
isMBLeft _ = False


isKeyDown :: KeyState -> Bool
isKeyDown Down = True
isKeyDown _	= False


filter :: Eq a => a -> a -> Maybe(a)
filter a b =
   if (a == b) then
	 Just(a)
   else
	 Nothing