fwgl 0.1.3.1 → 0.1.4.0

raw patch · 19 files changed

+1537/−755 lines, 19 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• FWGL.hs +21/−17
• FWGL/Backend/GLES.hs +51/−8
• FWGL/Backend/IO.hs +1/−0
• FWGL/Geometry.hs +37/−11
• FWGL/Graphics/D2.hs +1/−0
• FWGL/Graphics/D3.hs +1/−0
• FWGL/Graphics/Generic.hs +1/−0
• FWGL/Input.hs +52/−25
• FWGL/Internal/GL.hs +5/−4
• FWGL/Shader.hs +146/−23
• FWGL/Shader/CPU.hs +155/−13
• FWGL/Shader/GLSL.hs +6/−3
• FWGL/Shader/Language.hs +0/−646
• FWGL/Shader/Language/Functions.hs +632/−0
• FWGL/Shader/Language/Types.hs +423/−0
• FWGL/Shader/Shader.hs +1/−1
• FWGL/Shader/Stages.hs +1/−1
• LICENSE +1/−1
• fwgl.cabal +2/−2

@@ -23,8 +23,8 @@         -- module FWGL.Audio,         module FWGL.Input,         module FRP.Yampa,-        FWGL(..),-        fwgl,+        BackendM(..),+        backend,         mapIO,         -- * FRP interface         Output,@@ -92,7 +92,7 @@  -- | The general output. data Output = forall a. Output Bool (Either (Effect ())-                                    (Draw a, a -> Effect ()))+                                            (Draw a, a -> Effect ()))  newtype Effect a = Effect (ReaderT (Canvas, BackendState) Draw a)         deriving (Functor, Applicative, Monad, MonadIO)@@ -145,28 +145,30 @@ setTitle title = Effect $ ask >>= \(canvas, bs) ->                 liftIO $ setCanvasTitle title canvas bs -newtype FWGL a = FWGL (ReaderT BackendState IO a)+newtype BackendM a = BackendM (ReaderT BackendState IO a)         deriving (Functor, Applicative, Monad, MonadIO) --- | Initialize the FWGL backend, run the action and terminate it.-fwgl :: BackendIO => FWGL () -> IO ()-fwgl (FWGL a) = initBackend >>= \bs -> runReaderT a bs >> terminateBackend bs+-- | Initialize the backend, run the action and terminate it.+backend :: BackendIO => BackendM () -> IO ()+backend (BackendM a) = do bs <- initBackend+                          runReaderT a bs+                          terminateBackend bs  -- | Useful for functions like 'forkIO' and 'forkOS'.-mapIO :: (IO a -> IO b) -> FWGL a -> FWGL b-mapIO f (FWGL a) = FWGL ask >>= liftIO . f . runReaderT a+mapIO :: (IO a -> IO b) -> BackendM a -> BackendM b+mapIO f (BackendM a) = BackendM ask >>= liftIO . f . runReaderT a  -- | Run a FWGL program on a new canvas/window. run :: BackendIO     => SF (Input ()) Output  -- ^ Main signal-    -> FWGL ()+    -> BackendM () run = run' $ return ()  -- | Run a FWGL program, using custom inputs. run' :: BackendIO      => IO inp                -- ^ An IO effect generating the custom inputs.      -> SF (Input inp) Output-     -> FWGL ()+     -> BackendM () run' = runTo "canvas"  -- | Run a FWGL program, using custom inputs and a specified canvas.@@ -175,7 +177,7 @@                 -- meaning only in the JavaScript backend.       -> IO inp -- ^ An IO effect generating the custom inputs.       -> SF (Input inp) Output-      -> FWGL ()+      -> BackendM () runTo dest customInput sigf =         do initCustom <- liftIO customInput            outputRef <- liftIO . newIORef . eff $ return ()@@ -203,21 +205,23 @@                                 dataFramebufferSize = Nothing,                                 dataPointer = Nothing,                                 dataButton = Nothing,-                                dataKey = Nothing }+                                dataKey = Nothing,+                                dataTime = 0 }  -- | Run a non-reactive FWGL program. runIO :: BackendIO       => (Double -> Input () -> IO Output) -- ^ Loop function-      -> FWGL ()+      -> BackendM () runIO = runToIO "canvas" $ \_ _ -> return ()  -- | Run a non-reactive FWGL program in a specified canvas. runToIO :: BackendIO-        => String -- ^ Destination canvas (eg. "#myCanvasId"). This only has+        => String -- ^ Destination canvas (eg. "#myCanvasId"). This has+                  -- meaning only in the JavaScript backend.         -> (Int -> Int -> IO ()) -- ^ Initialization function         -> (Double -> Input () -> IO Output) -- ^ Loop function-        -> FWGL ()-runToIO dest init fun = FWGL $ ask >>= \bs -> liftIO $+        -> BackendM ()+runToIO dest init fun = BackendM $ ask >>= \bs -> liftIO $         do (canvas, w, h) <- createCanvas dest bs            init w h 

