module Synthesizer.Structure
  ( Channel (..)
  , Frequency
  , Length
  , PhaseLength
  , Sample
  , SamplingRate
  , SoundEvent (..)
  , SynSound (..)
  , Time
  , addChannel
  , addToNewChannel
  , getAllEvents
  , getAllEventsDuring
  , soundToSamples
  ) where

import Data.Foldable (Foldable (foldr'))
import Data.List     (sortOn)
import Data.Monoid

newtype SynSound = SynSound {
  SynSound -> [Channel]
channels :: [Channel]
} deriving (Int -> SynSound -> ShowS
[SynSound] -> ShowS
SynSound -> String
(Int -> SynSound -> ShowS)
-> (SynSound -> String) -> ([SynSound] -> ShowS) -> Show SynSound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SynSound] -> ShowS
$cshowList :: [SynSound] -> ShowS
show :: SynSound -> String
$cshow :: SynSound -> String
showsPrec :: Int -> SynSound -> ShowS
$cshowsPrec :: Int -> SynSound -> ShowS
Show, SynSound -> SynSound -> Bool
(SynSound -> SynSound -> Bool)
-> (SynSound -> SynSound -> Bool) -> Eq SynSound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SynSound -> SynSound -> Bool
$c/= :: SynSound -> SynSound -> Bool
== :: SynSound -> SynSound -> Bool
$c== :: SynSound -> SynSound -> Bool
Eq)

instance Semigroup SynSound where
  SynSound
a <> :: SynSound -> SynSound -> SynSound
<> SynSound
b = (SynSound -> Channel -> SynSound)
-> SynSound -> [Channel] -> SynSound
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl SynSound -> Channel -> SynSound
addChannel SynSound
a (SynSound -> [Channel]
channels SynSound
b)

instance Monoid SynSound where
  mempty :: SynSound
mempty = [Channel] -> SynSound
SynSound []

newtype Channel = Channel {
  Channel -> [SoundEvent]
timeline :: [SoundEvent]
} deriving (Int -> Channel -> ShowS
[Channel] -> ShowS
Channel -> String
(Int -> Channel -> ShowS)
-> (Channel -> String) -> ([Channel] -> ShowS) -> Show Channel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Channel] -> ShowS
$cshowList :: [Channel] -> ShowS
show :: Channel -> String
$cshow :: Channel -> String
showsPrec :: Int -> Channel -> ShowS
$cshowsPrec :: Int -> Channel -> ShowS
Show, Channel -> Channel -> Bool
(Channel -> Channel -> Bool)
-> (Channel -> Channel -> Bool) -> Eq Channel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Channel -> Channel -> Bool
$c/= :: Channel -> Channel -> Bool
== :: Channel -> Channel -> Bool
$c== :: Channel -> Channel -> Bool
Eq)

instance Semigroup Channel where
  Channel
a <> :: Channel -> Channel -> Channel
<> Channel
b = [SoundEvent] -> Channel
Channel (Channel -> [SoundEvent]
timeline Channel
a [SoundEvent] -> [SoundEvent] -> [SoundEvent]
forall a. [a] -> [a] -> [a]
++ Channel -> [SoundEvent]
timeline Channel
b)

instance Monoid Channel where
  mempty :: Channel
mempty = [SoundEvent] -> Channel
Channel []

type Time         = Double
type Length       = Double
type Sample       = Double
type Frequency    = Double
type PhaseLength  = Int
type SamplingRate = Int

data SoundEvent = SoundEvent {
  SoundEvent -> Time
startTime   :: Time,
  SoundEvent -> Time
eventLength :: Length,
  SoundEvent -> Int -> [Time]
samples     :: SamplingRate -> [Sample]
}

-- | Eq instance for SoundEvents. It should be noted that this isn't 100% sound, as if the needed samples for generating
-- sounds are exactly the same but a sample after that is different, this will return equality even if it really
-- isn't. However functionally these two events are the same, since at maximum that amount
-- of samples will be used when generating the sound from them. So there is no practical difference in this context
instance Eq SoundEvent where
  SoundEvent
a == :: SoundEvent -> SoundEvent -> Bool
== SoundEvent
b = SoundEvent -> Time
startTime SoundEvent
a Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== SoundEvent -> Time
startTime SoundEvent
b Bool -> Bool -> Bool
&&
           SoundEvent -> Time
eventLength SoundEvent
a Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== SoundEvent -> Time
eventLength SoundEvent
b Bool -> Bool -> Bool
&&
           SoundEvent -> Int -> [Time]
takeNeededSamples SoundEvent
a Int
rate [Time] -> [Time] -> Bool
forall a. Eq a => a -> a -> Bool
== SoundEvent -> Int -> [Time]
takeNeededSamples SoundEvent
b Int
rate
    where rate :: Int
rate = Int
100

instance Show SoundEvent where
  show :: SoundEvent -> String
