fwgl 0.1.0.0 → 0.1.0.1

raw patch · 18 files changed

+373/−133 lines, 18 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• FWGL.hs +2/−1
• FWGL/Backend/GLES.hs +1/−0
• FWGL/Backend/JavaScript.hs +1/−0
• FWGL/Backend/JavaScript/WebGL/Types.hs +5/−1
• FWGL/Geometry.hs +5/−5
• FWGL/Geometry/OBJ.hs +7/−4
• FWGL/Graphics/Custom.hs +1/−1
• FWGL/Graphics/D2.hs +2/−1
• FWGL/Graphics/D3.hs +159/−0
• FWGL/Graphics/Draw.hs +40/−5
• FWGL/Graphics/Texture.hs +99/−0
• FWGL/Graphics/Types.hs +15/−2
• FWGL/Internal/Resource.hs +10/−7
• FWGL/Shader/Default3D.hs +1/−1
• FWGL/Texture.hs +0/−98
• FWGL/Utils.hs +13/−1
• FWGL/Vector.hs +6/−1
• fwgl.cabal +6/−5

@@ -9,7 +9,7 @@     And a graphics system:          * "FWGL.Graphics.D2": 2D graphics-        * FWGL.Graphics.D3: 3D graphics (WIP)+        * "FWGL.Graphics.D3": 3D graphics         * "FWGL.Graphics.Custom": advanced custom graphics      "FWGL.Shader" contains the EDSL to make custom shaders.@@ -45,3 +45,4 @@                       flip evalGL ctx . flip execDraw drawState $                               do drawBegin                                  mapM_ drawLayer scenes+                                 drawEnd

@@ -45,6 +45,7 @@         toGLString :: String -> GLString         noBuffer :: Buffer         noTexture :: Texture+        noArray :: IO Array         encodeM2 :: M2 -> IO Float32Array         encodeM3 :: M3 -> IO Float32Array         encodeM4 :: M4 -> IO Float32Array

@@ -122,6 +122,7 @@         toGLString = toJSString         noBuffer = JS.noBuffer         noTexture = JS.noTexture+        noArray = JS.noArray          encodeM2 (M2 (V2 a1 a2) (V2 b1 b2)) = JS.listToJSArray [ a1, a2, b1, b2]                                               >>= JS.float32Array

@@ -28,7 +28,8 @@         toJSArray,         listToJSArray,         noBuffer,-        noTexture+        noTexture,+        noArray ) where  import Data.Int (Int32)@@ -90,6 +91,9 @@  noTexture :: Texture noTexture = jsNull++noArray :: IO ArrayBufferView+noArray = return jsNull  float32View :: JSArray Float -> IO ArrayBufferView float32View = fmap castRef . float32Array

@@ -129,7 +129,7 @@   -- TODO: use dlist-arraysToElements :: (Foldable f, GLES) => f (V3, V2, V3) -> Geometry Geometry3+arraysToElements :: Foldable f => f (V3, V2, V3) -> ([V3], [V2], [V3], [Word16]) arraysToElements arrays = runST $         do vs <- newSTRef []            us <- newSTRef []@@ -149,10 +149,10 @@                                          modifySTRef ns (n :)                                          modifySTRef es (idx :) -           mkGeometry3 <$> (reverse <$> readSTRef vs)-                       <*> (reverse <$> readSTRef us)-                       <*> (reverse <$> readSTRef ns)-                       <*> (reverse <$> readSTRef es)+           (,,,) <$> (reverse <$> readSTRef vs)+                 <*> (reverse <$> readSTRef us)+                 <*> (reverse <$> readSTRef ns)+                 <*> (reverse <$> readSTRef es)  facesToArrays :: V.Vector V3 -> V.Vector V2 -> V.Vector V3               -> [[(Int, Int, Int)]] -> [(V3, V2, V3)]

