Gamgine 0.4.1 → 0.5

raw patch · 7 files changed

+108/−46 lines, 7 filesdep ~StateVardep ~filepathdep ~mtlPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: StateVar, filepath, mtl, parsec, time

API changes (from Hackage documentation)

Files

• Gamgine.cabal +7/−6
• Gamgine/Image/PNG.hs +14/−14
• Gamgine/Image/PNG/Internal/CRC.hs +7/−6
• Gamgine/Image/PNG/Internal/Filters.hs +1/−1
• Gamgine/Image/PNG/Internal/LBS.hs +61/−0
• Gamgine/Image/PNG/Internal/Parser.hs +16/−19
• Gamgine/Math/Vect.hs +2/−0

@@ -1,5 +1,5 @@ name: Gamgine-version: 0.4.1+version: 0.5 cabal-version: >=1.6 build-type: Simple license: BSD3@@ -26,20 +26,20 @@         base >3 && <5,         GLFW-b >=1.0 && <1.5,         OpenGLRaw >=1.4.0.0 && <1.6,-        mtl >=2.1.3.1 && <2.2,-        time >=1.4.0.1 && <1.5,+        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.1,+        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.4,-        parsec ==3.1.5,+        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@@ -65,6 +65,7 @@         Gamgine.Engine         Gamgine.Image.PNG.Internal.Filters         Gamgine.Image.PNG.Internal.Parser+        Gamgine.Image.PNG.Internal.LBS         Gamgine.Image.PNG.Internal.CRC         Gamgine.Image.PNG         Gamgine.System

@@ -3,7 +3,7 @@ -- Module      :  Graphics.Formats.PNG -- Copyright   :  (c) Marko Lauronen 2008 -- License     :  BSD--- +-- -- Maintainer  :  marko.lauronen@pp1.inet.fi -- Stability   :  experimental -- Portability :  non-portable (GHC only)@@ -37,8 +37,6 @@ 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@@ -48,6 +46,8 @@ import Gamgine.Image.PNG.Internal.Parser import Gamgine.Image.PNG.Internal.CRC import Gamgine.Image.PNG.Internal.Filters+import qualified Gamgine.Image.PNG.Internal.LBS as LBS+import Gamgine.Image.PNG.Internal.LBS (LBS)  -- | Type for raw PNG chunks -- The parsing happens in two phases: first the file is read into@@ -56,7 +56,7 @@ -- with raw chunk data. data RawPNGChunk = RawPNGChunk {       rawPngChunk_type  :: !String,-      rawPngChunk_data  :: !LB.ByteString+      rawPngChunk_data  :: !LBS     } deriving (Show)  type Width  = Word32@@ -76,7 +76,7 @@   | PLTE {       plte_entries :: !(Array Word8 Rgb) }   | IDAT {-      idat_data :: !LB.ByteString }+      idat_data :: !LBS }   | UnknownChunk RawPNGChunk    -- chunk types not supported yet   | IEND     deriving (Show)@@ -102,8 +102,8 @@  -- | Raw chunk parsing -pngHeaderBytes :: LB.ByteString-pngHeaderBytes = LB.pack [137, 80, 78, 71, 13, 10, 26, 10]+pngHeaderBytes :: LBS+pngHeaderBytes = LBS.pack [137, 80, 78, 71, 13, 10, 26, 10]  pngFile :: Parser [RawPNGChunk] pngFile = do@@ -119,9 +119,9 @@   len <- anyWord32   chunkType <- block 4   chunkData <- block (fromIntegral len)-  let expectedCrc = crc (LB.concat [chunkType,chunkData])+  let expectedCrc = crc (LBS.concat [chunkType,chunkData])   word32 expectedCrc <?> "valid crc"-  return $ RawPNGChunk (C.unpack chunkType) chunkData+  return $ RawPNGChunk (LBS.unpackToString chunkType) chunkData  -- | Final chunk parsing @@ -142,12 +142,12 @@   --[(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)] +  compressionMethod <- allowedValues word8 [(0, Deflate)]                        <?> "valid compression method: supported Deflate"-  filterMethod <- allowedValues word8 [(0, Adaptive)] +  filterMethod <- allowedValues word8 [(0, Adaptive)]                   <?> "valid filter method: supported Adaptive"-  -- [(0, NoInterlace), (1, Adam7)] -  interlaceMethod <- allowedValues word8 [(0, NoInterlace)] +  -- [(0, NoInterlace), (1, Adam7)]+  interlaceMethod <- allowedValues word8 [(0, NoInterlace)]                      <?> "valid interlace method: supported NoInterlace"   return $ IHDR {                ihdr_width = width@@ -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 . LB.concat . map idat_data $ dataChunks+                      let dataDecompressed = decompress . LBS.unLSB . LBS.concat . map idat_data $ dataChunks                           bpp = bytesPerPixel (ihdr_colorType hdr) (ihdr_bitDepth hdr)                           w = fromIntegral (ihdr_width hdr)                           h = fromIntegral (ihdr_height hdr)

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

@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BangPatterns, FlexibleContexts #-}  module Gamgine.Image.PNG.Internal.Filters (defilter_scanlines_arr) where 

@@ -0,0 +1,61 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}++module Gamgine.Image.PNG.Internal.LBS+    ( LBS(..)+    , unpack+    , unpackToString+    , splitAt+    , readFile+    , concat+    , pack+    , null+    , head+    , tail+    ) where++import Prelude hiding (splitAt, readFile, concat, null, head, tail)+import Text.Parsec.Prim (Stream(..))+import Data.Word+import Data.Int (Int64)+import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString.Lazy.Char8 as C+import Control.Applicative ((<$>))++newtype LBS = LBS { unLSB :: LB.ByteString } deriving (Show)++instance (Monad m) => Stream LBS m Word8 where+    uncons = return . uncons'++uncons' :: LBS -> Maybe (Word8, LBS)+uncons' (LBS bs) = case LB.uncons bs of+    Just (w, bs) -> Just (w, LBS bs)+    Nothing      -> Nothing++unpack :: LBS -> [Word8]+unpack = LB.unpack . unLSB++unpackToString :: LBS -> String+unpackToString = C.unpack . unLSB++splitAt :: Int64 -> LBS -> (LBS, LBS)+splitAt idx (LBS bs) =+    let (bs1, bs2) = LB.splitAt idx bs+	in (LBS bs1, LBS bs2)++readFile :: FilePath -> IO LBS+readFile fp = LBS <$> LB.readFile fp++concat :: [LBS] -> LBS+concat = LBS . LB.concat . map unLSB++pack :: [Word8] -> LBS+pack = LBS . LB.pack++null :: LBS -> Bool+null = LB.null . unLSB++head :: LBS -> Word8+head = LB.head . unLSB++tail :: LBS -> LBS+tail = LBS . LB.tail . unLSB

