@@ -1,7 +1,14 @@
11{-# OPTIONS_GHC -Wall #-}
22{-# LANGUAGE OverloadedStrings #-}
3−module AST.Literal where
3+module AST.Literal
4+ ( Literal(..)
5+ , toBuilder
6+ , GLType(..), glTypeToText, Shader(..)
7+ )
8+ where
49
10+
11+import Data.Binary
512import qualified Data.Map as Map
613import Data.Monoid ((<>))
714import Data.Text (Text)
@@ -37,6 +44,15 @@ toBuilder literal =
3744-- WebGL TYPES
3845
3946
47+data Shader =
48+ Shader
49+ { attribute :: Map.Map Text GLType
50+ , uniform :: Map.Map Text GLType
51+ , varying :: Map.Map Text GLType
52+ }
53+ deriving (Eq)
54+
55+
4056data GLType
4157 = Int
4258 | Float
@@ -60,10 +76,38 @@ glTypeToText glTipe =
6076 Texture -> "WebGL.Texture"
6177
6278
63−data Shader =
64− Shader
65− { attribute :: Map.Map Text GLType
66− , uniform :: Map.Map Text GLType
67− , varying :: Map.Map Text GLType
68− }
69− deriving (Eq)
79+
80+-- BINARY
81+
82+
83+instance Binary Literal where
84+ put literal =
85+ case literal of
86+ Chr chr ->
87+ putWord8 0 >> put chr
88+
89+ Str str ->
90+ putWord8 1 >> put str
91+
92+ IntNum n ->
93+ putWord8 2 >> put n
94+
95+ FloatNum n ->
96+ putWord8 3 >> put n
97+
98+ Boolean True ->
99+ putWord8 4
100+
101+ Boolean False ->
102+ putWord8 5
103+
104+ get =
105+ do word <- getWord8
106+ case word of
107+ 0 -> Chr <$> get
108+ 1 -> Str <$> get
109+ 2 -> IntNum <$> get
110+ 3 -> FloatNum <$> get
111+ 4 -> pure $ Boolean True
112+ 5 -> pure $ Boolean False
113+ _ -> error "bad binary for AST.Literal"