@@ -5,6 +5,7 @@ import Control.Monad.ST import qualified Data.Vector.Storable as V import Data.STRef+import Data.Word (Word16)  import FWGL.Backend (GLES) import FWGL.Internal.STVectorLen@@ -18,10 +19,10 @@         objFaces :: [[(Int, Int, Int)]] } deriving (Show) -loadOBJ :: GLES => FilePath -> IO OBJModel+loadOBJ :: FilePath -> IO OBJModel loadOBJ = fmap parseOBJ . readFile -- TODO: substitute with ajax -parseOBJ :: GLES => String -> OBJModel+parseOBJ :: String -> OBJModel parseOBJ file = runST $         do vs <- new            us <- new@@ -74,6 +75,8 @@               parseFloat [] = 0               parseFloat s = read s +attributesOBJ :: OBJModel -> ([V3], [V2], [V3], [Word16])+attributesOBJ (OBJModel v u n fs) = arraysToElements $ facesToArrays v u n fs+ geometryOBJ :: GLES => OBJModel -> Geometry Geometry3-geometryOBJ (OBJModel vs us ns fs) =-        arraysToElements $ facesToArrays vs us ns fs+geometryOBJ o = let (v, u, n, e) = attributesOBJ o in mkGeometry3 v u n e

@@ -38,7 +38,7 @@ import FWGL.Internal.TList import FWGL.Shader.CPU import FWGL.Shader.Program-import FWGL.Texture+import FWGL.Graphics.Texture import FWGL.Vector  -- | An empty custom object.

@@ -15,6 +15,7 @@         mkGeometry2,         -- * Textures         module FWGL.Graphics.Color,+        Texture,         C.textureURL,         C.textureFile,         C.colorTex,@@ -68,10 +69,10 @@ import FWGL.Graphics.Draw import FWGL.Graphics.Shapes import FWGL.Graphics.Types+import FWGL.Graphics.Texture import FWGL.Internal.TList import FWGL.Shader.Default2D (Image, Depth, Transform2, View2) import FWGL.Shader.Program-import FWGL.Texture import FWGL.Vector  -- | A 2D object with a 'Texture', a depth and a transformation.

