-- | Utils for Scores
module Csound.Air.Sco(
    euc, dot, ddot, scoBpm, trn,
    -- * Shortcuts
    -- | Naming conventions :
    --
    -- First part @x@ can be [b | w | h | q | e | s | t | d[x] ]
    --
    -- @b@ means brewis @(str 2)@
    --
    -- @w@ means whole @(str 1)@
    --
    -- @h@ means half @(str $ 1/2)@
    --
    -- @q@ means quater @(str $ 1/4)@
    --
    -- @e@ means eighth @(str $ 1/8)@
    --
    -- @s@ means sixteenth @(str $ 1/16)@
    --
    -- @t@ means thirty second @(str $ 1/32)@
    --
    -- @d[x]@ means dotted [x] @(str 1.5 $ x)@
    bn, wn, hn, qn, en, sn, tn,

    -- ** Pauses
    -- | Naming conventions are the same as for 'time string'.
    bnr, wnr, hnr, qnr, enr, snr, tnr
) where

import Csound.Typed.Types
import Csound.Typed.Control
import Temporal.Media

-- | Euclidean beats.
--
-- Scales series of scores by apllying series of stretching transformations.
--
-- > euc totalLength initDelay durations scores
euc :: Double -> Double -> [Double] -> [Sco a] -> Sco a
euc :: Double -> Double -> [Double] -> [Sco a] -> Sco a
euc Double
len Double
delTime [Double]
durs [Sco a]
scos =
  (Double, Sco a) -> [(Double, Sco a)] -> Sco a
forall a. (Double, Sco a) -> [(Double, Sco a)] -> Sco a
go (Double
delTime, DurOf (Sco a) -> Sco a
forall a. Rest a => DurOf a -> a
rest (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Double -> D
double Double
delTime)) ([(Double, Sco a)] -> Sco a) -> [(Double, Sco a)] -> Sco a
forall a b. (a -> b) -> a -> b
$ [Double] -> [Sco a] -> [(Double, Sco a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Double] -> [Double]
forall a. [a] -> [a]
cycle [Double]
durs) ([Sco a] -> [Sco a]
forall a. [a] -> [a]
cycle [Sco a]
scos)
  where
    go :: (Double, Sco a) -> [(Double, Sco  a)] -> Sco a
    go :: (Double, Sco a) -> [(Double, Sco a)] -> Sco a
go (Double
time, Sco a
res) [(Double, Sco a)]
xs = case [(Double, Sco a)]
xs of
      []             -> Sco a
res
      (Double
dt, Sco a
a) : [(Double, Sco a)]
tl ->
        let nextTime :: Double
nextTime = Double
time Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dt
        in  if Double
nextTime Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
len
              then (Double, Sco a) -> [(Double, Sco a)] -> Sco a
forall a. (Double, Sco a) -> [(Double, Sco a)] -> Sco a
go (Double
nextTime, [Sco a] -> Sco a
forall a. Melody a => [a] -> a
mel [Sco a
res, DurOf (Sco a) -> Sco a -> Sco a
forall a. Stretch a => DurOf a -> a -> a
str (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Double -> D
double Double
dt) Sco a
a]) [(Double, Sco a)]
tl
              else let dtReduced :: Double
dtReduced = Double
len Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
time
                   in  [Sco a] -> Sco a
forall a. Melody a => [a] -> a
mel [Sco a
res, DurOf (Sco a) -> Sco a -> Sco a
forall a. Stretch a => DurOf a -> a -> a
str (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Double -> D
double Double
dtReduced) Sco a
a]

-- | Sets tempo in beats per minute,
-- if 1 "Dur" is equal to 1 second before transformation.
scoBpm :: Sig -> (Sco a -> Sco a)
scoBpm :: Sig -> Sco a -> Sco a
scoBpm Sig
beat = DurOf (Sco a) -> Sco a -> Sco a
forall a. Stretch a => DurOf a -> a -> a
str (Sig
x1Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/Sig
x0)
    where x0 :: Sig
x0 = Sig
0.25
          x1 :: Sig
x1 = Sig
60Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/Sig
beat

-- | Means 'three notes'. Plays three notes as fast as two.
trn :: Sco a -> Sco a
trn :: Sco a -> Sco a
trn = DurOf (Sco a) -> Sco a -> Sco a
forall a. Stretch a => DurOf a -> a -> a
str (Sig
2Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/Sig
3)

