{-# 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
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative(..))
#endif
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 {
        Game t s u v -> IORef (GameMap v)
gameMap       :: IORef (GameMap v), -- ^ a map (background)

        Game t s u v -> IORef u
gameState     :: IORef u,           -- ^ initial game state

        Game t s u v -> IORef GameFlags
gameFlags     :: IORef GameFlags,   -- ^ initial game flags

        Game t s u v -> IORef [ObjectManager s]
objManagers   :: IORef [(ObjectManager s)], -- ^ some object managers

        Game t s u v -> IORef [Text]
textList      :: IORef [Text],              -- ^ some texts

        Game t s u v -> QuadricPrimitive
quadricObj    :: QuadricPrimitive,          -- ^ a quadric thing

        Game t s u v -> IORef WindowConfig
windowConfig  :: IORef WindowConfig,        -- ^ a config for the main window

        Game t s u v -> IORef t
gameAttribute :: IORef t,                   -- ^ a game attribute

        Game t s u v -> IORef [TextureObject]
pictureList   :: IORef [TextureObject],     -- ^ some pictures

        Game t s u v -> IORef (Int, Int, Float)
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 :: IOGame t s u v a -> (a -> IOGame t s u v b) -> IOGame t s u v b
bindST (IOG Game t s u v -> IO (Game t s u v, a)
x) a -> IOGame t s u v b
f =
   (Game t s u v -> IO (Game t s u v, b)) -> IOGame t s u v b
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG (\Game t s u v
s -> ( Game t s u v -> IO (Game t s u v, a)
x Game t s u v
s IO (Game t s u v, a)
-> ((Game t s u v, a) -> IO (Game t s u v, b))
-> IO (Game t s u v, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Game t s u v
s',a
v) -> let IOG Game t s u v -> IO (Game t s u v, b)
g = a -> IOGame t s u v b
f a
v in Game t s u v -> IO (Game t s u v, b)
g Game t s u v
s'))

unitST :: a -> IOGame t s u v a
unitST :: a -> IOGame t s u v a
unitST a
v = (Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG (\Game t s u v
s -> (Game t s u v, a) -> IO (Game t s u v, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
s,a
v))

instance Functor (IOGame t s u v) where
  fmap :: (a -> b) -> IOGame t s u v a -> IOGame t s u v b
fmap = (a -> b) -> IOGame t s u v a -> IOGame t s u v b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative (IOGame t s u v) where
  pure :: a -> IOGame t s u v a
pure  = a -> IOGame t s u v a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: IOGame t s u v (a -> b) -> IOGame t s u v a -> IOGame t s u v b
(<*>) = IOGame t s u v (a -> b) -> IOGame t s u v a -> IOGame t s u v b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (IOGame t s u v) where
  >>= :: IOGame t s u v a -> (a -> IOGame t s u v b) -> IOGame t s u v b
(>>=) = IOGame t s u v a -> (a -> IOGame t s u v b) -> IOGame t s u v b
forall t s u v a b.
IOGame t s u v a -> (a -> IOGame t s u v b) -> IOGame t s u v b
bindST
  return :: a -> IOGame t s u v a
return = a -> IOGame t s u v a
forall a t s u v. a -> IOGame t s u v a
unitST

instance MonadFail (IOGame t s u v) where
  fail :: String -> IOGame t s u v a
fail String
s = IO a -> IOGame t s u v a
forall a t s u v. IO a -> IOGame t s u v a
liftIOtoIOGame (String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
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 :: IOGame t s u v a -> Game t s u v -> IO (Game t s u v, a)
runIOGame (IOG Game t s u v -> IO (Game t s u v, a)
f) Game t s u v
g = Game t s u v -> IO (Game t s u v, a)
f Game t s u v
g

runIOGameM :: IOGame t s u v a -> Game t s u v -> IO ()
runIOGameM :: IOGame t s u v a -> Game t s u v -> IO ()
runIOGameM IOGame t s u v a
x Game t s u v
g = IOGame t s u v a -> Game t s u v -> IO (Game t s u v, a)
forall t s u v a.
IOGame t s u v a -> Game t s u v -> IO (Game t s u v, a)
runIOGame IOGame t s u v a
x Game t s u v
g IO (Game t s u v, a) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                 
liftIOtoIOGame      :: IO a -> IOGame t s u v a
liftIOtoIOGame :: IO a -> IOGame t s u v a
liftIOtoIOGame IO a
p    =
     (Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ((Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a)
-> (Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
forall a b. (a -> b) -> a -> b
$ \Game t s u v
s -> (do a
y <- IO a
p
                     (Game t s u v, a) -> IO (Game t s u v, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
s,a
y))
                     
liftIOtoIOGame'     :: (a -> IO ()) -> a -> IOGame t s u v ()
liftIOtoIOGame' :: (a -> IO ()) -> a -> IOGame t s u v ()
liftIOtoIOGame' a -> IO ()
p a
q =
     (Game t s u v -> IO (Game t s u v, ())) -> IOGame t s u v ()
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ((Game t s u v -> IO (Game t s u v, ())) -> IOGame t s u v ())
-> (Game t s u v -> IO (Game t s u v, ())) -> IOGame t s u v ()
forall a b. (a -> b) -> a -> b
$ \Game t s u v
s -> (do a -> IO ()
p a
q
                     (Game t s u v, ()) -> IO (Game t s u v, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
s,()))

----------------------------------

-- get & set routines

----------------------------------


getMap :: IOGame t s u v (GameMap v)
getMap :: IOGame t s u v (GameMap v)
getMap = (Game t s u v -> IO (Game t s u v, GameMap v))
-> IOGame t s u v (GameMap v)
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ( \Game t s u v
game -> (IORef (GameMap v) -> IO (GameMap v)
forall a. IORef a -> IO a
readIORef (Game t s u v -> IORef (GameMap v)
forall t s u v. Game t s u v -> IORef (GameMap v)
gameMap Game t s u v
game) IO (GameMap v)
-> (GameMap v -> IO (Game t s u v, GameMap v))
-> IO (Game t s u v, GameMap v)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \GameMap v
gm -> if (GameMap v -> Bool
forall t. GameMap t -> Bool
isMultiMap GameMap v
gm)
                                                                then ((Game t s u v, GameMap v) -> IO (Game t s u v, GameMap v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,GameMap v -> GameMap v
forall t. GameMap t -> GameMap t
getCurrentMap GameMap v
gm))
                                                                else ((Game t s u v, GameMap v) -> IO (Game t s u v, GameMap v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,GameMap v
gm)) ))

getRealMap :: IOGame t s u v (GameMap v)
getRealMap :: IOGame t s u v (GameMap v)
getRealMap = (Game t s u v -> IO (Game t s u v, GameMap v))
-> IOGame t s u v (GameMap v)
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ( \Game t s u v
game -> (IORef (GameMap v) -> IO (GameMap v)
forall a. IORef a -> IO a
readIORef (Game t s u v -> IORef (GameMap v)
forall t s u v. Game t s u v -> IORef (GameMap v)
gameMap Game t s u v
game) IO (GameMap v)
-> (GameMap v -> IO (Game t s u v, GameMap v))
-> IO (Game t s u v, GameMap v)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \GameMap v
gm -> ((Game t s u v, GameMap v) -> IO (Game t s u v, GameMap v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,GameMap v
gm)) ))

setRealMap :: GameMap v -> IOGame t s u v ()
setRealMap :: GameMap v -> IOGame t s u v ()
setRealMap GameMap v
m = (Game t s u v -> IO (Game t s u v, ())) -> IOGame t s u v ()
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ( \Game t s u v
game -> (IORef (GameMap v) -> GameMap v -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Game t s u v -> IORef (GameMap v)
forall t s u v. Game t s u v -> IORef (GameMap v)
gameMap Game t s u v
game) GameMap v
m IO () -> IO (Game t s u v, ()) -> IO (Game t s u v, ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Game t s u v, ()) -> IO (Game t s u v, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,()) ))


getGameState :: IOGame t s u v u
getGameState :: IOGame t s u v u
getGameState = (Game t s u v -> IO (Game t s u v, u)) -> IOGame t s u v u
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ( \Game t s u v
game -> (IORef u -> IO u
forall a. IORef a -> IO a
readIORef (Game t s u v -> IORef u
forall t s u v. Game t s u v -> IORef u
gameState Game t s u v
game) IO u -> (u -> IO (Game t s u v, u)) -> IO (Game t s u v, u)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \u
gs -> (Game t s u v, u) -> IO (Game t s u v, u)
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,u
gs) ))

setGameState :: u -> IOGame t s u v ()
setGameState :: u -> IOGame t s u v ()
setGameState u
s = (Game t s u v -> IO (Game t s u v, ())) -> IOGame t s u v ()
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ( \Game t s u v
game -> (IORef u -> u -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Game t s u v -> IORef u
forall t s u v. Game t s u v -> IORef u
gameState Game t s u v
game) u
s IO () -> IO (Game t s u v, ()) -> IO (Game t s u v, ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Game t s u v, ()) -> IO (Game t s u v, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,()) ))

getTextList :: IOGame t s u v [Text]
getTextList :: IOGame t s u v [Text]
getTextList = (Game t s u v -> IO (Game t s u v, [Text]))
-> IOGame t s u v [Text]
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ( \Game t s u v
game -> (IORef [Text] -> IO [Text]
forall a. IORef a -> IO a
readIORef (Game t s u v -> IORef [Text]
forall t s u v. Game t s u v -> IORef [Text]
textList Game t s u v
game) IO [Text]
-> ([Text] -> IO (Game t s u v, [Text]))
-> IO (Game t s u v, [Text])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Text]
tl -> (Game t s u v, [Text]) -> IO (Game t s u v, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,[Text]
tl) ))

setTextList :: [Text] -> IOGame t s u v ()
setTextList :: [Text] -> IOGame t s u v ()
setTextList [Text]
t = (Game t s u v -> IO (Game t s u v, ())) -> IOGame t s u v ()
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ( \Game t s u v
game -> (IORef [Text] -> [Text] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Game t s u v -> IORef [Text]
forall t s u v. Game t s u v -> IORef [Text]
textList Game t s u v
game) [Text]
t IO () -> IO (Game t s u v, ()) -> IO (Game t s u v, ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Game t s u v, ()) -> IO (Game t s u v, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,()) ))

getGameFlags :: IOGame t s u v GameFlags
getGameFlags :: IOGame t s u v GameFlags
getGameFlags = (Game t s u v -> IO (Game t s u v, GameFlags))
-> IOGame t s u v GameFlags
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ( \Game t s u v
game -> (IORef GameFlags -> IO GameFlags
forall a. IORef a -> IO a
readIORef (Game t s u v -> IORef GameFlags
forall t s u v. Game t s u v -> IORef GameFlags
gameFlags Game t s u v
game) IO GameFlags
-> (GameFlags -> IO (Game t s u v, GameFlags))
-> IO (Game t s u v, GameFlags)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \GameFlags
gf -> (Game t s u v, GameFlags) -> IO (Game t s u v, GameFlags)
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,GameFlags
gf) ))

setGameFlags :: GameFlags -> IOGame t s u v ()
setGameFlags :: GameFlags -> IOGame t s u v ()
setGameFlags GameFlags
f = (Game t s u v -> IO (Game t s u v, ())) -> IOGame t s u v ()
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ( \Game t s u v
game -> (IORef GameFlags -> GameFlags -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Game t s u v -> IORef GameFlags
forall t s u v. Game t s u v -> IORef GameFlags
gameFlags Game t s u v
game) GameFlags
f IO () -> IO (Game t s u v, ()) -> IO (Game t s u v, ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Game t s u v, ()) -> IO (Game t s u v, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,()) ))

getObjectManagers :: IOGame t s u v [(ObjectManager s)]
getObjectManagers :: IOGame t s u v [ObjectManager s]
getObjectManagers = (Game t s u v -> IO (Game t s u v, [ObjectManager s]))
-> IOGame t s u v [ObjectManager s]
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ( \Game t s u v
game -> (IORef [ObjectManager s] -> IO [ObjectManager s]
forall a. IORef a -> IO a
readIORef (Game t s u v -> IORef [ObjectManager s]
forall t s u v. Game t s u v -> IORef [ObjectManager s]
objManagers Game t s u v
game) IO [ObjectManager s]
-> ([ObjectManager s] -> IO (Game t s u v, [ObjectManager s]))
-> IO (Game t s u v, [ObjectManager s])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[ObjectManager s]
om -> (Game t s u v, [ObjectManager s])
-> IO (Game t s u v, [ObjectManager s])
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,[ObjectManager s]
om) ))