@@ -0,0 +1,159 @@+{-# LANGUAGE DataKinds, FlexibleContexts, ConstraintKinds, TypeOperators,+             TypeFamilies #-}++{-| Simplified 3D graphics system. -}+module FWGL.Graphics.D3 (+        -- * Elements+        Element,+        cube,+        -- ** Geometry+        Geometry,+        geom,+        mkGeometry3,+        -- * Textures+        module FWGL.Graphics.Color,+        Texture,+        textureURL,+        textureFile,+        textureLayer,+        C.colorTex,+        mkTexture,+        -- * Transformations+        V3(..),+        pos,+        rotX,+        rotY,+        rotZ,+        rotAA,+        scale,+        scaleV,+        -- * Layers+        Layer,+        -- ** Element layers+        elements,+        view,+        -- ** Object layers+        layer,+        layerPrg,+        -- * Custom 3D objects+        Object,+        object,+        object1,+        (C.~~),+        -- ** Globals+        C.global,+        C.globalTexture,+        C.globalTexSize,+        viewObject,+        DefaultUniforms3D,+        Texture2(..),+        Transform3(..),+        View3(..),+        -- * 3D matrices+        V4(..),+        M4(..),+        mat4,+        mul4,+        -- ** View matrices+        perspectiveMat4,+        -- ** Transformation matrices+        idMat4,+        transMat4,+        rotXMat4,+        rotYMat4,+        rotZMat4,+        rotAAMat4,+        scaleMat4+) where++import Control.Applicative+import FWGL.Backend hiding (Texture, Program)+import FWGL.Geometry+import qualified FWGL.Graphics.Custom as C+import FWGL.Graphics.Color+import FWGL.Graphics.Draw+import FWGL.Graphics.Shapes+import FWGL.Graphics.Types+import FWGL.Internal.TList+import FWGL.Shader.Default3D (Texture2, Transform3, View3)+import FWGL.Shader.Program+import FWGL.Graphics.Texture+import FWGL.Vector++-- | A 3D object with a 'Texture' and a transformation.+data Element = Element Texture (Draw M4) (Geometry Geometry3)++-- | A cube with a specified 'Texture'.+cube :: GLES => Texture -> Element+cube t = Element t (return idMat4) cubeGeometry++-- | An element with a specified 'Geometry' and 'Texture'.+geom :: Texture -> Geometry Geometry3 -> Element+geom t = Element t $ return idMat4++-- | Create a graphical 'Object' from a list of 'Element's and a view matrix.+object :: BackendIO => M4 -> [Element] -> Object DefaultUniforms3D Geometry3+object m = viewObject m . foldl acc ObjectEmpty+        where acc o e = o C.~~ object1 e++-- | Create a graphical 'Object' from a single 'Element'. This lets you set your+-- own globals individually. If the shader uses the view matrix 'View3' (e.g.+-- the default 3D shader), you have to set it with 'viewObject'.+object1 :: BackendIO => Element -> Object '[Transform3, Texture2] Geometry3+object1 (Element t m g) = C.globalDraw (undefined :: Transform3) m $+                          C.globalTexture (undefined :: Texture2) t $+                          C.static g++-- | Create a standard 'Layer' from a list of 'Element's.+elements :: BackendIO => [Element] -> Layer+elements = layer . object idMat4++-- | Create a 'Layer' from a view matrix and a list of 'Element's.+view :: BackendIO => M4 -> [Element] -> Layer+view m = layer . object m++-- | Set the value of the view matrix of a 3D 'Object'.+viewObject :: BackendIO => M4 -> Object gs Geometry3+           -> Object (View3 ': gs) Geometry3+viewObject = C.global (undefined :: View3)++-- | Create a 'Layer' from a 3D 'Object', using the default shader.+layer :: BackendIO => Object DefaultUniforms3D Geometry3 -> Layer+layer = layerPrg defaultProgram3D++-- | Create a 'Layer' from a 3D 'Object', using a custom shader.+layerPrg :: (BackendIO, Subset og pg) => Program pg Geometry3+         -> Object og Geometry3 -> Layer+layerPrg = C.layer++-- | Translate an 'Element'.+pos :: V3 -> Element -> Element+pos v = transform $ transMat4 v++-- | Rotate an 'Element' around the X axis.+rotX :: Float -> Element -> Element+rotX a = transform $ rotXMat4 a++-- | Rotate an 'Element' around the X axis.+rotY :: Float -> Element -> Element+rotY a = transform $ rotYMat4 a++-- | Rotate an 'Element' around the X axis.+rotZ :: Float -> Element -> Element+rotZ a = transform $ rotZMat4 a++-- | Rotate an 'Element' around an axis and an angle.+rotAA :: V3 -> Float -> Element -> Element+rotAA ax ag = transform $ rotAAMat4 ax ag++-- | Scale an 'Element'.+scale :: Float -> Element -> Element+scale f = transform $ scaleMat4 (V3 f f f)++-- | Scale an 'Element' in three dimensions.+scaleV :: V3 -> Element -> Element+scaleV v = transform $ scaleMat4 v++-- | Transform an 'Element'.+transform :: M4 -> Element -> Element+transform m' (Element t m g) = Element t (mul4 <$> m <*> pure m') g

@@ -8,6 +8,7 @@         drawInit,         drawBegin,         drawLayer,+        drawEnd,         textureUniform,         textureSize,         setProgram,@@ -17,15 +18,17 @@ import FWGL.Geometry import FWGL.Graphics.Shapes import FWGL.Graphics.Types+import FWGL.Graphics.Texture import FWGL.Backend.IO import FWGL.Internal.GL hiding (Texture, Program, UniformLocation)+import qualified FWGL.Internal.GL as GL import FWGL.Internal.Resource import FWGL.Shader.CPU import FWGL.Shader.GLSL import FWGL.Shader.Program hiding (program)-import FWGL.Texture import FWGL.Vector +import Data.Hashable (Hashable) import qualified Data.HashMap.Strict as H import Data.Typeable import Data.Word (Word)@@ -45,8 +48,9 @@                                    , programs = newGLResMap                                    , gpuMeshes = newGLResMap                                    , uniforms = newGLResMap-                                   , textures = newGLResMap }-        where newGLResMap :: Resource i r GL => ResMap i r+                                   , textureImages = newGLResMap+                                   , textureLayers = [] }+        where newGLResMap :: (Hashable i, Resource i r GL) => ResMap i r               newGLResMap = newResMap  execDraw :: Draw () -> DrawState -> GL DrawState@@ -58,6 +62,9 @@ drawBegin :: GLES => Draw () drawBegin = gl $ clear gl_COLOR_BUFFER_BIT +drawEnd :: GLES => Draw ()+drawEnd = Draw get >>= mapM_ (gl . deleteTexture) . textureLayers+ drawLayer :: (GLES, BackendIO) => Layer -> Draw () drawLayer (Layer prg obj) = setProgram prg >> drawObject obj @@ -123,12 +130,40 @@ getGPUGeometry = getDrawResource gl gpuMeshes (\ m s -> s { gpuMeshes = m })  getTexture :: (GLES, BackendIO) => Texture -> Draw (ResStatus LoadedTexture)-getTexture = getDrawResource gl textures (\ m s -> s { textures = m })+getTexture (TextureLayer l w h) = do t <- renderTexture w h l+                                     return . Loaded $ LoadedTexture w h t+getTexture (TextureImage t) = getTextureImage t +getTextureImage :: (GLES, BackendIO) => TextureImage+                -> Draw (ResStatus LoadedTexture)+getTextureImage = getDrawResource gl textureImages+                                     (\ m s -> s { textureImages = m })+ getProgram :: GLES => Program '[] '[] -> Draw (ResStatus LoadedProgram) getProgram = getDrawResource gl programs (\ m s -> s { programs = m }) -getDrawResource :: Resource i r m+renderTexture :: GLES => GLSize -> GLSize -> Layer -> Draw GL.Texture+renderTexture w h layer = do+        t <- gl $ do fb <- createFramebuffer++                     t <- emptyTexture+                     arr <- liftIO $ noArray+                     bindTexture gl_TEXTURE_2D t+                     texImage2DBuffer gl_TEXTURE_2D 0 (fromIntegral gl_RGBA) w +                                      h 0 gl_RGBA+                                      gl_UNSIGNED_BYTE arr++                     bindFramebuffer gl_FRAMEBUFFER fb+                     framebufferTexture2D gl_FRAMEBUFFER+                                          gl_COLOR_ATTACHMENT0+                                          gl_TEXTURE_2D t 0+                     deleteFramebuffer fb++                     return t+        Draw . modify $ \s -> s { textureLayers = t : textureLayers s }+        return t++getDrawResource :: (Resource i r m, Hashable i)                 => (m (ResStatus r, ResMap i r)                     -> Draw (ResStatus r, ResMap i r))                 -> (DrawState -> ResMap i r)

