Add Vec.hs and update library versions

3 files changed, 89 insertions, 10 deletions

diff --git a/pfm.cabal b/pfm.cabal
index 7b18e2c..c36436f 100644
--- a/pfm.cabal
+++ b/pfm.cabal
@@ -28,12 +28,13 @@ library
   default-language: Haskell2010
   ghc-options: -Wall
   exposed-modules: PFM
+                 , PFM.Vec
   build-depends: attoparsec
-               , base >= 4 && < 5
-               , bytestring
-               , text
-               , binary
-               , data-binary-ieee754
+               , base >=4 && <5
+               , bytestring >=0.10 && <0.11
+               , text >=1.2 && <1.3
+               , binary >=0.8 && <0.9
+               , data-binary-ieee754 >=0.4 && <0.5
   default-extensions: OverloadedStrings
 
 executable readpfm
@@ -41,8 +42,8 @@ executable readpfm
   main-is: Main.hs
   default-language: Haskell2010
   build-depends: base >= 4 && < 5
-               , pfm
-               , text
-               , bytestring
-               , criterion
+               , pfm >=0.1 && <0.2
+               , text >=1.2 && <1.3
+               , bytestring >=0.10 && <0.11
+               , criterion >=1.5 && <1.6
   default-extensions: OverloadedStrings
diff --git a/src/PFM.hs b/src/PFM.hs
index 11063f9..f0eff7e 100644
--- a/src/PFM.hs
+++ b/src/PFM.hs
@@ -12,7 +12,8 @@ Debevec PFM reader
 
 module PFM ( parse
            , encode
-           , encodePPM) where
+           , encodePPM
+           , module PFM.Vec) where
 
 import           Control.Applicative        ((<|>))
 import           Data.Attoparsec.ByteString (Parser)
@@ -32,6 +33,7 @@ import           Data.Text                  (Text)
 import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as T
 import           Data.Word                  (Word8)
+import           PFM.Vec
 
 data PFMImage = PFMImage { pfmWidth  :: Int
                          , pfmHeight :: Int
diff --git a/src/PFM/Vec.hs b/src/PFM/Vec.hs
new file mode 100644
index 0000000..2e8f8ab
--- /dev/null
+++ b/src/PFM/Vec.hs
@@ -0,0 +1,76 @@
+{-|
+Module      : PFM.Vec
+Description : Small Vector module
+Copyright   : (c) 2019, Yann Herklotz Grave
+License     : GPL-3
+Maintainer  : ymherklotz [at] gmail [dot] com
+Stability   : experimental
+Portability : POSIX
+
+Small Vector module
+-}
+
+module PFM.Vec where
+
+newtype Vec a = Vec { unVec :: (a, a, a) }
+            deriving (Show)
+
+instance Functor Vec where
+  fmap f (Vec (a, b, c)) = Vec (f a, f b, f c)
+
+instance (Num a) => Num (Vec a) where
+  (Vec (x1, y1, z1)) + (Vec (x2, y2, z2)) = Vec (x1 + x2, y1 + y2, z1 + z2)
+  (Vec (x1, y1, z1)) - (Vec (x2, y2, z2)) = Vec (x1 - x2, y1 - y2, z1 - z2)
+  (Vec (x1, y1, z1)) * (Vec (x2, y2, z2)) = Vec (x1 * x2, y1 * y2, z1 * z2)
+  abs = fmap abs
+  signum = fmap signum
+  fromInteger i = Vec (fromInteger i, 0, 0)
+
+newtype Sph a = Sph { unSph :: (a, a) }
+              deriving (Show)
+
+instance Functor Sph where
+  fmap f (Sph (a, b)) = Sph (f a, f b)
+
+findZ :: (RealFloat a) => a -> a -> Vec a
+findZ x y =
+  Vec (x, y, z)
+  where
+    sq = sqrt (1 - x**2 - y**2)
+    z = if isNaN sq then 0 else sq
+
+dot :: (Num a) => Vec a -> Vec a -> a
+dot (Vec (x1, y1, z1)) (Vec (x2, y2, z2)) =
+  x1 * x2 + y1 * y2 + z1 * z2
+
+normalise :: (RealFloat a) => Int -> (Int, Int) -> Vec a
+normalise size (y, x) =
+  findZ (scale x) $ scale y
+  where
+    scale a = 2 * fromIntegral a / fromIntegral size - 1
+
+reflect :: (RealFloat a) => Int -> Vec a -> (Int, Int) -> Vec a
+reflect size v (y, x) =
+  l - v
+  where
+    n = normalise size (y, x)
+    l = ((2 * dot n v)*) <$> n
+
+toSpherical :: (Floating a, Eq a, Ord a) => Vec a -> Sph a
+toSpherical (Vec (x, y, z))
+  | z == 0 && x >= 0 =
+    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, - pi + atan (x / z))
+  | otherwise =
+    Sph (acos y, atan (x / z))
+
+indexLatLong :: (RealFrac a, Floating a) => Int -> Int -> Sph a -> (Int, Int)
+indexLatLong w h (Sph (theta, phi)) =
+  ( floor $ theta / pi * fromIntegral h
+  , floor $ ((phi / (2 * pi)) + 0.5) * fromIntegral w
+  )