tidal-0.1: Proxy303.lhs

> module Proxy303 where

> import Control.Concurrent
> import Sound.OpenSoundControl
> import Sound.OpenSoundControl.Transport.UDP
> import Data.List
> import Data.Maybe
> import Data.Char

> import qualified Data.ByteString.Lazy as B

> start portDSSI = do serv <- udpServer "127.0.0.1" 0
>                     localPort <- udpPort serv
>                     -- hack to get the integer port number out
>                     let localPortI = fromIntegral $ read $ show localPort
>                     client <- openUDP "127.0.0.1" portDSSI
>                     forkIO $ loop serv client
>                     return localPortI

> neko = "/dssi/nekobee/nekobee/chan00/"

> names :: [String]
> names = ["note", "duration", "saw", "tuning",
>          "cutoff", "resonance", "envmod", "decay", "accent",
>          "velocity", "volume"]

> loop :: UDP -> UDP -> IO ()
> loop serv client = 
>     do (Message path params) <- recv serv
>        runMessage client (zip names params)
>        loop serv client

> controls = ["saw", "tuning", "cutoff", "resonance", "envmod",
>             "decay", "accent", "volume"]

> runMessage serv p = do sendNote serv (lI "note") (floor $ (l "velocity") * 127) (l "duration")
>                        mapM_ (\x -> send serv $ message303 x (l x)) controls
>     where l name = (\(Float x) -> x) (fromJust $ lookup name p)
>           lI name = (\(Int x) -> x) (fromJust $ lookup name p)

> sendNote _ 0 _ _ = return ()
> sendNote serv n v d = do send serv $ noteon neko v n
>                          putStrLn $ "n: " ++ show n ++ " v: " ++ show v ++ " d: " ++ show d
>                          forkIO $ do threadDelay (floor $ 1000000.0 * d)
>                                      send serv $ noteoff neko n
>                                      return ()
>                          return ()

> midi :: String -> (Int, Int, Int, Int) -> OSC
> midi path (a, b, c, d) = 
>       Message (path ++ "midi") [Midi (fromIntegral a, fromIntegral b,
>                                       fromIntegral c, fromIntegral d
>                                      )
>                                ]

> noteon :: String -> Int -> Int -> OSC
> noteon path v i = midi path (0, 144, i, v)

> noteoff :: String -> Int -> OSC
> noteoff path i = midi path (0, 128, i, 0)

> control :: String -> Int -> Double -> OSC
> control path n value = Message (path ++ "control") [Int n, Float value]

> saw False = control neko 1 0
> saw True = control neko 1 1
> nSaw = saw . (>= 0.5)

> square = saw . not
> tuning = control neko 2
> cutoff = control neko 3
> resonance = control neko 4
> envMod = control neko 5
> decay value = control neko 6 ((1 - value) * 0.0005)
> accent = control neko 7
> volume = control neko 8

> message303 :: String -> Double -> OSC
> message303 "saw" = saw . (>= 0.5)
> message303 "tuning" = tuning . (+ 0.5) . (* 1.5)
> message303 "cutoff" = cutoff . (* 40.0)
> message303 "resonance" = resonance
> message303 "envmod" = envMod
> message303 "decay" = decay
> message303 "accent" = accent
> message303 "volume" = control neko 8
> message303 "note" = (noteon neko 64) . floor
> message303 "noteoff" = noteoff neko . floor
> message303 _ = error "Not a 303 parameter"