@@ -5,9 +5,16 @@  import Data.Bits (Bits) import Data.Vect.Float+import Data.Int import Data.Word+import Foreign.Storable+import Foreign.Ptr (castPtr) import FWGL.Graphics.Color +data IVec2 = IVec2 !Int32 !Int32 +data IVec3 = IVec3 !Int32 !Int32 !Int32+data IVec4 = IVec4 !Int32 !Int32 !Int32 !Int32+ -- | Mixed OpenGL ES 2.0/WebGL 1.0/OpenGL 2.0 API, with VAOs and FBOs. class ( Integral GLEnum       , Integral GLUInt@@ -61,14 +68,20 @@         encodeMat2 :: Mat2 -> IO Float32Array         encodeMat3 :: Mat3 -> IO Float32Array         encodeMat4 :: Mat4 -> IO Float32Array-        encodeFloats :: [Float] -> IO Array-        encodeVec2s :: [Vec2] -> IO Array-        encodeVec3s :: [Vec3] -> IO Array-        encodeVec4s :: [Vec4] -> IO Array+        encodeFloats :: [Float] -> IO Float32Array+        encodeInts :: [Int32] -> IO Int32Array+        encodeVec2s :: [Vec2] -> IO Float32Array+        encodeVec3s :: [Vec3] -> IO Float32Array+        encodeVec4s :: [Vec4] -> IO Float32Array+        encodeIVec2s :: [IVec2] -> IO Int32Array+        encodeIVec3s :: [IVec3] -> IO Int32Array+        encodeIVec4s :: [IVec4] -> IO Int32Array         encodeUShorts :: [Word16] -> IO Array         encodeColors :: [Color] -> IO Array          newByteArray :: Int -> IO Array+        fromFloat32Array :: Float32Array -> Array+        fromInt32Array :: Int32Array -> Array         decodeBytes :: Array -> IO [Word8]          glActiveTexture :: Ctx -> GLEnum -> IO ()@@ -177,19 +190,19 @@         glTexSubImage2D :: Ctx -> GLEnum -> GLInt -> GLInt -> GLInt -> GLSize -> GLSize -> GLEnum -> GLEnum -> Array -> IO ()         glUniform1f :: Ctx -> UniformLocation -> Float -> IO ()         glUniform1fv :: Ctx -> UniformLocation -> Float32Array -> IO ()-        glUniform1i :: Ctx -> UniformLocation -> GLInt -> IO ()+        glUniform1i :: Ctx -> UniformLocation -> Int32 -> IO ()         glUniform1iv :: Ctx -> UniformLocation -> Int32Array -> IO ()         glUniform2f :: Ctx -> UniformLocation -> Float -> Float -> IO ()         glUniform2fv :: Ctx -> UniformLocation -> Float32Array -> IO ()-        glUniform2i :: Ctx -> UniformLocation -> GLInt -> GLInt -> IO ()+        glUniform2i :: Ctx -> UniformLocation -> Int32 -> Int32 -> IO ()         glUniform2iv :: Ctx -> UniformLocation -> Int32Array -> IO ()         glUniform3f :: Ctx -> UniformLocation -> Float -> Float -> Float -> IO ()         glUniform3fv :: Ctx -> UniformLocation -> Float32Array -> IO ()-        glUniform3i :: Ctx -> UniformLocation -> GLInt -> GLInt -> GLInt -> IO ()+        glUniform3i :: Ctx -> UniformLocation -> Int32 -> Int32 -> Int32 -> IO ()         glUniform3iv :: Ctx -> UniformLocation -> Int32Array -> IO ()         glUniform4f :: Ctx -> UniformLocation -> Float -> Float -> Float -> Float -> IO ()         glUniform4fv :: Ctx -> UniformLocation -> Float32Array -> IO ()-        glUniform4i :: Ctx -> UniformLocation -> GLInt -> GLInt -> GLInt -> GLInt -> IO ()+        glUniform4i :: Ctx -> UniformLocation -> Int32 -> Int32 -> Int32 -> Int32 -> IO ()         glUniform4iv :: Ctx -> UniformLocation -> Int32Array -> IO ()         glUniformMatrix2fv :: Ctx -> UniformLocation -> GLBool -> Float32Array -> IO ()         glUniformMatrix3fv :: Ctx -> UniformLocation -> GLBool -> Float32Array -> IO ()@@ -494,3 +507,33 @@         gl_RENDERBUFFER_BINDING :: GLEnum         gl_MAX_RENDERBUFFER_SIZE :: GLEnum         gl_INVALID_FRAMEBUFFER_OPERATION :: GLEnum++instance Storable IVec2 where+        sizeOf _ = 8+        alignment _ = 4+        peek ptr = IVec2 <$> peekElemOff (castPtr ptr) 0+                         <*> peekElemOff (castPtr ptr) 1+        poke ptr (IVec2 x y) = do pokeElemOff (castPtr ptr) 0 x+                                  pokeElemOff (castPtr ptr) 1 y++instance Storable IVec3 where+        sizeOf _ = 12+        alignment _ = 4+        peek ptr = IVec3 <$> peekElemOff (castPtr ptr) 0+                         <*> peekElemOff (castPtr ptr) 1+                         <*> peekElemOff (castPtr ptr) 2+        poke ptr (IVec3 x y z) = do pokeElemOff (castPtr ptr) 0 x+                                    pokeElemOff (castPtr ptr) 1 y+                                    pokeElemOff (castPtr ptr) 2 z++instance Storable IVec4 where+        sizeOf _ = 16+        alignment _ = 4+        peek ptr = IVec4 <$> peekElemOff (castPtr ptr) 0+                         <*> peekElemOff (castPtr ptr) 1+                         <*> peekElemOff (castPtr ptr) 2+                         <*> peekElemOff (castPtr ptr) 3+        poke ptr (IVec4 x y z w) = do pokeElemOff (castPtr ptr) 0 x+                                      pokeElemOff (castPtr ptr) 1 y+                                      pokeElemOff (castPtr ptr) 2 z+                                      pokeElemOff (castPtr ptr) 3 w

@@ -39,6 +39,7 @@                                 -> Canvas -> BackendState -> IO ()         setCanvasRefreshCallback :: IO () -> Canvas -> BackendState -> IO () +        -- | 'EventData's must be sorted in reverse chronological order.         popInput :: a -> Canvas -> BackendState -> IO (Input a)         getInput :: a -> Canvas -> BackendState -> IO (Input a) 

@@ -1,5 +1,5 @@ {-# LANGUAGE GADTs, TypeOperators, KindSignatures, DataKinds,-             MultiParamTypeClasses #-}+             MultiParamTypeClasses, FlexibleInstances, OverlappingInstances #-}  module FWGL.Geometry (         AttrList(..),@@ -35,22 +35,23 @@ import FWGL.Backend (BackendIO) import FWGL.Internal.GL import FWGL.Internal.Resource+import FWGL.Internal.TList import FWGL.Shader.CPU import FWGL.Shader.Default2D (Position2) import FWGL.Shader.Default3D (Position3, Normal3) import qualified FWGL.Shader.Default2D as D2 import qualified FWGL.Shader.Default3D as D3-import FWGL.Shader.Language (size, ShaderType)+import FWGL.Shader.Language.Types (ShaderType(size)) import FWGL.Transformation  -- | A heterogeneous list of attributes. data AttrList (is :: [*]) where         AttrListNil :: AttrList '[]-        AttrListCons :: (H.Hashable c, AttributeCPU c g, ShaderType g)-                     => (a -> g)+        AttrListCons :: (H.Hashable c, AttributeCPU c i, ShaderType i)+                     => (a -> i)                      -> [c]-                     -> AttrList gs-                     -> AttrList (g ': gs)+                     -> AttrList is+                     -> AttrList (i ': is)  -- | A set of attributes and indices. data Geometry (is :: [*]) = Geometry (AttrList is) [Word16] Int@@ -111,15 +112,40 @@                         --   two lists above.             -> Geometry Geometry2D mkGeometry2D v u = mkGeometry (AttrListCons D2.Position2 v $-                              AttrListCons D2.UV u-                              AttrListNil)+                               AttrListCons D2.UV u+                               AttrListNil) -extend = undefined-remove = undefined +-- | Add an attribute to a geometry.+extend :: (AttributeCPU c i, H.Hashable c, ShaderType i, GLES)+       => (a -> i)              -- ^ Attribute constructor (or any other+                                -- function with that type).+       -> [c]                   -- ^ List of values+       -> Geometry is+       -> Geometry (i ': is)+extend g c (Geometry al es _) = mkGeometry (AttrListCons g c al) es++-- | Remove an attribute from a geometry.+remove :: (RemoveAttr i is is', GLES)+       => (a -> i)      -- ^ Attribute constructor (or any other function with+                        -- that type).+       -> Geometry is -> Geometry is'+remove g (Geometry al es _) = mkGeometry (removeAttr g al) es++class RemoveAttr i is is' where+        removeAttr :: (a -> i) -> AttrList is -> AttrList is'++instance RemoveAttr i (i ': is) is where+        removeAttr _ (AttrListCons _ _ al) = al++instance RemoveAttr i is is' =>+         RemoveAttr i (i1 ': is) (i1 ': is') where+        removeAttr g (AttrListCons g' c al) =+                AttrListCons g' c $ removeAttr g al+ -- | Create a custom 'Geometry'. mkGeometry :: GLES => AttrList is -> [Word16] -> Geometry is-mkGeometry al e = Geometry al e $ H.hash al+mkGeometry al e = Geometry al e $ H.hash (al, e)  castGeometry :: Geometry is -> Geometry is' castGeometry = unsafeCoerce

@@ -4,6 +4,7 @@ {-| Simplified 2D graphics system. -} module FWGL.Graphics.D2 (         module FWGL.Graphics.Generic,+        module Data.Vect.Float,         -- * 2D Objects and Groups         Object2D,         IsObject2D,

@@ -5,6 +5,7 @@ {-| Simplified 3D graphics system. -} module FWGL.Graphics.D3 (         module FWGL.Graphics.Generic,+        module Data.Vect.Float,         -- * 3D Objects         Object3D,         IsObject3D,

@@ -28,6 +28,7 @@         depthSubLayer,         subRenderLayer,         -- ** Render layers+        RenderLayer,         renderColor,         renderDepth,         renderColorDepth,

@@ -13,7 +13,7 @@         resize,         size,         custom,-        -- * IO+        -- * Raw         Input(..),         InputEvent(..),         EventData(..),@@ -29,12 +29,16 @@ data InputEvent = KeyUp | KeyDown | MouseUp | MouseDown | MouseMove | Resize                   deriving (Show, Eq, Enum) --- | The data carried by an event.+-- | The data carried by an event. They're all together in the same structure+-- because this is how it works in JavaScript. data EventData = EventData {         dataFramebufferSize :: Maybe (Int, Int),         dataPointer :: Maybe (Int, Int),         dataButton :: Maybe MouseButton,-        dataKey :: Maybe Key+        dataKey :: Maybe Key,+        dataTime :: Double -- ^ The unit of time is unspecified, this is only+                           -- used to determine the sequence of different+                           -- events. }  -- | The general input.@@ -56,19 +60,21 @@  -- | Keyboard down. key :: Key -> SF (Input a) (Event ())-key k = sscan upDown NoEvent <<< keyUp k &&& keyDown k+key k = sscan upDown NoEvent <<<+        evEdgeTime KeyUp (isKey k) &&& evEdgeTime KeyDown (isKey k)  -- | Mouse press. mouseDown :: MouseButton -> SF (Input a) (Event (Int, Int))-mouseDown b = evPointer MouseDown $ \d -> dataButton d == Just b+mouseDown b = evEdgePointer MouseDown (isButton b) >>^ fmap snd  -- | Mouse release. mouseUp :: MouseButton -> SF (Input a) (Event (Int, Int))-mouseUp b = evPointer MouseUp $ \d -> dataButton d == Just b+mouseUp b = evEdgePointer MouseUp (isButton b) >>^ fmap snd  -- | Mouse down. mouse :: MouseButton -> SF (Input a) (Event (Int, Int))-mouse b = sscan upDown NoEvent <<< mouseUp b &&& mouseDown b+mouse b = sscan upDown NoEvent <<< evEdgePointer MouseUp (isButton b) &&&+                                   evEdgePointer MouseDown (isButton b)  -- | Left click. click :: SF (Input a) (Event (Int, Int))@@ -99,33 +105,54 @@  keyLimited :: KeyCode a => Double -> a -> SF Input (Event ()) -} -upDown :: Event a -> (Event a, Event a) -> Event a-upDown _ (_, Event x) = Event x-upDown (Event _) (Event _, _) = NoEvent-upDown s _ = s+-- TODO: remove Show a+upDown :: Show a => Event a -> (Event (Double, a), Event (Double, a)) -> Event a+upDown _ (NoEvent, Event (_, x)) = Event x+upDown _ (Event _, NoEvent) = NoEvent+upDown _ (Event (t, _), Event (t', x)) | t' > t = Event x+                                       | otherwise = noEvent+upDown e _ = e  isKey :: Key -> EventData -> Bool-isKey k ed = case dataKey ed of-                Just k' -> k == k'-                Nothing -> False+isKey k ed = dataKey ed == Just k +isButton :: MouseButton -> EventData -> Bool+isButton btn evData = dataButton evData == Just btn+ evSearch :: InputEvent -> (EventData -> Bool) -> SF (Input a) (Event EventData)-evSearch ev bP = arr $ \ inp -> case H.lookup ev $ inputEvents inp of-                                        Just bs -> eventHead $ filter bP bs-                                        Nothing -> NoEvent+evSearch ev bP = arr $ \inp -> case H.lookup ev $ inputEvents inp of+                                    Just bs -> eventHead $ filter bP bs+                                    Nothing -> NoEvent  evEdge :: InputEvent -> (EventData -> Bool) -> SF (Input a) (Event ())-evEdge ev bP = evSearch ev bP >>> arr isEvent >>> edge+evEdge ev bP = (evSearch ev bP >>^ isEvent) >>> edge +evEdgeData :: InputEvent -> (EventData -> Bool)+           -> SF (Input a) (Event EventData)+evEdgeData ev bP = (evSearch ev bP >>^ event Nothing Just) >>> edgeJust++evEdgeTime :: InputEvent -> (EventData -> Bool)+           -> SF (Input a) (Event (Double, ()))+evEdgeTime ev bP = evEdgeData ev bP >>^ fmap (flip (,) () . dataTime)++evEdgePointer :: InputEvent -> (EventData -> Bool)+              -> SF (Input a) (Event (Double, (Int, Int)))+evEdgePointer ev bP = evEdgeData ev bP >>^ \med -> +                        case med of+                             Event ed ->+                                case dataPointer ed of+                                     Just ptr -> Event (dataTime ed, ptr)+                                     Nothing -> NoEvent+                             NoEvent -> NoEvent+ evPointer :: InputEvent -> (EventData -> Bool)           -> SF (Input a) (Event (Int, Int))-evPointer ev bP = evSearch ev bP >>>-                 arr (\ e -> case e of-                        Event ed -> case dataPointer ed of-                                        Just (x, y) -> Event (x, y)-                                        _ -> NoEvent-                        NoEvent -> NoEvent-                  )+evPointer ev bP = evSearch ev bP >>^ \e ->+                        case e of+                             Event ed -> case dataPointer ed of+                                              Just ptr -> Event ptr+                                              _ -> NoEvent+                             NoEvent -> NoEvent  eventHead :: [a] -> Event a eventHead [] = NoEvent

@@ -139,6 +139,7 @@ import Control.Concurrent import Control.Monad.IO.Class import Control.Monad.Trans.State+import Data.Int (Int32) import Data.Word import FWGL.Backend.IO (BackendIO, safeFork) import FWGL.Backend.GLES@@ -480,7 +481,7 @@ uniform1fv :: GLES => UniformLocation -> Float32Array -> GL () uniform1fv a b = GL get >>= \ctx -> liftIO $ glUniform1fv ctx a b -uniform1i :: GLES => UniformLocation -> GLInt -> GL ()+uniform1i :: GLES => UniformLocation -> Int32 -> GL () uniform1i a b = GL get >>= \ctx -> liftIO $ glUniform1i ctx a b  uniform1iv :: GLES => UniformLocation -> Int32Array -> GL ()@@ -492,7 +493,7 @@ uniform2fv :: GLES => UniformLocation -> Float32Array -> GL () uniform2fv a b = GL get >>= \ctx -> liftIO $ glUniform2fv ctx a b -uniform2i :: GLES => UniformLocation -> GLInt -> GLInt -> GL ()+uniform2i :: GLES => UniformLocation -> Int32 -> Int32 -> GL () uniform2i a b c = GL get >>= \ctx -> liftIO $ glUniform2i ctx a b c  uniform2iv :: GLES => UniformLocation -> Int32Array -> GL ()@@ -504,7 +505,7 @@ uniform3fv :: GLES => UniformLocation -> Float32Array -> GL () uniform3fv a b = GL get >>= \ctx -> liftIO $ glUniform3fv ctx a b -uniform3i :: GLES => UniformLocation -> GLInt -> GLInt -> GLInt -> GL ()+uniform3i :: GLES => UniformLocation -> Int32 -> Int32 -> Int32 -> GL () uniform3i a b c d = GL get >>= \ctx -> liftIO $ glUniform3i ctx a b c d  uniform3iv :: GLES => UniformLocation -> Int32Array -> GL ()@@ -516,7 +517,7 @@ uniform4fv :: GLES => UniformLocation -> Float32Array -> GL () uniform4fv a b = GL get >>= \ctx -> liftIO $ glUniform4fv ctx a b -uniform4i :: GLES => UniformLocation -> GLInt -> GLInt -> GLInt -> GLInt -> GL ()+uniform4i :: GLES => UniformLocation -> Int32 -> Int32 -> Int32 -> Int32 -> GL () uniform4i a b c d e = GL get >>= \ctx -> liftIO $ glUniform4i ctx a b c d e  uniform4iv :: GLES => UniformLocation -> Int32Array -> GL ()

@@ -45,6 +45,7 @@ -}  module FWGL.Shader (+        -- * Types         Shader,         VertexShader,         FragmentShader,@@ -55,43 +56,60 @@         ShaderType,         UniformCPU,         AttributeCPU,+        STList((:-), N),+        -- ** GPU types+        Bool,         Float,+        Int,         Sampler2D,+        SamplerCube,         Vec2(..),         Vec3(..),         Vec4(..),+        BVec2(..),+        BVec3(..),+        BVec4(..),+        IVec2(..),+        IVec3(..),+        IVec4(..),         Mat2(..),         Mat3(..),         Mat4(..),+        Array,+        -- ** CPU types+        CInt,+        CBool,         CFloat,         CSampler2D,+        CSamplerCube,         CVec2,         CVec3,         CVec4,+        CIVec2,+        CIVec3,+        CIVec4,+        CBVec2,+        CBVec3,+        CBVec4,         CMat2,         CMat3,         CMat4,-        negate,-        fromInteger,-        fromRational,-        (*),-        (/),-        (+),-        (-),-        (^),-        (&&),-        (||),-        (==),-        (>=),-        (<=),-        (<),-        (>),-        ifThenElse,+        CArray,+        toGPUBool,+        -- * Functions         loop,-        true,-        false,         store,         texture2D,+        texture2DBias,+        texture2DProj,+        texture2DProjBias,+        texture2DProj4,+        texture2DProjBias4,+        texture2DLod,+        texture2DProjLod,+        texture2DProjLod4,+        arrayLength,+        -- ** Math functions         radians,         degrees,         sin,@@ -128,34 +146,121 @@         reflect,         refract,         matrixCompMult,-        position,-        fragColor,-        STList((:-), N),+        -- *** Vector relational functions+        VecOrd,+        VecEq,+        lessThan,+        lessThanEqual,+        greaterThan,+        greaterThanEqual,+        equal,+        notEqual,+        BoolVector,+        anyB,+        allB,+        notB,+        -- ** Constructors+        true,+        false,+        ToBool,+        bool,+        ToInt,+        int,+        ToFloat,+        float,+        Components,+        CompList,+        ToCompList,+        (#),+        ToVec2,+        vec2,+        ToVec3,+        vec3,+        ToVec4,+        vec4,+        ToBVec2,+        bvec2,+        ToBVec3,+        bvec3,+        ToBVec4,+        bvec4,+        ToIVec2,+        ivec2,+        ToIVec3,+        ivec3,+        ToIVec4,+        ivec4,+        ToMat2,+        mat2,+        ToMat3,+        mat3,+        ToMat4,+        mat4,+        -- ** Operators+        (*),+        (/),+        (+),+        (-),+        (^),+        (&&),+        (||),+        (==),+        (>=),+        (<=),+        (<),+        (>),+        (!),+        -- ** Rebinding functions+        fromInteger,+        fromRational,+        ifThenElse,+        negate,+        -- ** Prelude functions         (.),         id,         const,         flip,         ($),         CPU.fst,-        CPU.snd+        CPU.snd,+        -- * Variables+        position,+        fragColor,+        fragCoord,+        fragFrontFacing ) where +import qualified Data.Int as CPU import Data.Typeable (Typeable) import qualified Data.Vect.Float as CPU import qualified FWGL.Internal.GL as CPU+import qualified FWGL.Backend.GLES as CPU import FWGL.Shader.CPU-import FWGL.Shader.Language+import FWGL.Shader.Language.Types+import FWGL.Shader.Language.Functions import FWGL.Shader.Shader import FWGL.Shader.Stages import Prelude ((.), id, const, flip, ($)) import qualified Prelude as CPU +-- | Arrays in the CPU.+type CArray a = [a]++-- | 32-bit integers in the CPU.+type CInt = CPU.Int32++-- | Booleans in the CPU.+type CBool = CPU.Int32+ -- | Floats in the CPU. type CFloat = CPU.Float  -- | Samplers in the CPU. type CSampler2D = CPU.ActiveTexture +-- | Samplers in the CPU.+type CSamplerCube = CPU.ActiveTexture+ -- | 2D vectors in the CPU. type CVec2 = CPU.Vec2 @@ -164,6 +269,24 @@  -- | 4D vectors in the CPU. type CVec4 = CPU.Vec4++-- | 2D integer vectors in the CPU.+type CIVec2 = CPU.IVec2++-- | 3D integer vectors in the CPU.+type CIVec3 = CPU.IVec3++-- | 4D integer vectors in the CPU.+type CIVec4 = CPU.IVec4++-- | 2D boolean vectors in the CPU.+type CBVec2 = CPU.IVec2++-- | 3D boolean vectors in the CPU.+type CBVec3 = CPU.IVec3++-- | 4D boolean vectors in the CPU.+type CBVec4 = CPU.IVec4  -- | 2x2 matrices in the CPU. type CMat2 = CPU.Mat2

@@ -1,11 +1,13 @@-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FunctionalDependencies #-}+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses,+             FunctionalDependencies, FlexibleInstances #-}  -- FWGL.Shader.Variables? (+ loadUniform, loadAttribute, inputName, etc.)-module FWGL.Shader.CPU (UniformCPU(..), AttributeCPU(..)) where+module FWGL.Shader.CPU (UniformCPU(..), AttributeCPU(..), toGPUBool) where +import qualified Data.Int as CPU import Data.Word (Word) import Data.Typeable-import qualified FWGL.Shader.Language as GPU+import qualified FWGL.Shader.Language.Types as GPU import FWGL.Internal.GL as CPU import qualified Data.Vect.Float as CPU import Prelude as CPU@@ -19,37 +21,173 @@         encodeAttribute :: g -> [c] -> GL Array         setAttribute :: g -> GLUInt -> GL () +-- Float+ instance GLES => UniformCPU CPU.Float GPU.Float where         setUniform l _ v = uniform1f l v +instance (Typeable n, GLES) =>+         UniformCPU [CPU.Float] (GPU.Array n GPU.Float) where+        setUniform l _ v = liftIO (encodeFloats v) >>= uniform1fv l+ instance GLES => AttributeCPU CPU.Float GPU.Float where-        encodeAttribute _ a = liftIO $ encodeFloats a-        setAttribute _ i = attr i 1+        encodeAttribute _ a = liftIO . fmap fromFloat32Array $ encodeFloats a+        setAttribute _ i = attr gl_FLOAT i 1 +-- Bool++instance GLES => UniformCPU CPU.Int32 GPU.Bool where+        setUniform l _ v = uniform1i l v++instance (Typeable n, GLES) =>+         UniformCPU [CPU.Int32] (GPU.Array n GPU.Bool) where+        setUniform l _ v = liftIO (encodeInts v) >>= uniform1iv l++instance GLES => AttributeCPU CPU.Int32 GPU.Bool where+        encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeInts a+        setAttribute _ i = attr gl_INT i 1++-- Int++instance GLES => UniformCPU CPU.Int32 GPU.Int where+        setUniform l _ v = uniform1i l v++instance (Typeable n, GLES) =>+         UniformCPU [CPU.Int32] (GPU.Array n GPU.Int) where+        setUniform l _ v = liftIO (encodeInts v) >>= uniform1iv l++instance GLES => AttributeCPU CPU.Int32 GPU.Int where+        encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeInts a+        setAttribute _ i = attr gl_INT i 1++-- TODO: sampler arrays (they're problematic to safely access in the shaders)+-- Samplers+ instance GLES => UniformCPU CPU.ActiveTexture GPU.Sampler2D where         setUniform l _ (CPU.ActiveTexture v) = uniform1i l $ fromIntegral v +instance GLES => UniformCPU CPU.ActiveTexture GPU.SamplerCube where+        setUniform l _ (CPU.ActiveTexture v) = uniform1i l $ fromIntegral v++-- Vec2+ instance GLES => UniformCPU CPU.Vec2 GPU.Vec2 where         setUniform l _ (CPU.Vec2 x y) = uniform2f l x y +instance (Typeable n, GLES) =>+         UniformCPU [CPU.Vec2] (GPU.Array n GPU.Vec2) where+        setUniform l _ v = liftIO (encodeVec2s v) >>= uniform2fv l+ instance GLES => AttributeCPU CPU.Vec2 GPU.Vec2 where-        encodeAttribute _ a = liftIO $ encodeVec2s a-        setAttribute _ i = attr i 2+        encodeAttribute _ a = liftIO . fmap fromFloat32Array $ encodeVec2s a+        setAttribute _ i = attr gl_FLOAT i 2 +-- Vec3+ instance GLES => UniformCPU CPU.Vec3 GPU.Vec3 where         setUniform l _ (CPU.Vec3 x y z) = uniform3f l x y z +instance (Typeable n, GLES) =>+         UniformCPU [CPU.Vec3] (GPU.Array n GPU.Vec3) where+        setUniform l _ v = liftIO (encodeVec3s v) >>= uniform3fv l+ instance GLES => AttributeCPU CPU.Vec3 GPU.Vec3 where-        encodeAttribute _ a = liftIO $ encodeVec3s a-        setAttribute _ i = attr i 3+        encodeAttribute _ a = liftIO . fmap fromFloat32Array $ encodeVec3s a+        setAttribute _ i = attr gl_FLOAT i 3 +-- Vec4+ instance GLES => UniformCPU CPU.Vec4 GPU.Vec4 where         setUniform l _ (CPU.Vec4 x y z w) = uniform4f l x y z w +instance (Typeable n, GLES) =>+         UniformCPU [CPU.Vec4] (GPU.Array n GPU.Vec4) where+        setUniform l _ v = liftIO (encodeVec4s v) >>= uniform4fv l+ instance GLES => AttributeCPU CPU.Vec4 GPU.Vec4 where-        encodeAttribute _ a = liftIO $ encodeVec4s a-        setAttribute _ i = attr i 4+        encodeAttribute _ a = liftIO . fmap fromFloat32Array $ encodeVec4s a+        setAttribute _ i = attr gl_FLOAT i 4 +-- IVec2++instance GLES => UniformCPU CPU.IVec2 GPU.IVec2 where+        setUniform l _ (CPU.IVec2 x y) = uniform2i l x y++instance (Typeable n, GLES) =>+         UniformCPU [CPU.IVec2] (GPU.Array n GPU.IVec2) where+        setUniform l _ v = liftIO (encodeIVec2s v) >>= uniform2iv l++instance GLES => AttributeCPU CPU.IVec2 GPU.IVec2 where+        encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeIVec2s a+        setAttribute _ i = attr gl_INT i 2++-- IVec3++instance GLES => UniformCPU CPU.IVec3 GPU.IVec3 where+        setUniform l _ (CPU.IVec3 x y z) = uniform3i l x y z++instance (Typeable n, GLES) =>+         UniformCPU [CPU.IVec3] (GPU.Array n GPU.IVec3) where+        setUniform l _ v = liftIO (encodeIVec3s v) >>= uniform3iv l++instance GLES => AttributeCPU CPU.IVec3 GPU.IVec3 where+        encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeIVec3s a+        setAttribute _ i = attr gl_INT i 3++-- IVec4++instance GLES => UniformCPU CPU.IVec4 GPU.IVec4 where+        setUniform l _ (CPU.IVec4 x y z w) = uniform4i l x y z w++instance (Typeable n, GLES) =>+         UniformCPU [CPU.IVec4] (GPU.Array n GPU.IVec4) where+        setUniform l _ v = liftIO (encodeIVec4s v) >>= uniform4iv l++instance GLES => AttributeCPU CPU.IVec4 GPU.IVec4 where+        encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeIVec4s a+        setAttribute _ i = attr gl_INT i 4++-- BVec2++instance GLES => UniformCPU CPU.IVec2 GPU.BVec2 where+        setUniform l _ (CPU.IVec2 x y) = uniform2i l x y++instance (Typeable n, GLES) =>+         UniformCPU [CPU.IVec2] (GPU.Array n GPU.BVec2) where+        setUniform l _ v = liftIO (encodeIVec2s v) >>= uniform2iv l++instance GLES => AttributeCPU CPU.IVec2 GPU.BVec2 where+        encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeIVec2s a+        setAttribute _ i = attr gl_INT i 2++-- BVec3++instance GLES => UniformCPU CPU.IVec3 GPU.BVec3 where+        setUniform l _ (CPU.IVec3 x y z) = uniform3i l x y z++instance (Typeable n, GLES) =>+         UniformCPU [CPU.IVec3] (GPU.Array n GPU.BVec3) where+        setUniform l _ v = liftIO (encodeIVec3s v) >>= uniform3iv l++instance GLES => AttributeCPU CPU.IVec3 GPU.BVec3 where+        encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeIVec3s a+        setAttribute _ i = attr gl_INT i 3++-- BVec4++instance GLES => UniformCPU CPU.IVec4 GPU.BVec4 where+        setUniform l _ (CPU.IVec4 x y z w) = uniform4i l x y z w++instance (Typeable n, GLES) =>+         UniformCPU [CPU.IVec4] (GPU.Array n GPU.BVec4) where+        setUniform l _ v = liftIO (encodeIVec4s v) >>= uniform4iv l++instance GLES => AttributeCPU CPU.IVec4 GPU.BVec4 where+        encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeIVec4s a+        setAttribute _ i = attr gl_INT i 4++-- Matrices+ instance GLES => UniformCPU CPU.Mat2 GPU.Mat2 where         setUniform l _ m = liftIO (encodeMat2 m) >>= uniformMatrix2fv l false @@ -59,5 +197,9 @@ instance GLES => UniformCPU CPU.Mat4 GPU.Mat4 where         setUniform l _ m = liftIO (encodeMat4 m) >>= uniformMatrix4fv l false -attr :: GLES => GLUInt -> GLInt -> GL ()-attr i s = vertexAttribPointer i s gl_FLOAT false 0 nullGLPtr+attr :: GLES => GLEnum -> GLUInt -> GLInt -> GL ()+attr t i s = vertexAttribPointer i s t false 0 nullGLPtr++toGPUBool :: CPU.Bool -> CPU.Int32+toGPUBool True = 1+toGPUBool False = 0

@@ -15,8 +15,7 @@ import qualified Data.HashMap.Strict as H import Data.Typeable import FWGL.Shader.Shader-import FWGL.Shader.Language ( Expr(..), ShaderType(..), Unknown, Action(..)-                            , ContextVarType(..) )+import FWGL.Shader.Language.Types hiding (Int, Bool) import FWGL.Shader.Stages (VertexShader, FragmentShader, ValidVertex) import Text.Printf @@ -216,8 +215,12 @@ compileExpr (Literal s) = (s, H.empty, H.empty) compileExpr (Action a) = let h = hash a                          in (actionName h, H.singleton h a, H.empty)-compileExpr (ContextVar i t) = (contextVarName t i, H.empty, H.singleton i ()) compileExpr (Dummy _) = error "compileExpr: Dummy"+compileExpr (ArrayIndex eArr ei) = let (arr, aArr, cArr) = compileExpr eArr+                                       (i, ai, ci) = compileExpr ei+                                   in ( "(" ++ arr ++ "[" ++ i ++ "])"+                                      , H.union aArr ai, H.union cArr ci )+compileExpr (ContextVar i t) = (contextVarName t i, H.empty, H.singleton i ())  first3 :: (a -> a') -> (a, b, c) -> (a', b, c) first3 f (a, b, c) = (f a, b, c)

@@ -1,646 +0,0 @@-{-# LANGUAGE GADTs, MultiParamTypeClasses, DeriveDataTypeable, DataKinds,-             FunctionalDependencies #-}---- TODO FWGL.Shader.Language.Prefix and FWGL.Shader.Prefix (or Postfix)-module FWGL.Shader.Language (-        ShaderType(..),-        Expr(..),-        Action(..),-        ContextVarType(..),-        Float(..),-        Unknown(..),-        Sampler2D(..),-        Vec2(..),-        Vec3(..),-        Vec4(..),-        Mat2(..),-        Mat3(..),-        Mat4(..),-        fromRational,-        fromInteger,-        negate,-        Mul,-        (*),-        (/),-        Sum,-        (+),-        (-),-        (^),-        (&&),-        (||),-        (==),-        (>=),-        (<=),-        (<),-        (>),-        ifThenElse,-        loop,-        true,-        false,-        store,-        texture2D,-        radians,-        degrees,-        sin,-        cos,-        tan,-        asin,-        acos,-        atan,-        atan2,-        exp,-        log,-        exp2,-        log2,-        sqrt,-        inversesqrt,-        abs,-        sign,-        floor,-        ceil,-        fract,-        mod,-        min,-        max,-        clamp,-        mix,-        step,-        smoothstep,-        length,-        distance,-        dot,-        cross,-        normalize,-        faceforward,-        reflect,-        refract,-        matrixCompMult,-        position,-        fragColor-        -- TODO: memoized versions of the functions-) where--import Control.Applicative-import Control.Monad-import Data.Hashable-import Data.IORef-import Data.Typeable-import Prelude (String, (.), ($), error, Maybe(..), const, fst, snd, Eq)-import qualified Prelude-import Text.Printf-import System.IO.Unsafe---- | CPU integer.-type CInt = Prelude.Int---- | An expression.-data Expr = Empty | Read String | Op1 String Expr | Op2 String Expr Expr-          | Apply String [Expr] | X Expr | Y Expr | Z Expr | W Expr-          | Literal String | Action Action | Dummy CInt-          | ContextVar CInt ContextVarType-          deriving Eq---- | Expressions that are transformed to statements.-data Action = Store String Expr | If Expr String Expr Expr-            | For CInt String Expr (Expr -> Expr -> (Expr, Expr))--data ContextVarType = LoopIteration | LoopValue deriving Eq---- | A GPU boolean.-newtype Bool = Bool Expr deriving Typeable---- | A GPU float.-newtype Float = Float Expr deriving Typeable---- | A GPU sampler (sampler2D in GLSL).-newtype Sampler2D = Sampler2D Expr deriving Typeable---- | The type of a generic expression.-newtype Unknown = Unknown Expr---- | A GPU 2D vector.--- NB: This is a different type from Data.Vect.Float.'Data.Vect.Float.Vec2'.-data Vec2 = Vec2 Float Float deriving (Typeable)---- | A GPU 3D vector.-data Vec3 = Vec3 Float Float Float deriving (Typeable)---- | A GPU 4D vector.-data Vec4 = Vec4 Float Float Float Float deriving (Typeable)---- | A GPU 2x2 matrix.-data Mat2 = Mat2 Vec2 Vec2 deriving (Typeable)---- | A GPU 3x3 matrix.-data Mat3 = Mat3 Vec3 Vec3 Vec3 deriving (Typeable)---- | A GPU 4x4 matrix.-data Mat4 = Mat4 Vec4 Vec4 Vec4 Vec4 deriving (Typeable)---- | CPU equality.-infix 4 =!-(=!) :: Prelude.Eq a => a -> a -> Prelude.Bool-(=!) = (Prelude.==)---- | CPU and.-infixr 3 &&!-(&&!) :: Prelude.Bool -> Prelude.Bool -> Prelude.Bool-(&&!) = (Prelude.&&)---- | A type in the GPU.-class ShaderType t where-        zero :: t--        toExpr :: t -> Expr--        fromExpr :: Expr -> t--        typeName :: t -> String--        size :: t -> CInt--instance ShaderType Unknown where-        zero = error "zero: Unknown type."-        toExpr (Unknown e) = e-        fromExpr = Unknown-        typeName = error "typeName: Unknown type."-        size = error "size: Unknown type."--instance ShaderType Bool where-        zero = Bool $ Literal "false"--        toExpr (Bool e) = e--        fromExpr = Bool--        typeName _ = "bool"--        size _ = 1--instance ShaderType Float where-        zero = Float $ Literal "0.0"--        toExpr (Float e) = e--        fromExpr = Float--        typeName _ = "float"--        size _ = 1--instance ShaderType Sampler2D where-        zero = Sampler2D $ Literal "0"--        toExpr (Sampler2D e) = e--        fromExpr = Sampler2D--        typeName _ = "sampler2D"--        size _ = 1--instance ShaderType Vec2 where-        zero = Vec2 zero zero--        toExpr (Vec2 (Float (X v)) (Float (Y v'))) | v =! v' = Apply "vec2" [v]-        toExpr (Vec2 (Float x) (Float y)) = Apply "vec2" [x, y]--        fromExpr v = Vec2 (Float (X v)) (Float (Y v))--        typeName _ = "vec2"--        size _ = 1--instance ShaderType Vec3 where-        zero = Vec3 zero zero zero--        toExpr (Vec3 (Float (X v)) (Float (Y v')) (Float (Z v'')))-               | v =! v' &&! v' =! v'' = Apply "vec3" [v]-        toExpr (Vec3 (Float x) (Float y) (Float z)) = Apply "vec3" [x, y, z]--        fromExpr v = Vec3 (Float (X v)) (Float (Y v)) (Float (Z v))--        typeName _ = "vec3"--        size _ = 1--instance ShaderType Vec4 where-        zero = Vec4 zero zero zero zero--        toExpr (Vec4 (Float (X v)) (Float (Y v1)) (Float (Z v2)) (Float (W v3)))-               | v =! v1 &&! v1 =! v2 &&! v2 =! v3 = Apply "vec4" [v]-        toExpr (Vec4 (Float x) (Float y) (Float z) (Float w)) =-                Apply "vec4" [x, y, z, w]--        fromExpr v = Vec4 (Float (X v)) (Float (Y v)) (Float (Z v)) (Float (W v))--        typeName _ = "vec4"--        size _ = 1--instance ShaderType Mat2 where-        zero = Mat2 zero zero--        toExpr (Mat2 (Vec2 (Float (X (X m))) (Float (X (Y m1))))-                     (Vec2 (Float (Y (X m2))) (Float (Y (Y m3)))))-               | m =! m1 &&! m1 =! m2 &&! m2 =! m3 = Apply "mat2" [m]-        toExpr (Mat2 (Vec2 (Float xx) (Float xy))-                     (Vec2 (Float yx) (Float yy)))-               = Apply "mat2" [xx, yx, xy, yy]--        fromExpr m = Mat2 (Vec2 (Float (X (X m))) (Float (Y (X m))))-                          (Vec2 (Float (Y (X m))) (Float (Y (Y m))))--        typeName _ = "mat2"--        size _ = 2--instance ShaderType Mat3 where-        zero = Mat3 zero zero zero--        toExpr (Mat3 (Vec3 (Float (X (X m)))-                           (Float (X (Y m1)))-                           (Float (X (Z m2))))-                     (Vec3 (Float (Y (X m3)))-                           (Float (Y (Y m4)))-                           (Float (Y (Z m5))))-                     (Vec3 (Float (Z (X m6)))-                           (Float (Z (Y m7)))-                           (Float (Z (Z m8)))))-               | m =! m1 &&! m1 =! m2 &&! m2 =! m3 &&! m3 =! m4 &&!-                 m4 =! m5 &&! m5 =! m6 &&! m6 =! m7 &&! m7 =! m8 =-                         Apply "mat3" [m]-        toExpr (Mat3 (Vec3 (Float xx) (Float xy) (Float xz))-                     (Vec3 (Float yx) (Float yy) (Float yz))-                     (Vec3 (Float zx) (Float zy) (Float zz)))-               = Apply "mat3" [xx, yx, zx, xy, yy, zy, xz, yz, zz]--        fromExpr m = Mat3 (Vec3 (Float (X (X m)))-                                (Float (X (Y m)))-                                (Float (X (Z m))))-                          (Vec3 (Float (Y (X m)))-                                (Float (Y (Y m)))-                                (Float (Y (Z m))))-                          (Vec3 (Float (Z (X m)))-                                (Float (Z (Y m)))-                                (Float (Z (Z m))))--        typeName _ = "mat3"--        size _ = 3--instance ShaderType Mat4 where-        zero = Mat4 zero zero zero zero--        toExpr (Mat4 (Vec4 (Float (X (X m)))-                           (Float (X (Y m1)))-                           (Float (X (Z m2)))-                           (Float (X (W m3))))-                     (Vec4 (Float (Y (X m4)))-                           (Float (Y (Y m5)))-                           (Float (Y (Z m6)))-                           (Float (Y (W m7))))-                     (Vec4 (Float (Z (X m8)))-                           (Float (Z (Y m9)))-                           (Float (Z (Z m10)))-                           (Float (Z (W m11))))-                     (Vec4 (Float (W (X m12)))-                           (Float (W (Y m13)))-                           (Float (W (Z m14)))-                           (Float (W (W m15)))))-               | m =! m1 &&! m1 =! m2 &&! m2 =! m3 &&! m3 =! m4 &&!-                 m4 =! m5 &&! m5 =! m6 &&! m6 =! m7 &&! m7 =! m8 &&!-                 m8 =! m9 &&! m9 =! m10 &&! m10 =! m11 &&! m11 =! m12 &&!-                 m12 =! m13 &&! m13 =! m14 &&! m14 =! m15 = Apply "mat4" [m]-        toExpr (Mat4 (Vec4 (Float xx) (Float xy) (Float xz) (Float xw))-                     (Vec4 (Float yx) (Float yy) (Float yz) (Float yw))-                     (Vec4 (Float zx) (Float zy) (Float zz) (Float zw))-                     (Vec4 (Float wx) (Float wy) (Float wz) (Float ww)))-               = Apply "mat4" [ xx, yx, zx, wx-                              , xy, yy, zy, wy-                              , xz, yz, zz, wz-                              , xw, yw, zw, ww ]--        fromExpr m = Mat4 (Vec4 (Float (X (X m)))-                                (Float (X (Y m)))-                                (Float (X (Z m)))-                                (Float (X (W m))))-                          (Vec4 (Float (Y (X m)))-                                (Float (Y (Y m)))-                                (Float (Y (Z m)))-                                (Float (Y (W m))))-                          (Vec4 (Float (Z (X m)))-                                (Float (Z (Y m)))-                                (Float (Z (Z m)))-                                (Float (Z (W m))))-                          (Vec4 (Float (W (X m)))-                                (Float (W (Y m)))-                                (Float (W (Z m)))-                                (Float (W (W m))))--        typeName _ = "mat4"--        size _ = 4--class ShaderType a => Vector a-instance Vector Vec2-instance Vector Vec3-instance Vector Vec4--class ShaderType a => Matrix a-instance Matrix Mat2-instance Matrix Mat3-instance Matrix Mat4---- | Types that can be multiplied.-class Mul a b c | a b -> c-instance Mul Float Float Float-instance Mul Vec2 Vec2 Vec2-instance Mul Vec3 Vec3 Vec3-instance Mul Vec4 Vec4 Vec4-instance Mul Vec2 Float Vec2-instance Mul Vec3 Float Vec3-instance Mul Vec4 Float Vec4-instance Mul Float Vec2 Vec2-instance Mul Float Vec3 Vec3-instance Mul Float Vec4 Vec4-instance Mul Mat2 Mat2 Mat2-instance Mul Mat3 Mat3 Mat3-instance Mul Mat4 Mat4 Mat4-instance Mul Mat2 Float Mat2-instance Mul Mat3 Float Mat3-instance Mul Mat4 Float Mat4-instance Mul Float Mat2 Mat2-instance Mul Float Mat3 Mat3-instance Mul Float Mat4 Mat4-instance Mul Mat2 Vec2 Vec2-instance Mul Mat3 Vec3 Vec3-instance Mul Mat4 Vec4 Vec4-instance Mul Vec2 Mat2 Vec2-instance Mul Vec3 Mat3 Vec3-instance Mul Vec4 Mat4 Vec4---- | Floats or vectors.-class ShaderType a => GenType a-instance GenType Float-instance GenType Vec2-instance GenType Vec3-instance GenType Vec4--infixl 7 *-(*) :: (Mul a b c, ShaderType a, ShaderType b, ShaderType c) => a -> b -> c-x * y = fromExpr $ Op2 "*" (toExpr x) (toExpr y)--infixl 7 /-(/) :: (Mul a b c, ShaderType a, ShaderType b, ShaderType c) => a -> b -> c-x / y = fromExpr $ Op2 "/" (toExpr x) (toExpr y)---- | Types that can be added.-class Sum a-instance Sum Float-instance Sum Vec2-instance Sum Vec3-instance Sum Vec4-instance Sum Mat2-instance Sum Mat3-instance Sum Mat4--infixl 6 +-(+) :: (Sum a, ShaderType a) => a -> a -> a-x + y = fromExpr $ Op2 "+" (toExpr x) (toExpr y)--infixl 6 --(-) :: (Sum a, ShaderType a) => a -> a -> a-x - y = fromExpr $ Op2 "-" (toExpr x) (toExpr y)--infixr 8 ^--- TODO: type-unsafe?-(^) :: (ShaderType a, ShaderType b) => a -> b -> a-x ^ y = fromExpr $ Apply "pow" [toExpr x, toExpr y]--infixr 3 &&-(&&) :: Bool -> Bool -> Bool-x && y = fromExpr $ Op2 "&&" (toExpr x) (toExpr y)--infixr 2 ||-(||) :: Bool -> Bool -> Bool-x || y = fromExpr $ Op2 "||" (toExpr x) (toExpr y)--infix 4 ==-(==) :: ShaderType a => a -> a -> Bool-x == y = fromExpr $ Op2 "==" (toExpr x) (toExpr y)--infix 4 /=-(/=) :: ShaderType a => a -> a -> Bool-x /= y = fromExpr $ Op2 "!=" (toExpr x) (toExpr y)--infix 4 >=-(>=) :: ShaderType a => a -> a -> Bool-x >= y = fromExpr $ Op2 ">=" (toExpr x) (toExpr y)--infix 4 <=-(<=) :: ShaderType a => a -> a -> Bool-x <= y = fromExpr $ Op2 "<=" (toExpr x) (toExpr y)--infix 4 <-(<) :: ShaderType a => a -> a -> Bool-x < y = fromExpr $ Op2 "<" (toExpr x) (toExpr y)--infix 4 >-(>) :: ShaderType a => a -> a -> Bool-x > y = fromExpr $ Op2 ">" (toExpr x) (toExpr y)---- TODO: not--negate :: GenType a => a -> a-negate v = fromExpr $ Op1 "-" (toExpr v)--fromInteger :: Prelude.Integer -> Float -- Integer-fromInteger = fromRational . Prelude.fromIntegral--fromRational :: Prelude.Rational -> Float-fromRational = Float . Literal-                        . (printf "%f" :: Prelude.Float -> String)-                        . Prelude.fromRational--radians :: GenType a => a -> a-radians x = fromExpr $ Apply "radians" [toExpr x]--degrees :: GenType a => a -> a-degrees x = fromExpr $ Apply "degrees" [toExpr x]--sin :: GenType a => a -> a-sin x = fromExpr $ Apply "sin" [toExpr x]--cos :: GenType a => a -> a-cos x = fromExpr $ Apply "cos" [toExpr x]--tan :: GenType a => a -> a-tan x = fromExpr $ Apply "tan" [toExpr x]--asin :: GenType a => a -> a-asin x = fromExpr $ Apply "asin" [toExpr x]--acos :: GenType a => a -> a-acos x = fromExpr $ Apply "acos" [toExpr x]--atan :: GenType a => a -> a-atan x = fromExpr $ Apply "atan" [toExpr x]--atan2 :: GenType a => a -> a -> a-atan2 x y = fromExpr $ Apply "atan" [toExpr x, toExpr y]--exp :: GenType a => a -> a-exp x = fromExpr $ Apply "exp" [toExpr x]--log :: GenType a => a -> a-log x = fromExpr $ Apply "log" [toExpr x]--exp2 :: GenType a => a -> a-exp2 x = fromExpr $ Apply "exp2" [toExpr x]--log2 :: GenType a => a -> a-log2 x = fromExpr $ Apply "log2" [toExpr x]--sqrt :: GenType a => a -> a-sqrt x = fromExpr $ Apply "sqrt" [toExpr x]--inversesqrt :: GenType a => a -> a-inversesqrt x = fromExpr $ Apply "inversesqrt" [toExpr x]--abs :: GenType a => a -> a-abs x = fromExpr $ Apply "abs" [toExpr x]--sign :: GenType a => a -> a-sign x = fromExpr $ Apply "sign" [toExpr x]--floor :: GenType a => a -> a-floor x = fromExpr $ Apply "floor" [toExpr x]--ceil :: GenType a => a -> a-ceil x = fromExpr $ Apply "ceil" [toExpr x]--fract :: GenType a => a -> a-fract x = fromExpr $ Apply "fract" [toExpr x]--mod :: (GenType a, GenType b) => a -> b -> a-mod x y = fromExpr $ Apply "mod" [toExpr x, toExpr y]--min :: GenType a => a -> a -> a-min x y = fromExpr $ Apply "min" [toExpr x, toExpr y]--max :: GenType a => a -> a -> a-max x y = fromExpr $ Apply "max" [toExpr x, toExpr y]--clamp :: (GenType a, GenType b) => a -> b -> b -> a-clamp x y z = fromExpr $ Apply "clamp" [toExpr x, toExpr y, toExpr z]--mix :: (GenType a, GenType b) => a -> a -> b -> a-mix x y z = fromExpr $ Apply "mix" [toExpr x, toExpr y, toExpr z]--step :: GenType a => a -> a -> a-step x y = fromExpr $ Apply "step" [toExpr x, toExpr y]--smoothstep :: (GenType a, GenType b) => b -> b -> a -> a-smoothstep x y z = fromExpr $ Apply "smoothstep" [toExpr x, toExpr y, toExpr z]--length :: GenType a => a -> Float-length x = fromExpr $ Apply "length" [toExpr x]--distance :: GenType a => a -> a -> Float-distance x y = fromExpr $ Apply "distance" [toExpr x, toExpr y]--dot :: GenType a => a -> a -> Float-dot x y = fromExpr $ Apply "dot" [toExpr x, toExpr y]--cross :: Vec3 -> Vec3 -> Vec3-cross x y = fromExpr $ Apply "cross" [toExpr x, toExpr y]--normalize :: GenType a => a -> a-normalize x = fromExpr $ Apply "normalize" [toExpr x]--faceforward :: GenType a => a -> a -> a -> a-faceforward x y z = fromExpr $ Apply "faceforward" [toExpr x, toExpr y, toExpr z]--reflect :: GenType a => a -> a -> a-reflect x y = fromExpr $ Apply "reflect" [toExpr x, toExpr y]--refract :: GenType a => a -> a -> Float -> a-refract x y z = fromExpr $ Apply "refract" [toExpr x, toExpr y, toExpr z]---- TODO: unsafe-matrixCompMult :: (Matrix a, Matrix b, Matrix c) => a -> b -> c-matrixCompMult x y = fromExpr $ Apply "matrixCompMult" [toExpr x, toExpr y]---- | Avoid executing this expression more than one time. Conditionals and loops--- imply it.-store :: ShaderType a => a -> a-store x = fromExpr . Action $ Store (typeName x) (toExpr x)--true :: Bool-true = Bool $ Literal "true"--false :: Bool-false = Bool $ Literal "false"---- | Rebound if. You don't need to use this function, with -XRebindableSyntax.-ifThenElse :: ShaderType a => Bool -> a -> a -> a-ifThenElse b t f = fromExpr . Action $ If (toExpr b) (typeName t)-                                          (toExpr t) (toExpr f)--loop :: ShaderType a -     => Float -- ^ Maximum number of iterations (should be as low as possible, must be an integer literal)-     -> a -- ^ Initial value-     -> (Float -> a -> (a, Bool)) -- ^ Iteration -> Old value -> (Next, Stop)-     -> a-loop (Float (Literal iters)) iv f =-        fromExpr . Action $-                For (Prelude.floor (Prelude.read iters :: Prelude.Float))-                    (typeName iv)-                    (toExpr iv)-                    (\ie ve -> let (next, stop) = f (fromExpr ie) (fromExpr ve)-                               in (toExpr next, toExpr stop))-loop _ _ _ = error "loop: iteration number is not a literal."--texture2D :: Sampler2D -> Vec2 -> Vec4-texture2D (Sampler2D s) v = fromExpr $ Apply "texture2D" [s, toExpr v]---- | The position of the vertex (only works in the vertex shader).-position :: Vec4-position = fromExpr $ Read "gl_Position"---- | The color of the fragment (only works in the fragment shader).-fragColor :: Vec4-fragColor = fromExpr $ Read "gl_FragColor"--instance Hashable Expr where-        hashWithSalt s e = case e of-                                Empty -> hash2 s 0 (0 :: CInt)-                                Read str -> hash2 s 1 str-                                Op1 str exp -> hash2 s 2 (str, exp)-                                Op2 str exp exp' -> hash2 3 s (str, exp, exp')-                                Apply str exps -> hash2 4 s exps-                                X exp -> hash2 5 s exp-                                Y exp -> hash2 6 s exp-                                Z exp -> hash2 7 s exp-                                W exp -> hash2 8 s exp-                                Literal str -> hash2 s 9 str-                                Action hash -> hash2 s 10 hash-                                Dummy i -> hash2 s 11 i-                                ContextVar i LoopIteration -> hash2 s 12 i-                                ContextVar i LoopValue -> hash2 s 13 i--instance Hashable Action where-        hashWithSalt s (Store t e) = hash2 s 0 (t, e)-        hashWithSalt s (If eb tt et ef) = hash2 s 1 (eb, tt, et, ef)-        hashWithSalt s (For iters tv iv eFun) =-                let baseHash = hash (iters, tv, iv, eFun (Dummy 0) (Dummy 1))-                in hash2 s 2 ( baseHash-                             , eFun (Dummy baseHash)-                                    (Dummy $ baseHash Prelude.+ 1))--instance Prelude.Eq Action where-        a == a' = hash a =! hash a'--hash2 :: Hashable a => CInt -> CInt -> a -> CInt-hash2 s i x = s `hashWithSalt` i `hashWithSalt` x

@@ -0,0 +1,632 @@+{-# LANGUAGE DataKinds, MultiParamTypeClasses, FunctionalDependencies,+             KindSignatures, TypeOperators, TypeFamilies, GADTs,+             FlexibleInstances, UndecidableInstances, OverlappingInstances,+             ConstraintKinds, FlexibleContexts #-}+module FWGL.Shader.Language.Functions where++import FWGL.Shader.Language.Types++import GHC.Exts (Constraint)+import GHC.TypeLits+import Text.Printf+import Prelude (String, (.), ($), error, Eq)+import qualified Prelude++-- TODO: memoized versions of the functions++class Base a b | a -> b+instance Base Int Int+instance Base IVec2 Int+instance Base IVec3 Int+instance Base IVec4 Int+instance Base Float Float+instance Base Vec2 Float+instance Base Vec3 Float+instance Base Vec4 Float+instance Base Mat2 Float+instance Base Mat3 Float+instance Base Mat4 Float++class (Base a aBase, Base b bBase) =>+      Arithmetic aBase bBase a b result | a b -> result+                                        , b -> aBase bBase+                                        , a -> aBase bBase+                                        , result -> aBase bBase++instance Arithmetic Float Float Float Float Float+instance Arithmetic Float Float Vec2 Vec2 Vec2+instance Arithmetic Float Float Vec3 Vec3 Vec3+instance Arithmetic Float Float Vec4 Vec4 Vec4+instance Arithmetic Float Float Vec2 Float Vec2+instance Arithmetic Float Float Vec3 Float Vec3+instance Arithmetic Float Float Vec4 Float Vec4+instance Arithmetic Float Float Float Vec2 Vec2+instance Arithmetic Float Float Float Vec3 Vec3+instance Arithmetic Float Float Float Vec4 Vec4+instance Arithmetic Float Float Mat2 Mat2 Mat2+instance Arithmetic Float Float Mat3 Mat3 Mat3+instance Arithmetic Float Float Mat4 Mat4 Mat4+instance Arithmetic Float Float Mat2 Float Mat2+instance Arithmetic Float Float Mat3 Float Mat3+instance Arithmetic Float Float Mat4 Float Mat4+instance Arithmetic Float Float Float Mat2 Mat2+instance Arithmetic Float Float Float Mat3 Mat3+instance Arithmetic Float Float Float Mat4 Mat4++instance Arithmetic Int Int Int Int Int+instance Arithmetic Int Int IVec2 IVec2 IVec2+instance Arithmetic Int Int IVec3 IVec3 IVec3+instance Arithmetic Int Int IVec4 IVec4 IVec4+instance Arithmetic Int Int IVec2 Int IVec2+instance Arithmetic Int Int IVec3 Int IVec3+instance Arithmetic Int Int IVec4 Int IVec4+instance Arithmetic Int Int Int IVec2 IVec2+instance Arithmetic Int Int Int IVec3 IVec3+instance Arithmetic Int Int Int IVec4 IVec4++-- | Types that can be multiplied.+class (Base a aBase, Base b bBase) =>+      Mul aBase bBase a b result | a b -> result+                                 , b -> aBase bBase+                                 , a -> aBase bBase+                                 , result -> aBase bBase+instance Mul Float Float Mat2 Vec2 Vec2+instance Mul Float Float Mat3 Vec3 Vec3+instance Mul Float Float Mat4 Vec4 Vec4+instance Mul Float Float Vec2 Mat2 Vec2+instance Mul Float Float Vec3 Mat3 Vec3+instance Mul Float Float Vec4 Mat4 Vec4+instance Arithmetic aBase bBase a b result => Mul aBase bBase a b result++class (ShaderType a, Base a Float) => FloatVec a+instance FloatVec Vec2+instance FloatVec Vec3+instance FloatVec Vec4++-- | Floats or vectors.+class ShaderType a => GenType a+instance GenType Float+instance FloatVec a => GenType a++type family GenTypeFloatConstr a b where+        GenTypeFloatConstr a Float = GenType a+        GenTypeFloatConstr a a = GenType a++type GenTypeFloat a b = (GenTypeFloatConstr a b, ShaderType a, ShaderType b)++infixl 7 *+(*) :: (Mul aBase bBase a b c, ShaderType a, ShaderType b, ShaderType c)+    => a -> b -> c+(*) = op2 "*"++infixl 7 /+(/) :: (Arithmetic aBase bBase a b c, ShaderType a, ShaderType b, ShaderType c)+    => a -> b -> c+(/) = op2 "/"++infixl 6 ++(+) :: (Arithmetic aBase bBase a b c, ShaderType a, ShaderType b, ShaderType c)+    => a -> b -> c+(+) = op2 "+"++infixl 6 -+(-) :: (Arithmetic aBase bBase a b c, ShaderType a, ShaderType b, ShaderType c)+    => a -> b -> c+(-) = op2 "-"++infixr 8 ^+(^) :: (ShaderType a, GenType a) => a -> a -> a+(^) = fun2 "pow"++infixr 3 &&+(&&) :: Bool -> Bool -> Bool+(&&) = op2 "&&"++infixr 2 ||+(||) :: Bool -> Bool -> Bool+(||) = op2 "||"++infix 4 ==+(==) :: ShaderType a => a -> a -> Bool+(==) = op2 "=="++infix 4 /=+(/=) :: ShaderType a => a -> a -> Bool+(/=) = op2 "!="++infix 4 >=+(>=) :: ShaderType a => a -> a -> Bool+(>=) = op2 ">="++infix 4 <=+(<=) :: ShaderType a => a -> a -> Bool+(<=) = op2 "<="++infix 4 <+(<) :: ShaderType a => a -> a -> Bool+(<) = op2 "<"++infix 4 >+(>) :: ShaderType a => a -> a -> Bool+(>) = op2 ">"++class ShaderType a => VecOrd a+instance VecOrd Vec2+instance VecOrd Vec3+instance VecOrd Vec4+instance VecOrd IVec2+instance VecOrd IVec3+instance VecOrd IVec4++class ShaderType a => VecEq a+instance VecEq Vec2+instance VecEq Vec3+instance VecEq Vec4+instance VecEq IVec2+instance VecEq IVec3+instance VecEq IVec4+instance VecEq BVec2+instance VecEq BVec3+instance VecEq BVec4++lessThan :: VecOrd a => a -> a -> Bool+lessThan = fun2 "lessThan"++lessThanEqual :: VecOrd a => a -> a -> Bool+lessThanEqual = fun2 "lessThanEqual"++greaterThan :: VecOrd a => a -> a -> Bool+greaterThan = fun2 "greaterThan"++greaterThanEqual :: VecOrd a => a -> a -> Bool+greaterThanEqual = fun2 "greaterThanEqual"++equal :: VecEq a => a -> a -> Bool+equal = fun2 "equal"++notEqual :: VecEq a => a -> a -> Bool+notEqual = fun2 "notEqual"++class ShaderType a => BoolVector a+instance BoolVector BVec2+instance BoolVector BVec3+instance BoolVector BVec4++anyB :: BoolVector a => a -> Bool+anyB = fun1 "any"++allB :: BoolVector a => a -> Bool+allB = fun1 "all"++notB :: BoolVector a => a -> Bool+notB = fun1 "not"++negate :: GenType a => a -> a+negate = op1 "-"++not :: GenType a => a -> a+not = op1 "!"++class (ShaderType a, Base a a) => Num a where+        fromInteger :: Prelude.Integer -> a++instance Num Float where+        fromInteger = fromRational . Prelude.fromInteger++instance Num Int where+        fromInteger = Int . Literal+                          . (printf "%d" :: Prelude.Integer -> String)+                          . Prelude.fromInteger++fromRational :: Prelude.Rational -> Float+fromRational = Float . Literal+                     . (printf "%f" :: Prelude.Float -> String)+                     . Prelude.fromRational++radians :: GenType a => a -> a+radians = fun1 "radians"++degrees :: GenType a => a -> a+degrees = fun1 "degrees"++sin :: GenType a => a -> a+sin = fun1 "sin"++cos :: GenType a => a -> a+cos = fun1 "cos"++tan :: GenType a => a -> a+tan = fun1 "tan"++asin :: GenType a => a -> a+asin = fun1 "asin"++acos :: GenType a => a -> a+acos = fun1 "acos"++atan :: GenType a => a -> a+atan = fun1 "atan"++atan2 :: GenType a => a -> a -> a+atan2 = fun2 "atan"++exp :: GenType a => a -> a+exp = fun1 "exp"++log :: GenType a => a -> a+log = fun1 "log"++exp2 :: GenType a => a -> a+exp2 = fun1 "exp2"++log2 :: GenType a => a -> a+log2 = fun1 "log2"++sqrt :: GenType a => a -> a+sqrt = fun1 "sqrt"++inversesqrt :: GenType a => a -> a+inversesqrt = fun1 "inversesqrt"++abs :: GenType a => a -> a+abs = fun1 "abs"++sign :: GenType a => a -> a+sign = fun1 "sign"++floor :: GenType a => a -> a+floor = fun1 "floor"++ceil :: GenType a => a -> a+ceil = fun1 "ceil"++fract :: GenType a => a -> a+fract = fun1 "fract"++mod :: GenTypeFloat a b => a -> b -> a+mod = fun2 "mod"++min :: GenTypeFloat a b => a -> b -> a+min = fun2 "min"++max :: GenTypeFloat a b => a -> b -> a+max = fun2 "max"++clamp :: GenTypeFloat a b => a -> b -> b -> a+clamp = fun3 "clamp"++mix :: GenTypeFloat a b => a -> a -> b -> a+mix = fun3 "mix"++step :: GenTypeFloat a b => b -> a -> a+step = fun2 "step"++smoothstep :: GenTypeFloat a b => b -> b -> a -> a+smoothstep = fun3 "smoothstep"++length :: GenType a => a -> Float+length = fun1 "length"++arrayLength :: (ShaderType t, KnownNat n) => Array n t -> Int+arrayLength = fun1 "length"++(!) :: (ShaderType t, KnownNat n) => Array n t -> Int -> t+arr ! i = fromExpr $ ArrayIndex (toExpr arr) (toExpr i)++distance :: GenType a => a -> a -> Float+distance = fun2 "distance"++dot :: GenType a => a -> a -> Float+dot = fun2 "dot"++cross :: Vec3 -> Vec3 -> Vec3+cross = fun2 "cross"++normalize :: GenType a => a -> a+normalize = fun1 "normalize"++faceforward :: GenType a => a -> a -> a -> a+faceforward = fun3 "faceforward"++reflect :: GenType a => a -> a -> a+reflect = fun2 "reflect"++refract :: GenType a => a -> a -> Float -> a+refract = fun3 "refract"++class ShaderType a => Matrix a+instance Matrix Mat2+instance Matrix Mat3+instance Matrix Mat4++-- TODO: unsafe+matrixCompMult :: (Matrix a, Matrix b, Matrix c) => a -> b -> c+matrixCompMult = fun2 "matrixCompMult"++-- | Avoid executing this expression more than one time. Conditionals and loops+-- imply it.+store :: ShaderType a => a -> a+store x = fromExpr . Action $ Store (typeName x) (toExpr x)++true :: Bool+true = Bool $ Literal "true"++false :: Bool+false = Bool $ Literal "false"++-- | Rebound if. You don't need to use this function, with -XRebindableSyntax.+ifThenElse :: ShaderType a => Bool -> a -> a -> a+ifThenElse b t f = fromExpr . Action $ If (toExpr b) (typeName t)+                                          (toExpr t) (toExpr f)++loop :: ShaderType a +     => Int -- ^ Maximum number of iterations (should be as low as possible, must be an integer literal)+     -> a -- ^ Initial value+     -> (Int -> a -> (a, Bool)) -- ^ Iteration -> Old value -> (Next, Stop)+     -> a+loop (Int (Literal iters)) iv f =+        fromExpr . Action $+                For (Prelude.read iters :: Prelude.Int)+                    (typeName iv)+                    (toExpr iv)+                    (\ie ve -> let (next, stop) = f (fromExpr ie) (fromExpr ve)+                               in (toExpr next, toExpr stop))+loop _ _ _ = error "loop: iteration number is not a literal."++texture2D :: Sampler2D -> Vec2 -> Vec4+texture2D = fun2 "texture2D"++texture2DBias :: Sampler2D -> Vec2 -> Float -> Vec4+texture2DBias = fun3 "texture2DBias"++texture2DProj :: Sampler2D -> Vec3 -> Vec4+texture2DProj = fun2 "texture2DProj"++texture2DProjBias :: Sampler2D -> Vec3 -> Float -> Vec4+texture2DProjBias = fun3 "texture2DProj"++texture2DProj4 :: Sampler2D -> Vec4 -> Vec4+texture2DProj4 = fun2 "texture2DProj"++texture2DProjBias4 :: Sampler2D -> Vec4 -> Float -> Vec4+texture2DProjBias4 = fun3 "texture2DProj"++texture2DLod :: Sampler2D -> Vec2 -> Float -> Vec4+texture2DLod = fun3 "texture2DLod"++texture2DProjLod :: Sampler2D -> Vec3 -> Float -> Vec4+texture2DProjLod = fun3 "texture2DProjLod"++texture2DProjLod4 :: Sampler2D -> Vec4 -> Float -> Vec4+texture2DProjLod4 = fun3 "texture3DProjLod"++textureCube :: SamplerCube -> Vec3 -> Vec4+textureCube = fun2 "textureCube"++textureCubeBias :: SamplerCube -> Vec3 -> Float -> Vec4+textureCubeBias = fun3 "textureCube"++textureCubeLod :: SamplerCube -> Vec3 -> Float -> Vec4+textureCubeLod = fun3 "textureCubeLod"++-- | The position of the vertex (only works in the vertex shader).+position :: Vec4+position = fromExpr $ Read "gl_Position"++-- | The color of the fragment (only works in the fragment shader).+fragColor :: Vec4+fragColor = fromExpr $ Read "gl_FragColor"++-- | The coordinates of the fragment (only works in the fragment shader).+fragCoord :: Vec4+fragCoord = fromExpr $ Read "gl_FragCoord"++-- | If the fragment belongs to a front-facing primitive (only works in the+-- fragment shader).+fragFrontFacing :: Bool+fragFrontFacing = fromExpr $ Read "gl_FrontFacing"++class ShaderType t => ToInt t+instance ToInt Float+instance ToInt Bool+instance ToInt Int++int :: ToInt t => t -> Int+int = fun1 "int"++class ShaderType t => ToBool t+instance ToBool Float+instance ToBool Bool+instance ToBool Int++bool :: ToBool t => t -> Bool+bool = fun1 "bool"++class ShaderType t => ToFloat t+instance ToFloat Float+instance ToFloat Bool+instance ToFloat Int++float :: ToFloat t => t -> Float+float = fun1 "float"++class ToVec2 t where+        vec2 :: t -> Vec2++instance ToVec2 Float where+        vec2 = fun1 "vec2"++instance (Components Vec2 <= n, ToCompList t n) => ToVec2 t where+        vec2 = funCompList "vec2"++class ToVec3 t where+        vec3 :: t -> Vec3++instance ToVec3 Float where+        vec3 = fun1 "vec3"++instance (Components Vec3 <= n, ToCompList t n) => ToVec3 t where+        vec3 = funCompList "vec3"++class ToVec4 t where+        vec4 :: t -> Vec4++instance ToVec4 Float where+        vec4 = fun1 "vec4"++instance (Components Vec4 <= n, ToCompList t n) => ToVec4 t where+        vec4 = funCompList "vec4"++class ToIVec2 t where+        ivec2 :: t -> IVec2++instance ToIVec2 Float where+        ivec2 = fun1 "ivec2"++instance (Components IVec2 <= n, ToCompList t n) => ToIVec2 t where+        ivec2 = funCompList "ivec2"++class ToIVec3 t where+        ivec3 :: t -> IVec3++instance ToIVec3 Float where+        ivec3 = fun1 "ivec3"++instance (Components IVec3 <= n, ToCompList t n) => ToIVec3 t where+        ivec3 = funCompList "ivec3"++class ToIVec4 t where+        ivec4 :: t -> IVec4++instance ToIVec4 Float where+        ivec4 = fun1 "ivec4"++instance (Components IVec4 <= n, ToCompList t n) => ToIVec4 t where+        ivec4 = funCompList "ivec4"++class ToBVec2 t where+        bvec2 :: t -> BVec2++instance ToBVec2 Float where+        bvec2 = fun1 "bvec2"++instance (Components BVec2 <= n, ToCompList t n) => ToBVec2 t where+        bvec2 = funCompList "bvec2"++class ToBVec3 t where+        bvec3 :: t -> BVec3++instance ToBVec3 Float where+        bvec3 = fun1 "bvec3"++instance (Components BVec3 <= n, ToCompList t n) => ToBVec3 t where+        bvec3 = funCompList "bvec3"++class ToBVec4 t where+        bvec4 :: t -> BVec4++instance ToBVec4 Float where+        bvec4 = fun1 "bvec4"++instance (Components BVec4 <= n, ToCompList t n) => ToBVec4 t where+        bvec4 = funCompList "bvec4"++class ToMat2 t where+        mat2 :: t -> Mat2++instance ToMat2 Float where+        mat2 = fun1 "mat2"++instance (Components Mat2 <= n, ToCompList t n) => ToMat2 t where+        mat2 = funCompList "mat2"++class ToMat3 t where+        mat3 :: t -> Mat3++instance ToMat3 Float where+        mat3 = fun1 "mat3"++instance (Components Mat3 <= n, ToCompList t n) => ToMat3 t where+        mat3 = funCompList "mat3"++class ToMat4 t where+        mat4 :: t -> Mat4++instance ToMat4 Float where+        mat4 = fun1 "mat4"++instance (Components Mat4 <= n, ToCompList t n) => ToMat4 t where+        mat4 = funCompList "mat4"++-- | Useful type for constructing vectors and matrices from scalars, vectors and+-- matrices.+data CompList (count :: Nat) where+        CL :: (1 <= Components t, ShaderType t) => t -> CompList (Components t)+        CLAppend :: CompList x -> CompList y -> CompList (x + y)++class ToCompList x (n :: Nat) | x -> n where+        toCompList :: x -> CompList n++instance ToCompList (CompList n) n where+        toCompList = Prelude.id++instance (1 <= n, ShaderType t, n ~ (Components t)) => ToCompList t n where+        toCompList = CL++-- | You can call \*vec\* and mat\* with a single scalar or with a 'CompList'+-- containing enough components. This function helps you create 'CompList's.+--+-- Examples:+--+-- > vec2 0+-- > mat2 $ Vec2 2 4 # Vec2 1 3+-- > vec4 $ mat2 (0 # 1 # vec2 2) # 9  -- 9 is discarded+-- > mat4 $ 5 # vec2 5 # Vec3 1 2 3 # Mat2 (vec2 0) (Vec2 1 2) # mat3 0+-- > vec4 $ 1 # vec2 0 -- Not enough components, fails with "Couldn't match type+-- >                   -- ‘'Prelude.False’ with 'Prelude.True’" (because+-- >                   -- Components Vec4 <=? 3 ~ False).+(#) :: (ToCompList x xn, ToCompList y yn) => x -> y -> CompList (xn + yn)+x # y = CLAppend (toCompList x) (toCompList y)++infixr 5 #++type family Components (t :: *) :: Nat where+        Components Int = 1+        Components Float = 1+        Components Bool = 1+        Components Vec2 = 2+        Components IVec2 = 2+        Components BVec2 = 2+        Components Vec3 = 3+        Components IVec3 = 3+        Components BVec3 = 3+        Components Vec4 = 4+        Components IVec4 = 4+        Components BVec4 = 4+        Components Mat2 = 4+        Components Mat3 = 9+        Components Mat4 = 16+        Components x = 0++op1 :: (ShaderType a, ShaderType b) => String -> a -> b+op1 name = fromExpr . Op1 name . toExpr++op2 :: (ShaderType a, ShaderType b, ShaderType c) => String -> a -> b -> c+op2 name x y = fromExpr $ Op2 name (toExpr x) (toExpr y)++fun1 :: (ShaderType a, ShaderType b) => String -> a -> b+fun1 name x = fromExpr $ Apply name [toExpr x]++fun2 :: (ShaderType a, ShaderType b, ShaderType c) => String -> a -> b -> c+fun2 name x y = fromExpr $ Apply name [toExpr x, toExpr y]++fun3 :: (ShaderType a, ShaderType b, ShaderType c, ShaderType d)+     => String -> a -> b -> c -> d+fun3 name x y z = fromExpr $ Apply name [toExpr x, toExpr y, toExpr z]++funCompList :: (ToCompList cl n, ShaderType r) => String -> cl -> r+funCompList name = fromExpr . Apply name . toExprList . toCompList+        where toExprList :: CompList n -> [Expr]+              toExprList (CL x) = [toExpr x]+              toExprList (CLAppend c1 c2) =+                      toExprList c1 Prelude.++ toExprList c2

@@ -0,0 +1,423 @@+{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, DataKinds,+             KindSignatures, ScopedTypeVariables #-}++module FWGL.Shader.Language.Types where++import Data.Typeable+import GHC.TypeLits+import Data.Hashable+import Prelude (String, ($), error, Eq(..), (++), (*), fromInteger, (&&))+import qualified Prelude++-- | CPU integer, used in the shader compiler.+type MInt = Prelude.Int++-- | An expression.+data Expr = Empty | Read String | Op1 String Expr | Op2 String Expr Expr+          | Apply String [Expr] | X Expr | Y Expr | Z Expr | W Expr+          | Literal String | Action Action | Dummy MInt | ArrayIndex Expr Expr+          | ContextVar MInt ContextVarType+          deriving Eq++-- | Expressions that are transformed to statements.+data Action = Store String Expr | If Expr String Expr Expr+            | For MInt String Expr (Expr -> Expr -> (Expr, Expr))++data ContextVarType = LoopIteration | LoopValue deriving Eq++-- | A GPU boolean.+newtype Bool = Bool Expr deriving Typeable++-- | A GPU float.+newtype Float = Float Expr deriving Typeable++-- | A GPU integer.+newtype Int = Int Expr deriving Typeable++-- | A GPU 2D texture handle.+newtype Sampler2D = Sampler2D Expr deriving Typeable++-- | A GPU cube texture handler.+newtype SamplerCube = SamplerCube Expr deriving Typeable++-- | The type of a generic expression.+newtype Unknown = Unknown Expr++-- | A GPU 2D float vector.+-- NB: This is a different type from Data.Vect.Float.'Data.Vect.Float.Vec2'.+data Vec2 = Vec2 Float Float deriving Typeable++-- | A GPU 3D float vector.+data Vec3 = Vec3 Float Float Float deriving Typeable++-- | A GPU 4D float vector.+data Vec4 = Vec4 Float Float Float Float deriving Typeable++-- | A GPU 2D integer vector.+data IVec2 = IVec2 Int Int deriving Typeable++-- | A GPU 3D integer vector.+data IVec3 = IVec3 Int Int Int deriving Typeable++-- | A GPU 4D integer vector.+data IVec4 = IVec4 Int Int Int Int deriving Typeable++-- | A GPU 2D boolean vector.+data BVec2 = BVec2 Bool Bool deriving Typeable++-- | A GPU 3D boolean vector.+data BVec3 = BVec3 Bool Bool Bool deriving Typeable++-- | A GPU 4D boolean vector.+data BVec4 = BVec4 Bool Bool Bool Bool deriving Typeable++-- | A GPU 2x2 float matrix.+data Mat2 = Mat2 Vec2 Vec2 deriving Typeable++-- | A GPU 3x3 float matrix.+data Mat3 = Mat3 Vec3 Vec3 Vec3 deriving Typeable++-- | A GPU 4x4 float matrix.+data Mat4 = Mat4 Vec4 Vec4 Vec4 Vec4 deriving Typeable++-- | A GPU array.+data Array (n :: Nat) t = Array Expr deriving Typeable++-- | A type in the GPU.+class ShaderType t where+        zero :: t++        toExpr :: t -> Expr++        fromExpr :: Expr -> t++        typeName :: t -> String++        size :: t -> MInt++instance ShaderType Unknown where+        zero = error "zero: Unknown type."+        toExpr (Unknown e) = e+        fromExpr = Unknown+        typeName = error "typeName: Unknown type."+        size = error "size: Unknown type."++instance (ShaderType t, KnownNat n) => ShaderType (Array n t) where+        zero = error "zero: Unsupported constant arrays."+        toExpr (Array e) = e+        fromExpr = Array+        typeName (Array _ :: Array n t) =+                typeName (zero :: t) +++                "[" ++ Prelude.show (natVal (Proxy :: Proxy n)) ++ "]"+        size (Array _ :: Array n t) =+                size (zero :: t) * fromInteger (natVal (Proxy :: Proxy n))++instance ShaderType Bool where+        zero = Bool $ Literal "false"++        toExpr (Bool e) = e++        fromExpr = Bool++        typeName _ = "bool"++        size _ = 1++instance ShaderType Int where+        zero = Int $ Literal "0"++        toExpr (Int e) = e++        fromExpr = Int++        typeName _ = "int"++        size _ = 1++instance ShaderType Float where+        zero = Float $ Literal "0.0"++        toExpr (Float e) = e++        fromExpr = Float++        typeName _ = "float"++        size _ = 1++instance ShaderType Sampler2D where+        zero = Sampler2D $ Literal "0"++        toExpr (Sampler2D e) = e++        fromExpr = Sampler2D++        typeName _ = "sampler2D"++        size _ = 1++instance ShaderType SamplerCube where+        zero = SamplerCube $ Literal "0"++        toExpr (SamplerCube e) = e++        fromExpr = SamplerCube++        typeName _ = "samplerCube"++        size _ = 1++instance ShaderType Vec2 where+        zero = Vec2 zero zero++        toExpr (Vec2 (Float (X v)) (Float (Y v'))) | v == v' = Apply "vec2" [v]+        toExpr (Vec2 (Float x) (Float y)) = Apply "vec2" [x, y]++        fromExpr v = Vec2 (Float (X v)) (Float (Y v))++        typeName _ = "vec2"++        size _ = 1++instance ShaderType Vec3 where+        zero = Vec3 zero zero zero++        toExpr (Vec3 (Float (X v)) (Float (Y v')) (Float (Z v'')))+               | v == v' && v' == v'' = Apply "vec3" [v]+        toExpr (Vec3 (Float x) (Float y) (Float z)) = Apply "vec3" [x, y, z]++        fromExpr v = Vec3 (Float (X v)) (Float (Y v)) (Float (Z v))++        typeName _ = "vec3"++        size _ = 1++instance ShaderType Vec4 where+        zero = Vec4 zero zero zero zero++        toExpr (Vec4 (Float (X v)) (Float (Y v1)) (Float (Z v2)) (Float (W v3)))+               | v == v1 && v1 == v2 && v2 == v3 = Apply "vec4" [v]+        toExpr (Vec4 (Float x) (Float y) (Float z) (Float w)) =+                Apply "vec4" [x, y, z, w]++        fromExpr v = Vec4 (Float (X v)) (Float (Y v)) (Float (Z v)) (Float (W v))++        typeName _ = "vec4"++        size _ = 1++instance ShaderType IVec2 where+        zero = IVec2 zero zero++        toExpr (IVec2 (Int (X v)) (Int (Y v'))) | v == v' = Apply "ivec2" [v]+        toExpr (IVec2 (Int x) (Int y)) = Apply "ivec2" [x, y]++        fromExpr v = IVec2 (Int (X v)) (Int (Y v))++        typeName _ = "ivec2"++        size _ = 1++instance ShaderType IVec3 where+        zero = IVec3 zero zero zero++        toExpr (IVec3 (Int (X v)) (Int (Y v')) (Int (Z v'')))+               | v == v' && v' == v'' = Apply "ivec3" [v]+        toExpr (IVec3 (Int x) (Int y) (Int z)) = Apply "ivec3" [x, y, z]++        fromExpr v = IVec3 (Int (X v)) (Int (Y v)) (Int (Z v))++        typeName _ = "ivec3"++        size _ = 1++instance ShaderType IVec4 where+        zero = IVec4 zero zero zero zero++        toExpr (IVec4 (Int (X v)) (Int (Y v1)) (Int (Z v2)) (Int (W v3)))+               | v == v1 && v1 == v2 && v2 == v3 = Apply "ivec4" [v]+        toExpr (IVec4 (Int x) (Int y) (Int z) (Int w)) =+                Apply "ivec4" [x, y, z, w]++        fromExpr v = IVec4 (Int (X v)) (Int (Y v)) (Int (Z v)) (Int (W v))++        typeName _ = "ivec4"++        size _ = 1++instance ShaderType BVec2 where+        zero = BVec2 zero zero++        toExpr (BVec2 (Bool (X v)) (Bool (Y v'))) | v == v' = Apply "bvec2" [v]+        toExpr (BVec2 (Bool x) (Bool y)) = Apply "bvec2" [x, y]++        fromExpr v = BVec2 (Bool (X v)) (Bool (Y v))++        typeName _ = "bvec2"++        size _ = 1++instance ShaderType BVec3 where+        zero = BVec3 zero zero zero++        toExpr (BVec3 (Bool (X v)) (Bool (Y v')) (Bool (Z v'')))+               | v == v' && v' == v'' = Apply "bvec3" [v]+        toExpr (BVec3 (Bool x) (Bool y) (Bool z)) = Apply "bvec3" [x, y, z]++        fromExpr v = BVec3 (Bool (X v)) (Bool (Y v)) (Bool (Z v))++        typeName _ = "bvec3"++        size _ = 1++instance ShaderType BVec4 where+        zero = BVec4 zero zero zero zero++        toExpr (BVec4 (Bool (X v)) (Bool (Y v1)) (Bool (Z v2)) (Bool (W v3)))+               | v == v1 && v1 == v2 && v2 == v3 = Apply "bvec4" [v]+        toExpr (BVec4 (Bool x) (Bool y) (Bool z) (Bool w)) =+                Apply "bvec4" [x, y, z, w]++        fromExpr v = BVec4 (Bool (X v)) (Bool (Y v))+                           (Bool (Z v)) (Bool (W v))++        typeName _ = "bvec4"++        size _ = 1++instance ShaderType Mat2 where+        zero = Mat2 zero zero++        toExpr (Mat2 (Vec2 (Float (X (X m))) (Float (X (Y m1))))+                     (Vec2 (Float (Y (X m2))) (Float (Y (Y m3)))))+               | m == m1 && m1 == m2 && m2 == m3 = Apply "mat2" [m]+        toExpr (Mat2 (Vec2 (Float xx) (Float xy))+                     (Vec2 (Float yx) (Float yy)))+               = Apply "mat2" [xx, yx, xy, yy]++        fromExpr m = Mat2 (Vec2 (Float (X (X m))) (Float (Y (X m))))+                          (Vec2 (Float (Y (X m))) (Float (Y (Y m))))++        typeName _ = "mat2"++        size _ = 2++instance ShaderType Mat3 where+        zero = Mat3 zero zero zero++        toExpr (Mat3 (Vec3 (Float (X (X m)))+                           (Float (X (Y m1)))+                           (Float (X (Z m2))))+                     (Vec3 (Float (Y (X m3)))+                           (Float (Y (Y m4)))+                           (Float (Y (Z m5))))+                     (Vec3 (Float (Z (X m6)))+                           (Float (Z (Y m7)))+                           (Float (Z (Z m8)))))+               | m == m1 && m1 == m2 && m2 == m3 && m3 == m4 &&+                 m4 == m5 && m5 == m6 && m6 == m7 && m7 == m8 =+                         Apply "mat3" [m]+        toExpr (Mat3 (Vec3 (Float xx) (Float xy) (Float xz))+                     (Vec3 (Float yx) (Float yy) (Float yz))+                     (Vec3 (Float zx) (Float zy) (Float zz)))+               = Apply "mat3" [xx, yx, zx, xy, yy, zy, xz, yz, zz]++        fromExpr m = Mat3 (Vec3 (Float (X (X m)))+                                (Float (X (Y m)))+                                (Float (X (Z m))))+                          (Vec3 (Float (Y (X m)))+                                (Float (Y (Y m)))+                                (Float (Y (Z m))))+                          (Vec3 (Float (Z (X m)))+                                (Float (Z (Y m)))+                                (Float (Z (Z m))))++        typeName _ = "mat3"++        size _ = 3++instance ShaderType Mat4 where+        zero = Mat4 zero zero zero zero++        toExpr (Mat4 (Vec4 (Float (X (X m)))+                           (Float (X (Y m1)))+                           (Float (X (Z m2)))+                           (Float (X (W m3))))+                     (Vec4 (Float (Y (X m4)))+                           (Float (Y (Y m5)))+                           (Float (Y (Z m6)))+                           (Float (Y (W m7))))+                     (Vec4 (Float (Z (X m8)))+                           (Float (Z (Y m9)))+                           (Float (Z (Z m10)))+                           (Float (Z (W m11))))+                     (Vec4 (Float (W (X m12)))+                           (Float (W (Y m13)))+                           (Float (W (Z m14)))+                           (Float (W (W m15)))))+               | m == m1 && m1 == m2 && m2 == m3 && m3 == m4 &&+                 m4 == m5 && m5 == m6 && m6 == m7 && m7 == m8 &&+                 m8 == m9 && m9 == m10 && m10 == m11 && m11 == m12 &&+                 m12 == m13 && m13 == m14 && m14 == m15 = Apply "mat4" [m]+        toExpr (Mat4 (Vec4 (Float xx) (Float xy) (Float xz) (Float xw))+                     (Vec4 (Float yx) (Float yy) (Float yz) (Float yw))+                     (Vec4 (Float zx) (Float zy) (Float zz) (Float zw))+                     (Vec4 (Float wx) (Float wy) (Float wz) (Float ww)))+               = Apply "mat4" [ xx, yx, zx, wx+                              , xy, yy, zy, wy+                              , xz, yz, zz, wz+                              , xw, yw, zw, ww ]++        fromExpr m = Mat4 (Vec4 (Float (X (X m)))+                                (Float (X (Y m)))+                                (Float (X (Z m)))+                                (Float (X (W m))))+                          (Vec4 (Float (Y (X m)))+                                (Float (Y (Y m)))+                                (Float (Y (Z m)))+                                (Float (Y (W m))))+                          (Vec4 (Float (Z (X m)))+                                (Float (Z (Y m)))+                                (Float (Z (Z m)))+                                (Float (Z (W m))))+                          (Vec4 (Float (W (X m)))+                                (Float (W (Y m)))+                                (Float (W (Z m)))+                                (Float (W (W m))))++        typeName _ = "mat4"++        size _ = 4++instance Hashable Expr where+        hashWithSalt s e = case e of+                                Empty -> hash2 s 0 (0 :: MInt)+                                Read str -> hash2 s 1 str+                                Op1 str exp -> hash2 s 2 (str, exp)+                                Op2 str exp exp' -> hash2 3 s (str, exp, exp')+                                Apply str exps -> hash2 4 s exps+                                X exp -> hash2 5 s exp+                                Y exp -> hash2 6 s exp+                                Z exp -> hash2 7 s exp+                                W exp -> hash2 8 s exp+                                Literal str -> hash2 s 9 str+                                Action hash -> hash2 s 10 hash+                                Dummy i -> hash2 s 11 i+                                ContextVar i LoopIteration -> hash2 s 12 i+                                ContextVar i LoopValue -> hash2 s 13 i+                                ArrayIndex arr i -> hash2 s 14 (arr, i)++instance Hashable Action where+        hashWithSalt s (Store t e) = hash2 s 0 (t, e)+        hashWithSalt s (If eb tt et ef) = hash2 s 1 (eb, tt, et, ef)+        hashWithSalt s (For iters tv iv eFun) =+                let baseHash = hash (iters, tv, iv, eFun (Dummy 0) (Dummy 1))+                in hash2 s 2 ( baseHash+                             , eFun (Dummy baseHash)+                                    (Dummy $ baseHash Prelude.+ 1))++instance Prelude.Eq Action where+        a == a' = hash a == hash a'++hash2 :: Hashable a => MInt -> MInt -> a -> MInt+hash2 s i x = s `hashWithSalt` i `hashWithSalt` x

@@ -19,7 +19,7 @@  import Data.Typeable import FWGL.Internal.TList-import FWGL.Shader.Language (ShaderType)+import FWGL.Shader.Language.Types (ShaderType) import Prelude (String, error, Bool(False), undefined)  infixr 4 :-

@@ -13,7 +13,7 @@ import Data.Typeable  import FWGL.Internal.TList-import FWGL.Shader.Language+import FWGL.Shader.Language.Types import FWGL.Shader.Shader  -- | A 'Shader' with a 'VertexShaderOutput' output.

@@ -13,7 +13,7 @@       disclaimer in the documentation and/or other materials provided       with the distribution. -    * Neither the name of Luca "ZioCrocifisso" Prezzavento nor the names of other+    * Neither the name of Luca Prezzavento nor the names of other       contributors may be used to endorse or promote products derived       from this software without specific prior written permission. 

@@ -1,5 +1,5 @@ name:                fwgl-version:             0.1.3.1+version:             0.1.4.0 synopsis:            Game engine description:         FWGL is a library for interactive 2D and 3D applications and games. It provides a purely functional interface for advanced graphics programming, including a type safe embedded DSL for GPU programming. You are not required to know or use OpenGL directly to work with FWGL, you just need a basic knowledge of what vertex/fragment shaders, uniforms and attributes are (if you are going to make a more advanced use of it). FWGL is aimed at functional reactive programming (with Yampa), but provides a non-reactive interface as well. There are two backends: fwgl-glfw and fwgl-javascript. homepage:            https://github.com/ziocroc/FWGL@@ -13,7 +13,7 @@ cabal-version:       >=1.10  library-  exposed-modules:     FWGL, FWGL.Shader, FWGL.Geometry, FWGL.Transformation, FWGL.Key, FWGL.Backend, FWGL.Input, FWGL.Graphics.Draw, FWGL.Graphics.D2, FWGL.Graphics.D3, FWGL.Graphics.Texture, FWGL.Graphics.Types, FWGL.Graphics.Color, FWGL.Graphics.Generic, FWGL.Graphics.Shapes, FWGL.Internal.GL, FWGL.Internal.TList, FWGL.Geometry.OBJ, FWGL.Shader.GLSL, FWGL.Shader.Stages, FWGL.Shader.Program, FWGL.Shader.CPU, FWGL.Shader.Default3D, FWGL.Shader.Shader, FWGL.Shader.Language, FWGL.Shader.Default2D, FWGL.Backend.GLES, FWGL.Backend.IO+  exposed-modules:     FWGL, FWGL.Shader, FWGL.Geometry, FWGL.Transformation, FWGL.Key, FWGL.Backend, FWGL.Input, FWGL.Graphics.Draw, FWGL.Graphics.D2, FWGL.Graphics.D3, FWGL.Graphics.Texture, FWGL.Graphics.Types, FWGL.Graphics.Color, FWGL.Graphics.Generic, FWGL.Graphics.Shapes, FWGL.Internal.GL, FWGL.Internal.TList, FWGL.Geometry.OBJ, FWGL.Shader.GLSL, FWGL.Shader.Stages, FWGL.Shader.Program, FWGL.Shader.CPU, FWGL.Shader.Default3D, FWGL.Shader.Shader, FWGL.Shader.Language.Types, FWGL.Shader.Language.Functions, FWGL.Shader.Default2D, FWGL.Backend.GLES, FWGL.Backend.IO   other-modules:        FWGL.Internal.STVectorLen, FWGL.Internal.Resource   other-extensions:    FlexibleContexts, RankNTypes, GADTs, TypeOperators, KindSignatures, DataKinds, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, ConstraintKinds, TypeFamilies, ExistentialQuantification, GeneralizedNewtypeDeriving, PolyKinds, UndecidableInstances, ScopedTypeVariables, OverlappingInstances, FunctionalDependencies, DeriveDataTypeable, ImpredicativeTypes, RebindableSyntax, NullaryTypeClasses, Arrows   build-depends:       base >=4.7 && <4.9, Yampa >=0.9 && <0.10, hashable >=1.2 && <1.3, unordered-containers >=0.2 && <0.3, vector >=0.10 && <0.12, transformers, vect