{-# OPTIONS_HADDOCK hide #-}
{- | 
This FunGEn module contains some functions to print text on the screen.
Fonts supported: Bitmap9By15, Bitmap8By13, BitmapTimesRoman10, BitmapTimesRoman24
BitmapHelvetica10, BitmapHelvetica12, BitmapHelvetica18
-}
{- 

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.Text (
        BitmapFont(..),
        Text,
        putGameText
) where

import Graphics.UI.GLUT
import Graphics.UI.Fungen.Types

-- | String to be printed, font, screen position, color RGB.
type Text = (String,BitmapFont,Point2D,GLclampf,GLclampf,GLclampf)

-- | Display these texts on screen.
putGameText :: [Text] -> IO ()
putGameText :: [Text] -> IO ()
putGameText [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
putGameText ((String
text,BitmapFont
font,(GLdouble
x,GLdouble
y),GLclampf
r,GLclampf
g,GLclampf
b):[Text]
ts) = do
        IO ()
loadIdentity
        forall a. Color a => a -> IO ()
color (forall a. a -> a -> a -> Color3 a
Color3 GLclampf
r GLclampf
g GLclampf
b)
        forall a. RasterPos a => a -> IO ()
rasterPos (forall a. a -> a -> Vertex2 a
Vertex2 GLdouble
x GLdouble
y)
        forall a (m :: * -> *). (Font a, MonadIO m) => a -> String -> m ()
renderString BitmapFont
font String
text
        [Text] -> IO ()
putGameText [Text]
ts