{-# OPTIONS_HADDOCK hide #-}
{- | 
This FunGEn module contains the initialization 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.Init (
        funInit
        ,funExit
)where

import Graphics.UI.Fungen.Types
import Graphics.UI.Fungen.Loader(FilePictureList)
import Graphics.UI.Fungen.Display
import Graphics.UI.Fungen.Input
import Graphics.UI.Fungen.Map
import Graphics.UI.Fungen.Objects
import Graphics.UI.Fungen.Game
import Graphics.UI.Fungen.Timer
import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT
import System.Exit

-- | Configure a FunGEn game and start it running.
funInit :: 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 ()
funInit :: forall v s u t.
WindowConfig
-> GameMap v
-> [ObjectManager s]
-> u
-> t
-> [InputBinding t s u v]
-> IOGame t s u v ()
-> RefreshType
-> FilePictureList
-> IO ()
funInit winConfig :: WindowConfig
winConfig@((Int
px,Int
py),(Int
sx,Int
sy),String
t) GameMap v
userMap [ObjectManager s]
objectGroups u
gState t
gAttrib [InputBinding t s u v]
i IOGame t s u v ()
gameCicle RefreshType
r FilePictureList
picList = do
        forall (m :: * -> *). MonadIO m => String -> [String] -> m [String]
initialize String
"FunGen app" []
        forall (m :: * -> *). MonadIO m => String -> m Window
createWindow String
t -- (return ()) [ Double, RGBA ]
        StateVar Position
windowPosition forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= GLsizei -> GLsizei -> Position
Position (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
px) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
py)
        StateVar Size
windowSize     forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= GLsizei -> GLsizei -> Size
Size     (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sx) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sy)
        Int -> Int -> IO ()
basicInit Int
sx Int
sy
        Game t s u v
game <- forall v s u t.
GameMap v
-> [ObjectManager s]
-> WindowConfig
-> u
-> t
-> FilePictureList
-> IO (Game t s u v)
createGame GameMap v
userMap [ObjectManager s]
objectGroups WindowConfig
winConfig u
gState t
gAttrib FilePictureList
picList
        (KeyBinder
_bindKey, IO ()
stillDown) <- forall t s u v.
[InputBinding t s u v] -> Game t s u v -> IO (KeyBinder, IO ())
funInitInput [InputBinding t s u v]
i Game t s u v
game
        SettableStateVar (IO ())
displayCallback forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= (forall t s u v. Game t s u v -> IOGame t s u v () -> IO ()
display Game t s u v
game IOGame t s u v ()
gameCicle)
        RefreshType -> IO () -> IO ()
setRefresh RefreshType
r IO ()
stillDown
        forall (m :: * -> *). MonadIO m => m ()
mainLoop
        
basicInit :: Int -> Int -> IO ()
basicInit :: Int -> Int -> IO ()
basicInit Int
sx Int
sy = do
        StateVar (Color4 GLfloat)
clearColor forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= (forall a. a -> a -> a -> a -> Color4 a
Color4 GLfloat
0 GLfloat
0 GLfloat
0 GLfloat
0)
        [ClearBuffer] -> IO ()
clear [ClearBuffer
ColorBuffer]
        StateVar Capability
blend forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Capability
Enabled
        StateVar (BlendingFactor, BlendingFactor)
blendFunc forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= (BlendingFactor
SrcAlpha, BlendingFactor
OneMinusSrcAlpha)
        HintTarget -> StateVar HintMode
hint HintTarget
PerspectiveCorrection forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= HintMode
Nicest
        StateVar MatrixMode
matrixMode forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= MatrixMode
Projection
        IO ()
loadIdentity
        GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> IO ()
ortho GLdouble
0.0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sx) GLdouble
0.0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sy) (-GLdouble
1.0) GLdouble
1.0
        StateVar MatrixMode
matrixMode forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= GLsizei -> MatrixMode
Modelview GLsizei
0
        IO ()
loadIdentity

-- | Exit the program successfully (from within a game action).
funExit :: IOGame t s u v ()
funExit :: forall t s u v. IOGame t s u v ()
funExit = forall a t s u v. (a -> IO ()) -> a -> IOGame t s u v ()
liftIOtoIOGame' forall a. ExitCode -> IO a
exitWith ExitCode
ExitSuccess