{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}
{- | 
This FunGEn module contains some important game routines.
-}
{- 

FunGEN - Functional Game Engine
http://www.cin.ufpe.br/~haskell/fungen
Copyright (C) 2002  Andre Furtado <awbf@cin.ufpe.br>

This code is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

-}


module Graphics.UI.Fungen.Game (
  Game, IOGame,
  -- ** creating
  createGame,
  -- ** IO utilities
  runIOGame, runIOGameM, liftIOtoIOGame, liftIOtoIOGame',
  -- ** game state
  getGameState, setGameState,
  getGameAttribute, setGameAttribute,
  -- ** game flags
  getGameFlags, setGameFlags,
  enableGameFlags, disableGameFlags,
  enableMapDrawing, disableMapDrawing,
  enableObjectsDrawing, disableObjectsDrawing,
  enableObjectsMoving, disableObjectsMoving,
  -- ** map operations
  drawMap, clearScreen, getTileFromIndex, getTileFromWindowPosition, setCurrentMapIndex,
  -- ** object operations
  getObjectManagers, setObjectManagers,
  drawAllObjects, drawObject, moveAllObjects, destroyObjects, destroyObject,
  getObjectsFromGroup, addObjectsToGroup, addObjectsToNewGroup, findObjectManager,findObject,
  getObjectName, getObjectGroupName, getObjectAsleep, getObjectSize,
  getObjectPosition, getObjectSpeed, getObjectAttribute,
  setObjectPosition, setObjectAsleep, setObjectSpeed, setObjectCurrentPicture, setObjectAttribute,
  replaceObject,
  reverseXSpeed, reverseYSpeed,
  -- ** collision detection
  objectsCollision, objectsFutureCollision,
  objectListObjectCollision, objectListObjectFutureCollision,
  objectTopMapCollision, objectBottomMapCollision, objectRightMapCollision, objectLeftMapCollision,
  pointsObjectCollision, pointsObjectListCollision,
  objectTopMapFutureCollision, objectBottomMapFutureCollision, objectRightMapFutureCollision, objectLeftMapFutureCollision,
  -- ** text operations
  printOnPrompt, printOnScreen, printText,
  -- ** random numbers
  randomFloat, randomInt, randomDouble,
  -- ** utilities
  showFPS,
  wait
) where

import Graphics.UI.Fungen.Types
import Graphics.UI.Fungen.Util
import Graphics.UI.Fungen.Loader
import Graphics.UI.Fungen.Text
import Graphics.UI.Fungen.Map
import Graphics.UI.Fungen.Objects
import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT
import Control.Monad
import Data.IORef
import Text.Printf


-- | A game has the type @Game t s u v@, where 
--  
-- * t is the type of the game special attributes
-- 
-- * s is the type of the object special attributes
-- 
-- * u is the type of the game levels (state)
-- 
-- * v is the type of the map tile special attribute, in case we use a Tile Map as the background of our game
-- 
-- For a mnemonic, uh...
--
-- * t - /T/op-level game attribute type,
--
-- * s - /S/prite object attribute type,
--
-- * u - /U/pdating game state type,
--
-- * v - /V/icinity (map tile) attribute type.
-- 
-- Internally, a Game consists of:
--
-- * @gameMap       :: IORef (GameMap v)         -- a map (background)@
--
-- * @gameState     :: IORef u                   -- initial game state@
--
-- * @gameFlags     :: IORef GameFlags           -- initial game flags@
--
-- * @objManagers   :: IORef [(ObjectManager s)] -- some object managers@
--
-- * @textList      :: IORef [Text]              -- some texts@
--
-- * @quadricObj    :: QuadricPrimitive          -- a quadric thing@
--
-- * @windowConfig  :: IORef WindowConfig        -- a config for the main window@
--
-- * @gameAttribute :: IORef t                   -- a game attribute@
--
-- * @pictureList   :: IORef [TextureObject]     -- some pictures@
--
-- * @fpsInfo       :: IORef (Int,Int,Float)     -- only for debugging@
-- 
data Game t s u v = Game {
        gameMap       :: IORef (GameMap v), -- ^ a map (background)
        gameState     :: IORef u,           -- ^ initial game state
        gameFlags     :: IORef GameFlags,   -- ^ initial game flags
        objManagers   :: IORef [ObjectManager s], -- ^ some object managers
        textList      :: IORef [Text],              -- ^ some texts
        quadricObj    :: QuadricPrimitive,          -- ^ a quadric thing
        windowConfig  :: IORef WindowConfig,        -- ^ a config for the main window
        gameAttribute :: IORef t,                   -- ^ a game attribute
        pictureList   :: IORef [TextureObject],     -- ^ some pictures
        fpsInfo       :: IORef (Int,Int,Float)  -- only for debugging
        }

