Gamgine (empty) → 0.2

raw patch · 49 files changed

+2919/−0 lines, 49 filesdep +GLFW-bdep +ListZipperdep +OpenGLRawsetup-changedbinary-added

Dependencies added: GLFW-b, ListZipper, OpenGLRaw, StateVar, Vec, array, base, bytestring, composition, cpphs, data-lens, directory, filepath, mtl, parsec, pretty-show, time, unordered-containers, utility-ht, zlib

Files

• Gamgine.cabal +86/−0
• Gamgine/Bool.hs +18/−0
• Gamgine/Control.hs +29/−0
• Gamgine/Coroutine.hs +10/−0
• Gamgine/Engine.hs +23/−0
• Gamgine/Font/GLF.hs +93/−0
• Gamgine/Gfx.hs +220/−0
• Gamgine/Image/PNG.hs +243/−0
• Gamgine/Image/PNG/Internal/CRC.hs +29/−0
• Gamgine/Image/PNG/Internal/Filters.hs +98/−0
• Gamgine/Image/PNG/Internal/Parser.hs +74/−0
• Gamgine/Lens/IORef.hs +75/−0
• Gamgine/Lens/State.hs +20/−0
• Gamgine/Math/Box.hs +91/−0
• Gamgine/Math/BoxTree.hs +52/−0
• Gamgine/Math/Matrix.hs +95/−0
• Gamgine/Math/Utils.hs +29/−0
• Gamgine/Math/Vect.hs +69/−0
• Gamgine/State/InputInfo.hs +26/−0
• Gamgine/State/KeyInfo.hs +17/−0
• Gamgine/State/MouseInfo.hs +17/−0
• Gamgine/State/RenderState.hs +41/−0
• Gamgine/State/State.hs +33/−0
• Gamgine/State/StateTree.hs +55/−0
• Gamgine/State/StateTreeZipper.hs +109/−0
• Gamgine/System.hs +40/−0
• Gamgine/Utils.cpp +29/−0
• Gamgine/Utils.hs +71/−0
• Gamgine/Zipper.hs +43/−0
• LICENSE +24/−0
• Ressources/Fonts/aksent1.glf binary
• Ressources/Fonts/alpine1.glf binary
• Ressources/Fonts/arial1.glf binary
• Ressources/Fonts/broadway1.glf binary
• Ressources/Fonts/chicago1.glf binary
• Ressources/Fonts/compact1.glf binary
• Ressources/Fonts/courier1.glf binary
• Ressources/Fonts/cricket1.glf binary
• Ressources/Fonts/crystal1.glf binary
• Ressources/Fonts/garamond1.glf binary
• Ressources/Fonts/gothic1.glf binary
• Ressources/Fonts/penta1.glf binary
• Ressources/Fonts/present_script1.glf binary
• Ressources/Fonts/techno0.glf binary
• Ressources/Fonts/techno1.glf binary
• Ressources/Fonts/times_new1.glf binary
• Setup.hs +2/−0
• c_libraries/glf/glf.c +944/−0
• c_libraries/glf/glf.h +114/−0

