Safe Haskell | None |
---|---|
Language | Haskell2010 |
This is the main module of FunGEN (Functional Game Engine), which re-exports the rest.
Synopsis
- funInit :: WindowConfig -> GameMap v -> [ObjectManager s] -> u -> t -> [InputBinding t s u v] -> IOGame t s u v () -> RefreshType -> FilePictureList -> IO ()
- funExit :: IOGame t s u v ()
- type WindowConfig = ((Int, Int), (Int, Int), String)
- type Point2D = (GLdouble, GLdouble)
- type ColorList3 = [(GLubyte, GLubyte, GLubyte)]
- type AwbfBitmap = (GLsizei, GLsizei, PixelData GLubyte)
- type InvList = Maybe [(Int, Int, Int)]
- loadBitmap :: FilePath -> Maybe ColorList3 -> IO AwbfBitmap
- loadBitmapList :: [(FilePath, Maybe ColorList3)] -> IO [AwbfBitmap]
- type FilePictureList = [(FilePath, InvList)]
- data BitmapFont
- type Text = (String, BitmapFont, Point2D, GLclampf, GLclampf, GLclampf)
- putGameText :: [Text] -> IO ()
- data GameMap t
- type Tile t = (Int, Bool, Float, t)
- type TileMatrix t = [[Tile t]]
- colorMap :: GLclampf -> GLclampf -> GLclampf -> GLdouble -> GLdouble -> GameMap t
- textureMap :: Int -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GameMap t
- tileMap :: TileMatrix t -> GLdouble -> GLdouble -> GameMap t
- multiMap :: [GameMap t] -> Int -> GameMap t
- isTileMap :: GameMap t -> Bool
- isMultiMap :: GameMap t -> Bool
- getMapSize :: GameMap t -> Point2D
- getTileMapTileMatrix :: GameMap t -> TileMatrix t
- getTileMapScroll :: GameMap t -> Point2D
- getTileMapSize :: GameMap t -> Point2D
- getTileMapTileSize :: GameMap t -> Point2D
- getTilePictureIndex :: Tile t -> Int
- getTileBlocked :: Tile t -> Bool
- getTileMoveCost :: Tile t -> Float
- getTileSpecialAttribute :: Tile t -> t
- getCurrentMap :: GameMap t -> GameMap t
- updateCurrentMap :: GameMap t -> GameMap t -> GameMap t
- updateCurrentIndex :: GameMap t -> Int -> GameMap t
- drawGameMap :: GameMap t -> Point2D -> [TextureObject] -> IO ()
- clearGameScreen :: GLclampf -> GLclampf -> GLclampf -> IO ()
- data ObjectManager t
- data GameObject t
- data ObjectPicture
- data Primitive
- data FillMode
- object :: String -> ObjectPicture -> Bool -> (GLdouble, GLdouble) -> (GLdouble, GLdouble) -> t -> GameObject t
- getGameObjectId :: GameObject t -> Integer
- getGameObjectName :: GameObject t -> String
- getGameObjectManagerName :: GameObject t -> String
- getGameObjectAsleep :: GameObject t -> Bool
- getGameObjectPosition :: GameObject t -> (GLdouble, GLdouble)
- getGameObjectSize :: GameObject t -> (GLdouble, GLdouble)
- getGameObjectSpeed :: GameObject t -> (GLdouble, GLdouble)
- getGameObjectAttribute :: GameObject t -> t
- updateObject :: (GameObject t -> GameObject t) -> Integer -> String -> [ObjectManager t] -> [ObjectManager t]
- updateObjectAsleep :: Bool -> GameObject t -> GameObject t
- updateObjectSize :: (GLdouble, GLdouble) -> GameObject t -> GameObject t
- updateObjectPosition :: (GLdouble, GLdouble) -> GameObject t -> GameObject t
- updateObjectSpeed :: (GLdouble, GLdouble) -> GameObject t -> GameObject t
- updateObjectAttribute :: t -> GameObject t -> GameObject t
- updateObjectPicture :: Int -> Int -> GameObject t -> GameObject t
- drawGameObjects :: [ObjectManager t] -> QuadricPrimitive -> [TextureObject] -> IO ()
- drawGameObject :: GameObject t -> QuadricPrimitive -> [TextureObject] -> IO ()
- moveGameObjects :: [ObjectManager t] -> [ObjectManager t]
- destroyGameObject :: String -> String -> [ObjectManager t] -> [ObjectManager t]
- objectGroup :: String -> [GameObject t] -> ObjectManager t
- addObjectsToManager :: [GameObject t] -> String -> [ObjectManager t] -> [ObjectManager t]
- getObjectManagerName :: ObjectManager t -> String
- getObjectManagerCounter :: ObjectManager t -> Integer
- getObjectManagerObjects :: ObjectManager t -> [GameObject t]
- findObjectFromId :: GameObject t -> [ObjectManager t] -> GameObject t
- searchObjectManager :: String -> [ObjectManager t] -> ObjectManager t
- searchGameObject :: String -> ObjectManager t -> GameObject t
- type InputBinding t s u v = (Key, KeyEvent, InputHandler t s u v)
- type InputHandler t s u v = Modifiers -> Position -> IOGame t s u v ()
- data KeyEvent
- data Key
- data SpecialKey
- data MouseButton
- data Modifiers = Modifiers {}
- data Position = Position !GLint !GLint
- funInitInput :: [InputBinding t s u v] -> Game t s u v -> IO (KeyBinder, StillDownHandler)
- data RefreshType
- setRefresh :: RefreshType -> StillDownHandler -> IO ()
- data Game t s u v
- data IOGame t s u v a
- createGame :: GameMap v -> [ObjectManager s] -> WindowConfig -> u -> t -> FilePictureList -> IO (Game t s u v)
- runIOGame :: IOGame t s u v a -> Game t s u v -> IO (Game t s u v, a)
- runIOGameM :: IOGame t s u v a -> Game t s u v -> IO ()
- liftIOtoIOGame :: IO a -> IOGame t s u v a
- liftIOtoIOGame' :: (a -> IO ()) -> a -> IOGame t s u v ()
- getGameState :: IOGame t s u v u
- setGameState :: u -> IOGame t s u v ()
- getGameAttribute :: IOGame t s u v t
- setGameAttribute :: t -> IOGame t s u v ()
- getGameFlags :: IOGame t s u v GameFlags
- setGameFlags :: GameFlags -> IOGame t s u v ()
- enableGameFlags :: IOGame t s u v ()
- disableGameFlags :: IOGame t s u v ()
- enableMapDrawing :: IOGame t s u v ()
- disableMapDrawing :: IOGame t s u v ()
- enableObjectsDrawing :: IOGame t s u v ()
- disableObjectsDrawing :: IOGame t s u v ()
- enableObjectsMoving :: IOGame t s u v ()
- disableObjectsMoving :: IOGame t s u v ()
- drawMap :: IOGame t s u v ()
- clearScreen :: GLclampf -> GLclampf -> GLclampf -> IOGame t s u v ()
- getTileFromIndex :: (Int, Int) -> IOGame t s u v (Tile v)
- getTileFromWindowPosition :: (GLdouble, GLdouble) -> IOGame t s u v (Tile v)
- setCurrentMapIndex :: Int -> IOGame t s u v ()
- getObjectManagers :: IOGame t s u v [ObjectManager s]
- setObjectManagers :: [ObjectManager s] -> IOGame t s u v ()
- drawAllObjects :: IOGame t s u v ()
- drawObject :: GameObject s -> IOGame t s u v ()
- moveAllObjects :: IOGame t s u v ()
- destroyObjects :: [GameObject s] -> IOGame t s u v ()
- destroyObject :: GameObject s -> IOGame t s u v ()
- getObjectsFromGroup :: String -> IOGame t s u v [GameObject s]
- addObjectsToGroup :: [GameObject s] -> String -> IOGame t s u v ()
- addObjectsToNewGroup :: [GameObject s] -> String -> IOGame t s u v ()
- findObjectManager :: String -> IOGame t s u v (ObjectManager s)
- findObject :: String -> String -> IOGame t s u v (GameObject s)
- getObjectName :: GameObject s -> IOGame t s u v String
- getObjectGroupName :: GameObject s -> IOGame t s u v String
- getObjectAsleep :: GameObject s -> IOGame t s u v Bool
- getObjectSize :: GameObject s -> IOGame t s u v (GLdouble, GLdouble)
- getObjectPosition :: GameObject s -> IOGame t s u v (GLdouble, GLdouble)
- getObjectSpeed :: GameObject s -> IOGame t s u v (GLdouble, GLdouble)
- getObjectAttribute :: GameObject s -> IOGame t s u v s
- setObjectPosition :: (GLdouble, GLdouble) -> GameObject s -> IOGame t s u v ()
- setObjectAsleep :: Bool -> GameObject s -> IOGame t s u v ()
- setObjectSpeed :: (GLdouble, GLdouble) -> GameObject s -> IOGame t s u v ()
- setObjectCurrentPicture :: Int -> GameObject s -> IOGame t s u v ()
- setObjectAttribute :: s -> GameObject s -> IOGame t s u v ()
- replaceObject :: GameObject s -> (GameObject s -> GameObject s) -> IOGame t s u v ()
- reverseXSpeed :: GameObject s -> IOGame t s u v ()
- reverseYSpeed :: GameObject s -> IOGame t s u v ()
- objectsCollision :: GameObject s -> GameObject s -> IOGame t s u v Bool
- objectsFutureCollision :: GameObject s -> GameObject s -> IOGame t s u v Bool
- objectListObjectCollision :: [GameObject s] -> GameObject s -> IOGame t s u v Bool
- objectListObjectFutureCollision :: [GameObject s] -> GameObject s -> IOGame t s u v Bool
- objectTopMapCollision :: GameObject s -> IOGame t s u v Bool
- objectBottomMapCollision :: GameObject s -> IOGame t s u v Bool
- objectRightMapCollision :: GameObject s -> IOGame t s u v Bool
- objectLeftMapCollision :: GameObject s -> IOGame t s u v Bool
- pointsObjectCollision :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> GameObject s -> IOGame t s u v Bool
- pointsObjectListCollision :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> [GameObject s] -> IOGame t s u v Bool
- objectTopMapFutureCollision :: GameObject s -> IOGame t s u v Bool
- objectBottomMapFutureCollision :: GameObject s -> IOGame t s u v Bool
- objectRightMapFutureCollision :: GameObject s -> IOGame t s u v Bool
- objectLeftMapFutureCollision :: GameObject s -> IOGame t s u v Bool
- printOnPrompt :: Show a => a -> IOGame t s u v ()
- printOnScreen :: String -> BitmapFont -> (GLdouble, GLdouble) -> GLclampf -> GLclampf -> GLclampf -> IOGame t s u v ()
- printText :: IOGame t s u v ()
- randomFloat :: (Float, Float) -> IOGame t s u v Float
- randomInt :: (Int, Int) -> IOGame t s u v Int
- randomDouble :: (Double, Double) -> IOGame t s u v Double
- showFPS :: BitmapFont -> (GLdouble, GLdouble) -> GLclampf -> GLclampf -> GLclampf -> IOGame t s u v ()
- wait :: Int -> IOGame t s u v ()
- display :: Game t s u v -> IOGame t s u v () -> DisplayCallback
- texCoord2 :: GLdouble -> GLdouble -> IO ()
- vertex3 :: GLdouble -> GLdouble -> GLdouble -> IO ()
- texStuff :: [TextureObject] -> [AwbfBitmap] -> IO ()
- toRad :: Float -> Float
- randInt :: (Int, Int) -> IO Int
- randFloat :: (Float, Float) -> IO Float
- randDouble :: (Double, Double) -> IO Double
- shiftLeft :: String -> Int -> String
- toDecimal :: String -> GLsizei
- pow2 :: GLsizei -> GLsizei
- toBinary :: Int -> String
- make0 :: Int -> String
- dropGLsizei :: GLsizei -> [a] -> [a]
- ord2 :: Char -> GLubyte
- addNoInvisibility :: [FilePath] -> [(FilePath, Maybe ColorList3)]
- racMod :: GLdouble -> GLdouble -> GLdouble
- matrixToList :: [[a]] -> [a]
- matrixSize :: [[a]] -> (Int, Int)
- inv2color3 :: InvList -> Maybe ColorList3
- pathAndInv2color3List :: (FilePath, InvList) -> (FilePath, Maybe ColorList3)
- point2DtoVertex3 :: [Point2D] -> [Vertex3 GLdouble]
- isEmpty :: [a] -> Bool
- when :: Monad m => Bool -> m () -> m ()
- unless :: Monad m => Bool -> m () -> m ()
- bindTexture :: TextureTarget2D -> TextureObject -> IO ()
- tracewith :: (a -> String) -> a -> a
- strace :: Show a => a -> a
- ltrace :: Show a => String -> a -> a
- mtrace :: (Monad m, Show a) => a -> m a
Execution
Starting and stopping a game.
:: WindowConfig | main window layout |
-> GameMap v | background/map(s) |
-> [ObjectManager s] | object groups |
-> u | initial game state |
-> t | initial game attribute |
-> [InputBinding t s u v] | input bindings |
-> IOGame t s u v () | step action |
-> RefreshType | main loop timing |
-> FilePictureList | image files |
-> IO () |
Configure a FunGEn game and start it running.
Types
Some basic types.
Images
Loading BMP image files.
loadBitmap :: FilePath -> Maybe ColorList3 -> IO AwbfBitmap Source #
Loads a bitmap from a file.
loadBitmapList :: [(FilePath, Maybe ColorList3)] -> IO [AwbfBitmap] Source #
Loads n bitmaps from n files.
type FilePictureList = [(FilePath, InvList)] Source #
Text
Printing text on the screen.
data BitmapFont #
The bitmap fonts available in GLUT. The exact bitmap to be used is defined by the standard X glyph bitmaps for the X font with the given name.
Fixed8By13 | A fixed width font with every character fitting in an 8
by 13 pixel rectangle.
( |
Fixed9By15 | A fixed width font with every character fitting in an 9
by 15 pixel rectangle.
( |
TimesRoman10 | A 10-point proportional spaced Times Roman font.
( |
TimesRoman24 | A 24-point proportional spaced Times Roman font.
( |
Helvetica10 | A 10-point proportional spaced Helvetica font.
( |
Helvetica12 | A 12-point proportional spaced Helvetica font.
( |
Helvetica18 | A 18-point proportional spaced Helvetica font.
( |
Instances
Eq BitmapFont | |
Defined in Graphics.UI.GLUT.Raw.Fonts (==) :: BitmapFont -> BitmapFont -> Bool # (/=) :: BitmapFont -> BitmapFont -> Bool # | |
Ord BitmapFont | |
Defined in Graphics.UI.GLUT.Raw.Fonts compare :: BitmapFont -> BitmapFont -> Ordering # (<) :: BitmapFont -> BitmapFont -> Bool # (<=) :: BitmapFont -> BitmapFont -> Bool # (>) :: BitmapFont -> BitmapFont -> Bool # (>=) :: BitmapFont -> BitmapFont -> Bool # max :: BitmapFont -> BitmapFont -> BitmapFont # min :: BitmapFont -> BitmapFont -> BitmapFont # | |
Show BitmapFont | |
Defined in Graphics.UI.GLUT.Raw.Fonts showsPrec :: Int -> BitmapFont -> ShowS # show :: BitmapFont -> String # showList :: [BitmapFont] -> ShowS # | |
Font BitmapFont | |
Defined in Graphics.UI.GLUT.Fonts renderString :: MonadIO m => BitmapFont -> String -> m () # stringWidth :: MonadIO m => BitmapFont -> String -> m GLint # fontHeight :: MonadIO m => BitmapFont -> m GLfloat # |
type Text = (String, BitmapFont, Point2D, GLclampf, GLclampf, GLclampf) Source #
String to be printed, font, screen position, color RGB.
putGameText :: [Text] -> IO () Source #
Display these texts on screen.
Maps/backgrounds
Game backgrounds, tile maps.
A game background (flat color, scrollable texture, or tile map), or several of them.
type TileMatrix t = [[Tile t]] Source #
creating
colorMap :: GLclampf -> GLclampf -> GLclampf -> GLdouble -> GLdouble -> GameMap t Source #
creates a PreColorMap
textureMap :: Int -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GameMap t Source #
creates a PreTextureMap
tileMap :: TileMatrix t -> GLdouble -> GLdouble -> GameMap t Source #
creates a PreTileMap, cheking if the tileMatrix given is valid and automatically defining the map size
map attributes
isMultiMap :: GameMap t -> Bool Source #
getMapSize :: GameMap t -> Point2D Source #
getTileMapTileMatrix :: GameMap t -> TileMatrix t Source #
getTileMapScroll :: GameMap t -> Point2D Source #
getTileMapSize :: GameMap t -> Point2D Source #
getTileMapTileSize :: GameMap t -> Point2D Source #
map tiles
getTilePictureIndex :: Tile t -> Int Source #
getTileBlocked :: Tile t -> Bool Source #
getTileMoveCost :: Tile t -> Float Source #
getTileSpecialAttribute :: Tile t -> t Source #
setting the current map
getCurrentMap :: GameMap t -> GameMap t Source #
drawing
drawGameMap :: GameMap t -> Point2D -> [TextureObject] -> IO () Source #
draw the background map
Objects
Game objects (sprites).
data ObjectManager t Source #
data GameObject t Source #
creating
object :: String -> ObjectPicture -> Bool -> (GLdouble, GLdouble) -> (GLdouble, GLdouble) -> t -> GameObject t Source #
object attributes
getGameObjectId :: GameObject t -> Integer Source #
getGameObjectName :: GameObject t -> String Source #
getGameObjectManagerName :: GameObject t -> String Source #
getGameObjectAsleep :: GameObject t -> Bool Source #
getGameObjectPosition :: GameObject t -> (GLdouble, GLdouble) Source #
getGameObjectSize :: GameObject t -> (GLdouble, GLdouble) Source #
getGameObjectSpeed :: GameObject t -> (GLdouble, GLdouble) Source #
getGameObjectAttribute :: GameObject t -> t Source #
updating
updateObject :: (GameObject t -> GameObject t) -> Integer -> String -> [ObjectManager t] -> [ObjectManager t] Source #
updateObjectAsleep :: Bool -> GameObject t -> GameObject t Source #
updateObjectSize :: (GLdouble, GLdouble) -> GameObject t -> GameObject t Source #
updateObjectPosition :: (GLdouble, GLdouble) -> GameObject t -> GameObject t Source #
updateObjectSpeed :: (GLdouble, GLdouble) -> GameObject t -> GameObject t Source #
updateObjectAttribute :: t -> GameObject t -> GameObject t Source #
updateObjectPicture :: Int -> Int -> GameObject t -> GameObject t Source #
drawing
drawGameObjects :: [ObjectManager t] -> QuadricPrimitive -> [TextureObject] -> IO () Source #
drawGameObject :: GameObject t -> QuadricPrimitive -> [TextureObject] -> IO () Source #
moving
moveGameObjects :: [ObjectManager t] -> [ObjectManager t] Source #
destroying
destroyGameObject :: String -> String -> [ObjectManager t] -> [ObjectManager t] Source #
groups of objects
objectGroup :: String -> [GameObject t] -> ObjectManager t Source #
addObjectsToManager :: [GameObject t] -> String -> [ObjectManager t] -> [ObjectManager t] Source #
getObjectManagerName :: ObjectManager t -> String Source #
getObjectManagerObjects :: ObjectManager t -> [GameObject t] Source #
searching
findObjectFromId :: GameObject t -> [ObjectManager t] -> GameObject t Source #
searchObjectManager :: String -> [ObjectManager t] -> ObjectManager t Source #
searchGameObject :: String -> ObjectManager t -> GameObject t Source #
Input
User input from mouse and keyboard.
type InputBinding t s u v = (Key, KeyEvent, InputHandler t s u v) Source #
A mapping from an input event to an input handler.
type InputHandler t s u v = Modifiers -> Position -> IOGame t s u v () Source #
A FunGEn input handler is like an IOGame (game action) that takes two extra arguments: the current keyboard modifiers state, and the current mouse position. (For a StillDown event, these will be the original state and position from the Press event.)
data SpecialKey #
Special keys
KeyF1 | |
KeyF2 | |
KeyF3 | |
KeyF4 | |
KeyF5 | |
KeyF6 | |
KeyF7 | |
KeyF8 | |
KeyF9 | |
KeyF10 | |
KeyF11 | |
KeyF12 | |
KeyLeft | |
KeyUp | |
KeyRight | |
KeyDown | |
KeyPageUp | |
KeyPageDown | |
KeyHome | |
KeyEnd | |
KeyInsert | |
KeyNumLock | |
KeyBegin | |
KeyDelete | |
KeyShiftL | |
KeyShiftR | |
KeyCtrlL | |
KeyCtrlR | |
KeyAltL | |
KeyAltR | |
KeyUnknown Int | You should actually never encounter this value, it is just here as a safeguard against future changes in the native GLUT library. |
Instances
Eq SpecialKey | |
Defined in Graphics.UI.GLUT.Callbacks.Window (==) :: SpecialKey -> SpecialKey -> Bool # (/=) :: SpecialKey -> SpecialKey -> Bool # | |
Ord SpecialKey | |
Defined in Graphics.UI.GLUT.Callbacks.Window compare :: SpecialKey -> SpecialKey -> Ordering # (<) :: SpecialKey -> SpecialKey -> Bool # (<=) :: SpecialKey -> SpecialKey -> Bool # (>) :: SpecialKey -> SpecialKey -> Bool # (>=) :: SpecialKey -> SpecialKey -> Bool # max :: SpecialKey -> SpecialKey -> SpecialKey # min :: SpecialKey -> SpecialKey -> SpecialKey # | |
Show SpecialKey | |
Defined in Graphics.UI.GLUT.Callbacks.Window showsPrec :: Int -> SpecialKey -> ShowS # show :: SpecialKey -> String # showList :: [SpecialKey] -> ShowS # |
data MouseButton #
Mouse buttons, including a wheel
Instances
Eq MouseButton | |
Defined in Graphics.UI.GLUT.Types (==) :: MouseButton -> MouseButton -> Bool # (/=) :: MouseButton -> MouseButton -> Bool # | |
Ord MouseButton | |
Defined in Graphics.UI.GLUT.Types compare :: MouseButton -> MouseButton -> Ordering # (<) :: MouseButton -> MouseButton -> Bool # (<=) :: MouseButton -> MouseButton -> Bool # (>) :: MouseButton -> MouseButton -> Bool # (>=) :: MouseButton -> MouseButton -> Bool # max :: MouseButton -> MouseButton -> MouseButton # min :: MouseButton -> MouseButton -> MouseButton # | |
Show MouseButton | |
Defined in Graphics.UI.GLUT.Types showsPrec :: Int -> MouseButton -> ShowS # show :: MouseButton -> String # showList :: [MouseButton] -> ShowS # |
The state of the keyboard modifiers
A 2-dimensional position, measured in pixels.
funInitInput :: [InputBinding t s u v] -> Game t s u v -> IO (KeyBinder, StillDownHandler) Source #
Initialise the input system, which keeps a list of input event to action bindings and executes the the proper actions automatically. Returns a function for adding bindings (GLUT's - should return the FunGEn-aware one instead ?), and another which should be called periodically (eg from refresh) to trigger still-down actions.
Timing
Timing control.
data RefreshType Source #
Used by funInit
to configure the main loop's timing strategy.
setRefresh :: RefreshType -> StillDownHandler -> IO () Source #
Change the current timing strategy.
Game
Game management and various game utilities.
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 - Top-level game attribute type,
- s - Sprite object attribute type,
- u - Updating game state type,
- v - Vicinity (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 IOGame t s u v a Source #
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).
Instances
Monad (IOGame t s u v) Source # | |
Functor (IOGame t s u v) Source # | |
MonadFail (IOGame t s u v) Source # | |
Defined in Graphics.UI.Fungen.Game | |
Applicative (IOGame t s u v) Source # | |
Defined in Graphics.UI.Fungen.Game pure :: a -> IOGame t s u v a # (<*>) :: IOGame t s u v (a -> b) -> IOGame t s u v a -> IOGame t s u v b # liftA2 :: (a -> b -> c) -> IOGame t s u v a -> IOGame t s u v b -> IOGame t s u v c # (*>) :: IOGame t s u v a -> IOGame t s u v b -> IOGame t s u v b # (<*) :: IOGame t s u v a -> IOGame t s u v b -> IOGame t s u v a # |
creating
createGame :: GameMap v -> [ObjectManager s] -> WindowConfig -> u -> t -> FilePictureList -> IO (Game t s u v) Source #
IO utilities
liftIOtoIOGame :: IO a -> IOGame t s u v a Source #
liftIOtoIOGame' :: (a -> IO ()) -> a -> IOGame t s u v () Source #
game state
getGameState :: IOGame t s u v u Source #
setGameState :: u -> IOGame t s u v () Source #
getGameAttribute :: IOGame t s u v t Source #
setGameAttribute :: t -> IOGame t s u v () Source #
game flags
getGameFlags :: IOGame t s u v GameFlags Source #
setGameFlags :: GameFlags -> IOGame t s u v () Source #
enableGameFlags :: IOGame t s u v () Source #
disableGameFlags :: IOGame t s u v () Source #
enableMapDrawing :: IOGame t s u v () Source #
disableMapDrawing :: IOGame t s u v () Source #
enableObjectsDrawing :: IOGame t s u v () Source #
disableObjectsDrawing :: IOGame t s u v () Source #
enableObjectsMoving :: IOGame t s u v () Source #
disableObjectsMoving :: IOGame t s u v () Source #
map operations
clearScreen :: GLclampf -> GLclampf -> GLclampf -> IOGame t s u v () Source #
paint the whole screen with a specified RGB color
getTileFromIndex :: (Int, Int) -> IOGame t s u v (Tile v) Source #
returns a mapTile, given its index (x,y) in the tile map
getTileFromWindowPosition :: (GLdouble, GLdouble) -> IOGame t s u v (Tile v) Source #
returns a mapTile, given its pixel position (x,y) in the screen
setCurrentMapIndex :: Int -> IOGame t s u v () Source #
set the current map for a MultiMap
object operations
getObjectManagers :: IOGame t s u v [ObjectManager s] Source #
setObjectManagers :: [ObjectManager s] -> IOGame t s u v () Source #
drawAllObjects :: IOGame t s u v () Source #
draws all visible objects
drawObject :: GameObject s -> IOGame t s u v () Source #
draw one object
moveAllObjects :: IOGame t s u v () Source #
changes objects position according to its speed
destroyObjects :: [GameObject s] -> IOGame t s u v () Source #
destroys objects from the game
destroyObject :: GameObject s -> IOGame t s u v () Source #
destroys an object from the game
getObjectsFromGroup :: String -> IOGame t s u v [GameObject s] Source #
returns the list of all objects from the group whose name is given
addObjectsToGroup :: [GameObject s] -> String -> IOGame t s u v () Source #
adds an object to a previously created group
addObjectsToNewGroup :: [GameObject s] -> String -> IOGame t s u v () Source #
adds an object to a new group
findObjectManager :: String -> IOGame t s u v (ObjectManager s) Source #
returns an object manager of the game, given its name (internal use)
findObject :: String -> String -> IOGame t s u v (GameObject s) Source #
returns an object of the game, given its name and is object manager name
getObjectName :: GameObject s -> IOGame t s u v String Source #
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.
getObjectGroupName :: GameObject s -> IOGame t s u v String Source #
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.
getObjectAsleep :: GameObject s -> IOGame t s u v Bool Source #
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.
getObjectSize :: GameObject s -> IOGame t s u v (GLdouble, GLdouble) Source #
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.
getObjectPosition :: GameObject s -> IOGame t s u v (GLdouble, GLdouble) Source #
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.
getObjectSpeed :: GameObject s -> IOGame t s u v (GLdouble, GLdouble) Source #
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.
getObjectAttribute :: GameObject s -> IOGame t s u v s Source #
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.
setObjectPosition :: (GLdouble, GLdouble) -> GameObject s -> IOGame t s u v () Source #
changes the position of an object, given its new position
setObjectAsleep :: Bool -> GameObject s -> IOGame t s u v () Source #
changes the sleeping status of an object, given its new status
setObjectSpeed :: (GLdouble, GLdouble) -> GameObject s -> IOGame t s u v () Source #
changes the speed of an object, given its new speed
setObjectCurrentPicture :: Int -> GameObject s -> IOGame t s u v () Source #
changes the current picture of a multitextured object
setObjectAttribute :: s -> GameObject s -> IOGame t s u v () Source #
changes the attribute of an object, given its new attribute
replaceObject :: GameObject s -> (GameObject s -> GameObject s) -> IOGame t s u v () Source #
replaces an object by a new one, given the old object and the function that must be applied to it.
reverseXSpeed :: GameObject s -> IOGame t s u v () Source #
reverseYSpeed :: GameObject s -> IOGame t s u v () Source #
collision detection
objectsCollision :: GameObject s -> GameObject s -> IOGame t s u v Bool Source #
checks the collision between two objects
objectsFutureCollision :: GameObject s -> GameObject s -> IOGame t s u v Bool Source #
checks the collision between two objects in the next game cicle
objectListObjectCollision :: [GameObject s] -> GameObject s -> IOGame t s u v Bool Source #
objectListObjectFutureCollision :: [GameObject s] -> GameObject s -> IOGame t s u v Bool Source #
objectTopMapCollision :: GameObject s -> IOGame t s u v Bool Source #
checks the collision between an object and the top of the map
objectBottomMapCollision :: GameObject s -> IOGame t s u v Bool Source #
checks the collision between an object and the bottom of the map
objectRightMapCollision :: GameObject s -> IOGame t s u v Bool Source #
checks the collision between an object and the right side of the map
objectLeftMapCollision :: GameObject s -> IOGame t s u v Bool Source #
checks the collision between an object and the left side of the map
pointsObjectCollision :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> GameObject s -> IOGame t s u v Bool Source #
pointsObjectListCollision :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> [GameObject s] -> IOGame t s u v Bool Source #
objectTopMapFutureCollision :: GameObject s -> IOGame t s u v Bool Source #
checks the collision between an object and the top of the map in the next game cicle
objectBottomMapFutureCollision :: GameObject s -> IOGame t s u v Bool Source #
checks the collision between an object and the bottom of the map in the next game cicle
objectRightMapFutureCollision :: GameObject s -> IOGame t s u v Bool Source #
checks the collision between an object and the right side of the map in the next game cicle
objectLeftMapFutureCollision :: GameObject s -> IOGame t s u v Bool Source #
checks the collision between an object and the left side of the map in the next game cicle
text operations
printOnPrompt :: Show a => a -> IOGame t s u v () Source #
prints a string in the prompt
printOnScreen :: String -> BitmapFont -> (GLdouble, GLdouble) -> GLclampf -> GLclampf -> GLclampf -> IOGame t s u v () Source #
prints a string in the current window
random numbers
utilities
showFPS :: BitmapFont -> (GLdouble, GLdouble) -> GLclampf -> GLclampf -> GLclampf -> IOGame t s u v () Source #
shows the frame rate (or frame per seconds)
wait :: Int -> IOGame t s u v () Source #
delay for N seconds while continuing essential game functions
Display
Rendering the game window.
display :: Game t s u v -> IOGame t s u v () -> DisplayCallback Source #
Given a fungen Game and IOGame step action, generate a GLUT
display callback that steps the game and renders its resulting
state. funInit
runs this automatically.
Util
Miscellaneous utilities.
texStuff :: [TextureObject] -> [AwbfBitmap] -> IO () Source #
dropGLsizei :: GLsizei -> [a] -> [a] Source #
addNoInvisibility :: [FilePath] -> [(FilePath, Maybe ColorList3)] Source #
to be used when no invisibility must be added when loading a file
matrixToList :: [[a]] -> [a] Source #
matrixSize :: [[a]] -> (Int, Int) Source #
return the max indexes of a matrix (assumed that its lines have the same length)
inv2color3 :: InvList -> Maybe ColorList3 Source #
pathAndInv2color3List :: (FilePath, InvList) -> (FilePath, Maybe ColorList3) Source #
bindTexture :: TextureTarget2D -> TextureObject -> IO () Source #