{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Harmonic.Interface.Tidal.Orchestra
-- Description : Orchestral instrument functions for TidalCycles
--
-- Voice line system (SATB + octave variants) and instrument functions
-- with built-in MIDI range clipping and octave handling.
-- Each instrument is a thin 'arrange' wrapper — clip and octave shift
-- are internal; the composer sees only voice assignment and kinetics range.

module Harmonic.Interface.Tidal.Orchestra (
    -- * Voice lines
    Voice(..), VoiceLines(..), voiceLines, vlGet, voiceOct,

    -- * Pitched instruments
    -- | Every pitched instrument shares the 'Instrument' shape and carries its
    -- own MIDI range and channel. Ranges are given in Tidal note space
    -- (MIDI − 60); the physical range follows in parentheses.
    --
    -- +------------+---------+-----------------+
    -- | Instrument | Channel | Range           |
    -- +============+=========+=================+
    -- | flute      | 1       | C3-D6           |
    -- | oboe       | 2       | Bb3-A6          |
    -- | clarinet   | 3       | D2-Bb6          |
    -- | bassoon    | 4       | Bb1-Eb5         |
    -- | horn       | 5       | B1-F5           |
    -- | trombone   | 6       | Bb1-F5          |
    -- | basstrom   | 6       | A0-G3           |
    -- | harp       | 7       | B1-F#7          |
    -- | timpani    | 8       | D2-C4           |
    -- | violin1\/2 | 16      | G3-A7           |
    -- | viola      | 16      | C3-E6           |
    -- | cello      | 16      | C2-C6           |
    -- | contrabass | 16      | C1-C4           |
    -- +------------+---------+-----------------+
    flute, oboe, clarinet, bassoon,
    horn, trombone, basstrom,
    harp, timpani,
    violin1, violin2, viola, cello, contrabass,

    -- * Unpitched percussion
    bassdrum, tamtam,

    -- * String articulations
    pizz, spicc, marc, legg, arco,

    -- * Divisi
    Instrument, divisi, divisi2, divisi3,

    -- * Internal (for testing only)
    clip, voiceBase, voiceTier,
) where

import Sound.Tidal.Context hiding (voice, clip)
import qualified Data.Map.Strict as Map
import Harmonic.Interface.Tidal.Bridge (VoiceFunction, arrange, overlapF)
import Harmonic.Interface.Tidal.Arranger (flow, root, grid)
import Harmonic.Interface.Tidal.Form (IK)
import Harmonic.Interface.Tidal.Instruments (ch, vel)
import Harmonic.Interface.Tidal.Utils (oct)
import Harmonic.Rules.Types.ProgressionContext (Layer(..))

-------------------------------------------------------------------------------
-- Voice type (SATB + octave variants)
-------------------------------------------------------------------------------

-- | An SATB voice, at one of five octave transpositions and one of three
-- divisi tiers.
--
-- Divisi tiers: the base 20 voices (tier 0), then the same 20 primed (tier 1,
-- read the @'@ fields), then double-primed (tier 2, the @''@ fields). Declared
-- in three identical-order blocks of 20 so 'voiceBase' \/ 'voiceTier' derive by
-- enum arithmetic (@mod@ \/ @div@ 20). Octave rides the constructor, so e.g.
-- @Bass8vb'@ reads the @bass'@ field at octave −1.
data Voice
  -- tier 0 (base)
  = Soprano | Alto | Tenor | Bass                                      -- loco (normal register)
  | Soprano8va  | Alto8va  | Tenor8va  | Bass8va                      -- octave up
  | Soprano15va | Alto15va | Tenor15va | Bass15va                     -- two octaves up
  | Soprano8vb  | Alto8vb  | Tenor8vb  | Bass8vb                     -- octave down
  | Soprano15vb | Alto15vb | Tenor15vb | Bass15vb                    -- two octaves down
  -- tier 1 (')
  | Soprano' | Alto' | Tenor' | Bass'
  | Soprano8va'  | Alto8va'  | Tenor8va'  | Bass8va'
  | Soprano15va' | Alto15va' | Tenor15va' | Bass15va'
  | Soprano8vb'  | Alto8vb'  | Tenor8vb'  | Bass8vb'
  | Soprano15vb' | Alto15vb' | Tenor15vb' | Bass15vb'
  -- tier 2 ('')
  | Soprano'' | Alto'' | Tenor'' | Bass''
  | Soprano8va''  | Alto8va''  | Tenor8va''  | Bass8va''
  | Soprano15va'' | Alto15va'' | Tenor15va'' | Bass15va''
  | Soprano8vb''  | Alto8vb''  | Tenor8vb''  | Bass8vb''
  | Soprano15vb'' | Alto15vb'' | Tenor15vb'' | Bass15vb''
  deriving (Int -> Voice -> ShowS
[Voice] -> ShowS
Voice -> String
(Int -> Voice -> ShowS)
-> (Voice -> String) -> ([Voice] -> ShowS) -> Show Voice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Voice -> ShowS
showsPrec :: Int -> Voice -> ShowS
$cshow :: Voice -> String
show :: Voice -> String
$cshowList :: [Voice] -> ShowS
showList :: [Voice] -> ShowS
Show, Voice -> Voice -> Bool
(Voice -> Voice -> Bool) -> (Voice -> Voice -> Bool) -> Eq Voice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Voice -> Voice -> Bool
== :: Voice -> Voice -> Bool
$c/= :: Voice -> Voice -> Bool
/= :: Voice -> Voice -> Bool
Eq, Eq Voice
Eq Voice =>
(Voice -> Voice -> Ordering)
-> (Voice -> Voice -> Bool)
-> (Voice -> Voice -> Bool)
-> (Voice -> Voice -> Bool)
-> (Voice -> Voice -> Bool)
-> (Voice -> Voice -> Voice)
-> (Voice -> Voice -> Voice)
-> Ord Voice
Voice -> Voice -> Bool
Voice -> Voice -> Ordering
Voice -> Voice -> Voice
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Voice -> Voice -> Ordering
compare :: Voice -> Voice -> Ordering
$c< :: Voice -> Voice -> Bool
< :: Voice -> Voice -> Bool
$c<= :: Voice -> Voice -> Bool
<= :: Voice -> Voice -> Bool
$c> :: Voice -> Voice -> Bool
> :: Voice -> Voice -> Bool
$c>= :: Voice -> Voice -> Bool
>= :: Voice -> Voice -> Bool
$cmax :: Voice -> Voice -> Voice
max :: Voice -> Voice -> Voice
$cmin :: Voice -> Voice -> Voice
min :: Voice -> Voice -> Voice
Ord, Int -> Voice
Voice -> Int
Voice -> [Voice]
Voice -> Voice
Voice -> Voice -> [Voice]
Voice -> Voice -> Voice -> [Voice]
(Voice -> Voice)
-> (Voice -> Voice)
-> (Int -> Voice)
-> (Voice -> Int)
-> (Voice -> [Voice])
-> (Voice -> Voice -> [Voice])
-> (Voice -> Voice -> [Voice])
-> (Voice -> Voice -> Voice -> [Voice])
-> Enum Voice
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Voice -> Voice
succ :: Voice -> Voice
$cpred :: Voice -> Voice
pred :: Voice -> Voice
$ctoEnum :: Int -> Voice
toEnum :: Int -> Voice
$cfromEnum :: Voice -> Int
fromEnum :: Voice -> Int
$cenumFrom :: Voice -> [Voice]
enumFrom :: Voice -> [Voice]
$cenumFromThen :: Voice -> Voice -> [Voice]
enumFromThen :: Voice -> Voice -> [Voice]
$cenumFromTo :: Voice -> Voice -> [Voice]
enumFromTo :: Voice -> Voice -> [Voice]
$cenumFromThenTo :: Voice -> Voice -> Voice -> [Voice]
enumFromThenTo :: Voice -> Voice -> Voice -> [Voice]
Enum, Voice
Voice -> Voice -> Bounded Voice
forall a. a -> a -> Bounded a
$cminBound :: Voice
minBound :: Voice
$cmaxBound :: Voice
maxBound :: Voice
Bounded)

-------------------------------------------------------------------------------
-- VoiceLines
-------------------------------------------------------------------------------

-- | The scale-degree pattern assigned to each voice.
--
-- Each SATB voice has three divisi tiers: base, @'@, @''@. All are ordinary
-- scale-degree patterns (same syntax and semantics); the primed fields only
-- exist to hold extra divisi desks. Defaults stack one\/two degrees above the
-- base so an undeclared @divisi 3@ voices a chord; declared primes are whatever
-- the composer writes.
data VoiceLines = VoiceLines
  { VoiceLines -> Pattern Int
_vl      :: Pattern Int     -- ^ structural placeholder (always silence)
  , VoiceLines -> Pattern Int
soprano  :: Pattern Int     -- ^ Soprano
  , VoiceLines -> Pattern Int
alto     :: Pattern Int     -- ^ Alto
  , VoiceLines -> Pattern Int
tenor    :: Pattern Int     -- ^ Tenor
  , VoiceLines -> Pattern Int
bass     :: Pattern Int     -- ^ Bass
  , VoiceLines -> Pattern Int
soprano' :: Pattern Int     -- ^ Soprano, divisi desk 2
  , VoiceLines -> Pattern Int
alto'    :: Pattern Int     -- ^ Alto, divisi desk 2
  , VoiceLines -> Pattern Int
tenor'   :: Pattern Int     -- ^ Tenor, divisi desk 2
  , VoiceLines -> Pattern Int
bass'    :: Pattern Int     -- ^ Bass, divisi desk 2
  , VoiceLines -> Pattern Int
soprano'':: Pattern Int     -- ^ Soprano, divisi desk 3
  , VoiceLines -> Pattern Int
alto''   :: Pattern Int     -- ^ Alto, divisi desk 3
  , VoiceLines -> Pattern Int
tenor''  :: Pattern Int     -- ^ Tenor, divisi desk 3
  , VoiceLines -> Pattern Int
bass''   :: Pattern Int     -- ^ Bass, divisi desk 3
  }

-- | Default voice lines: root in the bass, root 8va in the soprano, inner
-- voices on the 2nd and 3rd degrees. Override the fields you want:
--
-- @vl = voiceLines { soprano = \"3 4 3 2\", bass = \"0\" }@
voiceLines :: VoiceLines
voiceLines :: VoiceLines
voiceLines = VoiceLines
  { _vl :: Pattern Int
_vl      = Pattern Int
"~"
  , soprano :: Pattern Int
soprano  = Pattern Int
"3"      -- root 8va
  , alto :: Pattern Int
alto     = Pattern Int
"1"      -- 2nd degree
  , tenor :: Pattern Int
tenor    = Pattern Int
"2"      -- 3rd degree
  , bass :: Pattern Int
bass     = Pattern Int
"0"      -- root
  , soprano' :: Pattern Int
soprano' = Pattern Int
"4"      -- one degree above base defaults …
  , alto' :: Pattern Int
alto'    = Pattern Int
"2"
  , tenor' :: Pattern Int
tenor'   = Pattern Int
"3"
  , bass' :: Pattern Int
bass'    = Pattern Int
"1"
  , soprano'' :: Pattern Int
soprano''= Pattern Int
"5"      -- … two degrees above
  , alto'' :: Pattern Int
alto''   = Pattern Int
"3"
  , tenor'' :: Pattern Int
tenor''  = Pattern Int
"4"
  , bass'' :: Pattern Int
bass''   = Pattern Int
"2"
  }

-------------------------------------------------------------------------------
-- vlGet \/ voiceOct
-------------------------------------------------------------------------------

-- | Strip the divisi prime, giving the tier-0 (base) voice. Relies on the
-- three identical-order 'Voice' blocks of 20.
voiceBase :: Voice -> Voice
voiceBase :: Voice -> Voice
voiceBase = Int -> Voice
forall a. Enum a => Int -> a
toEnum (Int -> Voice) -> (Voice -> Int) -> Voice -> Voice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
20) (Int -> Int) -> (Voice -> Int) -> Voice -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Voice -> Int
forall a. Enum a => a -> Int
fromEnum

-- | Divisi tier of a voice: 0 (base), 1 (@'@), 2 (@''@).
voiceTier :: Voice -> Int
voiceTier :: Voice -> Int
voiceTier = (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
20) (Int -> Int) -> (Voice -> Int) -> Voice -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Voice -> Int
forall a. Enum a => a -> Int
fromEnum

-- | SATB letter of a voice, ignoring octave and divisi tier.
data VLetter = LtrS | LtrA | LtrT | LtrB

voiceLetter :: Voice -> VLetter
voiceLetter :: Voice -> VLetter
voiceLetter Voice
v = case Voice -> Voice
voiceBase Voice
v of
  Voice
Soprano -> VLetter
LtrS; Voice
Soprano8va -> VLetter
LtrS; Voice
Soprano15va -> VLetter
LtrS; Voice
Soprano8vb -> VLetter
LtrS; Voice
Soprano15vb -> VLetter
LtrS
  Voice
Alto -> VLetter
LtrA; Voice
Alto8va -> VLetter
LtrA; Voice
Alto15va -> VLetter
LtrA; Voice
Alto8vb -> VLetter
LtrA; Voice
Alto15vb -> VLetter
LtrA
  Voice
Tenor -> VLetter
LtrT; Voice
Tenor8va -> VLetter
LtrT; Voice
Tenor15va -> VLetter
LtrT; Voice
Tenor8vb -> VLetter
LtrT; Voice
Tenor15vb -> VLetter
LtrT
  Voice
_ -> VLetter
LtrB   -- Bass* (voiceBase always yields a tier-0 constructor)

-- | Read the scale-degree pattern a given 'Voice' should play, resolving both
-- its SATB letter and its divisi tier.
vlGet :: Voice -> VoiceLines -> Pattern Int
vlGet :: Voice -> VoiceLines -> Pattern Int
vlGet Voice
v = case (Voice -> VLetter
voiceLetter Voice
v, Voice -> Int
voiceTier Voice
v) of
  (VLetter
LtrS, Int
0) -> VoiceLines -> Pattern Int
soprano;  (VLetter
LtrS, Int
1) -> VoiceLines -> Pattern Int
soprano';  (VLetter
LtrS, Int
_) -> VoiceLines -> Pattern Int
soprano''
  (VLetter
LtrA, Int
0) -> VoiceLines -> Pattern Int
alto;     (VLetter
LtrA, Int
1) -> VoiceLines -> Pattern Int
alto';     (VLetter
LtrA, Int
_) -> VoiceLines -> Pattern Int
alto''
  (VLetter
LtrT, Int
0) -> VoiceLines -> Pattern Int
tenor;    (VLetter
LtrT, Int
1) -> VoiceLines -> Pattern Int
tenor';    (VLetter
LtrT, Int
_) -> VoiceLines -> Pattern Int
tenor''
  (VLetter
LtrB, Int
0) -> VoiceLines -> Pattern Int
bass;     (VLetter
LtrB, Int
1) -> VoiceLines -> Pattern Int
bass';     (VLetter
LtrB, Int
_) -> VoiceLines -> Pattern Int
bass''

