summaryrefslogtreecommitdiff
path: root/src/Csound/Catalog/Wave/Sharc.hs
blob: 49b90967037f97f960a2af38a3e0c8833dec4b53 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
module Csound.Catalog.Wave.Sharc(
    -- * Oscillators
    sharcOsc, sigSharcOsc, rndSharcOsc, rndSigSharcOsc,
    soloSharcOsc, orcSharcOsc, purePadSharcOsc, padSharcOsc,

    -- * Padsynth
    PadSharcSpec(..), padsynthSharcOsc, padsynthSharcOsc2,
    padsynthSharcOsc', padsynthSharcOsc2',

    -- * Instriments
    SharcInstr(..),
    shViolin, shViolinPizzicato, shViolinMuted, shViolinMarteleBowing, shViolinsEnsemble, shViola, shViolaPizzicato, shViolaMuted,
    shViolaMarteleBowing, shTuba, shTromboneMuted, shTrombone, shPiccolo, shOboe, shFrenchHornMuted, shFrenchHorn, shFlute,
    shEnglishHorn, shClarinetEflat, shTrumpetMutedC, shTrumpetC, shContrabassClarinet, shContrabassoon, shCello, shCelloPizzicato,
    shCelloMuted, shCelloMarteleBowing, shContrabassPizzicato, shContrabassMuted, shContrabassMarteleBowing, shContrabass,
    shClarinet, shBassTrombone, shBassClarinet, shBassoon, shBassFlute, shTrumpetBach, shAltoTrombone, shAltoFlute,

    -- * Low-level getters
    getInstrTab, note2sig, note2tab
) where

import qualified Sharc.Types as Sh
import qualified Sharc.Data as Sh
import Csound.Base
import Sharc.Types

note2sig :: Sh.Note -> Sig
note2sig n = oscBy (harmonics2tab $ Sh.noteHarmonics n) (sig $ double $ Sh.pitchFund $ Sh.notePitch n)

note2tab :: Sh.Note -> Tab
note2tab n = (harmonics2tab $ Sh.noteHarmonics n)

deg x = 180 * x / pi

harmonics2tab harmonics = sines3 $ fmap (\h -> (fromIntegral $ Sh.harmonicId h, Sh.harmonicAmplitude h, deg $ Sh.harmonicPhase h)) harmonics

-- | Get instrument wave table by midi pitch number.
getInstrTab :: SharcInstr -> Int -> Tab
getInstrTab (SharcInstr instr) n = note2tab $ Sh.instrNotes instr !! idx
    where
        ns = Sh.instrNotes instr
        keys = fmap (Sh.pitchKeyNum . Sh.notePitch) ns
        keyMin = minimum keys
        keyMax = maximum keys
        idx = (min (max keyMin n) keyMax - keyMin)

---------------------------------------------------------------------------
-- oscilliators

-- | Sharc oscillator
sharcOsc :: SharcInstr -> D -> Sig
sharcOsc instr cpsTab = sigSharcOsc instr cpsTab (sig cpsTab)

-- | Sharc oscillator with continuous pitch.
-- The second argument picks upth table by frequency
-- and the third supplies the frequency.
sigSharcOsc :: SharcInstr -> D -> Sig -> Sig
sigSharcOsc = genSharcOsc' oscBy 

-- | Sharc oscillator with randomized phase.
rndSharcOsc :: SharcInstr -> D -> SE Sig
rndSharcOsc instr cpsTab = rndSigSharcOsc instr cpsTab (sig cpsTab)

-- | Sharc oscillator with continuous pitch and randomized phase.
rndSigSharcOsc :: SharcInstr -> D -> Sig -> SE Sig
rndSigSharcOsc = genSharcOsc' rndOscBy 

genSharcOsc' :: (Tab -> Sig -> a) -> SharcInstr -> D -> Sig -> a
genSharcOsc' wave (SharcInstr instr) cps cpsSig = wave t cpsSig
    where
        t = fromTabListD tabs (cps2pitch cps - int keyMin)        

        tabs = tabList $ fmap note2tab ns

        ns = Sh.instrNotes instr
        keys = fmap (Sh.pitchKeyNum . Sh.notePitch) ns
        keyMin = minimum keys        

