diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 46 |
1 files changed, 37 insertions, 9 deletions
diff --git a/src/Main.hs b/src/Main.hs index a0b3889..da1ef80 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -16,7 +16,7 @@ clamp (PFMColour ri gi bi) = PPMColour (f ri) (f gi) (f bi) where v s = s * 255.0 - f s = if v s > 255.0 then 255 else fromInteger (round (v s)) + f s = if v s > 255.0 then 255 else fromInteger (floor (v s)) clamp _ = undefined clampImage :: PFMImage -> PPMImage @@ -57,16 +57,16 @@ bench :: IO () bench = do im <- B.readFile "data/urbanEM_latlong.pfm" let urban = revColour $ parse im - benchmark $ whnf (circleImage (toColour $ normalise 511)) 511 - benchmark $ whnf (circleImage (toColour $ reflect 511 (Vec (0, 0, 1)))) 511 - benchmark $ whnf (circleImage (fromImage 511 (Vec (0, 0, 1)) urban)) 511 + benchmark $ whnf (circleImage (toColour $ normalise 510)) 511 + benchmark $ whnf (circleImage (toColour $ reflect 510 (Vec (0, 0, 1)))) 511 + benchmark $ whnf (circleImage (fromImage 510 (Vec (0, 0, 1)) urban)) 511 indexTwice :: [[a]] -> (Int, Int) -> a indexTwice c (y, x) = c !! y !! x fromImage :: Int -> Vec Double -> PFMImage -> (Int, Int) -> PFMColour fromImage s v (PFMImage w h c) (y, x) = - indexTwice c . indexLatLong w h . toSpherical $ reflect s v (y, x) + indexTwice c . indexLatLong (w - 1) (h - 1) . toSpherical $ reflect s v (y, x) applyGamma :: Float -> PFMImage -> PFMImage applyGamma g (PFMImage w h c) = @@ -74,6 +74,10 @@ applyGamma g (PFMImage w h c) = where gc (PFMColour r gr b) = PFMColour (gamma g r) (gamma g gr) (gamma g b) +fromImageF :: (Int, Int) -> PFMImage -> PFMColour +fromImageF (y, x) (PFMImage w h c) = + c !! y !! x + gamma :: (Floating a) => a -> a -> a gamma g m = m ** (1 / g) @@ -83,15 +87,38 @@ myForkIO io = do _ <- forkFinally io (\_ -> putMVar mvar ()) return mvar +printInfo :: PFMImage -> PFMImage -> PFMImage -> PFMImage -> (Int, Int) -> IO () +printInfo i r f fg coord = do + let ref = reflect 510 (Vec (0, 0, 1)) coord + let (y, x) = coord + print coord + putStr " normalise: " + print $ normalise 510 coord + putStr " reflect: " + print $ ref + putStr " Spherical: " + print $ toSpherical ref + putStr " Index: " + print . indexLatLong 1023 511 $ toSpherical ref + putStr " " + print $ fromImageF coord i + putStr " " + print $ fromImageF coord r + putStr " " + print $ fromImageF coord f + putStr " " + print $ fromImageF coord fg + main :: IO () main = do im <- B.readFile "data/urbanEM_latlong.pfm" let urban = revColour $ parse im - let i = circleImage (toColour $ normalise 511) 511 - let r = circleImage (toColour $ reflect 511 (Vec (0, 0, 1))) 511 - let f = circleImage (fromImage 511 (Vec (0, 0, 1)) urban) 511 - let fg = applyGamma 1.7 f + let i = circleImage (toColour $ normalise 510) 511 + let r = circleImage (toColour $ reflect 510 (Vec (0, 0, 1))) 511 + let f = circleImage (fromImage 510 (Vec (0, 0, 1)) urban) 511 + let fg = applyGamma 2.2 f createDirectoryIfMissing True "data" + let prnti = printInfo i r f fg vars <- sequence $ myForkIO <$> [ BL.writeFile "data/normal.ppm" . encodePPM . clampImage $ i , BL.writeFile "data/normal.pfm" . encode . revColour $ i @@ -103,3 +130,4 @@ main = do , BL.writeFile "data/final.pfm" . encode . revColour $ fg ] sequence_ $ takeMVar <$> vars + |