-- | Octave transposition carried by a 'Voice' constructor: @0@ loco, @1@ for
-- @8va@, @2@ for @15va@, @-1@ for @8vb@, @-2@ for @15vb@.
voiceOct :: Voice -> Int
voiceOct :: Voice -> Int
voiceOct Voice
v = case Voice -> Voice
voiceBase Voice
v of
  Voice
Soprano -> Int
0; Voice
Alto -> Int
0; Voice
Tenor -> Int
0; Voice
Bass -> Int
0
  Voice
Soprano8va  -> Int
1;  Voice
Alto8va  -> Int
1;  Voice
Tenor8va  -> Int
1;  Voice
Bass8va  -> Int
1
  Voice
Soprano15va -> Int
2;  Voice
Alto15va -> Int
2;  Voice
Tenor15va -> Int
2;  Voice
Bass15va -> Int
2
  Voice
Soprano8vb  -> (-Int
1); Voice
Alto8vb  -> (-Int
1); Voice
Tenor8vb  -> (-Int
1); Voice
Bass8vb  -> (-Int
1)
  Voice
_ -> (-Int
2)   -- *15vb (voiceBase always yields a tier-0 constructor)

-------------------------------------------------------------------------------
-- clip (MIDI range enforcement — internal)
-------------------------------------------------------------------------------

