nanogenmo2018/Vec.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}

module Vec
    ( Vec
    , Vec2
    , Vec3
    , vcycle
    , vadd
    , vsub
    , vmul
    , vdiv
    , vnegate
    , vmag
    , vdist
    , vproject
    , v2rotate
    , v3rotate
    , vlerp
    ) where

class Vec a where
    vcycle  :: a -> a
    vadd    :: a -> a -> a
    vsub    :: a -> a -> a
    vsub a b = vadd a $ vnegate b
    vmul    :: a -> Double -> a
    vdiv    :: a -> Double -> a
    vdiv a b = vmul a (1 / b)
    vnegate :: a -> a
    vmag    :: a -> Double
    vdist   :: a -> a -> Double
    vdist a b = vmag (vsub a b)

type Vec2 = (Double, Double)
type Vec3 = (Double, Double, Double)

instance Vec Vec3 where
    vcycle (x, y, z) = (y, z, x)
    vadd (x, y, z) (a, b, c) = (x + a, y + b, z + c)
    vmul (x, y, z) a = (x * a, y * a, z * a)
    vnegate (x, y, z) = (-x, -y, -z)
    vmag (x, y, z) = sqrt $ x * x + y * y + z * z

instance Vec Vec2 where
    vcycle (x, y) = (y, x)
    vadd (x, y) (a, b) = (x + a, y + b)
    vmul (x, y) a = (x * a, y * a)
    vnegate (x, y) = (-x, -y)
    vmag (x, y) = sqrt $ x * x + y * y

vproject :: Vec3 -> Vec2
vproject (x, y, z) = vdiv (x, y) (1 + z)

v2rotate :: Vec2 -> Double -> Vec2
v2rotate (x, y) t = (x * (cos t) - y * (sin t), x * (sin t) + y * (cos t))

v3rotate :: Vec3 -> Vec3 -> Vec3
v3rotate v (a, b, c) = rx a $ ry b $ rz c v
  where
    rx t (x, y, z) = (x, fst $ v2rotate (y, z) t, snd $ v2rotate (y, z) t)
    ry t (x, y, z) = (fst $ v2rotate (x, z) t, y, snd $ v2rotate (x, z) t)
    rz t (x, y, z) = (fst $ v2rotate (x, y) t, snd $ v2rotate (x, y) t, z)

vlerp :: Vec v => v -> v -> Double -> v
vlerp a b c = vadd a $ vmul (vsub b a) c