diff options
author | Yann Herklotz Grave <git@yannherklotzgrave.com> | 2019-02-21 19:33:16 +0000 |
---|---|---|
committer | Yann Herklotz Grave <git@yannherklotzgrave.com> | 2019-02-21 19:33:16 +0000 |
commit | ec56fed98f691fe32de29e0cdbaa354cf9c3e79a (patch) | |
tree | 3e060cab235a650529ab34615e7e3bc8e104b135 /src/PFM.hs | |
parent | 711deffd693615530ec9a12f7c3e58682633e032 (diff) | |
download | pfm-master.tar.gz pfm-master.zip |
Diffstat (limited to 'src/PFM.hs')
-rw-r--r-- | src/PFM.hs | 152 |
1 files changed, 72 insertions, 80 deletions
@@ -10,37 +10,42 @@ Portability : POSIX Debevec PFM reader -} -module PFM ( PFMImage(..) - , PPMImage(..) - , PFMColour(..) - , PPMColour(..) - , parse - , encode - , encodePPM - , revColour - , gamma - , module PFM.Vec) where - -import Control.Applicative ((<|>)) -import Data.Attoparsec.ByteString (Parser) -import qualified Data.Attoparsec.ByteString as P -import Data.Binary.Get (runGet) -import Data.Binary.IEEE754 (getFloat32be, getFloat32le, - putFloat32le) -import Data.Binary.Put (runPut) -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.ByteString.Lazy (fromStrict) -import qualified Data.ByteString.Lazy as BL -import Data.Foldable (fold) -import Data.Functor ((<$>)) -import Data.Monoid ((<>)) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Data.Vector (Vector) -import qualified Data.Vector as V -import Data.Word (Word8) +module PFM + ( PFMImage(..) + , PPMImage(..) + , PFMColour(..) + , PPMColour(..) + , parse + , encode + , encodePPM + , revColour + , gamma + , module PFM.Vec + ) +where + +import Control.Applicative ( (<|>) ) +import Data.Attoparsec.ByteString ( Parser ) +import qualified Data.Attoparsec.ByteString as P +import Data.Binary.Get ( runGet ) +import Data.Binary.IEEE754 ( getFloat32be + , getFloat32le + , putFloat32le + ) +import Data.Binary.Put ( runPut ) +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as B +import Data.ByteString.Lazy ( fromStrict ) +import qualified Data.ByteString.Lazy as BL +import Data.Foldable ( fold ) +import Data.Functor ( (<$>) ) +import Data.Monoid ( (<>) ) +import Data.Text ( Text ) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Vector ( Vector ) +import qualified Data.Vector as V +import Data.Word ( Word8 ) import PFM.Vec type PFMColours = Vector (Vector PFMColour) @@ -80,16 +85,12 @@ matchText = P.string . T.encodeUtf8 magicNum :: Parser ImageType magicNum = do - match <- T.decodeUtf8 <$> (matchText "Pf" <|> matchText "PF") - if match == "Pf" - then return MonoImage - else return ColourImage + match <- T.decodeUtf8 <$> (matchText "Pf" <|> matchText "PF") + if match == "Pf" then return MonoImage else return ColourImage skipNewline :: Parser () -skipNewline = P.skip isNewline - where - isNewline w = w == 13 || w == 10 +skipNewline = P.skip isNewline where isNewline w = w == 13 || w == 10 skipSpace :: Parser () skipSpace = P.skip (== 32) @@ -104,51 +105,49 @@ num :: Parser Int num = decode <$> matchMult "0-9" endianness :: Parser Endianness -endianness = - getEnd . (<(0.0 :: Float)) . decode <$> matchMult "0-9.-" +endianness = getEnd . (< (0.0 :: Float)) . decode <$> matchMult "0-9.-" where getEnd True = Little getEnd False = Big float :: Endianness -> Parser Float -float e = - runGet conv . fromStrict <$> P.take 4 +float e = runGet conv . fromStrict <$> P.take 4 where conv = case e of - Big -> getFloat32be - Little -> getFloat32le + Big -> getFloat32be + Little -> getFloat32le header :: Parser (Int, Int, Endianness, ImageType) header = do - n <- magicNum - skipNewline - n1 <- num - skipSpace - n2 <- num - skipNewline - s <- endianness - skipNewline - return (n1, n2, s, n) + n <- magicNum + skipNewline + n1 <- num + skipSpace + n2 <- num + skipNewline + s <- endianness + skipNewline + return (n1, n2, s, n) parseColour :: Endianness -> Parser PFMColour parseColour e = do - ri <- float e - gi <- float e - bi <- float e - return $ PFMColour ri gi bi + ri <- float e + gi <- float e + bi <- float e + return $ PFMColour ri gi bi parseMono :: Endianness -> Parser PFMColour parseMono e = PFMMono <$> float e parser :: Parser PFMImage parser = do - (w, h, e, i) <- header - c <- V.fromList <$> (P.many1 . fmap V.fromList . P.count w) (fun i e) - return $ PFMImage w h c + (w, h, e, i) <- header + c <- V.fromList <$> (P.many1 . fmap V.fromList . P.count w) (fun i e) + return $ PFMImage w h c where fun i = case i of - ColourImage -> parseColour - MonoImage -> parseMono + ColourImage -> parseColour + MonoImage -> parseMono magicNumPFM :: PFMColours -> Text magicNumPFM v = case V.head $ V.head v of @@ -162,45 +161,38 @@ encFloat :: Float -> BL.ByteString encFloat = runPut . putFloat32le encodeColourPFM :: PFMColour -> BL.ByteString -encodeColourPFM (PFMColour ri gi bi) = - encFloat ri <> encFloat gi <> encFloat bi -encodeColourPFM (PFMMono m) = - encFloat m +encodeColourPFM (PFMColour ri gi bi) = encFloat ri <> encFloat gi <> encFloat bi +encodeColourPFM (PFMMono m ) = encFloat m encodeColourPPM :: PPMColour -> BL.ByteString -encodeColourPPM (PPMColour ri gi bi) = - BL.pack [ri, gi, bi] -encodeColourPPM (PPMMono m) = - BL.pack [m, m, m] +encodeColourPPM (PPMColour ri gi bi) = BL.pack [ri, gi, bi] +encodeColourPPM (PPMMono m ) = BL.pack [m, m, m] -- | Encode as a PFM file. Returns a lazy ByteString with the encoded -- result. encode :: PFMImage -> BL.ByteString -encode (PFMImage w h c) = - fromStrict (T.encodeUtf8 he) <> body +encode (PFMImage w h c) = fromStrict (T.encodeUtf8 he) <> body where - he = magicNumPFM c <> "\n" <> tShow w <> " " <> tShow h <> "\n-1.0\n" + he = magicNumPFM c <> "\n" <> tShow w <> " " <> tShow h <> "\n-1.0\n" body = fold . fold $ fmap encodeColourPFM <$> c -- | Encode as a PPM file. Returns a lazy ByteString which contains the encoded -- file. encodePPM :: PPMImage -> BL.ByteString -encodePPM (PPMImage w h c) = - fromStrict (T.encodeUtf8 he) <> body +encodePPM (PPMImage w h c) = fromStrict (T.encodeUtf8 he) <> body where - he = "P6" <> "\n" <> tShow w <> " " <> tShow h <> "\n255\n" + he = "P6" <> "\n" <> tShow w <> " " <> tShow h <> "\n255\n" body = fold . fold $ fmap encodeColourPPM <$> c -- | Parse a 'ByteString' into a 'PFMImage'. These can be mono colour images or -- RGB colour images. parse :: ByteString -> PFMImage parse s = case P.parseOnly parser s of - Left str -> error str - Right i -> i + Left str -> error str + Right i -> i revColour :: PFMImage -> PFMImage -revColour (PFMImage w h i) = - PFMImage w h $ V.reverse i +revColour (PFMImage w h i) = PFMImage w h $ V.reverse i gamma :: (Floating a) => a -> a -> a gamma g m = m ** (1 / g) |