aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorYann Herklotz <ymherklotz@gmail.com>2019-01-30 22:11:09 +0000
committerYann Herklotz <ymherklotz@gmail.com>2019-01-30 22:11:09 +0000
commit46748a4bedeea5ff35a9d0c627f9ca1f8dee8bcc (patch)
treedac65e6b4b004b5a1d94d4bb017f32e9ae95748c
parent4280f50fd134c1ac505e746c9418f94d230d9a00 (diff)
downloadmirror-ball-46748a4bedeea5ff35a9d0c627f9ca1f8dee8bcc.tar.gz
mirror-ball-46748a4bedeea5ff35a9d0c627f9ca1f8dee8bcc.zip
Use Vec module
-rw-r--r--src/Main.hs36
1 files 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