module Csound.Typed.Render(
renderOut, renderOutBy,
renderEff, renderEffBy,
renderOut_, renderOutBy_,
module Csound.Typed.GlobalState.Options,
module Csound.Dynamic.Types.Flags
) where
import qualified Data.Map as M
import Data.Default
import Data.Maybe
import Data.Tuple
import Data.Monoid
import Data.Ord
import Data.List(sortBy, groupBy)
import qualified Data.IntMap as IM
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Text.PrettyPrint.Leijen(displayS, renderPretty)
import Csound.Dynamic hiding (csdFlags)
import Csound.Typed.Types
import Csound.Typed.GlobalState
import Csound.Typed.GlobalState.Elements(NamedInstrs(..))
import Csound.Typed.GlobalState.Options
import Csound.Typed.Control.Instr
import Csound.Typed.Control(getIns)
import Csound.Dynamic.Types.Flags
import Csound.Typed.Gui.Gui(guiStmt, panelIsKeybdSensitive)
import Csound.Typed.Gui.Cabbage.CabbageLang(ppCabbage)
toCsd :: Tuple a => Maybe Int -> Options -> SE a -> GE Csd
toCsd mnchnls_i options sigs = do
saveMasterInstr (constArity sigs) (masterExp sigs)
saveMidiMap
handleMissingKeyPannel
renderHistory mnchnls_i (outArity sigs) options
handleMissingKeyPannel :: GE ()
handleMissingKeyPannel = do
st <- fmap guis $ getHistory
if (not $ IM.null $ guiKeyEvents st) && (null $ filter panelIsKeybdSensitive $ guiStateRoots st)
then do
saveDefKeybdPanel
else do
return ()
renderOut_ :: SE () -> IO String
renderOut_ = renderOutBy_ def
renderOutBy_ :: Options -> SE () -> IO String
renderOutBy_ options sigs = evalGE options $ fmap renderCsd $ toCsd Nothing options (fmap (const unit) sigs)
renderOut :: Sigs a => SE a -> IO String
renderOut = renderOutBy def
renderOutBy :: Sigs a => Options -> SE a -> IO String
renderOutBy options sigs = evalGE options $ fmap renderCsd $ toCsd Nothing options sigs
renderEff :: (Sigs a, Sigs b) => (a -> SE b) -> IO String
renderEff = renderEffBy def
renderEffBy :: (Sigs a, Sigs b) => Options -> (a -> SE b) -> IO String
renderEffBy options eff = evalGE options $ fmap renderCsd $ toCsd (Just (arityIns $ funArity eff)) options (eff =<< getIns)
renderHistory :: Maybe Int -> Int -> Options -> GE Csd
renderHistory mnchnls_i nchnls opt = do
keyEventListener <- getKeyEventListener
hist1 <- getHistory
udos <- fmap verbatim $ liftIO $ renderUdoPlugins hist1
instr0 <- execDepT $ getInstr0 mnchnls_i nchnls opt udos hist1
terminatorInstrId <- saveInstr =<< terminatorInstr
expr2 <- getSysExpr terminatorInstrId
saveAlwaysOnInstr =<< saveInstr (SE expr2)
expr3 <- guiInstrExp
saveAlwaysOnInstr =<< saveInstr (SE expr3)
hist2 <- getHistory
let namedIntruments = fmap (\(name, body) -> Instr (InstrLabel name) body) $ unNamedInstrs $ namedInstrs hist2
let orc = Orc instr0 ((namedIntruments ++ ) $ maybeAppend keyEventListener $ fmap (uncurry Instr) $ instrsContent $ instrs hist2)
hist3 <- getHistory
let flags = reactOnMidi hist3 $ csdFlags opt
sco = Sco (Just $ pureGetTotalDurForF0 $ totalDur hist3)
(renderGens (genMap hist3) (writeGenMap hist3)) $
((fmap alwaysOn $ alwaysOnInstrs hist3) ++ (getNoteEvents $ notes hist3))
let plugins = getPlugins opt hist3
return $ Csd flags orc sco plugins
where
renderGens gens writeGens = (fmap swap $ M.toList $ idMapContent gens) ++ writeGens
maybeAppend ma = maybe id (:) ma
getNoteEvents = fmap $ \(instrId, evt) -> (instrId, [evt])
getPlugins opt hist = case cabbageGui hist of
Nothing -> []
Just x -> [(Plugin "Cabbage" (displayS (renderPretty 1 10000 $ ppCabbage x) ""))]
getInstr0 :: Maybe Int -> Int -> Options -> Dep () -> History -> Dep ()
getInstr0 mnchnls_i nchnls opt udos hist = do
macroses
defaultScaleUI <- fmap defScaleUI $ lift getOptions
globalConstants
midiAssigns
midiInitCtrls
initGlobals
renderBandLimited (genMap hist) (bandLimitedMap hist)
userInstr0 hist
chnUpdateUdo
udos
sf2
jackos
guiStmt defaultScaleUI $ getPanels hist
where
globalConstants = do
setSr $ defSampleRate opt
setKsmps $ defBlockSize opt
setNchnls (max 1 nchnls)
setZeroDbfs 1
maybe (return ()) setNchnls_i mnchnls_i
midiAssigns = mapM_ renderMidiAssign $ midis hist
midiInitCtrls = mapM_ renderMidiCtrl $ midiCtrls hist
initGlobals = fst $ renderGlobals $ globals $ hist
sf2 = mapM_ (uncurry sfSetList) $ sfGroup $ sfTable hist
sfGroup = fmap phi . groupBy (\a b -> getName a == getName b) . sortBy (comparing getName)
where
getName = sfName . fst
phi as = (getName $ head as, fmap (\(sf, index) -> (sfBank sf, sfProgram sf, index)) as)
macroses = forM_ (fmap snd $ M.toList $ macrosInits hist) $ \x -> case x of
MacrosInitDouble name value -> initMacrosDouble name value
MacrosInitString name value -> initMacrosString name value
MacrosInitInt name value -> initMacrosInt name value
jackos = maybe (return ()) (verbatim . renderJacko) $ csdJacko opt
reactOnMidi :: History -> Flags -> Flags
reactOnMidi h flags
| midiIsActive h && midiDeviceIsEmpty flags = setMidiDevice flags
| otherwise = flags
where
midiIsActive = not . null . midis
midiDeviceIsEmpty = isNothing . midiDevice . midiRT
setMidiDevice x = x { midiRT = (midiRT x) { midiDevice = Just "a" } }