hbeat (empty) → 0.1

raw patch · 4 files changed

+178/−0 lines, 4 filesdep +OpenGLdep +SDLdep +SDL-mixerbuild-type:Customsetup-changed

Dependencies added: OpenGL, SDL, SDL-mixer, base, containers, mtl, old-time

Files

• LICENSE +31/−0
• Main.hs +132/−0
• Setup.hs +2/−0
• hbeat.cabal +13/−0

@@ -0,0 +1,31 @@+Copyright (c) 2007, Tim Docker++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * The names of contributors may not be used to endorse or promote+      products derived from this software without specific prior+      written permission. ++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,132 @@+import qualified Graphics.Rendering.OpenGL as GL+import Graphics.Rendering.OpenGL( ($=) )+import qualified Graphics.UI.SDL as SDL+import System.Time+import System.Environment (getArgs)+import Control.Monad+import Control.Monad.State++import Model+import Render+import Sound++data Config = Config {+    c_samples :: [FilePath],+    c_steps :: Int+    } deriving (Read,Show)+    +data World = World {+    now :: IO Time,+    model :: Model,+    geom :: Geometry,+    sounds :: SoundState,+    pending_event :: (Time,[Action])+}++type GState a = StateT World IO a++main :: IO ()+main = do+    args <- getArgs+    config <- (liftM read.readFile) (args !! 0)  :: IO Config++    let m = defaultModel{+        m_channels=[0..length (c_samples config)-1],+        m_stepRange=c_steps config+        }+    let width = 50 * m_stepRange m+    let height = 50 * (length (m_channels m))++    SDL.init [SDL.InitEverything]+    sstate <- initSound (c_samples config)+    vinfo <- SDL.getVideoInfo+    SDL.glSetAttribute SDL.glRedSize 8+    SDL.glSetAttribute SDL.glGreenSize 8+    SDL.glSetAttribute SDL.glBlueSize 8+    SDL.glSetAttribute SDL.glDepthSize 16+    SDL.glSetAttribute SDL.glDoubleBuffer 1+    setVideoMode width height+    SDL.setCaption "hBeat" "hBeat"++    t0 <- getClockTime+    let clock = tnow t0+    t <- clock++    let ev = nextEvent t m+    let w = World clock m (geometry (GL.Size (fi width) (fi height)) m) sstate ev+    evalStateT mainLoop w+    endSound sstate+    SDL.quit++setVideoMode width height =+    SDL.setVideoMode width height 32 [SDL.OpenGL,SDL.Resizable]++mainLoop :: GState ()+mainLoop = do+    st <- get+    t <- liftIO $ now st+    processActions t+    ev <- liftIO $ SDL.delay 10 >> SDL.pollEvent+    finished <- case ev of+      (SDL.VideoResize w h) -> do+          modify (\st -> st{geom=geometry (GL.Size (fi w) (fi h)) (model st)})+          liftIO $ setVideoMode w h+          redraw+      (SDL.MouseButtonDown x y SDL.ButtonLeft) -> mouseClick t x y >> redraw+      (SDL.MouseButtonDown _ _ SDL.ButtonWheelUp) -> modifySpeed t (\v -> v+5)+      (SDL.MouseButtonDown _ _ SDL.ButtonWheelDown) -> modifySpeed t (\v -> if v > 50 then v-5 else v)+      SDL.VideoExpose -> redraw+      (SDL.KeyDown  SDL.Keysym{SDL.symKey=SDL.SDLK_ESCAPE}) -> return True+      SDL.Quit -> return True+      _ -> return False+    when (not finished) mainLoop+  where+    redraw :: GState Bool+    redraw = do+      st <- get+      liftIO $ display st True+      return False++    modifySpeed :: Time -> (Int->Int) -> GState Bool+    modifySpeed t adj = updateModel (updateStepTime t adj) >> return False++processActions :: Time -> GState ()+processActions t  = do+    st <- get+    let (ta,actions) = pending_event st+    when (t >= ta) $ do+        liftIO $ mapM_ (doAction st) actions+        let ev = nextEvent ta (model st)+        modify (\s -> s{pending_event=ev})+        processActions t+  where+    doAction st (Play c) = playSound (sounds st) c+    doAction st Repaint = display st False+    doAction st FlipBuffer = SDL.glSwapBuffers++mouseClick t x y = modify uf+  where+    uf st = st{model=click t (GL.Vertex2 (fi x) (fi y)) (geom st) (model st)}++updateModel mf = modify (\st -> st{model=mf (model st)})++display :: World -> Bool -> IO ()+display st swapBuffers = do+        t <- now st+        let sz@(GL.Size wWidth wHeight) = g_size (geom st)+        GL.viewport $= (GL.Position 0 0, sz)+        GL.matrixMode $= GL.Projection+        GL.loadIdentity+        GL.ortho2D 0 (fi wWidth) (fi wHeight) 0+        GL.clear [GL.ColorBuffer]+        GL.preservingMatrix $ do+            render (picture (geom st) t (model st))+        GL.flush+        when swapBuffers SDL.glSwapBuffers++tnow :: ClockTime -> IO Time+tnow t0 = do+    t <- getClockTime+    let td = t `diffClockTimes` t0+    return (fi (tdPicosec td `div` 1000000000) ++            ((tdHour td * 60 + tdMin td) * 60 + tdSec td) * 1000)

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,13 @@+Name: hbeat+Version: 0.1+License: BSD4+License-file: LICENSE+Copyright: Tim Docker, 2007+Author: Tim Docker+Build-Depends:  base, containers, old-time, OpenGL, SDL, SDL-mixer, mtl+Synopsis: A simple step sequencer GUI.+Description: A toy step sequencer program written using OpenGL and the SDL libraries. Configuration (including the audio samples used) is controlled via an external file.+Category: Sound+Executable: hbeat+Main-Is: Main.hs+Extra-Libraries: SDL, SDL_mixer