png-file 0.0.1.0 → 0.0.1.1

raw patch · 2 files changed

+85/−2 lines, 2 files

Files

• png-file.cabal +3/−2
• src/File/Binary/PNG/DataChunks.hs +82/−0

@@ -2,7 +2,7 @@ cabal-version:	>= 1.8  name:		png-file-version:	0.0.1.0+version:	0.0.1.1 stability:	Experimental author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>@@ -24,7 +24,7 @@ source-repository	this     type:	git     location:	git://github.com/YoshikuniJujo/png-file.git-    tag:	0.0.1.0+    tag:	0.0.1.1  library     hs-source-dirs:	src@@ -34,6 +34,7 @@         File.Binary.PNG.Chunks,         File.Binary.PNG.Chunks.CRC,         File.Binary.PNG.Chunks.Each,+        File.Binary.PNG.DataChunks         Language.Haskell.TH.Tools     build-depends:         base > 3 && < 5, binary-file, bytestring, zlib, array,

@@ -0,0 +1,82 @@+module File.Binary.PNG.DataChunks (+	module File.Binary.PNG.Chunks,+	makePNGHeader,+	bsToPNGImage,+	pngImageToBS,+	PNGImageL(..),+	PNGImageLColor(..),+	readIccp+) where++import File.Binary.PNG.Data+import File.Binary.PNG.Chunks+import Data.Bits+import qualified Data.ByteString.Lazy as BSL+import Data.List++bsToPNGImage :: PNGImage pi =>+	IHDR -> Maybe PLTE -> Maybe TRNS -> BSL.ByteString -> Either String pi+bsToPNGImage ihdr plte trns bs = do+	h <- makePNGHeader ihdr plte trns+	return $ makePNGImage h bs++pngImageToBS :: PNGImage pi => pi -> (IHDR, Maybe TRNS, BSL.ByteString)+pngImageToBS pi = let+	(header, bs) = fromPNGImage pi+	(ihdr, trns) = fromPNGHeader header in+	(ihdr, trns, bs)++makePNGHeader :: IHDR -> Maybe PLTE -> Maybe TRNS -> Either String PNGHeader+makePNGHeader ihdr plte trns = do+	ct <- getColorType (alpha ihdr) (color ihdr) (palet ihdr) trns+	return PNGHeader {+		pngWidth = width ihdr,+		pngHeight = height ihdr,+		pngDepth = depth ihdr,+		pngColorType = ct,+		pngCompType = compressionType ihdr,+		pngFilterType = filterType ihdr,+		pngInterlaceType = interlaceType ihdr,+		pngPalette = maybe [] plteToInts plte+	 }++plteToInts :: PLTE -> [(Int, Int, Int)]+plteToInts = map (\(RGB8 r g b) -> (fi r, fi g, fi b)) . colors+	where+	fi = fromIntegral++fromPNGHeader :: PNGHeader -> (IHDR, Maybe TRNS)+fromPNGHeader ph@PNGHeader { pngColorType = PNGTypeColor Nothing } = (IHDR {+	width = pngWidth ph,+	height = pngHeight ph,+	depth = pngDepth ph,+	alpha = False,+	color = True,+	palet = False,+	compressionType = 0,+	filterType = 0,+	interlaceType = 0 }, Nothing)+getTRNSChunk :: [Chunk] -> Maybe Chunk+getTRNSChunk = find ((== T_tRNS) . typeChunk)++getColorType :: Bool -> Bool -> Bool -> Maybe TRNS -> Either String PNGColorType+getColorType False True True = return . PNGTypeIndex . maybe [] readTRNSi+getColorType False False False = return . PNGTypeGrey . fmap readTRNSg+getColorType False True False = return . PNGTypeColor . fmap readTRNSc+getColorType True False False = const $ return PNGTypeGreyAlpha+getColorType True True False = const $ return PNGTypeColorAlpha+getColorType _ _ _ = fail "bad colortype"++readTRNSi :: TRNS -> [Int]+readTRNSi = map fromIntegral . BSL.unpack . dat++readTRNSg :: TRNS -> Int+readTRNSg t = let [h, l] = map fromIntegral $ BSL.unpack $ dat t in+	h `shiftL` 8 .|. l++readTRNSc :: TRNS -> (Int, Int, Int)+readTRNSc t = let+	[rh, rl, gh, gl, bh, bl] = map fromIntegral $ BSL.unpack $ dat t in (+		rh `shiftL` 8 .|. rl,+		gh `shiftL` 8 .|. gl,+		bh `shiftL` 8 .|. bl)