module Csound.IO (
RenderCsd(..),
renderCsd,
writeCsd, writeCsdBy,
writeSnd, writeSndBy,
playCsd, playCsdBy,
mplayer, mplayerBy, totem, totemBy,
dac, dacBy, vdac, vdacBy,
csd, csdBy,
runCabbage, runCabbageBy,
onCard1, onCard2, onCard4, onCard6, onCard8,
readMacrosString, readMacrosDouble, readMacrosInt
) where
import System.Process
import qualified Control.Exception as E
import Control.Monad
import Data.Monoid
import Data.Default
import Csound.Typed
import Csound.Control.Gui
import Csound.Options(setSilent, setDac, setCabbage)
render :: Sigs a => Options -> SE a -> IO String
render = renderOutBy
render_ :: Options -> SE () -> IO String
render_ = renderOutBy_
class RenderCsd a where
renderCsdBy :: Options -> a -> IO String
instance RenderCsd (SE ()) where
renderCsdBy = render_
instance RenderCsd Sig where
renderCsdBy opt a = render opt (return a)
instance RenderCsd Sig2 where
renderCsdBy opt a = render opt (return a)
instance RenderCsd Sig4 where
renderCsdBy opt a = render opt (return a)
instance RenderCsd (Sig2, Sig2) where
renderCsdBy opt a = render opt (return a)
instance RenderCsd Sig6 where
renderCsdBy opt a = render opt (return a)
instance RenderCsd (Sig2, Sig2, Sig2) where
renderCsdBy opt a = render opt (return a)
instance RenderCsd Sig8 where
renderCsdBy opt a = render opt (return a)
instance RenderCsd (Sig2, Sig2, Sig2, Sig2) where
renderCsdBy opt a = render opt (return a)
instance RenderCsd (Sig8, Sig8) where
renderCsdBy opt a = render opt (return a)
instance RenderCsd (Sig8, Sig8, Sig8, Sig8) where
renderCsdBy opt a = render opt (return a)
instance RenderCsd (SE Sig) where
renderCsdBy opt a = render opt a
instance RenderCsd (SE Sig2) where
renderCsdBy opt a = render opt a
instance RenderCsd (SE Sig4) where
renderCsdBy opt a = render opt a
instance RenderCsd (SE (Sig2, Sig2)) where
renderCsdBy opt a = render opt a
instance RenderCsd (SE Sig6) where
renderCsdBy opt a = render opt a
instance RenderCsd (SE (Sig2, Sig2, Sig2)) where
renderCsdBy opt a = render opt a
instance RenderCsd (SE Sig8) where
renderCsdBy opt a = render opt a
instance RenderCsd (SE (Sig2, Sig2, Sig2, Sig2)) where
renderCsdBy opt a = render opt a
instance RenderCsd (SE (Sig8, Sig8)) where
renderCsdBy opt a = render opt a
instance RenderCsd (SE (Sig8, Sig8, Sig8, Sig8)) where
renderCsdBy opt a = render opt a
instance (Sigs a) => RenderCsd (a -> Sig) where
renderCsdBy opt f = renderEffBy opt (return . f)
instance (Sigs a) => RenderCsd (a -> Sig2) where
renderCsdBy opt f = renderEffBy opt (return . f)
instance (Sigs a) => RenderCsd (a -> Sig3) where
renderCsdBy opt f = renderEffBy opt (return . f)
instance (Sigs a) => RenderCsd (a -> Sig4) where
renderCsdBy opt f = renderEffBy opt (return . f)
instance (Sigs a) => RenderCsd (a -> (Sig2, Sig2)) where
renderCsdBy opt f = renderEffBy opt (return . f)
instance (Sigs a) => RenderCsd (a -> Sig6) where
renderCsdBy opt f = renderEffBy opt (return . f)
instance (Sigs a) => RenderCsd (a -> (Sig2, Sig2, Sig2)) where
renderCsdBy opt f = renderEffBy opt (return . f)
instance (Sigs a) => RenderCsd (a -> Sig8) where
renderCsdBy opt f = renderEffBy opt (return . f)
instance (Sigs a) => RenderCsd (a -> (Sig2, Sig2, Sig2, Sig2)) where
renderCsdBy opt f = renderEffBy opt (return . f)
instance (Sigs a) => RenderCsd (a -> (Sig8, Sig8)) where
renderCsdBy opt f = renderEffBy opt (return . f)
instance (Sigs a) => RenderCsd (a -> (Sig8, Sig8, Sig8, Sig8)) where
renderCsdBy opt f = renderEffBy opt (return . f)
instance (Sigs a) => RenderCsd (a -> SE Sig) where
renderCsdBy opt f = renderEffBy opt f
instance (Sigs a) => RenderCsd (a -> SE Sig2) where
renderCsdBy opt f = renderEffBy opt f
instance (Sigs a) => RenderCsd (a -> SE Sig3) where
renderCsdBy opt f = renderEffBy opt f
instance (Sigs a) => RenderCsd (a -> SE Sig4) where
renderCsdBy opt f = renderEffBy opt f
instance (Sigs a) => RenderCsd (a -> SE Sig5) where
renderCsdBy opt f = renderEffBy opt f
instance (Sigs a) => RenderCsd (a -> SE Sig6) where
renderCsdBy opt f = renderEffBy opt f
instance (Sigs a) => RenderCsd (a -> SE (Sig2, Sig2)) where
renderCsdBy opt f = renderEffBy opt f
instance (Sigs a) => RenderCsd (a -> SE (Sig2, Sig2, Sig2)) where
renderCsdBy opt f = renderEffBy opt f
instance (Sigs a) => RenderCsd (a -> SE Sig8) where
renderCsdBy opt f = renderEffBy opt f
instance (Sigs a) => RenderCsd (a -> SE (Sig2, Sig2, Sig2, Sig2)) where
renderCsdBy opt f = renderEffBy opt f
instance (Sigs a) => RenderCsd (a -> SE (Sig8, Sig8)) where
renderCsdBy opt f = renderEffBy opt f
instance (Sigs a) => RenderCsd (a -> SE (Sig8, Sig8, Sig8, Sig8)) where
renderCsdBy opt f = renderEffBy opt f
instance (Sigs a) => RenderCsd (a -> Source Sig) where
renderCsdBy opt f = renderEffBy opt (fromSource . f)
instance (Sigs a) => RenderCsd (a -> Source Sig2) where
renderCsdBy opt f = renderEffBy opt (fromSource . f)
instance (Sigs a) => RenderCsd (a -> Source Sig3) where
renderCsdBy opt f = renderEffBy opt (fromSource . f)
instance (Sigs a) => RenderCsd (a -> Source Sig4) where
renderCsdBy opt f = renderEffBy opt (fromSource . f)
instance (Sigs a) => RenderCsd (a -> Source (Sig2, Sig2)) where
renderCsdBy opt f = renderEffBy opt (fromSource . f)
instance (Sigs a) => RenderCsd (a -> Source Sig6) where
renderCsdBy opt f = renderEffBy opt (fromSource . f)
instance (Sigs a) => RenderCsd (a -> Source (Sig2, Sig2, Sig2)) where
renderCsdBy opt f = renderEffBy opt (fromSource . f)
instance (Sigs a) => RenderCsd (a -> Source Sig8) where
renderCsdBy opt f = renderEffBy opt (fromSource . f)
instance (Sigs a) => RenderCsd (a -> Source (Sig2, Sig2, Sig2, Sig2)) where
renderCsdBy opt f = renderEffBy opt (fromSource . f)
instance (Sigs a) => RenderCsd (a -> Source (Sig8, Sig8)) where
renderCsdBy opt f = renderEffBy opt (fromSource . f)
instance (Sigs a) => RenderCsd (a -> Source (Sig8, Sig8, Sig8, Sig8)) where
renderCsdBy opt f = renderEffBy opt (fromSource . f)
instance (Sigs a) => RenderCsd (a -> Source (SE Sig)) where
renderCsdBy opt f = renderEffBy opt (fromSourceSE . f)
instance (Sigs a) => RenderCsd (a -> Source (SE Sig2)) where
renderCsdBy opt f = renderEffBy opt (fromSourceSE . f)
instance (Sigs a) => RenderCsd (a -> Source (SE Sig3)) where
renderCsdBy opt f = renderEffBy opt (fromSourceSE . f)
instance (Sigs a) => RenderCsd (a -> Source (SE Sig4)) where
renderCsdBy opt f = renderEffBy opt (fromSourceSE . f)
instance (Sigs a) => RenderCsd (a -> Source (SE Sig5)) where
renderCsdBy opt f = renderEffBy opt (fromSourceSE . f)
instance (Sigs a) => RenderCsd (a -> Source (SE Sig6)) where
renderCsdBy opt f = renderEffBy opt (fromSourceSE . f)
instance (Sigs a) => RenderCsd (a -> Source (SE (Sig2, Sig2))) where
renderCsdBy opt f = renderEffBy opt (fromSourceSE . f)
instance (Sigs a) => RenderCsd (a -> Source (SE (Sig2, Sig2, Sig2))) where
renderCsdBy opt f = renderEffBy opt (fromSourceSE . f)
instance (Sigs a) => RenderCsd (a -> Source (SE Sig8)) where
renderCsdBy opt f = renderEffBy opt (fromSourceSE . f)
instance (Sigs a) => RenderCsd (a -> Source (SE (Sig2, Sig2, Sig2, Sig2))) where
renderCsdBy opt f = renderEffBy opt (fromSourceSE . f)
instance (Sigs a) => RenderCsd (a -> Source (SE (Sig8, Sig8))) where
renderCsdBy opt f = renderEffBy opt (fromSourceSE . f)
instance (Sigs a) => RenderCsd (a -> Source (SE (Sig8, Sig8, Sig8, Sig8))) where
renderCsdBy opt f = renderEffBy opt (fromSourceSE . f)
instance RenderCsd (Source Sig) where
renderCsdBy opt a = renderCsdBy opt (fromSource a)
instance RenderCsd (Source Sig2) where
renderCsdBy opt a = renderCsdBy opt (fromSource a)
instance RenderCsd (Source Sig4) where
renderCsdBy opt a = renderCsdBy opt (fromSource a)
instance RenderCsd (Source (Sig2, Sig2)) where
renderCsdBy opt a = renderCsdBy opt $ mapSource (\((a1, a2), (b1, b2)) -> (a1, a2, b1, b2)) a
instance RenderCsd (Source Sig6) where
renderCsdBy opt a = renderCsdBy opt (fromSource a)
instance RenderCsd (Source (Sig2, Sig2, Sig2)) where
renderCsdBy opt a = renderCsdBy opt $ mapSource (\((a1, a2), (b1, b2), (c1, c2)) -> (a1, a2, b1, b2, c1, c2)) a
instance RenderCsd (Source Sig8) where
renderCsdBy opt a = renderCsdBy opt (fromSource a)
instance RenderCsd (Source (Sig2, Sig2, Sig2, Sig2)) where
renderCsdBy opt a = renderCsdBy opt $ mapSource (\((a1, a2), (b1, b2), (c1, c2), (d1, d2)) -> (a1, a2, b1, b2, c1, c2, d1, d2)) a
instance RenderCsd (Source (SE Sig)) where
renderCsdBy opt a = renderCsdBy opt (fromSourceSE a)
instance RenderCsd (Source (SE Sig2)) where
renderCsdBy opt a = renderCsdBy opt (fromSourceSE a)
instance RenderCsd (Source (SE Sig4)) where
renderCsdBy opt a = renderCsdBy opt (fromSourceSE a)
instance RenderCsd (Source (SE (Sig2, Sig2))) where
renderCsdBy opt a = renderCsdBy opt $ mapSource (fmap $ \((a1, a2), (b1, b2)) -> (a1, a2, b1, b2)) a
instance RenderCsd (Source (SE Sig6)) where
renderCsdBy opt a = renderCsdBy opt (fromSourceSE a)
instance RenderCsd (Source (SE (Sig2, Sig2, Sig2))) where
renderCsdBy opt a = renderCsdBy opt $ mapSource (fmap $ \((a1, a2), (b1, b2), (c1, c2)) -> (a1, a2, b1, b2, c1, c2)) a
instance RenderCsd (Source (SE Sig8)) where
renderCsdBy opt a = renderCsdBy opt (fromSourceSE a)
instance RenderCsd (Source (SE (Sig2, Sig2, Sig2, Sig2))) where
renderCsdBy opt a = renderCsdBy opt $ mapSource (fmap $ \((a1, a2), (b1, b2), (c1, c2), (d1, d2)) -> (a1, a2, b1, b2, c1, c2, d1, d2)) a
instance RenderCsd (Source ()) where
renderCsdBy opt src = renderCsdBy opt $ do
(ui, _) <- src
panel ui
instance RenderCsd (Source (SE ())) where
renderCsdBy opt src = renderCsdBy opt (joinSource src)
renderCsd :: RenderCsd a => a -> IO String
renderCsd = renderCsdBy def
writeCsd :: RenderCsd a => String -> a -> IO ()
writeCsd file a = writeFile file =<< renderCsd a
writeCsdBy :: RenderCsd a => Options -> String -> a -> IO ()
writeCsdBy opt file a = writeFile file =<< renderCsdBy opt a
writeSnd :: RenderCsd a => String -> a -> IO ()
writeSnd = writeSndBy def
writeSndBy :: RenderCsd a => Options -> String -> a -> IO ()
writeSndBy opt file a = do
writeCsdBy opt fileCsd a
runWithUserInterrupt $ "csound -o " ++ file ++ " " ++ fileCsd
where fileCsd = "tmp.csd"
playCsd :: (RenderCsd a) => (String -> IO ()) -> String -> a -> IO ()
playCsd = playCsdBy def
playCsdBy :: (RenderCsd a) => Options -> (String -> IO ()) -> String -> a -> IO ()
playCsdBy opt player file a = do
writeCsdBy opt fileCsd a
runWithUserInterrupt $ "csound -o " ++ fileWav ++ " " ++ fileCsd
player fileWav
return ()
where fileCsd = file ++ ".csd"
fileWav = file ++ ".wav"
simplePlayCsdBy :: (RenderCsd a) => Options -> String -> String -> a -> IO ()
simplePlayCsdBy opt player = playCsdBy opt phi
where phi file = do
runWithUserInterrupt $ player ++ " " ++ file
dac :: (RenderCsd a) => a -> IO ()
dac = dacBy def
dacBy :: (RenderCsd a) => Options -> a -> IO ()
dacBy opt' a = do
writeCsdBy opt "tmp.csd" a
runWithUserInterrupt $ "csound " ++ "tmp.csd"
where opt = opt' <> setDac
vdac :: (RenderCsd a) => a -> IO ()
vdac = dacBy (setVirtual def)
vdacBy :: (RenderCsd a) => Options -> a -> IO ()
vdacBy opt = dacBy (setVirtual opt)
setVirtual :: Options -> Options
setVirtual a = a { csdFlags = (csdFlags a) { rtmidi = Just VirtualMidi, midiRT = m { midiDevice = Just "0" } } }
where m = midiRT $ csdFlags a
csd :: (RenderCsd a) => a -> IO ()
csd = csdBy setSilent
csdBy :: (RenderCsd a) => Options -> a -> IO ()
csdBy options a = do
writeCsdBy (setSilent <> options) "tmp.csd" a
runWithUserInterrupt $ "csound tmp.csd"
mplayer :: (RenderCsd a) => a -> IO ()
mplayer = mplayerBy def
mplayerBy :: (RenderCsd a) => Options -> a -> IO ()
mplayerBy opt = simplePlayCsdBy opt "mplayer" "tmp"
totem :: (RenderCsd a) => a -> IO ()
totem = totemBy def
totemBy :: (RenderCsd a) => Options -> a -> IO ()
totemBy opt = simplePlayCsdBy opt "totem" "tmp"
runWithUserInterrupt :: String -> IO ()
runWithUserInterrupt cmd = do
pid <- runCommand cmd
E.catch (waitForProcess pid >> return ()) (onUserInterrupt pid)
where
onUserInterrupt :: ProcessHandle -> E.AsyncException -> IO ()
onUserInterrupt pid x = case x of
E.UserInterrupt -> terminateProcess pid >> E.throw x
e -> E.throw e
runCabbage :: (RenderCsd a) => a -> IO ()
runCabbage = runCabbageBy def
runCabbageBy :: (RenderCsd a) => Options -> a -> IO ()
runCabbageBy opt' a = do
writeCsdBy opt "tmp.csd" a
runWithUserInterrupt $ "Cabbage " ++ "tmp.csd"
where opt = opt' <> setCabbage
onCard1 :: (Sig -> a) -> (Sig -> a)
onCard1= id
onCard2 :: (Sig2 -> a) -> (Sig2 -> a)
onCard2= id
onCard4 :: (Sig4 -> a) -> (Sig4 -> a)
onCard4= id
onCard6 :: (Sig6 -> a) -> (Sig6 -> a)
onCard6= id
onCard8 :: (Sig8 -> a) -> (Sig8 -> a)
onCard8= id