@@ -0,0 +1,86 @@+name: Gamgine+version: 0.2+cabal-version: >=1.6+build-type: Simple+license: BSD3+license-file: LICENSE+maintainer: daniel.trstenjak@gmail.com+synopsis: Some kind of game library or set of utilities.+description:+    Some kind of game library or set of utilities, which are mostly/certainly only usable for my own toy projects.+category: Library+author: Daniel Trstenjak+data-files:+    Ressources/Fonts/*.glf+extra-source-files:+    c_libraries/glf/glf.h+    c_libraries/glf/glf.c+    Gamgine/Utils.cpp+ +source-repository head+    type: git+    location: https://github.com/dan-t/Gamgine+ +library+    build-depends:+        base >3 && <5,+        GLFW-b >=0.1.0.5 && <0.2,+        OpenGLRaw >=1.4.0.0 && <1.5,+        mtl >=2.1.3.1 && <2.2,+        time >=1.4.0.1 && <1.5,+        Vec >=1.0.1 && <1.1,+        utility-ht >=0.0.10 && <0.1,+        directory >=1.2.0.1 && <1.3,+        StateVar >=1.0.0.0 && <1.1,+        array >=0.4.0.1 && <0.5,+        bytestring >=0.10.0.2 && <0.11,+        unordered-containers >=0.2.4.0 && <0.3,+        data-lens >=2.10.4 && <2.11,+        pretty-show >=1.6.7 && <1.7,+        cpphs >=1.18.4 && <1.19,+        filepath >=1.3.0.1 && <1.4,+        parsec >=3.1.5 && <3.2,+        zlib >=0.5.4.1 && <0.6,+        ListZipper >=1.2.0.2 && <1.3,+        composition >=1.0.1.0 && <1.1+    exposed-modules:+        Gamgine.Coroutine+        Gamgine.Bool+        Gamgine.Math.Matrix+        Gamgine.Math.Utils+        Gamgine.Math.BoxTree+        Gamgine.Math.Vect+        Gamgine.Math.Box+        Gamgine.State.RenderState+        Gamgine.State.StateTreeZipper+        Gamgine.State.MouseInfo+        Gamgine.State.KeyInfo+        Gamgine.State.State+        Gamgine.State.StateTree+        Gamgine.State.InputInfo+        Gamgine.Font.GLF+        Gamgine.Control+        Gamgine.Utils+        Gamgine.Gfx+        Gamgine.Engine+        Gamgine.Image.PNG.Internal.Filters+        Gamgine.Image.PNG.Internal.Parser+        Gamgine.Image.PNG.Internal.CRC+        Gamgine.Image.PNG+        Gamgine.System+        Gamgine.Zipper+        Gamgine.Lens.IORef+        Gamgine.Lens.State+    exposed: True+    buildable: True+    cpp-options: -DCABAL+    cc-options: -Wno-unused-result+    c-sources:+        c_libraries/glf/glf.c+    extensions: CPP+    includes:+        glf.h+    include-dirs: . Gamgine c_libraries/glf+    ghc-options: -pgmPcpphs -optP--cpp+ + 

@@ -0,0 +1,18 @@++module Gamgine.Bool where++(<&&>) :: Monad m => m Bool -> m Bool -> m Bool+(<&&>) m1 m2 = do+   r1 <- m1+   if r1 then m2 else return False+++(<||>) :: Monad m => m Bool -> m Bool -> m Bool+(<||>) m1 m2 = do+   r1 <- m1+   if r1 then return True else m2++infixr 3 <&&>+infixr 2 <||>++

@@ -0,0 +1,29 @@++module Gamgine.Control where+import Data.Bool.HT (if')++whenM :: Monad m => m Bool -> m () -> m ()+whenM p m = do+   r <- p+   if r then m else return ()+++-- | if a is just than apply f, otherwise 'return ()'+ifJust :: Monad m => Maybe a -> (a -> m ()) -> m ()+ifJust (Just a) f = f a+ifJust _        _ = return ()++-- | apply f on a if p is true, otherwise just return a+applyIf :: (a -> Bool) -> (a -> a) -> a -> a+applyIf p f a | p a       = f a+              | otherwise = a++-- | apply f on a if p is true, otherwise 'return ()'+applyIfM :: Monad m => (a -> Bool) -> (a -> m ()) -> a -> m ()+applyIfM p f a | p a       = f a+               | otherwise = return ()+++(?) :: Bool -> a -> a -> a+(?) = if'+infixl 1 ?

@@ -0,0 +1,10 @@++module Gamgine.Coroutine where++newtype Coroutine i o = Coroutine {+   runCoroutine :: i -> (o, Coroutine i o)+   }++newtype CoroutineM m i o = CoroutineM {+   runCoroutineM :: i -> m (o, CoroutineM m i o)+   }

@@ -0,0 +1,23 @@++module Gamgine.Engine where+import Graphics.UI.GLFW (getTime)+import Control.Monad.State (MonadIO, liftIO)+++mkUpdateLoop :: (MonadIO m) => Int -> Int -> m a -> (Double -> m (Double, Double))+mkUpdateLoop ticksPerSecond maxFrameSkip update = \nextFrame -> loop nextFrame 0+   where+      loop nextFrame skippedFrames = do+	 time <- liftIO getTime+	 if time > nextFrame && skippedFrames < maxFrameSkip+	    then do+	       update+	       loop (nextFrame + skipTicks) (skippedFrames + 1)+	    else do+	       let interpol = interpolation time nextFrame skipTicks+	       return (nextFrame, interpol)++      interpolation time nextFrame skipTicks =+	 (time - skipTicks - nextFrame) / skipTicks++      skipTicks = 1 / (fromIntegral ticksPerSecond :: Double)

@@ -0,0 +1,93 @@+{-# LANGUAGE ForeignFunctionInterface #-}++module Gamgine.Font.GLF where+import Foreign+import Foreign.C.Types+import Foreign.C.String+import Foreign.Marshal.Alloc+import Control.Applicative ((<$>))+++init :: IO ()+init = c_glfInit+++newtype FontId = FontId Int deriving (Eq, Show)++loadFont :: FilePath -> IO FontId+loadFont s = do+   withCString s $ \cs -> do+      ci <- c_glfLoadFont cs+      return . FontId . fromIntegral $ ci+++setCurrentFont :: FontId -> IO Bool+setCurrentFont (FontId id) = do+   ci <- c_glfSetCurrentFont $ fromIntegral id+   return $ glfOk == (fromIntegral ci)+++type X = Double+type Y = Double++data Bounds = Bounds {+   min :: (X, Y),+   max :: (X, Y)+   } deriving Show++getStringBounds :: String -> IO Bounds+getStringBounds s = do+   withCString s $ \cs ->+      alloca $ \cminX ->+      alloca $ \cminY ->+      alloca $ \cmaxX ->+      alloca $ \cmaxY -> do+         c_glfGetStringBounds cs cminX cminY cmaxX cmaxY+         minX <- peekToFrac cminX+         minY <- peekToFrac cminY+         maxX <- peekToFrac cmaxX+         maxY <- peekToFrac cmaxY+         return $ Bounds (minX, minY) (maxX, maxY)+   where+      peekToFrac = (realToFrac <$>) . peek+++drawWiredString :: String -> IO ()+drawWiredString s = withCString s c_glfDrawWiredString+++drawSolidString :: String -> IO ()+drawSolidString s = withCString s c_glfDrawSolidString++++glfError :: Int+glfError = -1++glfOk :: Int+glfOk = 0++glfYes :: Int+glfYes = 1++glfNo :: Int+glfNo = 2+++foreign import ccall unsafe "glf.h glfInit"+   c_glfInit :: IO ()++foreign import ccall unsafe "glf.h glfLoadFont"+   c_glfLoadFont :: CString -> IO CInt++foreign import ccall unsafe "glf.h glfSetCurrentFont"+   c_glfSetCurrentFont :: CInt -> IO CInt++foreign import ccall unsafe "glf.h glfGetStringBounds"+   c_glfGetStringBounds :: CString -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO ()++foreign import ccall unsafe "glf.h glfDrawWiredString"+   c_glfDrawWiredString :: CString -> IO ()++foreign import ccall unsafe "glf.h glfDrawSolidString"+   c_glfDrawSolidString :: CString -> IO ()

@@ -0,0 +1,220 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}++module Gamgine.Gfx where+import Graphics.Rendering.OpenGL.Raw+import Control.Monad (forM_)+import Data.Either+import Foreign.Marshal.Utils+import Foreign.Storable+import Data.Array.Storable+import System.IO+import Gamgine.Image.PNG+import qualified Gamgine.Math.Box as B+import Gamgine.Math.Vect+import Gamgine.Math.BoxTree as BT+import Gamgine.Control ((?))+#include "Gamgine/Utils.cpp"++type XY   = (Double, Double)+type XYZ  = (Double, Double, Double)+type XYZW = (Double, Double, Double, Double)+type RGB  = (Double, Double, Double)+type RGBA = (Double, Double, Double, Double)++xy :: Double -> Double -> XY+xy x y = (x, y)++xyz :: Double -> Double -> Double -> XYZ+xyz x y z = (x, y, z)++xyzw :: Double -> Double -> Double -> Double -> XYZW+xyzw x y z w = (x, y, z, w)++rgb :: Double -> Double -> Double -> RGB+rgb r g b = (r, g, b)++rgba :: Double -> Double -> Double -> Double -> RGBA+rgba r g b a = (r, g, b, a)+++floatToFloat :: (RealFloat a, RealFloat b) => a -> b+floatToFloat = (uncurry encodeFloat) . decodeFloat+++class Tuple4d a where+   t4d_first  :: a -> Double+   t4d_second :: a -> Double+   t4d_third  :: a -> Double+   t4d_forth  :: a -> Double++instance Tuple4d (Double, Double, Double, Double) where+   t4d_first  (f, _, _, _) = f+   t4d_second (_, s, _, _) = s+   t4d_third  (_, _, t, _) = t+   t4d_forth  (_, _, _, f) = f++instance Tuple4d (Vec4 Double) where+   t4d_first  (f:._)           = f+   t4d_second (_:.s:._)        = s+   t4d_third  (_:._:.t:._)     = t+   t4d_forth  (_:._:._:.f:.()) = f+++class Tuple3d a where+   t3d_first  :: a -> Double+   t3d_second :: a -> Double+   t3d_third  :: a -> Double++instance Tuple3d (Double, Double, Double) where+   t3d_first  (f, _, _) = f+   t3d_second (_, s, _) = s+   t3d_third  (_, _, t) = t++instance Tuple3d (Vec3 Double) where+   t3d_first  (f:._)        = f+   t3d_second (_:.s:._)     = s+   t3d_third  (_:._:.t:.()) = t+++class Tuple2d a where+   t2d_first  :: a -> Double+   t2d_second :: a -> Double++instance Tuple2d (Double, Double) where+   t2d_first  (f, _) = f+   t2d_second (_, s) = s++instance Tuple2d (Vec2 Double) where+   t2d_first  (f:._)     = f+   t2d_second (_:.s:.()) = s+++(<<) :: Tuple2d a => (GLfloat -> GLfloat -> IO ()) -> a -> IO ()+f << a = f (floatToFloat $ t2d_first a)+           (floatToFloat $ t2d_second a)+infixl 5 <<+++(<<<) :: Tuple3d a => (GLfloat -> GLfloat -> GLfloat -> IO ()) -> a -> IO ()+f <<< a = f (floatToFloat $ t3d_first a)+            (floatToFloat $ t3d_second a)+            (floatToFloat $ t3d_third a)+infixl 5 <<<+++(<<<<) :: Tuple4d a => (GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()) -> a -> IO ()+f <<<< a = f (floatToFloat $ t4d_first a)+             (floatToFloat $ t4d_second a)+             (floatToFloat $ t4d_third a)+             (floatToFloat $ t4d_forth a)+infixl 5 <<<<+++quad :: (Double,Double) -> (Double,Double) -> [(Double,Double)]+quad (minx, miny) (maxx, maxy) =+   [(minx,miny), (maxx,miny), (maxx, maxy), (minx, maxy)]++quadTexCoords :: Double -> Double -> [(Double,Double)]+quadTexCoords maxx maxy = [(0,maxy), (maxx,maxy), (maxx,0), (0,0)]++draw :: Tuple3d a => GLenum -> [a] -> IO ()+draw primType vertices = withPrimitive primType $ mapM_ (glVertex3f <<<) vertices++drawBox :: B.Box -> IO ()+drawBox box = do+   drawQuad (B.minPt box) (B.maxPt box)++drawQuad :: Tuple3d a => a -> a -> IO ()+drawQuad min max = do+   draw gl_QUADS [(minX, minY, 0 :: Double), (maxX, minY, 0 :: Double),+                  (maxX, maxY, 0 :: Double), (minX, maxY, 0 :: Double)]+   where+      minX = t3d_first min+      minY = t3d_second min+      maxX = t3d_first max+      maxY = t3d_second max+++drawBoxTree :: BT.BoxTree a -> IO ()+drawBoxTree tree = do+   go tree+   where+      go (Node box ts) = drawBox box >> mapM_ (\t -> go t) ts+      go (Leaf box _)  = drawBox box++drawPoint :: Tuple3d a => a -> RGB -> IO ()+drawPoint pos color = do+   glPointSize 10+   glBegin gl_POINTS+   glVertex3f <<< pos+   glEnd++withPrimitive :: GLenum -> IO () -> IO ()+withPrimitive primType act = do+   glBegin primType+   act+   glEnd++withPushedMatrix :: IO a -> IO a+withPushedMatrix act = do+   glPushMatrix+   a <- act+   glPopMatrix+   return a++withPolyMode :: GLenum -> IO () -> IO ()+withPolyMode mode act = do+   glPolygonMode gl_FRONT_AND_BACK mode+   act+   glPolygonMode gl_FRONT_AND_BACK gl_FILL++withEnabled :: GLenum -> IO () -> IO ()+withEnabled mode act = do+   glEnable mode+   act+   glDisable mode++withBlend :: GLenum -> GLenum -> IO () -> IO ()+withBlend srcFactor dstFactor act = do+   glBlendFunc srcFactor dstFactor+   withEnabled gl_BLEND act++withTexture2d :: GLuint -> IO () -> IO ()+withTexture2d id act = do+   glBindTexture gl_TEXTURE_2D id+   withEnabled gl_TEXTURE_2D act++makeTexture2d :: FilePath -> GLenum -> IO GLuint+makeTexture2d file wrapMode = do+   res <- loadPNGFile file+   either (\str -> ERROR str)+          (\img -> genTex img)+	  res+   where+      genTex img = do+	 let (width, height) = dimensions img+             imgData         = imageData img+	     format          = hasAlphaChannel img ? gl_RGBA $ gl_RGB+	 id <- with 0 (\buf -> glGenTextures 1 buf >> peek buf)+	 glBindTexture gl_TEXTURE_2D id+	 glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_S (fromIntegral wrapMode)+	 glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_T (fromIntegral wrapMode)+	 glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER (fromIntegral gl_NEAREST)+	 glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER (fromIntegral gl_NEAREST)+	 withStorableArray imgData (\array ->+	    glTexImage2D gl_TEXTURE_2D 0 (fromIntegral format) (fromIntegral width)+	                 (fromIntegral height) 0 (fromIntegral format) gl_UNSIGNED_BYTE array)+	 return id+++renderTexturedQuad :: (Double,Double) -> GLuint -> IO ()+renderTexturedQuad size texture =+   withTexture2d texture $+      withBlend gl_SRC_ALPHA gl_ONE_MINUS_SRC_ALPHA $+         withPrimitive gl_QUADS $ do+            let coords   = quadTexCoords 1 1+                vertices = quad (0,0) size+            glColor3f <<< ((1, 1, 1) :: RGB)+            forM_ (zip coords vertices) (\(c,v) -> do+               glTexCoord2f << c+               glVertex2f << v)

@@ -0,0 +1,243 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Formats.PNG+-- Copyright   :  (c) Marko Lauronen 2008+-- License     :  BSD+-- +-- Maintainer  :  marko.lauronen@pp1.inet.fi+-- Stability   :  experimental+-- Portability :  non-portable (GHC only)+--+-- A simple, pure Haskell PNG loader. Currently supports 24bit RGB(A) images+-- with no interlacing. Also lacks support for color indexed (paletted) images.+--+-- The image is stored in a StorableArray for compatibility with OpenGL (the+-- array supports getting Ptr Word8 to the image data using withStorableArray+-- function).+--+-----------------------------------------------------------------------------+module Gamgine.Image.PNG+    (+     -- * Types+      PNGImage, Width, Height+     -- * Functions+    , loadPNGFile+    , dimensions+    --, pixelWidth+    , imageData+    , hasAlphaChannel+    ) where++import Codec.Compression.Zlib++import Text.Parsec.Combinator+import Text.Parsec.Prim++import Data.Array.Unboxed+import Data.Array.Storable+import Data.Word+import Data.List+import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString.Lazy.Char8 as C+import Data.Int+import Data.Char+import System.IO++import Control.Monad.Error++import Gamgine.Image.PNG.Internal.Parser+import Gamgine.Image.PNG.Internal.CRC+import Gamgine.Image.PNG.Internal.Filters++-- | Type for raw PNG chunks+-- The parsing happens in two phases: first the file is read into+-- raw chunks, then the raw chunks are parsed into actual PNGChunks+-- This is due to the CRC checksum that requires is easiest to compute+-- with raw chunk data.+data RawPNGChunk = RawPNGChunk {+      rawPngChunk_type  :: !String,+      rawPngChunk_data  :: !LB.ByteString+    } deriving (Show)++type Width  = Word32+type Height = Word32+type Rgb = (Word8, Word8, Word8)++-- | The actual fully parsed chunk type+data PNGChunk =+    IHDR {+      ihdr_width             :: !Width+    , ihdr_height            :: !Height+    , ihdr_bitDepth          :: !BitDepth+    , ihdr_colorType         :: !ColorType+    , ihdr_compressionMethod :: !CompressionMethod+    , ihdr_filterMethod      :: !FilterMethod+    , ihdr_interlaceMethod   :: !InterlaceMethod }+  | PLTE {+      plte_entries :: !(Array Word8 Rgb) }+  | IDAT {+      idat_data :: !LB.ByteString }+  | UnknownChunk RawPNGChunk    -- chunk types not supported yet+  | IEND+    deriving (Show)++data ColorType         = Ct0 | Ct2 | Ct3 | Ct4 | Ct6 deriving (Show,Eq)+data BitDepth          = Bd1 | Bd2 | Bd4 | Bd8 | Bd16 deriving (Show,Eq)+data CompressionMethod = Deflate deriving (Show,Eq)+data FilterMethod      = Adaptive deriving (Show,Eq)+data InterlaceMethod   = NoInterlace | Adam7 deriving (Show,Eq)++isIDAT :: PNGChunk -> Bool+isIDAT (IDAT _) = True+isIDAT _        = False++data PNGImage = PNGImage {+      pngImg_header  :: !PNGChunk+    , pngImg_otherChunks :: ![PNGChunk]+    , pngImg_imageData :: !(StorableArray (Int,Int) Word8)+    }++instance Show PNGImage where+    show _ = "PNGImage"++-- | Raw chunk parsing++pngHeaderBytes :: LB.ByteString+pngHeaderBytes = LB.pack [137, 80, 78, 71, 13, 10, 26, 10]++pngFile :: Parser [RawPNGChunk]+pngFile = do+  string pngHeaderBytes+  hdr <- rawPngChunk+  when (rawPngChunk_type hdr /= "IHDR") $+       fail "expecting IHDR as the first chunk"+  rest <- many1 rawPngChunk+  return (hdr:rest)++rawPngChunk :: Parser RawPNGChunk+rawPngChunk = do+  len <- anyWord32+  chunkType <- block 4+  chunkData <- block (fromIntegral len)+  let expectedCrc = crc (LB.concat [chunkType,chunkData])+  word32 expectedCrc <?> "valid crc"+  return $ RawPNGChunk (C.unpack chunkType) chunkData++-- | Final chunk parsing++parsePlte :: Parser PNGChunk+parsePlte = do+  paletteEntries <- many1 paletteEntry+  return . PLTE $ listArray (0, fromIntegral (length paletteEntries-1)) paletteEntries+ where+   paletteEntry = liftM3 (,,) anyWord8 anyWord8 anyWord8++parseIhdr :: Parser PNGChunk+parseIhdr = do+  width <- anyWord32+  height <- anyWord32+  -- [(1,Bd1), (2,Bd2), (4,Bd4), (8,Bd8), (16,Bd16)]+  bitDepth <- allowedValues word8 [(8,Bd8)]+              <?> "valid bit depth (supported: Bd8)"+  --[(0,Ct0), (2,Ct2), (3,Ct3), (4,Ct4), (6,Ct6)]+  colorType <- allowedValues word8 [(2,Ct2), (6,Ct6)]+               <?> "valid colorType: supported Ct2,Ct6"+  compressionMethod <- allowedValues word8 [(0, Deflate)] +                       <?> "valid compression method: supported Deflate"+  filterMethod <- allowedValues word8 [(0, Adaptive)] +                  <?> "valid filter method: supported Adaptive"+  -- [(0, NoInterlace), (1, Adam7)] +  interlaceMethod <- allowedValues word8 [(0, NoInterlace)] +                     <?> "valid interlace method: supported NoInterlace"+  return $ IHDR {+               ihdr_width = width+             , ihdr_height = height+             , ihdr_bitDepth = bitDepth+             , ihdr_colorType = colorType+             , ihdr_compressionMethod = compressionMethod+             , ihdr_filterMethod = filterMethod+             , ihdr_interlaceMethod = interlaceMethod+             }++-- | conversion from raw chunks to final chunks+toPngChunk :: RawPNGChunk -> Either String PNGChunk+toPngChunk raw =+    case chunkName of+      "IHDR"   -> parseChunkData parseIhdr+      "PLTE"   -> parseChunkData parsePlte+      "IEND"   -> return IEND+      "IDAT"   -> return $ IDAT (rawPngChunk_data raw)+      _        -> return $ UnknownChunk raw+ where+   parseChunkData a =+       case runP a () "" (rawPngChunk_data raw) of+         Left e  -> fail $ "failed to parse chunk " ++ show chunkName ++ ", " ++ show e+         Right x -> return x+   chunkName = rawPngChunk_type raw++toPngImage :: [RawPNGChunk] -> IO (Either String PNGImage)+toPngImage chunks = do+  case mapM toPngChunk chunks >>= return . partition isIDAT of+    Right (_, []) -> return $ Left "File has no chunks!"+    Right (dataChunks, hdr:otherChunks)  -> do+                      let dataDecompressed = decompress . LB.concat . map idat_data $ dataChunks+                          bpp = bytesPerPixel (ihdr_colorType hdr) (ihdr_bitDepth hdr)+                          w = fromIntegral (ihdr_width hdr)+                          h = fromIntegral (ihdr_height hdr)+                      sls <- defilter_scanlines_arr (w,h) (fromIntegral bpp) dataDecompressed+                      return $ Right (PNGImage hdr otherChunks sls)+    Left x -> return $ Left x++-- |Load a PNG file, Left value contains a description of a problem as a String,+-- if any+loadPNGFile :: FilePath -> IO (Either String PNGImage)+loadPNGFile fn = do+  rawChunks <- parseFromFile pngFile fn+  case rawChunks of+    Right chunks  -> toPngImage chunks `catchError` (\e -> return (Left (show e)))+    Left s        -> return (Left s)++sampleWidth :: BitDepth -> Int+sampleWidth Bd1  = 1+sampleWidth Bd2  = 2+sampleWidth Bd4  = 4+sampleWidth Bd8  = 8+sampleWidth Bd16 = 16++bytesPerPixel :: ColorType -> BitDepth -> Int+bytesPerPixel Ct0 Bd16   = 2+bytesPerPixel Ct0 _      = 1+bytesPerPixel Ct2 Bd1    = 1+bytesPerPixel Ct2 Bd2    = 1+bytesPerPixel Ct2 Bd4    = 2+bytesPerPixel Ct2 Bd8    = 3+bytesPerPixel Ct2 Bd16   = 6+bytesPerPixel Ct3 _      = 3+bytesPerPixel Ct4 Bd8    = 2+bytesPerPixel Ct4 Bd16   = 4+bytesPerPixel Ct4 _      = 1+bytesPerPixel Ct6 Bd8    = 4+bytesPerPixel Ct6 Bd16   = 8+bytesPerPixel Ct6 Bd4    = 2+bytesPerPixel Ct6 _      = 1++-- |Check if the image has alpha channel+hasAlphaChannel :: PNGImage -> Bool+hasAlphaChannel img = case ihdr_colorType hdr of+                        Ct6   -> True+                        _     -> False+ where hdr = pngImg_header img++-- |Get dimensions of the image (in pixels)+dimensions :: PNGImage -> (Width,Height)+dimensions img = (ihdr_width hdr, ihdr_height hdr)+ where hdr = pngImg_header img++-- |Bytes per pixel+pixelWidth :: PNGImage -> Int+pixelWidth img = bytesPerPixel (ihdr_colorType hdr) (ihdr_bitDepth hdr)+ where hdr = pngImg_header img++-- |Get image data as C-compatible StorableArray+imageData :: PNGImage -> StorableArray (Int,Int) Word8+imageData img = pngImg_imageData img

@@ -0,0 +1,29 @@+{-# LANGUAGE BangPatterns #-}++module Gamgine.Image.PNG.Internal.CRC (update_crc, crc) where++import Data.Word+import Data.Array.Unboxed+import Data.Bits+import qualified Data.ByteString.Lazy as LB++crc_table :: UArray Word32 Word32+crc_table = listArray (0,255) . map iterate_c $ [0..]+ where+   iterate_c = (!! 8) . iterate compute_c+   compute_c c+       | c .&. 1 == 1   = 0xedb88320 `xor` (c `shiftR` 1)+       | otherwise      = c `shiftR` 1++update_crc :: Word32 -> LB.ByteString -> Word32+update_crc !c bs+    | LB.null bs        = c+    | otherwise         = let w      = LB.head bs+                              newcrc = (crc_table ! ((c `xor` fromIntegral w) .&. 0xff)) `xor` (c `shiftR` 8)+                          in+                            update_crc newcrc (LB.tail bs)++crc :: LB.ByteString -> Word32+crc = (`xor` 0xffffffff) . update_crc 0xffffffff++--test = crc $ LB.replicate 10000000 128

@@ -0,0 +1,98 @@+{-# LANGUAGE BangPatterns #-}++module Gamgine.Image.PNG.Internal.Filters (defilter_scanlines_arr) where++import Data.Array.Storable+import Data.Array.IO++import Data.Word+import Data.Maybe++import qualified Data.ByteString.Lazy as LB++type Width = Int+type Height = Int++-- | Defilter filtered PNG data (data includes scanlines prepended with filter+--   types).+defilter_scanlines_arr :: (Width,Height) -> Int -> LB.ByteString+                       -> IO (StorableArray (Width,Height) Word8)+defilter_scanlines_arr (width,height) bpp bs = do+  (slTypes, imgArr) <- imageArray (widthInBytes, height) bs+  doFilter widthInBytes bpp imgArr slTypes+  return imgArr+ where+   widthInBytes = bpp*width++-- | create mutable array for defiltering the image and break out scanline types+imageArray :: (Width,Height) -> LB.ByteString+           -> IO ([Word8],StorableArray (Int,Int) Word8)+imageArray (width,height) bs = do+  a <- newListArray ((0,0), (height-1, width-1)) $ LB.unpack imageData+  return (scanlineTypes, a)+ where+   imageData = LB.concat scanlineData+   (scanlineTypes, scanlineData) = unzip scanlines+   scanlines = map (fromJust . LB.uncons) (chop bs)+   chop b+       | LB.null b   = []+       | otherwise   = let (sl,rest) = LB.splitAt slWidth b+                       in sl : chop rest+   slWidth = fromIntegral (width+1)++-- | Perform filtering on the image array (standard adaptive filters supported)+doFilter :: Width -> Int -> StorableArray (Int,Int) Word8 -> [Word8]+         -> IO ()+doFilter width bpp image scanlineTypes = doFilter' scanlineTypes 0+ where+   doFilter'       [] _ = return ()+   doFilter' (0:rest) !y = doFilter' rest (y+1)        -- no filter on this line+   doFilter' (1:rest) !y = sub_filter 0 >> doFilter' rest (y+1)+     where sub_filter !x+               | x<width = do subx <- readByte (y,x)+                              raw  <- readByte (y,x-bpp)+                              writeByte (y,x) (subx+raw)+                              sub_filter (x+1)+               | otherwise = return ()+   doFilter' (2:rest) !y = up_filter 0 >> doFilter' rest (y+1)+     where up_filter !x+               | x<width = do upx <- readByte (y,x)+                              prior <- readByte (y-1,x)+                              writeByte (y,x) (upx+prior)+                              up_filter (x+1)+               | otherwise = return ()+   doFilter' (3:rest) !y = avg_filter 0 >> doFilter' rest (y+1)+     where avg_filter !x+               | x<width = do avgx <- readByte (y,x)+                              raw <- readByte (y,x-bpp)+                              prior <- readByte (y-1,x)+                              let s = ((fromIntegral raw + fromIntegral prior) `div` (2::Word16))+                              writeByte (y,x) (avgx + fromIntegral s)+                              avg_filter (x+1)+               | otherwise = return ()+   doFilter' (4:rest) !y = paeth_filter 0 >> doFilter' rest (y+1)+     where paeth_filter !x+               | x<width = do paethx <- readByte (y,x)+                              a <- readByte (y,x-bpp)+                              b <- readByte (y-1,x)+                              c <- readByte (y-1, x-bpp)+                              writeByte (y,x) (paethx + fromIntegral (paeth_predictor (fromIntegral a) (fromIntegral b) (fromIntegral c)))+                              paeth_filter (x+1)+               | otherwise = return ()+   doFilter' (_:rest) !y = doFilter' rest (y+1) -- unknown filter, leave as is (and mess up image ;)+   {-# INLINE readByte #-}+   readByte (!y,!x) = if x<0 then return 0 else readArray image (y,x)+   {-# INLINE writeByte #-}+   writeByte = writeArray image++{-# INLINE paeth_predictor #-}+paeth_predictor :: Int -> Int -> Int -> Int+paeth_predictor !a !b !c+    | pa <= pb && pa <= pc  = a+    | pb <= pc              = b+    | otherwise             = c+ where+   p = a + b - c+   pa = abs(p-a)+   pb = abs(p-b)+   pc = abs(p-c)

@@ -0,0 +1,74 @@+{-# LANGUAGE BangPatterns, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}++module Gamgine.Image.PNG.Internal.Parser where++import Text.Parsec.Prim+import Text.Parsec.Combinator++import Data.Word+import Data.Bits+import Numeric (showHex)++import qualified Data.ByteString.Lazy as LB++instance (Monad m) => Stream LB.ByteString m Word8 where+    uncons = return . LB.uncons++type Parser = Parsec LB.ByteString ()++word8 :: (Stream LB.ByteString m Word8) => Word8 -> ParsecT LB.ByteString u m Word8+word8 = satisfy . (==)++word16 :: (Stream LB.ByteString m Word8) => Word16 -> ParsecT LB.ByteString u m Word16+word16 w = (word8 hi >> word8 lo >> return w) <?> "0x" ++ showHex w ""+ where+   hi = fromIntegral (w `shiftR` 8)+   lo = fromIntegral w++word32 :: (Stream LB.ByteString m Word8) => Word32 -> ParsecT LB.ByteString u m Word32+word32 w = (word16 hi >> word16 lo >> return w) <?> "0x" ++ showHex w ""+ where+   hi = fromIntegral (w `shiftR` 16)+   lo = fromIntegral w++satisfy :: (Stream LB.ByteString m Word8) => (Word8 -> Bool) -> ParsecT LB.ByteString u m Word8+satisfy f = tokenPrim (\c -> "0x" ++ showHex c "")+                      (\pos _ _ -> pos)+                      (\c -> if f c then Just c else Nothing)++anyWord8 :: (Stream LB.ByteString m Word8) => ParsecT LB.ByteString u m Word8+anyWord8 = anyToken++anyWord16 :: (Stream LB.ByteString m Word8) => ParsecT LB.ByteString u m Word16+anyWord16 = do+  hi <- anyWord8+  lo <- anyWord8+  return $ (fromIntegral hi `shiftL` 8) .|. fromIntegral lo++anyWord32 :: (Stream LB.ByteString m Word8) => ParsecT LB.ByteString u m Word32+anyWord32 = do+  hi <- anyWord16+  lo <- anyWord16+  return $ (fromIntegral hi `shiftL` 16) .|. fromIntegral lo++string :: (Stream LB.ByteString m Word8) => LB.ByteString -> ParsecT LB.ByteString u m LB.ByteString+string s = mapM_ word8 (LB.unpack s) >> return s++block :: (Stream LB.ByteString m Word8) => Int -> ParsecT LB.ByteString u m LB.ByteString+block size = do  -- count size anyWord8 >>= return . LB.pack+  i <- getInput+  let (s,r) = LB.splitAt (fromIntegral size) i+  setInput r+  return s++allowedValues :: (a -> Parser a) -> [(a,b)] -> Parser b+allowedValues fn = choice . map (\(val,res) -> fn val >> return res) ++parseFromFile :: Parser a -> FilePath -> IO (Either String a)+parseFromFile p fname+    = do input <- LB.readFile fname+         return $ case runP p () fname input of+                    Left err  -> Left (show err)+                    Right x   -> Right x++

@@ -0,0 +1,75 @@++module Gamgine.Lens.IORef where+#include "Gamgine/Utils.cpp"+IMPORT_LENS_AS_LE++import Control.Applicative ((<$>))+import Control.Monad (void)+import qualified Control.Monad.State as ST+import qualified Data.IORef as R++type StateIORef a = ST.StateT (R.IORef a) IO ++-- | map a function on the value of the IORef+mapIORef :: R.IORef a -> (a -> b) -> IO b+mapIORef ref f = f <$> R.readIORef ref+++{- functions to operate on the value of a IORef inside of a State -}++-- | get the value of the IORef inside of the State+get :: StateIORef a a+get = do+   ref <- ST.get+   ST.liftIO $ R.readIORef ref++-- | apply a function on the value of the IORef+gets :: (a -> b) -> StateIORef a b+gets f = do+   ref <- ST.get+   ST.liftIO $ mapIORef ref f++-- | apply the getter lens on the value of the IORef inside of the State+getsL :: LE.Lens a b -> StateIORef a b+getsL lens = do+   ref <- ST.get+   ST.liftIO $ getL ref lens++-- | set the value of the IORef inside of the State+put :: a -> StateIORef a ()+put value = do+   ref <- ST.get+   ST.liftIO $ R.writeIORef ref value++-- | put a value +putL :: LE.Lens a b -> b -> StateIORef a ()+putL lens value = do+   ref <- ST.get+   void $ ST.liftIO $ setL ref lens value++-- | modify the value of the IORef inside of the State with a lens+modify :: (a -> a) -> StateIORef a ()+modify f = do+   ref <- ST.get+   ST.liftIO $ R.modifyIORef ref f++-- | modify the value of the IORef inside of the State with a lens+modifyL :: LE.Lens a b -> (b -> b) -> StateIORef a ()+modifyL lens f = do+   ref <- ST.get+   ST.liftIO $ modL ref lens f+++{- functions to apply a lens to the value of a IORef -}++-- | apply the getter of the lens on the value of the IORef  +getL :: R.IORef a -> LE.Lens a b -> IO b+getL ref lens = mapIORef ref $ LE.getL lens++-- | apply the setter of the lens on the value of the IORef  +setL :: R.IORef a -> LE.Lens a b -> b -> IO ()+setL ref lens value = R.modifyIORef ref $ (LE.setL lens value)++-- | modify the value of the IORef with a lens+modL :: R.IORef a -> LE.Lens a b -> (b -> b) -> IO ()+modL ref lens f = R.modifyIORef ref $ LE.modL lens f

@@ -0,0 +1,20 @@++module Gamgine.Lens.State where+#include "Gamgine/Utils.cpp"+IMPORT_LENS_AS_LE++import Control.Applicative ((<$>))+import qualified Control.Monad.State as ST++-- | apply the getter lens on the value of the state +getL :: Monad m => LE.Lens a b -> ST.StateT a m b+getL lens = ST.gets $ LE.getL lens+  ++-- | apply the setter of the lens on the value of the state+setL :: Monad m => LE.Lens a b -> b -> ST.StateT a m ()+setL lens value = ST.modify $ LE.setL lens value++-- | modify the value of the state with a lens+modL :: Monad m => LE.Lens a b -> (b -> b) -> ST.StateT a m ()+modL lens f =  ST.modify $ LE.modL lens f

@@ -0,0 +1,91 @@++module Gamgine.Math.Box where+#include "Gamgine/Utils.cpp"+import Data.Maybe+import qualified Data.List as L+import Gamgine.Math.Vect as V+import Gamgine.Math.Utils+import Gamgine.Utils+IMPORT_LENS_AS_LE+++-- axis aligned bounding box+data Box = Box {+   minPt :: Vect,+   maxPt :: Vect+   } deriving (Show, Read)++LENS(minPt)+LENS(maxPt)++center :: Box -> Vect+center b = minPt b + halfs b++halfs :: Box -> Vect+halfs (Box minPt maxPt) = (maxPt - minPt) * 0.5++intersects :: Box -> Box -> Bool+Box min1 max1 `intersects` Box min2 max2 =+   not $ V.any (>) min2 max1 || V.any (<) max2 min1++inside :: Box -> Box -> Bool+Box min1 max1 `inside` Box min2 max2 =+   V.all (>=) min1 min2 && V.all (<=) max1 max2++moveBy :: Box -> Vect -> Box+Box min max `moveBy` v = Box (min + v) (max + v)++extendBy :: Box -> Box -> Box+Box min1 max1 `extendBy` Box min2 max2 =+   Box (V.minVec min1 min2) (V.maxVec max1 max2)++contains :: Box -> Vect -> Bool+contains (Box min max) v =+   V.all (>=) v min && V.all (<=) v max++bound :: [Box] -> Box+bound []     = Box (V.v3 0 0 0) (V.v3 0 0 0)+bound (b:bs) = L.foldr extendBy b bs++-- overlapping if distance negative in all dimensions+distance :: Box -> Box -> Vect+distance b1 b2 = (abs $ center b2 - center b1) - (halfs b1 + halfs b2)++-- If the boxes are overlapping, than minOverlap returns the minimal+-- distance in each dimension by which b1 has to be moved to resolve+-- the overlapping with b2. Otherwise, if not overlapping, for each+-- dimension 0 is returned.+minOverlap :: Box -> Box -> Vect+minOverlap (Box min1 max1) (Box min2 max2) = V.fromList $ L.map overlap [0..2]+   where+      overlap dim =+	 let v1@(minv1, maxv1) = (getElem dim min1, getElem dim max1)+             v2@(minv2, maxv2) = (getElem dim min2, getElem dim max2)+             in if maxv1 < minv2 || minv1 > maxv2+                   then 0+                   else let minv1Outside     = minv1 < minv2+                            maxv1Outside     = maxv1 > maxv2+                            v1Inside         = not minv1Outside && not maxv1Outside+                            o | v1Inside     = insideOverlap v1 v2+                              | minv1Outside = minOutsideOverlap v1 v2+                              | maxv1Outside = maxOutsideOverlap v1 v2+                            in o++      insideOverlap (minv1, maxv1) (minv2, maxv2) =+         let leftDist  = maxv1 - minv2+             rightDist = maxv2 - minv1+             o | leftDist < rightDist = -leftDist+               | otherwise            =  rightDist+             in o++      minOutsideOverlap (_, maxv1) (minv2, _) = -(maxv1 - minv2)+      maxOutsideOverlap (minv1, _) (_, maxv2) = maxv2 - minv1+++type Tuple3d = (Double,Double,Double)++fromTuples :: (Tuple3d, Tuple3d) -> Box+fromTuples (t1, t2) = Box (V.fromTuple t1) (V.fromTuple t2)++toTuples :: Box -> (Tuple3d, Tuple3d)+toTuples (Box minPt maxPt) = (V.toTuple minPt, V.toTuple maxPt)

@@ -0,0 +1,52 @@++module Gamgine.Math.BoxTree where+import qualified Gamgine.Math.Vect as V+import qualified Gamgine.Math.Box as B+import Data.List (concat)+import Debug.Trace++data BoxTree a = Node B.Box [BoxTree a]+		  | Leaf B.Box a+		  deriving (Show)++-- intersection details+data Intersection a = Intersection {+   leaf1 :: (B.Box, a),+   leaf2 :: (B.Box, a)+   }+   deriving (Show)++intersection :: BoxTree a -> BoxTree a -> [Intersection a]+qt1 `intersection` qt2 = qt1 `isect` qt2+   where+      isect :: BoxTree a -> BoxTree a -> [Intersection a]++      (Node b1 qts1) `isect` (Node b2 qts2)+	 | b1 `B.intersects` b2 = concat $ [qt1 `isect` qt2 | qt1 <- qts1, qt2 <- qts2]+	 | otherwise            = []++      l@(Leaf b1 _) `isect` (Node b2 qts2)+	 | b1 `B.intersects` b2 = concat $ [l `isect` qt2 | qt2 <- qts2]+	 | otherwise            = []++      (Node b1 qts1) `isect` l@(Leaf b2 _)+	 | b1 `B.intersects` b2 = concat $ [qt1 `isect` l | qt1 <- qts1]+	 | otherwise            = []++      (Leaf b1 a1) `isect` (Leaf b2 a2)+--	 | b1 `B.intersects` b2 = trace ("b1: " ++ show b1 ++ "\nb2: " ++ show b2) [Intersection (b1, a1) (b2, a2)]+	 | b1 `B.intersects` b2 = [Intersection (b1, a1) (b2, a2)]+	 | otherwise            = []+++moveBy :: BoxTree a -> V.Vect -> BoxTree a+(Node b qts) `moveBy` v = Node (b `B.moveBy` v) [qt `moveBy` v | qt <- qts]+(Leaf b a)   `moveBy` v = Leaf (b `B.moveBy` v) a+++asBox :: BoxTree a -> B.Box+asBox (Node box _) = box+asBox (Leaf box _) = box++asBoxTree :: B.Box -> a -> BoxTree a+asBoxTree b a = Leaf b a

@@ -0,0 +1,95 @@++module Gamgine.Math.Matrix (+   module Data.Vec,+   Matrix,+   Window,+   Frustum(..),+   mkOrtho,+   mkScale,+   mkTranslate,+   mkWindowMatrix,+   mkWorldToWinMatrix,+   mkWinToWorldMatrix,+   winToWorld,+   inverseOrIdentity) where++import Data.Vec+import Gamgine.Math.Vect++-- row major matrix+type Matrix = Mat44 Double++type Width  = Int+type Height = Int+type Window = (Width, Height)++type X        = Int+type Y        = Int+type WinCoord = (X, Y)++data Frustum = Frustum {+   left   :: Double,+   right  :: Double,+   bottom :: Double,+   top    :: Double,+   near   :: Double,+   far    :: Double+   } deriving (Show, Eq)+++mkOrtho :: Frustum -> Matrix+mkOrtho Frustum {left = l, right = r, bottom = b, top = t, near = n, far = f} =+   matFromList [2 / rml,       0,       0, -(rpl / rml),+                0      , 2 / tmb,       0, -(tpb / tmb),+                0      ,       0, 2 / fmn, -(fpn / fmn),+                0      ,       0,       0,            1]+   where+      rml = r - l+      rpl = r + l+      tmb = t - b+      tpb = t + b+      fmn = f - n+      fpn = f + n+++mkScale :: Vect -> Matrix+mkScale v = scale (snoc v 1) identity +++mkTranslate :: Vect -> Matrix+mkTranslate v = translate v identity+++mkWindowMatrix :: Window -> Matrix+mkWindowMatrix (width, height) = toGLFW dHeight `multmm` unitCubeToWin dWidth dHeight+   where+      unitCubeToWin :: Double -> Double -> Matrix+      unitCubeToWin width height = +	 mkScale (v3 (width*0.5) (height*0.5) 0.5) `multmm` mkTranslate (v3 1 1 1)++      toGLFW :: Double -> Matrix+      toGLFW height = mkTranslate (v3 0 height 0) `multmm` mkScale (v3 1 (-1) 1) ++      dWidth  = fromIntegral width+      dHeight = fromIntegral height+++mkWorldToWinMatrix :: Window -> Frustum -> Matrix+mkWorldToWinMatrix win frust = mkWindowMatrix win `multmm` mkOrtho frust+++mkWinToWorldMatrix :: Window -> Frustum -> Matrix+mkWinToWorldMatrix win frust = inverseOrIdentity $ mkWorldToWinMatrix win frust+++inverseOrIdentity :: Matrix -> Matrix+inverseOrIdentity m =+   case invert m of+	Nothing -> identity+	Just m  -> m+++winToWorld :: Matrix -> WinCoord -> Vect+winToWorld winToWorldMatrix (x, y) = fromVect4 $ winToWorldMatrix `multmv` posVec+   where+      posVec = v4 (fromIntegral x) (fromIntegral y) 0 1

@@ -0,0 +1,29 @@++module Gamgine.Math.Utils where++clamp :: Double -> Double -> Double -> Double+clamp min max value+   | value < min = min+   | value > max = max+   | otherwise = value++flipSign :: Double -> Double+flipSign num = -1 * signum num++maxFloat :: RealFloat a => a -> a+maxFloat a = encodeFloat m n+   where+      b = floatRadix a+      e = floatDigits a+      (_, e') = floatRange a+      m = b ^ e - 1+      n = e' - e++instance Bounded Double where+   maxBound = maxFloat (0 :: Double)+   minBound = -maxBound++minPositiveFloat :: RealFloat a => a -> a+minPositiveFloat a = encodeFloat 1 $ fst (floatRange a) - floatDigits a++minPositiveDouble = minPositiveFloat (0 :: Double)

@@ -0,0 +1,69 @@+module Gamgine.Math.Vect (module Data.Vec,Vect,Vect4,x,y,z,v3,v4,fromTuple,toTuple,fromVect4,len,+                          inverseVec,clampVec,maxVec,minVec,index,absVec,nullVec,and,or,all,any) where++import Gamgine.Utils+#include "Gamgine/Utils.cpp"+import qualified Gamgine.Math.Utils as U+import Data.Vec+import qualified Data.Vec as V+import Prelude hiding (and, or, all, any)+import Debug.Trace++type Vect  = Vec3 Double+type Vect4 = Vec4 Double++x :: Vect -> Double+x (x:._) = x++y :: Vect -> Double+y (_:.y:._) = y++z :: Vect -> Double+z (_:._:.z:.()) = z++v3 :: Double -> Double -> Double -> Vect+v3 x y z = x:.y:.z:.()++v4 :: Double -> Double -> Double -> Double -> Vect4+v4 x y z w = x:.y:.z:.w:.()++fromTuple :: (Double,Double,Double) -> Vect+fromTuple (x,y,z) = v3 x y z++toTuple :: Vect -> (Double,Double,Double)+toTuple (x:.y:.z:.()) = (x,y,z)++fromVect4 :: Vect4 -> Vect+fromVect4 (x:.y:.z:.w:.()) = v3 x y z++len :: Vect -> Double+len = norm++inverseVec v = V.map (* (-1)) v++index :: (Double -> Bool) -> Vect -> Int+index f (x:.y:.z:.())+   | f x = 0+   | f y = 1+   | f z = 2+   | otherwise = ERROR "Couldn't find elem!"++clampVec :: Vect -> Vect -> Vect -> Vect+clampVec (minX:.minY:.minZ:.()) (maxX:.maxY:.maxZ:.()) (x:.y:.z:.()) =+   v3 (U.clamp minX maxX x) (U.clamp minY maxY y) (U.clamp minZ maxZ z)++maxVec v1 v2 = V.zipWith max v1 v2++minVec v1 v2 = V.zipWith min v1 v2++absVec v = V.map abs v++nullVec = v3 0 0 0++and v = V.foldr (&&) True v++or v = V.foldr (||) False v++all f v1 v2 = and $ V.zipWith f v1 v2++any f v1 v2 = or $ V.zipWith f v1 v2

@@ -0,0 +1,26 @@++module Gamgine.State.InputInfo where+import qualified Graphics.UI.GLFW as GLFW+import Control.Monad (liftM2)+import Gamgine.Control ((?))+import qualified Gamgine.Math.Vect as V++data Modifier = Ctrl | Alt | Shift deriving (Eq, Ord)++-- | mouse position in world coordinates+type MousePos = V.Vect++-- | if the key/mouse button was pressed or released+data InputState = Pressed | Released deriving (Eq, Ord)++pressedModifiers :: IO [Modifier]+pressedModifiers = do+   ctrl  <- isCtrlPressed+   shift <- isShiftPressed+   alt   <- isAltPressed+   return $ (ctrl ? [Ctrl] $ []) ++ (shift ? [Shift] $ []) ++ (alt ? [Alt] $ [])+         +isCtrlPressed, isAltPressed, isShiftPressed :: IO Bool+isCtrlPressed  = liftM2 (||) (GLFW.keyIsPressed GLFW.KeyLeftCtrl)  (GLFW.keyIsPressed GLFW.KeyRightCtrl)+isAltPressed   = liftM2 (||) (GLFW.keyIsPressed GLFW.KeyLeftAlt)   (GLFW.keyIsPressed GLFW.KeyRightAlt)+isShiftPressed = liftM2 (||) (GLFW.keyIsPressed GLFW.KeyLeftShift) (GLFW.keyIsPressed GLFW.KeyRightShift)

@@ -0,0 +1,17 @@++module Gamgine.State.KeyInfo (module II, KeyInfo(..)) where+import qualified Graphics.UI.GLFW as GLFW+import qualified Gamgine.Math.Vect as V+import Gamgine.State.InputInfo as II++-- | info for the pressed/released key+data KeyInfo = KeyInfo {+   -- the pressed/released key+   key       :: GLFW.Key,+   -- if the key was pressed/released+   status    :: II.InputState,+   -- the current mouse position in world coordinates+   mousePos  :: II.MousePos,+   -- if a modifier key is additionally pressed+   modifiers :: [II.Modifier]+   }

@@ -0,0 +1,17 @@++module Gamgine.State.MouseInfo (module II, MouseInfo(..)) where+import qualified Graphics.UI.GLFW as GLFW+import qualified Gamgine.Math.Vect as V+import qualified Gamgine.State.InputInfo as II++-- | info for the pressed/released mouse button+data MouseInfo = MouseInfo {+   -- the pressed/released mouse button+   button    :: GLFW.MouseButton,+   -- if the button was pressed/released+   status    :: II.InputState,+   -- the current mouse position in world coordinates+   mousePos  :: II.MousePos,+   -- if a modifier key is additionally pressed+   modifiers :: [II.Modifier]+   }

@@ -0,0 +1,41 @@++module Gamgine.State.RenderState where+#include "Gamgine/Utils.cpp"+import Control.Applicative ((<$>))+import qualified Data.List as L+import qualified Graphics.Rendering.OpenGL.Raw as GL+import qualified Gamgine.Font.GLF as GLF+IMPORT_LENS_AS_LE++newtype TextureName = TextureName Int deriving (Show, Eq)+newtype FontName    = FontName Int deriving (Show, Eq)++type TextureIds = [(TextureName, GL.GLuint)]+type FontIds    = [(FontName   , GLF.FontId)]++data Ressources = Ressources {+   textureIds :: TextureIds,+   fontIds    :: FontIds+   } deriving Show++emptyRessources :: Ressources+emptyRessources = Ressources [] []++textureId :: TextureName -> Ressources -> Maybe GL.GLuint+textureId name res = L.lookup name $ textureIds res++fontId :: FontName -> Ressources -> Maybe GLF.FontId+fontId name res = L.lookup name $ fontIds res++LENS(textureIds)+LENS(fontIds)++data RenderState = RenderState {+   nextFrameFraction :: Double,    -- ^ value range 0-1+   ressources        :: Ressources,+   frustumSize       :: (Double, Double)+   } deriving Show++LENS(nextFrameFraction)+LENS(ressources)+LENS(frustumSize)

@@ -0,0 +1,33 @@++module Gamgine.State.State where+import qualified Gamgine.Math.Vect as V+import qualified Gamgine.State.RenderState as RS+import qualified Gamgine.State.InputInfo as II+import qualified Gamgine.State.KeyInfo as KI+import qualified Gamgine.State.MouseInfo as MI++-- | an application state+data State a = State {+   -- | called when the state is entered,+   --   when Nothing is returned, than the state+   --   couldn't be entered+   enter :: II.MousePos -> a -> Maybe (a, State a),++   -- | called when the state is leaved+   leave :: a -> (a, State a),++   -- | called for each application update cycle+   update :: a -> (a, State a),++   -- | called for each frame rendering+   render :: RS.RenderState -> a -> IO (a, State a),++   -- | called when a key was pressed/released+   keyEvent :: KI.KeyInfo -> a -> (a, State a),++   -- | called when a mouse button was pressed/released+   mouseEvent :: MI.MouseInfo -> a -> (a, State a),++   -- | called when a mouse was moved+   mouseMoved :: II.MousePos -> a -> (a, State a)+   }

@@ -0,0 +1,55 @@++module Gamgine.State.StateTree where+import qualified Data.List as L+import qualified Graphics.UI.GLFW as GLFW+import qualified Gamgine.State.State as S+import qualified Gamgine.State.InputInfo as II+import qualified Gamgine.State.MouseInfo as MI+import qualified Gamgine.State.KeyInfo as KI++-- | the tree of application states and how they entered and leaved+data StateTree a = Branch {+   state     :: S.State a,+   enterWhen :: StateTransition,+   leaveWhen :: StateTransition,+   adjacents :: [StateTree a]+   }++-- | at which event the next state should be entered+type EnterWhen = StateTransition++-- | at which event the current state should be leaved+type LeaveWhen = StateTransition++-- | when a state should be entered or leaved+data StateTransition = ByKey GLFW.Key II.InputState+                     | ByKeyWithMod GLFW.Key II.InputState II.Modifier+                     | ByMouse GLFW.MouseButton II.InputState+                     | ByMouseWithMod GLFW.MouseButton II.InputState II.Modifier+                     | NoTransition+                     deriving (Eq, Ord)++root :: S.State a -> [StateTree a] -> StateTree a+root s as = Branch s NoTransition NoTransition as+++enterState :: II.MousePos -> a -> StateTree a -> Maybe (a, StateTree a)+enterState mp a st@(Branch s e l as) =+   case (S.enter s) mp a of+        Just (a', s') -> Just (a', Branch s' e l as)+        _             -> Nothing+++leaveState :: a -> StateTree a -> (a, StateTree a)+leaveState a (Branch s e l as) =+   let (a', s') = S.leave s $ a in (a', Branch s' e l as)+++handleKeyEvent :: KI.KeyInfo -> a -> StateTree a -> (a, StateTree a)+handleKeyEvent ki a (Branch s e l as) =+   let (a', s') = (S.keyEvent s) ki a in (a', Branch s' e l as)+++handleMouseEvent :: MI.MouseInfo -> a -> StateTree a -> (a, StateTree a)+handleMouseEvent mi a (Branch s e l as) =+   let (a', s') = (S.mouseEvent s) mi a in (a', Branch s' e l as)

@@ -0,0 +1,109 @@++module Gamgine.State.StateTreeZipper where+import qualified Data.List as L+import Data.List ((!!))+import qualified Gamgine.State.State as S+import qualified Gamgine.State.StateTree as ST+import Gamgine.State.StateTree (root, enterWhen, leaveWhen, adjacents, StateTree(..), StateTransition(..))+import qualified Gamgine.State.KeyInfo as KI+import qualified Gamgine.State.MouseInfo as MI+import qualified Gamgine.State.InputInfo as II++-- | a zipper for the state tree+data Zipper a = Zipper {+   path    :: [Step a],+   current :: ST.StateTree a+   }+++-- | represents a step walking the state tree+data Step a = Step {+   parent   :: (S.State a, ST.EnterWhen, ST.LeaveWhen),+   -- (beforeSiblings, afterSiblings)+   siblings :: ([ST.StateTree a], [ST.StateTree a])+   }+++-- | create a zipper from a StateTree+zipper :: ST.StateTree a -> Zipper a+zipper s = Zipper [] s+++-- | checks if a state transition should occur, otherwise+--   calls the keyEvent function of the current state+handleKeyEvent :: KI.KeyInfo -> a -> Zipper a -> (a, Zipper a)+handleKeyEvent ki a z@(Zipper ps c)+   | transitionAppliesKI ki (ST.leaveWhen . current $ z) = goUp mp a z+   | otherwise = +      case L.findIndex (== True) $ L.map (transitionAppliesKI ki . ST.enterWhen) (ST.adjacents . current $ z) of+           Just idx -> goDown idx mp a z+           _        -> let (a', c') = ST.handleKeyEvent ki a c in (a', Zipper ps c') +   where+      mp = KI.mousePos ki+++-- | checks if a state transition should occur, otherwise+--   calls the mouseEvent function of the current state+handleMouseEvent :: MI.MouseInfo -> a -> Zipper a -> (a, Zipper a)+handleMouseEvent mi a z@(Zipper ps c)+   | transitionAppliesMI mi (ST.leaveWhen . current $ z) = goUp mp a z+   | otherwise = +      case L.findIndex (== True) $ L.map (transitionAppliesMI mi . ST.enterWhen) (ST.adjacents . current $ z) of+           Just idx -> goDown idx mp a z+           _        -> let (a', c') = ST.handleMouseEvent mi a c in (a', Zipper ps c') +   where+      mp = MI.mousePos mi+      +   +-- | leave the current state and enter the parent state+goUp :: II.MousePos -> a -> Zipper a -> (a, Zipper a)+goUp mp a z@(Zipper [] _) = (a, z)+goUp mp a z@(Zipper (Step (p,e,l) (beforeSibs, afterSibs):ps) c) =+   case (S.enter p) mp a' of+        Just (a'', p') -> (a'', Zipper ps $ ST.Branch p' e l (beforeSibs ++ (c' : afterSibs)))+        _              -> (a, z)+   where+      (a' , c') = ST.leaveState a c+++-- | leave the current state and enter the adjacent state+--   with index 'adjIdx'+goDown :: Int -> II.MousePos -> a -> Zipper a -> (a, Zipper a)+goDown adjIdx mp a z@(Zipper ps (Branch c e l as))+   | adjIdx >= L.length as = (a, z)+   | otherwise =+      case ST.enterState mp a' s of+           Just (a'', s') -> (a'', Zipper ((Step (c',e,l) (beforeSibs, afterSibs)):ps) s')+           _              -> (a, z)+   where+      (a', c')   = (S.leave c) a+      s          = as !! adjIdx+      beforeSibs = L.take adjIdx as+      afterSibs  = L.drop (adjIdx + 1) as+++-- | replace the current state+replace :: S.State a -> Zipper a -> Zipper a+replace s (Zipper p (ST.Branch _ e l ss)) = Zipper p (ST.Branch s e l ss)+++-- | checks if the KeyInfo matches the StateTransition+transitionAppliesKI :: KI.KeyInfo -> StateTransition -> Bool+transitionAppliesKI ki (ByKey key status) =+   KI.key ki == key && KI.status ki == status++transitionAppliesKI ki (ByKeyWithMod key status mod) =+   KI.key ki == key && KI.status ki == status && L.any (== mod) (KI.modifiers ki)++transitionAppliesKI _ _ = False+++-- | checks of the MouseInfo matches the StateTransition+transitionAppliesMI :: MI.MouseInfo -> StateTransition -> Bool+transitionAppliesMI mi (ByMouse button status) =+   MI.button mi == button && MI.status mi == status++transitionAppliesMI mi (ByMouseWithMod button status mod) =+   MI.button mi == button && MI.status mi == status && L.any (== mod) (MI.modifiers mi)++transitionAppliesMI _ _ = False

@@ -0,0 +1,40 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Gamgine.System where+import System.Environment (getProgName, getEnv)+import System.Directory (createDirectoryIfMissing, getAppUserDataDirectory, getDirectoryContents)+import Data.List (takeWhile)+import Data.Time.Clock (getCurrentTime, utctDay)+import Data.Time.Calendar (toGregorian)+import Control.Exception (try)+import Control.Monad (filterM)++normalizedProgName :: IO (String)+normalizedProgName = do+   pn <- getProgName+   return $ takeWhile (/= '.') pn++getCurrentDate :: IO (Integer,Int,Int) -- :: (year,month,day)+getCurrentDate = getCurrentTime >>= return . toGregorian . utctDay++getEnvOrDefault :: String -> String -> IO String+getEnvOrDefault envVar defaultValue = do+   result <- try $ getEnv envVar+   case result of+	Right value          -> return value+	Left  (_ :: IOError) -> return defaultValue++appDirectory = normalizedProgName >>= \pn -> getAppUserDataDirectory pn++getAndCreateAppDir :: IO (FilePath)+getAndCreateAppDir = do+   dir <- appDirectory+   createDirectoryIfMissing True dir+   return dir++getDirContents :: FilePath -> IO [FilePath]+getDirContents dir = do+   entries <- getDirectoryContents dir+   filterM notDots entries+   where+      notDots entry = return . not $ "." == entry || ".." == entry

@@ -0,0 +1,29 @@++#define __POS__        (__FILE__ ++ ":" ++ show __LINE__)+#define ERROR          error $ __POS__ ++ " -> " ++++#define SHOW(a)        (#a ++ "=" ++ (show (a)))+#define S(a)           SHOW(a)+#define SHOW2(a,b)     (S(a) ++ " " ++ S(b))+#define S2(a,b)        SHOW2(a,b)+#define SHOW3(a,b,c)   (S2(a,b) ++ " " ++ S(c))+#define S3(a,b,c)      SHOW3(a,b,c)+#define SHOW4(a,b,c,d) (S3(a,b,c) ++ " " ++ S(d))+#define S4(a,b,c,d)    SHOW4(a,b,c,d)++#define PRINT(a)        putStrLn S(a)+#define P(a)            PRINT(a)+#define PRINT2(a,b)     putStrLn S2(a,b)+#define P2(a,b)         PRINT2(a,b)+#define PRINT3(a,b,c)   putStrLn S3(a,b,c)+#define P3(a,b,c)       PRINT3(a,b,c)+#define PRINT4(a,b,c,d) putStrLn S4(a,b,c,d)+#define P4(a,b,c,d)     PRINT4(a,b,c,d)++#define SHOWLN(x)       (#x ++ "=" ++ (show (x)) ++ "\n")++#define IMPORT_LENS_AS_LE import qualified Data.Lens.Strict as LE; \+                          import Control.Category ((.)); \+                          import Prelude hiding ((.)); \++#define LENS(field)    field##L = LE.lens field (\value record -> record {field=value})

@@ -0,0 +1,71 @@+module Gamgine.Utils where+#include "Gamgine/Utils.cpp"+import Gamgine.Control ((?))+import Prelude hiding (catch)+import qualified Data.ByteString.Lazy   as BL+import qualified Data.ByteString.Unsafe as BU+import qualified Data.List as L+import System.IO (hPutStrLn, stderr)+import Control.Exception (catch, SomeException)+import Data.Array.Storable+import Data.List+import Data.Bits ((.|.), shiftL)+import Data.Word+import Foreign.Ptr+import Gamgine.System+import Debug.Trace++count :: Eq a => a -> [a] -> Int+count x ys = go x 0 ys+   where+      go x num []     = num+      go x num (y:ys) = go x (x == y ? num + 1 $ num) ys++-- | replace all entries in 'as' by 'new' for which 'f' returns true+replaceBy :: (a -> Bool) -> a -> [a] -> [a]+replaceBy f new as = map (\a -> if f a then new else a) as+++errorsToStderr :: IO () -> IO ()+errorsToStderr action =+   catch action (\e -> do pn <- normalizedProgName+			  hPutStrLn stderr ("\n" ++ pn ++ ": " ++ show (e :: SomeException)))++showValue :: Show a => String -> a -> String+showValue name value = name ++ ": " ++ (show value) ++ "\n"++sv :: Show a => String -> a -> String+sv = showValue++for_ :: [a] -> (a -> b) -> [b]+for_ as f = map f as++maybe_ :: Maybe a -> b -> (a -> b) -> b+maybe_ m dflt f = maybe dflt f m++-- both lists have to be sorted ascending+firstFreeId :: Eq a => [a] -> [a] -> a+firstFreeId usedIds allIds = go usedIds allIds+   where+      go      _ []     = ERROR "Ups, all ids used!"+      go     [] (a:as) = a+      go (u:us) (a:as) = u /= a ? a $ go us as+++word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32+word a b c d =  (fromIntegral a `shiftL` 24)+                .|. (fromIntegral b `shiftL` 16)+                .|. (fromIntegral c `shiftL`  8)+                .|. (fromIntegral d            )+++bytesFromPointer :: Int -> Ptr Word8 -> IO BL.ByteString+bytesFromPointer n ptr = do+    s <- BU.unsafePackCStringLen (castPtr ptr, n)+    return $! BL.fromChunks [s]+++bytesFromStorableArray :: Int -> StorableArray (Int, Int) Word8 -> IO BL.ByteString+bytesFromStorableArray n array = do+   bytes <- withStorableArray array (bytesFromPointer n)+   return bytes

@@ -0,0 +1,43 @@++module Gamgine.Zipper where+import qualified Data.List as L+import qualified Data.List.Zipper as LZ+++-- | get the elements before the current one+before :: LZ.Zipper a -> LZ.Zipper a+before (LZ.Zip     [] _) = LZ.empty+before (LZ.Zip (a:ls) _) = LZ.Zip ls [a]+++-- | get the elements after the current one+after :: LZ.Zipper a -> LZ.Zipper a+after (LZ.Zip _     []) = LZ.empty+after (LZ.Zip _ (a:rs)) = LZ.Zip [] rs+++-- | get the current element, might fail+current :: LZ.Zipper a -> a+current = LZ.cursor+++-- | get the previous element, might fail+previous :: LZ.Zipper a -> a+previous (LZ.Zip (p:ls) _) = p+++-- | get the next element, might fail+next :: LZ.Zipper a -> a+next (LZ.Zip _ (c:n:_)) = n+++-- | if the current element is the last of the list+atLast :: LZ.Zipper a -> Bool+atLast (LZ.Zip _ (a:[])) = True+atLast _                 = False+++-- | if the current element is the first of the list+atFirst :: LZ.Zipper a -> Bool+atFirst (LZ.Zip [] (a:ls)) = True+atFirst _                  = False

@@ -0,0 +1,24 @@+Copyright (c) 2011, Daniel Trstenjak+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright+      notice, this list of conditions and the following disclaimer in the+      documentation and/or other materials provided with the distribution.+    * Neither the name of the <organization> nor the+      names of its contributors may be used to endorse or promote products+      derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL DANIEL TRSTENJAK BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

binary file changed (absent → 22751 bytes)

binary file changed (absent → 47854 bytes)

binary file changed (absent → 28623 bytes)

binary file changed (absent → 43546 bytes)

binary file changed (absent → 25421 bytes)

binary file changed (absent → 39851 bytes)

binary file changed (absent → 53463 bytes)

binary file changed (absent → 40205 bytes)

binary file changed (absent → 20944 bytes)

binary file changed (absent → 74642 bytes)

binary file changed (absent → 66344 bytes)

binary file changed (absent → 23653 bytes)

binary file changed (absent → 52880 bytes)

binary file changed (absent → 30801 bytes)

binary file changed (absent → 50270 bytes)

binary file changed (absent → 45361 bytes)

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,944 @@+/*+==============================================================================+|  GLF Library+|  Version 1.0 (Release)+| +|  Author: Roman Podobedov+|  Email: romka@ut.ee+|  WEB: www.ut.ee/~romka+|  Date: 17 August 2000+|  +|  Copyright (C) 2000, Romka Graphics+|  This library is freely distributable without any license or permissions.+|  You can use this library in any program (commercial, educational+|  or individual), but in each program, where You use this library, You +|  should to keep this header (author name and coordinates)!+==============================================================================+*/+#if defined (WIN32)+#include <windows.h>+#endif++#include <stdio.h>+#include <stdlib.h>+#include <string.h>+#include <GL/gl.h>+#include "glf.h"++/* Defines */++#define anchor_proc(x, y, ap) { \+    float *xx, *yy; \+    xx = (float *)&x; \+    yy = (float *)&y; \+    switch (ap) \+    { \+      case GLF_CENTER: break; \+      case GLF_LEFT_UP: *xx += 1; *yy -= 1; break; \+      case GLF_LEFT_CENTER: *xx += 1; break; \+      case GLF_LEFT_DOWN: *xx += 1; *yy += 1; break; \+      case GLF_CENTER_UP: *yy -= 1; break; \+      case GLF_CENTER_DOWN: *yy += 1; break; \+    } \+}++#define MAX_FONTS 256++/* Color structure */+struct color+{+  float r, g, b, a;+};++/* One symbol of font */+struct one_symbol+{+  unsigned char vertexs; /* Number of vertexs         */+  unsigned char facets;  /* Number of facets          */+  unsigned char lines;   /* Number of lines in symbol */++  float *vdata;          /* Pointer to Vertex data    */+  unsigned char *fdata;  /* Pointer to Facets data    */+  unsigned char *ldata;  /* Pointer to Line data      */++  float leftx;           /* Smaller x coordinate      */+  float rightx;          /* Right x coordinate        */+  float topy;            /* Top y coordinate          */+  float bottomy;         /* Bottom y coordinate       */+};++/* Font structure */+struct glf_font+{+  char font_name [97];+  unsigned char sym_total;          /* Total symbols in font */+  struct one_symbol *symbols[256];  /* Pointers to symbols   */+};++/* Main variables */++float SymbolDist = 0.2f;  /* Distance between symbols (Variable constant) */+float SymbolDepth = 0.2f; /* Symbol Depth in 3D space (Variable constant) */+float SpaceSize = 2.0f;   /* Space size (Variable constant)               */++/* Array of font pointers, up to MAX_FONTS fonts can be loaded at once */+/* if (fonts[i] == NULL) then this font is not present in memory */+struct glf_font *fonts[MAX_FONTS];+int curfont; /* Index of current font pointer */+char ap = GLF_CENTER; /* Anchor point */+char console_msg = GLF_NO;+char texturing = GLF_NO;+char contouring = GLF_NO;+struct color contouring_color;++/* Console mode variables */+int conWidth, conHeight; /* Console width and height */+int conx = 0, cony = 0;  /* Console current X and Y */+char *conData;           /* Console data */+int conFont;             /* Console font */+char conCursor = GLF_NO; /* Console cursor Enabled|Disabled */+int conCursorBlink;          /* Console cursor blink rate */+int conCursorCount;          /* Console cursor blink counter */+char conCursorMode = GLF_NO; /* Console Cursor mode (on/off screen) */++void glfInit()+{+/*+  Initialization of GLF library+  This function should be called before use of this library+*/+  int i;++  for (i=0; i<MAX_FONTS; i++) fonts[i] = NULL;+  curfont = -1;+  console_msg = GLF_NO;+  ap = GLF_CENTER; /* Set anchor point to center of each symbol */+  texturing = GLF_NO;  /* By default texturing is NOT Enabled */+  contouring = GLF_NO; /* By default contouring is NOT Enabled */+  memset(&contouring_color, 0, sizeof(struct color));+  conData = NULL;+  glfSetConsoleParam(40, 20);+  glfConsoleClear();+  glfEnable(GLF_CONSOLE_CURSOR);+  glfSetCursorBlinkRate(10);+}++int LittleEndian()+{+/* This function check that this machine is little endian+   Return value: 1 - little endian+                 0 - big endian+*/+  int endianTester = 1;+  char *endianChar = 0;++  endianChar = (char *)&endianTester;+  if (*endianChar) return 1;+  return 0;+}++int ReadFont(char *font_name, struct glf_font *glff)+{+/* +   This function read font file and store information in memory+   Return: GLF_OK - if all OK+   Return: GLF_ERROR - if any error +*/++  FILE *fontf;+  char buffer[64];+  int i, j;+  unsigned char temp, code, verts, fcets, lns;+  float tempfx, tempfy;+  unsigned char *tp;+  int LEndian; /* True if little endian machine */++  fontf = fopen(font_name, "rb");+  if (fontf == NULL) return GLF_ERROR;++  fread(buffer, 3, 1, fontf);+  buffer[3] = 0;+  if (strcmp(buffer, "GLF"))+  {+    if (console_msg) printf("Error reading font file: incorrect file format\n");+    return GLF_ERROR;+  }++  /* Check for machine */+  LEndian = LittleEndian();++  fread(glff->font_name, 96, 1, fontf);+  glff->font_name[96] = 0;++  fread(&glff->sym_total, 1, 1, fontf); /* Read total symbols in font */++  for (i=0; i<MAX_FONTS; i++) glff->symbols[i] = NULL;++  for (i=0; i<28; i++) fread(&temp, 1, 1, fontf);  /* Read unused data */++  /* Now start to read font data */+  +  for (i=0; i<glff->sym_total; i++)+  {+    fread(&code, 1, 1, fontf);  /* Read symbol code   */+    fread(&verts, 1, 1, fontf); /* Read vertexs count */+    fread(&fcets, 1, 1, fontf); /* Read facets count  */+    fread(&lns, 1, 1, fontf);   /* Read lines count   */++    if (glff->symbols[code] != NULL) +    {+      if (console_msg) printf("Error reading font file: encountered symbols in font\n");+      return GLF_ERROR;+    }++    glff->symbols[code] = (struct one_symbol *)malloc(sizeof(struct one_symbol));+    glff->symbols[code]->vdata = (float *)malloc(8*verts);+    glff->symbols[code]->fdata = (unsigned char *)malloc(3*fcets);+    glff->symbols[code]->ldata = (unsigned char *)malloc(lns);++    glff->symbols[code]->vertexs = verts;+    glff->symbols[code]->facets = fcets;+    glff->symbols[code]->lines = lns;++    /* Read vertexs data */+    glff->symbols[code]->leftx = 10;+    glff->symbols[code]->rightx = -10;+    glff->symbols[code]->topy = 10;+    glff->symbols[code]->bottomy = -10;++    for (j=0; j<verts; j++)+    {+      fread(&tempfx, 4, 1, fontf);+      fread(&tempfy, 4, 1, fontf);+          +      /* If machine is bigendian -> swap low and high words in+       tempfx and tempfy */+      if (!LEndian) +      {+        tp = (unsigned char *)&tempfx;+        temp = tp[0]; tp[0] = tp[3]; tp[3] = temp;+        temp = tp[1]; tp[1] = tp[2]; tp[2] = temp;+        tp = (unsigned char *)&tempfy;+        temp = tp[0]; tp[0] = tp[3]; tp[3] = temp;+        temp = tp[1]; tp[1] = tp[2]; tp[2] = temp;+      }+      glff->symbols[code]->vdata[j*2] = tempfx;+      glff->symbols[code]->vdata[j*2+1] = tempfy;++      if (tempfx < glff->symbols[code]->leftx) glff->symbols[code]->leftx = tempfx;+      if (tempfx > glff->symbols[code]->rightx) glff->symbols[code]->rightx = tempfx;+      if (tempfy < glff->symbols[code]->topy) glff->symbols[code]->topy = tempfy;+      if (tempfy > glff->symbols[code]->bottomy) glff->symbols[code]->bottomy = tempfy;+    }+    for (j=0; j<fcets; j++)+      fread(&glff->symbols[code]->fdata[j*3], 3, 1, fontf);+    for (j=0; j<lns; j++)+       fread(&glff->symbols[code]->ldata[j], 1, 1, fontf);+  }+  fclose(fontf);+  return GLF_OK;+}++int glfLoadFont(char *font_name)+{+/* +  Function loads font to memory from file+  Return value: GLF_ERROR  - if error+                >=0 - returned font descriptor (load success)+*/++  int i;+  char flag; /* Temporary flag */++  /* First we find free font descriptor */+  flag = 0; /* Descriptor not found yet */+  for (i=0; i<MAX_FONTS; i++)+    if (fonts[i] == NULL)+    {+      /* Initialize this font */+      fonts[i] = (struct glf_font *)malloc(sizeof(struct glf_font));+      flag = 1;+      break;+    }++  if (!flag) return GLF_ERROR; /* Free font not found */+  if (ReadFont(font_name, fonts[i]) == GLF_OK) +  {+    curfont = i; /* Set curfont to just loaded font */+    return i;+  }+  +  if (fonts[i] != NULL)+  {+    free(fonts[i]);+    fonts[i] = NULL;+  }+  return GLF_ERROR;+}++int glfUnloadFont()+{+/* +  Unload current font from memory+  Return value: GLF_OK  - if all OK+                GLF_ERROR -  if error+*/+  int i;+  +  if ((curfont<0) || (fonts[curfont] == NULL)) return GLF_ERROR;+  +  for (i=0; i<MAX_FONTS; i++)+  {+    if (fonts[curfont]->symbols[i] != NULL)+    {+      free(fonts[curfont]->symbols[i]->vdata);+      free(fonts[curfont]->symbols[i]->fdata);+      free(fonts[curfont]->symbols[i]->ldata);+      free(fonts[curfont]->symbols[i]);+    }+  }+  free(fonts[curfont]);+  fonts[curfont] = NULL;+  curfont = -1;+  return GLF_OK;+}++/* Unload font by font descriptor */+int glfUnloadFontD(int font_descriptor)+{+  int temp;++  if ((font_descriptor<0) || (fonts[font_descriptor] == NULL)) return GLF_ERROR;++  temp = curfont;+  curfont = font_descriptor;+  glfUnloadFont();+  if (temp != font_descriptor) curfont = temp;+  else curfont = -1;+  return GLF_OK;+}++void glfDrawWiredSymbol(char s)+{+  int i, cur_line;+  float *tvp; /* temporary vertex pointer */+  float x, y;+  +  if ((curfont < 0) || (fonts[curfont] == NULL)) return;+  if (fonts[curfont]->symbols[s] == NULL) return;++  glBegin(GL_LINE_LOOP);+  tvp = fonts[curfont]->symbols[s]->vdata;+  cur_line = 0;+  for (i=0; i<fonts[curfont]->symbols[s]->vertexs; i++)+  {+    x = *tvp;+    tvp++;+    y = *tvp;+    tvp++;+    anchor_proc(x, y, ap);+    glVertex2f(x, y);+    if (fonts[curfont]->symbols[s]->ldata[cur_line] == i)+    {+      glEnd();+      cur_line++;+      if (cur_line < fonts[curfont]->symbols[s]->lines) glBegin(GL_LINE_LOOP);+      else break; /* No more lines */+    }+  }+}++/* Draw wired symbol by font_descriptor */+void glfDrawWiredSymbolF(int font_descriptor, char s)+{+  int temp;++  temp = curfont;+  curfont = font_descriptor;+  glfDrawWiredSymbol(s);+  curfont = temp;+}++void DrawString(char *s, void (*funct) (char s))+{+  int i;+  float sda, sdb;++  if (!strcmp(s, "")) return;+  if (curfont == -1) return;++  glPushMatrix();+  for (i=0; i<(int)strlen(s); i++)+  {+    if (s[i] != ' ') (*funct) (s[i]);+    if ((fonts[curfont]->symbols[s[i]] == NULL) || (s[i] == ' '))+      glTranslatef(SpaceSize, 0, 0);+    else+    {+      if (i < ((int)strlen(s)-1))+      {+        if (s[i+1] == ' ') glTranslatef(SymbolDist, 0, 0);+        else+        {+          if (fonts[curfont]->symbols[s[i+1]] == NULL) continue;+          sda = fonts[curfont]->symbols[s[i]]->rightx;+          sdb = -fonts[curfont]->symbols[s[i+1]]->leftx;+          glTranslatef(sda+sdb+SymbolDist, 0, 0);+        }+      }+    }+  }+  glPopMatrix();+}+++void glfDrawWiredString(char *s)+{+  DrawString(s, &glfDrawWiredSymbol);+}++/* Draw wired string by font_descriptor */+void glfDrawWiredStringF(int font_descriptor, char *s)+{+  int temp;++  temp = curfont;+  curfont = font_descriptor;+  DrawString(s, &glfDrawWiredSymbol);+  curfont = temp;+}++void glfDrawSolidSymbol(char s)+{+  unsigned char *b; /* Face pointer   */+  float *vp;        /* Vertex pointer */+  int i, j;+  float x, y;+  float temp_color[4];++  if ((curfont<0) || (fonts[curfont] == NULL)) return;+  +  if (fonts[curfont]->symbols[s] == NULL) return;++  b = fonts[curfont]->symbols[s]->fdata;+  vp = fonts[curfont]->symbols[s]->vdata;+  +  glBegin(GL_TRIANGLES);   +  for (i=0; i<fonts[curfont]->symbols[s]->facets; i++)+  {+      for (j=0; j<3; j++)+      {+        x = vp[*b*2];+        y = vp[*b*2+1];+        anchor_proc(x, y, ap);+        if (texturing == GLF_YES) glTexCoord2f((x+1)/2, (y+1)/2);+        glVertex2f(x, y);+        b++;+      }+  }+  glEnd();++  /* Draw contour, if enabled */+  if (contouring == GLF_YES) +  {+    glGetFloatv(GL_CURRENT_COLOR, temp_color);+    glColor4f(contouring_color.r, contouring_color.g, contouring_color.b, contouring_color.a);+    glfDrawWiredSymbol(s);+    glColor4fv(temp_color);+  }+}++/* Draw solid symbol by font_descriptor */+void glfDrawSolidSymbolF(int font_descriptor, char s)+{+  int temp;++  temp = curfont;+  curfont = font_descriptor;+  glfDrawSolidSymbol(s);+  curfont = temp;+}++void glfDrawSolidString(char *s)+{+  DrawString(s, &glfDrawSolidSymbol);+}++/* Draw solid string by font_descriptor */+void glfDrawSolidStringF(int font_descriptor, char *s)+{+  int temp;++  temp = curfont;+  curfont = font_descriptor;+  DrawString(s, &glfDrawSolidSymbol);+  curfont = temp;+}++/* ------------ 3D Wired text drawing ---------------------- */++void glfDraw3DWiredSymbol(char s)+{+  int i, cur_line;+  float *tvp; /* temp vertex pointer */+  float x, y;+  +  if ((curfont<0) || (fonts[curfont] == NULL)) return;+  if (fonts[curfont]->symbols[(int)s] == NULL) return;++  glBegin(GL_LINE_LOOP);+  tvp = fonts[curfont]->symbols[s]->vdata;+  cur_line = 0;+  for (i=0; i<fonts[curfont]->symbols[s]->vertexs; i++)+  {+    x = *tvp;+    tvp++;+    y = *tvp;+    tvp++;+    anchor_proc(x, y, ap);+    glVertex3f(x, y, 1);+    if (fonts[curfont]->symbols[s]->ldata[cur_line] == i)+    {+      glEnd();+      cur_line++;+      if (cur_line < fonts[curfont]->symbols[s]->lines) glBegin(GL_LINE_LOOP);+      else break; /* No more lines */+    }+  }++  glBegin(GL_LINE_LOOP);+  tvp = fonts[curfont]->symbols[s]->vdata;+  cur_line = 0;+  for (i=0; i<fonts[curfont]->symbols[s]->vertexs; i++)+  {+    x = *tvp;+    tvp++;+    y = *tvp;+    tvp++;+    anchor_proc(x, y, ap);+    glVertex3f(x, y, 1+SymbolDepth);+    if (fonts[curfont]->symbols[s]->ldata[cur_line] == i)+    {+      glEnd();+      cur_line++;+      if (cur_line < fonts[curfont]->symbols[s]->lines) glBegin(GL_LINE_LOOP);+      else break; /* No more lines */+    }+  }++  glBegin(GL_LINES);+  tvp = fonts[curfont]->symbols[s]->vdata;+  for (i=0; i<fonts[curfont]->symbols[s]->vertexs; i++)+  {+    x = *tvp;+    tvp++;+    y = *tvp;+    tvp++;+    anchor_proc(x, y, ap);+    glVertex3f(x, y, 1);+    glVertex3f(x, y, 1+SymbolDepth);+  }+  glEnd();+}++/* Draw 3D wired symbol by font_descriptor */+void glfDraw3DWiredSymbolF(int font_descriptor, char s)+{+  int temp;++  temp = curfont;+  curfont = font_descriptor;+  glfDraw3DWiredSymbol(s);+  curfont = temp;+}++void glfDraw3DWiredString(char *s)+{+  DrawString(s, &glfDraw3DWiredSymbol);+}++/* Draw 3D wired string by font_descriptor */+void glfDraw3DWiredStringF(int font_descriptor, char *s)+{+  int temp;++  temp = curfont;+  curfont = font_descriptor;+  DrawString(s, &glfDraw3DWiredSymbol);+  curfont = temp;+}++/* ------------ 3D Solid text drawing ---------------------- */++void glfDraw3DSolidSymbol(char s)+{+  int i, j, cur_line, flag;+  float x, y, bx, by;+  unsigned char *b; /* Face pointer   */+  float *vp;        /* Vertex pointer */+  float *tvp;       /* temp vertex pointer */+  float temp_color[4];+  GLboolean light_temp;+  +  if ((curfont<0) || (fonts[curfont] == NULL)) return;+  if (fonts[curfont]->symbols[(int)s] == NULL) return;++  b = fonts[curfont]->symbols[s]->fdata;+  vp = fonts[curfont]->symbols[s]->vdata;++  glBegin(GL_TRIANGLES);   +  glNormal3f(0, 0, 1);+  for (i=0; i<fonts[curfont]->symbols[s]->facets; i++)+  {+    b += 2;+    for (j=0; j<3; j++)+    {+      x = vp[*b*2];+      y = vp[*b*2+1];+      anchor_proc(x, y, ap);+      glVertex3f(x, y, 1+SymbolDepth);+      b--;+    }+    b += 4;+  }+  glEnd();++  b = fonts[curfont]->symbols[s]->fdata;+  vp = fonts[curfont]->symbols[s]->vdata;+  +  glBegin(GL_TRIANGLES);   +  glNormal3f(0, 0, -1);+  for (i=0; i<fonts[curfont]->symbols[s]->facets; i++)+  {+      for (j=0; j<3; j++)+      {+        x = vp[*b*2];+        y = vp[*b*2+1];+        anchor_proc(x, y, ap);+        glVertex3f(x, y, 1);+        b++;+      }+  }+  glEnd();++  flag = 0;+  glBegin(GL_QUAD_STRIP);+  tvp = fonts[curfont]->symbols[s]->vdata;+  cur_line = 0;+  for (i=0; i<fonts[curfont]->symbols[s]->vertexs; i++)+  {+    x = *tvp;+    tvp++;+    y = *tvp;+    tvp++;+    if (!flag) +    {+      bx = x;+      by = y;+      flag = 1;+    }+    anchor_proc(x, y, ap);+    glNormal3f(x, y, 0);+    glVertex3f(x, y, 1);+    glVertex3f(x, y, 1+SymbolDepth);+    if (fonts[curfont]->symbols[s]->ldata[cur_line] == i)+    {+      anchor_proc(bx, by, ap);+      glVertex3f(bx, by, 1);+      glVertex3f(bx, by, 1+SymbolDepth);+      flag = 0;+      glEnd();+      cur_line++;+      if (cur_line < fonts[curfont]->symbols[s]->lines) glBegin(GL_QUAD_STRIP);+      else break; /* No more lines */+    }+  }++  /* Draw contour, if enabled */+  if (contouring == GLF_YES) +  {+    glGetBooleanv(GL_LIGHTING, &light_temp);+    glDisable(GL_LIGHTING);+    glGetFloatv(GL_CURRENT_COLOR, temp_color);+    glColor4f(contouring_color.r, contouring_color.g, contouring_color.b, contouring_color.a);+    glfDraw3DWiredSymbol(s);+    glColor4fv(temp_color);+    if (light_temp) glEnable(GL_LIGHTING);+  }+}++/* Draw 3D solid symbol by font_descriptor */+void glfDraw3DSolidSymbolF(int font_descriptor, char s)+{+  int temp;++  temp = curfont;+  curfont = font_descriptor;+  glfDraw3DSolidSymbol(s);+  curfont = temp;+}++void glfDraw3DSolidString(char *s)+{+  DrawString(s, &glfDraw3DSolidSymbol);+}++/* Draw 3D solid string by font_descriptor */+void glfDraw3DSolidStringF(int font_descriptor, char *s)+{+  int temp;++  temp = curfont;+  curfont = font_descriptor;+  DrawString(s, &glfDraw3DSolidSymbol);+  curfont = temp;+}++/* Get the size a string will have on screen */+void glfGetStringBoundsF(int fd, char *s, float *minx, float *miny, float *maxx, float *maxy)+{+  struct glf_font *font;+  int i;+  float sda, sdb, cw = 0, minxx = 10;+  float top = 10, bottom = -10;++  if (fd < 0 || fd > (MAX_FONTS-1)) return;+  font = fonts[fd];++  if (font == NULL) return;++  if (font->symbols[s[0]])+    minxx = font->symbols[s[0]]->leftx;+  else+    minxx = 0.0;++  for (i=0; i<(int)strlen(s); i++)+  {+    if ((font->symbols[s[i]] == NULL) || (s[i] == ' '))+      cw += SpaceSize;+    else+    {+      sdb = -font->symbols[(int)s[i]]->leftx;+      sda = font->symbols[(int)s[i]]->rightx;++      cw += sda+sdb+SymbolDist;++      /* Update top/bottom bounds */+      if (font->symbols[(int)s[i]]->bottomy > bottom)+        bottom = font->symbols[(int)s[i]]->bottomy;++      if (font->symbols[(int)s[i]]->topy < top)+        top = font->symbols[(int)s[i]]->topy;+    }+  }++  cw += minxx;++  if ((maxx) && (maxy))+  {+    *maxx = cw;+    *maxy = bottom;+    anchor_proc(maxx, maxy, ap);+  }++  if ((minx) && (miny))+  {+    *minx = minxx;+    *miny = top;+    anchor_proc(maxx, maxy, ap);+  }+}++void glfGetStringBounds(char *s, float *minx, float *miny, float *maxx, float *maxy)+{+  glfGetStringBoundsF(curfont, s, minx, miny, maxx, maxy);+}++void glfSetSymbolSpace(float sp)+{+  SymbolDist = sp;+}++float glfGetSymbolSpace()+{+  return SymbolDist;+}++void glfSetSpaceSize(float sp)+{+  SpaceSize = sp;+}++float glfGetSpaceSize()+{+  return SpaceSize;+}++void glfSetSymbolDepth(float dpth)+{+  SymbolDepth = dpth;+}++float glfGetSymbolDepth()+{+  return SymbolDepth;+}++int glfSetCurrentFont(int Font_Descriptor)+{+  if ((Font_Descriptor < 0) || (fonts[Font_Descriptor] == NULL)) return GLF_ERROR;+  +  curfont = Font_Descriptor;+  return GLF_OK;+}++int glfGetCurrentFont()+{+  return curfont;+}++void glfSetAnchorPoint(int anchp)+{+  if ((anchp >= GLF_LEFT_UP) && (anchp <= GLF_RIGHT_DOWN))+    ap = anchp;+}++void glfSetContourColor(float r, float g, float b, float a)+{+  contouring_color.r = r;+  contouring_color.g = g;+  contouring_color.b = b;+  contouring_color.a = a;+}++void glfEnable(int what)+{+  switch (what) +  {+    case GLF_CONSOLE_MESSAGES: console_msg = GLF_YES; break;+    case GLF_TEXTURING: texturing = GLF_YES; break;+    case GLF_CONSOLE_CURSOR: conCursor = GLF_YES; break;+    case GLF_CONTOURING: contouring = GLF_YES; break;+  }+}++void glfDisable(int what)+{+  switch (what) +  {+    case GLF_CONSOLE_MESSAGES: console_msg = GLF_NO; break;+    case GLF_TEXTURING: texturing = GLF_NO; break;+    case GLF_CONSOLE_CURSOR: conCursor = GLF_NO; break;+    case GLF_CONTOURING: contouring = GLF_NO; break;+  }+}++/* ---------------- Console functions ---------------------- */++void glfSetConsoleParam(int width, int height)+{+  if (conData) free(conData);++  conWidth = width;+  conHeight = height;+  conData = (char *)malloc(width*height);+  glfConsoleClear();+}++int glfSetConsoleFont(int Font_Descriptor)+{+  if ((Font_Descriptor < 0) || (fonts[Font_Descriptor] == NULL)) return GLF_ERROR;+  +  conFont = Font_Descriptor;+  return GLF_OK;+}++void glfConsoleClear()+{+  memset(conData, 0, conWidth*conHeight);+  conx = 0;+  cony = 0;+}++void glfPrint(char *s, int lenght)+{+  int i;++  for (i=0; i<lenght; i++)+  {+    if (s[i] > 31)+    {+      conData[cony*conWidth+conx] = s[i];+      conx++;+    } else+    if (s[i] == '\n') conx = conWidth;+    if (conx >= conWidth)+    {+      conx = 0;+      cony++;+      if (cony >= conHeight)+      {+        /* Shift all console contents up */+        memcpy(conData, &conData[conWidth], conWidth*(conHeight-1));+        /* Fill bottom line by spaces */+        memset(&conData[conWidth*(conHeight-1)], 0, conWidth);+        cony = conHeight-1;+      }+    }+  }+}++void glfPrintString(char *s)+{+  glfPrint(s, strlen(s));+}++void glfPrintChar(char s)+{+  glfPrint(&s, 1);+}++void glfConsoleDraw()+{+  int i, j;+  char s[512];++  for (i=0; i<conHeight; i++)+  {+    memcpy(s, &conData[i*conWidth], conWidth);+    s[conWidth] = 0;+    if ((conCursor == GLF_YES) && (i == cony))+    {+      conCursorCount--;+      if (conCursorCount < 0)+      {+        conCursorCount = conCursorBlink;+        if (conCursorMode == GLF_YES) conCursorMode = GLF_NO;+        else conCursorMode = GLF_YES;+      }++      if (conCursorMode == GLF_YES)+        for (j=0; j<conWidth; j++)+        {+        if (!s[j])+          {+           s[j] = '_'; /* Draw cursor */+           s[j+1] = 0;+           break;+          }+        }+    }+    glfDrawSolidStringF(conFont, s);+    glTranslatef(0, -2, 0);+  }+}++void glfSetCursorBlinkRate(int Rate)+{+  if (Rate > 0)+  {+    conCursorBlink = Rate;+    conCursorCount = Rate;+    conCursorMode = GLF_YES;+  }+}

