FunGEn-0.4.2: FUNctional Game ENgine

Safe HaskellNone

Graphics.UI.Fungen

Contents

Description

This is the main module of FunGEN (Functional Game Engine), which re-exports the rest.

Synopsis

Execution

Starting and stopping a game.

funInitSource

Arguments

:: WindowConfig

main window config

-> GameMap v

background tile map

-> [ObjectManager s]

object (sprite) groups

-> u

initial game state

-> t

initial game attribute

-> [InputBinding t s u v]

input bindings

-> IOGame t s u v ()

step action

-> RefreshType

timing type

-> FilePictureList

image files to load

-> IO () 

Build a FunGEn game and start it running.

funExit :: IOGame t s u v ()Source

Exit the program successfully (from within a game action).

Types

Some basic types.

type WindowConfig = ((Int, Int), (Int, Int), String)Source

position, size and name of the window

type Point2D = (GLdouble, GLdouble)Source

a bidimensional point in space

type ColorList3 = [(GLubyte, GLubyte, GLubyte)]Source

color in RGB format

type AwbfBitmap = (GLsizei, GLsizei, PixelData GLubyte)Source

width, height and data of bitmap

type InvList = Maybe [(Int, Int, Int)]Source

invisible colors (in RGB) of bitmap

Images

Loading BMP image files.

loadBitmap :: FilePath -> Maybe ColorList3 -> IO AwbfBitmapSource

Loads a bitmap from a file.

loadBitmapList :: [(FilePath, Maybe ColorList3)] -> IO [AwbfBitmap]Source

Loads n bitmaps from n files.

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.

Constructors

Fixed8By13

A fixed width font with every character fitting in an 8 by 13 pixel rectangle. (-misc-fixed-medium-r-normal--13-120-75-75-C-80-iso8859-1)

Fixed9By15

A fixed width font with every character fitting in an 9 by 15 pixel rectangle. (-misc-fixed-medium-r-normal--15-140-75-75-C-90-iso8859-1)

TimesRoman10

A 10-point proportional spaced Times Roman font. (-adobe-times-medium-r-normal--10-100-75-75-p-54-iso8859-1)

TimesRoman24

A 24-point proportional spaced Times Roman font. (-adobe-times-medium-r-normal--24-240-75-75-p-124-iso8859-1)

Helvetica10

A 10-point proportional spaced Helvetica font. (-adobe-helvetica-medium-r-normal--10-100-75-75-p-56-iso8859-1)

Helvetica12

A 12-point proportional spaced Helvetica font. (-adobe-helvetica-medium-r-normal--12-120-75-75-p-67-iso8859-1)

Helvetica18

A 18-point proportional spaced Helvetica font. (-adobe-helvetica-medium-r-normal--18-180-75-75-p-98-iso8859-1)

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.

Tile Maps

Tile maps (backgrounds).

type Tile t = (Int, Bool, Float, t)Source

type TileMatrix t = [[Tile t]]Source

creating

colorMap :: GLclampf -> GLclampf -> GLclampf -> GLdouble -> GLdouble -> GameMap tSource

creates a PreColorMap

textureMap :: Int -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GameMap tSource

creates a PreTextureMap

tileMap :: TileMatrix t -> GLdouble -> GLdouble -> GameMap tSource

creates a PreTileMap, cheking if the tileMatrix given is valid and automatically defining the map size

multiMap :: [GameMap t] -> Int -> GameMap tSource

creates a multimap

map attributes

map tiles

setting the current map

drawing

drawGameMap :: GameMap t -> Point2D -> [TextureObject] -> IO ()Source

draw the background map

clearGameScreen :: GLclampf -> GLclampf -> GLclampf -> IO ()Source

clear the screen

Objects

Game objects (sprites).

data FillMode Source

Constructors

Filled 
Unfilled 

Instances

creating

object attributes

updating

drawing

moving

destroying

groups of objects

searching

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 KeyEvent Source

Constructors

Press 
StillDown 
Release 

Instances

data Key

A generalized view of keys

Instances

data MouseButton

Mouse buttons, including a wheel

data Modifiers

The state of the keyboard modifiers

Constructors

Modifiers 

Fields

shift :: KeyState
 
ctrl :: KeyState
 
alt :: KeyState
 

data Position

A 2-dimensional position, measured in pixels.

Constructors

Position !GLint !GLint 

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.

Constructors

Idle 
Timer Int 

setRefresh :: RefreshType -> StillDownHandler -> IO ()Source

Change the current timing strategy.

Game

Game management and various game utilities.

data Game t s u v Source

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) 

creating

createGame :: GameMap v -> [ObjectManager s] -> WindowConfig -> u -> t -> FilePictureList -> IO (Game t s u v)Source

IO utilities

runIOGame :: IOGame t s u v a -> Game t s u v -> IO (Game t s u v, a)Source

runIOGameM :: IOGame t s u v a -> Game t s u v -> IO ()Source

liftIOtoIOGame :: IO a -> IOGame t s u v aSource

liftIOtoIOGame' :: (a -> IO ()) -> a -> IOGame t s u v ()Source

game state

setGameState :: u -> IOGame t s u v ()Source

setGameAttribute :: t -> IOGame t s u v ()Source

game flags

getGameFlags :: IOGame t s u v GameFlagsSource

setGameFlags :: GameFlags -> IOGame t s u v ()Source

map operations

drawMap :: IOGame t s u v ()Source

draws the background map

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

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 StringSource

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 StringSource

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 BoolSource

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 sSource

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.

collision detection

objectsCollision :: GameObject s -> GameObject s -> IOGame t s u v BoolSource

checks the collision between two objects

objectsFutureCollision :: GameObject s -> GameObject s -> IOGame t s u v BoolSource

checks the collision between two objects in the next game cicle

objectTopMapCollision :: GameObject s -> IOGame t s u v BoolSource

checks the collision between an object and the top of the map

objectBottomMapCollision :: GameObject s -> IOGame t s u v BoolSource

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

objectRightMapCollision :: GameObject s -> IOGame t s u v BoolSource

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

objectLeftMapCollision :: GameObject s -> IOGame t s u v BoolSource

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

objectTopMapFutureCollision :: GameObject s -> IOGame t s u v BoolSource

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 BoolSource

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 BoolSource

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 BoolSource

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

printText :: IOGame t s u v ()Source

internal use of the engine

random numbers

randomInt :: (Int, Int) -> IOGame t s u v IntSource

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 () -> DisplayCallbackSource

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.

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)

when :: Monad m => Bool -> m () -> m ()Source

unless :: Monad m => Bool -> m () -> m ()Source