hsc3-cairo (empty) → 0.13

raw patch · 4 files changed

+183/−0 lines, 4 filesdep +basedep +cairodep +gtksetup-changed

Dependencies added: base, cairo, gtk, hcg-minus, hosc, hsc3, split

Files

README +14/−0
Setup.hs +3/−0
Sound/SC3/Cairo/Scope/Shell.hs +135/−0
hsc3-cairo.cabal +31/−0

+ README view

@@ -0,0 +1,14 @@+hsc3-cairo+----------++[haskell][hs] [supercollider][sc3] ([hsc3][hsc3]) [cairo][cairo] drawing++[hsc3]: http://rd.slavepianos.org/rd/?t=hsc3+[hs]: http://haskell.org/+[sc3]: http://audiosynth.com/+[cairo]: http://cairographics.org/++© [rohan drape][rd], 2012, [gpl]++[rd]: http://rd.slavepianos.org/+[gpl]: http://gnu.org/copyleft/

+ Setup.hs view

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain

+ Sound/SC3/Cairo/Scope/Shell.hs view

@@ -0,0 +1,135 @@+-- | Shell+module Sound.SC3.Cairo.Scope.Shell where++import Data.CG.Minus {- hcg-minus -}+import Data.IORef+import Data.List+import Data.List.Split {- split -}+import qualified Graphics.Rendering.Cairo as C {- cairo -}+import qualified Graphics.UI.Gtk as G {- gtk -}+import qualified Graphics.UI.Gtk.Gdk.Events as E+import Sound.OSC.FD {- hosc -}+import Sound.SC3.FD {- hsc3 -}++-- * Types++type Render_F st = Shell st -> st -> C.Render st+type Interact_F st = UDP -> Shell st -> st -> IO st+type Bracket_F st = (Interact_F st,Interact_F st)+type SC3_F st = Interact_F st+type Key_F st = Char -> st -> st+data Shell st = Shell {sh_gr :: Int -- ^ Group (protected)+                      ,sh_nc :: Int -- ^ Number of channels+                      ,sh_nf :: Int -- ^ Number of frames+                      ,sh_b :: Int -- ^ Buffer ID+                      ,sh_ix :: Int -- ^ Bus index+                      ,sh_data :: [[R]] -- ^ Signal data+                      ,sh_bracket :: Bracket_F st+                      ,sh_sc3 :: SC3_F st+                      ,sh_render :: Render_F st+                      ,sh_key :: Key_F st+                      ,sh_delay :: Int -- ^ Frame delay in ms+                      }++sh_bracket_nil :: Bracket_F st+sh_bracket_nil =+    let no_op _ _ st = return st+    in (no_op,no_op)++sh_sc3_nil :: SC3_F st+sh_sc3_nil _ _ st = return st++sh_monitor_bus :: Transport t => Shell st -> t -> IO ()+sh_monitor_bus sh fd = do+  let b = fromIntegral (sh_b sh)+      ix = fromIntegral (sh_ix sh)+      i = in' (sh_nc sh) AR ix+      r = recordBuf AR b 0 1 0 1 Loop 1 DoNothing i+      s = synthdef "sh_monitor_bus" r+  _ <- async fd (d_recv s)+  _ <- async fd (b_alloc (sh_b sh) (sh_nf sh) (sh_nc sh))+  send fd (g_new [(sh_gr sh,AddToTail,0)])+  send fd (s_new "sh_monitor_bus" (-1) AddToTail (sh_gr sh) [])++deinterleave :: Int -> [a] -> [[a]]+deinterleave nc l =+    case nc of+      1 -> [l]+      _ -> transpose (chunksOf nc l)++sh_std_sc3 :: Transport t => Shell st -> t -> IO (Shell st)+sh_std_sc3 sh fd = do+  let b = sh_b sh+      nf = sh_nf sh+      nc = sh_nc sh+  send fd (b_getn b [(0,nf * nc)])+  r <- waitDatum fd "/b_setn"+  let d = case r of+            _:Int 0:Int _:xs -> map datum_real_err xs+            _ -> []+  return (sh {sh_data = deinterleave nc d})++sh_on_close :: UDP -> Shell b -> b -> IO b+sh_on_close fd sh st = do+  let (_,c_f) = sh_bracket sh+  send fd (n_free [3])+  c_f fd sh st++sh_keypress_f :: G.WidgetClass w =>+                 w -> IORef st -> UDP -> Shell st -> E.Event -> IO Bool+sh_keypress_f w r fd sh e = do+  let kv = E.eventKeyVal e+      nm = E.eventKeyName e+  case nm of+    "Escape" -> do st <- readIORef r+                   _ <- sh_on_close fd sh st+                   G.widgetDestroy w+    _ -> case G.keyToChar kv of+           Just c -> modifyIORef r (sh_key sh c)+           _ -> return ()+  return True++sh_update_f :: G.WidgetClass w =>+               w -> C.Surface -> IORef st -> UDP -> Shell st -> IO Bool+sh_update_f c s r fd sh = do+  w <- G.widgetGetDrawWindow c+  bd <- readIORef r+  sh' <- sh_std_sc3 sh fd+  bd' <- sh_sc3 sh' fd sh' bd >>= C.renderWith s . sh_render sh' sh'+  C.surfaceFlush s+  _ <- G.renderWithDrawable w (C.setSourceSurface s 0 0 >> C.paint)+  writeIORef r bd'+  return True++sc3_fd :: IO UDP+sc3_fd = openUDP "127.0.0.1" 57110++shell :: Shell st -> st -> IO ()+shell sh i_st = do+  let n = sh_nf sh+      n' = fromIntegral n+      (i_f,_) = sh_bracket sh+  fd <- sc3_fd+  st <- i_f fd sh i_st+  sh_monitor_bus sh fd+  r <- newIORef st+  s <- C.createImageSurface C.FormatARGB32 n n+  C.renderWith s (do C.rectangle 0 0 n' n'+                     C.setSourceRGBA 0 0 0 1+                     C.fill)+  _ <- G.initGUI+  w <- G.windowNew+  c <- G.drawingAreaNew+  G.windowSetResizable w False+  G.widgetSetSizeRequest w n n+  _ <- G.onKeyPress w (sh_keypress_f w r fd sh)+  _ <- G.onDestroy w G.mainQuit+  _ <- G.onExpose c (const (sh_update_f c s r fd sh))+  _ <- G.timeoutAdd (G.widgetQueueDraw w >> return True) (sh_delay sh)+  G.set w [G.containerChild G.:= c]+  G.widgetShowAll w+  G.mainGUI++sh_default :: Int -> Render_F st -> Key_F st -> Shell st+sh_default nc r k = Shell 3 nc 512 10 0 [] sh_bracket_nil sh_sc3_nil r k 15+

+ hsc3-cairo.cabal view

@@ -0,0 +1,31 @@+Name:              hsc3-cairo+Version:           0.13+Synopsis:          haskell supercollider cairo drawing+Description:       haskell supercollider cairo drawing+License:           GPL+Category:          Sound+Copyright:         (c) Rohan Drape, 2012+Author:            Rohan Drape+Maintainer:        rd@slavepianos.org+Stability:         Experimental+Homepage:          http://rd.slavepianos.org/?t=hsc3-cairo+Tested-With:       GHC == 7.6.1+Build-Type:        Simple+Cabal-Version:     >= 1.8++Data-files:        README++Library+  Build-Depends:   base == 4.*,+                   cairo,+                   gtk,+                   hcg-minus,+                   hosc == 0.13.*,+                   hsc3 == 0.13.*,+                   split+  GHC-Options:     -Wall -fwarn-tabs+  Exposed-modules: Sound.SC3.Cairo.Scope.Shell++Source-Repository  head+  Type:            darcs+  Location:        http://rd.slavepianos.org/sw/hsc3-cairo