setObjectManagers :: [(ObjectManager s)] -> IOGame t s u v ()
setObjectManagers :: [ObjectManager s] -> IOGame t s u v ()
setObjectManagers [ObjectManager s]
o = (Game t s u v -> IO (Game t s u v, ())) -> IOGame t s u v ()
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ( \Game t s u v
game -> (IORef [ObjectManager s] -> [ObjectManager s] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Game t s u v -> IORef [ObjectManager s]
forall t s u v. Game t s u v -> IORef [ObjectManager s]
objManagers Game t s u v
game) [ObjectManager s]
o IO () -> IO (Game t s u v, ()) -> IO (Game t s u v, ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Game t s u v, ()) -> IO (Game t s u v, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,()) ))
                                                   
getQuadric :: IOGame t s u v QuadricPrimitive
getQuadric :: IOGame t s u v QuadricPrimitive
getQuadric = (Game t s u v -> IO (Game t s u v, QuadricPrimitive))
-> IOGame t s u v QuadricPrimitive
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ( \Game t s u v
game -> (Game t s u v, QuadricPrimitive)
-> IO (Game t s u v, QuadricPrimitive)
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,Game t s u v -> QuadricPrimitive
forall t s u v. Game t s u v -> QuadricPrimitive
quadricObj Game t s u v
game) )

getPictureList :: IOGame t s u v [TextureObject]
getPictureList :: IOGame t s u v [TextureObject]
getPictureList = (Game t s u v -> IO (Game t s u v, [TextureObject]))
-> IOGame t s u v [TextureObject]
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ( \Game t s u v
game -> (IORef [TextureObject] -> IO [TextureObject]
forall a. IORef a -> IO a
readIORef (Game t s u v -> IORef [TextureObject]
forall t s u v. Game t s u v -> IORef [TextureObject]
pictureList Game t s u v
game) IO [TextureObject]
-> ([TextureObject] -> IO (Game t s u v, [TextureObject]))
-> IO (Game t s u v, [TextureObject])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[TextureObject]
pl -> (Game t s u v, [TextureObject])
-> IO (Game t s u v, [TextureObject])
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,[TextureObject]
pl) ))

getWindowConfig :: IOGame t s u v WindowConfig
getWindowConfig :: IOGame t s u v WindowConfig
getWindowConfig = (Game t s u v -> IO (Game t s u v, WindowConfig))
-> IOGame t s u v WindowConfig
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ( \Game t s u v
game -> (IORef WindowConfig -> IO WindowConfig
forall a. IORef a -> IO a
readIORef (Game t s u v -> IORef WindowConfig
forall t s u v. Game t s u v -> IORef WindowConfig
windowConfig Game t s u v
game) IO WindowConfig
-> (WindowConfig -> IO (Game t s u v, WindowConfig))
-> IO (Game t s u v, WindowConfig)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \WindowConfig
wc -> (Game t s u v, WindowConfig) -> IO (Game t s u v, WindowConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,WindowConfig
wc) ))

getGameAttribute :: IOGame t s u v t
getGameAttribute :: IOGame t s u v t
getGameAttribute = (Game t s u v -> IO (Game t s u v, t)) -> IOGame t s u v t
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ( \Game t s u v
game -> (IORef t -> IO t
forall a. IORef a -> IO a
readIORef (Game t s u v -> IORef t
forall t s u v. Game t s u v -> IORef t
gameAttribute Game t s u v
game) IO t -> (t -> IO (Game t s u v, t)) -> IO (Game t s u v, t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t
ga -> (Game t s u v, t) -> IO (Game t s u v, t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,t
ga) ))

setGameAttribute :: t -> IOGame t s u v ()
setGameAttribute :: t -> IOGame t s u v ()
setGameAttribute t
ga = (Game t s u v -> IO (Game t s u v, ())) -> IOGame t s u v ()
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ( \Game t s u v
game -> (IORef t -> t -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Game t s u v -> IORef t
forall t s u v. Game t s u v -> IORef t
gameAttribute Game t s u v
game) t
ga IO () -> IO (Game t s u v, ()) -> IO (Game t s u v, ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Game t s u v, ()) -> IO (Game t s u v, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,()) ))

-- internal use only

getFpsInfo :: IOGame t s u v (Int,Int,Float)
getFpsInfo :: IOGame t s u v (Int, Int, Float)
getFpsInfo = (Game t s u v -> IO (Game t s u v, (Int, Int, Float)))
-> IOGame t s u v (Int, Int, Float)
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ( \Game t s u v
game -> (IORef (Int, Int, Float) -> IO (Int, Int, Float)
forall a. IORef a -> IO a
readIORef (Game t s u v -> IORef (Int, Int, Float)
forall t s u v. Game t s u v -> IORef (Int, Int, Float)
fpsInfo Game t s u v
game) IO (Int, Int, Float)
-> ((Int, Int, Float) -> IO (Game t s u v, (Int, Int, Float)))
-> IO (Game t s u v, (Int, Int, Float))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int, Int, Float)
fpsi -> (Game t s u v, (Int, Int, Float))
-> IO (Game t s u v, (Int, Int, Float))
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,(Int, Int, Float)
fpsi) ))

