module Graphics.HaGL.GLObj (
    GLObj(..),
    Graphics.HaGL.GLObj.PrimitiveMode,
    GLObjException(..)
) where

import Control.Exception (Exception)
import qualified Graphics.Rendering.OpenGL.GL.PrimitiveMode (PrimitiveMode)

import Graphics.HaGL.Numerical (Vec)
import Graphics.HaGL.GLType
import Graphics.HaGL.GLExpr


-- TODO: should the indices be bundled with the PrimitiveMode?
-- | A drawable object specified by a set of variables of type 'GLExpr' and
-- the 'PrimitiveMode' according to which output vertices of the variable 
-- 'position', indexed by 'indices', should be interpreted. 
--
-- When using the convenience functions 'Graphics.HaGL.points', 
-- 'Graphics.HaGL.triangles', etc., to define a 'GLObj' with the corresponding 
-- 'PrimitiveMode', at the very minimum the fields 'position' and 'color' must 
-- be set before drawing the 'GLObj'.
data GLObj = GLObj {
    -- | The 'PrimitiveMode' that will be used to draw the object
    GLObj -> PrimitiveMode
primitiveMode :: PrimitiveMode,
    -- | A set of position indices used to construct the primitives of the object
    GLObj -> Maybe [ConstExpr UInt]
indices :: Maybe [ConstExpr UInt],
    -- | A vertex variable specifying the position of an arbitrary vertex
    GLObj -> VertExpr (Vec 4 Float)
position :: VertExpr (Vec 4 Float),
    -- | A fragment variable specifying the color of an arbitrary fragment
    GLObj -> FragExpr (Vec 4 Float)
color :: FragExpr (Vec 4 Float),
    -- | An fragment variable specifying the condition for discarding an arbitrary
    -- fragment
    GLObj -> FragExpr Bool
discardWhen :: FragExpr Bool
}

-- | See [Graphics.Rendering.OpenGL.GL.PrimitiveMode]
-- (https://hackage.haskell.org/package/OpenGL-3.0.3.0/docs/Graphics-Rendering-OpenGL-GL-PrimitiveMode.html#g:1)
-- for a description of each @PrimitiveMode@
type PrimitiveMode = 
    Graphics.Rendering.OpenGL.GL.PrimitiveMode.PrimitiveMode

data GLObjException =
    NoInputVars |
    EmptyInputVar |
    MismatchedInputVars
    deriving GLObjException -> GLObjException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GLObjException -> GLObjException -> Bool
$c/= :: GLObjException -> GLObjException -> Bool
== :: GLObjException -> GLObjException -> Bool
$c== :: GLObjException -> GLObjException -> Bool
Eq

instance Show GLObjException where
    show :: GLObjException -> String
show GLObjException
NoInputVars = String
"Attempted to process a GLObj containing no input variables"
    show GLObjException
EmptyInputVar = String
"Input variable initialized using empty list"
    show GLObjException
MismatchedInputVars = String
"Dimensions of input variables do not match"

instance Exception GLObjException