blob: 2b2bc96645c0161009cc987b585f5f0c286dba57 (
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
|
{-# 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 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 :: Data k => String -> k
mkb n = fix $ \v ->
fromMaybe (error $ "mkb " ++ n) $ case lookupA n of
Just (This k@(AttributeKey tt _ _)) -> case tagTypable tt of
Witness -> cast k
_ -> Nothing
z :: x -> (,) [String] x
z r = (fields, r)
k :: Data b => (,) [String] (b -> r) -> (,) [String] r
k (n:ns,btor) = (ns,btor (mkb n))
(_,ks) = gunfold k z c :: (,) [String] attrkeys
Just ks
_ -> Nothing
|
