{-# 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 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.Applicative (Applicative(..)) 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 (\s -> ( x s >>= \(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 = return (<*>) = ap instance Monad (IOGame t s u v) where (>>=) = bindST return = unitST 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) g = f g runIOGameM :: IOGame t s u v a -> Game t s u v -> IO () runIOGameM x g = runIOGame x g >> return () 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 [] = return () destroyObjects (o:os) = destroyObject o >> destroyObjects os -- | 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 = do objectManagers <- getObjectManagers return (searchObjectManager mngName objectManagers) -- | 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 a = liftIOtoIOGame' print a -- | 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