packages feed

fwgl 0.1.1.0 → 0.1.2.0

raw patch · 14 files changed

+197/−64 lines, 14 filesdep ~base

Dependency ranges changed: base

Files

FWGL.hs view
@@ -1,9 +1,10 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}+ {-|     The main module. You should also import a backend:          * FWGL.Backend.JavaScript: GHCJS/WebGL backend (contained in fwgl-javascript)         * FWGL.Backend.GLFW.GL20: GLFW/OpenGL 2.0 backend (contained in fwgl-glfw)-        * FWGL.Backend.GLFW.GLES20: GLFW/OpenGL ES 2.0 backend (WIP)       And a graphics system:@@ -12,6 +13,7 @@         * "FWGL.Graphics.D3": 3D graphics         * "FWGL.Graphics.Custom": advanced custom graphics +     "FWGL.Shader" contains the EDSL to make custom shaders. -} module FWGL (@@ -19,10 +21,15 @@         module FWGL.Input,         module FWGL.Utils,         module FRP.Yampa,-        Output(..),-        run+        draw,+        run,+        run',+        Output,+        (.>),+        io, ) where +import Control.Monad.IO.Class import FWGL.Audio import FWGL.Backend import FWGL.Input@@ -33,16 +40,35 @@ import FRP.Yampa  -- | The general output.-data Output = Output [Layer] Audio -- StateT ... IO+newtype Output = Output { drawOutput :: Draw () } +-- | Compose two 'Output' effects.+(.>) :: Output -> Output -> Output+Output a .> Output b = Output $ a >> b++-- | Draw some layers.+draw :: BackendIO => [Layer] -> Output+draw layers = Output $ mapM_ drawLayer layers++-- | Perform an IO action.+io :: IO () -> Output+io = Output . liftIO+ -- | Run a FWGL program. run :: BackendIO-    => SF Input Output  -- ^ Main signal+    => SF (Input ()) Output  -- ^ Main signal     -> IO ()-run sigf = setup initState loop sigf+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+     -> IO ()+run' customInput sigf = setup initState loop customInput sigf         where initState w h = evalGL $ drawInit w h-              loop (Output scenes _) ctx drawState =-                      flip evalGL ctx . flip execDraw drawState $-                              do drawBegin-                                 mapM_ drawLayer scenes-                                 drawEnd+              loop (Output act) ctx drawState =+                      flip evalGL ctx . flip execDraw drawState $ do+                              drawBegin+                              act+                              drawEnd
FWGL/Backend/IO.hs view
@@ -12,5 +12,6 @@          setup :: (Int -> Int -> Ctx -> IO state)               -> (out -> Ctx -> state -> IO state)-              -> SF Input out+              -> IO inp+              -> SF (Input inp) out               -> IO ()
FWGL/Graphics/Custom.hs view
@@ -2,29 +2,36 @@              TypeFamilies, FlexibleContexts #-}  module FWGL.Graphics.Custom (-        module FWGL.Vector,-        Layer,         Object,-        AttrList(..),-        Geometry,-        Texture,-        Color(..),         (~~),-        program,+        unsafeJoin,         nothing,         static,++        Program,+        program,         global,         globalDraw,         globalTexture,         globalTexSize,++        Layer,         layer,         subLayer,-        unsafeJoin,++        Geometry,+        AttrList(..),         mkGeometry,++        Texture,         mkTexture,         textureURL,         textureFile,-        colorTex++        Color(..),+        colorTex,++        module FWGL.Vector ) where  import Control.Applicative@@ -50,7 +57,7 @@ static :: Geometry i -> Object '[] i static = ObjectMesh . StaticGeom --- | Sets a global (uniform) of an object.+-- | Sets a global variable (uniform) of an object. global :: (Typeable g, UniformCPU c g) => g -> c        -> Object gs is -> Object (g ': gs) is global g c = globalDraw g $ return c
FWGL/Graphics/D2.hs view
@@ -38,7 +38,7 @@         layer,         layerPrg,         program,-        -- * Sublayers+        -- ** Sublayers         C.subLayer,         -- * Custom 2D objects         Object,
FWGL/Graphics/D3.hs view
@@ -37,7 +37,7 @@         Program,         layer,         layerPrg,-        program,+        program, -- TODO: wrong!         -- ** Sublayers         C.subLayer,         -- * Custom 3D objects
FWGL/Graphics/Types.hs view
@@ -10,7 +10,6 @@         LoadedTexture(..),         Geometry(..),         Mesh(..),-        Light(..),         Object(..),         Layer(..) ) where@@ -31,6 +30,7 @@  newtype UniformLocation = UniformLocation GL.UniformLocation +-- | The state of the 'Draw' monad. data DrawState = DrawState {         program :: Maybe (Program '[] '[]),         loadedProgram :: Maybe LoadedProgram,@@ -40,6 +40,7 @@         textureImages :: ResMap TextureImage LoadedTexture } +-- | A monad that represents OpenGL actions with some state ('DrawState'). newtype Draw a = Draw { unDraw :: StateT DrawState GL a }         deriving (Functor, Applicative, Monad, MonadIO) @@ -59,9 +60,14 @@         StaticGeom :: Geometry is -> Mesh is         DynamicGeom :: Geometry is -> Geometry is -> Mesh is -data Light---- | An object is a set of geometries associated with some uniforms.+-- | An object is a set of geometries associated with some uniforms. For+-- example, if you want to draw a rotating cube, its vertices, normals, etc.+-- would be the 'Geometry', the combination of the geometry and the value of the+-- model matrix would be the 'Object', and the combination of the object with+-- a 'Program' would be the 'Layer'. In fact, 'Object's are just descriptions+-- of the actions to perform to draw something. Instead, the Element types in+-- "FWGL.Graphics.D2" and "FWGL.Graphics.D3" represent managed (high level) objects,+-- and they are ultimately converted to them. data Object (gs :: [*]) (is :: [*]) where         ObjectEmpty :: Object gs is         ObjectMesh :: Mesh is -> Object gs is@@ -69,16 +75,8 @@                      -> Object gs is -> Object gs' is          ObjectAppend :: Object gs is -> Object gs' is' -> Object gs'' is'' -{---- | An 'Element' is anything that can be converted to an 'Object'.-class Element o gs is | o -> gs is where-        object :: o -> Object gs is--instance Element (Object gs is) gs is where-        object = id--}---- | An object associated with a program.+-- | An object associated with a program. It can also be a layer included in+-- another. data Layer = forall oi pi og pg. (Subset oi pi, Subset og pg)                               => Layer (Program pg pi) (Object og oi)            | SubLayer Int Int Layer (Texture -> [Layer])
FWGL/Input.hs view
@@ -12,7 +12,8 @@         click,         pointer,         resize,-        size+        size,+        custom ) where  import Data.Maybe@@ -34,54 +35,59 @@ }  -- | The general input.-data Input = Input {-        inputEvents :: H.HashMap InputEvent [EventData]+data Input a = Input {+        inputEvents :: H.HashMap InputEvent [EventData],+        inputCustom :: a }  instance Hashable InputEvent where         hashWithSalt salt = hashWithSalt salt . fromEnum  -- | Keyboard release.-keyUp :: Key -> SF Input (Event ())+keyUp :: Key -> SF (Input a) (Event ()) keyUp k = evEdge KeyUp $ isKey k  -- | Keyboard press.-keyDown :: Key -> SF Input (Event ())+keyDown :: Key -> SF (Input a) (Event ()) keyDown k = evEdge KeyDown $ isKey k  -- | Keyboard down.-key :: Key -> SF Input (Event ())+key :: Key -> SF (Input a) (Event ()) key k = sscan upDown NoEvent <<< keyUp k &&& keyDown k  -- | Mouse press.-mouseDown :: MouseButton -> SF Input (Event (Int, Int))+mouseDown :: MouseButton -> SF (Input a) (Event (Int, Int)) mouseDown b = evPointer MouseDown $ \d -> dataButton d == Just b  -- | Mouse release.-mouseUp :: MouseButton -> SF Input (Event (Int, Int))+mouseUp :: MouseButton -> SF (Input a) (Event (Int, Int)) mouseUp b = evPointer MouseUp $ \d -> dataButton d == Just b  -- | Mouse down.-mouse :: MouseButton -> SF Input (Event (Int, Int))+mouse :: MouseButton -> SF (Input a) (Event (Int, Int)) mouse b = sscan upDown NoEvent <<< mouseUp b &&& mouseDown b  -- | Left click.-click :: SF Input (Event (Int, Int))+click :: SF (Input a) (Event (Int, Int)) click = mouseDown MouseLeft  -- | Pointer location in pixels.-pointer :: SF Input (Int, Int)+pointer :: SF (Input a) (Int, Int) pointer = evPointer MouseMove (const True) >>> hold (0, 0)  -- | Window/framebuffer/canvas/etc. resize.-resize :: SF Input (Event (Int, Int))+resize :: SF (Input a) (Event (Int, Int)) resize = evSearch Resize (isJust . dataFramebufferSize) >>^          fmap (fromJust . dataFramebufferSize)  -- | Window/framebuffer/canvas size.-size :: SF Input (Int, Int)+size :: SF (Input a) (Int, Int) size = resize >>> hold (0, 0) +-- | Custom input.+custom :: SF (Input a) a+custom = arr inputCustom+ {- keyDownLimited :: KeyCode a => Double -> a -> SF Input (Event ())  keyLimited :: KeyCode a => Double -> a -> SF Input (Event ()) -}@@ -96,15 +102,16 @@                 Just k' -> k == k'                 Nothing -> False -evSearch :: InputEvent -> (EventData -> Bool) -> SF Input (Event EventData)+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 -evEdge :: InputEvent -> (EventData -> Bool) -> SF Input (Event ())+evEdge :: InputEvent -> (EventData -> Bool) -> SF (Input a) (Event ()) evEdge ev bP = evSearch ev bP >>> arr isEvent >>> edge -evPointer :: InputEvent -> (EventData -> Bool) -> SF Input (Event (Int, Int))+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
FWGL/Shader.hs view
@@ -1,5 +1,49 @@ {-# LANGUAGE FlexibleContexts, RankNTypes, TypeFamilies #-} +{-|+An example of shader variable:++@+        newtype Transform2 = Transform2 M3+                deriving (Typeable,-- This have a name in the shader.+                          ShaderType, -- This is a type in the GPU (3x3 matrix).+                          UniformCPU CM3) -- This can be used as an uniform+                                             and you can set it using a CPU+                                             3x3 matrix+                                             (FWGL.Vector.'FWGL.Vector.M3').+@++An example of vertex shader:++@+        vertexShader :: VertexShader+        -- The types of the uniforms:+                                '[Transform2, View2, Depth]+        -- The types of the attributes:+                                '[Position2, UV]+        -- The types of the varying (outputs), excluding 'VertexShaderOutput'.+                                '[UV]+        vertexShader +        -- Set of uniforms:+                     (Transform2 trans :- View2 view :- Depth z :- N)+        -- Set of attributes:+                     (Position2 (V2 x y) :- uv@(UV _) :- N) =+        -- Matrix and vector multiplication:+                        let V3 x' y' _ = view * trans * V3 x y 1+        -- Set of outputs:+                        in Vertex (V4 x' y' z 1) -- Vertex position.+                           :- uv :- N+@++Required extensions:++@+\{\-# LANGUAGE DataKinds, RebindableSyntax, DeriveDataTypeable,+             GeneralizedNewtypeDeriving, GADTs #\-\}+@++-}+ module FWGL.Shader (         Shader,         VertexShader,@@ -75,11 +119,26 @@ import Prelude ((.), id, const, flip, ($)) import qualified Prelude as CPU +-- | Floats in the CPU. type CFloat = CPU.Float++-- | Samplers in the CPU. type CSampler2D = CPU.ActiveTexture++-- | 2D vectors in the CPU. type CV2 = CPU.V2++-- | 3D vectors in the CPU. type CV3 = CPU.V3++-- | 4D vectors in the CPU. type CV4 = CPU.V4++-- | 2x2 matrices in the CPU. type CM2 = CPU.M2++-- | 3x3 matrices in the CPU. type CM3 = CPU.M3++-- | 4x4 matrices in the CPU. type CM4 = CPU.M4
FWGL/Shader/CPU.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FunctionalDependencies #-}  -- FWGL.Shader.Variables? (+ loadUniform, loadAttribute, inputName, etc.)-module FWGL.Shader.CPU where+module FWGL.Shader.CPU (UniformCPU(..), AttributeCPU(..)) where  import Data.Word (Word) import Data.Typeable@@ -10,9 +10,11 @@ import qualified FWGL.Vector as CPU import Prelude as CPU +-- | CPU types convertible to GPU types (as uniforms). class Typeable g => UniformCPU c g | g -> c where         setUniform :: UniformLocation -> g -> c -> GL () +-- | CPU types convertible to GPU types (as attributes). class Typeable g => AttributeCPU c g | g -> c where         encodeAttribute :: g -> [c] -> GL Array         setAttribute :: g -> GLUInt -> GL ()
FWGL/Shader/Language.hs view
@@ -16,8 +16,10 @@         fromRational,         fromInteger,         negate,+        Mul,         (*),         (/),+        Sum,         (+),         (-),         (^),@@ -43,15 +45,32 @@           | Apply String [Expr] | X Expr | Y Expr | Z Expr | W Expr           | Literal String deriving (Prelude.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--- | NB: These are different types from 'FWGL.Vector.V2', 'FWGL.Vector.V3', etc.++-- | A GPU 2D vector.+-- NB: This is a different type from FWGL.Vector.'FWGL.Vector.V2'. data V2 = V2 Float Float deriving (Typeable)++-- | A GPU 3D vector. data V3 = V3 Float Float Float deriving (Typeable)++-- | A GPU 4D vector. data V4 = V4 Float Float Float Float deriving (Typeable)++-- | A GPU 2x2 matrix. data M2 = M2 V2 V2 deriving (Typeable)++-- | A GPU 3x3 matrix. data M3 = M3 V3 V3 V3 deriving (Typeable)++-- | A GPU 4x4 matrix. data M4 = M4 V4 V4 V4 V4 deriving (Typeable)  infix 4 =!@@ -62,6 +81,7 @@ (&&!) :: Prelude.Bool -> Prelude.Bool -> Prelude.Bool (&&!) = (Prelude.&&) +-- | A type in the GPU. class ShaderType t where         toExpr :: t -> Expr @@ -238,6 +258,7 @@ instance Matrix M3 instance Matrix M4 +-- | Types that can be multiplied. class Mul a b c | a b -> c instance Mul Float Float Float instance Mul V2 V2 V2@@ -273,6 +294,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 V2
FWGL/Shader/Shader.hs view
@@ -24,14 +24,18 @@  infixr 4 :- +-- | An heterogeneous set of 'ShaderType's and 'Typeable's. data STList :: [*] -> * where         N :: STList '[]         (:-) :: (ShaderType a, Typeable a, IsMember a xs ~ False)              => a -> STList xs -> STList (a ': xs) +-- | The condition for a valid 'Shader'. type Valid gs is os = ( StaticList gs, StaticList is, StaticList os                       , StaticSTList gs, StaticSTList is, StaticSTList os) +-- | A function from a (heterogeneous) set of uniforms and a set of inputs+-- (attributes or varyings) to a set of outputs (varyings). type Shader gs is os = STList gs -> STList is -> STList os  stFold :: (forall x. (Typeable x, ShaderType x) => acc -> x -> acc)
FWGL/Shader/Stages.hs view
@@ -16,10 +16,17 @@ import FWGL.Shader.Language import FWGL.Shader.Shader +-- | A 'Shader' with a 'VertexShaderOutput' output. type VertexShader g i o = Shader g i (VertexShaderOutput ': o)++-- | A 'Shader' with only a 'FragmentShaderOutput' output. type FragmentShader g i = Shader g i (FragmentShaderOutput ': '[]) +-- | The condition for a valid 'VertexShader'. type ValidVertex g i o = (Valid g i o, IsMember VertexShaderOutput o ~ False) +-- | The position of the vertex. newtype VertexShaderOutput = Vertex V4 deriving (Typeable, ShaderType)++-- | The RGBA color of the fragment (1.0 = #FF). newtype FragmentShaderOutput = Fragment V4 deriving (Typeable, ShaderType)
FWGL/Utils.hs view
@@ -11,16 +11,16 @@  -- | Generate a view matrix that transforms the pixel coordinates in OpenGL -- coordinates.-screenScale :: SF Input M3-screenScale = size >>^ \(x, y) -> scaleMat3 (V2 (1 / fromIntegral x)-                                                (1 / fromIntegral y))+screenScale :: SF (Input a) M3+screenScale = size >>^ \(x, y) -> scaleMat3 (V2 (2 / fromIntegral x)+                                                (2 / fromIntegral y))  -- | Generate a perspective view matrix using the aspect ratio of the -- framebuffer. perspective4 :: Float   -- ^ Far              -> Float   -- ^ Near              -> Float   -- ^ FOV-             -> SF Input M4+             -> SF (Input a) M4 perspective4 f n fov =         size >>^ \(w, h) -> perspectiveMat4 f n fov                                             (fromIntegral w / fromIntegral h)@@ -29,7 +29,7 @@ perspectiveView :: Float    -- ^ Far                 -> Float    -- ^ Near                 -> Float    -- ^ FOV-                -> SF (Input, M4) M4+                -> SF (Input a, M4) M4 perspectiveView far near fov  =         perspective4 far near fov *** identity         >>^ \(perspMat, viewMat) -> mul4 viewMat perspMat
fwgl.cabal view
@@ -1,12 +1,12 @@ name:                fwgl-version:             0.1.1.0+version:             0.1.2.0 synopsis:            FRP 2D/3D game engine description:         FRP 2D/3D game engine (work in progress).-homepage:            https://github.com/ZioCrocifisso/FWGL+homepage:            https://github.com/ziocroc/FWGL stability:           experimental license:             BSD3 license-file:        LICENSE-author:              Luca "ZioCrocifisso" Prezzavento+author:              Luca "ziocroc" Prezzavento maintainer:          ziocroc@gmail.com category:            Game, Game Engine, Javascript build-type:          Simple