-- internal use only

setFpsInfo :: (Int,Int,Float) -> IOGame t s u v ()
setFpsInfo :: (Int, Int, Float) -> IOGame t s u v ()
setFpsInfo (Int, Int, Float)
f = (Game t s u v -> IO (Game t s u v, ())) -> IOGame t s u v ()
forall t s u v a.
(Game t s u v -> IO (Game t s u v, a)) -> IOGame t s u v a
IOG ( \Game t s u v
game -> (IORef (Int, Int, Float) -> (Int, Int, Float) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Game t s u v -> IORef (Int, Int, Float)
forall t s u v. Game t s u v -> IORef (Int, Int, Float)
fpsInfo Game t s u v
game) (Int, Int, Float)
f IO () -> IO (Game t s u v, ()) -> IO (Game t s u v, ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Game t s u v, ()) -> IO (Game t s u v, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Game t s u v
game,()) ))
                                                   
----------------------------------

-- initialization of the game

----------------------------------

createGame :: GameMap v -> [(ObjectManager s)] -> WindowConfig -> u -> t -> FilePictureList -> IO (Game t s u v)
createGame :: GameMap v
-> [ObjectManager s]
-> WindowConfig
-> u
-> t
-> FilePictureList
-> IO (Game t s u v)
createGame GameMap v
gMap [ObjectManager s]
objectManagers WindowConfig
winConf u
gState t
gAttrib FilePictureList
filePicList = do
        IORef (GameMap v)
gM <- GameMap v -> IO (IORef (GameMap v))
forall a. a -> IO (IORef a)
newIORef GameMap v
gMap
        IORef u
gS <- u -> IO (IORef u)
forall a. a -> IO (IORef a)
newIORef u
gState
        IORef GameFlags
gF <- GameFlags -> IO (IORef GameFlags)
forall a. a -> IO (IORef a)
newIORef (Bool
True,Bool
True,Bool
True)
        IORef [ObjectManager s]
gO <- [ObjectManager s] -> IO (IORef [ObjectManager s])
forall a. a -> IO (IORef a)
newIORef [ObjectManager s]
objectManagers
        IORef [Text]
gT <- [Text] -> IO (IORef [Text])
forall a. a -> IO (IORef a)
newIORef []
        let gQ :: QuadricPrimitive
gQ = Radius -> Slices -> Slices -> QuadricPrimitive
Sphere Radius
0 Slices
0 Slices
0
        IORef WindowConfig
gW <- WindowConfig -> IO (IORef WindowConfig)
forall a. a -> IO (IORef a)
newIORef WindowConfig
winConf
        IORef t
gA <- t -> IO (IORef t)
forall a. a -> IO (IORef a)
newIORef t
gAttrib
        [TextureObject]
picList <- FilePictureList -> IO [TextureObject]
loadPictures FilePictureList
filePicList
        IORef [TextureObject]
gP <- [TextureObject] -> IO (IORef [TextureObject])
forall a. a -> IO (IORef a)
newIORef [TextureObject]
picList
        IORef (Int, Int, Float)
gFPS <- (Int, Int, Float) -> IO (IORef (Int, Int, Float))
forall a. a -> IO (IORef a)
newIORef (Int
0,Int
0,Float
0.0)
        Game t s u v -> IO (Game t s u v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Game :: forall t s u v.
IORef (GameMap v)
-> IORef u
-> IORef GameFlags
-> IORef [ObjectManager s]
-> IORef [Text]
-> QuadricPrimitive
-> IORef WindowConfig
-> IORef t
-> IORef [TextureObject]
-> IORef (Int, Int, Float)
-> Game t s u v
Game {
            gameMap :: IORef (GameMap v)
gameMap       = IORef (GameMap v)
gM,
            gameState :: IORef u
gameState     = IORef u
gS,
            gameFlags :: IORef GameFlags
gameFlags     = IORef GameFlags
gF,
            objManagers :: IORef [ObjectManager s]
objManagers   = IORef [ObjectManager s]
gO,
            textList :: IORef [Text]
textList      = IORef [Text]
gT,
            quadricObj :: QuadricPrimitive
quadricObj    = QuadricPrimitive
gQ,
            windowConfig :: IORef WindowConfig
windowConfig  = IORef WindowConfig
gW,
            gameAttribute :: IORef t
gameAttribute = IORef t
gA,
            pictureList :: IORef [TextureObject]
pictureList   = IORef [TextureObject]
gP,
            fpsInfo :: IORef (Int, Int, Float)
fpsInfo       = IORef (Int, Int, Float)
gFPS
            })

-- | loads all of the pictures used in the game

loadPictures :: [(FilePath,InvList)] -> IO [TextureObject]
loadPictures :: FilePictureList -> IO [TextureObject]
loadPictures FilePictureList
pathsAndInvLists = do
        [AwbfBitmap]
bmps <- [(String, Maybe ColorList3)] -> IO [AwbfBitmap]
loadBitmapList (((String, InvList) -> (String, Maybe ColorList3))
-> FilePictureList -> [(String, Maybe ColorList3)]
forall a b. (a -> b) -> [a] -> [b]
map (String, InvList) -> (String, Maybe ColorList3)
pathAndInv2color3List FilePictureList
pathsAndInvLists)
        [TextureObject]
texBmList <- Int -> IO [TextureObject]
forall a (m :: * -> *).
(GeneratableObjectName a, MonadIO m) =>
Int -> m [a]
genObjectNames ([AwbfBitmap] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AwbfBitmap]
bmps)
        [TextureObject] -> [AwbfBitmap] -> IO ()
texStuff [TextureObject]
texBmList [AwbfBitmap]
bmps
        [TextureObject] -> IO [TextureObject]
forall (m :: * -> *) a. Monad m => a -> m a
return [TextureObject]
texBmList

----------------------------------

-- map routines

----------------------------------


-- | draws the background map

drawMap :: IOGame t s u v ()
drawMap :: IOGame t s u v ()
drawMap = do
    GameMap v
m <- IOGame t s u v (GameMap v)
forall t s u v. IOGame t s u v (GameMap v)
getMap
    [TextureObject]
p <- IOGame t s u v [TextureObject]
forall t s u v. IOGame t s u v [TextureObject]
getPictureList
    ((Int, Int)
_,(Int
winWidth, Int
winHeight),String
_) <- IOGame t s u v WindowConfig
forall t s u v. IOGame t s u v WindowConfig
getWindowConfig
    IO () -> IOGame t s u v ()
forall a t s u v. IO a -> IOGame t s u v a
liftIOtoIOGame (IO () -> IOGame t s u v ()) -> IO () -> IOGame t s u v ()
forall a b. (a -> b) -> a -> b
$ GameMap v -> Point2D -> [TextureObject] -> IO ()
forall t. GameMap t -> Point2D -> [TextureObject] -> IO ()
drawGameMap GameMap v
m (Int -> Radius
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
winWidth, Int -> Radius
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
winHeight) [TextureObject]
p

-- | returns a mapTile, given its pixel position (x,y) in the screen

getTileFromWindowPosition :: (GLdouble,GLdouble) -> IOGame t s u v (Tile v)
getTileFromWindowPosition :: Point2D -> IOGame t s u v (Tile v)
getTileFromWindowPosition (Radius
preX,Radius
preY) = do
       GameMap v
m <- IOGame t s u v (GameMap v)
forall t s u v. IOGame t s u v (GameMap v)
getMap
       if (GameMap v -> Bool
forall t. GameMap t -> Bool
isTileMap GameMap v
m)
            then let (Radius
tileXsize,Radius
tileYsize) = GameMap v -> Point2D
forall t. GameMap t -> Point2D
getTileMapTileSize GameMap v
m
                     (Radius
scrollX,Radius
scrollY) = GameMap v -> Point2D
forall t. GameMap t -> Point2D
getTileMapScroll GameMap v
m
                     (Radius
x,Radius
y) = (Radius
preX Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ Radius
scrollX,Radius
preY Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ Radius
scrollY)
                     (Radius
sX,Radius
sY) = GameMap v -> Point2D
forall t. GameMap t -> Point2D
getTileMapSize GameMap v
m
                 in if (Radius
x Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
>= Radius
sX Bool -> Bool -> Bool
|| Radius
y Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
>= Radius
sY)
                        then String -> IOGame t s u v (Tile v)
forall a. HasCallStack => String -> a
error (String
"Game.getTileFromWindowPosition error: pixel " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Point2D -> String
forall a. Show a => a -> String
show (Radius
x,Radius
y)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" out of map range!")
                        else (Int, Int) -> IOGame t s u v (Tile v)
