diff --git a/Gamgine.cabal b/Gamgine.cabal new file mode 100644 --- /dev/null +++ b/Gamgine.cabal @@ -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 + + diff --git a/Gamgine/Bool.hs b/Gamgine/Bool.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Bool.hs @@ -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 <||> + + diff --git a/Gamgine/Control.hs b/Gamgine/Control.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Control.hs @@ -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 ? diff --git a/Gamgine/Coroutine.hs b/Gamgine/Coroutine.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Coroutine.hs @@ -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) + } diff --git a/Gamgine/Engine.hs b/Gamgine/Engine.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Engine.hs @@ -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) diff --git a/Gamgine/Font/GLF.hs b/Gamgine/Font/GLF.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Font/GLF.hs @@ -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 () diff --git a/Gamgine/Gfx.hs b/Gamgine/Gfx.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Gfx.hs @@ -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) diff --git a/Gamgine/Image/PNG.hs b/Gamgine/Image/PNG.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Image/PNG.hs @@ -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 diff --git a/Gamgine/Image/PNG/Internal/CRC.hs b/Gamgine/Image/PNG/Internal/CRC.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Image/PNG/Internal/CRC.hs @@ -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 diff --git a/Gamgine/Image/PNG/Internal/Filters.hs b/Gamgine/Image/PNG/Internal/Filters.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Image/PNG/Internal/Filters.hs @@ -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> doFilter' rest (y+1) + where up_filter !x + | x> doFilter' rest (y+1) + where avg_filter !x + | x> doFilter' rest (y+1) + where paeth_filter !x + | x 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) diff --git a/Gamgine/Image/PNG/Internal/Parser.hs b/Gamgine/Image/PNG/Internal/Parser.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Image/PNG/Internal/Parser.hs @@ -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 + + diff --git a/Gamgine/Lens/IORef.hs b/Gamgine/Lens/IORef.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Lens/IORef.hs @@ -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 diff --git a/Gamgine/Lens/State.hs b/Gamgine/Lens/State.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Lens/State.hs @@ -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 diff --git a/Gamgine/Math/Box.hs b/Gamgine/Math/Box.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Math/Box.hs @@ -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) diff --git a/Gamgine/Math/BoxTree.hs b/Gamgine/Math/BoxTree.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Math/BoxTree.hs @@ -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 diff --git a/Gamgine/Math/Matrix.hs b/Gamgine/Math/Matrix.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Math/Matrix.hs @@ -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 diff --git a/Gamgine/Math/Utils.hs b/Gamgine/Math/Utils.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Math/Utils.hs @@ -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) diff --git a/Gamgine/Math/Vect.hs b/Gamgine/Math/Vect.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Math/Vect.hs @@ -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 diff --git a/Gamgine/State/InputInfo.hs b/Gamgine/State/InputInfo.hs new file mode 100644 --- /dev/null +++ b/Gamgine/State/InputInfo.hs @@ -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) diff --git a/Gamgine/State/KeyInfo.hs b/Gamgine/State/KeyInfo.hs new file mode 100644 --- /dev/null +++ b/Gamgine/State/KeyInfo.hs @@ -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] + } diff --git a/Gamgine/State/MouseInfo.hs b/Gamgine/State/MouseInfo.hs new file mode 100644 --- /dev/null +++ b/Gamgine/State/MouseInfo.hs @@ -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] + } diff --git a/Gamgine/State/RenderState.hs b/Gamgine/State/RenderState.hs new file mode 100644 --- /dev/null +++ b/Gamgine/State/RenderState.hs @@ -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) diff --git a/Gamgine/State/State.hs b/Gamgine/State/State.hs new file mode 100644 --- /dev/null +++ b/Gamgine/State/State.hs @@ -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) + } diff --git a/Gamgine/State/StateTree.hs b/Gamgine/State/StateTree.hs new file mode 100644 --- /dev/null +++ b/Gamgine/State/StateTree.hs @@ -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) diff --git a/Gamgine/State/StateTreeZipper.hs b/Gamgine/State/StateTreeZipper.hs new file mode 100644 --- /dev/null +++ b/Gamgine/State/StateTreeZipper.hs @@ -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 diff --git a/Gamgine/System.hs b/Gamgine/System.hs new file mode 100644 --- /dev/null +++ b/Gamgine/System.hs @@ -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 diff --git a/Gamgine/Utils.cpp b/Gamgine/Utils.cpp new file mode 100644 --- /dev/null +++ b/Gamgine/Utils.cpp @@ -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}) diff --git a/Gamgine/Utils.hs b/Gamgine/Utils.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Utils.hs @@ -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 diff --git a/Gamgine/Zipper.hs b/Gamgine/Zipper.hs new file mode 100644 --- /dev/null +++ b/Gamgine/Zipper.hs @@ -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 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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 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. diff --git a/Ressources/Fonts/aksent1.glf b/Ressources/Fonts/aksent1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/aksent1.glf differ diff --git a/Ressources/Fonts/alpine1.glf b/Ressources/Fonts/alpine1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/alpine1.glf differ diff --git a/Ressources/Fonts/arial1.glf b/Ressources/Fonts/arial1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/arial1.glf differ diff --git a/Ressources/Fonts/broadway1.glf b/Ressources/Fonts/broadway1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/broadway1.glf differ diff --git a/Ressources/Fonts/chicago1.glf b/Ressources/Fonts/chicago1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/chicago1.glf differ diff --git a/Ressources/Fonts/compact1.glf b/Ressources/Fonts/compact1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/compact1.glf differ diff --git a/Ressources/Fonts/courier1.glf b/Ressources/Fonts/courier1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/courier1.glf differ diff --git a/Ressources/Fonts/cricket1.glf b/Ressources/Fonts/cricket1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/cricket1.glf differ diff --git a/Ressources/Fonts/crystal1.glf b/Ressources/Fonts/crystal1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/crystal1.glf differ diff --git a/Ressources/Fonts/garamond1.glf b/Ressources/Fonts/garamond1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/garamond1.glf differ diff --git a/Ressources/Fonts/gothic1.glf b/Ressources/Fonts/gothic1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/gothic1.glf differ diff --git a/Ressources/Fonts/penta1.glf b/Ressources/Fonts/penta1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/penta1.glf differ diff --git a/Ressources/Fonts/present_script1.glf b/Ressources/Fonts/present_script1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/present_script1.glf differ diff --git a/Ressources/Fonts/techno0.glf b/Ressources/Fonts/techno0.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/techno0.glf differ diff --git a/Ressources/Fonts/techno1.glf b/Ressources/Fonts/techno1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/techno1.glf differ diff --git a/Ressources/Fonts/times_new1.glf b/Ressources/Fonts/times_new1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/times_new1.glf differ diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/c_libraries/glf/glf.c b/c_libraries/glf/glf.c new file mode 100644 --- /dev/null +++ b/c_libraries/glf/glf.c @@ -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 +#endif + +#include +#include +#include +#include +#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; ifont_name, 96, 1, fontf); + glff->font_name[96] = 0; + + fread(&glff->sym_total, 1, 1, fontf); /* Read total symbols in font */ + + for (i=0; isymbols[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; isym_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 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; jsymbols[code]->fdata[j*3], 3, 1, fontf); + for (j=0; jsymbols[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; isymbols[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; isymbols[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; isymbols[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; isymbols[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; isymbols[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; isymbols[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; isymbols[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; isymbols[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; isymbols[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 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 0) + { + conCursorBlink = Rate; + conCursorCount = Rate; + conCursorMode = GLF_YES; + } +} diff --git a/c_libraries/glf/glf.h b/c_libraries/glf/glf.h new file mode 100644 --- /dev/null +++ b/c_libraries/glf/glf.h @@ -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