cps2pitch :: Floating a => a -> a
cps2pitch x =  69 + 12 * logBase 2 (x / 440)

---------------------------------------------------------------------------
-- patches

uni = multiHz 4 (cent 40)

-- | Plays a solo instrument
soloSharcOsc :: SharcInstr -> D -> SE Sig
soloSharcOsc instr cps = mul (fades 0.001 0.05) $ rndSharcOsc instr cps

-- | Plays a orchestrated instrument (with pitch chorus)
orcSharcOsc :: SharcInstr -> D -> SE Sig
orcSharcOsc instr cps = mul (fades 0.01 0.42) $ uni (rndSharcOsc instr . ir) (sig cps)

-- | Plays a solo instrument with pad-like envelope
purePadSharcOsc :: SharcInstr -> D -> SE Sig
purePadSharcOsc instr cps = mul (fades 0.65 0.75) $ rndSharcOsc instr cps

-- | Plays orchestrated instrument with pad-like envelope
padSharcOsc :: SharcInstr -> D -> SE Sig
padSharcOsc instr cps = mul (fades 0.65 0.75) $ uni (rndSharcOsc instr . ir) (sig cps)

---------------------------------------------------------------------------
-- padsynth

data PadSharcSpec = PadSharcSpec {
        padSharcBandwidth :: Double,
        padSharcSize      :: Int
    }

instance Default PadSharcSpec where
    def = PadSharcSpec 15 8

padsynthSharcOsc :: SharcInstr -> D -> SE Sig
padsynthSharcOsc = padsynthSharcOsc' def

padsynthSharcOsc2 :: SharcInstr -> D -> SE Sig2
padsynthSharcOsc2 = padsynthSharcOsc2' def

padsynthSharcOsc2' :: PadSharcSpec -> SharcInstr -> D -> SE Sig2
padsynthSharcOsc2' spec instr freq = padsynthOscMultiCps2 (getSpecIntervals spec instr) freq

padsynthSharcOsc' :: PadSharcSpec -> SharcInstr -> D -> SE Sig
padsynthSharcOsc' spec instr freq = padsynthOscMultiCps (getSpecIntervals spec instr) freq

getSpecIntervals spec (SharcInstr instr) = zip borderFreqs specs
    where 
        groups = splitTo (padSharcSize spec) (Sh.instrNotes instr)
        medians = fmap getMedian groups
        borders = fmap getBorder groups

        specs   = fmap (note2padsynth $ padSharcBandwidth spec) medians
        borderFreqs = fmap (Sh.pitchFund . Sh.notePitch) borders


splitTo :: Int -> [a] -> [[a]]
splitTo n as = go size as
    where 
        size = max 1 (length as `div` n)

        go :: Int -> [a] -> [[a]]
        go n bs
            | null ys   = [xs]
            | otherwise = xs : go n ys
            where
                (xs, ys) = splitAt n bs

getMedian :: [a] -> a
getMedian as
    | null as   = error "getMedian: Csound.Catalog.Wave.Sharc.hs empty list"
    | otherwise = as !! (length as `div` 2)

getBorder :: [a] -> a
getBorder as
    | null as   = error "getMedian: Csound.Catalog.Wave.Sharc.hs empty list"
    | otherwise = last as

note2padsynth :: Double -> Sh.Note -> PadsynthSpec
note2padsynth bandwidth note = (defPadsynthSpec bandwidth normAmps) { padsynthFundamental = Sh.pitchFund (Sh.notePitch note) }
    where 
        normAmps = fmap ( / maxAmp) amps
        amps = fmap Sh.harmonicAmplitude $ Sh.noteHarmonics note
        maxAmp = maximum amps


toStereoOsc :: (a -> SE Sig) -> (a -> SE Sig2)
toStereoOsc f x = do
    left  <- f x
    right <- f x
    return (left, right)

---------------------------------------------------------------------------
-- sharc instr

newtype SharcInstr = SharcInstr { unSharcInstr :: Sh.Instr }

