call 0.1.1.2 → 0.1.1.3

raw patch · 4 files changed

+25/−16 lines, 4 filesdep ~objective

Dependency ranges changed: objective

Files

• call.cabal +3/−3
• src/Call/Internal/GLFW.hs +5/−7
• src/Call/Util/Deck.hs +8/−2
• src/Call/Util/Sampler.hs +9/−4

@@ -1,5 +1,5 @@ name:                call
-version:             0.1.1.2
+version:             0.1.1.3
 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
@@ -68,7 +68,7 @@     lens >=4.0 && <5,
     linear >=1.13 && <2,
     mtl >=2.0 && <2.7,
-    objective >= 0.6.1 && <0.7,
+    objective >= 0.6.2 && <0.7,
     OpenGL == 2.9.*,
     OpenGLRaw >=1.4 && <1.7,
     random ==1.*,
@@ -91,4 +91,4 @@   else
     buildable: False
   build-depends: base == 4.*, call <= 0.2, lens == 4.*
-  default-language:    Haskell2010+  default-language:    Haskell2010

@@ -55,8 +55,6 @@   [tex] <- GL.genObjectNames 1
   GL.textureBinding GL.Texture2D GL.$= Just tex
   let siz = GL.TextureSize2D (gsizei w) (gsizei h)
-  GL.glTexParameteri GL.gl_TEXTURE_2D GL.gl_TEXTURE_BASE_LEVEL 0
-  GL.glTexParameteri GL.gl_TEXTURE_2D GL.gl_TEXTURE_MAX_LEVEL 0
   V.unsafeWith v
     $ GL.texImage2D GL.Texture2D GL.NoProxy 0 GL.RGBA8 siz 0
     . GL.PixelData GL.ABGR GL.UnsignedInt8888
@@ -99,7 +97,7 @@ 
   GLFW.swapInterval 1
   -- GL.clearColor $= GL.Color4 1 1 1 1
-  
+
   (fw, fh) <- GLFW.getFramebufferSize win
 
   rbox <- newIORef $ bbox & size zero .~ fmap fromIntegral (V2 fw fh)
@@ -121,7 +119,7 @@   let vertexAttribute = GL.AttribLocation 0
   let uvAttribute = GL.AttribLocation 1
   let normalAttribute = GL.AttribLocation 2
-  
+
   cubeVao <- GL.genObjectName
   cubeVbo <- GL.genObjectName
 
@@ -159,7 +157,7 @@   GL.attribLocation shaderProg "in_Normal" $= normalAttribute
   GL.linkProgram shaderProg
   GL.currentProgram $= Just shaderProg
-  
+
   -- GL.blend $= GL.Disabled
   GL.depthMask $= GL.Enabled
   GL.depthFunc $= Just GL.Lequal
@@ -167,7 +165,7 @@   {-
   GL.depthMask $= GL.Disabled
   GL.depthFunc $= Nothing
-  
+
   GL.colorMask $= GL.Color4 GL.Enabled GL.Enabled GL.Enabled GL.Enabled
   -}
   -- GL.cullFace $= GL.Back
@@ -176,7 +174,7 @@   linked <- GL.get (GL.linkStatus shaderProg)
   unless linked $ do
     GL.get (GL.programInfoLog shaderProg) >>= putStrLn
-  
+
   GL.lineSmooth $= GL.Enabled
   GL.textureFunction $= GL.Combine
   GL.clearColor $= GL.Color4 1 1 1 1

@@ -4,6 +4,7 @@ {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ConstraintKinds #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Call.Util.Deck
@@ -17,12 +18,14 @@ -- The deck for a single stream
 --
 -----------------------------------------------------------------------------
-module Call.Util.Deck (Deck(..), empty, source, pos, playing, playback) where
+module Call.Util.Deck (Deck(..), empty, source, pos, playing, playback, playbackOf) where
 import Control.Lens
-import Control.Monad.State.Class
+import Control.Monad.State.Strict
 import Call.Data.Wave
 import Call.Types
 import qualified Data.Vector.Storable as V
+import Control.Monad.Objective
+import Control.Elevator
 
 data Deck = Deck
   { _src :: Source Stereo
@@ -51,3 +54,6 @@       pos += dt
       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 i = \dt n -> i .- playback dt n

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts, ConstraintKinds #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Call.Util.Deck
@@ -16,17 +16,19 @@ import qualified Data.Vector.Storable as V
 import qualified Data.Vector.Storable.Mutable as MV
 import Control.Monad.ST
-import Control.Monad.State.Class
+import Control.Monad.State.Strict
 import Call.Types
 import Call.Data.Wave
 import Control.Monad
+import Control.Monad.Objective
+import Control.Elevator
 
 data Sampler = Sampler [(Sample Stereo, Time)]
 
 empty :: Sampler
 empty = Sampler []
 
-playback :: MonadState Sampler m => Time -> Int -> m (V.Vector Stereo) 
+playback :: MonadState Sampler m => Time -> Int -> m (V.Vector Stereo)
 playback dt n = do
   Sampler vs <- get
   let (vs'', r) = runST $ do
@@ -46,4 +48,7 @@     f = dt / fromIntegral n
 
 play :: MonadState Sampler m => Sample Stereo -> m ()
-play s = modify $ \(Sampler xs) -> Sampler $ (s, 0) : xs+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 i = \dt n -> i .- playback dt n