1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE EmptyDataDecls #-}
3module AST.Utils.Shader
4  ( Source
5  , Types(..)
6  , Type(..)
7  , fromChars
8  , toJsStringBuilder
9  )
10  where
11
12
13import Control.Monad (liftM)
14import Data.Binary (Binary, get, put)
15import qualified Data.ByteString as BS
16import qualified Data.ByteString.Builder as B
17import qualified Data.ByteString.UTF8 as BS_UTF8
18import qualified Data.Map as Map
19import qualified Data.Name as Name
20
21
22
23-- SOURCE
24
25
26newtype Source =
27  Source BS.ByteString
28
29
30
31-- TYPES
32
33
34data Types =
35  Types
36    { _attribute :: Map.Map Name.Name Type
37    , _uniform :: Map.Map Name.Name Type
38    , _varying :: Map.Map Name.Name Type
39    }
40
41
42data Type
43  = Int
44  | Float
45  | V2
46  | V3
47  | V4
48  | M4
49  | Texture
50
51
52
53-- TO BUILDER
54
55
56toJsStringBuilder :: Source -> B.Builder
57toJsStringBuilder (Source src) =
58  B.byteString src
59
60
61
62-- FROM CHARS
63
64
65fromChars :: [Char] -> Source
66fromChars chars =
67  Source (BS_UTF8.fromString (escape chars))
68
69
70escape :: [Char] -> [Char]
71escape chars =
72  case chars of
73    [] ->
74      []
75
76    c:cs
77      | c == '\r' -> escape cs
78      | c == '\n' -> '\\' : 'n'  : escape cs
79      | c == '\"' -> '\\' : '"'  : escape cs
80      | c == '\'' -> '\\' : '\'' : escape cs
81      | c == '\\' -> '\\' : '\\' : escape cs
82      | otherwise -> c : escape cs
83
84
85
86-- BINARY
87
88
89instance Binary Source where
90  get = liftM Source get
91  put (Source a) = put a
92