module Examples
  where

import Language.Instrument
import Language.Modulators
import Language.MusicPiece
import Language.Notes
import Notes.Default
import Synthesizer.Converters.Language (convertMusicPieceToSynthesizer)
import Synthesizer.Encoders.Wav
import Synthesizer.Modifiers
import Synthesizer.Oscillator
import Synthesizer.Structure

defaultVolume :: Amplitude
defaultVolume :: Amplitude
defaultVolume = Amplitude
25000

-- A piece of music written in the DSL. Multiple instrument can be combined into a single music piece
musicPiece :: MusicPiece
musicPiece :: MusicPiece
musicPiece = [Instrument] -> MusicPiece
MusicPiece [
 -- Instrument BaseFrequency BaseAmplitude NoteStrike
    Amplitude
-> Amplitude -> NoteStrike -> [InstrumentEvent] -> Instrument
Instrument Amplitude
440 Amplitude
defaultVolume (Amplitude -> Amplitude -> Amplitude -> Amplitude -> NoteStrike
noteStrike Amplitude
0.2 Amplitude
0.2 Amplitude
0.5 Amplitude
0.1) [
   -- NoteEvent StartTime Length AmplitudeMult Note
      Amplitude -> Amplitude -> Amplitude -> Note -> InstrumentEvent
NoteEvent Amplitude
0   Amplitude
0.5 Amplitude
1 (Tone
C Tone -> Octave -> Note
forall a b. ModulateOctave a b => a -> Octave -> b
^= Octave
Four),
      Amplitude -> Amplitude -> Amplitude -> Note -> InstrumentEvent
NoteEvent Amplitude
0.5 Amplitude
0.5 Amplitude
1 (Tone
D Tone -> Octave -> Note
forall a b. ModulateOctave a b => a -> Octave -> b
^= Octave
Four),
      Amplitude -> Amplitude -> Amplitude -> Note -> InstrumentEvent
NoteEvent Amplitude
1   Amplitude
0.5 Amplitude
1 (Tone
E Tone -> Octave -> Note
forall a b. ModulateOctave a b => a -> Octave -> b
^= Octave
Four),
      Amplitude -> Amplitude -> Amplitude -> Note -> InstrumentEvent
NoteEvent Amplitude
1.5 Amplitude
0.5 Amplitude
1 (Tone
C Tone -> Octave -> Note
forall a b. ModulateOctave a b => a -> Octave -> b
^= Octave
Four),

      Amplitude -> Amplitude -> Amplitude -> Note -> InstrumentEvent
NoteEvent Amplitude
2   Amplitude
0.5 Amplitude
1 (Tone
C Tone -> Octave -> Note
forall a b. ModulateOctave a b => a -> Octave -> b
^= Octave
Four),
      Amplitude -> Amplitude -> Amplitude -> Note -> InstrumentEvent
NoteEvent Amplitude
2.5 Amplitude
0.5 Amplitude
1 (Tone
D Tone -> Octave -> Note
forall a b. ModulateOctave a b => a -> Octave -> b
^= Octave
Four),
      Amplitude -> Amplitude -> Amplitude -> Note -> InstrumentEvent
NoteEvent Amplitude
3   Amplitude
0.5 Amplitude
1 (Tone
E Tone -> Octave -> Note
forall a b. ModulateOctave a b => a -> Octave -> b
^= Octave
Four),
      Amplitude -> Amplitude -> Amplitude -> Note -> InstrumentEvent
NoteEvent Amplitude
3.5 Amplitude
0.5 Amplitude
1 (Tone
C Tone -> Octave -> Note
forall a b. ModulateOctave a b => a -> Octave -> b
^= Octave
Four),

      Amplitude -> Amplitude -> Amplitude -> Note -> InstrumentEvent
NoteEvent Amplitude
4   Amplitude
0.5 Amplitude
1.3 (Tone
E Tone -> Octave -> Note
forall a b. ModulateOctave a b => a -> Octave -> b
^= Octave
Four),
      Amplitude -> Amplitude -> Amplitude -> Note -> InstrumentEvent
NoteEvent Amplitude
4.5 Amplitude
0.5 Amplitude
1   (Tone
F Tone -> Octave -> Note
forall a b. ModulateOctave a b => a -> Octave -> b
^= Octave
Four),
      Amplitude -> Amplitude -> Amplitude -> Note -> InstrumentEvent
NoteEvent Amplitude
5   Amplitude
0.5 Amplitude
1.3 (Tone
G Tone -> Octave -> Note
forall a b. ModulateOctave a b => a -> Octave -> b
^= Octave
Four)
    ]
  ]