@@ -0,0 +1,114 @@+/*+==============================================================================+|  GLF Library+|  Version 1.0 (Release)+| +|  Author: Roman Podobedov+|  Email: romka@ut.ee+|  WEB: www.ut.ee/~romka+|  Date: 17 August 2000+|  +|  Copyright (C) 2000, Romka Graphics+|  This library is freely distributable without any license or permissions.+|  You can use this library in any program (commercial, educational+|  or individual), but in each program, where You use this library, You +|  should to keep this header (author name and coordinates)!+==============================================================================+*/+#ifndef GLF_H+#define GLF_H++#ifdef __cplusplus+extern "C" {+#endif++/* CONSTANTS */++#define GLF_ERROR           -1+#define GLF_OK               0+#define GLF_YES              1+#define GLF_NO               2++#define GLF_CONSOLE_MESSAGES 10+#define GLF_TEXTURING        11+#define GLF_CONTOURING       12++#define GLF_LEFT_UP          20+#define GLF_LEFT_CENTER      21+#define GLF_LEFT_DOWN        22+#define GLF_CENTER_UP        23+#define GLF_CENTER_CENTER    24+#define GLF_CENTER_DOWN      25+#define GLF_RIGHT_UP         26+#define GLF_RIGHT_CENTER     27+#define GLF_RIGHT_DOWN       28+#define GLF_CENTER           24++/* Console constants */+#define GLF_CONSOLE_CURSOR   30++ /* Library initialization (must be called before any usage of library) */+void glfInit(); ++/* Font loading/unloading functions */+int  glfLoadFont(char *font_name);        /* Load font to memory*/+int  glfUnloadFont();                     /* Unload font from memory */+int  glfUnloadFontD(int font_descriptor); /* Unload font by font_descriptor */++/* Text drawing functions */+void glfDrawWiredSymbol(char s);    /* Draw wired symbol    */+void glfDrawWiredString(char *s);   /* Draw wired string    */+void glfDrawSolidSymbol(char s);    /* Draw solid symbol    */+void glfDrawSolidString(char *s);   /* Draw wired string    */+void glfDraw3DWiredSymbol(char s);  /* Draw 3D wired symbol */+void glfDraw3DWiredString(char *s); /* Draw 3D wired string */+void glfDraw3DSolidSymbol(char s);  /* Draw 3D solid symbol */+void glfDraw3DSolidString(char *s); /* Draw 3D solid string */++/* Text drawing functions by specified font */+void glfDrawWiredSymbolF(int font_descriptor, char s);+void glfDrawWiredStringF(int font_descriptor, char *s);+void glfDrawSolidSymbolF(int font_descriptor, char s);+void glfDrawSolidStringF(int font_descriptor, char *s);+void glfDraw3DWiredSymbolF(int font_descriptor, char s);+void glfDraw3DWiredStringF(int font_descriptor, char *s);+void glfDraw3DSolidSymbolF(int font_descriptor, char s);+void glfDraw3DSolidStringF(int font_descriptor, char *s);++/* Text control functions */+void glfGetStringBoundsF(int fd, char *s, float *minx, float *miny, float *maxx, float *maxy);+void glfGetStringBounds(char *s, float *minx, float *miny, float *maxx, float *maxy);++void  glfSetSymbolSpace(float sp);   /* Set space between symbols */+float glfGetSymbolSpace();           /* Get space between symbols */+void  glfSetSpaceSize(float sp);     /* Set space size            */+float glfGetSpaceSize();             /* Get current space size    */++void  glfSetSymbolDepth(float dpth); /* Set depth of 3D symbol */+float glfGetSymbolDepth();           /* Get depth of 3D symbol */+int   glfSetCurrentFont(int Font_Descriptor); /* Set current font */+int   glfGetCurrentFont();                    /* Get current font descriptor */++void  glfSetAnchorPoint(int anchp); /* Set symbol anchor point */+void glfSetContourColor(float r, float g, float b, float a); /* Contour color */+/* Enable/Disable GLF features */++void glfEnable(int what); /* Enable GLF feature 'what' */+void glfDisable(int what); /* Disable GLF feature 'what' */++/* Console functions */+void glfSetConsoleParam(int width, int height);+int  glfSetConsoleFont(int Font_Descriptor);+void glfConsoleClear();+void glfPrint(char *s, int lenght);+void glfPrintString(char *s);+void glfPrintChar(char s);++void glfConsoleDraw();+void glfSetCursorBlinkRate(int Rate);++#ifdef __cplusplus+};+#endif++#endif