@@ -9,66 +9,63 @@ import Data.Bits import Numeric (showHex) +import qualified Gamgine.Image.PNG.Internal.LBS as LBS+import Gamgine.Image.PNG.Internal.LBS (LBS) 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 ()+type Parser = Parsec LBS () -word8 :: (Stream LB.ByteString m Word8) => Word8 -> ParsecT LB.ByteString u m Word8+word8 :: (Stream LBS m Word8) => Word8 -> ParsecT LBS u m Word8 word8 = satisfy . (==) -word16 :: (Stream LB.ByteString m Word8) => Word16 -> ParsecT LB.ByteString u m Word16+word16 :: (Stream LBS m Word8) => Word16 -> ParsecT LBS 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 :: (Stream LBS m Word8) => Word32 -> ParsecT LBS 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 :: (Stream LBS m Word8) => (Word8 -> Bool) -> ParsecT LBS 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 :: (Stream LBS m Word8) => ParsecT LBS u m Word8 anyWord8 = anyToken -anyWord16 :: (Stream LB.ByteString m Word8) => ParsecT LB.ByteString u m Word16+anyWord16 :: (Stream LBS m Word8) => ParsecT LBS 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 :: (Stream LBS m Word8) => ParsecT LBS 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+string :: (Stream LBS m Word8) => LBS -> ParsecT LBS u m LBS+string s = mapM_ word8 (LBS.unpack s) >> return s -block :: (Stream LB.ByteString m Word8) => Int -> ParsecT LB.ByteString u m LB.ByteString+block :: (Stream LBS m Word8) => Int -> ParsecT LBS u m LBS block size = do  -- count size anyWord8 >>= return . LB.pack   i <- getInput-  let (s,r) = LB.splitAt (fromIntegral size) i+  let (s,r) = LBS.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) +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+    = do input <- LBS.readFile fname          return $ case runP p () fname input of                     Left err  -> Left (show err)                     Right x   -> Right x--

@@ -1,3 +1,5 @@+{-# LANGUAGE FlexibleContexts #-}+ 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