call 0.1.3 → 0.1.4

raw patch · 8 files changed

+58/−90 lines, 8 filesdep +freedep −elevatordep −extensibledep −minioperationaldep ~objective

Dependencies added: free

Dependencies removed: elevator, extensible, minioperational, reflection

Dependency ranges changed: objective

Files

• call.cabal +3/−6
• shaders/vertex.glsl +31/−31
• src/Call.hs +0/−2
• src/Call/Internal/GLFW.hs +0/−7
• src/Call/System.hs +0/−17
• src/Call/Util/Deck.hs +2/−3
• src/Call/Util/Sampler.hs +2/−3
• src/Call/Util/Text.hs +20/−21

@@ -1,5 +1,5 @@ name:                call-version:             0.1.3+version:             0.1.4 synopsis:            The call game engine description:         Call is a minimalistic game engine that supports 2D/3D graphics and sounds. homepage:            https://github.com/fumieval/call@@ -57,8 +57,6 @@     control-bool >=0.2 && <0.4,     directory,     distributive == 0.4.*,-    elevator >= 0.2 && <0.3,-    extensible >= 0.2.6 && <0.3,     filepath,     freetype2 >=0.1 && <0.2,     GLFW-b >=1.3 && <2,@@ -68,17 +66,16 @@     lens >=4.0 && <5,     linear >=1.13 && <2,     mtl >=2.0 && <2.7,-    objective >= 0.6.5 && <0.7,+    objective >= 1 && <1.1,+    free >= 4.5 && <5,     OpenGL >= 2.9 && <2.12,     OpenGLRaw >=1.4 && <1.7,     random ==1.*,-    reflection >=1.4 && <1.7,     template-haskell == 2.*,     text >= 1.0 && <1.5,     transformers >=0.3 && <0.5,     vector >=0.9 && <0.13,     WAVE >=0.1 && <0.2,-    minioperational >= 0.4.7 && <0.6,     deepseq   hs-source-dirs:      src   default-language:    Haskell2010

@@ -1,31 +1,31 @@-#version 330
-uniform mat4 projection;
-uniform mat4 matrices[13];
-uniform int level;
-uniform bool useEnv;
-out vec2 UV;
-out vec2 envUV;
-in vec3 in_Position;
-in vec2 in_UV;
-in vec3 in_Normal;
-out vec3 lightDir;
-out vec3 normal;
-
-void main(void) {
-  mat4 model = mat4(1.0);
-  for(int i=0; i < level; i++)
-  {
-    model *= matrices[i];
-  }
-  gl_Position = projection * model * vec4(in_Position, 1.0);
-  UV = in_UV;
-
-  if(useEnv)
-  {
-    vec3 refl = reflect( normalize(vec3(model * vec4(in_Position, 1.0))), in_Normal );
-    float m = 2.0 * sqrt( refl.x*refl.x + refl.y*refl.y + (refl.z+1.0)*(refl.z+1.0) );
-    envUV = refl.xy / m + 0.5;
-  }
-  normal = in_Normal;
-  lightDir = vec3(0.0);
-}
+#version 330+uniform mat4 projection;+uniform mat4 matrices[13];+uniform int level;+uniform bool useEnv;+out vec2 UV;+out vec2 envUV;+in vec3 in_Position;+in vec2 in_UV;+in vec3 in_Normal;+out vec3 lightDir;+out vec3 normal;++void main(void) {+  mat4 model = mat4(1.0);+  for(int i=0; i < level; i++)+  {+    model *= matrices[i];+  }+  gl_Position = projection * model * vec4(in_Position, 1.0);+  UV = in_UV;++  if(useEnv)+  {+    vec3 refl = reflect( normalize(vec3(model * vec4(in_Position, 1.0))), in_Normal );+    float m = 2.0 * sqrt( refl.x*refl.x + refl.y*refl.y + (refl.z+1.0)*(refl.z+1.0) );+    envUV = refl.xy / m + 0.5;+  }+  normal = in_Normal;+  lightDir = vec3(0.0);+}

@@ -17,7 +17,6 @@     module Data.Color.Names,     module Linear,     module Control.Object,-    module Control.Monad.Objective.Class,     module Control.Monad.IO.Class ) where @@ -32,7 +31,6 @@ import Control.Applicative import Control.Bool import Control.Object hiding (invoke)-import Control.Monad.Objective.Class import Data.Color import Data.Color.Names import Data.Monoid

@@ -158,17 +158,10 @@   GL.linkProgram shaderProg   GL.currentProgram $= Just shaderProg -  -- GL.blend $= GL.Disabled   GL.depthMask $= GL.Enabled   GL.depthFunc $= Just GL.Lequal   GL.colorMask $= GL.Color4 GL.Enabled GL.Enabled GL.Enabled GL.Enabled-  {--  GL.depthMask $= GL.Disabled-  GL.depthFunc $= Nothing -  GL.colorMask $= GL.Color4 GL.Enabled GL.Enabled GL.Enabled GL.Enabled-  -}-  -- GL.cullFace $= GL.Back   GL.blend      $= GL.Enabled   GL.blendFunc  $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)   linked <- GL.get (GL.linkStatus shaderProg)

