module Haskore.Interface.SuperCollider.Schedule (
T(..), SoundHandler, Time,
fromMelody, fromMusic, fromMusicGlobalEffect,
fromRhythmicMusicSoundEffects,
fromPerformance,
rhythmicMusic, rhythmicMusicWithAttributes,
installUGenMsg, installSoundMsg,
defaultChannel, atomPlayMsg,
fromMusicMsgs, eventToMark,
) where
import qualified Sound.SC3.Server.Command as SCCmd
import qualified Sound.SC3.Server.PlayEasy as SCPlay
import Sound.SC3.Server.Enum (AddAction(AddToTail, AddToHead))
import Sound.SC3.UGen.Type (UGen)
import qualified Sound.OSC.Type as OSC
import qualified Haskore.Interface.SuperCollider.Note as Note
import qualified Haskore.Interface.SuperCollider.Performance as SCPf
import qualified Haskore.Interface.SuperCollider.SoundMap as SoundMap
import Haskore.Interface.SuperCollider.SoundMap (Instrument, Sound)
import Haskore.Interface.SuperCollider.Channel (Channel, NumberChannels)
import qualified Haskore.Interface.SuperCollider.Channel as Channel
import qualified Haskore.Melody as Melody
import qualified Haskore.Music.Rhythmic as RhyMusic
import qualified Haskore.Music as Music
import qualified Haskore.Performance.BackEnd as PfBE
import qualified Haskore.RealTime.EventList.TimeBody as TimeList
import qualified Haskore.RealTime.EventList.TimeTime as TimeListPad
import qualified Haskore.General.IdGenerator as IdGen
import qualified Numeric.NonNegative.Wrapper as NonNeg
import Control.Monad (liftM2, )
import Data.Maybe(fromMaybe, maybeToList, )
data T =
Cons {
initial :: [OSC.Message]
,
body :: TimeList.T Time OSC.Message
}
deriving Show
type SoundAssign = (SoundMap.Name, UGen)
type SoundHandler note =
(Note.FromNote NonNeg.Double note, [SoundAssign])
type Time = NonNeg.Double
fromMusic :: Ord note =>
SoundHandler note ->
Music.T note ->
T
fromMusic (makeNote, soundAssigns) =
fromPerformance (installSoundsMsg defaultChannel soundAssigns) [] .
SCPf.fixNodeIds .
SCPf.fromMusic makeNote
fromMusicMsgs :: Ord note =>
(Note.FromNote NonNeg.Double note, [OSC.Message]) ->
Music.T note ->
T
fromMusicMsgs (makeNote, installSounds) =
fromPerformance installSounds [] .
SCPf.fixNodeIds .
SCPf.fromMusic makeNote
fromMusicGlobalEffect :: Ord note =>
SoundHandler note ->
(UGen -> UGen, NumberChannels) ->
Music.T note ->
T
fromMusicGlobalEffect
(makeNote, soundAssigns) (globalEffect, numChan) music =
let effectsName = "global effects"
instrumentChannel = defaultChannel+numChan
effectChannel = defaultChannel
(sid,pf) =
SCPf.fixNodeIds $
liftM2 (,)
IdGen.alloc
(SCPf.fromMusic makeNote music)
in fromPerformance
(installUGenMsg effectsName effectChannel
(globalEffect (Channel.readUGen numChan instrumentChannel)) :
installSoundsMsg instrumentChannel soundAssigns)
[SCCmd.s_new effectsName sid AddToTail SCPlay.homeId []]
pf
fromRhythmicMusicSoundEffects ::
(Ord drum, Ord instr) =>
SoundMap.ChannelMap instr drum ->
NumberChannels ->
RhyMusic.T instr drum ->
T
fromRhythmicMusicSoundEffects cMap numChan music =
let effectsName = "global effects"
instrumentChannel = defaultChannel+numChan
effectChannel = defaultChannel
(globalEffect, (drumCMap, instrCMap)) =
SoundMap.runChannelMap cMap instrumentChannel
(drumChannels, drumMap) = unzip drumCMap
(instrChannels,instrMap) = unzip instrCMap
(makeNote, soundAssigns) =
rhythmicMusicWithAttributes drumMap instrMap
soundChannelAssigns =
zipWith
(\chan (name,ugen) -> (name,chan,ugen))
(drumChannels++instrChannels) soundAssigns
(sid,pf) =
SCPf.fixNodeIds $
liftM2 (,)
IdGen.alloc
(SCPf.fromMusic makeNote music)
in fromPerformance
(installUGenMsg effectsName effectChannel globalEffect :
installChannelSoundsMsg soundChannelAssigns)
[SCCmd.s_new effectsName sid AddToTail SCPlay.homeId []]
pf
rhythmicMusic :: (Show instr, Show drum, Ord instr, Ord drum) =>
SoundMap.DrumTable drum ->
SoundMap.InstrumentTable instr ->
SoundHandler (RhyMusic.Note drum instr)
rhythmicMusic drumMap instrMap =
(Note.fromRhythmicNote show show,
map extractSoundAssign drumMap ++
map extractSoundAssign instrMap)
rhythmicMusicWithAttributes :: (Ord instr, Ord drum) =>
SoundMap.DrumTableWithAttributes drum ->
SoundMap.InstrumentTableWithAttributes instr ->
SoundHandler (RhyMusic.Note drum instr)
rhythmicMusicWithAttributes drumMap instrMap =
(Note.fromRhythmicNoteWithAttributes
(SoundMap.lookup drumMap)
(SoundMap.lookup instrMap),
map extractSoundWithAttributesAssign drumMap ++
map extractSoundWithAttributesAssign instrMap)
fromMelody ::
Instrument ->
Melody.T () ->
T
fromMelody sound =
fromMelodyPerformance sound .
SCPf.fromMelody
melodyRestError :: a
melodyRestError =
error "SuperCollider.Play: Music from Melody contains a rest."
fromMelodyPerformance ::
Instrument ->
PfBE.Padded Time Note.T ->
T
fromMelodyPerformance sound =
let name = "mono instrument"
sid = SCPf.instrStartNodeId
installSoundEvent =
installSoundMsg name defaultChannel sound
playSoundEvent =
atomPlayMsg sid name []
events =
flip TimeListPad.snocBody stopMsg .
TimeListPad.mapBody
(\note ->
SCCmd.n_set sid
[(SoundMap.pitchName, NonNeg.toNumber $ fromMaybe melodyRestError $ Note.pitch note),
(SoundMap.velocityName, NonNeg.toNumber (Note.velocity note))]) .
TimeListPad.mapBody PfBE.eventNote
in Cons (installSoundEvent : []) .
prependInitialMsgs (resetMsgs ++ playSoundEvent : []) . events
fromPerformance ::
[OSC.Message] ->
[OSC.Message] ->
SCPf.T Time ->
T
fromPerformance installInstruments globalEffects pf =
Cons
installInstruments
(prependInitialMsgs
(resetMsgs ++ globalEffects) (messagesFromPerformance pf))
prependInitialMsgs :: [OSC.Message] -> TimeList.T Time OSC.Message -> TimeList.T Time OSC.Message
prependInitialMsgs = flip (foldr (TimeList.cons 0))
messagesFromPerformance :: SCPf.T Time -> TimeList.T Time OSC.Message
messagesFromPerformance =
flip TimeListPad.snocBody stopMsg .
TimeListPad.mapBody (uncurry eventToMsg)
stopMsg :: OSC.Message
stopMsg = SCCmd.g_freeAll [SCPlay.homeId]
resetMsgs :: [OSC.Message]
resetMsgs =
[SCCmd.g_freeAll [SCPlay.rootId],
SCCmd.g_new [(SCPlay.homeId, AddToTail, SCPlay.rootId)]]
atomPlayMsg ::
SCPlay.NodeId ->
String ->
[(String, Double)] ->
OSC.Message
atomPlayMsg sid name =
SCCmd.s_new name sid AddToHead SCPlay.homeId
installUGenMsg ::
String ->
Channel ->
UGen ->
OSC.Message
installUGenMsg name chan =
SCPlay.d_recv_synthdef name .
Channel.writeUGen chan
installSoundMsg ::
SoundMap.SoundParameters params =>
String ->
Channel ->
Sound params ->
OSC.Message
installSoundMsg name chan =
installUGenMsg name chan . SoundMap.ugenFromSound
defaultChannel :: Channel
defaultChannel = 0
installSoundsMsg ::
Channel ->
[SoundAssign] ->
[OSC.Message]
installSoundsMsg channel =
map (\(name,sound) ->
installUGenMsg name channel sound)
installChannelSoundsMsg ::
[(SoundMap.Name, Channel, UGen)] ->
[OSC.Message]
installChannelSoundsMsg =
map (\(name, channel, ugen) ->
installUGenMsg name channel ugen)
extractSoundAssign ::
(Show instr, SoundMap.SoundParameters params) =>
(instr, Sound params) -> SoundAssign
extractSoundAssign =
\(instr, sound) ->
(show instr, SoundMap.ugenFromSound sound)
extractSoundWithAttributesAssign ::
SoundMap.SoundParameters params =>
SoundMap.Assign params instr -> SoundAssign
extractSoundWithAttributesAssign =
\(SoundMap.Assign name _ sound) -> (name, SoundMap.ugenFromSound sound)
eventToMark ::
(SCPlay.NodeId, Maybe Note.T) ->
(SCPlay.NodeId, Bool)
eventToMark (sid, note) =
(sid, maybe False (const True) note)
eventToMsg :: SCPlay.NodeId -> Maybe (Time, Note.T) -> OSC.Message
eventToMsg sid =
maybe
(SCCmd.n_free [sid])
(\(dur,note) ->
atomPlayMsg sid
(Note.instrument note)
(map ((,) SoundMap.pitchName . NonNeg.toNumber)
(maybeToList (Note.pitch note)) ++
(SoundMap.velocityName, NonNeg.toNumber (Note.velocity note)) :
(SoundMap.durationName, NonNeg.toNumber dur) :
zip SoundMap.attributeNames (Note.parameters note)))