Timing.hs

{-
Rohan Drape: Haskell-Cafe, 2006-11-08
-}
import qualified Sound.SC3.Server.PlayEasy as Play
import Sound.SC3
          (UGen, out, s_new, n_run, n_free,
           Rate(AR,KR), sinOsc, envGen, envPerc',
           Envelope_Curve(EnvNum), DoneAction(RemoveSynth),
           AddAction(AddToTail), )

import qualified Sound.OSC.Time as Time
import qualified Sound.OSC.Type as OSC
import Sound.OSC.Type (Time, )
import Sound.OSC.Time (pauseThread, pauseThreadUntil, )
import Sound.OSC.Transport.FD.UDP (UDP)

import Control.Concurrent (forkIO, )
import Control.Monad.IO.Class (liftIO, )
import Control.Monad.Trans.Reader (ReaderT, )


-- * from old Rhs.Schedule module
{-
http://slavepianos.org/rd/sw/sw-76
Build-Depends: Rhs >=0.1 && <0.2
-}
type Interval = Time
type Action = Time -> IO (Maybe Interval)

-- | Apply action at indicated time and reschedule after interval.
at :: Time -> Action -> IO ()
at t f = pauseThreadUntil t >> f t >>= resched t f

-- | Rescheduler
resched :: Interval -> Action -> (Maybe Interval) -> IO ()
resched _ _ Nothing = return ()
resched t f (Just i) = at (t+i) f


-- * custom code

ping :: UGen -> UGen -> UGen
ping f a = out 0 (sinOsc AR f 0 * e)
     where c = EnvNum (-4.0)
           e = envGen KR 1 a 0 1 RemoveSynth (envPerc' 0.1 0.6 1 (c,c))

latency :: Time
latency = 0.05

bundle :: Time -> [OSC.Message] -> OSC.Bundle
bundle t m = OSC.bundle (t + latency) m

scPutStrLn :: String -> ReaderT UDP IO ()
scPutStrLn = liftIO . putStrLn

pinger :: IO ()
pinger =
   let f t = Play.withSC3 $
                do Play.send (bundle t [s_new "ping" 42 AddToTail 1 []])
--                   Play.send (n_run (-1) True)
                   Play.send (bundle (t+0.1) [n_run [(42, False)], n_free [42]])
--                   Play.send (bundle (t+0.1) [])
--                   Play.send (n_free [101])
--                   Play.send (bundle (t+0.1) [s_new "pong" 5 AddToTail 1 []])
                   scPutStrLn "Sending ping"
                   return (Just 1.0)
   in  do now <- Time.time
          at (fromInteger (ceiling now)) f

main :: IO ()
main =
   Play.withSC3 $
       do scPutStrLn "Sending Ping Instrument"
          _ <- Play.sync (Play.d_recv_synthdef "ping" (ping 880 0.1))
--          sync (d_recv_synthdef "pong" (ping 660 0.1))
          scPutStrLn "Resetting scsynth"
          Play.reset
          scPutStrLn "Starting schedule thread"
          _ <- liftIO $ forkIO pinger
          scPutStrLn "Delaying main thread"
          liftIO $ pauseThread (30::Time)
          scPutStrLn "End of delay, exiting"