-- | Drop any event whose note falls outside a MIDI range. Applied outermost by
-- 'Instrument', so it filters /after/ the octave shift.
clip :: (Int, Int) -> ControlPattern -> ControlPattern
clip :: (Int, Int) -> ControlPattern -> ControlPattern
clip (Int
lo, Int
hi) = (ValueMap -> Bool) -> ControlPattern -> ControlPattern
forall a. (a -> Bool) -> Pattern a -> Pattern a
filterValues (\ValueMap
vm ->
    case String -> ValueMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"note" ValueMap
vm of
        Just (VF Double
v) -> Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lo Bool -> Bool -> Bool
&& Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hi
        Just (VN Note
n) -> let v :: Double
v = Note -> Double
unNote Note
n in Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lo Bool -> Bool -> Bool
&& Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hi
        Maybe Value
_ -> Bool
True)

-------------------------------------------------------------------------------
-- instrument (internal helper)
-------------------------------------------------------------------------------

-- Pipeline: arrange -> # ch -> |+ oct -> clip (outermost, filters AFTER octave shift)
instrument :: (Int, Int) -> Int -> Layer -> (Double, Double) -> IK -> VoiceLines -> VoiceFunction -> Voice -> ControlPattern
instrument :: (Int, Int)
-> Int
-> Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
instrument (Int, Int)
range Int
channel Layer
lyr (Double, Double)
ki IK
k VoiceLines
vl VoiceFunction
vf Voice
v =
    (Int, Int) -> ControlPattern -> ControlPattern