forall t s u v. (Int, Int) -> IOGame t s u v (Tile v)
getTileFromIndex (Radius -> Int
forall a. Enum a => a -> Int
fromEnum (Radius
yRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
tileXsize),Radius -> Int
forall a. Enum a => a -> Int
fromEnum (Radius
xRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
tileYsize)) -- (x,y) window orientation is different than index (x,y)!

            else String -> IOGame t s u v (Tile v)
forall a. HasCallStack => String -> a
error String
"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 :: (Int, Int) -> IOGame t s u v (Tile v)
getTileFromIndex (Int
x,Int
y) = do
        GameMap v
m <- IOGame t s u v (GameMap v)
forall t s u v. IOGame t s u v (GameMap v)
getMap
        if (GameMap v -> Bool
forall t. GameMap t -> Bool
isTileMap GameMap v
m)
            then let matrix :: TileMatrix v
matrix = GameMap v -> TileMatrix v
forall t. GameMap t -> TileMatrix t
getTileMapTileMatrix GameMap v
m
                     (Int
mapX,Int
mapY) = TileMatrix v -> (Int, Int)
forall a. [[a]] -> (Int, Int)
matrixSize TileMatrix v
matrix
                 in if (Int
mapX Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
x Bool -> Bool -> Bool
&& Int
mapY Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
y Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0)
                        then Tile v -> IOGame t s u v (Tile v)
forall (m :: * -> *) a. Monad m => a -> m a
return ( (TileMatrix v
matrix TileMatrix v -> Int -> [Tile v]
forall a. [a] -> Int -> a
!! (Int
mapX Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x)) [Tile v] -> Int -> Tile v
forall a. [a] -> Int -> a
!! Int
y)
                        else String -> IOGame t s u v (Tile v)
forall a. HasCallStack => String -> a
error (String
"Game.getTileFromIndex error: tile index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((Int, Int) -> String
forall a. Show a => a -> String
show (Int
x,Int
y)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" out of map range!")
            else String -> IOGame t s u v (Tile v)
forall a. HasCallStack => String -> a
error String
"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 :: Float -> Float -> Float -> IOGame t s u v ()
clearScreen Float
r Float
g Float
b = IO () -> IOGame t s u v ()
forall a t s u v. IO a -> IOGame t s u v a
liftIOtoIOGame (IO () -> IOGame t s u v ()) -> IO () -> IOGame t s u v ()
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> IO ()
clearGameScreen Float
r Float
g Float
b

-- | set the current map for a MultiMap

setCurrentMapIndex :: Int -> IOGame t s u v ()
setCurrentMapIndex :: Int -> IOGame t s u v ()
setCurrentMapIndex Int
i = do
        GameMap v
m <- IOGame t s u v (GameMap v)
forall t s u v. IOGame t s u v (GameMap v)
getRealMap
        if (GameMap v -> Bool
forall t. GameMap t -> Bool
isMultiMap GameMap v
m)
                then (GameMap v -> IOGame t s u v ()
forall v t s u. GameMap v -> IOGame t s u v ()
setRealMap (GameMap v -> Int -> GameMap v
forall t. GameMap t -> Int -> GameMap t
updateCurrentIndex GameMap v
m Int
i))
                else (String -> IOGame t s u v ()
forall a. HasCallStack => String -> a
error String
"Game.setCurrentMapIndex error: you are not working with MultiMaps!")

----------------------------------

-- flags routines

----------------------------------


enableGameFlags :: IOGame t s u v ()
enableGameFlags :: IOGame t s u v ()
enableGameFlags = GameFlags -> IOGame t s u v ()
forall t s u v. GameFlags -> IOGame t s u v ()
setGameFlags (Bool
True,Bool
True,Bool
True)

disableGameFlags :: IOGame t s u v ()
disableGameFlags :: IOGame t s u v ()
disableGameFlags = GameFlags -> IOGame t s u v ()
forall t s u v. GameFlags -> IOGame t s u v ()
setGameFlags (Bool
False,Bool
False,Bool
False)

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

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

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

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

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

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

----------------------------------

-- objects routines

----------------------------------


-- | draws all visible objects

drawAllObjects :: IOGame t s u v ()
drawAllObjects :: IOGame t s u v ()
drawAllObjects = do
    [ObjectManager s]
o <- IOGame t s u v [ObjectManager s]
forall t s u v. IOGame t s u v [ObjectManager s]
getObjectManagers
    QuadricPrimitive
q <- IOGame t s u v QuadricPrimitive
forall t s u v. IOGame t s u v QuadricPrimitive
getQuadric
    [TextureObject]
p <- IOGame t s u v [TextureObject]
forall t s u v. IOGame t s u v [TextureObject]
getPictureList
    IO () -> IOGame t s u v ()
forall a t s u v. IO a -> IOGame t s u v a
liftIOtoIOGame (IO () -> IOGame t s u v ()) -> IO () -> IOGame t s u v ()
forall a b. (a -> b) -> a -> b
$ [ObjectManager s] -> QuadricPrimitive -> [TextureObject] -> IO ()
forall t.
[ObjectManager t] -> QuadricPrimitive -> [TextureObject] -> IO ()
drawGameObjects [ObjectManager s]
o QuadricPrimitive
q [TextureObject]
p

-- | draw one object

drawObject :: GameObject s -> IOGame t s u v ()
drawObject :: GameObject s -> IOGame t s u v ()
drawObject GameObject s
o = do
    QuadricPrimitive
q <- IOGame t s u v QuadricPrimitive
forall t s u v. IOGame t s u v QuadricPrimitive
getQuadric
    [TextureObject]
p <- IOGame t s u v [TextureObject]
forall t s u v. IOGame t s u v [TextureObject]
getPictureList
    IO () -> IOGame t s u v ()
forall a t s u v. IO a -> IOGame t s u v a
liftIOtoIOGame (IO () -> IOGame t s u v ()) -> IO () -> IOGame t s u v ()
forall a b. (a -> b) -> a -> b
$ GameObject s -> QuadricPrimitive -> [TextureObject] -> IO ()
forall t.
GameObject t -> QuadricPrimitive -> [TextureObject] -> IO ()
drawGameObject GameObject s
o QuadricPrimitive
q [TextureObject]
p

-- | changes objects position according to its speed

moveAllObjects :: IOGame t s u v ()
moveAllObjects :: IOGame t s u v ()
moveAllObjects = do
    [ObjectManager s]
m <- IOGame t s u v [ObjectManager s]
forall t s u v. IOGame t s u v [ObjectManager s]
getObjectManagers
    let newManagers :: [ObjectManager s]
newManagers = [ObjectManager s] -> [ObjectManager s]
forall t. [ObjectManager t] -> [ObjectManager t]
moveGameObjects [ObjectManager s]
m
    [ObjectManager s] -> IOGame t s u v ()
forall s t u v. [ObjectManager s] -> IOGame t s u v ()
setObjectManagers [ObjectManager s]
newManagers

-- | destroys objects from the game

destroyObjects :: [(GameObject s)] -> IOGame t s u v ()
destroyObjects :: [GameObject s] -> IOGame t s u v ()
destroyObjects [] = () -> IOGame t s u v ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
destroyObjects (GameObject s
o:[GameObject s]
os) = GameObject s -> IOGame t s u v ()
forall s t u v. GameObject s -> IOGame t s u v ()
destroyObject GameObject s
o IOGame t s u v () -> IOGame t s u v () -> IOGame t s u v ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [GameObject s] -> IOGame t s u v ()
forall s t u v. [GameObject s] -> IOGame t s u v ()
destroyObjects [GameObject s]
os

-- | destroys an object from the game

destroyObject :: GameObject s -> IOGame t s u v ()
destroyObject :: GameObject s -> IOGame t s u v ()
destroyObject GameObject s
obj = do
    [ObjectManager s]
m <- IOGame t s u v [ObjectManager s]
forall t s u v. IOGame t s u v [ObjectManager s]
getObjectManagers
    let objName :: String
objName = GameObject s -> String
forall t. GameObject t -> String
getGameObjectName GameObject s
obj
    String
mngName <- GameObject s -> IOGame t s u v String
forall s t u v. GameObject s -> IOGame t s u v String
getObjectGroupName GameObject s
obj
    let newManagers :: [ObjectManager s]
newManagers = String -> String -> [ObjectManager s] -> [ObjectManager s]
forall t.
String -> String -> [ObjectManager t] -> [ObjectManager t]
destroyGameObject String
objName String
mngName [ObjectManager s]
m
    [ObjectManager s] -> IOGame t s u v ()
forall s t u v. [ObjectManager s] -> IOGame t s u v ()
setObjectManagers [ObjectManager s]
newManagers

-- | returns the list of all objects from the group whose name is given

getObjectsFromGroup :: String -> IOGame t s u v [(GameObject s)]
getObjectsFromGroup :: String -> IOGame t s u v [GameObject s]
getObjectsFromGroup String
mngName = do
        ObjectManager s