@@ -0,0 +1,99 @@+{-# LANGUAGE MultiParamTypeClasses #-}++module FWGL.Graphics.Texture (+        mkTexture,+        textureURL,+        textureFile,+        textureLayer,+        textureHash,+        emptyTexture+) where++import Data.Hashable++import FWGL.Backend.GLES (GLES)+import FWGL.Backend.IO+import FWGL.Graphics.Color+import FWGL.Graphics.Types+import FWGL.Internal.GL hiding (Texture)+import qualified FWGL.Internal.GL as GL+import FWGL.Internal.Resource++-- | Creates a 'Texture' from a list of pixels.+mkTexture :: GLES+          => Int      -- ^ Width.+          -> Int      -- ^ Height.+          -> [Color]  -- ^ List of pixels+          -> Texture+mkTexture w h ps = TextureImage . TexturePixels ps (fromIntegral w)+                                                   (fromIntegral h) $ hash ps++-- | Creates a 'Texture' from an URL (JavaScript only).+textureURL :: String  -- ^ URL+           -> Texture+textureURL url = TextureImage . TextureURL url $ hash url++-- | Creates a 'Texture' from a file (Desktop only).+textureFile :: String -> Texture+textureFile = textureURL++-- | Creates a 'Texture' from a 'Layer'.+textureLayer :: GLES => Int -> Int -> Layer -> Texture+textureLayer w h l = TextureLayer l (fromIntegral w) (fromIntegral h)++textureHash :: TextureImage -> Int+textureHash (TexturePixels _ _ _ h) = h+textureHash (TextureURL _ h) = h++instance Hashable TextureImage where+        hashWithSalt salt tex = hashWithSalt salt $ textureHash tex++instance Eq TextureImage where+        (TexturePixels _ _ _ h) == (TexturePixels _ _ _ h') = h == h'+        (TextureURL _ h) == (TextureURL _ h') = h == h'+        _ == _ = False++instance (BackendIO, GLES) => Resource TextureImage LoadedTexture GL where+        loadResource i f = loadTextureImage i $ f . Right -- TODO: err check+        unloadResource _ (LoadedTexture _ _ t) = deleteTexture t++loadTextureImage :: (BackendIO, GLES) => TextureImage+                 -> (LoadedTexture -> GL ()) -> GL ()+loadTextureImage tex f =+        case tex of+                (TexturePixels ps w h _) -> (>>= f) $+                        do t <- emptyTexture+                           arr <- liftIO $ encodeColors ps+                           texImage2DBuffer gl_TEXTURE_2D 0+                                            (fromIntegral gl_RGBA)+                                            w h 0+                                            gl_RGBA+                                            gl_UNSIGNED_BYTE+                                            arr+                           return $ LoadedTexture (fromIntegral w)+                                                  (fromIntegral h)+                                                  t+                (TextureURL url _) ->+                        do ctx <- getCtx+                           liftIO $ loadImage url $ \(img, w, h) ->+                                flip evalGL ctx $ do+                                        t <- emptyTexture+                                        texImage2DImage gl_TEXTURE_2D 0+                                                        (fromIntegral gl_RGBA)+                                                        gl_RGBA+                                                        gl_UNSIGNED_BYTE+                                                        img+                                        f $ LoadedTexture (fromIntegral w)+                                                          (fromIntegral h)+                                                          t++emptyTexture :: GLES => GL GL.Texture+emptyTexture = do t <- createTexture+                  bindTexture gl_TEXTURE_2D t+                  param gl_TEXTURE_MAG_FILTER gl_LINEAR+                  param gl_TEXTURE_MIN_FILTER gl_LINEAR+                  param gl_TEXTURE_WRAP_S gl_REPEAT+                  param gl_TEXTURE_WRAP_T gl_REPEAT+                  return t+        where param :: GLES => GLEnum -> GLEnum -> GL ()+              param p v = texParameteri gl_TEXTURE_2D p $ fromIntegral v

@@ -5,6 +5,9 @@         Draw(..),         DrawState(..),         UniformLocation(..),+        Texture(..),+        TextureImage(..),+        LoadedTexture(..),         Geometry(..),         Mesh(..),         Light(..),@@ -17,13 +20,13 @@ import Control.Monad.Trans.State import Data.Typeable import FWGL.Geometry+import FWGL.Graphics.Color import FWGL.Internal.GL hiding (Program, Texture, UniformLocation) import qualified FWGL.Internal.GL as GL import FWGL.Internal.TList import FWGL.Internal.Resource import FWGL.Shader.CPU import FWGL.Shader.Program-import FWGL.Texture import FWGL.Vector  newtype UniformLocation = UniformLocation GL.UniformLocation@@ -34,11 +37,21 @@         programs :: ResMap (Program '[] '[]) LoadedProgram,         uniforms :: ResMap (LoadedProgram, String) UniformLocation,         gpuMeshes :: ResMap (Geometry '[]) GPUGeometry,-        textures :: ResMap Texture LoadedTexture+        textureImages :: ResMap TextureImage LoadedTexture,+        textureLayers :: [GL.Texture] }  newtype Draw a = Draw { unDraw :: StateT DrawState GL a }         deriving (Functor, Applicative, Monad, MonadIO)++-- | A texture.+data Texture = TextureImage TextureImage+             | TextureLayer Layer GLSize GLSize+             +data TextureImage = TexturePixels [Color] GLSize GLSize Int+                  | TextureURL String Int++data LoadedTexture = LoadedTexture GLSize GLSize GL.Texture  -- | A static or dinamic geometry. data Mesh is where

@@ -18,28 +18,30 @@ import qualified Data.HashMap.Strict as H import Data.Hashable -data ResMap i r = forall m. Resource i r m =>+data ResMap i r = forall m. (Resource i r m, Hashable i) =>                             ResMap (H.HashMap i (IORef (ResStatus r)))  data ResStatus r = Loaded r | Unloaded | Loading | Error String -class (Hashable i, Eq i, Applicative m, MonadIO m) =>+class (Eq i, Applicative m, MonadIO m) =>       Resource i r m | i -> r m where         loadResource :: i -> (Either String r -> m ()) -> m ()         unloadResource :: i -> r -> m () -newResMap :: Resource i r m => ResMap i r+newResMap :: Hashable i => Resource i r m => ResMap i r newResMap = ResMap H.empty -addResource :: Resource i r m => i -> ResMap i r -> m (ResMap i r)+addResource :: (Resource i r m, Hashable i) => i -> ResMap i r -> m (ResMap i r) addResource i m = snd <$> getResource i m -checkResource :: Resource i r m => i -> ResMap i r -> m (ResStatus r)+checkResource :: (Resource i r m, Hashable i)+              => i -> ResMap i r -> m (ResStatus r) checkResource i (ResMap map) = case H.lookup i map of                                         Just ref -> liftIO $ readIORef ref                                         Nothing -> return $ Unloaded -getResource :: Resource i r m => i -> ResMap i r -> m (ResStatus r, ResMap i r)+getResource :: (Resource i r m, Hashable i)+            => i -> ResMap i r -> m (ResStatus r, ResMap i r) getResource i rmap@(ResMap map) =         do status <- checkResource i rmap            case status of@@ -52,7 +54,8 @@                            return (status', ResMap $ H.insert i ref map)                    _ -> return (status, rmap) -removeResource :: Resource i r m => i -> ResMap i r -> m (ResMap i r)+removeResource :: (Resource i r m, Hashable i)+               => i -> ResMap i r -> m (ResMap i r) removeResource i rmap@(ResMap map) =          do status <- checkResource i rmap            case status of

@@ -7,7 +7,7 @@ import FWGL.Shader import qualified FWGL.Vector -type Uniforms = '[Transform3, View3, Texture2]+type Uniforms = '[View3, Transform3, Texture2] type Attributes = '[Position3, UV, Normal3]  newtype Texture2 = Texture2 Sampler2D

@@ -1,98 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}--module FWGL.Texture (-        Texture(..),-        LoadedTexture(..),-        mkTexture,-        textureURL,-        textureFile,-        textureHash-) where--import Data.Hashable--import FWGL.Backend.GLES (GLES)-import FWGL.Backend.IO-import FWGL.Graphics.Color-import FWGL.Internal.GL hiding (Texture)-import qualified FWGL.Internal.GL as GL-import FWGL.Internal.Resource---- | A texture.-data Texture = TexturePixels [Color] GLSize GLSize Int-             | TextureURL String Int--data LoadedTexture = LoadedTexture GLSize GLSize GL.Texture---- | Creates a 'Texture' from a list of pixels.-mkTexture :: GLES-          => Int      -- ^ Width.-          -> Int      -- ^ Height.-          -> [Color]  -- ^ List of pixels-          -> Texture-mkTexture w h ps = TexturePixels ps (fromIntegral w) (fromIntegral h) $ hash ps---- | Creates a 'Texture' from an URL (JavaScript only).-textureURL :: String  -- ^ URL-           -> Texture-textureURL url = TextureURL url $ hash url---- | Creates a 'Texture' from a file (Desktop only).-textureFile :: String -> Texture-textureFile = textureURL--textureHash :: Texture -> Int-textureHash (TexturePixels _ _ _ h) = h-textureHash (TextureURL _ h) = h--instance Hashable Texture where-        hashWithSalt salt tex = hashWithSalt salt $ textureHash tex--instance Eq Texture where-        (TexturePixels _ _ _ h) == (TexturePixels _ _ _ h') = h == h'-        (TextureURL _ h) == (TextureURL _ h') = h == h'-        _ == _ = False--instance (BackendIO, GLES) => Resource Texture LoadedTexture GL where-        loadResource i f = loadTexture i $ f . Right -- TODO: err check-        unloadResource _ (LoadedTexture _ _ t) = deleteTexture t--loadTexture :: (BackendIO, GLES) => Texture -> (LoadedTexture -> GL ()) -> GL ()-loadTexture tex f =-        case tex of-                (TexturePixels ps w h _) -> flip asyncGL f $-                        do t <- setup-                           arr <- liftIO $ encodeColors ps-                           texImage2DBuffer gl_TEXTURE_2D 0-                                            (fromIntegral gl_RGBA)-                                            w h 0-                                            gl_RGBA-                                            gl_UNSIGNED_BYTE-                                            arr-                           return $ LoadedTexture (fromIntegral w)-                                                  (fromIntegral h)-                                                  t-                (TextureURL url _) ->-                        do ctx <- getCtx-                           liftIO $ loadImage url $ \(img, w, h) ->-                                flip evalGL ctx $ do-                                        t <- setup-                                        texImage2DImage gl_TEXTURE_2D 0-                                                        (fromIntegral gl_RGBA)-                                                        gl_RGBA-                                                        gl_UNSIGNED_BYTE-                                                        img-                                        f $ LoadedTexture (fromIntegral w)-                                                          (fromIntegral h)-                                                          t-        where setup = do                  -- XXX-                t <- createTexture-                bindTexture gl_TEXTURE_2D t-                param gl_TEXTURE_MAG_FILTER gl_LINEAR-                param gl_TEXTURE_MIN_FILTER gl_LINEAR-                param gl_TEXTURE_WRAP_S gl_REPEAT-                param gl_TEXTURE_WRAP_T gl_REPEAT-                return t-              param :: GLEnum -> GLEnum -> GL ()-              param p v = texParameteri gl_TEXTURE_2D p $ fromIntegral v-

@@ -1,16 +1,28 @@ module FWGL.Utils (-        screenScale+        screenScale,+        perspective4 ) where  import FRP.Yampa import FWGL.Input import FWGL.Graphics.Custom+import FWGL.Vector  -- | 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))++-- | Generate a perspective view matrix using the aspect ratio of the+-- framebuffer.+perspective4 :: Float   -- ^ Far+             -> Float   -- ^ Near+             -> Float   -- ^ FOV+             -> SF Input M4+perspective4 f n fov =+        size >>^ \(w, h) -> perspectiveMat4 f n fov+                                            (fromIntegral w / fromIntegral h)  -- | Like 'dynamic', but instead of comparing the two objects it checks the -- event with the new object.

@@ -21,6 +21,7 @@         rotZMat4,         rotAAMat4,         scaleMat4,+        perspectiveMat4,         idMat3,         transMat3,         rotMat3,@@ -249,7 +250,11 @@                                  , 0, 0, z )  -- | 4x4 perspective matrix.-perspectiveMat4 :: Float -> Float -> Float -> Float -> M4+perspectiveMat4 :: Float        -- ^ Far+                -> Float        -- ^ Near+                -> Float        -- ^ FOV+                -> Float        -- ^ Aspect ratio+                -> M4 perspectiveMat4 f n fov ar =         mat4 ( s / ar , 0 , 0                 , 0              , 0      , s , 0                 , 0

@@ -1,19 +1,20 @@ name:                fwgl-version:             0.1.0.0+version:             0.1.0.1 synopsis:            FRP 2D/3D game engine-description:         FRP 2D/3D game engine (work in progress)+description:         FRP 2D/3D game engine (work in progress). You need to install it with the "--ghcjs" option, for now. I'll separate the ghcjs backend when the GLFW one will be complete. homepage:            https://github.com/ZioCrocifisso/FWGL+stability:           experimental license:             BSD3 license-file:        LICENSE author:              Luca "ZioCrocifisso" Prezzavento maintainer:          ziocroc@hotmail.it-category:            Game+category:            Game, Game Engine, Javascript build-type:          Simple cabal-version:       >=1.10  library-  exposed-modules:     FWGL, FWGL.Shader, FWGL.Geometry, FWGL.Utils, FWGL.Vector, FWGL.Texture, FWGL.Audio, FWGL.Key, FWGL.Backend, FWGL.Input, FWGL.Graphics.Draw, FWGL.Graphics.D2, FWGL.Graphics.Types, FWGL.Graphics.Color, FWGL.Graphics.Custom, 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.Monad, FWGL.Shader.Language, FWGL.Shader.Default2D, FWGL.Backend.JavaScript-  -- , FWGL.Backend.OpenGL.GL32, FWGL.Backend.OpenGL.Common, FWGL.Backend.OpenGL.GLES20, FWGL.Backend.GLFW.GL32, FWGL.Backend.GLFW.Common, FWGL.Backend.GLFW.GLES20, FWGL.Graphics.D3,+  exposed-modules:     FWGL, FWGL.Shader, FWGL.Geometry, FWGL.Utils, FWGL.Vector, FWGL.Audio, 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.Custom, 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.Monad, FWGL.Shader.Language, FWGL.Shader.Default2D, FWGL.Backend.JavaScript+  -- , FWGL.Backend.OpenGL.GL32, FWGL.Backend.OpenGL.Common, FWGL.Backend.OpenGL.GLES20, FWGL.Backend.GLFW.GL32, FWGL.Backend.GLFW.Common, FWGL.Backend.GLFW.GLES20   other-modules:        FWGL.Internal.STVectorLen, FWGL.Internal.Resource, FWGL.Backend.JavaScript.WebGL, FWGL.Backend.JavaScript.Event, FWGL.Backend.JavaScript.WebGL.Const, FWGL.Backend.JavaScript.WebGL.Types, FWGL.Backend.JavaScript.WebGL.Raw, FWGL.Backend.GLES, FWGL.Backend.IO   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.8, Yampa >=0.9 && <0.10, hashable >=1.2 && <1.3, unordered-containers >=0.2 && <0.3, vector >=0.10 && <0.11, transformers, ghcjs-base