-- | IOGame is the monad in which game actions run. An IOGame action
-- takes a Game (with type parameters @t s u v@), performs some IO,
-- and returns an updated Game along with a result value (@a@):
--
-- @newtype IOGame t s u v a = IOG (Game  t s u v -> IO (Game t s u v,a))@
--
-- The name IOGame was chosen to remind that each action deals with a
-- Game, but an IO operation can also be performed between game
-- actions (such as the reading of a file or printing something in the
-- prompt).
newtype IOGame t s u v a = IOG (Game  t s u v -> IO (Game t s u v,a))

-- | Game flags: mapDrawing, objectsDrawing, objectsMoving
type GameFlags = (Bool,Bool,Bool)

----------------------------------
-- IOGame Monad definitions
----------------------------------
-- OBS.: all of this stuff is done to encapsulate Monad IO inside
--       Monad IOGame. Thanks to Jay Cox who suggested this solution.

bindST :: IOGame t s u v a -> (a -> IOGame t s u v b) -> IOGame t s u v b
bindST (IOG x) f =
   IOG (x >=> (\ (s', v) -> let IOG g = f v in g s'))

unitST :: a -> IOGame t s u v a
unitST v = IOG (\s -> return (s,v))

instance Functor (IOGame t s u v) where
  fmap = liftM

instance Applicative (IOGame t s u v) where
  pure  = unitST
  (<*>) = ap

instance Monad (IOGame t s u v) where
  (>>=) = bindST

instance MonadFail (IOGame t s u v) where
  fail s = liftIOtoIOGame (fail s)

runIOGame :: IOGame t s u v a -> Game t s u v -> IO (Game t s u v,a)  -- (a,Game t s u v) the state tuple
runIOGame (IOG f) = f

runIOGameM :: IOGame t s u v a -> Game t s u v -> IO ()
runIOGameM x g = void (runIOGame x g)

liftIOtoIOGame      :: IO a -> IOGame t s u v a
liftIOtoIOGame p    =
     IOG $ \s -> (do y <- p
                     return (s,y))

liftIOtoIOGame'     :: (a -> IO ()) -> a -> IOGame t s u v ()
liftIOtoIOGame' p q =
     IOG $ \s -> (do p q
                     return (s,()))

----------------------------------
-- get & set routines
----------------------------------

getMap :: IOGame t s u v (GameMap v)
getMap = IOG ( \game -> readIORef (gameMap game) >>= \gm -> if isMultiMap gm
                                                                then return (game,getCurrentMap gm)
                                                                else return (game,gm))

getRealMap :: IOGame t s u v (GameMap v)
getRealMap = IOG ( \game -> readIORef (gameMap game) >>= \gm -> return (game,gm))

setRealMap :: GameMap v -> IOGame t s u v ()
setRealMap m = IOG ( \game -> writeIORef (gameMap game) m >> return (game,()))


getGameState :: IOGame t s u v u
getGameState = IOG ( \game -> readIORef (gameState game) >>= \gs -> return (game,gs))

setGameState :: u -> IOGame t s u v ()
setGameState s = IOG ( \game -> writeIORef (gameState game) s >> return (game,()))

getTextList :: IOGame t s u v [Text]
getTextList = IOG ( \game -> readIORef (textList game) >>= \tl -> return (game,tl))

setTextList :: [Text] -> IOGame t s u v ()
setTextList t = IOG ( \game -> writeIORef (textList game) t >> return (game,()))

getGameFlags :: IOGame t s u v GameFlags
getGameFlags = IOG ( \game -> readIORef (gameFlags game) >>= \gf -> return (game,gf))

setGameFlags :: GameFlags -> IOGame t s u v ()
setGameFlags f = IOG ( \game -> writeIORef (gameFlags game) f >> return (game,()))

getObjectManagers :: IOGame t s u v [ObjectManager s]
getObjectManagers = IOG ( \game -> readIORef (objManagers game) >>= \om -> return (game,om))

setObjectManagers :: [ObjectManager s] -> IOGame t s u v ()
setObjectManagers o = IOG ( \game -> writeIORef (objManagers game) o >> return (game,()))

getQuadric :: IOGame t s u v QuadricPrimitive
getQuadric = IOG ( \game -> return (game,quadricObj game) )

getPictureList :: IOGame t s u v [TextureObject]
getPictureList = IOG ( \game -> readIORef (pictureList game) >>= \pl -> return (game,pl))

getWindowConfig :: IOGame t s u v WindowConfig
getWindowConfig = IOG ( \game -> readIORef (windowConfig game) >>= \wc -> return (game,wc))

getGameAttribute :: IOGame t s u v t
getGameAttribute = IOG ( \game -> readIORef (gameAttribute game) >>= \ga -> return (game,ga))

setGameAttribute :: t -> IOGame t s u v ()
setGameAttribute ga = IOG ( \game -> writeIORef (gameAttribute game) ga >> return (game,()))

-- internal use only
getFpsInfo :: IOGame t s u v (Int,Int,Float)
getFpsInfo = IOG ( \game -> readIORef (fpsInfo game) >>= \fpsi -> return (game,fpsi))

-- internal use only
setFpsInfo :: (Int,Int,Float) -> IOGame t s u v ()
setFpsInfo f = IOG ( \game -> writeIORef (fpsInfo game) f >> return (game,()))

----------------------------------
-- initialization of the game
----------------------------------
createGame :: GameMap v -> [ObjectManager s] -> WindowConfig -> u -> t -> FilePictureList -> IO (Game t s u v)
createGame gMap objectManagers winConf gState gAttrib filePicList = do
        gM <- newIORef gMap
        gS <- newIORef gState
        gF <- newIORef (True,True,True)
        gO <- newIORef objectManagers
        gT <- newIORef []
        let gQ = Sphere 0 0 0
        gW <- newIORef winConf
        gA <- newIORef gAttrib
        picList <- loadPictures filePicList
        gP <- newIORef picList
        gFPS <- newIORef (0,0,0.0)
        return (Game {
            gameMap       = gM,
            gameState     = gS,
            gameFlags     = gF,
            objManagers   = gO,
            textList      = gT,
            quadricObj    = gQ,
            windowConfig  = gW,
            gameAttribute = gA,
            pictureList   = gP,
            fpsInfo       = gFPS
            })

-- | loads all of the pictures used in the game
loadPictures :: [(FilePath,InvList)] -> IO [TextureObject]
loadPictures pathsAndInvLists = do
        bmps <- loadBitmapList (map pathAndInv2color3List pathsAndInvLists)
        texBmList <- genObjectNames (length bmps)
        texStuff texBmList bmps
        return texBmList

----------------------------------
-- map routines
----------------------------------

-- | draws the background map
drawMap :: IOGame t s u v ()
drawMap = do
    m <- getMap
    p <- getPictureList
    (_,(winWidth, winHeight),_) <- getWindowConfig
    liftIOtoIOGame $ drawGameMap m (fromIntegral winWidth, fromIntegral winHeight) p

-- | returns a mapTile, given its pixel position (x,y) in the screen
getTileFromWindowPosition :: (GLdouble,GLdouble) -> IOGame t s u v (Tile v)
getTileFromWindowPosition (preX,preY) = do
       m <- getMap
       if isTileMap m
            then let (tileXsize,tileYsize) = getTileMapTileSize m
                     (scrollX,scrollY) = getTileMapScroll m
                     (x,y) = (preX + scrollX,preY + scrollY)
                     (sX,sY) = getTileMapSize m
                 in if x >= sX || y >= sY
                        then error ("Game.getTileFromWindowPosition error: pixel " ++ show (x,y) ++ " out of map range!")
                        else getTileFromIndex (fromEnum (y/tileXsize),fromEnum (x/tileYsize)) -- (x,y) window orientation is different than index (x,y)!
            else error "Game.getTileFromWindowPosition error: game map is not a tile map!"

-- | returns a mapTile, given its index (x,y) in the tile map
getTileFromIndex :: (Int,Int) -> IOGame t s u v (Tile v)
getTileFromIndex (x,y) = do
        m <- getMap
        if isTileMap m
            then let matrix = getTileMapTileMatrix m
                     (mapX,mapY) = matrixSize matrix
                 in if mapX >= x && mapY >= y && x >= 0 && y >= 0
                        then return ( matrix !! (mapX - x) !! y)
                        else error ("Game.getTileFromIndex error: tile index " ++ show (x,y) ++ " out of map range!")
            else error "Game.getTileFromIndex error: game map is not a tile map!"

-- | paint the whole screen with a specified RGB color
clearScreen :: GLclampf -> GLclampf -> GLclampf -> IOGame t s u v ()
clearScreen r g b = liftIOtoIOGame $ clearGameScreen r g b

-- | set the current map for a MultiMap
setCurrentMapIndex :: Int -> IOGame t s u v ()
setCurrentMapIndex i = do
        m <- getRealMap
        if isMultiMap m
                then setRealMap (updateCurrentIndex m i)
                else error "Game.setCurrentMapIndex error: you are not working with MultiMaps!"

----------------------------------
-- flags routines
----------------------------------

enableGameFlags :: IOGame t s u v ()
enableGameFlags = setGameFlags (True,True,True)

disableGameFlags :: IOGame t s u v ()
disableGameFlags = setGameFlags (False,False,False)

enableMapDrawing :: IOGame t s u v ()
enableMapDrawing = do
    (_,od,om) <- getGameFlags
    setGameFlags (True,od,om)

disableMapDrawing :: IOGame t s u v ()
disableMapDrawing = do
    (_,od,om) <- getGameFlags
    setGameFlags (False,od,om)

enableObjectsDrawing :: IOGame t s u v ()
enableObjectsDrawing = do
    (md,_,om) <- getGameFlags
    setGameFlags (md,True,om)

disableObjectsDrawing :: IOGame t s u v ()
disableObjectsDrawing = do
    (md,_,om) <- getGameFlags
    setGameFlags (md,False,om)

enableObjectsMoving :: IOGame t s u v ()
enableObjectsMoving = do
    (md,od,_) <- getGameFlags
    setGameFlags (md,od,True)

disableObjectsMoving :: IOGame t s u v ()
disableObjectsMoving = do
    (md,od,_) <- getGameFlags
    setGameFlags (md,od,False)

----------------------------------
-- objects routines
----------------------------------

-- | draws all visible objects
drawAllObjects :: IOGame t s u v ()
drawAllObjects = do
    o <- getObjectManagers
    q <- getQuadric
    p <- getPictureList
    liftIOtoIOGame $ drawGameObjects o q p

-- | draw one object
drawObject :: GameObject s -> IOGame t s u v ()
drawObject o = do
    q <- getQuadric
    p <- getPictureList
    liftIOtoIOGame $ drawGameObject o q p

-- | changes objects position according to its speed
moveAllObjects :: IOGame t s u v ()
moveAllObjects = do
    m <- getObjectManagers
    let newManagers = moveGameObjects m
    setObjectManagers newManagers

-- | destroys objects from the game
destroyObjects :: [GameObject s] -> IOGame t s u v ()
destroyObjects = foldr ((>>) . destroyObject) (return ())

-- | destroys an object from the game
destroyObject :: GameObject s -> IOGame t s u v ()
destroyObject obj = do
    m <- getObjectManagers
    let objName = getGameObjectName obj
    mngName <- getObjectGroupName obj
    let newManagers = destroyGameObject objName mngName m
    setObjectManagers newManagers

-- | returns the list of all objects from the group whose name is given
getObjectsFromGroup :: String -> IOGame t s u v [GameObject s]
getObjectsFromGroup mngName = do
        mng <- findObjectManager mngName
        return (getObjectManagerObjects mng)

-- | adds an object to a previously created group
addObjectsToGroup :: [GameObject s] -> String -> IOGame t s u v ()
addObjectsToGroup objs managerName = do
        -- manager <- findObjectManager managerName
        managers <- getObjectManagers
        let newManagers = addObjectsToManager objs managerName managers
        setObjectManagers newManagers

-- | adds an object to a new group
addObjectsToNewGroup :: [GameObject s] -> String -> IOGame t s u v ()
addObjectsToNewGroup objs newMngName = do
        let newManager = objectGroup newMngName objs
        managers <- getObjectManagers
        setObjectManagers (newManager:managers)

-- | returns an object manager of the game, given its name (internal use)
findObjectManager :: String -> IOGame t s u v (ObjectManager s)
findObjectManager mngName = searchObjectManager mngName <$> getObjectManagers

-- | returns an object of the game, given its name and is object manager name
findObject :: String -> String -> IOGame t s u v (GameObject s)
findObject objName mngName = do
    objectManagers <- getObjectManagers
    let m = searchObjectManager mngName objectManagers
    return (searchGameObject objName m)

-- | there is no need to search through the managers, because the name of an object is
-- never modified so the result of this function will always be safe.
getObjectName :: GameObject s -> IOGame t s u v String
getObjectName o = return (getGameObjectName o)

-- | because an object can have its group (manager) name modified, it is necessary
-- to search through the managers to find it, otherwise this functions won't be safe.
getObjectGroupName :: GameObject s -> IOGame t s u v String
getObjectGroupName o = do managers <- getObjectManagers
                          let obj = findObjectFromId o managers
                          return (getGameObjectManagerName obj)

-- | because an object can have its sleeping status modified, it is necessary
-- to search through the managers to find it, otherwise this functions won't be safe.
getObjectAsleep :: GameObject s -> IOGame t s u v Bool
getObjectAsleep o = do managers <- getObjectManagers
                       let obj = findObjectFromId o managers
                       return (getGameObjectAsleep obj)

-- | because an object can have its size modified, it is necessary
-- to search through the managers to find it, otherwise this functions won't be safe.
getObjectSize :: GameObject s -> IOGame t s u v (GLdouble,GLdouble)
getObjectSize o = do managers <- getObjectManagers
                     let obj = findObjectFromId o managers
                     return (getGameObjectSize obj)

-- | because an object can have its position modified, it is necessary
-- to search through the managers to find it, otherwise this functions won't be safe.
getObjectPosition :: GameObject s -> IOGame t s u v (GLdouble,GLdouble)
getObjectPosition o = do managers <- getObjectManagers
                         let obj = findObjectFromId o managers
                         return (getGameObjectPosition obj)

-- | because an object can have its speed modified, it is necessary
-- to search through the managers to find it, otherwise this functions won't be safe.
getObjectSpeed :: GameObject s -> IOGame t s u v (GLdouble,GLdouble)
getObjectSpeed o = do managers <- getObjectManagers
                      let obj = findObjectFromId o managers
                      return (getGameObjectSpeed obj)

-- | because an object can have its attribute modified, it is necessary
-- to search through the managers to find it, otherwise this functions won't be safe.
getObjectAttribute :: GameObject s -> IOGame t s u v s
getObjectAttribute o = do managers <- getObjectManagers
                          let obj = findObjectFromId o managers
                          return (getGameObjectAttribute obj)

-- | changes the sleeping status of an object, given its new status
setObjectAsleep :: Bool -> GameObject s -> IOGame t s u v ()
setObjectAsleep asleep obj = replaceObject obj (updateObjectAsleep asleep)

-- | changes the position of an object, given its new position
setObjectPosition :: (GLdouble,GLdouble) -> GameObject s -> IOGame t s u v ()
setObjectPosition pos obj = replaceObject obj (updateObjectPosition pos)

-- | changes the speed of an object, given its new speed
setObjectSpeed :: (GLdouble,GLdouble) -> GameObject s -> IOGame t s u v ()
setObjectSpeed speed obj = replaceObject obj (updateObjectSpeed speed)

-- | changes the current picture of a multitextured object
setObjectCurrentPicture :: Int -> GameObject s -> IOGame t s u v ()
setObjectCurrentPicture n obj = do
        picList <- getPictureList
        replaceObject obj (updateObjectPicture n (length picList - 1))

-- | changes the attribute of an object, given its new attribute
setObjectAttribute :: s -> GameObject s -> IOGame t s u v ()
setObjectAttribute a obj = replaceObject obj (updateObjectAttribute a)

-- | replaces an object by a new one, given the old object and the function that must be applied to it.
replaceObject :: GameObject s -> (GameObject s -> GameObject s) -> IOGame t s u v ()
replaceObject obj f = do
    managerName <- getObjectGroupName obj
    oldManagers <- getObjectManagers
    let objectId = getGameObjectId obj
        newManagers = updateObject f objectId managerName oldManagers
    setObjectManagers newManagers

reverseXSpeed :: GameObject s -> IOGame t s u v ()
reverseXSpeed  o = do (vX,vY) <- getObjectSpeed o
                      setObjectSpeed (-vX,vY) o

reverseYSpeed :: GameObject s -> IOGame t s u v ()
reverseYSpeed o = do (vX,vY) <- getObjectSpeed o
                     setObjectSpeed (vX,-vY) o

-----------------------
-- collision routines
-----------------------

-- | checks the collision between an object and the top of the map
objectTopMapCollision :: GameObject s -> IOGame t s u v Bool
objectTopMapCollision o = do
    asleep <- getObjectAsleep o
    if asleep
        then return False
        else do m <- getMap
                (_,pY) <- getObjectPosition o
                (_,sY) <- getObjectSize o
                let (_,mY) = getMapSize m
                return (pY + sY/2 > realToFrac mY)

-- | checks the collision between an object and the top of the map in the next game cicle
objectTopMapFutureCollision :: GameObject s -> IOGame t s u v Bool
objectTopMapFutureCollision o = do
    asleep <- getObjectAsleep o
    if asleep
        then return False
        else do m <- getMap
                (_,pY) <- getObjectPosition o
                (_,vY) <- getObjectSpeed o
                (_,sY) <- getObjectSize o
                let (_,mY) = getMapSize m
                return (pY + sY/2 + vY > realToFrac mY)

-- | checks the collision between an object and the bottom of the map
objectBottomMapCollision :: GameObject s -> IOGame t s u v Bool
objectBottomMapCollision o = do
    asleep <- getObjectAsleep o
    if asleep
        then return False
        else do (_,pY) <- getObjectPosition o
                (_,sY) <- getObjectSize o
                return (pY - sY/2 < 0)

-- | checks the collision between an object and the bottom of the map in the next game cicle
objectBottomMapFutureCollision :: GameObject s -> IOGame t s u v Bool
objectBottomMapFutureCollision o = do
    asleep <- getObjectAsleep o
    if asleep
        then return False
        else do (_,pY) <- getObjectPosition o
                (_,sY) <- getObjectSize o
                (_,vY) <- getObjectSpeed o
                return (pY - sY/2 + vY < 0)

-- | checks the collision between an object and the right side of the map
objectRightMapCollision :: GameObject s -> IOGame t s u v Bool
objectRightMapCollision o = do
    asleep <- getObjectAsleep o
    if asleep
        then return False
        else do m <- getMap
                (pX,_) <- getObjectPosition o
                (sX,_) <- getObjectSize o
                let (mX,_) = getMapSize m
                return (pX + sX/2 > realToFrac mX)

-- | checks the collision between an object and the right side of the map in the next game cicle
objectRightMapFutureCollision :: GameObject s -> IOGame t s u v Bool
objectRightMapFutureCollision o = do
    asleep <- getObjectAsleep o
    if asleep
        then return False
        else do m <- getMap
                (pX,_) <- getObjectPosition o
                (sX,_) <- getObjectSize o
                (vX,_) <- getObjectSpeed o
                let (mX,_) = getMapSize m
                return (pX + sX/2 + vX > realToFrac mX)

-- | checks the collision between an object and the left side of the map
objectLeftMapCollision :: GameObject s -> IOGame t s u v Bool
objectLeftMapCollision o = do
    asleep <- getObjectAsleep o
    if asleep
        then return False
        else do (pX,_) <- getObjectPosition o
                (sX,_) <- getObjectSize o
                return (pX - sX/2 < 0)

-- | checks the collision between an object and the left side of the map in the next game cicle
objectLeftMapFutureCollision :: GameObject s -> IOGame t s u v Bool
objectLeftMapFutureCollision o = do
    asleep <- getObjectAsleep o
    if asleep
        then return False
        else do (pX,_) <- getObjectPosition o
                (sX,_) <- getObjectSize o
                (vX,_) <- getObjectSpeed o
                return (pX - sX/2 + vX < 0)

-- | checks the collision between two objects
objectsCollision :: GameObject s -> GameObject s -> IOGame t s u v Bool
objectsCollision o1 o2 = do
    asleep1 <- getObjectAsleep o1
    asleep2 <- getObjectAsleep o2
    if asleep1 || asleep2
                then return False
                else  do (p1X,p1Y) <- getObjectPosition o1
                         (p2X,p2Y) <- getObjectPosition o2
                         (s1X,s1Y) <- getObjectSize o1
                         (s2X,s2Y) <- getObjectSize o2

                         let aX1 = p1X - s1X/2
                             aX2 = p1X + s1X/2
                             aY1 = p1Y - s1Y/2
                             aY2 = p1Y + s1Y/2

                             bX1 = p2X - s2X/2
                             bX2 = p2X + s2X/2
                             bY1 = p2Y - s2Y/2
                             bY2 = p2Y + s2Y/2

                         return (bX1 < aX2 && aX1 < bX2 && bY1 < aY2 && aY1 < bY2)

-- | checks the collision between two objects in the next game cicle
objectsFutureCollision :: GameObject s -> GameObject s -> IOGame t s u v Bool
objectsFutureCollision o1 o2 = do
    asleep1 <- getObjectAsleep o1
    asleep2 <- getObjectAsleep o2
    if asleep1 || asleep2
                then return False
                else do (p1X,p1Y) <- getObjectPosition o1
                        (p2X,p2Y) <- getObjectPosition o2
                        (v1X,v1Y) <- getObjectSpeed o1
                        (v2X,v2Y) <- getObjectSpeed o2
                        (s1X,s1Y) <- getObjectSize o1
                        (s2X,s2Y) <- getObjectSize o2

                        let aX1 = p1X - s1X/2 + v1X
                            aX2 = p1X + s1X/2 + v1X
                            aY1 = p1Y - s1Y/2 + v1Y
                            aY2 = p1Y + s1Y/2 + v1Y

                            bX1 = p2X - s2X/2 + v2X
                            bX2 = p2X + s2X/2 + v2X
                            bY1 = p2Y - s2Y/2 + v2Y
                            bY2 = p2Y + s2Y/2 + v2Y
                        return (bX1 < aX2 && aX1 < bX2 && bY1 < aY2 && aY1 < bY2)

objectListObjectCollision :: [GameObject s] -> GameObject s -> IOGame t s u v Bool
objectListObjectCollision [] _ = return False
objectListObjectCollision (a:as) b = do
        col <- objectsCollision a b
        if col
                then return True
                else objectListObjectCollision as b

objectListObjectFutureCollision :: [GameObject s] -> GameObject s -> IOGame t s u v Bool
objectListObjectFutureCollision [] _ = return False
objectListObjectFutureCollision (a:as) b = do
        col <- objectsFutureCollision a b
        if col
                then return True
                else objectListObjectFutureCollision as b

pointsObjectCollision :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> GameObject s -> IOGame t s u v Bool
pointsObjectCollision p1X p1Y s1X s1Y o2 = do
        asleep <- getObjectAsleep o2
        if asleep
                then return False
                else do (p2X,p2Y) <- getObjectPosition o2
                        (s2X,s2Y) <- getObjectSize o2

                        let aX1 = p1X - s1X/2
                            aX2 = p1X + s1X/2
                            aY1 = p1Y - s1Y/2
                            aY2 = p1Y + s1Y/2

                            bX1 = p2X - s2X/2
                            bX2 = p2X + s2X/2
                            bY1 = p2Y - s2Y/2
                            bY2 = p2Y + s2Y/2
                        return (bX1 < aX2 && aX1 < bX2 && bY1 < aY2 && aY1 < bY2)

pointsObjectListCollision :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> [GameObject s] -> IOGame t s u v Bool
pointsObjectListCollision _ _ _ _ [] = return False
pointsObjectListCollision p1X p1Y s1X s1Y (o:os) = do
        col <- pointsObjectCollision p1X p1Y s1X s1Y o
        if col
                then return True
                else pointsObjectListCollision p1X p1Y s1X s1Y os

-----------------------------------------------
--              TEXT ROUTINES                --
-----------------------------------------------
-- | prints a string in the prompt
printOnPrompt :: Show a => a -> IOGame t s u v ()
printOnPrompt = liftIOtoIOGame' print

-- | prints a string in the current window
printOnScreen :: String -> BitmapFont -> (GLdouble,GLdouble) -> GLclampf -> GLclampf -> GLclampf -> IOGame t s u v ()
printOnScreen text font pos r g b = do
        t <- getTextList
        setTextList ((text,font,pos,r,g,b) : t)

-- | internal use of the engine
printText :: IOGame t s u v ()
printText = do
        t <- getTextList
        liftIOtoIOGame $ putGameText t
        setTextList []

-----------------------------------------------
--     RANDOM NUMBER GENERATOR ROUTINES      --
-----------------------------------------------
randomInt :: (Int,Int) -> IOGame t s u v Int
randomInt (x,y) = liftIOtoIOGame $ randInt (x,y)

randomFloat :: (Float,Float) -> IOGame t s u v Float
randomFloat (x,y) = liftIOtoIOGame $ randFloat (x,y)

randomDouble :: (Double,Double) -> IOGame t s u v Double
randomDouble (x,y) = liftIOtoIOGame $ randDouble (x,y)

-----------------------------------------------
--           DEBUGGING ROUTINES              --
-----------------------------------------------

-- | shows the frame rate (or frame per seconds) 
showFPS :: BitmapFont -> (GLdouble,GLdouble) -> GLclampf -> GLclampf -> GLclampf -> IOGame t s u v ()
showFPS font pos r g b = do
        (framei,timebasei,fps) <- getFpsInfo
        timei <- getElapsedTime
        let frame = toEnum (framei + 1) :: Float
            timebase = toEnum timebasei :: Float
            time = toEnum timei :: Float
        if timei - timebasei > 1000
                then setFpsInfo (0,timei,frame*toEnum 1000/(time-timebase))
                else setFpsInfo (framei + 1,timebasei,fps)
        printOnScreen (printf "%.1f" fps) font pos r g b

-- | get the elapsed time of the game
getElapsedTime :: IOGame t s u v Int
getElapsedTime = liftIOtoIOGame $ get elapsedTime

-- | delay for N  seconds while continuing essential game functions
wait :: Int -> IOGame t s u v ()
wait delay = do
        printText                                   -- force text messages to be printed (is not working properly!)
        (framei,timebasei,fps) <- getFpsInfo
        setFpsInfo (framei,timebasei + delay,fps) -- helps FPS info to be displayed correctly (if requested)
        startTime <- getElapsedTime

        waitAux delay startTime

waitAux :: Int -> Int -> IOGame t s u v ()
waitAux delay startTime = do
        presentTime <- getElapsedTime
        if presentTime - startTime > delay
                then return ()
                else waitAux delay startTime


