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