module SimpleH.GL.Base where

import SimpleH

-- |A two-element vector
data V2 t = V2 !t !t
          deriving Show
instance Semigroup a => Semigroup (V2 a) where (+) = plusA
instance Monoid a => Monoid (V2 a) where zero = zeroA
instance Functor V2 where map f (V2 x y) = V2 (f x) (f y)
instance Unit V2 where pure = join V2
instance Applicative V2 where
  V2 fx fy <*> V2 x y = V2 (fx x) (fy y)
instance Foldable V2 where
  fold (V2 a b) = a+b
instance Traversable V2 where
  sequence (V2 a b) = V2<$>a<*>b

-- |A three-element vector
data V3 t = V3 !t !t !t
          deriving Show
instance Semigroup a => Semigroup (V3 a) where (+) = plusA
instance Monoid a => Monoid (V3 a) where zero = zeroA
instance Functor V3 where map f (V3 x y z) = V3 (f x) (f y) (f z)
instance Unit V3 where pure = (join.join) V3
instance Applicative V3 where
  V3 fx fy fz <*> V3 x y z = V3 (fx x) (fy y) (fz z)
instance Foldable V3 where
  fold (V3 a b c) = a+b+c
instance Traversable V3 where
  sequence (V3 a b c) = V3<$>a<*>b<*>c

-- |A three-element vector
data V4 t = V4 !t !t !t !t
          deriving Show
instance Semigroup a => Semigroup (V4 a) where (+) = plusA
instance Monoid a => Monoid (V4 a) where zero = zeroA
instance Functor V4 where map f (V4 x y z w) = V4 (f x) (f y) (f z) (f w)
instance Unit V4 where pure = (join.join.join) V4
instance Applicative V4 where
  V4 fx fy fz fw <*> V4 x y z w = V4 (fx x) (fy y) (fz z) (fw w)
instance Foldable V4 where
  fold (V4 a b c d) = a+b+c+d
instance Traversable V4 where
  sequence (V4 a b c d) = V4<$>a<*>b<*>c<*>d

class Graphics g where
  draw :: g -> IO ()