diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -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/ diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +import Distribution.Simple +main = defaultMain diff --git a/Sound/SC3/Cairo/Scope/Shell.hs b/Sound/SC3/Cairo/Scope/Shell.hs new file mode 100644 --- /dev/null +++ b/Sound/SC3/Cairo/Scope/Shell.hs @@ -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 + diff --git a/hsc3-cairo.cabal b/hsc3-cairo.cabal new file mode 100644 --- /dev/null +++ b/hsc3-cairo.cabal @@ -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