module Synthesizer.Converters.Language
  ( convertMusicPieceToSynthesizer
  ) where

import Data.Map                        (Map, (!))
import Language.Chords                 (getChordNotes)
import Language.Instrument             (Amplitude, BaseAmplitude,
                                        Instrument (..),
                                        InstrumentEvent (ChordEvent, NoteEvent))
import Language.MusicPiece
import Language.Notes
import Notes                           (generateNotes)
import Synthesizer.Modifiers           (applyAmplitude)
import Synthesizer.Modifiers.Envelopes (Envelope (Envelope), applyEnvelope)
import Synthesizer.Oscillator          (sineOscillator)
import Synthesizer.Structure           (Channel (..), Frequency, Sample,
                                        SamplingRate, SoundEvent (..),
                                        SynSound (..))


-- | Convert the DSL to a 'SynSound'. This allows the user to add custom sounds to the 'SynSound' if they so wish.
convertMusicPieceToSynthesizer :: MusicPiece -> SynSound
convertMusicPieceToSynthesizer :: MusicPiece -> SynSound
convertMusicPieceToSynthesizer MusicPiece
musicPiece = [Channel] -> SynSound
SynSound ([Channel] -> SynSound) -> [Channel] -> SynSound
forall a b. (a -> b) -> a -> b
$ (Instrument -> Channel) -> [Instrument] -> [Channel]
forall a b. (a -> b) -> [a] -> [b]
map Instrument -> Channel
convertInstrumentToChannel [Instrument]
instruments
  where
    (MusicPiece [Instrument]
instruments) = MusicPiece
musicPiece

-- | Convert an InstrumentEvent to a NoteEvent. A chord could play multiple notes.
convertInstrumentEventToNoteEvent :: InstrumentEvent  -> [InstrumentEvent]
convertInstrumentEventToNoteEvent :: InstrumentEvent -> [InstrumentEvent]
convertInstrumentEventToNoteEvent c :: InstrumentEvent
c@(ChordEvent StartTime
startTime StartTime
duration StartTime
amplitudeMult Chord
chord) = (Note -> InstrumentEvent) -> [Note] -> [InstrumentEvent]
forall a b. (a -> b) -> [a] -> [b]
map Note -> InstrumentEvent
toNoteEvent (Chord -> [Note]
getChordNotes Chord
chord)
  where
    toNoteEvent :: Note -> InstrumentEvent
    toNoteEvent :: Note -> InstrumentEvent
toNoteEvent Note
note = StartTime -> StartTime -> StartTime -> Note -> InstrumentEvent
NoteEvent StartTime
startTime StartTime
duration StartTime
amplitudeMult Note
note
convertInstrumentEventToNoteEvent n :: InstrumentEvent
n@NoteEvent {} = [InstrumentEvent
n]


-- | Converts an 'Instrument' with corresponding 'NoteEvent's in the DSL to a Synthesizer channel.
convertInstrumentToChannel :: Instrument -> Channel
convertInstrumentToChannel :: Instrument -> Channel
convertInstrumentToChannel Instrument
instrument = [SoundEvent] -> Channel
Channel ([SoundEvent] -> Channel) -> [SoundEvent] -> Channel
forall a b. (a -> b) -> a -> b
$ (InstrumentEvent -> SoundEvent)
-> [InstrumentEvent] -> [SoundEvent]
forall a b. (a -> b) -> [a] -> [b]
map (Envelope -> SoundEvent -> SoundEvent
applyEnvelope Envelope
noteStrike (SoundEvent -> SoundEvent)
-> (InstrumentEvent -> SoundEvent) -> InstrumentEvent -> SoundEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Note StartTime -> StartTime -> InstrumentEvent -> SoundEvent
convertNoteEventsToSoundEvents Map Note StartTime
noteMap StartTime
baseAmplitude) [InstrumentEvent]
noteEvents
  where
    (Instrument StartTime
baseFreq StartTime
baseAmplitude Envelope
noteStrike [InstrumentEvent]
instrumentEvents) = Instrument
instrument
    noteMap :: Map Note StartTime
noteMap = StartTime -> Map Note StartTime
generateNotes StartTime
baseFreq
    noteEvents :: [InstrumentEvent]
noteEvents = (InstrumentEvent -> [InstrumentEvent])
-> [InstrumentEvent] -> [InstrumentEvent]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InstrumentEvent -> [InstrumentEvent]
convertInstrumentEventToNoteEvent [InstrumentEvent]
instrumentEvents


-- | Convert a single (possibly modified by envelope) 'InstrumentEvent' to a SoundEvent.
convertNoteEventsToSoundEvents :: Map Note Frequency -> BaseAmplitude -> InstrumentEvent -> SoundEvent
convertNoteEventsToSoundEvents :: Map Note StartTime -> StartTime -> InstrumentEvent -> SoundEvent
convertNoteEventsToSoundEvents Map Note StartTime
noteMap StartTime
baseAmplitude InstrumentEvent
noteEvent = StartTime
-> StartTime -> (SamplingRate -> [StartTime]) -> SoundEvent
SoundEvent StartTime
startTime StartTime
duration SamplingRate -> [StartTime]
samples
  where
    (NoteEvent StartTime
startTime StartTime
duration StartTime
amplitudeMult Note
note) = InstrumentEvent
noteEvent
    samples :: SamplingRate -> [Sample]
    samples :: SamplingRate -> [StartTime]
samples SamplingRate
samplingRate = StartTime -> SamplingRate -> StartTime -> [StartTime]
convertFrequencyToSamples StartTime
noteAmplitude SamplingRate
samplingRate StartTime
noteFreq
    noteFreq :: Frequency
    noteFreq :: StartTime
noteFreq = Map Note StartTime -> Note -> StartTime
convertNoteToFrequency Map Note StartTime
noteMap Note
note
    noteAmplitude :: Amplitude
    noteAmplitude :: StartTime
noteAmplitude = StartTime
baseAmplitude StartTime -> StartTime -> StartTime
forall a. Num a => a -> a -> a
* StartTime
amplitudeMult

-- | Converts a note to a frequency. First argument is the map of the base frequency of the instrument.
convertNoteToFrequency :: Map Note Frequency -> Note -> Frequency
convertNoteToFrequency :: Map Note StartTime -> Note -> StartTime
convertNoteToFrequency Map Note StartTime
noteMap Note
note = Map Note StartTime
noteMap Map Note StartTime -> Note -> StartTime
forall k a. Ord k => Map k a -> k -> a
! Note
note

convertFrequencyToSamples :: Amplitude -> SamplingRate -> Frequency -> [Sample]
convertFrequencyToSamples :: StartTime -> SamplingRate -> StartTime -> [StartTime]
convertFrequencyToSamples StartTime
amplitude SamplingRate
samplingRate StartTime
freq = (StartTime -> [StartTime] -> [StartTime]
applyAmplitude StartTime
amplitude ([StartTime] -> [StartTime])
-> (SamplingRate -> [StartTime]) -> SamplingRate -> [StartTime]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StartTime -> SamplingRate -> [StartTime]
sineOscillator StartTime
freq) SamplingRate
samplingRate