mng <- String -> IOGame t s u v (ObjectManager s)
forall t s u v. String -> IOGame t s u v (ObjectManager s)
findObjectManager String
mngName
        [GameObject s] -> IOGame t s u v [GameObject s]
forall (m :: * -> *) a. Monad m => a -> m a
return (ObjectManager s -> [GameObject s]
forall t. ObjectManager t -> [GameObject t]
getObjectManagerObjects ObjectManager s
mng)

-- | adds an object to a previously created group

addObjectsToGroup :: [(GameObject s)] -> String -> IOGame t s u v ()
addObjectsToGroup :: [GameObject s] -> String -> IOGame t s u v ()
addObjectsToGroup [GameObject s]
objs String
managerName = do
        -- manager <- findObjectManager managerName

        [ObjectManager s]
managers <- IOGame t s u v [ObjectManager s]
forall t s u v. IOGame t s u v [ObjectManager s]
getObjectManagers
        let newManagers :: [ObjectManager s]
newManagers = [GameObject s] -> String -> [ObjectManager s] -> [ObjectManager s]
forall t.
[GameObject t] -> String -> [ObjectManager t] -> [ObjectManager t]
addObjectsToManager [GameObject s]
objs String
managerName [ObjectManager s]
managers 
        [ObjectManager s] -> IOGame t s u v ()
forall s t u v. [ObjectManager s] -> IOGame t s u v ()
setObjectManagers [ObjectManager s]
newManagers

-- | adds an object to a new group

addObjectsToNewGroup :: [(GameObject s)] -> String -> IOGame t s u v ()
addObjectsToNewGroup :: [GameObject s] -> String -> IOGame t s u v ()
addObjectsToNewGroup [GameObject s]
objs String
newMngName = do
        let newManager :: ObjectManager s
newManager = String -> [GameObject s] -> ObjectManager s
forall t. String -> [GameObject t] -> ObjectManager t
objectGroup String
newMngName [GameObject s]
objs
        [ObjectManager s]
managers <- IOGame t s u v [ObjectManager s]
forall t s u v. IOGame t s u v [ObjectManager s]
getObjectManagers
        [ObjectManager s] -> IOGame t s u v ()
forall s t u v. [ObjectManager s] -> IOGame t s u v ()
setObjectManagers (ObjectManager s
newManagerObjectManager s -> [ObjectManager s] -> [ObjectManager s]
forall a. a -> [a] -> [a]
:[ObjectManager s]
managers)

-- | returns an object manager of the game, given its name (internal use)

findObjectManager :: String -> IOGame t s u v (ObjectManager s)
findObjectManager :: String -> IOGame t s u v (ObjectManager s)
findObjectManager String
mngName = do
    [ObjectManager s]
objectManagers <- IOGame t s u v [ObjectManager s]
forall t s u v. IOGame t s u v [ObjectManager s]
getObjectManagers
    ObjectManager s -> IOGame t s u v (ObjectManager s)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [ObjectManager s] -> ObjectManager s
forall t. String -> [ObjectManager t] -> ObjectManager t
searchObjectManager String
mngName [ObjectManager s]
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 :: String -> String -> IOGame t s u v (GameObject s)
findObject String
objName String
mngName = do
    [ObjectManager s]
objectManagers <- IOGame t s u v [ObjectManager s]
forall t s u v. IOGame t s u v [ObjectManager s]
getObjectManagers
    let m :: ObjectManager s
m = String -> [ObjectManager s] -> ObjectManager s
forall t. String -> [ObjectManager t] -> ObjectManager t
searchObjectManager String
mngName [ObjectManager s]
objectManagers
    GameObject s -> IOGame t s u v (GameObject s)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ObjectManager s -> GameObject s