shViolin :: SharcInstr
shViolin = SharcInstr Sh.violin

shViolinPizzicato :: SharcInstr
shViolinPizzicato = SharcInstr Sh.violinPizzicato

shViolinMuted :: SharcInstr
shViolinMuted = SharcInstr Sh.violinMuted

shViolinMarteleBowing :: SharcInstr
shViolinMarteleBowing = SharcInstr Sh.violinMarteleBowing

shViolinsEnsemble :: SharcInstr
shViolinsEnsemble = SharcInstr Sh.violinsEnsemble

shViola :: SharcInstr
shViola = SharcInstr Sh.viola

shViolaPizzicato :: SharcInstr
shViolaPizzicato = SharcInstr Sh.violaPizzicato

shViolaMuted :: SharcInstr
shViolaMuted = SharcInstr Sh.violaMuted

shViolaMarteleBowing :: SharcInstr
shViolaMarteleBowing = SharcInstr Sh.violaMarteleBowing

shTuba :: SharcInstr
shTuba = SharcInstr Sh.tuba

shTromboneMuted :: SharcInstr
shTromboneMuted = SharcInstr Sh.tromboneMuted

shTrombone :: SharcInstr
shTrombone = SharcInstr Sh.trombone

shPiccolo :: SharcInstr
shPiccolo = SharcInstr Sh.piccolo

shOboe :: SharcInstr
shOboe = SharcInstr Sh.oboe

shFrenchHornMuted :: SharcInstr
shFrenchHornMuted = SharcInstr Sh.frenchHornMuted

shFrenchHorn :: SharcInstr
shFrenchHorn = SharcInstr Sh.frenchHorn

shFlute :: SharcInstr
shFlute = SharcInstr Sh.flute

shEnglishHorn :: SharcInstr
shEnglishHorn = SharcInstr Sh.englishHorn

shClarinetEflat :: SharcInstr
shClarinetEflat = SharcInstr Sh.clarinetEflat

shTrumpetMutedC :: SharcInstr
shTrumpetMutedC = SharcInstr Sh.trumpetMutedC

shTrumpetC :: SharcInstr
shTrumpetC = SharcInstr Sh.trumpetC

shContrabassClarinet :: SharcInstr
shContrabassClarinet = SharcInstr Sh.contrabassClarinet

shContrabassoon :: SharcInstr
shContrabassoon = SharcInstr Sh.contrabassoon

shCello :: SharcInstr
shCello = SharcInstr Sh.cello

shCelloPizzicato :: SharcInstr
shCelloPizzicato = SharcInstr Sh.celloPizzicato

shCelloMuted :: SharcInstr
shCelloMuted = SharcInstr Sh.celloMuted

shCelloMarteleBowing :: SharcInstr
shCelloMarteleBowing = SharcInstr Sh.celloMarteleBowing

shContrabassPizzicato :: SharcInstr
shContrabassPizzicato = SharcInstr Sh.contrabassPizzicato

shContrabassMuted :: SharcInstr
shContrabassMuted = SharcInstr Sh.contrabassMuted

shContrabassMarteleBowing :: SharcInstr
shContrabassMarteleBowing = SharcInstr Sh.contrabassMarteleBowing

shContrabass :: SharcInstr
shContrabass = SharcInstr Sh.contrabass

shClarinet :: SharcInstr
shClarinet = SharcInstr Sh.clarinet

shBassTrombone :: SharcInstr
shBassTrombone = SharcInstr Sh.bassTrombone

shBassClarinet :: SharcInstr
shBassClarinet = SharcInstr Sh.bassClarinet

shBassoon :: SharcInstr
shBassoon = SharcInstr Sh.bassoon

shBassFlute :: SharcInstr
shBassFlute = SharcInstr Sh.bassFlute

shTrumpetBach :: SharcInstr
shTrumpetBach = SharcInstr Sh.trumpetBach

shAltoTrombone :: SharcInstr
shAltoTrombone = SharcInstr Sh.altoTrombone

shAltoFlute :: SharcInstr
shAltoFlute = SharcInstr Sh.altoFlute