module Haskore.Interface.SuperCollider.Schedule (
    T(..), SoundHandler, Time,

    fromMelody, fromMusic, fromMusicGlobalEffect,
    fromRhythmicMusicSoundEffects,
    fromPerformance,
    rhythmicMusic, rhythmicMusicWithAttributes,

    -- for Play module
    installUGenMsg, installSoundMsg,
    defaultChannel, atomPlayMsg,
    timeStamp,

    -- for Render module
    toStream,

    -- for suppression of "unused" warnings :-)
    fromMusicMsgs, messagesToStream, eventToMark,

    -- testing
    -- fromMelodyPerformance,
  ) where

import qualified Sound.SC3.UGen.UGen as SCUGen

import qualified Sound.SC3.Server.Command   as SCCmd
import qualified Sound.SC3.Server.PlayEasy  as SCPlay

import Sound.SC3.UGen.UGen (UGen)

-- import qualified Sound.OpenSoundControl.Transport.UDP      as UDP
-- import qualified Sound.OpenSoundControl.UDPMonad as UDP
import Sound.OpenSoundControl.OSC (OSC(Bundle))

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.Basic.TimeOrderedList    as TimeList
import qualified Haskore.Basic.TimeOrderedListPad as TimeListPad
import qualified Data.EventList.Absolute.TimeBody as AbsoluteEventList

import qualified Haskore.General.IdGenerator      as IdGen

import qualified Numeric.NonNegative.Wrapper as NonNeg

import Control.Monad (liftM2)

import Data.Maybe(fromMaybe,maybeToList)


{- * Schedule data structure -}


data T =
   Cons {
      initial :: [OSC]
          {- ^ All of these messages must be synchronous!
               Otherwise the player might wait forever. -},
      body    :: TimeList.T Time OSC
   }
    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]) ->
   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 SCCmd.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 SCCmd.AddToTail SCPlay.homeId []]
          pf

-- slightly inconsistent naming with respect to Music.fromMelodyNullAttr
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),
    -- fromRhythmicMusicSoundEffects relies on that order
    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] ->
   [OSC] ->
   SCPf.T Time ->
   T
fromPerformance installInstruments globalEffects pf =
   Cons
      installInstruments
      (prependInitialMsgs
         (resetMsgs ++ globalEffects) (messagesFromPerformance pf))


prependInitialMsgs :: [OSC] -> TimeList.T Time OSC -> TimeList.T Time OSC
prependInitialMsgs = flip (foldr (TimeList.cons 0))

messagesFromPerformance :: SCPf.T Time -> TimeList.T Time OSC
messagesFromPerformance =
   flip TimeListPad.snocBody stopMsg .
   TimeListPad.mapBody (uncurry eventToMsg)


toStream ::
   T ->
   [OSC]
toStream sc =
   timeStamp 0 (initial sc) :
   messagesToStream (body sc)

messagesToStream ::
   TimeList.T Time OSC ->
   [OSC]
messagesToStream =
   map (uncurry timeStamp) .
   TimeList.toAbsPairList .
   {- first absolutize, then collectCoincident in order to catch
      coincidences caused by rounding -}
   AbsoluteEventList.collectCoincident .
   TimeList.toAbsoluteEventList 0

timeStamp :: Time -> [OSC] -> OSC
timeStamp = Bundle . NonNeg.toNumber






{- * Construction of OpenSoundControl messages -}

stopMsg :: OSC
stopMsg = SCCmd.g_freeAll [SCPlay.homeId]


resetMsgs :: [OSC]
resetMsgs =
   [SCCmd.g_freeAll [SCPlay.rootId],
    SCCmd.g_new [(SCPlay.homeId, SCCmd.AddToTail, SCPlay.rootId)]]


atomPlayMsg ::
   SCPlay.NodeId ->
   String ->
   [(String, Double)] ->
   OSC
atomPlayMsg sid name =
   SCCmd.s_new name sid SCCmd.AddToHead SCPlay.homeId
   -- adding to head is necessary for allowing global effects like in the Life module


installUGenMsg ::
   String ->
   Channel ->
   UGen ->
   OSC
installUGenMsg name chan =
   SCPlay.d_recv' name .
   Channel.writeUGen chan

installSoundMsg ::
   SoundMap.SoundParameters params =>
   String ->
   Channel ->
   Sound params ->
   OSC
installSoundMsg name chan =
   installUGenMsg name chan . SoundMap.ugenFromSound


defaultChannel :: Channel
defaultChannel = 0


installSoundsMsg ::
   Channel ->
   [SoundAssign] ->
   [OSC]
installSoundsMsg channel =
   map (\(name,sound) ->
           installUGenMsg name channel sound)

installChannelSoundsMsg ::
   [(SoundMap.Name, Channel, UGen)] ->
   [OSC]
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
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)))

