Small fixes in the Vec library

2 files changed, 41 insertions, 11 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
+
diff --git a/src/Vec.hs b/src/Vec.hs
index 3f5a839..2e08b46 100644
--- a/src/Vec.hs
+++ b/src/Vec.hs
@@ -34,7 +34,7 @@ instance Functor Sph where
 
 findZ :: (Floating a) => a -> a -> Vec a
 findZ x y =
-  Vec (x, y, sqrt (1 - x^^2 - y^^2))
+  Vec (x, y, sqrt (1 - x**2 - y**2))
 
 dot :: (Num a) => Vec a -> Vec a -> a
 dot (Vec (x1, y1, z1)) (Vec (x2, y2, z2)) =
@@ -59,8 +59,10 @@ toSpherical (Vec (x, y, z))
     Sph (acos y, pi / 2)
   | z == 0 =
     Sph (acos y, - pi / 2)
+  | z < 0 && x >= 0 =
+    Sph (acos y, pi + atan (x / z))
   | z < 0 =
-    Sph (acos y, signum x * pi + atan (x / z))
+    Sph (acos y, - pi + atan (x / z))
   | otherwise =
     Sph (acos y, atan (x / z))