clip (Int, Int)
range (ControlPattern -> ControlPattern)
-> ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$ (Double, Double)
-> IK
-> (Int, Int)
-> Layer
-> VoiceFunction
-> (Progression -> Progression)
-> [Pattern Int]
-> ControlPattern
arrange (Double, Double)
ki IK
k (-Int
9,Int
9) Layer
lyr VoiceFunction
vf (Int -> Progression -> Progression
overlapF Int
0) [Voice -> VoiceLines -> Pattern Int
vlGet Voice
v VoiceLines
vl] ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Int -> ControlPattern
ch Int
channel ControlPattern -> ControlPattern -> ControlPattern
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|+ Int -> ControlPattern
oct (Voice -> Int
voiceOct Voice
v)

-------------------------------------------------------------------------------
-- Pitched instruments (partial application of instrument)
-------------------------------------------------------------------------------

-- | Winds, channels 1&#8211;4.
--
-- Every pitched instrument takes a prepended 'Layer' argument — 'T' to voice
-- the triad layer (default harmonic behaviour), 'S' for the strata layer,
-- 'M' for the diatonic-mode layer:
--
-- @d1 $ flute T (0,1) k voiceLines flow Soprano [\"0 1 2 3\"]@
flute, oboe, clarinet, bassoon :: Layer -> (Double, Double) -> IK -> VoiceLines -> VoiceFunction -> Voice -> ControlPattern
flute :: Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
flute      = (Int, Int)
-> Int
-> Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
instrument (-Int
12, Int
26) Int
1   -- C3–D6  (MIDI 48–86)
oboe :: Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
oboe       = (Int, Int)
-> Int
-> Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
instrument ( -Int
2, Int
33) Int
2   -- Bb3–A6 (MIDI 58–93)
clarinet :: Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
clarinet   = (Int, Int)
-> Int
-> Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
instrument (-Int
22, Int
34) Int
3   -- D2–Bb6 (MIDI 38–92)
bassoon :: Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
bassoon    = (Int, Int)
-> Int
-> Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
instrument (-Int
28, Int
15) Int
4   -- Bb1–Eb5 (MIDI 32–75)

-- | Brass, channels 5&#8211;6. @basstrom@ shares channel 6 with @trombone@ at a
-- lower range.
horn, trombone, basstrom :: Layer -> (Double, Double) -> IK -> VoiceLines -> VoiceFunction -> Voice -> ControlPattern
horn :: Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
horn       = (Int, Int)
-> Int
-> Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
instrument (-Int
29, Int
17) Int
5   -- B1–F5  (MIDI 31–77)
trombone :: Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
trombone   = (Int, Int)
-> Int
-> Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
instrument (-Int
28, Int
17) Int
6   -- Bb1–F5 (MIDI 32–77)
basstrom :: Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
basstrom   = (Int, Int)
-> Int
-> Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
instrument (-Int
39, -Int
5) Int
6   -- A0–G3  (MIDI 21–55)

-- | Harp, channel 7. The widest range in the orchestra.
harp :: Layer -> (Double, Double) -> IK -> VoiceLines -> VoiceFunction -> Voice -> ControlPattern
harp :: Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
harp       = (Int, Int)
-> Int
-> Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
instrument (-Int
29, Int
42) Int
7   -- B1–F#7 (MIDI 31–102)

-- | Timpani, channel 8. Pitched percussion; the narrowest range.
timpani :: Layer -> (Double, Double) -> IK -> VoiceLines -> VoiceFunction -> Voice -> ControlPattern
timpani :: Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
timpani    = (Int, Int)
-> Int
-> Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
instrument (-Int
22,  Int
0) Int
8   -- D2–C4  (MIDI 38–60)

-- | Strings. All default to channel 16 (@arco@); prefix an articulation
-- ('pizz', 'spicc', 'marc', 'legg') to route elsewhere.
violin1, violin2, viola, cello, contrabass :: Layer -> (Double, Double) -> IK -> VoiceLines -> VoiceFunction -> Voice -> ControlPattern
violin1 :: Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
violin1    = (Int, Int)
-> Int
-> Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
instrument ( -Int
5, Int
45) Int
16  -- G3–A7  (MIDI 55–105)
violin2 :: Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
violin2    = (Int, Int)
-> Int
-> Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
instrument ( -Int
5, Int
45) Int
16  -- G3–A7  (MIDI 55–105)
viola :: Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
viola      = (Int, Int)
-> Int
-> Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
instrument (-Int
12, Int
28) Int
16  -- C3–E6  (MIDI 48–88)
cello :: Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
cello      = (Int, Int)
-> Int
-> Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
instrument (-Int
24, Int
24) Int
16  -- C2–C6  (MIDI 36–84)
contrabass :: Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
contrabass = (Int, Int)
-> Int
-> Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
instrument (-Int
36,  Int
0) Int
16  -- C1–C4  (MIDI 24–60)

-------------------------------------------------------------------------------
-- Unpitched percussion (struct-based)
-------------------------------------------------------------------------------

-- | Bass drum, channel 9. Struct-based: takes a boolean pattern rather than a
-- voice, since it is unpitched.
--
-- @d1 $ bassdrum \"t ~ ~ t\"@
bassdrum :: Pattern Bool -> ControlPattern
bassdrum :: Pattern Bool -> ControlPattern
bassdrum Pattern Bool
pat = Pattern Bool -> ControlPattern -> ControlPattern
forall a. Pattern Bool -> Pattern a -> Pattern a
struct Pattern Bool
pat (ControlPattern -> ControlPattern)
-> ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$ Pattern Note -> ControlPattern
midinote Pattern Note
36 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Int -> ControlPattern
ch Int
9 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
sustain Pattern Double
0.05

-- | Tam-tam, channel 11. Struct-based, with a long sustain.
tamtam :: Pattern Bool -> ControlPattern
tamtam :: Pattern Bool -> ControlPattern
tamtam Pattern Bool
pat = Pattern Bool -> ControlPattern -> ControlPattern
forall a. Pattern Bool -> Pattern a -> Pattern a
struct Pattern Bool
pat (ControlPattern -> ControlPattern)
-> ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$ Pattern Note -> ControlPattern
midinote Pattern Note
31 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Int -> ControlPattern
ch Int
11 ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
sustain Pattern Double
0.5

-------------------------------------------------------------------------------
-- String articulations (channel aliases)
-------------------------------------------------------------------------------

-- | String articulations, applied as a postfix channel override:
--
-- @, violin1 T (0,1) k vl flow Soprano # pizz@
--
-- @pizz@ 12, @spicc@ 13, @marc@ 14, @legg@ 15, @arco@ 16 (the string default).
pizz, spicc, marc, legg, arco :: ControlPattern
pizz :: ControlPattern
pizz  = Int -> ControlPattern
ch Int
12    -- pizzicato
spicc :: ControlPattern
spicc = Int -> ControlPattern
ch Int
13    -- spiccato
marc :: ControlPattern
marc  = Int -> ControlPattern
ch Int
14    -- marcato
legg :: ControlPattern
legg  = Int -> ControlPattern
ch Int
15    -- legato
arco :: ControlPattern
arco  = Int -> ControlPattern
ch Int
16    -- arco (same as default)

-------------------------------------------------------------------------------
-- Divisi
-------------------------------------------------------------------------------

-- | The shared shape of every orchestral instrument function.
type Instrument =
  Layer -> (Double, Double) -> IK -> VoiceLines -> VoiceFunction -> Voice -> ControlPattern

-- | Optional prefix wrapper: divide an instrument into @n@ desks, each reading
-- the next divisi tier of its voice (base, ' , ''), scaled by equal-power
-- @1\/sqrt n@ so the combined loudness matches the undivided line.
--
-- Used in the space form; drop @divisi n@ and the line is a normal single voice:
--
-- @, divisi 3 violin1 T (0,1) k vl grid Soprano@   — 3 desks: Soprano\/Soprano'/Soprano''
-- @, violin1 T (0,1) k vl grid Soprano@            — plain
--
-- Octave rides the 'Voice' argument, so @divisi 2 contrabass T (0.9,1) k vl grid Bass8vb@
-- voices Bass8vb and Bass8vb' (tier + octave together).
divisi :: Int -> Instrument -> Instrument
divisi :: Int
-> (Layer
    -> (Double, Double)
    -> IK
    -> VoiceLines
    -> VoiceFunction
    -> Voice
    -> ControlPattern)
-> Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
divisi Int
n Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
instr Layer
lyr (Double, Double)
rng IK
k VoiceLines
vl VoiceFunction
vf Voice
v =
  [ControlPattern] -> ControlPattern
forall a. [Pattern a] -> Pattern a
stack [ Layer
-> (Double, Double)
-> IK
-> VoiceLines
-> VoiceFunction
-> Voice
-> ControlPattern
instr Layer
lyr (Double, Double)
rng IK
k VoiceLines
vl VoiceFunction
vf (Int -> Voice -> Voice
forall {c} {a}. (Enum c, Enum a) => Int -> a -> c
primeN Int
i Voice
v) | Int
i <- [Int
0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ]
    ControlPattern -> ControlPattern -> ControlPattern
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|* Pattern Double -> ControlPattern
vel (Pattern Double
1 Pattern Double -> Pattern Double -> Pattern Double
forall a. Fractional a => a -> a -> a
/ Pattern Double -> Pattern Double
forall a. Floating a => a -> a
sqrt (Int -> Pattern Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))
  where primeN :: Int -> a -> c
primeN Int
i = Int -> c
forall a. Enum a => Int -> a
toEnum (Int -> c) -> (a -> Int) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
20) (Int -> Int) -> (a -> Int) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum   -- shift a base voice into tier i

-- | Equal-power volume scalers for hand-built desks that differ in articulation
-- or entry (not uniform 'divisi'). Postfix like the articulation tags — set
-- @amp@; the block's outer @|* vel d@ then multiplies, giving @d\/sqrt n@.
--
-- @, violin1 T (0,1)   k vl flow Soprano  # divisi2@
-- @, violin1 T (0.9,1) k vl grid Soprano' # divisi2@
divisi2, divisi3 :: ControlPattern
divisi2 :: ControlPattern
divisi2 = Pattern Double -> ControlPattern
vel (Pattern Double
1 Pattern Double -> Pattern Double -> Pattern Double
forall a. Fractional a => a -> a -> a
/ Pattern Double -> Pattern Double
forall a. Floating a => a -> a
sqrt Pattern Double
2)
divisi3 :: ControlPattern
divisi3 = Pattern Double -> ControlPattern
vel (Pattern Double
1 Pattern Double -> Pattern Double -> Pattern Double
forall a. Fractional a => a -> a -> a
/ Pattern Double -> Pattern Double
forall a. Floating a => a -> a
sqrt Pattern Double
3)