bn, wn, hn, qn, en, sn, tn  :: Sco a -> Sco a

bn :: Sco a -> Sco a
bn = DurOf (Sco a) -> Sco a -> Sco a
forall a. Stretch a => DurOf a -> a -> a
str DurOf (Sco a)
2
wn :: Sco a -> Sco a
wn = Sco a -> Sco a
forall a. a -> a
id
hn :: Sco a -> Sco a
hn = DurOf (Sco a) -> Sco a -> Sco a
forall a. Stretch a => DurOf a -> a -> a
str (DurOf (Sco a) -> Sco a -> Sco a)
-> DurOf (Sco a) -> Sco a -> Sco a
forall a b. (a -> b) -> a -> b
$ Sig
1Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/Sig
2
qn :: Sco a -> Sco a
qn = DurOf (Sco a) -> Sco a -> Sco a
forall a. Stretch a => DurOf a -> a -> a
str (DurOf (Sco a) -> Sco a -> Sco a)
-> DurOf (Sco a) -> Sco a -> Sco a
forall a b. (a -> b) -> a -> b
$ Sig
1Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/Sig
4
en :: Sco a -> Sco a
en = DurOf (Sco a) -> Sco a -> Sco a
forall a. Stretch a => DurOf a -> a -> a
str (DurOf (Sco a) -> Sco a -> Sco a)
-> DurOf (Sco a) -> Sco a -> Sco a
forall a b. (a -> b) -> a -> b
$ Sig
1Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/Sig
8
sn :: Sco a -> Sco a
sn = DurOf (Sco a) -> Sco a -> Sco a
forall a. Stretch a => DurOf a -> a -> a
str (DurOf (Sco a) -> Sco a -> Sco a)
-> DurOf (Sco a) -> Sco a -> Sco a
forall a b. (a -> b) -> a -> b
$ Sig
1Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/Sig
16
tn :: Sco a -> Sco a
tn = DurOf (Sco a) -> Sco a -> Sco a
forall a. Stretch a => DurOf a -> a -> a
str (DurOf (Sco a) -> Sco a -> Sco a)
-> DurOf (Sco a) -> Sco a -> Sco a
forall a b. (a -> b) -> a -> b
$ Sig
1Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/Sig
32

-- | Synonym to @'str' (3/2)@
dot :: Sco a -> Sco a
dot :: Sco a -> Sco a
dot = DurOf (Sco a) -> Sco a -> Sco a
forall a. Stretch a => DurOf a -> a -> a
str (DurOf (Sco a) -> Sco a -> Sco a)
-> DurOf (Sco a) -> Sco a -> Sco a
forall a b. (a -> b) -> a -> b
$ Sig
3Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/Sig
2

-- | double 'dot', str with 1.75
ddot :: Sco a -> Sco a
ddot :: Sco a -> Sco a
ddot = DurOf (Sco a) -> Sco a -> Sco a
forall a. Stretch a => DurOf a -> a -> a
str DurOf (Sco a)
1.75

bnr, wnr, hnr, qnr, enr, snr, tnr :: Sco a

wnr :: Sco a
wnr = DurOf (Sco a) -> Sco a
forall a. Rest a => DurOf a -> a
rest DurOf (Sco a)
1

bnr :: Sco a
bnr = Sco a -> Sco a
forall a. Sco a -> Sco a
bn Sco a
forall a. Sco a
wnr
hnr :: Sco a
hnr = Sco a -> Sco a
forall a. Sco a -> Sco a
hn Sco a
forall a. Sco a
wnr
qnr :: Sco a
qnr = Sco a -> Sco a
forall a. Sco a -> Sco a
qn Sco a
forall a. Sco a
wnr
enr :: Sco a
enr = Sco a -> Sco a
forall a. Sco a -> Sco a
en Sco a
forall a. Sco a
wnr
snr :: Sco a
snr = Sco a -> Sco a
forall a. Sco a -> Sco a
sn Sco a
forall a. Sco a
wnr
tnr :: Sco a
tnr = Sco a -> Sco a
forall a. Sco a -> Sco a
tn Sco a
forall a. Sco a
wnr