@@ -71,11 +71,8 @@ import Control.Applicative import Control.Concurrent import Control.Exception-import Control.Elevator import Control.Lens-import Control.Monad.Objective import Control.Monad.Reader-import Control.Object import Data.BoundingBox (Box(..)) import Data.IORef import Data.Maybe@@ -92,7 +89,6 @@ import qualified Graphics.Rendering.OpenGL.Raw as GL import qualified Graphics.UI.GLFW as GLFW import Unsafe.Coerce-import Data.Extensible  setFPS :: Float -> System s () setFPS f = mkSystem $ \fo -> writeIORef (targetFPS fo) f@@ -118,19 +114,6 @@ instance Monoid a => Monoid (System s a) where   mempty = return mempty   mappend = liftA2 mappend--instance ObjectiveBase (System s) where-  data Inst (System s) f g = InstS (MVar (Object f g))-  invoke mr gr (InstS m) e = do-    c <- mr $ liftIO $ takeMVar m-    (a, c') <- gr (runObject c e)-    mr $ liftIO $ putMVar m c'-    return a-  new v = liftIO $ InstS `fmap` newMVar v--instance Tower (System s) where-  type Floors (System s) = Floors IO-  stairs = hmap (\(Gondola f) -> Gondola (liftIO . f)) stairs  unSystem :: Foundation s -> System s a -> IO a unSystem f m = unsafeCoerce m f

@@ -24,8 +24,7 @@ import Call.Data.Wave import Call.Types import qualified Data.Vector.Storable as V-import Control.Monad.Objective-import Control.Elevator+import Control.Object  data Deck = Deck   { _src :: Source Stereo@@ -55,5 +54,5 @@       return $ V.fromList $ take n $ map s [t0,t0 + dt / fromIntegral n..]     else return $ V.replicate n 0 -playbackOf :: (MonadObjective b m, Elevate n m) => Inst b (State Deck) n -> Time -> Int -> m (V.Vector Stereo)+playbackOf :: (MonadIO m, MonadState Deck b) => Instance b m -> Time -> Int -> m (V.Vector Stereo) playbackOf i = \dt n -> i .- playback dt n

@@ -19,8 +19,7 @@ import Control.Monad.State.Strict import Call.Types import Call.Data.Wave-import Control.Monad.Objective-import Control.Elevator+import Control.Object  data Sampler = Sampler [(Sample Stereo, Time)] @@ -49,5 +48,5 @@ play :: MonadState Sampler m => Sample Stereo -> m () play s = modify $ \(Sampler xs) -> Sampler $ (s, 0) : xs -playbackOf :: (MonadObjective b m, Elevate n m) => Inst b (State Sampler) n -> Time -> Int -> m (V.Vector Stereo)+playbackOf :: (MonadIO m, MonadState Sampler b) => Instance b m -> Time -> Int -> m (V.Vector Stereo) playbackOf i = \dt n -> i .- playback dt n

@@ -1,56 +1,55 @@-{-# LANGUAGE ConstraintKinds, FlexibleContexts, BangPatterns #-}+{-# LANGUAGE ConstraintKinds, FlexibleContexts, BangPatterns, DeriveFunctor #-} module Call.Util.Text (renderer, typewriter, putStr, clear, simple) where import Prelude hiding (putStr) import Call.Data.Bitmap (Bitmap(..)) import Call.Data.Font import Call.Sight import Control.Lens hiding (simple)-import Control.Monad.Objective-import Control.Monad.Operational.Mini+import Control.Monad.Free import Control.Monad.State.Class import Control.Monad.Trans+import Control.Applicative import Control.Object import Data.Monoid import Linear import Control.DeepSeq -renderer :: MonadIO m => Font -> Float -> Object (Request Char (Bitmap, V2 Float, V2 Float)) m+data Typewriting a = Render (Picture -> a) | Type Char a deriving Functor++renderer :: (MonadIO m, Applicative m) => Font -> Float -> Object (Request Char (Bitmap, V2 Float, V2 Float)) m renderer font size = flyweight (liftIO . renderChar font size) -typewriter :: MonadIO m => Float -> (Char -> m (Bitmap, V2 Float, V2 Float)) -> Object (ReifiedProgram (PushPull Char Picture)) m-typewriter l req = sequential $ stateful go (V2 0 0, mempty) where-  go (Push '\3' cont) = do+typewriter :: MonadIO m => Float -> (Char -> m (Bitmap, V2 Float, V2 Float)) -> Object (Free Typewriting) m+typewriter l req = iterative $ stateful go (V2 0 0, mempty) where+  go (Type '\3' cont) = do     put (V2 0 0, mempty)     return cont-  go (Push '\r' cont) = return cont-  go (Push '\n' cont) = do+  go (Type '\r' cont) = return cont+  go (Type '\n' cont) = do     _1 . _y += l     _1 . _x .= 0     return cont-  go (Push ch cont) = do+  go (Type ch cont) = do     (pos, pic) <- get     (!bmp@(Bitmap img _ _), !ofs, !adv) <- lift $ req ch     return $! rnf img     put (pos + adv, pic <> translate (pos + ofs) (bitmap bmp))     return cont-  go (Pull cont) = uses _2 cont+  go (Render cont) = uses _2 cont -putStr :: String -> ReifiedProgram (PushPull Char Picture) ()+putStr :: String -> Free Typewriting () putStr [] = return ()-putStr (c:cs) = Push c () :>>= const (putStr cs)--clear :: ReifiedProgram (PushPull Char Picture) ()-clear = Push '\3' () :>>= return+putStr (c:cs) = wrap (Type c (putStr cs)) -new' :: ObjectiveBase b => Object f b -> b (Inst b f b)-new' = new+clear :: Free Typewriting ()+clear = liftF $ Type '\3' ()  simple :: MonadIO m => Font -> Float -> m (String -> Picture) simple font size = liftIO $ do-  r <- new' $ renderer font size-  t <- new' $ typewriter (size * 1.2) ((r.-) . request)+  r <- new $ renderer font size+  t <- new $ typewriter (size * 1.2) ((r.-) . request)   return $ \s -> Picture $ applyVFX $ EmbedIO $ do     t .- putStr s-    p <- t .- (Pull id :>>= return)+    p <- t .- liftF (Render id)     t .- clear     return $! unPicture p