Babylon.Data.V.hs

module Babylon.Data.V where

import           Data.Aeson
import           GHC.Generics
import           JS

data V2 = V2 { x, y :: Float } deriving (Show, Generic)

instance ToJSVal V2 where
    toJSVal v = newb "Vector2" [v.x, v.y]

data V3 = V3 { x, y, z :: Float } deriving (Show, Generic)

instance ToJSVal V3 where
    toJSVal v = newb "Vector3" [v.x, v.y, v.z]

instance FromJSON V3
instance ToJSON V3

data V4 = V4 { x, y, z, w :: Float } deriving (Show, Generic)

instance ToJSVal V4 where
    toJSVal v = newb "Vector4" [v.x, v.y, v.z, v.w]

instance FromJSON V4
instance ToJSON V4

class IsV v where
    zero :: v

    addX :: Float -> v -> v
    addY :: Float -> v -> v

instance IsV V2 where
    zero     = V2 0 0
    addX n v = v { x = v.x + n }
    addY n v = v { y = v.y + n }

instance IsV V3 where
    zero     = V3 0 0 0
    addX n v = v { x = v.x + n }
    addY n v = v { y = v.y + n }

addZ :: Float -> V3 -> V3
addZ n v = v { z = v.z + n }

instance IsV V4 where
    zero     = V4 0 0 0 0
    addX n v = v { x = v.x + n }
    addY n v = v { y = v.y + n }

addW :: Float -> V4 -> V4
addW n v = v { w = v.w + n }

instance Num V2 where
    (+) v1 v2     = v1 { x = v1.x + v2.x, y = v1.y + v2.y }
    (-) v1 v2     = v1 { x = v1.x - v2.x, y = v1.y - v2.y }
    (*) v1 v2     = v1 { x = v1.x * v2.x, y = v1.y * v2.y }
    abs v         = v { x = abs v.x, y = abs v.y }
    signum v      = v { x = signum v.x, y = signum v.y }
    fromInteger x = V2 x' x' where x' = fromInteger x

instance Num V3 where
    (+) v1 v2     = v1 { x = v1.x + v2.x, y = v1.y + v2.y, z = v1.z + v2.z }
    (-) v1 v2     = v1 { x = v1.x - v2.x, y = v1.y - v2.y, z = v1.z - v2.z }
    (*) v1 v2     = v1 { x = v1.x * v2.x, y = v1.y * v2.y, z = v1.z * v2.z }
    abs v         = v { x = abs v.x, y = abs v.y, z = abs v.z }
    signum v      = v { x = signum v.x, y = signum v.y, z = signum v.z }
    fromInteger x = V3 x' x' x' where x' = fromInteger x

instance Num V4 where
    (+) v1 v2     = v1 { x = v1.x + v2.x, y = v1.y + v2.y, z = v1.z + v2.z, w = v1.w + v2.w }
    (-) v1 v2     = v1 { x = v1.x - v2.x, y = v1.y - v2.y, z = v1.z - v2.z, w = v1.w - v2.w }
    (*) v1 v2     = v1 { x = v1.x * v2.x, y = v1.y * v2.y, z = v1.z * v2.z, w = v1.w * v2.w }
    abs v         = v { x = abs v.x, y = abs v.y, z = abs v.z, w = abs v.w }
    signum v      = v { x = signum v.x, y = signum v.y, z = signum v.z, w = signum v.w }
    fromInteger x = V4 x' x' x' x' where x' = fromInteger x

class HasCastToV2 v where
    toV2 :: v -> V2

instance HasCastToV2 V3 where
    toV2 v = V2 v.x v.y

instance HasCastToV2 V4 where
    toV2 v = V2 v.x v.y

toV3 :: V4 -> V3
toV3 v = V3 v.x v.y v.z