show (SoundEvent Time
startTime Time
eventLength Int -> [Time]
_) = String
"SoundEvent { startTime = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Time -> String
forall a. Show a => a -> String
show Time
startTime String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" eventLength = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Time -> String
forall a. Show a => a -> String
show Time
eventLength String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" samples = ... }"

data SoundEventCached = SoundEventCached {
  SoundEventCached -> SoundEvent
event         :: SoundEvent,
  SoundEventCached -> [Time]
samplesCached :: [Sample]
}

-- | Takes the maximum needed samples to generate the sound. This is dependent on the sampling rate and the length of
-- the event.
takeNeededSamples :: SoundEvent -> SamplingRate -> [Sample]
takeNeededSamples :: SoundEvent -> Int -> [Time]
takeNeededSamples SoundEvent
e Int
rate = Int -> [Time] -> [Time]
forall a. Int -> [a] -> [a]
take (Int
rate Int -> Int -> Int
forall a. Num a => a -> a -> a
* Time -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (SoundEvent -> Time
eventLength SoundEvent
e) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (SoundEvent -> Int -> [Time]
samples SoundEvent
e Int
rate)

-- | Converts the sound structure to a list of samples with a certain sampling rate.
-- The worst-case time complexity of the algorithm is @O(n log n)@, where n is the amount of sound events.
soundToSamples :: SynSound -> SamplingRate -> [Sample]
soundToSamples :: SynSound -> Int -> [Time]
soundToSamples SynSound
sound Int
rate = [SoundEventCached] -> [SoundEventCached] -> Int -> Int -> [Time]
soundToSamples' [SoundEventCached]
convertedEvents [] Int
rate Int
0
  where
    sortedEvents :: [SoundEvent]
sortedEvents = (SoundEvent -> Time) -> [SoundEvent] -> [SoundEvent]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn SoundEvent -> Time
startTime (SynSound -> [SoundEvent]
getAllEvents SynSound
sound)
    convertedEvents :: [SoundEventCached]
convertedEvents = (SoundEvent -> SoundEventCached)
-> [SoundEvent] -> [SoundEventCached]
forall a b. (a -> b) -> [a] -> [b]
map SoundEvent -> SoundEventCached
eagerEvaluate [SoundEvent]
sortedEvents
    eagerEvaluate :: SoundEvent -> SoundEventCached
eagerEvaluate SoundEvent
e = SoundEvent -> [Time] -> SoundEventCached
SoundEventCached SoundEvent
e (SoundEvent -> [Time]
eagerSamples SoundEvent
e)
    eagerSamples :: SoundEvent -> [Time]
eagerSamples  SoundEvent
e = SoundEvent -> Int -> [Time]
takeNeededSamples SoundEvent
e Int
rate

soundToSamples' :: [SoundEventCached] -> [SoundEventCached] -> SamplingRate -> Int -> [Sample]
soundToSamples' :: [SoundEventCached] -> [SoundEventCached] -> Int -> Int -> [Time]
soundToSamples' []      []     Int
_    Int
_            = []
soundToSamples' [SoundEventCached]
samToDo [SoundEventCached]
samCur Int
rate Int
sampleNumber = Time
samplesCurrentEvents Time -> [Time] -> [Time]
forall a. a -> [a] -> [a]
: [SoundEventCached] -> [SoundEventCached] -> Int -> Int -> [Time]
soundToSamples' [SoundEventCached]
updatedToDo [SoundEventCached]
updatedCurrent' Int
rate (Int
sampleNumber Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  where currentTime :: Time
currentTime = Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sampleNumber Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rate
        ([SoundEventCached]
updatedToDo, [SoundEventCached]
updatedCurrent) = ([SoundEventCached], [SoundEventCached])
-> Time -> ([SoundEventCached], [SoundEventCached])
mergeTodoAndCurrent ([SoundEventCached]
samToDo, [SoundEventCached]
samCur) Time
currentTime
        samplesCurrentEvents :: Time
samplesCurrentEvents = (SoundEventCached -> Time -> Time)
-> Time -> [SoundEventCached] -> Time
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (\SoundEventCached
e Time
t -> Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
+ [Time] -> Time
forall a. [a] -> a
head (SoundEventCached -> [Time]
samplesCached SoundEventCached
e)) Time
0 [SoundEventCached]
updatedCurrent
        updatedCurrent' :: [SoundEventCached]
updatedCurrent' = (SoundEventCached -> SoundEventCached)
-> [SoundEventCached] -> [SoundEventCached]
forall a b. (a -> b) -> [a] -> [b]
map (\SoundEventCached
e -> SoundEventCached
e {samplesCached :: [Time]
samplesCached = [Time] -> [Time]
forall a. [a] -> [a]
tail (SoundEventCached -> [Time]
samplesCached SoundEventCached
e)}) [SoundEventCached]
updatedCurrent


mergeTodoAndCurrent :: ([SoundEventCached], [SoundEventCached]) -> Time -> ([SoundEventCached], [SoundEventCached])
mergeTodoAndCurrent :: ([SoundEventCached], [SoundEventCached])
-> Time -> ([SoundEventCached], [SoundEventCached])
mergeTodoAndCurrent ([SoundEventCached]
todo, [SoundEventCached]
current) Time
time = ([SoundEventCached]
newTodo, [SoundEventCached]
newCurrent)
  where eventsToCurrent :: [SoundEventCached] -> [SoundEventCached]
eventsToCurrent []     = []
        eventsToCurrent (SoundEventCached
x:[SoundEventCached]
xs) = if Time
time Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= SoundEvent -> Time
startTime (SoundEventCached -> SoundEvent
event SoundEventCached
x) then SoundEventCached
xSoundEventCached -> [SoundEventCached] -> [SoundEventCached]
forall a. a -> [a] -> [a]
:[SoundEventCached] -> [SoundEventCached]
eventsToCurrent [SoundEventCached]
xs else []
        eventsFromTodo :: [SoundEventCached] -> [SoundEventCached]
eventsFromTodo [SoundEventCached]
xs      = (SoundEventCached -> Bool)
-> [SoundEventCached] -> [SoundEventCached]
forall a. (a -> Bool) -> [a] -> [a]
filter (\SoundEventCached
e -> Time
time Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< SoundEvent -> Time
startTime (SoundEventCached -> SoundEvent
event SoundEventCached
e) Time -> Time -> Time
forall a. Num a => a -> a -> a
+ SoundEvent -> Time
eventLength (SoundEventCached -> SoundEvent
event SoundEventCached
e)) [SoundEventCached]
xs
        newTodo :: [SoundEventCached]
newTodo = Int -> [SoundEventCached] -> [SoundEventCached]
forall a. Int -> [a] -> [a]
drop ([SoundEventCached] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([SoundEventCached] -> Int) -> [SoundEventCached] -> Int
forall a b. (a -> b) -> a -> b
$ [SoundEventCached] -> [SoundEventCached]
eventsToCurrent [SoundEventCached]
todo) [SoundEventCached]
todo
        newCurrent :: [SoundEventCached]
newCurrent = [SoundEventCached] -> [SoundEventCached]
eventsFromTodo ([SoundEventCached] -> [SoundEventCached])
-> [SoundEventCached] -> [SoundEventCached]
forall a b. (a -> b) -> a -> b
$ [SoundEventCached]
current [SoundEventCached] -> [SoundEventCached] -> [SoundEventCached]
forall a. [a] -> [a] -> [a]
++ [SoundEventCached] -> [SoundEventCached]
eventsToCurrent [SoundEventCached]
todo


-- Multiple helper functions for easy adding/removing events

-- | Adds a channel to a SynSound
addChannel :: SynSound -> Channel -> SynSound
addChannel :: SynSound -> Channel -> SynSound
addChannel SynSound
s Channel
c = SynSound
s {channels :: [Channel]
channels = Channel
c Channel -> [Channel] -> [Channel]
forall a. a -> [a] -> [a]
: SynSound -> [Channel]
channels SynSound
s}

-- | Adds SoundEvents to a new channel.
addToNewChannel :: SynSound -> [SoundEvent] -> SynSound
addToNewChannel :: SynSound -> [SoundEvent] -> SynSound
addToNewChannel SynSound
s [SoundEvent]
xs = SynSound -> Channel -> SynSound
addChannel SynSound
s ([SoundEvent] -> Channel
Channel [SoundEvent]
xs)

-- | Gets all events currently in the synthesizer.
getAllEvents :: SynSound -> [SoundEvent]
getAllEvents :: SynSound -> [SoundEvent]
getAllEvents SynSound
s = (Channel -> [SoundEvent]) -> [Channel] -> [SoundEvent]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Channel -> [SoundEvent]
timeline (SynSound -> [Channel]
channels SynSound
s)

-- | Gets all events that overlap with a time period of (startTime, endTime).
-- | Passing an endTime that is before the startTime will result in no events being returned.
getAllEventsDuring :: SynSound -> (Time, Time) -> [SoundEvent]
getAllEventsDuring :: SynSound -> (Time, Time) -> [SoundEvent]
getAllEventsDuring SynSound
s (Time
start, Time
end) = (SoundEvent -> Bool) -> [SoundEvent] -> [SoundEvent]
forall a. (a -> Bool) -> [a] -> [a]
filter (\SoundEvent
e -> Time
start Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< (SoundEvent -> Time
startTime SoundEvent
e Time -> Time -> Time
forall a. Num a => a -> a -> a
+ SoundEvent -> Time
eventLength SoundEvent
e) Bool -> Bool -> Bool
&& SoundEvent -> Time
startTime SoundEvent
e Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
end) [SoundEvent]
events
  where events :: [SoundEvent]
events = SynSound -> [SoundEvent]
getAllEvents SynSound
s