{-# LANGUAGE OverloadedStrings #-}
module Language.Del.TypeTable where
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
data Type
= NamedType T.Text
| FuncType [Type] Type
| BoolType
| Bool2Type
| Bool3Type
| Bool4Type
| ColorType
| DoubleType
| Double2Type
| Double3Type
| Double4Type
| DoubleMatrix Int Int
| FloatType
| Float2Type
| Float3Type
| Float4Type
| FloatMatrix Int Int
| IntType
| Int2Type
| Int3Type
| Int4Type
| LIntType
| LInt2Type
| LInt3Type
| LInt4Type
| LUIntType
| LUInt2Type
| LUInt3Type
| LUInt4Type
| UIntType
| UInt2Type
| UInt3Type
| UInt4Type
deriving Eq
data TypeInfo
-- First argument is type constructor, second is Del type, third is GLSL
-- type
= TypeInfo Type T.Text T.Text
typeinfos :: [TypeInfo]
typeinfos =
[ TypeInfo BoolType "b" "bool"
, TypeInfo Bool2Type "b2" "bvec2"
, TypeInfo Bool3Type "b3" "bvec3"
, TypeInfo Bool4Type "b4" "bvec4"
, TypeInfo ColorType "color" "vec4"
, TypeInfo DoubleType "d" "double"
, TypeInfo Double2Type "d2" "dvec2"
, TypeInfo Double3Type "d3" "dvec3"
, TypeInfo Double4Type "d4" "dvec4"
, TypeInfo (DoubleMatrix 2 2) "d2x2" "dmat2"
, TypeInfo (DoubleMatrix 2 3) "d2x3" "dmat2x3"
, TypeInfo (DoubleMatrix 2 4) "d2x4" "dmat2x4"
, TypeInfo (DoubleMatrix 3 2) "d3x2" "dmat3x2"
, TypeInfo (DoubleMatrix 3 3) "d3x3" "dmat3"
, TypeInfo (DoubleMatrix 3 4) "d3x4" "dmat3x4"
, TypeInfo (DoubleMatrix 4 2) "d4x2" "dmat4x2"
, TypeInfo (DoubleMatrix 4 3) "d4x3" "dmat4x3"
, TypeInfo (DoubleMatrix 4 2) "d4x4" "dmat4"
, TypeInfo FloatType "f" "float"
, TypeInfo Float2Type "f2" "vec2"
, TypeInfo Float3Type "f3" "vec3"
, TypeInfo Float4Type "f4" "vec4"
, TypeInfo (FloatMatrix 2 2) "f2x2" "fmat2"
, TypeInfo (FloatMatrix 2 3) "f2x3" "fmat2x3"
, TypeInfo (FloatMatrix 2 4) "f2x4" "fmat2x4"
, TypeInfo (FloatMatrix 3 2) "f3x2" "fmat3x2"
, TypeInfo (FloatMatrix 3 3) "f3x3" "fmat3"
, TypeInfo (FloatMatrix 3 4) "f3x4" "fmat3x4"
, TypeInfo (FloatMatrix 4 2) "f4x2" "fmat4x2"
, TypeInfo (FloatMatrix 4 3) "f4x3" "fmat4x3"
, TypeInfo (FloatMatrix 4 2) "f4x4" "fmat4"
, TypeInfo IntType "i" "int"
, TypeInfo Int2Type "i2" "ivec2"
, TypeInfo Int3Type "i3" "ivec3"
, TypeInfo Int4Type "i4" "ivec4"
, TypeInfo LIntType "l" "int64_t"
, TypeInfo LInt2Type "l2" "i64vec2"
, TypeInfo LInt3Type "l3" "i64vec3"
, TypeInfo LInt4Type "l4" "i64vec4"
, TypeInfo LUIntType "lu" "uint64_t"
, TypeInfo LUInt2Type "lu2" "u64vec2"
, TypeInfo LUInt3Type "lu3" "u64vec3"
, TypeInfo LUInt4Type "lu4" "u64vec4"
, TypeInfo UIntType "u" "uint"
, TypeInfo UInt2Type "u2" "uvec2"
, TypeInfo UInt3Type "u3" "uvec3"
, TypeInfo UInt4Type" u4" "uvec4"
]
delmap :: Map.Map T.Text TypeInfo
delmap = Map.fromList $ map (\ti@(TypeInfo _ t _) -> (t, ti)) typeinfos
glslmap :: Map.Map T.Text TypeInfo
glslmap = Map.fromList $ map (\ti@(TypeInfo _ _ t) -> (t, ti)) typeinfos
findType :: Type -> Maybe TypeInfo
findType = find typeinfos
where find (x@(TypeInfo t _ _):xs) typ
= if t == typ then Just x else find xs typ
find [] _ = Nothing
findGlslType :: T.Text -> Maybe TypeInfo
findGlslType = flip Map.lookup $ glslmap
findDelType :: T.Text -> Maybe TypeInfo
findDelType = flip Map.lookup $ delmap
instance Show Type where
show (NamedType t) = show t
show (FuncType args ret) = show args ++ " -> " ++ show ret
show x = case findType x of
Just (TypeInfo _ n _) -> T.unpack n
Nothing -> undefined