From 1dcdd6d2da9aa0ab9772986e72d69fd6f8ae5496 Mon Sep 17 00:00:00 2001
From: Yann Herklotz <ymherklotz@gmail.com>
Date: Tue, 29 Jan 2019 22:08:23 +0000
Subject: Implement saving

---
 app/Main.hs |  8 +++++---
 src/PFM.hs  | 38 +++++++++++++++++++++++++++++++++-----
 2 files changed, 38 insertions(+), 8 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 22c0fba..9c75d6f 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,10 +1,12 @@
 module Main where
 
-import qualified Data.ByteString as B
-import qualified Data.Text       as T
+import qualified Data.ByteString      as B
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Text            as T
 import           PFM
 
 main :: IO ()
 main = do
   s <- B.readFile "/home/yannherklotz/Imperial/AdvancedGraphics/coursework1/CO417-Assignment1/UrbanProbe/urbanEM_latlong.pfm"
-  parse s
+  let i = parse s
+  BL.writeFile "random.pfm" $ encode i
diff --git a/src/PFM.hs b/src/PFM.hs
index 478a5fb..bf805a5 100644
--- a/src/PFM.hs
+++ b/src/PFM.hs
@@ -17,10 +17,14 @@ import           Control.Monad              (void)
 import           Data.Attoparsec.ByteString (Parser)
 import qualified Data.Attoparsec.ByteString as P
 import           Data.Binary.Get            (runGet)
-import           Data.Binary.IEEE754        (getFloat32be, getFloat32le)
+import           Data.Binary.IEEE754        (getFloat32be, getFloat32le,
+                                             putFloat32be, putFloat32le)
+import           Data.Binary.Put            (runPut)
 import           Data.ByteString            (ByteString)
 import qualified Data.ByteString            as B
-import           Data.ByteString.Lazy       (fromStrict)
+import           Data.ByteString.Lazy       (fromStrict, toStrict)
+import qualified Data.ByteString.Lazy       as BL
+import           Data.Foldable              (fold)
 import           Data.Text                  (Text)
 import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as T
@@ -117,7 +121,31 @@ parser = do
       ColourImage -> parseColour
       MonoImage   -> parseMono
 
-parse :: ByteString -> IO ()
+imageType :: [Colour] -> Text
+imageType []           = "PF"
+imageType (Colour{}:_) = "PF"
+imageType (Mono{}:_)   = "Pf"
+
+tShow :: (Show a) => a -> Text
+tShow = T.pack . show
+
+encFloat :: Float -> BL.ByteString
+encFloat = runPut . putFloat32le
+
+encodeColour :: Colour -> BL.ByteString
+encodeColour (Colour ri gi bi) =
+  encFloat ri <> encFloat gi <> encFloat bi
+encodeColour (Mono m) =
+  encFloat m
+
+encode :: Image -> BL.ByteString
+encode (Image w h c) =
+  fromStrict (T.encodeUtf8 he) <> body
+  where
+    he = imageType c <> "\n" <> tShow w <> " " <> tShow h <> "\n-1.0\n"
+    body = fold $ encodeColour <$> c
+
+parse :: ByteString -> Image
 parse s = case P.parseOnly parser s of
-  Left str -> putStrLn str
-  Right i  -> print i
+  Left str -> error str
+  Right i  -> i
-- 
cgit