diff options
author | Yann Herklotz Grave <git@yannherklotzgrave.com> | 2019-02-20 16:18:46 +0000 |
---|---|---|
committer | Yann Herklotz Grave <git@yannherklotzgrave.com> | 2019-02-20 16:18:46 +0000 |
commit | a89296f3ff3b1bb2f82b28d6ece7d0ba6a98a9fe (patch) | |
tree | 8855d1c3ceb00c369b57ec8650e9a857482e4bf1 /src | |
parent | 492f39f0379c7a1bdea9594d519ff636cef8368a (diff) | |
download | pfm-a89296f3ff3b1bb2f82b28d6ece7d0ba6a98a9fe.tar.gz pfm-a89296f3ff3b1bb2f82b28d6ece7d0ba6a98a9fe.zip |
Add Vec.hs and update library versions
Diffstat (limited to 'src')
-rw-r--r-- | src/PFM.hs | 4 | ||||
-rw-r--r-- | src/PFM/Vec.hs | 76 |
2 files changed, 79 insertions, 1 deletions
@@ -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 + ) |