-- Converts the DSL into the synthesizer structure.
-- If you want more control, you can use this structure to add more
-- waveforms, notes or custom sounds.
synthesizerStructure :: SynSound
synthesizerStructure :: SynSound
synthesizerStructure = MusicPiece -> SynSound
convertMusicPieceToSynthesizer MusicPiece
musicPiece

-- Add a custom sound to the synthesizer
-- First: Create a channel. A channel can hold one or more events
channel :: Channel
channel = [SoundEvent] -> Channel
Channel [
    -- Second: Add a SoundEvent. The first argument is the start time, the second the time the event takes
    -- The last argument is the sound produced. Here, some default generators are used. Custom ones will be explained later
    Amplitude
-> Amplitude -> (SamplingRate -> [Amplitude]) -> SoundEvent
SoundEvent Amplitude
0 Amplitude
4 (Amplitude -> [Amplitude] -> [Amplitude]
applyAmplitude Amplitude
1000 ([Amplitude] -> [Amplitude])
-> (SamplingRate -> [Amplitude]) -> SamplingRate -> [Amplitude]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amplitude -> SamplingRate -> [Amplitude]
sineOscillator Amplitude
500)
  ]

-- Channels (and SynSounds) can be combined as they are an instance of Monoid.
doubleChannel :: Channel
doubleChannel = Channel
channel Channel -> Channel -> Channel
forall a. Semigroup a => a -> a -> a
<> Channel
channel

-- Now we can add the channel to the synthesizer structure
-- If we now save this file, a new waveform will be inserted from t=0 to t=4 seconds
newStructure :: SynSound
newStructure = SynSound -> Channel -> SynSound
addChannel SynSound
synthesizerStructure Channel
channel

-- Writing custom generators
-- The basis of writing a custom sound generator is that it has to return some function of form (SamplingRate -> [Double])
-- So let's say we wish to write some function that does (+1) in a second.
gen :: SamplingRate -> [Sample]
gen :: SamplingRate -> [Amplitude]
gen SamplingRate
rate = [Amplitude
0, Amplitude
timeStep..]
  where timeStep :: Amplitude
timeStep = Amplitude
1 Amplitude -> Amplitude -> Amplitude
forall a. Fractional a => a -> a -> a
/ SamplingRate -> Amplitude
forall a b. (Integral a, Num b) => a -> b
fromIntegral SamplingRate
rate
-- As you can see, this function returns an infinite list. While not strictly necessary, it is preferable.
-- The generator will work as long as it returns a list longer then (samplingRate * ceiling (eventLength e) + 1)


-- This generator can then be put into a SoundEvent. The SamplingRate will be passed into the function based on the file
-- you're creating
eventWithCustomGen :: SoundEvent
eventWithCustomGen = Amplitude
-> Amplitude -> (SamplingRate -> [Amplitude]) -> SoundEvent
SoundEvent Amplitude
0 Amplitude
10 (Amplitude -> [Amplitude] -> [Amplitude]
applyAmplitude Amplitude
1000 ([Amplitude] -> [Amplitude])
-> (SamplingRate -> [Amplitude]) -> SamplingRate -> [Amplitude]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SamplingRate -> [Amplitude]
gen)
-- And add it to our synthesizer structure
newStructureWithCustomGen :: SynSound
newStructureWithCustomGen = SynSound -> [SoundEvent] -> SynSound
addToNewChannel SynSound
synthesizerStructure [SoundEvent
eventWithCustomGen]


-- Save everything to WAV files
saveFiles :: IO ()
saveFiles :: IO ()
saveFiles = do
    FilePath -> SynSound -> IO ()
saveSignal FilePath
"dsl_only" SynSound
synthesizerStructure
    FilePath -> SynSound -> IO ()
saveSignal FilePath
"with_added_sine" SynSound
newStructure
    FilePath -> SynSound -> IO ()
saveSignal FilePath
"with_custom_gen" SynSound
newStructureWithCustomGen