diff --git a/Gamgine.cabal b/Gamgine.cabal --- a/Gamgine.cabal +++ b/Gamgine.cabal @@ -1,5 +1,5 @@ name: Gamgine -version: 0.5 +version: 0.5.1 cabal-version: >=1.6 build-type: Simple license: BSD3 @@ -16,33 +16,12 @@ 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 >=1.0 && <1.5, - OpenGLRaw >=1.4.0.0 && <1.6, - mtl >=2.1.3.1 && <2.3, - time >=1.4.0.1 && <1.6, - 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.2, - array >=0.4.0.1 && <0.6, - 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.5, - 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 @@ -72,8 +51,27 @@ Gamgine.Zipper Gamgine.Lens.IORef Gamgine.Lens.State - exposed: True - buildable: True + build-depends: + base >3 && <5, + GLFW-b >=1.0 && <1.5, + OpenGLRaw >=3.0.0.0 && <3.3, + mtl >=2.1.3.1 && <2.3, + time >=1.4.0.1 && <1.7, + 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.2, + array >=0.4.0.1 && <0.6, + bytestring >=0.10.0.2 && <0.11, + unordered-containers >=0.2.4.0 && <0.3, + data-lens >=2.10.4 && <2.12, + pretty-show >=1.6.7 && <1.7, + cpphs >=1.18.4 && <1.21, + filepath >=1.3.0.1 && <1.5, + parsec >=3.1.5 && <3.2, + zlib >=0.5.4.1 && <0.7, + ListZipper >=1.2.0.2 && <1.3, + composition >=1.0.1.0 && <1.1 cpp-options: -DCABAL cc-options: -Wno-unused-result c-sources: @@ -83,5 +81,4 @@ glf.h include-dirs: . Gamgine c_libraries/glf ghc-options: -pgmPcpphs -optP--cpp - - + diff --git a/Gamgine/Engine.hs b/Gamgine/Engine.hs --- a/Gamgine/Engine.hs +++ b/Gamgine/Engine.hs @@ -10,16 +10,16 @@ mkUpdateLoop ticksPerSecond maxFrameSkip update = \nextFrame -> loop nextFrame 0 where loop nextFrame skippedFrames = do - time <- liftIO (fromMaybe nextFrame <$> 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) + time <- liftIO (fromMaybe nextFrame <$> 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 + (time - skipTicks - nextFrame) / skipTicks skipTicks = 1 / (fromIntegral ticksPerSecond :: Double) diff --git a/Gamgine/Gfx.hs b/Gamgine/Gfx.hs --- a/Gamgine/Gfx.hs +++ b/Gamgine/Gfx.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module Gamgine.Gfx where -import Graphics.Rendering.OpenGL.Raw +import Graphics.GL import Control.Monad (forM_) import Data.Either import Foreign.Marshal.Utils @@ -126,7 +126,7 @@ drawQuad :: Tuple3d a => a -> a -> IO () drawQuad min max = do - draw gl_QUADS [(minX, minY, 0 :: Double), (maxX, minY, 0 :: Double), + draw GL_QUADS [(minX, minY, 0 :: Double), (maxX, minY, 0 :: Double), (maxX, maxY, 0 :: Double), (minX, maxY, 0 :: Double)] where minX = t3d_first min @@ -145,7 +145,7 @@ drawPoint :: Tuple3d a => a -> RGB -> IO () drawPoint pos color = do glPointSize 10 - glBegin gl_POINTS + glBegin GL_POINTS glVertex3f <<< pos glEnd @@ -164,9 +164,9 @@ withPolyMode :: GLenum -> IO () -> IO () withPolyMode mode act = do - glPolygonMode gl_FRONT_AND_BACK mode + glPolygonMode GL_FRONT_AND_BACK mode act - glPolygonMode gl_FRONT_AND_BACK gl_FILL + glPolygonMode GL_FRONT_AND_BACK GL_FILL withEnabled :: GLenum -> IO () -> IO () withEnabled mode act = do @@ -177,12 +177,12 @@ withBlend :: GLenum -> GLenum -> IO () -> IO () withBlend srcFactor dstFactor act = do glBlendFunc srcFactor dstFactor - withEnabled gl_BLEND act + withEnabled GL_BLEND act withTexture2d :: GLuint -> IO () -> IO () withTexture2d id act = do - glBindTexture gl_TEXTURE_2D id - withEnabled gl_TEXTURE_2D act + glBindTexture GL_TEXTURE_2D id + withEnabled GL_TEXTURE_2D act makeTexture2d :: FilePath -> GLenum -> IO GLuint makeTexture2d file wrapMode = do @@ -194,24 +194,24 @@ genTex img = do let (width, height) = dimensions img imgData = imageData img - format = hasAlphaChannel img ? gl_RGBA $ gl_RGB + 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) + 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) + 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 + 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) diff --git a/Gamgine/Image/PNG.hs b/Gamgine/Image/PNG.hs --- a/Gamgine/Image/PNG.hs +++ b/Gamgine/Image/PNG.hs @@ -41,7 +41,7 @@ import Data.Char import System.IO -import Control.Monad.Error +import Control.Monad.Except import Gamgine.Image.PNG.Internal.Parser import Gamgine.Image.PNG.Internal.CRC @@ -180,7 +180,7 @@ case mapM toPngChunk chunks >>= return . partition isIDAT of Right (_, []) -> return $ Left "File has no chunks!" Right (dataChunks, hdr:otherChunks) -> do - let dataDecompressed = decompress . LBS.unLSB . LBS.concat . map idat_data $ dataChunks + let dataDecompressed = decompress . LBS.unLBS . LBS.concat . map idat_data $ dataChunks bpp = bytesPerPixel (ihdr_colorType hdr) (ihdr_bitDepth hdr) w = fromIntegral (ihdr_width hdr) h = fromIntegral (ihdr_height hdr) diff --git a/Gamgine/Image/PNG/Internal/LBS.hs b/Gamgine/Image/PNG/Internal/LBS.hs --- a/Gamgine/Image/PNG/Internal/LBS.hs +++ b/Gamgine/Image/PNG/Internal/LBS.hs @@ -21,7 +21,7 @@ import qualified Data.ByteString.Lazy.Char8 as C import Control.Applicative ((<$>)) -newtype LBS = LBS { unLSB :: LB.ByteString } deriving (Show) +newtype LBS = LBS { unLBS :: LB.ByteString } deriving (Show) instance (Monad m) => Stream LBS m Word8 where uncons = return . uncons' @@ -32,30 +32,30 @@ Nothing -> Nothing unpack :: LBS -> [Word8] -unpack = LB.unpack . unLSB +unpack = LB.unpack . unLBS unpackToString :: LBS -> String -unpackToString = C.unpack . unLSB +unpackToString = C.unpack . unLBS splitAt :: Int64 -> LBS -> (LBS, LBS) splitAt idx (LBS bs) = let (bs1, bs2) = LB.splitAt idx bs - in (LBS bs1, LBS bs2) + in (LBS bs1, LBS bs2) readFile :: FilePath -> IO LBS readFile fp = LBS <$> LB.readFile fp concat :: [LBS] -> LBS -concat = LBS . LB.concat . map unLSB +concat = LBS . LB.concat . map unLBS pack :: [Word8] -> LBS pack = LBS . LB.pack null :: LBS -> Bool -null = LB.null . unLSB +null = LB.null . unLBS head :: LBS -> Word8 -head = LB.head . unLSB +head = LB.head . unLBS tail :: LBS -> LBS -tail = LBS . LB.tail . unLSB +tail = LBS . LB.tail . unLBS diff --git a/Gamgine/Math/Box.hs b/Gamgine/Math/Box.hs --- a/Gamgine/Math/Box.hs +++ b/Gamgine/Math/Box.hs @@ -59,7 +59,7 @@ 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) + 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 diff --git a/Gamgine/Math/BoxTree.hs b/Gamgine/Math/BoxTree.hs --- a/Gamgine/Math/BoxTree.hs +++ b/Gamgine/Math/BoxTree.hs @@ -6,8 +6,8 @@ import Debug.Trace data BoxTree a = Node B.Box [BoxTree a] - | Leaf B.Box a - deriving (Show) + | Leaf B.Box a + deriving (Show) -- intersection details data Intersection a = Intersection { @@ -22,21 +22,21 @@ 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 = [] + | 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 = [] + | 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 = [] + | 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 = [] +-- | 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 diff --git a/Gamgine/State/RenderState.hs b/Gamgine/State/RenderState.hs --- a/Gamgine/State/RenderState.hs +++ b/Gamgine/State/RenderState.hs @@ -3,7 +3,7 @@ #include "Gamgine/Utils.cpp" import Control.Applicative ((<$>)) import qualified Data.List as L -import qualified Graphics.Rendering.OpenGL.Raw as GL +import qualified Graphics.GL as GL import qualified Gamgine.Font.GLF as GLF IMPORT_LENS_AS_LE diff --git a/Gamgine/System.hs b/Gamgine/System.hs --- a/Gamgine/System.hs +++ b/Gamgine/System.hs @@ -21,8 +21,8 @@ getEnvOrDefault envVar defaultValue = do result <- try $ getEnv envVar case result of - Right value -> return value - Left (_ :: IOError) -> return defaultValue + Right value -> return value + Left (_ :: IOError) -> return defaultValue appDirectory = normalizedProgName >>= \pn -> getAppUserDataDirectory pn diff --git a/Gamgine/Utils.hs b/Gamgine/Utils.hs --- a/Gamgine/Utils.hs +++ b/Gamgine/Utils.hs @@ -29,7 +29,7 @@ errorsToStderr :: IO () -> IO () errorsToStderr action = catch action (\e -> do pn <- normalizedProgName - hPutStrLn stderr ("\n" ++ pn ++ ": " ++ show (e :: SomeException))) + hPutStrLn stderr ("\n" ++ pn ++ ": " ++ show (e :: SomeException))) showValue :: Show a => String -> a -> String showValue name value = name ++ ": " ++ (show value) ++ "\n"