blob: 86cb1e4a81545c2f60037d383d56b4476dfbf39b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ConstraintKinds #-}
module AttributeData where
import Control.Monad
import Data.Data
import Data.Foldable
import Data.Function
import Data.Int
import Data.IORef
import Data.Maybe
import Data.Some
import Data.Word
import qualified Data.Map.Strict as Map
import qualified Data.Vector as V
;import Data.Vector as V ((!),(//))
import Foreign.C.Types (CPtrdiff)
import Foreign.Marshal
import Foreign.Ptr
import Foreign.Storable
import LambdaCube.GL as LC
import LambdaCube.GL.Data -- (uploadCubeMapToGPU,uploadTextureBufferToGPU,updateTextureBuffer)
import LambdaCube.GL.Mesh as LC
import LambdaCube.GL.Type
import LambdaCube.IR as LC
import LambdaCube.GL.Util
import LambdaCube.GL.Input.Type
import LambdaCube.GL.Input hiding (createObjectCommands)
import Control.Monad.State.Lazy
import MaskableStream
data Witness c = c => Witness
tagTypable :: TypeTag c -> Witness (Typeable c)
tagTypable TypeBool = Witness
tagTypable TypeV2B = Witness
tagTypable TypeV3B = Witness
tagTypable TypeV4B = Witness
tagTypable TypeWord = Witness
tagTypable TypeV2U = Witness
tagTypable TypeV3U = Witness
tagTypable TypeV4U = Witness
tagTypable TypeInt = Witness
tagTypable TypeV2I = Witness
tagTypable TypeV3I = Witness
tagTypable TypeV4I = Witness
tagTypable TypeFloat = Witness
tagTypable TypeV2F = Witness
tagTypable TypeV3F = Witness
tagTypable TypeV4F = Witness
tagTypable TypeM22F = Witness
tagTypable TypeM23F = Witness
tagTypable TypeM24F = Witness
tagTypable TypeM32F = Witness
tagTypable TypeM33F = Witness
tagTypable TypeM34F = Witness
tagTypable TypeM42F = Witness
tagTypable TypeM43F = Witness
tagTypable TypeM44F = Witness
foo :: forall attrkeys. Data attrkeys => (String -> Maybe (Some AttributeKey)) -> Maybe attrkeys
foo lookupA = do
let dt = dataTypeOf (error "dataTypeOf attrkeys" :: attrkeys)
case dataTypeRep dt of
AlgRep (c:_) -> do
let fields = constrFields c
mkb :: (MonadPlus m, Data k) => String -> m k
mkb n = case lookupA n of
Just (This k@(AttributeKey tt _ _)) -> case tagTypable tt of
Witness -> maybe mzero return $ cast k
_ -> mzero
z :: x -> StateT [String] Maybe x
z r = put fields >> return r
k :: Data b => StateT [String] Maybe (b -> r) -> StateT [String] Maybe r
k c = do btor <- c
n:ns <- get
put ns
a <- mkb n
return (btor a)
evalStateT (gunfold k z c) [] -- :: (,) [String] attrkeys
_ -> Nothing
|