forall t. String -> ObjectManager t -> GameObject t
searchGameObject String
objName ObjectManager s
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 :: GameObject s -> IOGame t s u v String
getObjectName GameObject s
o = String -> IOGame t s u v String
forall (m :: * -> *) a. Monad m => a -> m a
return (GameObject s -> String
forall t. GameObject t -> String
getGameObjectName GameObject s
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 :: GameObject s -> IOGame t s u v String
getObjectGroupName GameObject s
o = do [ObjectManager s]
managers <- IOGame t s u v [ObjectManager s]
forall t s u v. IOGame t s u v [ObjectManager s]
getObjectManagers
                          let obj :: GameObject s
obj = GameObject s -> [ObjectManager s] -> GameObject s
forall t. GameObject t -> [ObjectManager t] -> GameObject t
findObjectFromId GameObject s
o [ObjectManager s]
managers
                          String -> IOGame t s u v String
forall (m :: * -> *) a. Monad m => a -> m a
return (GameObject s -> String
forall t. GameObject t -> String
getGameObjectManagerName GameObject s
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 :: GameObject s -> IOGame t s u v Bool
getObjectAsleep GameObject s
o = do [ObjectManager s]
managers <- IOGame t s u v [ObjectManager s]
forall t s u v. IOGame t s u v [ObjectManager s]
getObjectManagers
                       let obj :: GameObject s
obj = GameObject s -> [ObjectManager s] -> GameObject s
forall t. GameObject t -> [ObjectManager t] -> GameObject t
findObjectFromId GameObject s
o [ObjectManager s]
managers
                       Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (GameObject s -> Bool
forall t. GameObject t -> Bool
getGameObjectAsleep GameObject s
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 :: GameObject s -> IOGame t s u v Point2D
getObjectSize GameObject s
o = do [ObjectManager s]
managers <- IOGame t s u v [ObjectManager s]
forall t s u v. IOGame t s u v [ObjectManager s]
getObjectManagers
                     let obj :: GameObject s
obj = GameObject s -> [ObjectManager s] -> GameObject s
forall t. GameObject t -> [ObjectManager t] -> GameObject t
findObjectFromId GameObject s
o [ObjectManager s]
managers
                     Point2D -> IOGame t s u v Point2D
forall (m :: * -> *) a. Monad m => a -> m a
return (GameObject s -> Point2D
forall t. GameObject t -> Point2D
getGameObjectSize GameObject s
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 :: GameObject s -> IOGame t s u v Point2D
getObjectPosition GameObject s
o = do [ObjectManager s]
managers <- IOGame t s u v [ObjectManager s]
forall t s u v. IOGame t s u v [ObjectManager s]
getObjectManagers
                         let obj :: GameObject s
obj = GameObject s -> [ObjectManager s] -> GameObject s
forall t. GameObject t -> [ObjectManager t] -> GameObject t
findObjectFromId GameObject s
o [ObjectManager s]
managers
                         Point2D -> IOGame t s u v Point2D
forall (m :: * -> *) a. Monad m => a -> m a
return (GameObject s -> Point2D
forall t. GameObject t -> Point2D
getGameObjectPosition GameObject s
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 :: GameObject s -> IOGame t s u v Point2D
getObjectSpeed GameObject s
o = do [ObjectManager s]
managers <- IOGame t s u v [ObjectManager s]
forall t s u v. IOGame t s u v [ObjectManager s]
getObjectManagers
                      let obj :: GameObject s
obj = GameObject s -> [ObjectManager s] -> GameObject s
forall t. GameObject t -> [ObjectManager t] -> GameObject t
findObjectFromId GameObject s
o [ObjectManager s]
managers
                      Point2D -> IOGame t s u v Point2D
forall (m :: * -> *) a. Monad m => a -> m a
return (GameObject s -> Point2D
forall t. GameObject t -> Point2D
getGameObjectSpeed GameObject s
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 :: GameObject s -> IOGame t s u v s
getObjectAttribute GameObject s
o = do [ObjectManager s]
managers <- IOGame t s u v [ObjectManager s]
forall t s u v. IOGame t s u v [ObjectManager s]
getObjectManagers
                          let obj :: GameObject s
obj = GameObject s -> [ObjectManager s] -> GameObject s
forall t. GameObject t -> [ObjectManager t] -> GameObject t
findObjectFromId GameObject s
o [ObjectManager s]
managers
                          s -> IOGame t s u v s
forall (m :: * -> *) a. Monad m => a -> m a
return (GameObject s -> s
forall t. GameObject t -> t
getGameObjectAttribute GameObject s
obj)

-- | changes the sleeping status of an object, given its new status

setObjectAsleep :: Bool -> GameObject s -> IOGame t s u v ()
setObjectAsleep :: Bool -> GameObject s -> IOGame t s u v ()
setObjectAsleep Bool
asleep GameObject s
obj = GameObject s -> (GameObject s -> GameObject s) -> IOGame t s u v ()
forall s t u v.
GameObject s -> (GameObject s -> GameObject s) -> IOGame t s u v ()
replaceObject GameObject s
obj (Bool -> GameObject s -> GameObject s
forall t. Bool -> GameObject t -> GameObject t
updateObjectAsleep Bool
asleep)

-- | changes the position of an object, given its new position

setObjectPosition :: (GLdouble,GLdouble) -> GameObject s -> IOGame t s u v ()
setObjectPosition :: Point2D -> GameObject s -> IOGame t s u v ()
setObjectPosition Point2D
pos GameObject s
obj = GameObject s -> (GameObject s -> GameObject s) -> IOGame t s u v ()
forall s t u v.
GameObject s -> (GameObject s -> GameObject s) -> IOGame t s u v ()
replaceObject GameObject s
obj (Point2D -> GameObject s -> GameObject s
forall t. Point2D -> GameObject t -> GameObject t
updateObjectPosition Point2D
pos)

-- | changes the speed of an object, given its new speed

setObjectSpeed :: (GLdouble,GLdouble) -> GameObject s -> IOGame t s u v ()
setObjectSpeed :: Point2D -> GameObject s -> IOGame t s u v ()
setObjectSpeed Point2D
speed GameObject s
obj = GameObject s -> (GameObject s -> GameObject s) -> IOGame t s u v ()
forall s t u v.
GameObject s -> (GameObject s -> GameObject s) -> IOGame t s u v ()
replaceObject GameObject s
obj (Point2D -> GameObject s -> GameObject s
forall t. Point2D -> GameObject t -> GameObject t
updateObjectSpeed Point2D
speed)

-- | changes the current picture of a multitextured object

setObjectCurrentPicture :: Int -> GameObject s -> IOGame t s u v ()
setObjectCurrentPicture :: Int -> GameObject s -> IOGame t s u v ()
setObjectCurrentPicture Int
n GameObject s
obj = do
        [TextureObject]
picList <- IOGame t s u v [TextureObject]
forall t s u v. IOGame t s u v [TextureObject]
getPictureList
        GameObject s -> (GameObject s -> GameObject s) -> IOGame t s u v ()
forall s t u v.
GameObject s -> (GameObject s -> GameObject s) -> IOGame t s u v ()
replaceObject GameObject s
obj (Int -> Int -> GameObject s -> GameObject s
forall t. Int -> Int -> GameObject t -> GameObject t
updateObjectPicture Int
n (([TextureObject] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TextureObject]
picList) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))

-- | changes the attribute of an object, given its new attribute

setObjectAttribute :: s -> GameObject s -> IOGame t s u v ()
setObjectAttribute :: s -> GameObject s -> IOGame t s u v ()
setObjectAttribute s
a GameObject s
obj = GameObject s -> (GameObject s -> GameObject s) -> IOGame t s u v ()
forall s t u v.
GameObject s -> (GameObject s -> GameObject s) -> IOGame t s u v ()
replaceObject GameObject s
obj (s -> GameObject s -> GameObject s
forall t. t -> GameObject t -> GameObject t
updateObjectAttribute s
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 :: GameObject s -> (GameObject s -> GameObject s) -> IOGame t s u v ()
replaceObject GameObject s
obj GameObject s -> GameObject s
f = do
    String
managerName <- GameObject s -> IOGame t s u v String
forall s t u v. GameObject s -> IOGame t s u v String
getObjectGroupName GameObject s
obj
    [ObjectManager s]
oldManagers <- IOGame t s u v [ObjectManager s]
forall t s u v. IOGame t s u v [ObjectManager s]
getObjectManagers
    let objectId :: Integer
objectId = GameObject s -> Integer
forall t. GameObject t -> Integer
getGameObjectId GameObject s
obj
        newManagers :: [ObjectManager s]
newManagers = (GameObject s -> GameObject s)
-> Integer -> String -> [ObjectManager s] -> [ObjectManager s]
forall t.
(GameObject t -> GameObject t)
-> Integer -> String -> [ObjectManager t] -> [ObjectManager t]
updateObject GameObject s -> GameObject s
f Integer
objectId String
managerName [ObjectManager s]
oldManagers
    [ObjectManager s] -> IOGame t s u v ()
forall s t u v. [ObjectManager s] -> IOGame t s u v ()
setObjectManagers [ObjectManager s]
newManagers

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

reverseYSpeed :: GameObject s -> IOGame t s u v ()
reverseYSpeed :: GameObject s -> IOGame t s u v ()
reverseYSpeed GameObject s
o = do (Radius
vX,Radius
vY) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSpeed GameObject s
o
                     Point2D -> GameObject s -> IOGame t s u v ()
forall s t u v. Point2D -> GameObject s -> IOGame t s u v ()
setObjectSpeed (Radius
vX,-Radius
vY) GameObject s
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 :: GameObject s -> IOGame t s u v Bool
objectTopMapCollision GameObject s
o = do
    Bool
asleep <- GameObject s -> IOGame t s u v Bool
forall s t u v. GameObject s -> IOGame t s u v Bool
getObjectAsleep GameObject s
o
    if Bool
asleep
        then (Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        else do GameMap v
m <- IOGame t s u v (GameMap v)
forall t s u v. IOGame t s u v (GameMap v)
getMap
                (Radius
_,Radius
pY) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectPosition GameObject s
o
                (Radius
_,Radius
sY) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSize GameObject s
o
                let (Radius
_,Radius
mY) = GameMap v -> Point2D
forall t. GameMap t -> Point2D
getMapSize GameMap v
m
                Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Radius
pY Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ (Radius
sYRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2) Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
> (Radius -> Radius
forall a b. (Real a, Fractional b) => a -> b
realToFrac Radius
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 :: GameObject s -> IOGame t s u v Bool
objectTopMapFutureCollision GameObject s
o = do
    Bool
asleep <- GameObject s -> IOGame t s u v Bool
forall s t u v. GameObject s -> IOGame t s u v Bool
getObjectAsleep GameObject s
o
    if Bool
asleep
        then (Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        else do GameMap v
m <- IOGame t s u v (GameMap v)
forall t s u v. IOGame t s u v (GameMap v)
getMap
                (Radius
_,Radius
pY) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectPosition GameObject s
o
                (Radius
_,Radius
vY) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSpeed GameObject s
o
                (Radius
_,Radius
sY) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSize GameObject s
o
                let (Radius
_,Radius
mY) = GameMap v -> Point2D
forall t. GameMap t -> Point2D
getMapSize GameMap v
m
                Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Radius
pY Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ (Radius
sYRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2) Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ Radius
vY Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
> (Radius -> Radius
forall a b. (Real a, Fractional b) => a -> b
realToFrac Radius
mY))

-- | checks the collision between an object and the bottom of the map

objectBottomMapCollision :: GameObject s -> IOGame t s u v Bool
objectBottomMapCollision :: GameObject s -> IOGame t s u v Bool
objectBottomMapCollision GameObject s
o = do
    Bool
asleep <- GameObject s -> IOGame t s u v Bool
forall s t u v. GameObject s -> IOGame t s u v Bool
getObjectAsleep GameObject s
o
    if Bool
asleep
        then (Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        else do (Radius
_,Radius
pY) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectPosition GameObject s
o
                (Radius
_,Radius
sY) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSize GameObject s
o
                Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Radius
pY Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
- (Radius
sYRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2) Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
< Radius
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 :: GameObject s -> IOGame t s u v Bool
objectBottomMapFutureCollision GameObject s
o = do
    Bool
asleep <- GameObject s -> IOGame t s u v Bool
forall s t u v. GameObject s -> IOGame t s u v Bool
getObjectAsleep GameObject s
o
    if Bool
asleep
        then (Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        else do (Radius
_,Radius
pY) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectPosition GameObject s
o
                (Radius
_,Radius
sY) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSize GameObject s
o
                (Radius
_,Radius
vY) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSpeed GameObject s
o
                Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Radius
pY Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
- (Radius
sYRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2) Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ Radius
vY Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
< Radius
0)

-- | checks the collision between an object and the right side of the map

objectRightMapCollision :: GameObject s -> IOGame t s u v Bool
objectRightMapCollision :: GameObject s -> IOGame t s u v Bool
objectRightMapCollision GameObject s
o = do
    Bool
asleep <- GameObject s -> IOGame t s u v Bool
forall s t u v. GameObject s -> IOGame t s u v Bool
getObjectAsleep GameObject s
o
    if Bool
asleep
        then (Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        else do GameMap v
m <- IOGame t s u v (GameMap v)
forall t s u v. IOGame t s u v (GameMap v)
getMap
                (Radius
pX,Radius
_) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectPosition GameObject s
o
                (Radius
sX,Radius
_) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSize GameObject s
o
                let (Radius
mX,Radius
_) = GameMap v -> Point2D
forall t. GameMap t -> Point2D
getMapSize GameMap v
m
                Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Radius
pX Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ (Radius
sXRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2) Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
> (Radius -> Radius
forall a b. (Real a, Fractional b) => a -> b
realToFrac Radius
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 :: GameObject s -> IOGame t s u v Bool
objectRightMapFutureCollision GameObject s
o = do
    Bool
asleep <- GameObject s -> IOGame t s u v Bool
forall s t u v. GameObject s -> IOGame t s u v Bool
getObjectAsleep GameObject s
o
    if Bool
asleep
        then (Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        else do GameMap v
m <- IOGame t s u v (GameMap v)
forall t s u v. IOGame t s u v (GameMap v)
getMap
                (Radius
pX,Radius
_) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectPosition GameObject s
o
                (Radius
sX,Radius
_) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSize GameObject s
o
                (Radius
vX,Radius
_) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSpeed GameObject s
o
                let (Radius
mX,Radius
_) = GameMap v -> Point2D
forall t. GameMap t -> Point2D
getMapSize GameMap v
m
                Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Radius
pX Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ (Radius
sXRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2) Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ Radius
vX Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
> (Radius -> Radius
forall a b. (Real a, Fractional b) => a -> b
realToFrac Radius
mX))

-- | checks the collision between an object and the left side of the map

objectLeftMapCollision :: GameObject s -> IOGame t s u v Bool
objectLeftMapCollision :: GameObject s -> IOGame t s u v Bool
objectLeftMapCollision GameObject s
o = do
    Bool
asleep <- GameObject s -> IOGame t s u v Bool
forall s t u v. GameObject s -> IOGame t s u v Bool
getObjectAsleep GameObject s
o
    if Bool
asleep
        then (Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        else do (Radius
pX,Radius
_) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectPosition GameObject s
o
                (Radius
sX,Radius
_) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSize GameObject s
o
                Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Radius
pX Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
- (Radius
sXRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2) Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
< Radius
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 :: GameObject s -> IOGame t s u v Bool
objectLeftMapFutureCollision GameObject s
o = do
    Bool
asleep <- GameObject s -> IOGame t s u v Bool
forall s t u v. GameObject s -> IOGame t s u v Bool
getObjectAsleep GameObject s
o
    if Bool
asleep
        then (Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        else do (Radius
pX,Radius
_) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectPosition GameObject s
o
                (Radius
sX,Radius
_) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSize GameObject s
o
                (Radius
vX,Radius
_) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSpeed GameObject s
o
                Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Radius
pX Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
- (Radius
sXRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2) Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ Radius
vX Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
< Radius
0)

-- | checks the collision between two objects

objectsCollision :: GameObject s -> GameObject s -> IOGame t s u v Bool
objectsCollision :: GameObject s -> GameObject s -> IOGame t s u v Bool
objectsCollision GameObject s
o1 GameObject s
o2 = do
    Bool
asleep1 <- GameObject s -> IOGame t s u v Bool
forall s t u v. GameObject s -> IOGame t s u v Bool
getObjectAsleep GameObject s
o1
    Bool
asleep2 <- GameObject s -> IOGame t s u v Bool
forall s t u v. GameObject s -> IOGame t s u v Bool
getObjectAsleep GameObject s
o2
    if (Bool
asleep1 Bool -> Bool -> Bool
|| Bool
asleep2)
                then (Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
                else  do (Radius
p1X,Radius
p1Y) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectPosition GameObject s
o1
                         (Radius
p2X,Radius
p2Y) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectPosition GameObject s
o2
                         (Radius
s1X,Radius
s1Y) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSize GameObject s
o1
                         (Radius
s2X,Radius
s2Y) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSize GameObject s
o2
        
                         let aX1 :: Radius
aX1 = Radius
p1X Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
- (Radius
s1XRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2)
                             aX2 :: Radius
aX2 = Radius
p1X Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ (Radius
s1XRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2)
                             aY1 :: Radius
aY1 = Radius
p1Y Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
- (Radius
s1YRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2)
                             aY2 :: Radius
aY2 = Radius
p1Y Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ (Radius
s1YRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2)
        
                             bX1 :: Radius
bX1 = Radius
p2X Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
- (Radius
s2XRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2)
                             bX2 :: Radius
bX2 = Radius
p2X Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ (Radius
s2XRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2)
                             bY1 :: Radius
bY1 = Radius
p2Y Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
- (Radius
s2YRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2)
                             bY2 :: Radius
bY2 = Radius
p2Y Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ (Radius
s2YRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2)
                              
                         Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return ((Radius
bX1 Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
< Radius
aX2) Bool -> Bool -> Bool
&& (Radius
aX1 Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
< Radius
bX2) Bool -> Bool -> Bool
&& (Radius
bY1 Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
< Radius
aY2) Bool -> Bool -> Bool
&& (Radius
aY1 Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
< Radius
bY2))

-- | checks the collision between two objects in the next game cicle

objectsFutureCollision :: GameObject s -> GameObject s -> IOGame t s u v Bool
objectsFutureCollision :: GameObject s -> GameObject s -> IOGame t s u v Bool
objectsFutureCollision GameObject s
o1 GameObject s
o2 = do
    Bool
asleep1 <- GameObject s -> IOGame t s u v Bool
forall s t u v. GameObject s -> IOGame t s u v Bool
getObjectAsleep GameObject s
o1
    Bool
asleep2 <- GameObject s -> IOGame t s u v Bool
forall s t u v. GameObject s -> IOGame t s u v Bool
getObjectAsleep GameObject s
o2
    if (Bool
asleep1 Bool -> Bool -> Bool
|| Bool
asleep2)
                then (Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
                else do (Radius
p1X,Radius
p1Y) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectPosition GameObject s
o1
                        (Radius
p2X,Radius
p2Y) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectPosition GameObject s
o2
                        (Radius
v1X,Radius
v1Y) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSpeed GameObject s
o1
                        (Radius
v2X,Radius
v2Y) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSpeed GameObject s
o2
                        (Radius
s1X,Radius
s1Y) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSize GameObject s
o1
                        (Radius
s2X,Radius
s2Y) <- GameObject s -> IOGame t s u v Point2D
forall s t u v. GameObject s -> IOGame t s u v Point2D
getObjectSize GameObject s
o2
        
                        let aX1 :: Radius
aX1 = Radius
p1X Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
- (Radius
s1XRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2) Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ Radius
v1X
                            aX2 :: Radius
aX2 = Radius
p1X Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ (Radius
s1XRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2) Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ Radius
v1X
                            aY1 :: Radius
aY1 = Radius
p1Y Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
- (Radius
s1YRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2) Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ Radius
v1Y
                            aY2 :: Radius
aY2 = Radius
p1Y Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ (Radius
s1YRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2) Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ Radius
v1Y

                            bX1 :: Radius
bX1 = Radius
p2X Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
- (Radius
s2XRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2) Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ Radius
v2X
                            bX2 :: Radius
bX2 = Radius
p2X Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ (Radius
s2XRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2) Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ Radius
v2X
                            bY1 :: Radius
bY1 = Radius
p2Y Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
- (Radius
s2YRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2) Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ Radius
v2Y
                            bY2 :: Radius
bY2 = Radius
p2Y Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ (Radius
s2YRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2) Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ Radius
v2Y
                        Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return ((Radius
bX1 Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
< Radius
aX2) Bool -> Bool -> Bool
&& (Radius
aX1 Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
< Radius
bX2) Bool -> Bool -> Bool
&& (Radius
bY1 Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
< Radius
aY2) Bool -> Bool -> Bool
&& (Radius
aY1 Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
< Radius
bY2))

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

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

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

                        let aX1 :: Radius
aX1 = Radius
p1X Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
- (Radius
s1XRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2)
                            aX2 :: Radius
aX2 = Radius
p1X Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ (Radius
s1XRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2)
                            aY1 :: Radius
aY1 = Radius
p1Y Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
- (Radius
s1YRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2)
                            aY2 :: Radius
aY2 = Radius
p1Y Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ (Radius
s1YRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2)
        
                            bX1 :: Radius
bX1 = Radius
p2X Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
- (Radius
s2XRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2)
                            bX2 :: Radius
bX2 = Radius
p2X Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ (Radius
s2XRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2)
                            bY1 :: Radius
bY1 = Radius
p2Y Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
- (Radius
s2YRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2)
                            bY2 :: Radius
bY2 = Radius
p2Y Radius -> Radius -> Radius
forall a. Num a => a -> a -> a
+ (Radius
s2YRadius -> Radius -> Radius
forall a. Fractional a => a -> a -> a
/Radius
2)
                        Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return ((Radius
bX1 Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
< Radius
aX2) Bool -> Bool -> Bool
&& (Radius
aX1 Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
< Radius
bX2) Bool -> Bool -> Bool
&& (Radius
bY1 Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
< Radius
aY2) Bool -> Bool -> Bool
&& (Radius
aY1 Radius -> Radius -> Bool
forall a. Ord a => a -> a -> Bool
< Radius
bY2))
                         
pointsObjectListCollision :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> [(GameObject s)] -> IOGame t s u v Bool
pointsObjectListCollision :: Radius
-> Radius
-> Radius
-> Radius
-> [GameObject s]
-> IOGame t s u v Bool
pointsObjectListCollision Radius
_ Radius
_ Radius
_ Radius
_ [] = Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
pointsObjectListCollision Radius
p1X Radius
p1Y Radius
s1X Radius
s1Y (GameObject s
o:[GameObject s]
os) = do
        Bool
col <- Radius
-> Radius
-> Radius
-> Radius
-> GameObject s
-> IOGame t s u v Bool
forall s t u v.
Radius
-> Radius
-> Radius
-> Radius
-> GameObject s
-> IOGame t s u v Bool
pointsObjectCollision Radius
p1X Radius
p1Y Radius
s1X Radius
s1Y GameObject s
o
        if Bool
col
                then (Bool -> IOGame t s u v Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
                else (Radius
-> Radius
-> Radius
-> Radius
-> [GameObject s]
-> IOGame t s u v Bool
forall s t u v.
Radius
-> Radius
-> Radius
-> Radius
-> [GameObject s]
-> IOGame t s u v Bool
pointsObjectListCollision Radius
p1X Radius
p1Y Radius
s1X Radius
s1Y [GameObject s]
os)

-----------------------------------------------

--              TEXT ROUTINES                --

-----------------------------------------------

-- | prints a string in the prompt

printOnPrompt :: Show a => a -> IOGame t s u v ()
printOnPrompt :: a -> IOGame t s u v ()
printOnPrompt a
a = (a -> IO ()) -> a -> IOGame t s u v ()
forall a t s u v. (a -> IO ()) -> a -> IOGame t s u v ()
liftIOtoIOGame' a -> IO ()
forall a. Show a => a -> IO ()
print a
a

-- | prints a string in the current window

printOnScreen :: String -> BitmapFont -> (GLdouble,GLdouble) -> GLclampf -> GLclampf -> GLclampf -> IOGame t s u v ()
printOnScreen :: String
-> BitmapFont
-> Point2D
-> Float
-> Float
-> Float
-> IOGame t s u v ()
printOnScreen String
text BitmapFont
font Point2D
pos Float
r Float
g Float
b = do
        [Text]
t <- IOGame t s u v [Text]
forall t s u v. IOGame t s u v [Text]
getTextList
        [Text] -> IOGame t s u v ()
forall t s u v. [Text] -> IOGame t s u v ()
setTextList ([(String
text,BitmapFont
font,Point2D
pos,Float
r,Float
g,Float
b)] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
t)

-- | internal use of the engine

printText :: IOGame t s u v ()
printText :: IOGame t s u v ()
printText = do
        [Text]
t <- IOGame t s u v [Text]
forall t s u v. IOGame t s u v [Text]
getTextList
        IO () -> IOGame t s u v ()
forall a t s u v. IO a -> IOGame t s u v a
liftIOtoIOGame (IO () -> IOGame t s u v ()) -> IO () -> IOGame t s u v ()
forall a b. (a -> b) -> a -> b
$ [Text] -> IO ()
putGameText [Text]
t
        [Text] -> IOGame t s u v ()
forall t s u v. [Text] -> IOGame t s u v ()
setTextList []

-----------------------------------------------

--     RANDOM NUMBER GENERATOR ROUTINES      --

-----------------------------------------------

randomInt :: (Int,Int) -> IOGame t s u v Int
randomInt :: (Int, Int) -> IOGame t s u v Int
randomInt (Int
x,Int
y) = IO Int -> IOGame t s u v Int
forall a t s u v. IO a -> IOGame t s u v a
liftIOtoIOGame (IO Int -> IOGame t s u v Int) -> IO Int -> IOGame t s u v Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> IO Int
randInt (Int
x,Int
y)

randomFloat :: (Float,Float) -> IOGame t s u v Float
randomFloat :: (Float, Float) -> IOGame t s u v Float
randomFloat (Float
x,Float
y) = IO Float -> IOGame t s u v Float
forall a t s u v. IO a -> IOGame t s u v a
liftIOtoIOGame (IO Float -> IOGame t s u v Float)
-> IO Float -> IOGame t s u v Float
forall a b. (a -> b) -> a -> b
$ (Float, Float) -> IO Float
randFloat (Float
x,Float
y)

randomDouble :: (Double,Double) -> IOGame t s u v Double
randomDouble :: Point2D -> IOGame t s u v Radius
randomDouble (Radius
x,Radius
y) = IO Radius -> IOGame t s u v Radius
forall a t s u v. IO a -> IOGame t s u v a
liftIOtoIOGame (IO Radius -> IOGame t s u v Radius)
-> IO Radius -> IOGame t s u v Radius
forall a b. (a -> b) -> a -> b
$ Point2D -> IO Radius
randDouble (Radius
x,Radius
y)

-----------------------------------------------

--           DEBUGGING ROUTINES              --

-----------------------------------------------


-- | shows the frame rate (or frame per seconds) 

showFPS :: BitmapFont -> (GLdouble,GLdouble) -> GLclampf -> GLclampf -> GLclampf -> IOGame t s u v ()
showFPS :: BitmapFont
-> Point2D -> Float -> Float -> Float -> IOGame t s u v ()
showFPS BitmapFont
font Point2D
pos Float
r Float
g Float
b = do
        (Int
framei,Int
timebasei,Float
fps) <- IOGame t s u v (Int, Int, Float)
forall t s u v. IOGame t s u v (Int, Int, Float)
getFpsInfo
        Int
timei <- IOGame t s u v Int
forall t s u v. IOGame t s u v Int
getElapsedTime
        let frame :: Float
frame = (Int -> Float
forall a. Enum a => Int -> a
toEnum (Int
framei Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) :: Float
            timebase :: Float
timebase = (Int -> Float
forall a. Enum a => Int -> a
toEnum Int
timebasei) :: Float
            time :: Float
time = (Int -> Float
forall a. Enum a => Int -> a
toEnum Int
timei) :: Float
        if (Int
timei Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
timebasei Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1000)
                then (Int, Int, Float) -> IOGame t s u v ()
forall t s u v. (Int, Int, Float) -> IOGame t s u v ()
setFpsInfo (Int
0,Int
timei,(Float
frameFloat -> Float -> Float
forall a. Num a => a -> a -> a
*(Int -> Float
forall a. Enum a => Int -> a
toEnum Int
1000)Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/(Float
timeFloat -> Float -> Float
forall a. Num a => a -> a -> a
-Float
timebase)))
                else (Int, Int, Float) -> IOGame t s u v ()
forall t s u v. (Int, Int, Float) -> IOGame t s u v ()
setFpsInfo ((Int
framei Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1),Int
timebasei,Float
fps)
        String
-> BitmapFont
-> Point2D
-> Float
-> Float
-> Float
-> IOGame t s u v ()
forall t s u v.
String
-> BitmapFont
-> Point2D
-> Float
-> Float
-> Float
-> IOGame t s u v ()
printOnScreen (String -> Float -> String
forall r. PrintfType r => String -> r
printf String
"%.1f" Float
fps) BitmapFont
font Point2D
pos Float
r Float
g Float
b

-- | get the elapsed time of the game

getElapsedTime :: IOGame t s u v Int
getElapsedTime :: IOGame t s u v Int
getElapsedTime = IO Int -> IOGame t s u v Int
forall a t s u v. IO a -> IOGame t s u v a
liftIOtoIOGame (IO Int -> IOGame t s u v Int) -> IO Int -> IOGame t s u v Int
forall a b. (a -> b) -> a -> b
$ IO Int -> IO Int
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get IO Int
elapsedTime

-- | delay for N  seconds while continuing essential game functions

wait :: Int -> IOGame t s u v ()
wait :: Int -> IOGame t s u v ()
wait Int
delay = do
        IOGame t s u v ()
forall t s u v. IOGame t s u v ()
printText                                   -- force text messages to be printed (is not working properly!)

        (Int
framei,Int
timebasei,Float
fps) <- IOGame t s u v (Int, Int, Float)
forall t s u v. IOGame t s u v (Int, Int, Float)
getFpsInfo
        (Int, Int, Float) -> IOGame t s u v ()
forall t s u v. (Int, Int, Float) -> IOGame t s u v ()
setFpsInfo (Int
framei,(Int
timebasei Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delay),Float
fps) -- helps FPS info to be displayed correctly (if requested)

        Int
startTime <- IOGame t s u v Int
forall t s u v. IOGame t s u v Int
getElapsedTime
        
        Int -> Int -> IOGame t s u v ()
forall t s u v. Int -> Int -> IOGame t s u v ()
waitAux Int
delay Int
startTime

waitAux :: Int -> Int -> IOGame t s u v ()
waitAux :: Int -> Int -> IOGame t s u v ()
waitAux Int
delay Int
startTime = do
        Int
presentTime <- IOGame t s u v Int
forall t s u v. IOGame t s u v Int
getElapsedTime
        if (Int
presentTime Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startTime Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
delay)
                then () -> IOGame t s u v ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                else Int -> Int -> IOGame t s u v ()
forall t s u v. Int -> Int -> IOGame t s u v ()
waitAux Int
delay Int
startTime