From 46748a4bedeea5ff35a9d0c627f9ca1f8dee8bcc Mon Sep 17 00:00:00 2001
From: Yann Herklotz <ymherklotz@gmail.com>
Date: Wed, 30 Jan 2019 22:11:09 +0000
Subject: Use Vec module

---
 src/Main.hs | 36 ++++++++++++++++++++++--------------
 1 file changed, 22 insertions(+), 14 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index 3b3d263..b92807c 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -6,8 +6,7 @@ import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text            as T
 import           Data.Word            (Word8)
 import           PFM
-
-newtype Vec = Vec { unVec :: (Int, Int, Int) }
+import           Vec
 
 clamp :: PFMColour -> PPMColour
 clamp (PFMColour ri gi bi) =
@@ -19,28 +18,37 @@ clamp _ = undefined
 
 clampImage :: PFMImage -> PPMImage
 clampImage (PFMImage w h c) =
-  PPMImage w h . reverse $ fmap clamp <$> c
+  PPMImage w h $ fmap clamp <$> c
 
 bmap :: (Bifunctor f) => (a -> b) -> f a a -> f b b
 bmap f = bimap f f
 
-toCircle :: Int -> [[(Int, Int)]] -> [[PFMColour]]
-toCircle v m =
+uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
+uncurry3 f (a, b, c) = f a b c
+
+colourCorrect :: Double -> Double
+colourCorrect = (+0.5) . (/2)
+
+toCircle :: ((Int, Int) -> Vec Double) -> Int -> [[(Int, Int)]] -> [[PFMColour]]
+toCircle f v m =
   fmap toCol <$> m
   where
     toCol val = if dist val <= v ^ (2 :: Int)
-      then PFMColour 1.0 0.5 0.5
-      else PFMColour 0.5 0.5 1.0
+      then uncurry3 PFMColour (unVec $ realToFrac . colourCorrect <$> f val)
+      else PFMColour 0 0 0--0.5 0.5 1.0
     dist = add . bmap ((^(2 :: Int)) . (v-))
     add (an, bn) = an + bn
 
-circleImage :: Int -> PFMImage
-circleImage s = PFMImage s s $ toCircle ((s - 1) `div` 2)
-  [ [ (y, x) | x <- [0..s-1] ] | y <- [0..s-1] ]
+circleImage :: ((Int, Int) -> Vec Double) -> Int -> PFMImage
+circleImage f s = PFMImage s s $ toCircle f ((s - 1) `div` 2)
+  [ [ (y, x) | x <- [0..s-1] ] | y <- reverse [0..s-1] ]
+
+revColour :: PFMImage -> PFMImage
+revColour (PFMImage w h i) =
+  PFMImage w h $ reverse i
 
 main :: IO ()
 main = do
-  -- s <- B.readFile "/home/yannherklotz/Imperial/AdvancedGraphics/coursework1/CO417-Assignment1/UrbanProbe/urbanEM_latlong.pfm"
-  s <- B.readFile "/home/yannherklotz/Downloads/memorial.pfm"
-  -- BL.writeFile "random.ppm" . encodePPM . clampImage . parse $ s
-  BL.writeFile "circle.ppm" . encodePPM . clampImage $ circleImage 511
+  let i = circleImage (normalise 511) 511
+  BL.writeFile "normal.ppm" . encodePPM . clampImage $ i
+  BL.writeFile "normal.pfm" . encode . revColour $ i
-- 
cgit