{-# OPTIONS_HADDOCK hide #-}
{- | 
This module contains the FunGEn objects procedures
-}
{- 
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.Objects (
  ObjectManager,
  GameObject,
  ObjectPicture(..), Primitive(..),
  FillMode (..),
  -- ** creating
  object,
  -- ** object attributes
  getGameObjectId, getGameObjectName, getGameObjectManagerName, getGameObjectAsleep,
  getGameObjectPosition, getGameObjectSize, getGameObjectSpeed, getGameObjectAttribute,
  -- ** updating
  updateObject, updateObjectAsleep, updateObjectSize, updateObjectPosition,
  updateObjectSpeed, updateObjectAttribute, updateObjectPicture,
  -- ** drawing
  drawGameObjects, drawGameObject,
  -- ** moving
  moveGameObjects,
  -- ** destroying
  destroyGameObject,
  -- ** groups of objects
  objectGroup, addObjectsToManager,
  getObjectManagerName, getObjectManagerCounter , getObjectManagerObjects,
  -- ** searching
  findObjectFromId, searchObjectManager, searchGameObject,
) where

import Graphics.UI.Fungen.Types
import Graphics.UI.Fungen.Util
import Graphics.Rendering.OpenGL hiding (Primitive)

data GameObject t = GO {
    forall t. GameObject t -> Integer
objId          :: Integer,
    forall t. GameObject t -> String
objName        :: String,
    forall t. GameObject t -> String
objManagerName :: String,
    forall t. GameObject t -> GameObjectPicture
objPicture     :: GameObjectPicture,
    forall t. GameObject t -> Bool
objAsleep      :: Bool,
    forall t. GameObject t -> Point2D
objSize        :: Point2D,
    forall t. GameObject t -> Point2D
objPosition    :: Point2D,
    forall t. GameObject t -> Point2D
objSpeed       :: Point2D,
    forall t. GameObject t -> t
objAttribute   :: t
    }

data ObjectManager t = OM {
    forall t. ObjectManager t -> String
mngName    :: String,               -- name of the manager
    forall t. ObjectManager t -> Integer
mngCounter :: Integer,              -- next current avaible index for a new object
    forall t. ObjectManager t -> [GameObject t]
mngObjects :: [(GameObject t)]      -- the SET of objects
    }

data GamePrimitive
    = P [Vertex3 GLdouble] (Color4 GLfloat) FillMode
    | C GLdouble (Color4 GLfloat) FillMode

data GameObjectPicture
    = Tx Int
    | B GamePrimitive
--  | A [TextureObject] Int -- miliseconds between frames

data Primitive
    = Polyg [Point2D] GLfloat GLfloat GLfloat FillMode -- the points (must be in CCW order!), color, fill mode
    | Circle GLdouble GLfloat GLfloat GLfloat FillMode -- color, radius, fill mode
    
data ObjectPicture
    = Tex (GLdouble,GLdouble) Int -- size, current texture
    | Basic Primitive
--  | Animation [(FilePath,InvList)] Int -- (path to file, invisible colors), miliseconds between frames

data FillMode
    = Filled
    | Unfilled
    deriving FillMode -> FillMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FillMode -> FillMode -> Bool
$c/= :: FillMode -> FillMode -> Bool
== :: FillMode -> FillMode -> Bool
$c== :: FillMode -> FillMode -> Bool
Eq

-------------------------------------------
-- get & updating routines for GameObjects
-------------------------------------------
getGameObjectId :: GameObject t -> Integer
getGameObjectId :: forall t. GameObject t -> Integer
getGameObjectId = forall t. GameObject t -> Integer
objId

getGameObjectName :: GameObject t -> String
getGameObjectName :: forall t. GameObject t -> String
getGameObjectName = forall t. GameObject t -> String
objName

getGameObjectManagerName :: GameObject t -> String
getGameObjectManagerName :: forall t. GameObject t -> String
getGameObjectManagerName = forall t. GameObject t -> String
objManagerName

-- internal use only!
getGameObjectPicture :: GameObject t -> GameObjectPicture
getGameObjectPicture :: forall t. GameObject t -> GameObjectPicture
getGameObjectPicture = forall t. GameObject t -> GameObjectPicture
objPicture

getGameObjectAsleep :: GameObject t -> Bool
getGameObjectAsleep :: forall t. GameObject t -> Bool
getGameObjectAsleep = forall t. GameObject t -> Bool
objAsleep

getGameObjectSize :: GameObject t -> (GLdouble,GLdouble)
getGameObjectSize :: forall t. GameObject t -> Point2D
getGameObjectSize GameObject t
o = (forall a b. (Real a, Fractional b) => a -> b
realToFrac GLdouble
sX,forall a b. (Real a, Fractional b) => a -> b
realToFrac GLdouble
sY)
                      where (GLdouble
sX,GLdouble
sY) = forall t. GameObject t -> Point2D
objSize GameObject t
o

getGameObjectPosition :: GameObject t -> (GLdouble,GLdouble)
getGameObjectPosition :: forall t. GameObject t -> Point2D
getGameObjectPosition GameObject t
o = (forall a b. (Real a, Fractional b) => a -> b
realToFrac GLdouble
pX,forall a b. (Real a, Fractional b) => a -> b
realToFrac GLdouble
pY)
                          where (GLdouble
pX,GLdouble
pY) = forall t. GameObject t -> Point2D
objPosition GameObject t
o

getGameObjectSpeed :: GameObject t -> (GLdouble,GLdouble)
getGameObjectSpeed :: forall t. GameObject t -> Point2D
getGameObjectSpeed GameObject t
o = (forall a b. (Real a, Fractional b) => a -> b
realToFrac GLdouble
sX,forall a b. (Real a, Fractional b) => a -> b
realToFrac GLdouble
sY)
                       where (GLdouble
sX,GLdouble
sY) = forall t. GameObject t -> Point2D
objSpeed GameObject t
o

getGameObjectAttribute :: GameObject t -> t
getGameObjectAttribute :: forall t. GameObject t -> t
getGameObjectAttribute = forall t. GameObject t -> t
objAttribute

updateObjectPicture :: Int -> Int -> GameObject t -> GameObject t
updateObjectPicture :: forall t. Int -> Int -> GameObject t -> GameObject t
updateObjectPicture Int
newIndex Int
maxIndex GameObject t
obj =
    case (forall t. GameObject t -> GameObjectPicture
getGameObjectPicture GameObject t
obj) of
        Tx Int
_ -> if (Int
newIndex forall a. Ord a => a -> a -> Bool
<= Int
maxIndex)
                        then (GameObject t
obj {objPicture :: GameObjectPicture
objPicture = Int -> GameObjectPicture
Tx Int
newIndex})
                        else (forall a. HasCallStack => String -> a
error (String
"Objects.updateObjectPicture error: picture index out of range for object " forall a. [a] -> [a] -> [a]
++
                              (forall t. GameObject t -> String
getGameObjectName GameObject t
obj) forall a. [a] -> [a] -> [a]
++ String
" of group " forall a. [a] -> [a] -> [a]
++ (forall t. GameObject t -> String
getGameObjectManagerName GameObject t
obj)))
        GameObjectPicture
_ -> forall a. HasCallStack => String -> a
error (String
"Objects.updateObjectPicture error: object " forall a. [a] -> [a] -> [a]
++ (forall t. GameObject t -> String
getGameObjectName GameObject t
obj) forall a. [a] -> [a] -> [a]
++
                     String
" of group " forall a. [a] -> [a] -> [a]
++ (forall t. GameObject t -> String
getGameObjectManagerName GameObject t
obj) forall a. [a] -> [a] -> [a]
++ String
" is not a textured object!")

updateObjectAsleep :: Bool -> GameObject t -> GameObject t
updateObjectAsleep :: forall t. Bool -> GameObject t -> GameObject t
updateObjectAsleep Bool
asleep GameObject t
o = GameObject t
o {objAsleep :: Bool
objAsleep = Bool
asleep}

updateObjectSize :: (GLdouble,GLdouble) -> GameObject t -> GameObject t
updateObjectSize :: forall t. Point2D -> GameObject t -> GameObject t
updateObjectSize (GLdouble
sX,GLdouble
sY) GameObject t
o = GameObject t
o {objSize :: Point2D
objSize = (forall a b. (Real a, Fractional b) => a -> b
realToFrac GLdouble
sX, forall a b. (Real a, Fractional b) => a -> b
realToFrac GLdouble
sY)}

updateObjectPosition :: (GLdouble,GLdouble) -> GameObject t -> GameObject t
updateObjectPosition :: forall t. Point2D -> GameObject t -> GameObject t
updateObjectPosition (GLdouble
pX,GLdouble
pY) GameObject t
o = GameObject t
o {objPosition :: Point2D
objPosition = (forall a b. (Real a, Fractional b) => a -> b
realToFrac GLdouble
pX, forall a b. (Real a, Fractional b) => a -> b
realToFrac GLdouble
pY)}

updateObjectSpeed :: (GLdouble,GLdouble) -> GameObject t -> GameObject t
updateObjectSpeed :: forall t. Point2D -> GameObject t -> GameObject t
updateObjectSpeed (GLdouble
sX,GLdouble
sY) GameObject t
o = GameObject t
o {objSpeed :: Point2D
objSpeed = (forall a b. (Real a, Fractional b) => a -> b
realToFrac GLdouble
sX, forall a b. (Real a, Fractional b) => a -> b
realToFrac GLdouble
sY)}

updateObjectAttribute :: t -> GameObject t -> GameObject t
updateObjectAttribute :: forall t. t -> GameObject t -> GameObject t
updateObjectAttribute t
oAttrib GameObject t
o = GameObject t
o {objAttribute :: t
objAttribute = t
oAttrib}

----------------------------------------------
-- get & updating routines for ObjectManagers
----------------------------------------------
getObjectManagerName :: ObjectManager t -> String
getObjectManagerName :: forall t. ObjectManager t -> String
getObjectManagerName = forall t. ObjectManager t -> String
mngName

getObjectManagerCounter :: ObjectManager t -> Integer
getObjectManagerCounter :: forall t. ObjectManager t -> Integer
getObjectManagerCounter = forall t. ObjectManager t -> Integer
mngCounter

getObjectManagerObjects :: ObjectManager t -> [(GameObject t)]
getObjectManagerObjects :: forall t. ObjectManager t -> [GameObject t]
getObjectManagerObjects = forall t. ObjectManager t -> [GameObject t]
mngObjects

updateObjectManagerObjects :: [(GameObject t)] -> ObjectManager t -> ObjectManager t
updateObjectManagerObjects :: forall t. [GameObject t] -> ObjectManager t -> ObjectManager t
updateObjectManagerObjects [GameObject t]
objs ObjectManager t
mng = ObjectManager t
mng {mngObjects :: [GameObject t]
mngObjects = [GameObject t]
objs}

----------------------------------------
-- initialization of GameObjects
----------------------------------------
object :: String -> ObjectPicture -> Bool -> (GLdouble,GLdouble) -> (GLdouble,GLdouble) -> t -> GameObject t
object :: forall t.
String
-> ObjectPicture -> Bool -> Point2D -> Point2D -> t -> GameObject t
object String
name ObjectPicture
pic Bool
asleep Point2D
pos Point2D
speed t
oAttrib = let (GameObjectPicture
picture, Point2D
size) = ObjectPicture -> (GameObjectPicture, Point2D)
createPicture ObjectPicture
pic in
                        GO {
                        objId :: Integer
objId          = Integer
0,
                        objName :: String
objName        = String
name,
                        objManagerName :: String
objManagerName = String
"object not grouped yet!",
                        objPicture :: GameObjectPicture
objPicture     = GameObjectPicture
picture,
                        objAsleep :: Bool
objAsleep      = Bool
asleep,
                        objSize :: Point2D
objSize        = Point2D
size,
                        objPosition :: Point2D
objPosition    = Point2D
pos,
                        objSpeed :: Point2D
objSpeed       = Point2D
speed,
                        objAttribute :: t
objAttribute   = t
oAttrib
                        }

createPicture :: ObjectPicture -> (GameObjectPicture,Point2D)
createPicture :: ObjectPicture -> (GameObjectPicture, Point2D)
createPicture (Basic (Polyg [Point2D]
points GLfloat
r GLfloat
g GLfloat
b FillMode
fillMode))  = (GamePrimitive -> GameObjectPicture
B ([Vertex3 GLdouble] -> Color4 GLfloat -> FillMode -> GamePrimitive
P ([Point2D] -> [Vertex3 GLdouble]
point2DtoVertex3 [Point2D]
points) (forall a. a -> a -> a -> a -> Color4 a
Color4 GLfloat
r GLfloat
g GLfloat
b GLfloat
1.0) FillMode
fillMode),[Point2D] -> Point2D
findSize [Point2D]
points)
createPicture (Basic (Circle GLdouble
radius GLfloat
r GLfloat
g GLfloat
b FillMode
fillMode)) = (GamePrimitive -> GameObjectPicture
B (GLdouble -> Color4 GLfloat -> FillMode -> GamePrimitive
C GLdouble
radius (forall a. a -> a -> a -> a -> Color4 a
Color4 GLfloat
r GLfloat
g GLfloat
b GLfloat
1.0) FillMode
fillMode),(GLdouble
2 forall a. Num a => a -> a -> a
* GLdouble
radius,GLdouble
2 forall a. Num a => a -> a -> a
* GLdouble
radius))
createPicture (Tex Point2D
size Int
picIndex) = (Int -> GameObjectPicture
Tx Int
picIndex,Point2D
size)

-- given a point list, finds the height and width
findSize :: [Point2D] -> Point2D
findSize :: [Point2D] -> Point2D
findSize [Point2D]
l = ((GLdouble
x2 forall a. Num a => a -> a -> a
- GLdouble
x1),(GLdouble
y2 forall a. Num a => a -> a -> a
- GLdouble
y1))
    where ([GLdouble]
xList,[GLdouble]
yList) = forall a b. [(a, b)] -> ([a], [b])
unzip [Point2D]
l
          (GLdouble
x2,GLdouble
y2) = (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [GLdouble]
xList,forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [GLdouble]
yList)
          (GLdouble
x1,GLdouble
y1) = (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [GLdouble]
xList,forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [GLdouble]
yList)

----------------------------------------------
-- grouping GameObjects and creating managers
----------------------------------------------
objectGroup :: String -> [(GameObject t)] -> (ObjectManager t)
objectGroup :: forall t. String -> [GameObject t] -> ObjectManager t
objectGroup String
name [GameObject t]
objs = OM {mngName :: String
mngName = String
name, mngCounter :: Integer
mngCounter = forall a. Enum a => Int -> a
toEnum (forall (t :: * -> *) a. Foldable t => t a -> Int
length [GameObject t]
objs), mngObjects :: [GameObject t]
mngObjects = forall t. [GameObject t] -> String -> Integer -> [GameObject t]
objectGroupAux [GameObject t]
objs String
name Integer
0}

objectGroupAux :: [(GameObject t)] -> String -> Integer -> [(GameObject t)]
objectGroupAux :: forall t. [GameObject t] -> String -> Integer -> [GameObject t]
objectGroupAux [] String
_ Integer
_ = []
objectGroupAux (GameObject t
o:[GameObject t]
os) String
managerName Integer
oId = (GameObject t
o {objId :: Integer
objId = Integer
oId, objManagerName :: String
objManagerName = String
managerName})forall a. a -> [a] -> [a]
:(forall t. [GameObject t] -> String -> Integer -> [GameObject t]
objectGroupAux [GameObject t]
os String
managerName (Integer
oId forall a. Num a => a -> a -> a
+ Integer
1))

addObjectsToManager :: [(GameObject t)] -> String -> [(ObjectManager t)] -> [(ObjectManager t)]
addObjectsToManager :: forall t.
[GameObject t] -> String -> [ObjectManager t] -> [ObjectManager t]
addObjectsToManager [GameObject t]
_ String
managerName [] = forall a. HasCallStack => String -> a
error (String
"Objects.addObjectsToManager error: object manager " forall a. [a] -> [a] -> [a]
++ String
managerName forall a. [a] -> [a] -> [a]
++ String
" does not exists!")
addObjectsToManager [GameObject t]
objs String
managerName (ObjectManager t
m:[ObjectManager t]
ms) | (forall t. ObjectManager t -> String
getObjectManagerName ObjectManager t
m forall a. Eq a => a -> a -> Bool
== String
managerName) = (forall t. [GameObject t] -> ObjectManager t -> ObjectManager t
addObjectsToManagerAux [GameObject t]
objs ObjectManager t
m)forall a. a -> [a] -> [a]
:[ObjectManager t]
ms
                                            | Bool
otherwise = ObjectManager t
mforall a. a -> [a] -> [a]
:(forall t.
[GameObject t] -> String -> [ObjectManager t] -> [ObjectManager t]
addObjectsToManager [GameObject t]
objs String
managerName [ObjectManager t]
ms)


addObjectsToManagerAux :: [(GameObject t)] -> ObjectManager t -> ObjectManager t
addObjectsToManagerAux :: forall t. [GameObject t] -> ObjectManager t -> ObjectManager t
addObjectsToManagerAux [GameObject t]
objs ObjectManager t
mng = let counter :: Integer
counter = forall t. ObjectManager t -> Integer
getObjectManagerCounter ObjectManager t
mng
                                      newObjects :: [GameObject t]
newObjects = forall t. [GameObject t] -> Integer -> String -> [GameObject t]
adjustNewObjects [GameObject t]
objs (forall t. ObjectManager t -> Integer
getObjectManagerCounter ObjectManager t
mng) (forall t. ObjectManager t -> String
getObjectManagerName ObjectManager t
mng)
                                  in ObjectManager t
mng {mngObjects :: [GameObject t]
mngObjects = [GameObject t]
newObjects forall a. [a] -> [a] -> [a]
++ (forall t. ObjectManager t -> [GameObject t]
getObjectManagerObjects ObjectManager t
mng), mngCounter :: Integer
mngCounter = Integer
counter forall a. Num a => a -> a -> a
+ (forall a. Enum a => Int -> a
toEnum (forall (t :: * -> *) a. Foldable t => t a -> Int
length [GameObject t]
objs))}

adjustNewObjects :: [(GameObject t)] -> Integer -> String -> [(GameObject t)]
adjustNewObjects :: forall t. [GameObject t] -> Integer -> String -> [GameObject t]
adjustNewObjects [] Integer
_ String
_ = []
adjustNewObjects (GameObject t
o:[GameObject t]
os) Integer
oId String
managerName = (GameObject t
o {objId :: Integer
objId = Integer
oId, objManagerName :: String
objManagerName = String
managerName})forall a. a -> [a] -> [a]
:(forall t. [GameObject t] -> Integer -> String -> [GameObject t]
adjustNewObjects [GameObject t]
os (Integer
oId forall a. Num a => a -> a -> a
+ Integer
1) String
managerName)

------------------------------------------
-- draw routines
------------------------------------------
drawGameObjects :: [(ObjectManager t)] -> QuadricPrimitive -> [TextureObject] -> IO ()
drawGameObjects :: forall t.
[ObjectManager t] -> QuadricPrimitive -> [TextureObject] -> IO ()
drawGameObjects [] QuadricPrimitive
_ [TextureObject]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
drawGameObjects (ObjectManager t
m:[ObjectManager t]
ms) QuadricPrimitive
qobj [TextureObject]
picList = forall t.
[GameObject t] -> QuadricPrimitive -> [TextureObject] -> IO ()
drawGameObjectList (forall t. ObjectManager t -> [GameObject t]
getObjectManagerObjects ObjectManager t
m) QuadricPrimitive
qobj [TextureObject]
picList forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t.
[ObjectManager t] -> QuadricPrimitive -> [TextureObject] -> IO ()
drawGameObjects [ObjectManager t]
ms QuadricPrimitive
qobj [TextureObject]
picList

drawGameObjectList :: [(GameObject t)] -> QuadricPrimitive -> [TextureObject] -> IO ()
drawGameObjectList :: forall t.
[GameObject t] -> QuadricPrimitive -> [TextureObject] -> IO ()
drawGameObjectList [] QuadricPrimitive
_ [TextureObject]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
drawGameObjectList (GameObject t
o:[GameObject t]
os) QuadricPrimitive
qobj [TextureObject]
picList | (forall t. GameObject t -> Bool
getGameObjectAsleep GameObject t
o) = forall t.
[GameObject t] -> QuadricPrimitive -> [TextureObject] -> IO ()
drawGameObjectList [GameObject t]
os QuadricPrimitive
qobj [TextureObject]
picList
                                       | Bool
otherwise = forall t.
GameObject t -> QuadricPrimitive -> [TextureObject] -> IO ()
drawGameObject GameObject t
o QuadricPrimitive
qobj [TextureObject]
picList forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t.
[GameObject t] -> QuadricPrimitive -> [TextureObject] -> IO ()
drawGameObjectList [GameObject t]
os QuadricPrimitive
qobj [TextureObject]
picList

drawGameObject :: GameObject t -> QuadricPrimitive -> [TextureObject] -> IO ()
drawGameObject :: forall t.
GameObject t -> QuadricPrimitive -> [TextureObject] -> IO ()
drawGameObject GameObject t
o QuadricPrimitive
_qobj [TextureObject]
picList = do
    IO ()
loadIdentity
    let (GLdouble
pX,GLdouble
pY) = forall t. GameObject t -> Point2D
getGameObjectPosition GameObject t
o
        picture :: GameObjectPicture
picture = forall t. GameObject t -> GameObjectPicture
getGameObjectPicture GameObject t
o
    forall c. MatrixComponent c => Vector3 c -> IO ()
translate (forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
pX GLdouble
pY (GLdouble
0 :: GLdouble) )
    case GameObjectPicture
picture of
        (B (P [Vertex3 GLdouble]
points Color4 GLfloat
c FillMode
fillMode)) -> do
                    forall a. Color a => a -> IO ()
color Color4 GLfloat
c
                    if (FillMode
fillMode forall a. Eq a => a -> a -> Bool
== FillMode
Filled)
                        then (forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Polygon  forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. Vertex a => a -> IO ()
vertex [Vertex3 GLdouble]
points)
                        else (forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
LineLoop forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. Vertex a => a -> IO ()
vertex [Vertex3 GLdouble]
points) 

        (B (C GLdouble
r Color4 GLfloat
c FillMode
fillMode)) -> do
                    forall a. Color a => a -> IO ()
color Color4 GLfloat
c
                    QuadricStyle -> QuadricPrimitive -> IO ()
renderQuadric QuadricStyle
style forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> Slices -> Slices -> QuadricPrimitive
Disk GLdouble
0 GLdouble
r Slices
20 Slices
3
                 where style :: QuadricStyle
style = QuadricNormal
-> QuadricTexture
-> QuadricOrientation
-> QuadricDrawStyle
-> QuadricStyle
QuadricStyle forall a. Maybe a
Nothing QuadricTexture
NoTextureCoordinates QuadricOrientation
Outside QuadricDrawStyle
fillStyle
                       fillStyle :: QuadricDrawStyle
fillStyle = if (FillMode
fillMode forall a. Eq a => a -> a -> Bool
== FillMode
Filled) then QuadricDrawStyle
FillStyle else QuadricDrawStyle
SilhouetteStyle

        (Tx Int
picIndex) -> do
                        forall t. ParameterizedTextureTarget t => t -> StateVar Capability
texture TextureTarget2D
Texture2D forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Capability
Enabled
                        TextureTarget2D -> TextureObject -> IO ()
bindTexture TextureTarget2D
Texture2D ([TextureObject]
picList forall a. [a] -> Int -> a
!! Int
picIndex)
                        forall a. Color a => a -> IO ()
color (forall a. a -> a -> a -> a -> Color4 a
Color4 GLfloat
1.0 GLfloat
1.0 GLfloat
1.0 (GLfloat
1.0 :: GLfloat))
                        forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Quads forall a b. (a -> b) -> a -> b
$ do
                            GLdouble -> GLdouble -> IO ()
texCoord2 GLdouble
0.0 GLdouble
0.0;  GLdouble -> GLdouble -> GLdouble -> IO ()
vertex3 (-GLdouble
x) (-GLdouble
y) GLdouble
0.0
                            GLdouble -> GLdouble -> IO ()
texCoord2 GLdouble
1.0 GLdouble
0.0;  GLdouble -> GLdouble -> GLdouble -> IO ()
vertex3   GLdouble
x  (-GLdouble
y) GLdouble
0.0
                            GLdouble -> GLdouble -> IO ()
texCoord2 GLdouble
1.0 GLdouble
1.0;  GLdouble -> GLdouble -> GLdouble -> IO ()
vertex3   GLdouble
x    GLdouble
y  GLdouble
0.0
                            GLdouble -> GLdouble -> IO ()
texCoord2 GLdouble
0.0 GLdouble
1.0;  GLdouble -> GLdouble -> GLdouble -> IO ()
vertex3 (-GLdouble
x)   GLdouble
y  GLdouble
0.0
                        forall t. ParameterizedTextureTarget t => t -> StateVar Capability
texture TextureTarget2D
Texture2D forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Capability
Disabled
                   where (GLdouble
sX,GLdouble
sY) = forall t. GameObject t -> Point2D
getGameObjectSize GameObject t
o
                         x :: GLdouble
x = GLdouble
sXforall a. Fractional a => a -> a -> a
/GLdouble
2
                         y :: GLdouble
y = GLdouble
sYforall a. Fractional a => a -> a -> a
/GLdouble
2
            
------------------------------------------
-- search routines
------------------------------------------

findObjectFromId :: GameObject t -> [(ObjectManager t)] -> GameObject t
findObjectFromId :: forall t. GameObject t -> [ObjectManager t] -> GameObject t
findObjectFromId GameObject t
o [ObjectManager t]
mngs = forall t. Integer -> String -> [ObjectManager t] -> GameObject t
findObjectFromIdAux (forall t. GameObject t -> Integer
getGameObjectId GameObject t
o) (forall t. GameObject t -> String
getGameObjectManagerName GameObject t
o) [ObjectManager t]
mngs

findObjectFromIdAux :: Integer -> String ->  [(ObjectManager t)] -> GameObject t
findObjectFromIdAux :: forall t. Integer -> String -> [ObjectManager t] -> GameObject t
findObjectFromIdAux Integer
_ String
managerName [] = forall a. HasCallStack => String -> a
error (String
"Objects.findObjectFromIdAux error: object group " forall a. [a] -> [a] -> [a]
++ String
managerName forall a. [a] -> [a] -> [a]
++ String
" not found!")
findObjectFromIdAux Integer
objectId String
managerName (ObjectManager t
m:[ObjectManager t]
ms) | (String
managerName forall a. Eq a => a -> a -> Bool
== forall t. ObjectManager t -> String
getObjectManagerName ObjectManager t
m) = forall t. Integer -> [GameObject t] -> GameObject t
searchFromId Integer
objectId (forall t. ObjectManager t -> [GameObject t]
getObjectManagerObjects ObjectManager t
m)
                                                | Bool
otherwise = forall t. Integer -> String -> [ObjectManager t] -> GameObject t
findObjectFromIdAux Integer
objectId String
managerName [ObjectManager t]
ms

searchFromId :: Integer -> [(GameObject t)] -> GameObject t
searchFromId :: forall t. Integer -> [GameObject t] -> GameObject t
searchFromId Integer
_ [] = forall a. HasCallStack => String -> a
error (String
"Objects.searchFromId error: object not found!")
searchFromId Integer
objectId (GameObject t
o:[GameObject t]
os) | (Integer
objectId forall a. Eq a => a -> a -> Bool
== forall t. GameObject t -> Integer
getGameObjectId GameObject t
o) = GameObject t
o
                             | Bool
otherwise = forall t. Integer -> [GameObject t] -> GameObject t
searchFromId Integer
objectId [GameObject t]
os


searchObjectManager :: String -> [(ObjectManager t)] -> ObjectManager t
searchObjectManager :: forall t. String -> [ObjectManager t] -> ObjectManager t
searchObjectManager String
managerName [] = forall a. HasCallStack => String -> a
error (String
"Objects.searchObjectManager error: object group " forall a. [a] -> [a] -> [a]
++ String
managerName forall a. [a] -> [a] -> [a]
++ String
" not found!")
searchObjectManager String
managerName (ObjectManager t
m:[ObjectManager t]
ms) | (forall t. ObjectManager t -> String
getObjectManagerName ObjectManager t
m forall a. Eq a => a -> a -> Bool
== String
managerName) = ObjectManager t
m
                                       | Bool
otherwise = forall t. String -> [ObjectManager t] -> ObjectManager t
searchObjectManager String
managerName [ObjectManager t]
ms

searchGameObject :: String -> ObjectManager t -> GameObject t
searchGameObject :: forall t. String -> ObjectManager t -> GameObject t
searchGameObject String
objectName ObjectManager t
m = forall t. String -> [GameObject t] -> GameObject t
searchGameObjectAux String
objectName (forall t. ObjectManager t -> [GameObject t]
getObjectManagerObjects ObjectManager t
m)

searchGameObjectAux :: String -> [(GameObject t)] -> GameObject t
searchGameObjectAux :: forall t. String -> [GameObject t] -> GameObject t
searchGameObjectAux String
objectName [] = forall a. HasCallStack => String -> a
error (String
"Objects.searchGameObjectAux error: object " forall a. [a] -> [a] -> [a]
++ String
objectName forall a. [a] -> [a] -> [a]
++ String
" not found!")
searchGameObjectAux String
objectName (GameObject t
a:[GameObject t]
as) | (forall t. GameObject t -> String
getGameObjectName GameObject t
a forall a. Eq a => a -> a -> Bool
== String
objectName) = GameObject t
a
                                      | Bool
otherwise = forall t. String -> [GameObject t] -> GameObject t
searchGameObjectAux String
objectName [GameObject t]
as

------------------------------------------
-- update routines
------------------------------------------

-- substitutes an old object by a new one, given the function to be applied to the old object (whose id is given),
-- the name of its manager and the group of game managers.
updateObject :: (GameObject t -> GameObject t) -> Integer -> String -> [(ObjectManager t)] -> [(ObjectManager t)]
updateObject :: forall t.
(GameObject t -> GameObject t)
-> Integer -> String -> [ObjectManager t] -> [ObjectManager t]
updateObject GameObject t -> GameObject t
_ Integer
_ String
managerName [] = forall a. HasCallStack => String -> a
error (String
"Objects.updateObject error: object manager: " forall a. [a] -> [a] -> [a]
++ String
managerName forall a. [a] -> [a] -> [a]
++ String
" not found!")
updateObject GameObject t -> GameObject t
f Integer
objectId String
managerName (ObjectManager t
m:[ObjectManager t]
ms) | (forall t. ObjectManager t -> String
getObjectManagerName ObjectManager t
m forall a. Eq a => a -> a -> Bool
== String
managerName) = (forall t. [GameObject t] -> ObjectManager t -> ObjectManager t
updateObjectManagerObjects [GameObject t]
newObjects ObjectManager t
m)forall a. a -> [a] -> [a]
:[ObjectManager t]
ms
                                           | Bool
otherwise = ObjectManager t
mforall a. a -> [a] -> [a]
:(forall t.
(GameObject t -> GameObject t)
-> Integer -> String -> [ObjectManager t] -> [ObjectManager t]
updateObject GameObject t -> GameObject t
f Integer
objectId String
managerName [ObjectManager t]
ms)
                                           where newObjects :: [GameObject t]
newObjects = forall t.
(GameObject t -> GameObject t)
-> Integer -> [GameObject t] -> [GameObject t]
updateObjectAux GameObject t -> GameObject t
f Integer
objectId (forall t. ObjectManager t -> [GameObject t]
getObjectManagerObjects ObjectManager t
m)

updateObjectAux :: (GameObject t -> GameObject t) -> Integer -> [(GameObject t)] -> [(GameObject t)]
updateObjectAux :: forall t.
(GameObject t -> GameObject t)
-> Integer -> [GameObject t] -> [GameObject t]
updateObjectAux GameObject t -> GameObject t
_ Integer
_ [] = forall a. HasCallStack => String -> a
error (String
"Objects.updateObjectAux error: object not found!")
updateObjectAux GameObject t -> GameObject t
f Integer
objectId (GameObject t
o:[GameObject t]
os) | (forall t. GameObject t -> Integer
getGameObjectId GameObject t
o forall a. Eq a => a -> a -> Bool
== Integer
objectId) = (GameObject t -> GameObject t
f GameObject t
o)forall a. a -> [a] -> [a]
:[GameObject t]
os
                                  | Bool
otherwise = GameObject t
oforall a. a -> [a] -> [a]
:(forall t.
(GameObject t -> GameObject t)
-> Integer -> [GameObject t] -> [GameObject t]
updateObjectAux GameObject t -> GameObject t
f Integer
objectId [GameObject t]
os)

------------------------------------------
-- moving routines
------------------------------------------

-- modifies all objects position according to their speed
moveGameObjects :: [(ObjectManager t)] -> [(ObjectManager t)]
moveGameObjects :: forall t. [ObjectManager t] -> [ObjectManager t]
moveGameObjects [] = []
moveGameObjects (ObjectManager t
m:[ObjectManager t]
ms) = (forall t. [GameObject t] -> ObjectManager t -> ObjectManager t
updateObjectManagerObjects (forall a b. (a -> b) -> [a] -> [b]
map forall t. GameObject t -> GameObject t
moveSingleObject (forall t. ObjectManager t -> [GameObject t]
getObjectManagerObjects ObjectManager t
m)) ObjectManager t
m)forall a. a -> [a] -> [a]
:(forall t. [ObjectManager t] -> [ObjectManager t]
moveGameObjects [ObjectManager t]
ms)

moveSingleObject :: GameObject t -> GameObject t
moveSingleObject :: forall t. GameObject t -> GameObject t
moveSingleObject GameObject t
o = if (forall t. GameObject t -> Bool
getGameObjectAsleep GameObject t
o)
                        then GameObject t
o
                        else let (GLdouble
vX,GLdouble
vY) = forall t. GameObject t -> Point2D
getGameObjectSpeed GameObject t
o
                                 (GLdouble
pX,GLdouble
pY) = forall t. GameObject t -> Point2D
getGameObjectPosition GameObject t
o
                             in forall t. Point2D -> GameObject t -> GameObject t
updateObjectPosition (GLdouble
pX forall a. Num a => a -> a -> a
+ GLdouble
vX, GLdouble
pY forall a. Num a => a -> a -> a
+ GLdouble
vY) GameObject t
o

------------------------------------------
-- destroy routines
------------------------------------------

destroyGameObject :: String -> String -> [(ObjectManager t)] -> [(ObjectManager t)]
destroyGameObject :: forall t.
String -> String -> [ObjectManager t] -> [ObjectManager t]
destroyGameObject String
_ String
managerName [] = forall a. HasCallStack => String -> a
error (String
"Objects.destroyGameObject error: object manager: " forall a. [a] -> [a] -> [a]
++ String
managerName forall a. [a] -> [a] -> [a]
++ String
" not found!")
destroyGameObject String
objectName String
managerName (ObjectManager t
m:[ObjectManager t]
ms) | (forall t. ObjectManager t -> String
getObjectManagerName ObjectManager t
m forall a. Eq a => a -> a -> Bool
== String
managerName) = (forall t. [GameObject t] -> ObjectManager t -> ObjectManager t
updateObjectManagerObjects [GameObject t]
newObjects ObjectManager t
m)forall a. a -> [a] -> [a]
:[ObjectManager t]
ms
                     | Bool
otherwise = ObjectManager t
mforall a. a -> [a] -> [a]
:(forall t.
String -> String -> [ObjectManager t] -> [ObjectManager t]
destroyGameObject String
objectName String
managerName [ObjectManager t]
ms)
                       where newObjects :: [GameObject t]
newObjects = forall t. String -> [GameObject t] -> [GameObject t]
destroyGameObjectAux String
objectName (forall t. ObjectManager t -> [GameObject t]
getObjectManagerObjects ObjectManager t
m)

destroyGameObjectAux :: String -> [(GameObject t)] -> [(GameObject t)]
destroyGameObjectAux :: forall t. String -> [GameObject t] -> [GameObject t]
destroyGameObjectAux String
objectName [] = forall a. HasCallStack => String -> a
error (String
"Objects.destroyGameObjectAux error: object: " forall a. [a] -> [a] -> [a]
++ String
objectName forall a. [a] -> [a] -> [a]
++ String
" not found!") 
destroyGameObjectAux String
objectName (GameObject t
o:[GameObject t]
os) | (forall t. GameObject t -> String
getGameObjectName GameObject t
o forall a. Eq a => a -> a -> Bool
== String
objectName) = [GameObject t]
os
                    | Bool
otherwise = GameObject t
oforall a. a -> [a] -> [a]
:(forall t. String -> [GameObject t] -> [GameObject t]
destroyGameObjectAux String
objectName [GameObject t]
os)