hsc3 0.20 → 0.21

raw patch · 137 files changed

+12574/−10414 lines, 137 filesdep ~hoscPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hosc

API changes (from Hackage documentation)

Files

• Help/Graph/f0-tw0028.hs +2/−2
• Help/Graph/jl-bitwise.hs +1/−1
• Help/Graph/jmcc-bowed-string.hs +1/−3
• Help/Ugen/bPeakEQ.help.hs +1/−1
• Help/Ugen/bufDur.help.hs +2/−2
• Help/Ugen/bufFrames.help.hs +2/−2
• Help/Ugen/bufGrain.help.hs +1/−1
• Help/Ugen/bufRateScale.help.hs +4/−4
• Help/Ugen/bufRd.help.hs +3/−3
• Help/Ugen/bufSampleRate.help.hs +1/−1
• Help/Ugen/concat.help.hs +1/−1
• Help/Ugen/control.hs +13/−0
• Help/Ugen/dx7.help.hs +7/−7
• Help/Ugen/fm7.help.hs +22/−5
• Help/Ugen/formlet.help.hs +0/−1
• Help/Ugen/freezer.help.hs +14/−13
• Help/Ugen/grainBuf.help.hs +3/−3
• Help/Ugen/grainSin.help.hs +1/−1
• Help/Ugen/max.help.hs +9/−1
• Help/Ugen/membraneHexagon.help.hs +2/−2
• Help/Ugen/miBraids.help.hs +1/−1
• Help/Ugen/miClouds.help.hs +4/−4
• Help/Ugen/miPlaits.help.hs +3/−6
• Help/Ugen/miTides.help.hs +3/−3
• Help/Ugen/phasor.help.hs +2/−2
• Help/Ugen/playBuf.help.hs +7/−7
• Help/Ugen/playBufCF.help.hs +2/−2
• Help/Ugen/pv_BinBufRd.help.hs +1/−1
• Help/Ugen/pv_BinScramble.help.hs +1/−1
• Help/Ugen/pv_Diffuser.help.hs +1/−1
• Help/Ugen/pv_MagFreeze.help.hs +1/−1
• Help/Ugen/pv_SpectralMap.help.hs +1/−1
• Help/Ugen/rSmplrIndex.help.hs +2/−2
• Help/Ugen/radiansPerSample.help.hs +2/−1
• Help/Ugen/select.help.hs +1/−1
• Help/Ugen/shufflerB.help.hs +5/−5
• Help/Ugen/sinOsc.help.hs +0/−3
• Help/Ugen/squiz.help.hs +1/−1
• Help/Ugen/stkInst.help.hs +1/−1
• Help/Ugen/sweep.help.hs +3/−3
• Help/Ugen/tGrains.help.hs +6/−6
• Help/Ugen/warp1.help.hs +2/−2
• README.md +41/−33
• Sound/Sc3.hs +3/−2
• Sound/Sc3/Common/Base.hs +174/−114
• Sound/Sc3/Common/Base/System.hs +2/−1
• Sound/Sc3/Common/Buffer.hs +145/−103
• Sound/Sc3/Common/Buffer/Array.hs +8/−8
• Sound/Sc3/Common/Buffer/Gen.hs +56/−36
• Sound/Sc3/Common/Buffer/Vector.hs +8/−8
• Sound/Sc3/Common/Context.hs +35/−33
• Sound/Sc3/Common/Enum.hs +45/−41
• Sound/Sc3/Common/Envelope.hs +313/−282
• Sound/Sc3/Common/Help.hs +130/−36
• Sound/Sc3/Common/Help/Sc2.hs +228/−171
• Sound/Sc3/Common/Math.hs +551/−351
• Sound/Sc3/Common/Math/Filter.hs +52/−46
• Sound/Sc3/Common/Math/Filter/Beq.hs +28/−25
• Sound/Sc3/Common/Math/Interpolate.hs +64/−53
• Sound/Sc3/Common/Math/Noise.hs +19/−15
• Sound/Sc3/Common/Math/Operator.hs +281/−250
• Sound/Sc3/Common/Math/Warp.hs +36/−26
• Sound/Sc3/Common/Math/Window.hs +3/−3
• Sound/Sc3/Common/Mce.hs +53/−38
• Sound/Sc3/Common/Monad.hs +5/−2
• Sound/Sc3/Common/Monad/Operators.hs +95/−53
• Sound/Sc3/Common/Random.hs +4/−3
• Sound/Sc3/Common/Rate.hs +26/−24
• Sound/Sc3/Common/SoundFile.hs +2/−3
• Sound/Sc3/Common/Uid.hs +14/−14
• Sound/Sc3/Fd.hs +3/−2
• Sound/Sc3/Server.hs +6/−5
• Sound/Sc3/Server/Command.hs +1/−0
• Sound/Sc3/Server/Command/Completion.hs +19/−61
• Sound/Sc3/Server/Command/Enum.hs +130/−124
• Sound/Sc3/Server/Command/Generic.hs +194/−177
• Sound/Sc3/Server/Command/Plain.hs +61/−52
• Sound/Sc3/Server/Command/Plain/Completion.hs +69/−0
• Sound/Sc3/Server/Enum.hs +66/−51
• Sound/Sc3/Server/Graphdef.hs +128/−88
• Sound/Sc3/Server/Graphdef/Binary.hs +32/−27
• Sound/Sc3/Server/Graphdef/Graph.hs +34/−33
• Sound/Sc3/Server/Graphdef/Io.hs +2/−2
• Sound/Sc3/Server/Graphdef/Read.hs +32/−29
• Sound/Sc3/Server/Graphdef/Text.hs +28/−16
• Sound/Sc3/Server/Nrt.hs +24/−20
• Sound/Sc3/Server/Nrt/Edit.hs +12/−10
• Sound/Sc3/Server/Nrt/Render.hs +33/−20
• Sound/Sc3/Server/Nrt/Stat.hs +14/−12
• Sound/Sc3/Server/Nrt/Ugen.hs +45/−23
• Sound/Sc3/Server/Options.hs +68/−54
• Sound/Sc3/Server/Param.hs +23/−18
• Sound/Sc3/Server/Recorder.hs +74/−55
• Sound/Sc3/Server/Scsynth.hs +2/−3
• Sound/Sc3/Server/Status.hs +98/−88
• Sound/Sc3/Server/Synthdef.hs +19/−17
• Sound/Sc3/Server/Transport/Fd.hs +73/−50
• Sound/Sc3/Server/Transport/Monad.hs +175/−115
• Sound/Sc3/Ugen/Analysis.hs +24/−24
• Sound/Sc3/Ugen/Bindings.hs +3/−2
• Sound/Sc3/Ugen/Bindings/Composite.hs +173/−144
• Sound/Sc3/Ugen/Bindings/Composite/External.hs +101/−96
• Sound/Sc3/Ugen/Bindings/Db.hs +3039/−2670
• Sound/Sc3/Ugen/Bindings/Db/External.hs +3538/−3057
• Sound/Sc3/Ugen/Bindings/Hw.hs +24/−22
• Sound/Sc3/Ugen/Bindings/Hw/Construct.hs +3/−3
• Sound/Sc3/Ugen/Bindings/Hw/External/F0.hs +4/−4
• Sound/Sc3/Ugen/Bindings/Hw/External/Sc3_Plugins.hs +44/−18
• Sound/Sc3/Ugen/Bindings/Hw/External/Wavelets.hs +6/−7
• Sound/Sc3/Ugen/Bindings/Hw/External/Zita.hs +17/−16
• Sound/Sc3/Ugen/Bracketed.hs +10/−8
• Sound/Sc3/Ugen/Brackets.hs +3/−2
• Sound/Sc3/Ugen/Constant.hs +20/−6
• Sound/Sc3/Ugen/Control.hs +28/−22
• Sound/Sc3/Ugen/Enum.hs +4/−5
• Sound/Sc3/Ugen/Envelope.hs +14/−14
• Sound/Sc3/Ugen/Event.hs +105/−88
• Sound/Sc3/Ugen/Graph.hs +314/−273
• Sound/Sc3/Ugen/Graph/Reconstruct.hs +85/−78
• Sound/Sc3/Ugen/Graph/Transform.hs +50/−45
• Sound/Sc3/Ugen/Help/Graph.hs +61/−57
• Sound/Sc3/Ugen/Hs.hs +145/−115
• Sound/Sc3/Ugen/Math.hs +6/−6
• Sound/Sc3/Ugen/Math/Composite.hs +15/−11
• Sound/Sc3/Ugen/Mce.hs +3/−3
• Sound/Sc3/Ugen/Mrg.hs +4/−4
• Sound/Sc3/Ugen/Name.hs +46/−28
• Sound/Sc3/Ugen/Optimise.hs +51/−33
• Sound/Sc3/Ugen/Plain.hs +16/−12
• Sound/Sc3/Ugen/Pp.hs +12/−12
• Sound/Sc3/Ugen/Primitive.hs +10/−10
• Sound/Sc3/Ugen/Proxy.hs +4/−4
• Sound/Sc3/Ugen/Types.hs +1/−1
• Sound/Sc3/Ugen/Ugen.hs +381/−304
• Sound/Sc3/Ugen/Util.hs +124/−147
• emacs/hsc3.el +54/−23
• hsc3.cabal +6/−5

@@ -1,6 +1,6 @@ -- http://www.fredrikolofsson.com/f0blog/?q=node/537 (f0) ; slow to start... let fib = 0 : scanl (+) 1 fib-    sc3_fib k = take k (tail fib)+    sc3_fib k = take k (drop 1 fib)     n = map ((* 99) . (`mod` 8)) (sc3_fib 16)     p = dseq dinf (dshuf 8 (mce (map fromInteger n)))     q = combN (duty ar (1/8) 0 DoNothing p) 4 4 16@@ -10,7 +10,7 @@  -- http://www.fredrikolofsson.com/f0blog/?q=node/537 (f0) ; slow to start... ; id let fib = 0 : scanl (+) 1 fib-    sc3_fib k = take k (tail fib)+    sc3_fib k = take k (drop 1 fib)     n = map ((* 99) . (`mod` 8)) (sc3_fib 16)     p = dseqId 'α' dinf (dshufId 'β' 8 (mce (map fromInteger n)))     q = combN (duty ar (1/8) 0 DoNothing p) 4 4 16

@@ -1,7 +1,7 @@ -- bitwise ; a0f253ff89f6b244ea29a1e431dd9e5df5571a8b (jl) let t = pulseCount (impulse ar 8e3 0) 0     s = ((((t * 15) .&. (t .>>. 5)) .|.-          ((t *  5) .&. (t .>>. (mce2 3 4))) .|.+          ((t *  5) .&. (mce2 (t .>>. 3) (t .>>. 4))) .|.           ((t *  2) .&. (t .>>. 9)) .|.           ((t *  8) .&. (t .>>. 11))) - 3) `modE` 256 in tanh (hpf (((s / 127) - 1) * 3) 20) * 0.02

@@ -29,13 +29,12 @@   return (softClip (k * 0.1)))  -- bowed string (jmcc) ; event control-let f (_,g,x,y,z,_,_,_,p,_,_) =+let f (_,g,_,y,z,_,_,_,p,_,_) =       let n0 = mce2 (brownNoise ar) (brownNoise ar)           r0 = expRand 0.125 0.5           r1 = rand 0.7 0.9           r2 = X.randN 12 1.0 3.0           fq = unitCps p-          n1 = lfNoise1 kr r0           exc = n0 * 0.005 * z * lagUD g (y * 0.1) (y * 4)           geom n i m = mce (take n (iterate (* m) i))           iota n i m = mce (take n (iterate (+ m) i))@@ -50,7 +49,6 @@           r1 = randId (c,'δ') 0.7 0.9           r2 = X.randNId 12 (c,'ε') 1.0 3.0           fq = unitCps p-          n1 = lfNoise1Id (c,'ζ') kr r0           exc = n0 * 0.005 * z * lagUD g (y * 0.1) (y * 4)           geom n i m = mce (take n (iterate (* m) i))           iota n i m = mce (take n (iterate (+ m) i))

@@ -14,7 +14,7 @@ let i = pinkNoiseId 'α' ar * 0.1     freq = mouseX kr 2200 18000 Exponential 0.2     rq = mouseY kr 10 0.4 Linear 0.2-    (a0, a1, a2, b1, b2) = Sound.Sc3.Common.Math.Filter.Beq.bPeakEQCoef sampleRate freq rq 6+    (a0, a1, a2, b1, b2) = Sound.Sc3.Common.Math.Filter.Beq.bPeakEqCoef sampleRate freq rq 6 in sos i a0 a1 a2 b1 b2 * 0.5  -- bPeakEQ ; parametric

@@ -1,11 +1,11 @@ -- bufDur ; requires=buf ; read without loop, trigger reset based on buffer duration-let (b, nc) = (control kr "buf" 0, 2)+let (b, nc) = (control kr "buf" 100, 2)     t = impulse ar (recip (bufDur kr b)) 0     p = sweep ar t (bufSampleRate kr b) in bufRd nc ar b p NoLoop LinearInterpolation * 0.1  -- bufDur ; requires=buf ; bufDur = bufFrames / bufSampleRate-let (b, nc) = (control kr "buf" 0, 2)+let (b, nc) = (control kr "buf" 100, 2)     t = impulse ar (bufSampleRate kr b / bufFrames kr b) 0     p = sweep ar t (bufSampleRate kr b) in bufRd nc ar b p NoLoop LinearInterpolation * 0.1

@@ -1,10 +1,10 @@ -- bufFrames ; requires=buf ; read without loop, trigger reset based on buffer duration-let (b, nc) = (control kr "buf" 0, 2)+let (b, nc) = (control kr "buf" 100, 2)     p = phasor ar 0 (bufRateScale kr b) 0 (bufFrames kr b) 0 in bufRdL nc ar b p NoLoop * 0.1  -- bufFrames ; requires=buf ; mouse location drags play head-let (b, nc) = (control kr "buf" 0, 2)+let (b, nc) = (control kr "buf" 100, 2)     r = mce [0.05, 0.075 .. 0.15]     p = k2a (mouseX kr 0 (bufFrames kr b) Linear r) in mix (bufRdL nc ar b p NoLoop) * 0.1

@@ -1,5 +1,5 @@ -- bufGrain ; requires=buf-let b = control kr "buf" 0+let b = control kr "buf" 100     x = mouseX kr 0.5 8 Linear 0.2     y = mouseY kr 0.05 0.2 Linear 0.2     e = envGen kr 1 1 0 1 RemoveSynth (envelope [0, 1, 0] [3, 2] [EnvSin, EnvSin])

@@ -1,23 +1,23 @@ -- bufRateScale ; requires=buf ; read without loop, trigger reset based on buffer duration-let b = control kr "buf" 0+let b = control kr "buf" 100     r = bufRateScale kr b     p = phasor ar 0 r 0 (bufFrames kr b) 0 in bufRdL 1 ar b p NoLoop * 0.5  -- bufRateScale ; requires=buf ; read buffer at ~ 3/4 reported sample rate-let b = control kr "buf" 0+let b = control kr "buf" 100     r = midiRatio (-5) * bufRateScale kr b     p = phasor ar 0 r 0 (bufFrames kr b) 0 in bufRdL 1 ar b p NoLoop * 0.5  -- bufRateScale ; requires=buf ; bufRateScale = bufSampleRate / sampleRate-let b = control kr "buf" 0+let b = control kr "buf" 100     r = midiRatio (-5) * (bufSampleRate kr b / sampleRate)     p = phasor ar 0 r 0 (bufFrames kr b) 0 in bufRdL 1 ar b p NoLoop * 0.5  -- bufRateScale ; requires=buf ; bufRateScale = bufSampleRate * sampleDur-let b = control kr "buf" 0+let b = control kr "buf" 100     r = midiRatio (-5) * (bufSampleRate kr b * sampleDur)     p = phasor ar 0 r 0 (bufFrames kr b) 0 in bufRdL 1 ar b p NoLoop * 0.5

@@ -1,16 +1,16 @@ -- bufRd ; requires=buf ; phasor as phase input ; constructors bufRd{N|L|C} preset interpolation type-let (buf, nc) = (control kr "buf" 0, 2)+let (buf, nc) = (control kr "buf" 100, 2)     tr = impulse ar (recip (bufDur kr buf)) 0     ph = phasor ar tr (bufRateScale kr buf) 0 (bufFrames kr buf) 0 in bufRdL nc ar buf ph NoLoop  -- bufRd ; requires=buf ; audio rate sine oscillator as phase input-let (buf, nc) = (control kr "buf" 0, 2)+let (buf, nc) = (control kr "buf" 100, 2)     phase = sinOsc ar 0.1 0 * bufFrames kr buf * bufRateScale kr buf in bufRdL nc ar buf phase Loop  -- bufRd ; requires=buf ; mouse control-let (buf, nc) = (control kr "buf" 0, 2)+let (buf, nc) = (control kr "buf" 100, 2)     x = mouseX kr (mce [5, 10]) 100 Linear 0.1     n = lfNoise1Id 'α' ar x in mix (bufRdL nc ar buf (n * bufFrames kr buf * bufRateScale kr buf) Loop)

@@ -1,5 +1,5 @@ -- bufSampleRate ; requires=buf ; frequency as fraction of buffer sample-rate (ie. 48000 / 100 == 480)-let b = control kr "buf" 0+let b = control kr "buf" 100     f = mce [bufSampleRate kr b * 0.01, 440] in sinOsc ar f 0 * 0.1 

@@ -1,5 +1,5 @@ -- concat ; requires=buf ; granulator-let (b, nc) = (control kr "buf" 0, 2)+let (b, nc) = (control kr "buf" 100, 2)     y0 = mouseY kr 0.01 1 Linear 0.2     y1 = mouseY kr b 100 Linear 0.2     n = lfNoise0Id 'α' kr y0 * 3 + 4.5

@@ -1,4 +1,7 @@ -- control+out 0 (sinOsc ar (control kr "freq" 440) 0 * 0.1)++-- control sinOsc ar (control kr "freq" 440) 0 * control kr "amp" 0.1  -- control ; ir and kr and tr controls ; setting amp also triggers an envelope@@ -29,3 +32,13 @@  ---- ; command list ui to send messages to set oscillator frequency UI.ui_scsynth_command_list (map (\x -> n_set 1 [("freq1",55 * (x ** 2)),("amp1",0.1 * (1 / x))]) [1 .. 7])++---- ; control ; printing+ugen_dump_ugens (out 0 (sinOsc ar (control kr "freq" 440) 0 * 0.1))++---- ; control ; encoding+import qualified Data.ByteString.Lazy as L+L.unpack (synthdefData (Synthdef "LocalControls" (out 0 (sinOsc ar (control kr "freq" 440) 0 * 0.1))))++-- ; control ; printing+putStrLn $ synthstat (out 0 (sinOsc ar (control kr "freq" 440) 0 * 0.1))

@@ -29,11 +29,11 @@                ,[99,99,99,99,50,50,50,50,3,2,1,29,99,1,0,0,0,1,24]]           buf = asLocalBufId 'ε' (map constant (concat vc))           x0 = latch x g-      in pan2 (X.dx7 ar buf g 0 0 0 (p * 127) z (0x2000 * (x - x0)) 0 0 0) (o * 2 - 1) 1+      in pan2 (X.dx7 ar buf g 0 0 0 (p * 100) z (0x2000 * (x - x0)) 0 0 0) (o * 2 - 1) 1 in mix (voicer 16 f) * control kr "gain" 1  -- dx7 ; data at shared buffer ; external control-let buf = control kr "dat" 100+let buf = control kr "dat" 400     gate_ = control kr "gate" 0     reset = control kr "reset" 0     data_ = control kr "data" 0@@ -48,7 +48,7 @@  -- dx7 ; data at shared buffer let nv = 32 -- 221-    buf = control kr "dat" 100+    buf = control kr "dat" 400     tr = dustId 'α' kr 2.0     gate_ = toggleFF tr     reset_ = 0@@ -61,7 +61,7 @@  -- dx7 ; event control ; data at shared buffer let f (_,g,x,_,z,o,_,_,p,_,_) =-      let buf = control kr "buf" 100+      let buf = control kr "buf" 400           vc = control_m kr "vc" 0 (0,31,"lin")           x0 = latch x g           pw = 0x2000 * (1 + (x - x0) * 2)@@ -72,18 +72,18 @@ ---- ; send init voice import qualified Sound.Sc3.Data.Yamaha.DX7 as DX7 {- hsc3-data -} import qualified Sound.Sc3.Data.Yamaha.DX7.Sc3 as DX7 {- hsc3-data -}-DX7.dx7_sc3_data_load 100 [DX7.dx7_init_voice]+DX7.dx7_sc3_data_load 400 [DX7.dx7_init_voice]  ---- ; load patch data from .hex.text file hex_fn = "/home/rohan/uc/the-center-is-between-us/trees/text/dx7/tc.hex.text" v <- DX7.dx7_load_hex hex_fn-DX7.dx7_sc3_data_load 100 v+DX7.dx7_sc3_data_load 400 v length v == 221  ---- ; load patch data from .syx sysex file syx_fn = "/home/rohan/sw/hsc3-data/data/yamaha/dx7ii/rom/DX7II-32A.syx" bnk <- DX7.dx7_load_fmt9_sysex_err syx_fn-DX7.dx7_sc3_data_load 100 bnk+DX7.dx7_sc3_data_load 400 bnk length bnk == 32  ---- ; send external control messages

@@ -1,12 +1,29 @@--- fm7 ; two of six-let c = [[xLine kr 300 310 4 DoNothing,0,1]-        ,[xLine kr 300 310 8 DoNothing,0,1]+-- fm7 ; two of six ; direct form+let c = mce [xLine kr 300 310 4 DoNothing,0,1+            ,xLine kr 300 310 8 DoNothing,0,1+            ,0,0,1+            ,0,0,1+            ,0,0,1+            ,0,0,1]+    m = mce [line kr 0 0.001 2 DoNothing,line kr 0.1 0 4 DoNothing,0,0,0,0+            ,line kr 0 6 1 DoNothing,0,0,0,0,0+            ,0,0,0,0,0,0+            ,0,0,0,0,0,0+            ,0,0,0,0,0,0+            ,0,0,0,0,0,0]+    [l,r,_,_,_,_] = mceChannels (X.fm7 ar c m)+in mce2 l r * 0.1++-- fm7 ; two of six ; matrix form ; inputs may be audio or control or initialization rate+let rt = ar+    c = [[xLine rt 300 310 4 DoNothing,0,1]+        ,[xLine rt 300 310 8 DoNothing,0,1]         ,[0,0,1]         ,[0,0,1]         ,[0,0,1]         ,[0,0,1] ]-    m = [[line kr 0 0.001 2 DoNothing,line kr 0.1 0 4 DoNothing,0,0,0,0]-        ,[line kr 0 6 1 DoNothing,0,0,0,0,0]+    m = [[line rt 0 0.001 2 DoNothing,line rt 0.1 0 4 DoNothing,0,0,0,0]+        ,[line rt 0 6 1 DoNothing,0,0,0,0,0]         ,[0,0,0,0,0,0]         ,[0,0,0,0,0,0]         ,[0,0,0,0,0,0]

@@ -28,4 +28,3 @@       let s = blip ar (sinOsc kr 5 0 * 20 * constant (c + 1) + 300) (2000 * rx)       in pan2 (formlet s (linExp y 0 1 700 2000) 0.005 (linExp x 0 1 0.01 0.2)) (o * 2 - 1) (g * z) in mix (voicer 16 f) * control kr "gain" 1-

@@ -1,50 +1,50 @@ -- freezer ; check buffer-let b = control kr "buf" 0+let b = control kr "buf" 100     s = bufRateScale kr b in playBuf 1 ar b s 1 0 NoLoop RemoveSynth * 0.1  -- freezer ; static instance-let b = control kr "buf" 0+let b = control kr "buf" 100 in X.freezer b 0.35 0.4 0.6 0.1 0.05 0.02 0.1 0 0 6  -- freezer ; static instance-let b = control kr "buf" 0+let b = control kr "buf" 100 in X.freezer b 0.3 0.4 0.6 1 0 0 0 0 0 6  -- freezer ; static instance-let b = control kr "buf" 0+let b = control kr "buf" 100 in X.freezer b 0.3 0.7 0.6 0.35 0 0.5 0.5 0 0 6  -- freezer ; static instance-let b = control kr "buf" 0+let b = control kr "buf" 100 in X.freezer b 0.2500 0.2505 0.1 1 0 0.050 0.005 0 0 24  -- freezer ; k-rate instance-let b = control kr "buf" 0+let b = control kr "buf" 100     n f i j = linLin (lfNoise2 kr f) (-1) 1 i j     left = n 1 0.3 0.8     right = left + n 1 0.01 0.05 in X.freezer b left right 0.1 0.5 0.1 0.5 0.05 0 0 24  -- freezer ; k-rate instance ; id-let b = control kr "buf" 0+let b = control kr "buf" 100     nId z f i j = linLin (lfNoise2Id z kr f) (-1) 1 i j     left = nId 'α' 1 0.3 0.8     right = left + nId 'β' 1 0.01 0.05 in X.freezer b left right 0.1 0.5 0.1 0.5 0.05 0 0 24  -- freezer ; k-rate instance-let b = control kr "buf" 0+let b = control kr "buf" 100     n i j = linLin (lfNoise2 kr 0.1) (-1) 1 i j in X.freezer b (n 0.3 0.4) (n 0.5 0.6) (n 0.3 0.6) (n 0.95 1.05) (n 0.05 0.15) (n 0.05 0.15) (n 0.05 0.15) 0 0 36  -- freezer ; k-rate instance ; id-let b = control kr "buf" 0+let b = control kr "buf" 100     nId z i j = linLin (lfNoise2Id z kr 0.1) (-1) 1 i j in X.freezer b (nId 'α' 0.3 0.4) (nId 'β' 0.5 0.6) (nId 'γ' 0.3 0.6) (nId 'δ' 0.95 1.05) (nId 'ε' 0.05 0.15) (nId 'ζ' 0.05 0.15) (nId 'η' 0.05 0.15) 0 0 36  -- freezer ; controls-let b = control_m kr "buf" 0 (0,0,"lin")+let b = control_m kr "buf" 100 (0,0,"lin")     (lhs,rhs) = control_rng kr "wnd" (0,1) (0,1,"lin")     amp = control_m kr "amp" 0.1 (0,1,"amp")     incr = control_m kr "incr" 1 (0,4,"lin")@@ -56,8 +56,9 @@     dgr = control_m kr "numLp" 24 (1,64,"lin") in X.freezer b lhs rhs amp incr incrO incrR wndR syncPh randPh dgr ----- ; allocate buffer 0, required for examples-ld fn = withSc3 (async (b_allocRead 0 (sfResolve fn) 0 0))+---- ; allocate buffer 100, required for examples+import Sound.Sc3.Server.Command.MemCpy {- sc3-rdu -}+ld fn = b_allocReadOrSend 100 (sfResolve fn) 0 0 >>= (withSc3 . async) ld "instr/crotales/crotale05(D).wav" ld "saron-panerus-S-0-5.flac" ld "saron-panerus-S-0-6.flac"@@ -75,5 +76,5 @@  Create a set of concurrent loops at a signal buffer.  This is the dynamic and gestural variant of RLoopSet.  It was written after-reading the manual for the GRM ToolsId 'Freeze' plugin.+reading the manual for the Grm Tools 'Freeze' plugin. -}

@@ -1,5 +1,5 @@ -- grainBuf ; requires=buf-let (buf, nc) = (control kr "buf" 0, 2)+let (buf, nc) = (control kr "buf" 100, 2)     dur = 15     lin a b = line kr a b dur RemoveSynth     tr = impulse kr (lin 7.5 15) 0@@ -10,7 +10,7 @@ in grainBuf nc tr gd buf r i 2 l (-1) 512 * control kr "gain" 0.25  -- grainBuf ; requires=buf ; mouse control-let (buf, nc) = (control kr "buf" 0, 2)+let (buf, nc) = (control kr "buf" 100, 2)     e = -1     x = mouseX kr (-1) 1 Linear 0.1     y = mouseY kr 10 45 Linear 0.1@@ -21,7 +21,7 @@  -- grainBuf ; requires=buf ; event control let f (_,g,x,y,z,o,rx,ry,_,_,_) =-      let (buf, nc) = (control kr "buf" 0, 2)+      let (buf, nc) = (control kr "buf" 100, 2)           e = -1           tr = impulse ar (y * 60 + 10) 0       in grainBuf nc tr (ry * 0.5) buf (1 + (rx * 0.1)) x 2 o e 512 * z * g

@@ -20,7 +20,7 @@       in grainSin 2 tr du (midiCps ((p * 127) + (ry * 2 - 1))) (o * 2 - 1) (-1) 512 * z * g in mix (voicer 16 f) * control kr "gain" 1 --- grainsin ; mouse control+-- grainSin ; mouse control let overlap = mouseY kr 0 2 Linear 0.2     f = mouseX kr 1 220 Linear 0.2 in grainSin 2 (impulse ar f 0) (overlap / f) 440 0 (-1) 512 * 0.1

@@ -1,2 +1,10 @@ -- max-(fSinOsc ar 500 0 `max` fSinOsc ar 0.1 0) * 0.1+(sinOsc ar 500 0 `max` sinOsc ar 0.1 0) * 0.1++-- max ; rate selection ; derive from left+let f = (sinOsc ar 0.2 0 `max` sinOsc kr 0.9 0) * 200 + 300+in sinOsc ar f 0 * 0.1++-- max ; rate selection ; derive from right+let f = (sinOsc kr 0.2 0 `max` sinOsc ar 0.9 0) * 200 + 300+in sinOsc ar f 0 * 0.1

@@ -5,10 +5,10 @@     ex = pinkNoiseId 'α' ar * envGen kr mb 0.4 0 0.1 DoNothing (envPerc 0.01 1) in X.membraneHexagon ar ex mx my --- membraneHexagon ; event control+-- membraneHexagon ; event control ; requires=voicer let f (_,g,x,y,z,o,rx,_,_,_,_) =       let ex = pinkNoiseId 'α' ar * envGen kr g z 0 0.1 DoNothing (envPerc (0.02 * rx) 1)           tn = x * 0.1           ls = linExp y 0 1 0.999999 0.9999       in pan2 (X.membraneHexagon ar ex tn ls) (o * 2 - 1) 1-in mix (voicer 8 f) * control kr "gain" 1+in mix (voicer 16 f) * control kr "gain" 1

@@ -44,7 +44,7 @@ in X.miBraids ar pit timb color (X.miBraids_mode "PLUCKED") tr 0 0 0 0 * 0.1  -- MiBraids ; 28:PLUCKED ; event control-let f (_,g,x,y,z,o,rx,_,_,_,_) =+let f (_,g,x,y,_,o,rx,_,_,_,_) =       let tr = trig1 g controlDur           pit = x * 24 + 45           timb = latch y tr * 0.5 + 0.25

@@ -1,5 +1,5 @@ -- MiClouds ; basic granulation ; requires=buf (stereo) ; 0=GRANULAR-let (buf, nc) = (control kr "buf" 0, 2)+let (buf, nc) = (control kr "buf" 100, 2)     input = playBuf nc ar buf 1 1 0 Loop DoNothing     dens = lfNoise1Id 'α' kr 0.3 `in_range` (0.3,0.45) in X.miClouds ar 0 0 0 dens 0.5 1 1 0.5 0 0 0 (X.miClouds_mode "GRANULAR") 0 0 input@@ -17,14 +17,14 @@ in X.miClouds ar pit pos size dens tex 0.5 2 0.5 0.3 0.8 frez (X.miClouds_mode "GRANULAR") 1 0 input  -- MiClouds ; using external grain trigger ; requires=buf (stereo)-let (buf, nc) = (control kr "buf" 0, 2)+let (buf, nc) = (control kr "buf" 100, 2)     input = playBuf nc ar buf 1 1 0 Loop DoNothing     dens = 0.5     tr = dustId 'α' kr 10 in X.miClouds ar (-5) 0 0.2 dens 0.5 1 1 0.5 0 0 0 (X.miClouds_mode "GRANULAR") 0 tr input  -- MiClouds ; 3=SPECTRAL ; (this mode causes high CPU peaks)-let (buf, nc) = (control kr "buf" 0, 2)+let (buf, nc) = (control kr "buf" 100, 2)     input = playBuf nc ar buf 1 1 0 Loop DoNothing     size = 0.35     dens = 0.02@@ -32,7 +32,7 @@ in X.miClouds ar 0 0 size dens tex 1 1 0.5 0.8 0.8 0 (X.miClouds_mode "SPECTRAL") 0 0 input * 0.35  -- MiClouds ; spectral again ; watch volume-let (buf, nc) = (control kr "buf" 0, 2)+let (buf, nc) = (control kr "buf" 100, 2)     input = playBuf nc ar buf 1 1 0 Loop DoNothing     size = squared (range 0.1 0.5 (lfNoise1Id 'α' kr 0.2))     dens = lfNoise1Id 'β' kr 0.3 * 0.5 + 0.5

@@ -36,21 +36,18 @@ let harm = mouseY kr 0 1 Linear 0.2 -- select chord     trigger = impulse kr 6 0     lev = tRandId 'α' 0 1 trigger-    c0 = head . mceChannels-in c0 (X.miPlaits ar 40 (X.miPlaits_mode "chord") harm 0.5 0.5 trigger (lev * lev) 0 0.4 0 0.5 0.5) * 0.1+in mceChannel 0 (X.miPlaits ar 40 (X.miPlaits_mode "chord") harm 0.5 0.5 trigger (lev * lev) 0 0.4 0 0.5 0.5) * 0.1  -- MiPlaits ; 8=swarm ; super saw let pit = tiRandId 'α' 39 49 (dustId 'β' kr 0.5)-    c0 = head . mceChannels-in c0 (X.miPlaits ar pit (X.miPlaits_mode "swarm") 0.16 0 1 0 0 0 0 0 0.5 0.5) * 0.1+in mceChannel 0 (X.miPlaits ar pit (X.miPlaits_mode "swarm") 0.16 0 1 0 0 0 0 0 0.5 0.5) * 0.1  -- MiPlaits ; slow swarm X.miPlaits ar 48 (X.miPlaits_mode "swarm") 0.9 0 0.5 0 0 0 0 0 0.5 0.5 * mce2 0.04 0.15  -- MiPlaits ; 11=string ; inharmonic let harm = range 0 1 (lfNoise2Id 'α' kr 0.2)-    c0 = head . mceChannels-in c0 (X.miPlaits ar 60 (X.miPlaits_mode "string") harm 0 0.85 0 0 0 0 0 0.5 0.5)+in mceChannel 0 (X.miPlaits ar 60 (X.miPlaits_mode "string") harm 0 0.85 0 0 0 0 0 0.5 0.5)  -- MiPlaits ; 12=modal let harm = range 0 1 (lfNoise2Id 'α' kr 0.2)

@@ -1,11 +1,11 @@ -- MiTides ; shape let shape = lfTri ar 0.11 0 `in_range` (0,1)-    c0 = head . mceChannels+    c0 = mceChannel 0 in c0 (X.miTides ar 100 shape 0.5 0.5 0.2 0 0 {-output_mode:-} 2 1 9 1) * 0.25  -- MiTides ; slope let slope = lfTri ar 0.11 0 `in_range` (0,1)-    c0 = head . mceChannels+    c0 = mceChannel 0 in c0 (X.miTides ar 100 0.5 slope 0.5 0.2 0 0 {-output_mode:-} 2 1 9 1) * 0.25  -- MiTides ; phasing@@ -61,7 +61,7 @@     tr = lfPulse ar 1 0 0.5     env = X.miTides ar freq shape slope_ smooth 0.8 tr 0 {-output_mode:-} 0 {-ramp_mode:-} 0 1 9     sine = pmOsc ar 150 300 2 0-    c0 = head . mceChannels+    c0 = mceChannel 0 in sine * c0 env  -- MiTides ; Lightbath -- Loom 4

@@ -14,12 +14,12 @@ in sinOsc ar (x * 500 + 500) 0 * 0.1  -- phasor ; as phase input to bufRd ; requires=buf-let (b, nc) = (control kr "buf" 0, 2)+let (b, nc) = (control kr "buf" 100, 2)     ph = phasor ar 0 (bufRateScale kr b) 0 (bufFrames kr b) 0 in bufRd nc ar b ph Loop NoInterpolation  -- phasor ; audio rate oscillator as phase input to bufRd ; requires=buf (non-wavetable format)-let (b, nc) = (control kr "buf" 0, 2)+let (b, nc) = (control kr "buf" 100, 2)     f = 440     fr = bufFrames kr b     rt = f * (fr / sampleRate)

@@ -1,38 +1,38 @@ -- playBuf ; requires=buf ; once only-let (b, nc) = (control kr "buf" 0, 2)+let (b, nc) = (control kr "buf" 100, 2) in playBuf nc ar b (bufRateScale kr b) 1 0 NoLoop RemoveSynth  -- playBuf ; requires=buf ; infinite loop-let (b, nc) = (control kr "buf" 0, 2)+let (b, nc) = (control kr "buf" 100, 2) in playBuf nc ar b (bufRateScale kr b) 1 0 Loop DoNothing  -- playBuf ; requires=buf ; trigger playback at each pulse-let (b, nc) = (control kr "buf" 0, 2)+let (b, nc) = (control kr "buf" 100, 2)     t = impulse kr 2 0     s = bufRateScale kr 0 in playBuf nc ar b s t 0 NoLoop DoNothing  -- playBuf ; requires=buf ; trigger playback at each pulse (diminishing intervals)-let (b, nc) = (control kr "buf" 0, 2)+let (b, nc) = (control kr "buf" 100, 2)     f = xLine kr 0.1 100 10 RemoveSynth     t = impulse kr f 0     s = bufRateScale kr b in playBuf nc ar b s t 0 NoLoop DoNothing  -- playBuf ; requires=buf ; loop playback, accelerating pitch-let (b, nc) = (control kr "buf" 0, 2)+let (b, nc) = (control kr "buf" 100, 2)     r = xLine kr 0.1 100 60 RemoveSynth in playBuf nc ar b r 1 0 Loop DoNothing  -- playBuf ; requires=buf ; sine wave control of playback rate, negative rate plays backwards-let (b, nc) = (control kr "buf" 0, 2)+let (b, nc) = (control kr "buf" 100, 2)     f = xLine kr 0.2 8 30 RemoveSynth     r = fSinOsc kr f 0 * 3 + 0.6     s = bufRateScale kr b * r in playBuf nc ar b s 1 0 Loop DoNothing  -- playBuf ; requires=buf ; channel mismatch message in server log ; can acquire second channel (subsequent load)-let (b, nc) = (control kr "buf" 0, 1)+let (b, nc) = (control kr "buf" 100, 1) in playBuf (nc + 1) ar b (bufRateScale kr b) 1 0 Loop DoNothing  -- playBuf ; requires=buf ; scan sequence of buffers

@@ -1,5 +1,5 @@ -- playBufCF ; wslib ; CF = cross-fade ; control-rate trigger and start-position inputs-let b = control kr "buf" 0+let b = control kr "buf" 100     r = bufRateScale kr b     tr = impulse kr 2 0     wn = whiteNoiseId 'α' kr@@ -9,7 +9,7 @@ in mce2 o o'  -- playBufCF ; demand ugens inputs-let b = control kr "buf" 0+let b = control kr "buf" 100     r = drandId 'α' dinf (mce [0.95,1,1.05])     tr = dwhiteId 'β' dinf 0.1 0.3     sp = dbrownId 'γ' dinf 0 0.95 0.1 * bufFrames kr b

@@ -1,5 +1,5 @@ -- pv_BinBufRd ; play analysis back ; c.f. pv_RecordBuf help file-let snd_buf = control kr "buf" 0+let snd_buf = control kr "buf" 100     rec_buf = control kr "rec" 10     fft_buf = localBufId 'α' 1 1024     x = mouseX kr 0 1 Linear 0.2

@@ -1,5 +1,5 @@ -- pv_BinScramble-let b = control kr "buf" 0+let b = control kr "buf" 100     a = playBuf 1 ar b (bufRateScale kr b) 1 0 Loop DoNothing     f = fft' (localBufId 'α' 2048 1) a     x = mouseX kr 0.0 1.0 Linear 0.1

@@ -1,5 +1,5 @@ -- pv_Diffuser ; trigger revised phase shifts with MouseX crossing center of screen-let b = control kr "buf" 0+let b = control kr "buf" 100     z = playBuf 1 ar b (bufRateScale kr b) 0 0 Loop DoNothing     f = fft' (localBufId 'α' 2048 1) z     x = mouseX kr 0 1 Linear 0.1

@@ -1,5 +1,5 @@ -- pv_MagFreeze ; mouseX is trigger to freeze-let b = control kr "buf" 0+let b = control kr "buf" 100     z = playBuf 1 ar b (bufRateScale kr b) 0 0 Loop DoNothing     f = fft' (localBufId 'α' 2048 1) z     x = mouseX kr 0 1 Linear 0.1

@@ -1,7 +1,7 @@ -- pv_SpectralMap let y = mouseY kr (-1) 1 Linear 0.2     x = mouseX kr (-1) 1 Linear 0.2-    b = control kr "buf" 0+    b = control kr "buf" 100     c1 = fft' (localBufId 'α' 2048 1) (soundIn 0)     c2 = fft' (localBufId 'β' 2048 1) (playBuf 1 ar b 1 1 0 Loop DoNothing)     c3 = X.pv_SpectralMap c1 c2 0.0 y x 1 0

@@ -45,8 +45,8 @@ hsc3-smplr load pf --dyn=008 --b0=100  ---- ; load SFZ sample data-import Sound.OSC {- hosc -}-import Sound.Sc3.Data.SFZ {- hsc3-data -}+import Sound.Osc {- hosc -}+import Sound.Sc3.Data.Sfz {- hsc3-data -} sfz_fn = sfResolve "instr/bosendorfer/008.sfz" sfz_fn = sfResolve "instr/farfisa/aad/dolce-8.sfz" sfz_fn = sfResolve "instr/casacota/zell_1737_415_MeanTone5/8_i.sfz"

@@ -1,2 +1,3 @@ -- radiansPerSample ; two pi divided by the nominal sample rate (ie. a very small number)-let f = mce2 radiansPerSample ((2 * pi) / sampleRate) * 5000000 in sinOsc ar f 0 * 0.1+let f = mce2 radiansPerSample ((2 * pi) / sampleRate) * 5000000+in sinOsc ar f 0 * 0.1

@@ -26,7 +26,7 @@ in saw ar f * 0.1  -- select ; buffer segment player ; requires=buf-let (buf, nc) = (control kr "buf" 0, 2)+let (buf, nc) = (control kr "buf" 100, 2)     n_segments = control_m kr "nseg" 32 (1, 64, "lin")     sel = control_m kr "sel" 0 (0,3,"lin")     buf_size = bufFrames kr buf

@@ -1,22 +1,22 @@ -- playBuf ; check buffer-let b = control kr "buf" 0+let b = control kr "buf" 100     s = bufRateScale kr b in playBuf 1 ar b s 1 0 NoLoop RemoveSynth * 0.1  -- shufflerB ; static-let b = control kr "buf" 0+let b = control kr "buf" 100 in X.shufflerB b 0 0.05 0.95 1.05 0.035 0.05 0.1 0.2 0.4 0.6 0.4 0.6 0 1 0.005 0.01 1 0 0  -- shufflerB ; static, quantized-let b = control kr "buf" 0+let b = control kr "buf" 100 in X.shufflerB b 0 1 0.5 2 0.025 0.075 0.2 0.6 0.1 0.9 0.1 0.9 0 1 0.005 0.05 0 0.5 0.005  -- shufflerB ; static, pointilist-let b = control kr "buf" 0+let b = control kr "buf" 100 in X.shufflerB b 0.4 0.5 0.5 2 0.05 0.15 0.2 0.5 0.3 0.7 0.3 0.7 0 1 0.05 0.25 0 0 0  -- shufflerB ; controls-let b = control_m kr "buf" 0 (0,10,"lin")+let b = control_m kr "buf" 100 (0,10,"lin")     k nm def = control_m kr nm def     k2 nm (d1,d2) = control_rng kr nm (d1,d2)     k2_mul m (c1,c2) = (c1 * m,c2 * m)

@@ -137,9 +137,6 @@     o3 = pulse ar (1/4) 0.5 in (o1 + o2 + o3) * 0.1 --- jh ; <https://scsynth.org/t/auditory-illusion-with-exponentially-spaced-frequencies/4157>-mix (sinOsc ar (300 * mce (map (4 **) (take 200 [0, 0.002 ..]))) 0 * 0.02)- -- sinOsc ; https://scsynth.org/t/what-kind-of-synthesis-is-this/4318/30 let mratio = 4     amp = 0.2

@@ -12,7 +12,7 @@ in X.squiz (soundIn 0) x y 0.1 * 0.1  -- squiz ; of buffer ; requires=buf-let (b, nc) = (control kr "buf" 0, 2)+let (b, nc) = (control kr "buf" 100, 2)     zmax = 100     s = sinOsc ar 440 0     x = mouseX kr 1 10 Exponential 0.2

@@ -116,4 +116,4 @@ in mix (voicer 16 f) * control kr "gain" 1  ---- ; set globals-X.stkGlobals ar 1 1 (label "/home/rohan/opt/src/sc3-plugins/external_libraries/stk/rawwaves")+X.stkGlobals ar 1 1 (label "/home/rohan/opt/src/supercollider/sc3-plugins/external_libraries/stk/rawwaves")

@@ -5,14 +5,14 @@ in sinOsc ar f 0 * 0.2  -- sweep ; using sweep to index into a buffer ; requires=buf-let (b, nc) = (control kr "buf" 0, 2)+let (b, nc) = (control kr "buf" 100, 2)     x = mouseX kr 0.5 20 Exponential 0.1     t = impulse ar x 0     p = sweep ar t (bufSampleRate kr b) in bufRdL nc ar b p NoLoop  -- sweep ; backwards, variable offset ; requires=buf-let (b, nc) = (control kr "buf" 0, 2)+let (b, nc) = (control kr "buf" 100, 2)     n = lfNoise0Id 'α' kr 15     x = mouseX kr 0.5 10 Exponential 0.1     t = impulse ar x 0@@ -21,7 +21,7 @@ in bufRdL nc ar b p NoLoop  -- sweep ; raising rate ; requires=buf-let (b, nc) = (control kr "buf" 0, 2)+let (b, nc) = (control kr "buf" 100, 2)     x = mouseX kr 0.5 10 Exponential 0.1     t = impulse ar x 0     r = sweep ar t 2 + 0.5

@@ -1,12 +1,12 @@ -- tGrains ; mouse control ; requires=buf-let b = control kr "buf" 0+let b = control kr "buf" 100     tRate = mouseY kr 2 200 Exponential 0.1     ctr = mouseX kr 0 (bufDur kr b) Linear 0.1     tr = impulse ar tRate 0 in tGrains 2 tr b 1 ctr (4 / tRate) 0 0.25 2  -- tGrains ; mouse control ; requires=buf-let b = control kr "buf" 0+let b = control kr "buf" 100     rt = mouseY kr 8 120 Exponential 0.1     dur = 4 / rt     clk = dustId 'α' ar rt@@ -17,7 +17,7 @@ in tGrains 2 clk b 1 pos dur pan 0.25 2  -- tGrains ; mouse control ; requires=buf-let b = control kr "buf" 0+let b = control kr "buf" 100     rt = mouseY kr 2 120 Exponential 0.1     dur = 1.2 / rt     clk = impulse ar rt 0@@ -30,7 +30,7 @@ -- tGrains ; demand UGens as inputs ; requires=buf --         ; (Warning: empty sequence in Dseq - ServerId 'localhost' exited with exit code 0) --         ; (also at sclang graph)-let b = control kr "buf" 0+let b = control kr "buf" 100     rt = mouseX kr 1 100 Exponential 0.2     dId uid = dwhiteId uid 1 0.1 0.2     zId u0 u1 u2 u3 u4 u5 u6 u7 = drandId u1 1 (mce [dgeomId u2 (diwhiteId u3 1 20 40) 0.1 (1 + dId u4)@@ -48,7 +48,7 @@ --         ; http://sc-users.bham.ac.narkive.com/sj4Tw3ub/sync-osc#post5 (jmcc) --         ; "A wavetable windowed sync oscillator could be written. --         ;  You can actually do a version of this with TGrains."-let b = control kr "buf" 0+let b = control kr "buf" 100     freq = 100     dur = 2 / freq     clk = impulse ar freq 0@@ -57,7 +57,7 @@  -- tGrains ; requires=buf ; event control let f (_,g,x,y,z,o,rx,ry,_,_,_) =-      let b = control kr "buf" 0+      let b = control kr "buf" 100           tRate = linExp y 0 1 2 200           ctr = x * bufDur kr b           du = (ry * 8) / tRate

@@ -1,5 +1,5 @@ -- warp1 ; requires=buf ; interp=2=linear ; nc=2-let (b, nc) = (control kr "buf" 0, 2)+let (b, nc) = (control kr "buf" 100, 2)     p = linLin (lfSaw kr 0.05 0) (-1) 1 0 1     x = mouseX kr 0.5 2 Linear 0.1 in warp1 nc b p x 0.1 (-1) 8 0.1 2 * 0.5@@ -18,7 +18,7 @@  -- warp1 ; requires=buf ; event control let f (_,g,x,y,z,o,rx,ry,_,_,_) =-      let b = control kr "buf" 0+      let b = control kr "buf" 100           p = linLin (lfSaw kr 0.05 0) (-1) 1 0 1           dur = linLin y 0 1 0.01 0.2           freqScale = linLin ry 0 1 0.75 1.25

@@ -11,39 +11,39 @@ [hosc](http://rohandrape.net/?t=hosc).  There is an-[introduction](http://rohandrape.net/?t=hsc3-texts&e=lhs/hsc3-introduction.lhs)+[introduction](http://rohandrape.net/?t=hsc3-texts&e=1.1-introduction.md) and a-[tutorial](http://rohandrape.net/?t=hsc3-texts&e=lhs/hsc3-tutorial.lhs)+[tutorial](http://rohandrape.net/?t=hsc3-texts&e=2.1-tutorial.md) at [hsc3-texts](http://rohandrape.net/?t=hsc3-texts).  There are a number of related projects: -- [sc3-rdu](http://rohandrape.net/?t=sc3-rdu): SuperCollider UGens (1998)-- [rsc3](http://rohandrape.net/?t=rsc3): Scheme SuperCollider (2004)-- [hsc3-dot](http://rohandrape.net/?t=hsc3-dot): UGen graph drawing (2006)-- [hsc3-graphs](http://rohandrape.net/?t=hsc3-graphs): UGen graph collection (2006)-- [hsc3-db](http://rohandrape.net/?t=hsc3-db): UGen Database (2006)-- [hsc3-sf](http://rohandrape.net/?t=hsc3-sf): Sound file IO (2006)-- [hsc3-unsafe](http://rohandrape.net/?t=hsc3-unsafe): Unsafe UGen variants (2006)-- [hsc3-lang](http://rohandrape.net/?t=hsc3-lang): SC3 language (2007)-- [hsc3-rec](http://rohandrape.net/?t=hsc3-rec): Record UGens (2008)-- [smlsc3](http://rohandrape.net/?t=smlsc3): Standard ML SuperCollider (2008)-- [hsc3-sf-hsndfile](http://rohandrape.net/?t=hsc3-sf-hsndfile): Sound file IO (libsndfile) (2010)-- [hsc3-auditor](http://rohandrape.net/?t=hsc3-auditor): Simple sound event auditioner (2010)-- [hsc3-cairo](http://rohandrape.net/?t=hsc3-cairo): Drawing (2012)+- [hsc3-util](http://rohandrape.net/?t=hsc3-util): hsc3 & related utilities (2020)+- [stsc3](http://rohandrape.net/?t=stsc3): Smalltalk SuperCollider (2019)+- [hsc3-m](http://rohandrape.net/?t=hsc3-m): UGen variants (2018)+- [hsc3-forth](http://rohandrape.net/?t=hsc3-forth): Forth SuperCollider (2014)+- [hsc3-lisp](http://rohandrape.net/?t=hsc3-lisp): Lisp SuperCollider (2014) - [hsc3-plot](http://rohandrape.net/?t=hsc3-plot): Plotting (2013) - [hsc3-data](http://rohandrape.net/?t=hsc3-data): Data formats &etc. (2013) - [hsc3-rw](http://rohandrape.net/?t=hsc3-rw): UGen Graph Re-writing (2013)-- [hsc3-forth](http://rohandrape.net/?t=hsc3-forth): Forth SuperCollider (2014)-- [hsc3-lisp](http://rohandrape.net/?t=hsc3-lisp): Lisp SuperCollider (2014)-- [hsc3-m](http://rohandrape.net/?t=hsc3-m): UGen variants (2018)-- [stsc3](http://rohandrape.net/?t=stsc3): Smalltalk SuperCollider (2019)-- [hsc3-util](http://rohandrape.net/?t=hsc3-util): hsc3 & related utilities (2020)+- [hsc3-cairo](http://rohandrape.net/?t=hsc3-cairo): Drawing (2012)+- [hsc3-sf-hsndfile](http://rohandrape.net/?t=hsc3-sf-hsndfile): Sound file Io (libsndfile) (2010)+- [hsc3-auditor](http://rohandrape.net/?t=hsc3-auditor): Simple sound event auditioner (2010)+- [hsc3-rec](http://rohandrape.net/?t=hsc3-rec): Record UGens (2008)+- [smlsc3](http://rohandrape.net/?t=smlsc3): Standard Ml SuperCollider (2008)+- [hsc3-lang](http://rohandrape.net/?t=hsc3-lang): SC3 language (2007)+- [hsc3-graphs](http://rohandrape.net/?t=hsc3-graphs): UGen graph collection (2006)+- [hsc3-db](http://rohandrape.net/?t=hsc3-db): UGen Database (2006)+- [hsc3-dot](http://rohandrape.net/?t=hsc3-dot): UGen graph drawing (2006)+- [hsc3-sf](http://rohandrape.net/?t=hsc3-sf): Sound file Io (2006)+- [hsc3-unsafe](http://rohandrape.net/?t=hsc3-unsafe): Unsafe UGen variants (2006)+- [rsc3](http://rohandrape.net/?t=rsc3): Scheme SuperCollider (2004)+- [sc3-rdu](http://rohandrape.net/?t=sc3-rdu): SuperCollider UGens (1998)  The hsc3 interaction environment ([hsc3.el](http://rohandrape.net/?t=hsc3&e=emacs/hsc3.el)) is written for-[GNU](http://gnu.org/)+[Gnu](http://gnu.org/) [Emacs](http://gnu.org/software/emacs/).  <!--@@ -52,26 +52,34 @@  ## help -[UGen Index](http://rohandrape.net/?t=hsc3&e=Help/UGen/ix.md)+[UGen Index](http://rohandrape.net/?t=hsc3&e=Help/Ugen/ix.md)  ©-[rohan drape](http://rohandrape.net/)-and others, 2005-2022,-[gpl-3](http://gnu.org/copyleft/)+[Rohan Drape](http://rohandrape.net/)+and others, 2005-2024,+[Gpl-3](http://gnu.org/copyleft/) -with contributions by:+With contributions by: -- henning thielemann-- stefan kersten-- alex mclean-- brent yorgey-- shae erisson+- Henning Thielemann+- Stefan Kersten+- Alex McLean+- Brent Yorgey+- Shae Erisson -see the+See the [git](https://git-scm.com/) [history](http://rohandrape.net/?t=hsc3&q=history) for details -initial announcement:+Initial announcement: [[2005-11-29/haskell-cafe](http://rohandrape.net/?t=hsc3&e=md/announce.text),  [haskell.org](http://www.haskell.org/pipermail/haskell-cafe/2005-November/012483.html)]++* * *++```+$ doctest Sound/Sc3+Examples: 370  Tried: 370  Errors: 0  Failures: 0+$+```

@@ -1,5 +1,6 @@--- | Composite of "Sound.Sc3.Common", "Sound.Sc3.Server.Monad",--- "Sound.Sc3.Ugen" and "Sound.Sc3.Ugen.Bindings".+{- | Composite of "Sound.Sc3.Common", "Sound.Sc3.Server.Monad",+"Sound.Sc3.Ugen" and "Sound.Sc3.Ugen.Bindings".+-} module Sound.Sc3 (module M) where  import Sound.Sc3.Common as M

@@ -6,6 +6,8 @@ import Data.Maybe {- base -} import Data.Ord {- base -} +import qualified Safe {- safe -}+ -- * Function  -- | Unary function.@@ -32,10 +34,14 @@ -- | 11-parameter function. type Fn11 a b c d e f g h i j k l = a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l --- | Apply /f/ n times, ie. iterate f x !! n------ > iter 3 (* 2) 1 == 8--- > iterate (* 2) 1 !! 3 == 8+{- | Apply /f/ n times, ie. iterate f x !! n++>>> iter 3 (* 2) 1+8++>>> iterate (* 2) 1 !! 3+8+-} iter :: Int -> (a -> a) -> a -> a iter n f x = if n == 0 then x else f (iter (n - 1) f x) @@ -50,167 +56,214 @@ -- | Variant of 'reads' requiring exact match. reads_exact :: Read a => String -> Maybe a reads_exact s =-    case reads s of-      [(r,"")] -> Just r-      _ -> Nothing+  case reads s of+    [(r, "")] -> Just r+    _ -> Nothing  -- * String  {- | Similar to Data.List.Split.splitOn, which however hugs doesn't know of. -> string_split_at_char ':' "/usr/local/bin:/usr/bin:/bin" == ["/usr/local/bin","/usr/bin","/bin"]-> string_split_at_char ':' "/usr/local/bin" == ["/usr/local/bin"]+>>> string_split_at_char ':' "/usr/local/bin:/usr/bin:/bin"+["/usr/local/bin","/usr/bin","/bin"]++>>> string_split_at_char ':' "/usr/local/bin"+["/usr/local/bin"] -} string_split_at_char :: Char -> String -> [String] string_split_at_char c s =   case break (== c) s of-    (lhs,[]) -> [lhs]-    (lhs,_:rhs) -> lhs : string_split_at_char c rhs+    (lhs, []) -> [lhs]+    (lhs, _ : rhs) -> lhs : string_split_at_char c rhs  -- * String / Case  -- | Ci = Case insensitive, Cs = case sensitive, Sci = separator & case insensitive data Case_Rule = Ci | Cs | Sci deriving (Eq) +string_op :: (String -> String -> t) -> Case_Rule -> String -> String -> t+string_op f cr x y =+  let ci_form = map toLower+      sci_form = filter (`notElem` "-_") . ci_form+  in case cr of+      Ci -> f (ci_form x) (ci_form y)+      Cs -> f x y+      Sci -> f (sci_form x) (sci_form y)+ {- | String equality with 'Case_Rule'. -> string_eq Ci "sinOsc" "SinOsc" == True-> string_eq Sci "sin-osc" "SinOsc" == True+>>> string_eq Ci "sinOsc" "SinOsc"+True++>>> string_eq Sci "sin-osc" "SinOsc"+True -} string_eq :: Case_Rule -> String -> String -> Bool-string_eq cr x y =-  let ci_form = map toLower-      sci_form = filter (`notElem` "-_") . ci_form-  in case cr of-       Ci -> ci_form x == ci_form y-       Cs -> x == y-       Sci -> sci_form x == sci_form y+string_eq = string_op (==) +string_cmp :: Case_Rule -> String -> String -> Ordering+string_cmp = string_op compare+ -- | 'rlookup_by' of 'string_eq'.-rlookup_str :: Case_Rule -> String -> [(a,String)] -> Maybe a+rlookup_str :: Case_Rule -> String -> [(a, String)] -> Maybe a rlookup_str = rlookup_by . string_eq  {- | 'Enum' parser with 'Case_Rule'. -> parse_enum Ci "false" == Just False+>>> parse_enum Ci "false" :: Maybe Bool+Just False -}-parse_enum :: (Show t,Enum t,Bounded t) => Case_Rule -> String -> Maybe t+parse_enum :: (Show t, Enum t, Bounded t) => Case_Rule -> String -> Maybe t parse_enum cr nm =-    let u = [minBound .. maxBound]-        t = zip (map show u) u-    in lookup_by (string_eq cr) nm t+  let u = [minBound .. maxBound]+      t = zip (map show u) u+  in lookup_by (string_eq cr) nm t  -- * List --- | Left to right composition of a list of functions.------ > compose_l [(* 2),(+ 1)] 3 == 7+{- | Left to right composition of a list of functions.++>>> compose_l [(* 2),(+ 1)] 3+7+-} compose_l :: [t -> t] -> t -> t compose_l = flip (foldl (\x f -> f x)) --- | Right to left composition of a list of functions.------ > compose_r [(* 2),(+ 1)] 3 == 8+{- | Right to left composition of a list of functions.++>>> compose_r [(* 2),(+ 1)] 3+8+-} compose_r :: [t -> t] -> t -> t compose_r = flip (foldr ($))  {- | SequenceableCollection.differentiate -> > [3,4,1,1].differentiate == [3,1,-3,0]+> [3,4,1,1].differentiate == [3,1,-3,0] -> d_dx [3,4,1,1] == [3,1,-3,0]-> d_dx [0,1,3,6] == [0,1,2,3]+>>> d_dx [3,4,1,1]+[3,1,-3,0]++>>> d_dx [0,1,3,6]+[0,1,2,3] -} d_dx :: (Num a) => [a] -> [a]-d_dx l = zipWith (-) l (0:l)+d_dx l = zipWith (-) l (0 : l)  {- | Variant that does not prepend zero to input, ie. 'tail' of 'd_dx'. -> d_dx' [3,4,1,1] == [1,-3,0]-> d_dx' [0,1,3,6] == [1,2,3]+>> d_dx' [3,4,1,1]+[1,-3,0]++>>> d_dx' [0,1,3,6]+[1,2,3] -} d_dx' :: Num n => [n] -> [n]-d_dx' l = zipWith (-) (tail l) l+d_dx' l = zipWith (-) (Safe.tailNote "d_dx'" l) l  {- | SequenceableCollection.integrate -> > [3,4,1,1].integrate == [3,7,8,9]+> [3,4,1,1].integrate == [3,7,8,9] -> dx_d [3,4,1,1] == [3,7,8,9]-> dx_d (d_dx [0,1,3,6]) == [0,1,3,6]-> dx_d [0.5,0.5] == [0.5,1]+>>> dx_d [3,4,1,1]+[3,7,8,9]++>>> dx_d (d_dx [0,1,3,6])+[0,1,3,6]++>>> dx_d [0.5,0.5]+[0.5,1.0] -} dx_d :: Num n => [n] -> [n] dx_d = scanl1 (+)  {- | Variant pre-prending zero to output. -> dx_d' [3,4,1,1] == [0,3,7,8,9]-> dx_d' (d_dx' [0,1,3,6]) == [0,1,3,6]-> dx_d' [0.5,0.5] == [0,0.5,1]+>>> dx_d' [3,4,1,1]+[0,3,7,8,9]++>>> dx_d' (d_dx' [0,1,3,6])+[0,1,3,6]++>>> dx_d' [0.5,0.5]+[0.0,0.5,1.0] -} dx_d' :: Num n => [n] -> [n] dx_d' = (0 :) . dx_d  -- | 'lookup' with equality function.-lookup_by :: (a -> t -> Bool) -> a -> [(t,b)] -> Maybe b+lookup_by :: (a -> t -> Bool) -> a -> [(t, b)] -> Maybe b lookup_by f x = fmap snd . find (f x . fst) +-- | Erroring variant, with message.+lookup_by_note :: String -> (a -> t -> Bool) -> a -> [(t, b)] -> b+lookup_by_note msg f x = fromMaybe (error ("lookup_by: " ++ msg)) . lookup_by f x+ -- | Erroring variant.-lookup_by_err :: (a -> t -> Bool) -> a -> [(t,b)] -> b-lookup_by_err f x = fromMaybe (error "lookup_by") . lookup_by f x+lookup_by_err :: (a -> t -> Bool) -> a -> [(t, b)] -> b+lookup_by_err = lookup_by_note "error"  -- | Reverse 'lookup' with equality function.-rlookup_by :: (b -> b -> Bool) -> b -> [(a,b)] -> Maybe a+rlookup_by :: (b -> b -> Bool) -> b -> [(a, b)] -> Maybe a rlookup_by f x = fmap fst . find (f x . snd) --- | (prev,cur,next) triples.------ > pcn_triples [1..3] == [(Nothing,1,Just 2),(Just 1,2,Just 3),(Just 2,3,Nothing)]-pcn_triples :: [a] -> [(Maybe a,a,Maybe a)]+{- | (prev,cur,next) triples.++>>> pcn_triples [1..3]+[(Nothing,1,Just 2),(Just 1,2,Just 3),(Just 2,3,Nothing)]+-}+pcn_triples :: [a] -> [(Maybe a, a, Maybe a)] pcn_triples =-    let f e l = case l of-                  e1 : e2 : l' -> (e,e1,Just e2) : f (Just e1) (e2 : l')-                  [e'] -> [(e,e',Nothing)]-                  [] -> undefined-    in f Nothing+  let f e l = case l of+        e1 : e2 : l' -> (e, e1, Just e2) : f (Just e1) (e2 : l')+        [e'] -> [(e, e', Nothing)]+        [] -> undefined+  in f Nothing --- | Separate first list element.------ > sep_first "astring" == Just ('a',"string")-sep_first :: [t] -> Maybe (t,[t])+{- | Separate first list element.++>>> sep_first "astring"+Just ('a',"string")+-}+sep_first :: [t] -> Maybe (t, [t]) sep_first l =-    case l of-      e:l' -> Just (e,l')-      _ -> Nothing+  case l of+    e : l' -> Just (e, l')+    _ -> Nothing --- | Separate last list element.------ > sep_last "stringb" == Just ("string",'b')+{- | Separate last list element.++>>> sep_last "stringb"+Just ("string",'b')+-} sep_last :: [t] -> Maybe ([t], t) sep_last =-    let f (e,l) = (reverse l,e)-    in fmap f . sep_first . reverse+  let f (e, l) = (reverse l, e)+  in fmap f . sep_first . reverse --- | Are lists of equal length?------ > equal_length_p ["t1","t2"] == True--- > equal_length_p ["t","t1","t2"] == False+{- | Are lists of equal length?++>>> equal_length_p ["t1","t2"]+True++>>> equal_length_p ["t","t1","t2"]+False+-} equal_length_p :: [[a]] -> Bool equal_length_p = (== 1) . length . nub . map length  -- | Histogram-histogram :: Ord a => [a] -> [(a,Int)]+histogram :: Ord a => [a] -> [(a, Int)] histogram x =-    let g = group (sort x)-    in zip (map head g) (map length g)+  let g = group (sort x)+  in zip (map (Safe.headNote "histogram") g) (map length g)  -- | !! with localised error message at_with_error_message :: String -> [t] -> Int -> t at_with_error_message msg list index =   if index >= length list-  then error ("!!: index out of range: " ++ msg)-  else list !! index+    then error ("!!: index out of range: " ++ msg)+    else list !! index  -- | concat of intersperse.  This is the same function as intercalate, which hugs doesn't know of. concat_intersperse :: [a] -> [[a]] -> [a]@@ -218,92 +271,99 @@  {- | Similar to Data.List.Split.splitOn, which however hugs doesn't know of. -> list_split_at_elem ' ' "a sequence of words" == ["a","sequence","of","words"]+>>> list_split_at_elem ' ' "a sequence of words"+["a","sequence","of","words"] -} list_split_at_elem :: Eq t => t -> [t] -> [[t]] list_split_at_elem c s =   case break (== c) s of-    (lhs,[]) -> [lhs]-    (lhs,_:rhs) -> lhs : list_split_at_elem c rhs+    (lhs, []) -> [lhs]+    (lhs, _ : rhs) -> lhs : list_split_at_elem c rhs  {- | Data.List.sortOn, which however hugs does not know of. -> sort_on snd [('a',1),('b',0)] == [('b',0),('a',1)]+>>> sort_on snd [('a',1),('b',0)]+[('b',0),('a',1)] -} sort_on :: (Ord b) => (a -> b) -> [a] -> [a] sort_on = sortBy . comparing  {- | Inserts at the first position where it compares less but not equal to the next element. -> import Data.Function {- base -}-> insertBy (compare `on` fst) (3,'x') (zip [1..5] ['a'..])-> insertBy_post (compare `on` fst) (3,'x') (zip [1..5] ['a'..])+>>> import Data.Function+>>> insertBy (compare `on` fst) (3,'x') (zip [1..5] ['a'..])+[(1,'a'),(2,'b'),(3,'x'),(3,'c'),(4,'d'),(5,'e')]++>>> insertBy_post (compare `on` fst) (3,'x') (zip [1..5] ['a'..])+[(1,'a'),(2,'b'),(3,'c'),(3,'x'),(4,'d'),(5,'e')] -} insertBy_post :: (a -> a -> Ordering) -> a -> [a] -> [a] insertBy_post cmp e l =-    case l of-      [] -> [e]-      h:l' -> case cmp e h of-                LT -> e : l-                _ -> h : insertBy_post cmp e l'+  case l of+    [] -> [e]+    h : l' -> case cmp e h of+      LT -> e : l+      _ -> h : insertBy_post cmp e l'  -- | 'insertBy_post' using 'compare'. insert_post :: Ord t => t -> [t] -> [t] insert_post = insertBy_post compare --- | Apply /f/ at all but last element, and /g/ at last element.------ > at_last (* 2) negate [1..4] == [2,4,6,-4]+{- | Apply /f/ at all but last element, and /g/ at last element.++>>> at_last (* 2) negate [1..4]+[2,4,6,-4]+-} at_last :: (a -> b) -> (a -> b) -> [a] -> [b] at_last f g x =-    case x of-      [] -> []-      [i] -> [g i]-      i:x' -> f i : at_last f g x'+  case x of+    [] -> []+    [i] -> [g i]+    i : x' -> f i : at_last f g x'  -- * Tuples  -- | Zip two 4-tuples.-p4_zip :: (a,b,c,d) -> (e,f,g,h) -> ((a,e),(b,f),(c,g),(d,h))-p4_zip (a,b,c,d) (e,f,g,h) = ((a,e),(b,f),(c,g),(d,h))+p4_zip :: (a, b, c, d) -> (e, f, g, h) -> ((a, e), (b, f), (c, g), (d, h))+p4_zip (a, b, c, d) (e, f, g, h) = ((a, e), (b, f), (c, g), (d, h))  -- | Two-tuple.-type T2 a = (a,a)+type T2 a = (a, a)  -- | Three-tuple.-type T3 a = (a,a,a)+type T3 a = (a, a, a)  -- | Four-tuple.-type T4 a = (a,a,a,a)+type T4 a = (a, a, a, a)  -- | t -> (t,t) dup2 :: t -> T2 t-dup2 t = (t,t)+dup2 t = (t, t)  -- | t -> (t,t,t) dup3 :: t -> T3 t-dup3 t = (t,t,t)+dup3 t = (t, t, t)  -- | t -> (t,t,t,t) dup4 :: t -> T4 t-dup4 t = (t,t,t,t)+dup4 t = (t, t, t, t)  -- | 'concatMap' of /f/ at /x/ and /g/ at /y/. mk_duples :: (a -> c) -> (b -> c) -> [(a, b)] -> [c]-mk_duples a b = concatMap (\(x,y) -> [a x, b y])+mk_duples a b = concatMap (\(x, y) -> [a x, b y])  -- | Length prefixed list variant of 'mk_duples'.-mk_duples_l :: (Int -> c) -> (a -> c) -> (b -> c) -> [(a,[b])] -> [c]-mk_duples_l i a b = concatMap (\(x,y) -> a x : i (length y) : map b y)+mk_duples_l :: (Int -> c) -> (a -> c) -> (b -> c) -> [(a, [b])] -> [c]+mk_duples_l i a b = concatMap (\(x, y) -> a x : i (length y) : map b y)  -- | 'concatMap' of /f/ at /x/ and /g/ at /y/ and /h/ at /z/. mk_triples :: (a -> d) -> (b -> d) -> (c -> d) -> [(a, b, c)] -> [d]-mk_triples a b c = concatMap (\(x,y,z) -> [a x, b y, c z])+mk_triples a b c = concatMap (\(x, y, z) -> [a x, b y, c z])  -- | [x,y] -> (x,y) t2_from_list :: [t] -> T2 t-t2_from_list l = case l of {[p,q] -> (p,q);_ -> error "t2_from_list"}+t2_from_list l = case l of [p, q] -> (p, q); _ -> error "t2_from_list"  -- | [x,y,z] -> (x,y,z)-t3_from_list :: [t] -> (t,t,t)-t3_from_list l = case l of {[p,q,r] -> (p,q,r);_ -> error "t3_from_list"}+t3_from_list :: [t] -> (t, t, t)+t3_from_list l = case l of [p, q, r] -> (p, q, r); _ -> error "t3_from_list"

@@ -6,7 +6,8 @@  {- | 'getEnv' with error handler to return default value.  This almost works in hugs (IOException should be Exception, the signature can be elided) -> get_env_with_default "undefined_environment_variable" "default"  -- > "default"+>>> get_env_with_default "undefined_environment_variable" "default"+"default" -} get_env_with_default :: String -> String -> IO String get_env_with_default variableName defaultValue =

@@ -7,159 +7,202 @@  {- | /z/ ranges from 0 (for /i/) to 1 (for /j/). -> > 1.5.blend(2.0,0.50) == 1.75-> > 1.5.blend(2.0,0.75) == 1.875+> 1.5.blend(2.0,0.50)+1.75+> 1.5.blend(2.0,0.75)+1.875 -> blend 0.50 1.5 2 == 1.75-> blend 0.75 1.5 2 == 1.875+>>> blend 0.50 1.5 2+1.75++>>> blend 0.75 1.5 2+1.875 -} blend :: Num a => a -> a -> a -> a blend z i j = i + (z * (j - i)) --- | Variant of '(!!)' but values for index greater than the size of--- the collection will be clipped to the last index.------ > map (\x -> clipAt x "abc") [-1,0,1,2,3] == "aabcc"+{- | Variant of '(!!)' but values for index greater than the size of the collection will be clipped to the last index.++>>> map (\x -> clipAt x "abc") [-1,0,1,2,3]+"aabcc"+-} clipAt :: Int -> [a] -> a clipAt ix c = if ix > length c - 1 then last c else if ix < 0 then c !! 0 else c !! ix  -- | 'blendAt' with @clip@ function as argument.-blendAtBy :: (Integral i,RealFrac n) => (i -> t -> n) -> n -> t -> n+blendAtBy :: (Integral i, RealFrac n) => (i -> t -> n) -> n -> t -> n blendAtBy f ix c =-    let m = floor ix-        m' = fromIntegral m-    in blend (S.absdif ix m') (f m c) (f (m + 1) c)+  let m = floor ix+      m' = fromIntegral m+  in blend (S.absdif ix m') (f m c) (f (m + 1) c) --- | @SequenceableCollection.blendAt@ returns a linearly interpolated--- value between the two closest indices.  Inverse operation is--- 'indexInBetween'.------ > > [2,5,6].blendAt(0.4) == 3.2------ > blendAt 0 [2,5,6] == 2--- > blendAt 0.4 [2,5,6] == 3.2+{- | @SequenceableCollection.blendAt@ returns a linearly interpolated value between the two closest indices.+Inverse operation is 'indexInBetween'.++> [2,5,6].blendAt(0.4)+3.2++>>> blendAt 0 [2,5,6]+2.0+>>> blendAt 0.4 [2,5,6]+3.2+-} blendAt :: RealFrac a => a -> [a] -> a blendAt = blendAtBy clipAt --- | Resampling function, /n/ is destination length, /r/ is source--- length, /f/ is the indexing function, /c/ is the collection.-resamp1_gen :: (Integral i,RealFrac n) => i -> i -> (i -> t -> n) -> t -> i -> n+-- | Resampling function, /n/ is destination length, /r/ is source length, /f/ is the indexing function, /c/ is the collection.+resamp1_gen :: (Integral i, RealFrac n) => i -> i -> (i -> t -> n) -> t -> i -> n resamp1_gen n r f c =-    let n' = fromIntegral n-        fwd = (fromIntegral r - 1) / (n' - 1)-        gen i = blendAtBy f (fromIntegral i * fwd) c-    in gen+  let n' = fromIntegral n+      fwd = (fromIntegral r - 1) / (n' - 1)+      gen i = blendAtBy f (fromIntegral i * fwd) c+  in gen --- | @SequenceableCollection.resamp1@ returns a new collection of the--- desired length, with values resampled evenly-spaced from the--- receiver with linear interpolation.------ > > [1].resamp1(3) == [1,1,1]--- > > [1,2,3,4].resamp1(12)--- > > [1,2,3,4].resamp1(3) == [1,2.5,4]------ > resamp1 3 [1] == [1,1,1]--- > resamp1 12 [1,2,3,4]--- > resamp1 3 [1,2,3,4] == [1,2.5,4]+{- | @SequenceableCollection.resamp1@ returns a new collection of the desired length, with values resampled evenly-spaced from the receiver with linear interpolation.++> [1].resamp1(3) == [1,1,1]+> [1,2,3,4].resamp1(12)+> [1,2,3,4].resamp1(3) == [1,2.5,4]++>>> resamp1 3 [1]+[1.0,1.0,1.0]++>>> resamp1 7 [1,2,3,4]+[1.0,1.5,2.0,2.5,3.0,3.5,4.0]++>>> resamp1 3 [1,2,3,4]+[1.0,2.5,4.0]+-} resamp1 :: RealFrac n => Int -> [n] -> [n] resamp1 n c =-    let gen = resamp1_gen n (length c) clipAt c-    in map gen [0 .. n - 1]+  let gen = resamp1_gen n (length c) clipAt c+  in map gen [0 .. n - 1] --- | @ArrayedCollection.normalizeSum@ ensures sum of elements is one.------ > > [1,2,3].normalizeSum == [1/6,1/3,0.5]--- > normalizeSum [1,2,3] == [1/6,2/6,3/6]+{- | @ArrayedCollection.normalizeSum@ ensures sum of elements is one.++> [1,2,3].normalizeSum == [1/6,1/3,0.5]++>>> normalizeSum [1,2,3] == [1/6,2/6,3/6]+True+-} normalizeSum :: (Fractional a) => [a] -> [a] normalizeSum l = let n = sum l in map (/ n) l  -- | Variant that specifies range of input sequence separately.-normalise_rng :: Fractional n => (n,n) -> (n,n) -> [n] -> [n]-normalise_rng (il,ir) (l,r) = map (\e -> S.sc3_linlin e il ir l r)+normalise_rng :: Fractional n => (n, n) -> (n, n) -> [n] -> [n]+normalise_rng (il, ir) (l, r) = map (\e -> S.sc3_linlin e il ir l r) --- | @ArrayedCollection.normalize@ returns a new Array with the receiver--- items normalized between min and max.------ > > [1,2,3].normalize == [0,0.5,1]--- > > [1,2,3].normalize(-20,10) == [-20,-5,10]------ > normalize 0 1 [1,2,3] == [0,0.5,1]--- > normalize (-20) 10 [1,2,3] == [-20,-5,10]+{- | @ArrayedCollection.normalize@ returns a new Array with the receiver items normalized between min and max.++> [1,2,3].normalize == [0,0.5,1]+> [1,2,3].normalize(-20,10) == [-20,-5,10]++>>> normalize 0 1 [1,2,3]+[0.0,0.5,1.0]++>>> normalize (-20) 10 [1,2,3]+[-20.0,-5.0,10.0]+-} normalize :: (Fractional n, Ord n) => n -> n -> [n] -> [n]-normalize l r c = normalise_rng (minimum c,maximum c) (l,r) c+normalize l r c = normalise_rng (minimum c, maximum c) (l, r) c --- | List of 2-tuples of elements at distance (stride) /n/.------ > t2_window 3 [1..9] == [(1,2),(4,5),(7,8)]-t2_window :: Integral i => i -> [t] -> [(t,t)]+{- | List of 2-tuples of elements at distance (stride) /n/.++>>> t2_window 3 [1..9]+[(1,2),(4,5),(7,8)]+-}+t2_window :: Integral i => i -> [t] -> [(t, t)] t2_window n x =-    case x of-      i:j:_ -> (i,j) : t2_window n (genericDrop n x)-      _ -> []+  case x of+    i : j : _ -> (i, j) : t2_window n (genericDrop n x)+    _ -> [] --- | List of 2-tuples of adjacent elements.------ > t2_adjacent [1..6] == [(1,2),(3,4),(5,6)]--- > t2_adjacent [1..5] == [(1,2),(3,4)]-t2_adjacent :: [t] -> [(t,t)]-t2_adjacent = t2_window (2::Int)+{- | List of 2-tuples of adjacent elements. --- | List of 2-tuples of overlapping elements.------ > t2_overlap [1..4] == [(1,2),(2,3),(3,4)]-t2_overlap :: [b] -> [(b,b)]-t2_overlap x = zip x (tail x)+>>> t2_adjacent [1..6]+[(1,2),(3,4),(5,6)] --- | Concat of 2-tuples.------ > t2_concat (t2_adjacent [1..6]) == [1..6]--- > t2_concat (t2_overlap [1..4]) == [1,2,2,3,3,4]-t2_concat :: [(a,a)] -> [a]+>>> t2_adjacent [1..5]+[(1,2),(3,4)]+-}+t2_adjacent :: [t] -> [(t, t)]+t2_adjacent = t2_window (2 :: Int)++{- | List of 2-tuples of overlapping elements.++>>> t2_overlap [1..4]+[(1,2),(2,3),(3,4)]+-}+t2_overlap :: [b] -> [(b, b)]+t2_overlap x =+  case uncons x of+    Nothing -> error "t2_overlap"+    Just (_, t) -> zip x t++{- | Concat of 2-tuples.++>>> t2_concat (t2_adjacent [1..6])+[1,2,3,4,5,6]++>>> t2_concat (t2_overlap [1..4])+[1,2,2,3,3,4]+-}+t2_concat :: [(a, a)] -> [a] t2_concat x =-    case x of-      [] -> []-      (i,j):x' -> i : j : t2_concat x'+  case x of+    [] -> []+    (i, j) : x' -> i : j : t2_concat x'  {- | A Signal is half the size of a Wavetable, each element is the sum of two adjacent elements of the Wavetable. -> from_wavetable [-0.5,0.5,0,0.5,1.5,-0.5,1,-0.5] == [0.0,0.5,1.0,0.5]-> let s = [0,0.5,1,0.5] in from_wavetable (to_wavetable s) == s+>>> from_wavetable [-0.5,0.5,0,0.5,1.5,-0.5,1,-0.5]+[0.0,0.5,1.0,0.5]++>>> let s = [0,0.5,1,0.5]+>>> from_wavetable (to_wavetable s) == s+True -} from_wavetable :: Num n => [n] -> [n] from_wavetable = map (uncurry (+)) . t2_adjacent -{- | A Wavetable has n * 2 + 2 elements, where n is the number of elements of the Signal.+{- | A Wavetable has n * 2 elements, where n is the number of elements of the Signal.      Each signal element e0 expands to the two elements (2 * e0 - e1, e1 - e0)      where e1 is the next element, or zero at the final element.      Properly wavetables are only of power of two element signals. -> > Signal[0,0.5,1,0.5].asWavetable == Wavetable[-0.5,0.5,0,0.5,1.5,-0.5,1,-0.5]-> to_wavetable [0,0.5,1,0.5] == [-0.5,0.5,0,0.5,1.5,-0.5,1,-0.5]+> Signal[0,0.5,1,0.5].asWavetable == Wavetable[-0.5,0.5,0,0.5,1.5,-0.5,1,-0.5]++>>> to_wavetable [0,0.5,1,0.5]+[-0.5,0.5,0.0,0.5,1.5,-0.5,1.0,-0.5] -} to_wavetable :: Num a => [a] -> [a]-to_wavetable  = to_wavetable_nowrap . (++ [0])+to_wavetable = to_wavetable_nowrap . (++ [0]) --- | Shaper requires wavetables without wrap.------ > to_wavetable_nowrap [0,0.5,1,0.5] == [-0.5,0.5,0,0.5,1.5,-0.5]+{- | Shaper requires wavetables without wrap.++>>> to_wavetable_nowrap [0,0.5,1,0.5]+[-0.5,0.5,0.0,0.5,1.5,-0.5]+-} to_wavetable_nowrap :: Num a => [a] -> [a] to_wavetable_nowrap =-    let f (e0,e1) = (2 * e0 - e1,e1 - e0)-    in t2_concat . map f . t2_overlap+  let f (e0, e1) = (2 * e0 - e1, e1 - e0)+  in t2_concat . map f . t2_overlap  {- | Variant of 'sineFill' that gives each component table. -> let t = sineGen 1024 (map recip [1, 2, 3, 5, 8, 13, 21, 34, 55]) (replicate 9 0)-> map length t == replicate 9 1024+>>> let t = sineGen 1024 (map recip [1, 2, 3, 5, 8, 13, 21, 34, 55]) (replicate 9 0)+>>> map length t == replicate 9 1024+True+ > Sound.Sc3.Plot.plot_p1_ln t -}-sineGen :: (Floating n,Enum n) => Int -> [n] -> [n] -> [[n]]+sineGen :: (Floating n, Enum n) => Int -> [n] -> [n] -> [[n]] sineGen n =-    let incr = (2 * pi) / fromIntegral n-        ph partial = take n [0,incr * partial ..]-        f h amp iph = map (\z -> sin (z + iph) * amp) (ph h)-    in zipWith3 f [1..]+  let incr = (2 * pi) / fromIntegral n+      ph partial = take n [0, incr * partial ..]+      f h amp iph = map (\z -> sin (z + iph) * amp) (ph h)+  in zipWith3 f [1 ..]  {- | @Signal.*sineFill@ is a table generator.      Frequencies are partials, amplitudes and initial phases are as given.@@ -168,9 +211,8 @@ > let a = [[21,5,34,3,2,13,1,8,55],[13,8,55,34,5,21,3,1,2],[55,34,1,3,2,13,5,8,21]] > let t = map (\amp -> sineFill 1024 (map recip amp) (replicate 9 0)) a > Sound.Sc3.Plot.plot_p1_ln t- -}-sineFill :: (Ord n,Floating n,Enum n) => Int -> [n] -> [n] -> [n]+sineFill :: (Ord n, Floating n, Enum n) => Int -> [n] -> [n] -> [n] sineFill n amp iph =-    let t = sineGen n amp iph-    in normalize (-1) 1 (map sum (transpose t))+  let t = sineGen n amp iph+  in normalize (-1) 1 (map sum (transpose t))

@@ -5,14 +5,14 @@  import qualified Data.Array as A {- array -} -import qualified Sound.Sc3.Common.Buffer as  Common.Buffer {- hsc3 -}+import qualified Sound.Sc3.Common.Buffer as Common.Buffer {- hsc3 -}  -- | 'Common.Buffer.clipAt'. clipAt :: Int -> A.Array Int a -> a clipAt ix c =-    let (l,r) = A.bounds c-        f = (A.!) c-    in if ix < l then f l else if ix > r then f r else f ix+  let (l, r) = A.bounds c+      f = (A.!) c+  in if ix < l then f l else if ix > r then f r else f ix  {- | 'C.blendAtBy' of 'clipAt'. @@ -29,7 +29,7 @@ -} resamp1 :: RealFrac n => Int -> A.Array Int n -> A.Array Int n resamp1 n c =-    let (_,r) = A.bounds c-        gen = Common.Buffer.resamp1_gen n (r + 1) clipAt c-        rs = map gen [0 .. n - 1]-    in A.listArray (0,n - 1) rs+  let (_, r) = A.bounds c+      gen = Common.Buffer.resamp1_gen n (r + 1) clipAt c+      rs = map gen [0 .. n - 1]+  in A.listArray (0, n - 1) rs

@@ -1,7 +1,8 @@--- | Implementaion of server b_gen routines.------ The naming scheme is: _p generates one partial, _l generates a list--- of partials, _nrm is the unit normalised form.+{- | Implementation of server b_gen routines.++The naming scheme is: _p generates one partial, _l generates a list+of partials, _nrm is the unit normalised form.+-} module Sound.Sc3.Common.Buffer.Gen where  import Data.List {- base -}@@ -19,21 +20,23 @@  -- * sine1 --- | 'sine3_p' with zero phase.------ > import Sound.Sc3.Plot {- hsc3-plot -}--- > plot_p1_ln [sine1_p 512 (1, 1)]-sine1_p :: (Enum n, Floating n) => Int -> (n,n) -> [n]-sine1_p n (pfreq,ampl) = sine3_p n (pfreq,ampl,0)+{- | 'sine3_p' with zero phase. +> import Sound.Sc3.Plot+> plot_p1_ln [sine1_p 512 (1, 1)]+-}+sine1_p :: (Enum n, Floating n) => Int -> (n, n) -> [n]+sine1_p n (pfreq, ampl) = sine3_p n (pfreq, ampl, 0)+ -- | Series of sine wave harmonics using specified amplitudes.-sine1_l :: (Enum n,Floating n) => Int -> [n] -> [[n]]-sine1_l n = zipWith (curry (sine1_p n)) [1..]+sine1_l :: (Enum n, Floating n) => Int -> [n] -> [[n]]+sine1_l n = zipWith (curry (sine1_p n)) [1 ..] --- | 'sum_l' of 'sine1_l'.------ > plot_p1_ln [sine1 256 [1, 0.95 .. 0.5]]-sine1 :: (Enum n,Floating n) => Int -> [n] -> [n]+{- | 'sum_l' of 'sine1_l'.++> plot_p1_ln [sine1 256 [1, 0.95 .. 0.5]]+-}+sine1 :: (Enum n, Floating n) => Int -> [n] -> [n] sine1 n = sum_l . sine1_l n  {- | 'nrm_u' of 'sine1_l'.@@ -41,7 +44,7 @@ > Sound.Sc3.Plot.plot_p1_ln [sine1_nrm 256 [1, 0.95 .. 0.5]] > Sound.Sc3.Plot.plot_p1_ln [sine1_nrm 256 [1, 1/2, 1/3, 1/4, 1/5]] -}-sine1_nrm :: (Enum n,Floating n,Ord n) => Int -> [n] -> [n]+sine1_nrm :: (Enum n, Floating n, Ord n) => Int -> [n] -> [n] sine1_nrm n = nrm_u . sine1 n  -- | Variant that generates a wavetable (without guard point) suitable for the Shaper Ugen.@@ -51,7 +54,7 @@ -- * sine2  -- | Series of /n/ sine wave partials using specified frequencies and amplitudes.-sine2_l :: (Enum n,Floating n) => Int -> [(n,n)] -> [[n]]+sine2_l :: (Enum n, Floating n) => Int -> [(n, n)] -> [[n]] sine2_l n = map (sine1_p n)  {- | 'sum_l' of 'sine2_l'.@@ -59,45 +62,62 @@ > Sound.Sc3.Plot.plot_p1_ln [sine2 256 (zip [1, 2..] [1, 0.95 .. 0.5])] > Sound.Sc3.Plot.plot_p1_ln [sine2 256 (zip [1, 1.5 ..] [1, 0.95 .. 0.5])] -}-sine2 :: (Enum n,Floating n) => Int -> [(n,n)] -> [n]+sine2 :: (Enum n, Floating n) => Int -> [(n, n)] -> [n] sine2 n = sum_l . sine2_l n  -- | 'nrm_u' of 'sine2_l'.-sine2_nrm :: (Enum n,Floating n,Ord n) => Int -> [n] -> [n]+sine2_nrm :: (Enum n, Floating n, Ord n) => Int -> [n] -> [n] sine2_nrm n = nrm_u . sine1 n  -- * sine3 --- | Sine wave table at specified frequency, amplitude and phase.-sine3_p :: (Enum n,Floating n) => Int -> (n,n,n) -> [n]+{- | Sine wave table at specified frequency, amplitude and phase.+The table does not arrive back at the starting point.++>>> map (round . (* 100)) (sine3_p 8 (1, 1, 0))+[0,71,100,71,0,-71,-100,-71]+-}+sine3_p :: (Enum n, Floating n) => Int -> (n, n, n) -> [n] sine3_p n (pfreq, ampl, phase) =-    let incr = (Math.two_pi / (fromIntegral n - 0)) * pfreq -- the table should not arrive back at zero-    in map ((*) ampl . sin) (take n [phase, phase + incr ..])+  let incr = (Math.two_pi / (fromIntegral n - 0)) * pfreq+  in map ((*) ampl . sin) (take n [phase, phase + incr ..])  -- | 'map' of 'sine3_p'.-sine3_l :: (Enum n,Floating n) => Int -> [(n,n,n)] -> [[n]]+sine3_l :: (Enum n, Floating n) => Int -> [(n, n, n)] -> [[n]] sine3_l n = map (sine3_p n) --- | 'sum_l' of 'sine3_l'.------ > plot_p1_ln [sine3 256 (zip3 [1,1.5 ..] [1,0.95 .. 0.5] [0,pi/7..])]-sine3 :: (Enum n,Floating n) => Int -> [(n,n,n)] -> [n]+{- | 'sum_l' of 'sine3_l'.++> plot_p1_ln [sine3 256 (zip3 [1,1.5 ..] [1,0.95 .. 0.5] [0,pi/7..])]+-}+sine3 :: (Enum n, Floating n) => Int -> [(n, n, n)] -> [n] sine3 n = sum_l . sine3_l n  -- * cheby  {- | Generate Chebyshev waveshaping table, see b_gen_cheby.+Cf. <https://www.csounds.com/manual/html/GEN13.html> -> Sound.Sc3.Plot.plot_p1_ln [gen_cheby 256 [1, 0, 1, 1, 0, 1]]+> import Sound.Sc3.Plot+> let p x = plot_p1_ln [gen_cheby 512 x]++> p [1, 0, 1, 1, 0, 1]+> p [100, -50, -33, 25, 20, -16.7, -14.2, 12.5, 11.1, -10, -9.09, 8.333, 7.69, -7.14, -6.67, 6.25, 5.88, -5.55, -5.26, 5]+> p [100, 0, -33, 0, 20, 0, -14.2, 0, 11.1, 0, -9.09, 0, 7.69, 0, -6.67, 0, 5.88, 0, -5.26]+> p [100, 0, -11.11, 0, 4, 0, -2.04, 0, 1.23, 0, -0.826, 0, 0.59, 0, -0.444, 0, 0.346, 0, -0.277]+> p [1, -0.8, 0, 0.6, 0, 0, 0, 0.4, 0, 0, 0, 0, 0.1, -0.2, -0.3, 0.5]+> p [0, 0, -0.1, 0, 0.3, 0, -0.5, 0, 0.7, 0, -0.9, 0, 1, 0, -1, 0]+> p [0, 0, 0, 0, 0, 0, -1, 0, 1, 0, 0, -0.1, 0, 0.1, 0, -0.2, 0.3, 0, -0.7, 0, 0.2, 0, -0.1]+> p [5, 0, 3, 0, 1] -} gen_cheby :: (Enum n, Floating n, Ord n, Integral i) => i -> [n] -> [n] gen_cheby n =-    let acos' x = if x > 1 then 0 else if x < -1 then pi else acos x-        c k x = cos (k * acos' x)-        ix = [-1, -1 + (2 / (fromIntegral n - 1)) .. 1] -- increment?-        mix = map sum . transpose-        c_normalize x = let m = maximum (map abs x) in map (* recip m) x-    in c_normalize . mix . zipWith (\k a -> map ((* a) . c k) ix) [1..]+  let acos' x = if x > 1 then 0 else if x < -1 then pi else acos x+      c k x = cos (k * acos' x)+      ix = [-1, -1 + (2 / (fromIntegral n - 1)) .. 1] -- increment?+      mix = map sum . transpose+      c_normalize x = let m = maximum (map abs x) in map (* recip m) x+  in c_normalize . mix . zipWith (\k a -> map ((* a) . c k) ix) [1 ..]  -- | Type specialised 'gen_cheby'. cheby :: (Enum n, Floating n, Ord n) => Int -> [n] -> [n]

@@ -10,9 +10,9 @@ -- | 'C.clipAt'. clipAt :: V.Storable t => Int -> V.Vector t -> t clipAt ix c =-    let r = V.length c-        f = (V.!) c-    in if ix > r - 1 then f (r - 1) else f ix+  let r = V.length c+      f = (V.!) c+  in if ix > r - 1 then f (r - 1) else f ix  {- | 'C.blendAtBy' of 'clipAt'. @@ -20,14 +20,14 @@ > Sound.Sc3.Common.Buffer.Vector.blendAt 0.4 (V.fromList [2,5,6]) == 3.2 > Sound.Sc3.Common.Buffer.Vector.blendAt 2.1 (V.fromList [2,5,6]) == 6 -}-blendAt :: (V.Storable t,RealFrac t) => t -> V.Vector t -> t+blendAt :: (V.Storable t, RealFrac t) => t -> V.Vector t -> t blendAt = C.blendAtBy clipAt  {- | 'C.from_wavetable'  > Sound.Sc3.Common.Buffer.Vector.from_wavetable (V.fromList [-0.5,0.5,0,0.5,1.5,-0.5,1,-0.5]) -}-from_wavetable :: (V.Storable t,Num t) => V.Vector t -> V.Vector t+from_wavetable :: (V.Storable t, Num t) => V.Vector t -> V.Vector t from_wavetable wt =   let n = V.length wt       f k = let k2 = k * 2 in (wt V.! k2) + (wt V.! (k2 + 1))@@ -38,7 +38,7 @@ > Sound.Sc3.Common.Buffer.Vector.resamp1 12 (V.fromList [1,2,3,4]) > Sound.Sc3.Common.Buffer.Vector.resamp1 3 (V.fromList [1,2,3,4]) == V.fromList [1,2.5,4] -}-resamp1 :: (V.Storable t,RealFrac t) => Int -> V.Vector t -> V.Vector t+resamp1 :: (V.Storable t, RealFrac t) => Int -> V.Vector t -> V.Vector t resamp1 n c =-    let gen = C.resamp1_gen n (V.length c) clipAt c-    in V.generate n gen+  let gen = C.resamp1_gen n (V.length c) clipAt c+  in V.generate n gen

@@ -9,7 +9,7 @@ -- | Format a Context as a sequence of import commands. context_format :: Context -> [String] context_format =-  let f (moduleName,qualifier,packageName) =+  let f (moduleName, qualifier, packageName) =         case qualifier of           Nothing -> printf "import %s {- %s -}" moduleName packageName           Just qualifierName -> printf "import qualified %s as %s {- %s -}" moduleName qualifierName packageName@@ -22,39 +22,41 @@ -- | Minimal hsc3 context min_context :: Context min_context =-  [("Prelude",Nothing,"base")-  ,("Control.Monad",Nothing,"base")-  ,("Data.Bits",Nothing,"base")-  ,("Data.Function",Nothing,"base")-  ,("Data.List",Nothing,"base")-  ,("Sound.Sc3",Nothing,"hsc3")]+  [ ("Prelude", Nothing, "base")+  , ("Control.Monad", Nothing, "base")+  , ("Data.Bits", Nothing, "base")+  , ("Data.Function", Nothing, "base")+  , ("Data.List", Nothing, "base")+  , ("Sound.Sc3", Nothing, "hsc3")+  ]  -- | Standard hsc3 context std_context :: Context std_context =-  [("Prelude",Nothing,"base")-  ,("Control.Monad",Nothing,"base")-  ,("Data.Bits",Nothing,"base")-  ,("Data.Function",Nothing,"base")-  ,("Data.List",Nothing,"base")-  ,("System.Random",Nothing,"random")-  ,("Sound.Osc",Nothing,"hosc")-  ,("Sound.Sc3",Nothing,"hsc3")-  ,("Sound.Sc3.Common.Base",Just "Sound.Sc3.Common.Base","hsc3")-  ,("Sound.Sc3.Common.Buffer.Gen",Just "Gen","hsc3")-  ,("Sound.Sc3.Common.Math.Filter.Beq",Just "Sound.Sc3.Common.Math.Filter.Beq","hsc3")-  ,("Sound.Sc3.Ugen.Bindings.Db.External",Just "X","hsc3")-  ,("Sound.Sc3.Ugen.Bindings.Composite.External",Just "X","hsc3")-  ,("Sound.Sc3.Ugen.Bindings.Hw.External.F0",Just "X","hsc3")-  ,("Sound.Sc3.Ugen.Bindings.Hw.External.SC3_Plugins",Just "X","hsc3")-  ,("Sound.Sc3.Ugen.Bindings.Hw.External.Zita",Just "X","hsc3")-  ,("Sound.Sc3.Ugen.Bindings.Db.Rdu",Just "X","sc3-rdu")-  ,("Sound.Sc3.Ugen.Dot",Just "Sound.Sc3.Ugen.Dot","hsc3-dot")-  ,("Sound.Sc3.Ugen.Unsafe",Nothing,"hsc3-unsafe")-  ,("Sound.Sc3.Ugen.Unsafe",Nothing,"hsc3-unsafe")-  ,("Sound.Sc3.Ugen.Protect",Just "Protect","hsc3-rw")-  ,("Sound.Sc3.Ui.Html",Just "Ui","hsc3-ui")-  ,("Sound.Sc3.Ui.Plot",Just "Ui","hsc3-ui")-  ,("Sound.Sc3.Ui.Qarma",Just "Ui","hsc3-ui")-  ,("Sound.Sc3.Ui.ScLang",Just "Ui","hsc3-ui")-  ,("Sound.Sc3.Ui.ScLang.Control",Just "Ui","hsc3-ui")]+  [ ("Prelude", Nothing, "base")+  , ("Control.Monad", Nothing, "base")+  , ("Data.Bits", Nothing, "base")+  , ("Data.Function", Nothing, "base")+  , ("Data.List", Nothing, "base")+  , ("System.Random", Nothing, "random")+  , ("Sound.Osc", Nothing, "hosc")+  , ("Sound.Sc3", Nothing, "hsc3")+  , ("Sound.Sc3.Common.Base", Just "Sound.Sc3.Common.Base", "hsc3")+  , ("Sound.Sc3.Common.Buffer.Gen", Just "Gen", "hsc3")+  , ("Sound.Sc3.Common.Math.Filter.Beq", Just "Sound.Sc3.Common.Math.Filter.Beq", "hsc3")+  , ("Sound.Sc3.Ugen.Bindings.Db.External", Just "X", "hsc3")+  , ("Sound.Sc3.Ugen.Bindings.Composite.External", Just "X", "hsc3")+  , ("Sound.Sc3.Ugen.Bindings.Hw.External.F0", Just "X", "hsc3")+  , ("Sound.Sc3.Ugen.Bindings.Hw.External.SC3_Plugins", Just "X", "hsc3")+  , ("Sound.Sc3.Ugen.Bindings.Hw.External.Zita", Just "X", "hsc3")+  , ("Sound.Sc3.Ugen.Bindings.Db.Rdu", Just "X", "sc3-rdu")+  , ("Sound.Sc3.Ugen.Dot", Just "Sound.Sc3.Ugen.Dot", "hsc3-dot")+  , ("Sound.Sc3.Ugen.Unsafe", Nothing, "hsc3-unsafe")+  , ("Sound.Sc3.Ugen.Unsafe", Nothing, "hsc3-unsafe")+  , ("Sound.Sc3.Ugen.Protect", Just "Protect", "hsc3-rw")+  , ("Sound.Sc3.Ui.Html", Just "Ui", "hsc3-ui")+  , ("Sound.Sc3.Ui.Plot", Just "Ui", "hsc3-ui")+  , ("Sound.Sc3.Ui.Qarma", Just "Ui", "hsc3-ui")+  , ("Sound.Sc3.Ui.ScLang", Just "Ui", "hsc3-ui")+  , ("Sound.Sc3.Ui.ScLang.Control", Just "Ui", "hsc3-ui")+  ]

@@ -4,9 +4,11 @@ -- * Loop  -- | Loop indicator input.-data Loop t =-    NoLoop -- ^ 0-  | Loop -- ^ 1+data Loop t+  = -- | 0+    NoLoop+  | -- | 1+    Loop   | WithLoop t   deriving (Eq, Show) @@ -25,16 +27,16 @@ -- | Resolve 'Loop'. from_loop :: Num t => Loop t -> t from_loop e =-    case e of-      NoLoop -> 0-      Loop -> 1-      WithLoop u -> u+  case e of+    NoLoop -> 0+    Loop -> 1+    WithLoop u -> u  -- * Interpolation  -- | Interpolation indicator input.-data Interpolation t =-    NoInterpolation+data Interpolation t+  = NoInterpolation   | LinearInterpolation   | CubicInterpolation   | WithInterpolation t@@ -43,11 +45,11 @@ -- | Resolve 'Interpolation'. from_interpolation :: Num t => Interpolation t -> t from_interpolation e =-    case e of-      NoInterpolation -> 1-      LinearInterpolation -> 2-      CubicInterpolation -> 4-      WithInterpolation u -> u+  case e of+    NoInterpolation -> 1+    LinearInterpolation -> 2+    CubicInterpolation -> 4+    WithInterpolation u -> u  -- * DoneAction @@ -63,12 +65,12 @@ -- | Apply /f/ at 'WithDoneAction'. done_action_map :: (t -> u) -> DoneAction t -> DoneAction u done_action_map f e =-    case e of-      DoNothing -> DoNothing-      PauseSynth -> PauseSynth-      RemoveSynth -> RemoveSynth-      RemoveGroup -> RemoveGroup-      WithDoneAction x -> WithDoneAction (f x)+  case e of+    DoNothing -> DoNothing+    PauseSynth -> PauseSynth+    RemoveSynth -> RemoveSynth+    RemoveGroup -> RemoveGroup+    WithDoneAction x -> WithDoneAction (f x)  -- | fmap is 'done_action_map' instance Functor DoneAction where@@ -77,39 +79,41 @@ -- | Resolve 'DoneAction'. from_done_action :: Num t => DoneAction t -> t from_done_action e =-    case e of-      DoNothing -> 0-      PauseSynth -> 1-      RemoveSynth -> 2-      RemoveGroup -> 14-      WithDoneAction x -> x+  case e of+    DoNothing -> 0+    PauseSynth -> 1+    RemoveSynth -> 2+    RemoveGroup -> 14+    WithDoneAction x -> x  -- * Warp  -- | Warp interpolation indicator input.-data Warp t =-    Linear+data Warp t+  = Linear   | Exponential   | WithWarp t   deriving (Eq, Show) --- | Resolve 'Warp'.------ > map from_warp [Linear,Exponential] == [0,1]+{- | Resolve 'Warp'.++>>> map from_warp [Linear,Exponential]+[0,1]+-} from_warp :: Num t => Warp t -> t from_warp e =-    case e of-      Linear -> 0-      Exponential -> 1-      WithWarp u -> u+  case e of+    Linear -> 0+    Exponential -> 1+    WithWarp u -> u  -- | Apply /f/ at 'WithWarp' warp_map :: (t -> u) -> Warp t -> Warp u warp_map f e =-    case e of-      Linear -> Linear-      Exponential -> Exponential-      WithWarp u -> WithWarp (f u)+  case e of+    Linear -> Linear+    Exponential -> Exponential+    WithWarp u -> WithWarp (f u)  -- | fmap = 'warp_map' instance Functor Warp where@@ -118,7 +122,7 @@ -- * Buffer  -- | Unification of integer and 'Ugen' buffer identifiers.-data Buffer t =-    Buffer_Id Int+data Buffer t+  = Buffer_Id Int   | Buffer t   deriving (Eq, Show)

@@ -4,18 +4,21 @@ import Data.List {- base -} import Data.Maybe {- base -} +import qualified Safe {- safe -}+ import qualified Sound.Sc3.Common.Base as Base {- hsc3 -} import qualified Sound.Sc3.Common.Math.Interpolate as Interpolate {- hsc3 -}  -- * Curve  -- | Envelope curve indicator input.-data Envelope_Curve a =-  EnvStep+data Envelope_Curve a+  = EnvStep   | EnvLin   | EnvExp   | EnvSin-  | EnvWelch -- ^ Note: not implemented at Sc3+  | -- | Note: not implemented at Sc3+    EnvWelch   | EnvNum a   | EnvSqr   | EnvCub@@ -31,78 +34,87 @@ -- | Envelope curve quadruple. type Envelope_Curve_4 a = Base.T4 (Envelope_Curve a) --- | Convert 'Envelope_Curve' to shape value.------ > map env_curve_shape [EnvSin,EnvSqr] == [3,6]+{- | Convert 'Envelope_Curve' to shape value.++>>> map env_curve_shape [EnvSin,EnvSqr]+[3,6]+-} env_curve_shape :: Num a => Envelope_Curve a -> a env_curve_shape e =-    case e of-      EnvStep -> 0-      EnvLin -> 1-      EnvExp -> 2-      EnvSin -> 3-      EnvWelch -> 4-      EnvNum _ -> 5-      EnvSqr -> 6-      EnvCub -> 7-      EnvHold -> 8+  case e of+    EnvStep -> 0+    EnvLin -> 1+    EnvExp -> 2+    EnvSin -> 3+    EnvWelch -> 4+    EnvNum _ -> 5+    EnvSqr -> 6+    EnvCub -> 7+    EnvHold -> 8 --- | The /value/ of 'EnvCurve' is non-zero for 'EnvNum'.------ > map env_curve_value [EnvWelch,EnvNum 2] == [0,2]+{- | The /value/ of 'EnvCurve' is non-zero for 'EnvNum'.++>>> map env_curve_value [EnvWelch,EnvNum 2]+[0,2]+-} env_curve_value :: Num a => Envelope_Curve a -> a env_curve_value e =-    case e of-      EnvNum u -> u-      _ -> 0+  case e of+    EnvNum u -> u+    _ -> 0  -- | 'Interpolation_f' of 'Envelope_Curve'. env_curve_interpolation_f :: (Ord t, Floating t) => Envelope_Curve t -> Interpolate.Interpolation_f t env_curve_interpolation_f c =-    case c of-      EnvStep -> Interpolate.step-      EnvLin -> Interpolate.linear-      EnvExp -> Interpolate.exponential-      EnvSin -> Interpolate.sine-      EnvWelch -> Interpolate.welch-      EnvNum n -> Interpolate.curve n-      EnvSqr -> Interpolate.squared-      EnvCub -> Interpolate.cubed-      EnvHold -> undefined+  case c of+    EnvStep -> Interpolate.step+    EnvLin -> Interpolate.linear+    EnvExp -> Interpolate.exponential+    EnvSin -> Interpolate.sine+    EnvWelch -> Interpolate.welch+    EnvNum n -> Interpolate.curve n+    EnvSqr -> Interpolate.squared+    EnvCub -> Interpolate.cubed+    EnvHold -> undefined  -- | Apply /f/ to 'EnvNum' value. env_curve_map :: (a -> b) -> Envelope_Curve a -> Envelope_Curve b env_curve_map f e =-    case e of-      EnvStep -> EnvStep-      EnvLin -> EnvLin-      EnvExp -> EnvExp-      EnvSin -> EnvSin-      EnvWelch -> EnvWelch-      EnvNum x -> EnvNum (f x)-      EnvSqr -> EnvSqr-      EnvCub -> EnvCub-      EnvHold -> EnvHold+  case e of+    EnvStep -> EnvStep+    EnvLin -> EnvLin+    EnvExp -> EnvExp+    EnvSin -> EnvSin+    EnvWelch -> EnvWelch+    EnvNum x -> EnvNum (f x)+    EnvSqr -> EnvSqr+    EnvCub -> EnvCub+    EnvHold -> EnvHold  -- * Envelope  -- | Sc3 envelope segment model-data Envelope a =-    Envelope-    {env_levels :: [a] -- ^ Set of /n/ levels, n is >= 1-    ,env_times :: [a] -- ^ Set of /n-1/ time intervals-    ,env_curves :: [Envelope_Curve a] -- ^ Possibly empty curve set-    ,env_release_node :: Maybe Int -- ^ Maybe index to release node-    ,env_loop_node :: Maybe Int -- ^ Maybe index to loop node-    ,env_offset :: a -- ^ An offset for all time values (IEnvGen only)-    }-    deriving (Eq,Show)+data Envelope a = Envelope+  { env_levels :: [a]+  -- ^ Set of /n/ levels, n is >= 1+  , env_times :: [a]+  -- ^ Set of /n-1/ time intervals+  , env_curves :: [Envelope_Curve a]+  -- ^ Possibly empty curve set+  , env_release_node :: Maybe Int+  -- ^ Maybe index to release node+  , env_loop_node :: Maybe Int+  -- ^ Maybe index to loop node+  , env_offset :: a+  -- ^ An offset for all time values (IEnvGen only)+  }+  deriving (Eq, Show)  -- | Apply /f/ to all /a/ at 'Envelope'. envelope_map :: (a -> b) -> Envelope a -> Envelope b envelope_map f e =-    let Envelope l t c rn ln os = e-    in Envelope (map f l) (map f t) (map (env_curve_map f) c) rn ln (f os)+  let Envelope l t c rn ln os = e+  in Envelope (map f l) (map f t) (map (env_curve_map f) c) rn ln (f os)  -- | fmap = 'envelope_map' instance Functor Envelope where@@ -126,139 +138,142 @@ -- | Determine which envelope segment a given time /t/ falls in. envelope_segment_ix :: (Ord a, Num a) => Envelope a -> a -> Maybe Int envelope_segment_ix e t =-    let d = Base.dx_d (env_times e)-    in findIndex (>= t) d+  let d = Base.dx_d (env_times e)+  in findIndex (>= t) d  -- | A set of start time, start level, end time, end level and curve.-type Envelope_Segment t = (t,t,t,t,Envelope_Curve t)+type Envelope_Segment t = (t, t, t, t, Envelope_Curve t)  -- | Extract envelope segment given at index /i/. envelope_segment :: Num t => Envelope t -> Int -> Envelope_Segment t envelope_segment e i =-    let l = env_levels e-        t = env_times e-        x0 = l !! i-        x1 = l !! (i + 1)-        t0 = (0 : Base.dx_d t) !! i-        t1 = t0 + t !! i-        c = envelope_curves e !! i-    in (t0,x0,t1,x1,c)+  let l = env_levels e+      t = env_times e+      x0 = l !! i+      x1 = l !! (i + 1)+      t0 = (0 : Base.dx_d t) !! i+      t1 = t0 + t !! i+      c = envelope_curves e !! i+  in (t0, x0, t1, x1, c)  -- | Extract all segments. envelope_segments :: Num t => Envelope t -> [Envelope_Segment t] envelope_segments e =-    let n = envelope_n_segments e-    in map (envelope_segment e) [0 .. n - 1]+  let n = envelope_n_segments e+  in map (envelope_segment e) [0 .. n - 1]  -- | Transform list of 'Envelope_Segment's into lists ('env_levels','env_times','env_curves').-pack_envelope_segments :: Num t => [Envelope_Segment t] -> ([t],[t],[Envelope_Curve t])+pack_envelope_segments :: Num t => [Envelope_Segment t] -> ([t], [t], [Envelope_Curve t]) pack_envelope_segments s =-    case s of-      [] -> error ""-      [(t0,l0,t1,l1,c)] -> ([l0,l1],[t1 - t0],[c])-      (_,l0,_,_,_) : _ ->-          let t (t0,_,t1,_,_) = t1 - t0-              c (_,_,_,_,x) = x-              l (_,_,_,x,_) = x-          in (l0 : map l s,map t s,map c s)+  case s of+    [] -> error ""+    [(t0, l0, t1, l1, c)] -> ([l0, l1], [t1 - t0], [c])+    (_, l0, _, _, _) : _ ->+      let t (t0, _, t1, _, _) = t1 - t0+          c (_, _, _, _, x) = x+          l (_, _, _, x, _) = x+      in (l0 : map l s, map t s, map c s)  -- | An envelope is /normal/ if it has no segments with zero duration.-envelope_is_normal :: (Eq n,Num n) => Envelope n -> Bool+envelope_is_normal :: (Eq n, Num n) => Envelope n -> Bool envelope_is_normal = notElem 0 . env_times  -- | Normalise envelope by deleting segments of zero duration. envelope_normalise :: (Num a, Ord a) => Envelope a -> Envelope a envelope_normalise e =-    let s = envelope_segments e-        f (t0,_,t1,_,_) = t1 <= t0-        s' = filter (not . f) s-        (l,t,c) = pack_envelope_segments s'-    in case e of-         Envelope _ _ _ Nothing Nothing  os -> Envelope l t c Nothing Nothing os-         _ -> error "envelope_normalise: has release or loop node..."+  let s = envelope_segments e+      f (t0, _, t1, _, _) = t1 <= t0+      s' = filter (not . f) s+      (l, t, c) = pack_envelope_segments s'+  in case e of+      Envelope _ _ _ Nothing Nothing os -> Envelope l t c Nothing Nothing os+      _ -> error "envelope_normalise: has release or loop node..." --- | Get value for 'Envelope' at time /t/, or zero if /t/ is out of--- range.  By convention if the envelope has a segment of zero--- duration we give the rightmost value.+{- | Get value for 'Envelope' at time /t/, or zero if /t/ is out of+range.  By convention if the envelope has a segment of zero+duration we give the rightmost value.+-} envelope_at :: (Ord t, Floating t) => Envelope t -> t -> t envelope_at e t =-    case envelope_segment_ix e t of-      Just n -> let (t0,x0,t1,x1,c) = envelope_segment e n-                    d = t1 - t0-                    t' = (t - t0) / d-                    f = env_curve_interpolation_f c-                in if d <= 0-                   then x1-                   else f x0 x1 t'-      Nothing -> 0+  case envelope_segment_ix e t of+    Just n ->+      let (t0, x0, t1, x1, c) = envelope_segment e n+          d = t1 - t0+          t' = (t - t0) / d+          f = env_curve_interpolation_f c+      in if d <= 0+          then x1+          else f x0 x1 t'+    Nothing -> 0  -- | Render 'Envelope' to breakpoint set of /n/ equi-distant places.-envelope_render :: (Ord t, Floating t, Enum t) => Int -> Envelope t -> [(t,t)]+envelope_render :: (Ord t, Floating t, Enum t) => Int -> Envelope t -> [(t, t)] envelope_render n e =-    let d = envelope_duration e-        k = d / (fromIntegral n - 1)-        t = [0,k .. d]-    in zip t (map (envelope_at e) t)+  let d = envelope_duration e+      k = d / (fromIntegral n - 1)+      t = [0, k .. d]+  in zip t (map (envelope_at e) t)  -- | Contruct a lookup table of /n/ places from 'Envelope'. envelope_table :: (Ord t, Floating t, Enum t) => Int -> Envelope t -> [t] envelope_table n = map snd . envelope_render n --- | Variant on 'env_curves' that expands the, possibly empty, user--- list by cycling (if not empty) or by filling with 'EnvLin'.+{- | Variant on 'env_curves' that expands the, possibly empty, user+list by cycling (if not empty) or by filling with 'EnvLin'.+-} envelope_curves :: Envelope a -> [Envelope_Curve a] envelope_curves e =-    let c = env_curves e-        n = envelope_n_segments e-    in if null c-       then replicate n EnvLin-       else take n (cycle c)+  let c = env_curves e+      n = envelope_n_segments e+  in if null c+      then replicate n EnvLin+      else take n (cycle c)  {- | Linear Sc3 form of 'Envelope' data.  Form is: l0 #t reset loop l1 t0 c0 c0' ... -envelope_sc3_array (envelope [0,1] [0.1] [EnvLin]) == Just [0,1,-99,-99,1,0.1,1,0]+>>> envelope_sc3_array (envelope [0,1] [0.1] [EnvLin])+Just [0.0,1.0,-99.0,-99.0,1.0,0.1,1.0,0.0] -> let l = [0,0.6,0.3,1.0,0]-> let t = [0.1,0.02,0.4,1.1]-> let c = [EnvLin,EnvExp,EnvNum (-6),EnvSin]-> let e = Envelope l t c Nothing Nothing 0-> let r = [0,4,-99,-99,0.6,0.1,1,0,0.3,0.02,2,0,1,0.4,5,-6,0,1.1,3,0]-> envelope_sc3_array e == Just r+>>> let l = [0,0.6,0.3,1.0,0]+>>> let t = [0.1,0.02,0.4,1.1]+>>> let c = [EnvLin,EnvExp,EnvNum (-6),EnvSin]+>>> envelope_sc3_array (Envelope l t c Nothing Nothing 0)+Just [0.0,4.0,-99.0,-99.0,0.6,0.1,1.0,0.0,0.3,2.0e-2,2.0,0.0,1.0,0.4,5.0,-6.0,0.0,1.1,3.0,0.0] -} envelope_sc3_array :: Num a => Envelope a -> Maybe [a] envelope_sc3_array e =-    let Envelope l t _ rn ln _ = e-        n = length t-        n' = fromIntegral n-        rn' = fromIntegral (fromMaybe (-99) rn)-        ln' = fromIntegral (fromMaybe (-99) ln)-        c = envelope_curves e-        f i j k = [i,j,env_curve_shape k,env_curve_value k]-    in case l of-         l0:l' -> Just (l0 : n' : rn' : ln' : concat (zipWith3 f l' t c))-         _ -> Nothing+  let Envelope l t _ rn ln _ = e+      n = length t+      n' = fromIntegral n+      rn' = fromIntegral (fromMaybe (-99) rn)+      ln' = fromIntegral (fromMaybe (-99) ln)+      c = envelope_curves e+      f i j k = [i, j, env_curve_shape k, env_curve_value k]+  in case l of+      l0 : l' -> Just (l0 : n' : rn' : ln' : concat (zipWith3 f l' t c))+      _ -> Nothing  {- | @IEnvGen@ Sc3 form of 'Envelope' data. -> l = [0,0.6,0.3,1.0,0]-> t = [0.1,0.02,0.4,1.1]-> c = [EnvLin,EnvExp,EnvNum (-6),EnvSin]-> e = Envelope l t c Nothing Nothing 0-> r = [0,0,4,1.62,0.1,1,0,0.6,0.02,2,0,0.3,0.4,5,-6,1,1.1,3,0,0]-> envelope_sc3_ienvgen_array e == Just r+>>> let l = [0,0.6,0.3,1.0,0]+>>> let t = [0.1,0.02,0.4,1.1]+>>> let c = [EnvLin,EnvExp,EnvNum (-6),EnvSin]+>>> let e = Envelope l t c Nothing Nothing 0+>>> envelope_sc3_ienvgen_array e+Just [0.0,0.0,4.0,1.62,0.1,1.0,0.0,0.6,2.0e-2,2.0,0.0,0.3,0.4,5.0,-6.0,1.0,1.1,3.0,0.0,0.0] -} envelope_sc3_ienvgen_array :: Num a => Envelope a -> Maybe [a] envelope_sc3_ienvgen_array e =-    let Envelope l t _ _ _ os = e-        n = length t-        n' = fromIntegral n-        c = envelope_curves e-        f i j k = [j,env_curve_shape k,env_curve_value k,i]-    in case l of-         l0:l' -> Just (os : l0 : n' : sum t : concat (zipWith3 f l' t c))-         _ -> Nothing+  let Envelope l t _ _ _ os = e+      n = length t+      n' = fromIntegral n+      c = envelope_curves e+      f i j k = [j, env_curve_shape k, env_curve_value k, i]+  in case l of+      l0 : l' -> Just (os : l0 : n' : sum t : concat (zipWith3 f l' t c))+      _ -> Nothing  -- | 'True' if 'env_release_node' is not 'Nothing'. env_is_sustained :: Envelope a -> Bool@@ -267,31 +282,34 @@ -- | Delay the onset of the envelope (add initial segment). env_delay :: Envelope a -> a -> Envelope a env_delay (Envelope l t c rn ln os) d =-    let l0 = head l-        l' = l0 : l-        t' = d : t-        c' = EnvLin : c-        rn' = fmap (+ 1) rn-        ln' = fmap (+ 1) ln-    in Envelope l' t' c' rn' ln' os+  let l0 = Safe.headNote "env_delay" l+      l' = l0 : l+      t' = d : t+      c' = EnvLin : c+      rn' = fmap (+ 1) rn+      ln' = fmap (+ 1) ln+  in Envelope l' t' c' rn' ln' os --- | Connect releaseNode (or end) to first node of envelope.--- z is a value that is first zero and thereafter one.--- tc & cc are time and curve from first to last.+{- | Connect releaseNode (or end) to first node of envelope.+z is a value that is first zero and thereafter one.+tc & cc are time and curve from first to last.+-} env_circle_z :: Fractional a => a -> a -> Envelope_Curve a -> Envelope a -> Envelope a env_circle_z z tc cc (Envelope l t c rn _ os) =-    let n = length t-    in case rn of-         Nothing -> let l' = 0 : l ++ [0]-                        t' = z * tc : t ++ [1] -- inf (but drawings are poor)-                        c' = cc : take n (cycle c) ++ [EnvLin]-                        rn' = Just (n + 1)-                    in Envelope l' t' c' rn' (Just 0) os-         Just i -> let l' = 0 : l-                       t' = z * tc : t-                       c' = cc : take n (cycle c)-                       rn' = Just (i + 1)-                   in  Envelope l' t' c' rn' (Just 0) os+  let n = length t+  in case rn of+      Nothing ->+        let l' = 0 : l ++ [0]+            t' = z * tc : t ++ [1] -- inf (but drawings are poor)+            c' = cc : take n (cycle c) ++ [EnvLin]+            rn' = Just (n + 1)+        in Envelope l' t' c' rn' (Just 0) os+      Just i ->+        let l' = 0 : l+            t' = z * tc : t+            c' = cc : take n (cycle c)+            rn' = Just (i + 1)+        in Envelope l' t' c' rn' (Just 0) os  -- | env_circle_z with cycle time of zero. env_circle_0 :: Fractional a => Envelope a -> Envelope a@@ -308,87 +326,94 @@ envelope; 2. @skew@ determines the attack\/decay ratio, zero is an immediate attack and a slow decay, one a slow attack and an immediate decay; 3. @duration@ in seconds; 4. @amplitude@ as linear gain.- -}-envTrapezoid_f :: Num t => (t -> t -> t,t -> t -> t) -> t -> t -> t -> t -> Envelope t-envTrapezoid_f (lte_f,gte_f) shape skew dur amp =-    let x1 = skew * (1 - shape)-        bp = [(0,lte_f skew 0)-             ,(x1,1)-             ,(shape + x1,1)-             ,(1,gte_f skew 1)]-    in envCoord bp dur amp EnvLin+envTrapezoid_f :: Num t => (t -> t -> t, t -> t -> t) -> t -> t -> t -> t -> Envelope t+envTrapezoid_f (lte_f, gte_f) shape skew dur amp =+  let x1 = skew * (1 - shape)+      bp =+        [ (0, lte_f skew 0)+        , (x1, 1)+        , (shape + x1, 1)+        , (1, gte_f skew 1)+        ]+  in envCoord bp dur amp EnvLin  {- | Coordinate based static envelope generator.  Points are (time,value) pairs. -> let e = envCoord [(0,0),(1/4,1),(1,0)] 1 1 EnvLin-> envelope_sc3_array e == Just [0,2,-99,-99,1,1/4,1,0,0,3/4,1,0]+>>> let e = envCoord [(0,0),(1/4,1),(1,0)] 1 1 EnvLin+>>> envelope_sc3_array e+Just [0.0,2.0,-99.0,-99.0,1.0,0.25,1.0,0.0,0.0,0.75,1.0,0.0] -> import Sound.Sc3.Plot {- hsc3-plot -}+> import Sound.Sc3.Plot {\- hsc3-plot -\} > plotEnvelope [envCoord [(0,0),(1/4,1),(1,0)] 1 1 EnvLin] -}-envCoord :: Num n => [(n,n)] -> n -> n -> Envelope_Curve n -> Envelope n-envCoord xy dur amp c = envXyc (map (\(x,y) -> (x * dur,y * amp,c)) xy)+envCoord :: Num n => [(n, n)] -> n -> n -> Envelope_Curve n -> Envelope n+envCoord xy dur amp c = envXyc (map (\(x, y) -> (x * dur, y * amp, c)) xy) --- | Segments given as pairs of (time,level).---   The input is sorted by time before processing.------ > envPairs [(0, 1), (3, 1.4), (2.1, 0.5)] EnvSin-envPairs :: (Num n,Ord n) => [(n,n)] -> Envelope_Curve n -> Envelope n+{- | Segments given as pairs of (time,level).+The input is sorted by time before processing.++>>> env_levels (envPairs [(0, 1), (3, 1.4), (2.1, 0.5)] EnvSin)+[1.0,0.5,1.4]+-}+envPairs :: (Num n, Ord n) => [(n, n)] -> Envelope_Curve n -> Envelope n envPairs xy = envCoord (Base.sort_on fst xy) 1 1  -- | Percussive envelope, with attack, release, level and curve inputs. envPerc_c :: Num a => a -> a -> a -> Envelope_Curve_2 a -> Envelope a-envPerc_c atk rls lvl (c0,c1) =-    let c = [c0,c1]-    in Envelope [0,lvl,0] [atk,rls] c Nothing Nothing 0+envPerc_c atk rls lvl (c0, c1) =+  let c = [c0, c1]+  in Envelope [0, lvl, 0] [atk, rls] c Nothing Nothing 0  -- | Percussive envelope, with attack and release inputs. envPerc :: Num a => a -> a -> Envelope a envPerc atk rls =-    let cn = EnvNum (-4)-    in envPerc_c atk rls 1 (cn,cn)+  let cn = EnvNum (-4)+  in envPerc_c atk rls 1 (cn, cn) --- | Triangular envelope, with duration and level inputs.------ > let e = envTriangle 1 0.1--- > envelope_sc3_array e == Just [0,2,-99,-99,0.1,0.5,1,0,0,0.5,1,0]+{- | Triangular envelope, with duration and level inputs.++>>> let e = envTriangle 1 0.1+>>> envelope_sc3_array e+Just [0.0,2.0,-99.0,-99.0,0.1,0.5,1.0,0.0,0.0,0.5,1.0,0.0]+-} envTriangle :: Fractional a => a -> a -> Envelope a envTriangle dur lvl =-    let c = replicate 2 EnvLin-        d = replicate 2 (dur / 2)-    in Envelope [0,lvl,0] d c Nothing Nothing 0+  let c = replicate 2 EnvLin+      d = replicate 2 (dur / 2)+  in Envelope [0, lvl, 0] d c Nothing Nothing 0 --- | Sine envelope, with duration and level inputs.------ > let e = envSine 0 0.1--- > envelope_sc3_array e == Just [0,2,-99,-99,0.1,0.5,1,0,0,0.5,1,0]+{- | Sine envelope, with duration and level inputs.++>>> envelope_sc3_array (envSine 0 0.1)+Just [0.0,2.0,-99.0,-99.0,0.1,0.0,3.0,0.0,0.0,0.0,3.0,0.0]+-} envSine :: Fractional a => a -> a -> Envelope a envSine dur lvl =-    let c = replicate 2 EnvSin-        d = replicate 2 (dur / 2)-    in Envelope [0,lvl,0] d c Nothing Nothing 0+  let c = replicate 2 EnvSin+      d = replicate 2 (dur / 2)+  in Envelope [0, lvl, 0] d c Nothing Nothing 0  -- | Parameters for Linen envelopes.-data Linen a =-  Linen-  {linen_attackTime :: a-  ,linen_sustainTime :: a-  ,linen_releaseTime :: a-  ,linen_level :: a-  ,linen_curve :: Envelope_Curve_3 a}+data Linen a = Linen+  { linen_attackTime :: a+  , linen_sustainTime :: a+  , linen_releaseTime :: a+  , linen_level :: a+  , linen_curve :: Envelope_Curve_3 a+  }  -- | Sc3 defaults for Linen. linen_def :: Fractional t => Linen t-linen_def = let c = EnvLin in Linen 0.01 1 1 1 (c,c,c)+linen_def = let c = EnvLin in Linen 0.01 1 1 1 (c, c, c)  -- | Record ('Linen') variant of 'envLinen'. envLinen_r :: Num a => Linen a -> Envelope a-envLinen_r (Linen aT sT rT lv (c0,c1,c2)) =-    let l = [0,lv,lv,0]-        t = [aT,sT,rT]-        c = [c0,c1,c2]-    in Envelope l t c Nothing Nothing 0+envLinen_r (Linen aT sT rT lv (c0, c1, c2)) =+  let l = [0, lv, lv, 0]+      t = [aT, sT, rT]+      c = [c0, c1, c2]+  in Envelope l t c Nothing Nothing 0  -- | Variant of 'envLinen' with user specified 'Envelope_Curve a'. envLinen_c :: Num a => a -> a -> a -> a -> Envelope_Curve_3 a -> Envelope a@@ -396,35 +421,37 @@  {- | Linear envelope parameter constructor. -> e = envLinen 0 1 0 1-> s = envelope_segments e-> p = pack_envelope_segments s-> p == (env_levels e,env_times e,env_curves e)+>>> let e = envLinen 0 1 0 1+>>> let s = envelope_segments e+>>> let p = pack_envelope_segments s+>>> p == (env_levels e,env_times e,env_curves e)+True -} envLinen :: Num a => a -> a -> a -> a -> Envelope a envLinen aT sT rT lv =-    let c = (EnvLin,EnvLin,EnvLin)-    in envLinen_c aT sT rT lv c+  let c = (EnvLin, EnvLin, EnvLin)+  in envLinen_c aT sT rT lv c --- | Parameters for Adsr envelopes.---   The sustain level is given as a proportion of the peak level.-data Adsr a =-  Adsr-  {adsr_attackTime :: a-  ,adsr_decayTime :: a-  ,adsr_sustainLevel :: a-  ,adsr_releaseTime :: a-  ,adsr_peakLevel :: a-  ,adsr_curve :: Envelope_Curve_3 a-  ,adsr_bias :: a}+{- | Parameters for Adsr envelopes.+  The sustain level is given as a proportion of the peak level.+-}+data Adsr a = Adsr+  { adsr_attackTime :: a+  , adsr_decayTime :: a+  , adsr_sustainLevel :: a+  , adsr_releaseTime :: a+  , adsr_peakLevel :: a+  , adsr_curve :: Envelope_Curve_3 a+  , adsr_bias :: a+  }  -- | Sc3 defaults for Adsr. adsr_def :: Fractional n => Adsr n-adsr_def = let c = EnvNum (-4) in Adsr 0.01 0.3 0.5 1 1 (c,c,c) 0+adsr_def = let c = EnvNum (-4) in Adsr 0.01 0.3 0.5 1 1 (c, c, c) 0  -- | Attack, decay, sustain, release envelope parameter constructor. envAdsr :: Num a => a -> a -> a -> a -> a -> Envelope_Curve a -> a -> Envelope a-envAdsr aT dT sL rT pL c b = envAdsr_r (Adsr aT dT sL rT pL (c,c,c) b)+envAdsr aT dT sL rT pL c b = envAdsr_r (Adsr aT dT sL rT pL (c, c, c) b)  -- | Variant with defaults for pL, c and b. envAdsr_def :: Num a => a -> a -> a -> a -> Envelope a@@ -432,48 +459,48 @@  -- | Record ('Adsr') variant of 'envAdsr'. envAdsr_r :: Num a => Adsr a -> Envelope a-envAdsr_r (Adsr aT dT sL rT pL (c0,c1,c2) b) =-    let l = map (+ b) [0,pL,pL*sL,0]-        t = [aT,dT,rT]-        c = [c0,c1,c2]-    in Envelope l t c (Just 2) Nothing 0+envAdsr_r (Adsr aT dT sL rT pL (c0, c1, c2) b) =+  let l = map (+ b) [0, pL, pL * sL, 0]+      t = [aT, dT, rT]+      c = [c0, c1, c2]+  in Envelope l t c (Just 2) Nothing 0  -- | Parameters for Roland type Adssr envelopes.-data Adssr a =-  Adssr-  {adssr_attackTime :: a-  ,adssr_attackLevel :: a-  ,adssr_decayTime :: a-  ,adssr_decayLevel :: a-  ,adssr_slopeTime :: a-  ,adssr_sustainLevel :: a-  ,adssr_releaseTime :: a-  ,adssr_curve :: Envelope_Curve_4 a-  ,adssr_bias :: a}+data Adssr a = Adssr+  { adssr_attackTime :: a+  , adssr_attackLevel :: a+  , adssr_decayTime :: a+  , adssr_decayLevel :: a+  , adssr_slopeTime :: a+  , adssr_sustainLevel :: a+  , adssr_releaseTime :: a+  , adssr_curve :: Envelope_Curve_4 a+  , adssr_bias :: a+  }  -- | Attack, decay, slope, sustain, release envelope parameter constructor. envAdssr :: Num a => a -> a -> a -> a -> a -> a -> a -> Envelope_Curve a -> a -> Envelope a-envAdssr t1 l1 t2 l2 t3 l3 t4 c b = envAdssr_r (Adssr t1 l1 t2 l2 t3 l3 t4 (c,c,c,c) b)+envAdssr t1 l1 t2 l2 t3 l3 t4 c b = envAdssr_r (Adssr t1 l1 t2 l2 t3 l3 t4 (c, c, c, c) b)  -- | Record ('Adssr') variant of 'envAdssr'. envAdssr_r :: Num a => Adssr a -> Envelope a-envAdssr_r (Adssr t1 l1 t2 l2 t3 l3 t4 (c1,c2,c3,c4) b) =-    let l = map (+ b) [0,l1,l2,l3,0]-        t = [t1,t2,t3,t4]-        c = [c1,c2,c3,c4]-    in Envelope l t c (Just 3) Nothing 0+envAdssr_r (Adssr t1 l1 t2 l2 t3 l3 t4 (c1, c2, c3, c4) b) =+  let l = map (+ b) [0, l1, l2, l3, 0]+      t = [t1, t2, t3, t4]+      c = [c1, c2, c3, c4]+  in Envelope l t c (Just 3) Nothing 0  -- | Parameters for Asr envelopes.-data Asr a =-  Asr-  {asr_attackTime :: a-  ,asr_sustainLevel :: a-  ,asr_releaseTime :: a-  ,asr_curve :: Envelope_Curve_2 a}+data Asr a = Asr+  { asr_attackTime :: a+  , asr_sustainLevel :: a+  , asr_releaseTime :: a+  , asr_curve :: Envelope_Curve_2 a+  }  -- | Sc3 default values for Asr. asr_def :: Fractional t => Asr t-asr_def = let c = EnvNum (-4) in Asr 0.01 1 1 (c,c)+asr_def = let c = EnvNum (-4) in Asr 0.01 1 1 (c, c)  -- | Sc3 .asr has singular curve argument, hence _c suffix. envAsr_c :: Num a => a -> a -> a -> Envelope_Curve_2 a -> Envelope a@@ -481,41 +508,45 @@  {- | Attack, sustain, release envelope parameter constructor. -> c = 3-> r = Just [0,2,1,-99,0.1,3,c,0,0,2,c,0]-> envelope_sc3_array (envAsr 3 0.1 2 EnvSin) == r+>>> envelope_sc3_array (envAsr 3 0.1 2 EnvSin)+Just [0.0,2.0,1.0,-99.0,0.1,3.0,3.0,0.0,0.0,2.0,3.0,0.0] -} envAsr :: Num a => a -> a -> a -> Envelope_Curve a -> Envelope a-envAsr aT sL rT c = envAsr_c aT sL rT (c,c)+envAsr aT sL rT c = envAsr_c aT sL rT (c, c)  -- | Record ('Asr') variant of 'envAsr'. envAsr_r :: Num a => Asr a -> Envelope a-envAsr_r (Asr aT sL rT (c0,c1)) =-    let l = [0,sL,0]-        t = [aT,rT]-        c' = [c0,c1]-    in Envelope l t c' (Just 1) Nothing 0+envAsr_r (Asr aT sL rT (c0, c1)) =+  let l = [0, sL, 0]+      t = [aT, rT]+      c' = [c0, c1]+  in Envelope l t c' (Just 1) Nothing 0  -- | All segments are horizontal lines. envStep :: Num a => [a] -> [a] -> Maybe Int -> Maybe Int -> Envelope a envStep levels times releaseNode loopNode =-    if length levels /= length times+  if length levels /= length times     then error "envStep: levels and times must have same size"-    else let levels' = head levels : levels-         in Envelope levels' times [EnvStep] releaseNode loopNode 0+    else+      let levels' = Safe.headNote "envStep" levels : levels+      in Envelope levels' times [EnvStep] releaseNode loopNode 0 --- | Segments given as triples of (time,level,curve).  The final curve is ignored.------ > envXyc [(0, 1, EnvSin), (2.1, 0.5, EnvLin), (3, 1.4, EnvLin)]-envXyc :: Num n => [(n,n,Envelope_Curve n)] -> Envelope n+{- | Segments given as triples of (time,level,curve).  The final curve is ignored.++>>> env_levels (envXyc [(0, 1, EnvSin), (2.1, 0.5, EnvLin), (3, 1.4, EnvLin)])+[1.0,0.5,1.4]+-}+envXyc :: Num n => [(n, n, Envelope_Curve n)] -> Envelope n envXyc xyc =   let n = length xyc-      (times,levels,curves) = unzip3 xyc+      (times, levels, curves) = unzip3 xyc       offset = times !! 0   in Envelope levels (Base.d_dx' times) (take (n - 1) curves) Nothing Nothing offset --- | Variant where the input is sorted by time before processing.------ > envXyc_sort [(0, 1, EnvSin), (3, 1.4, EnvLin), (2.1, 0.5, EnvLin)]-envXyc_sort :: (Num n,Ord n) => [(n,n,Envelope_Curve n)] -> Envelope n-envXyc_sort = envXyc . Base.sort_on (\(x,_,_) -> x)+{- | Variant where the input is sorted by time before processing.++>>> env_levels (envXyc_sort [(0, 1, EnvSin), (3, 1.4, EnvLin), (2.1, 0.5, EnvLin)])+[1.0,0.5,1.4]+-}+envXyc_sort :: (Num n, Ord n) => [(n, n, Envelope_Curve n)] -> Envelope n+envXyc_sort = envXyc . Base.sort_on (\(x, _, _) -> x)

@@ -18,7 +18,7 @@  -- | Directory containing Sc3 Rtf help files. sc3_rtf_help_dir :: IO FilePath-sc3_rtf_help_dir = getEnv "SC3_RTF_HELP_DIR"+sc3_rtf_help_dir = getEnv "Sc3_Rtf_Help_Dir"  {- | Find (case-insensitively) indicated file at 'sc3_rtf_help_dir'. Runs the command "find -name" (so Unix only).@@ -30,7 +30,7 @@ sc3_rtf_find_file :: FilePath -> IO (Maybe FilePath) sc3_rtf_find_file fn = do   d <- sc3_rtf_help_dir-  r <- System.Process.readProcess "find" [d,"-iname",fn] ""+  r <- System.Process.readProcess "find" [d, "-iname", fn] ""   case lines r of     [] -> return Nothing     [r0] -> return (Just r0)@@ -43,7 +43,7 @@ -- | Run the command unrtf (so UNIX only) to convert an RTF file to a TEXT (.scd) file. sc3_rtf_to_scd :: FilePath -> FilePath -> IO () sc3_rtf_to_scd rtf_fn scd_fn = do-  txt <- System.Process.readProcess "unrtf" ["--text",rtf_fn] ""+  txt <- System.Process.readProcess "unrtf" ["--text", rtf_fn] ""   let delete_trailing_whitespace = reverse . dropWhile isSpace . reverse       tidy = unlines . map delete_trailing_whitespace . drop 4 . lines   writeFile scd_fn (tidy txt)@@ -58,8 +58,8 @@   return scd_fn  -- | 'sc3_rtf_help_translate' and run editor.-sc3_rtf_help_scd_open :: (String,[String]) -> String -> IO ()-sc3_rtf_help_scd_open (cmd,arg) nm = do+sc3_rtf_help_scd_open :: (String, [String]) -> String -> IO ()+sc3_rtf_help_scd_open (cmd, arg) nm = do   scd_fn <- sc3_rtf_help_translate nm   System.Process.callProcess cmd (arg ++ [scd_fn]) @@ -68,7 +68,7 @@ > sc3_rtf_help_scd_open_emacs "lfsaw" -} sc3_rtf_help_scd_open_emacs :: String -> IO ()-sc3_rtf_help_scd_open_emacs = sc3_rtf_help_scd_open ("emacsclient",["--no-wait"])+sc3_rtf_help_scd_open_emacs = sc3_rtf_help_scd_open ("emacsclient", ["--no-wait"])  -- * Sc-Doc (Html) @@ -76,65 +76,78 @@ sc3_scdoc_help_url :: String sc3_scdoc_help_url = "http://doc.sccode.org/" --- | Read the environment variable @SC3_SCDOC_HTML_HELP_DIR@.---   The default value is @~\/.local\/share\/SuperCollider/Help@.+{- | Read the environment variable @Sc3_ScDoc_Html_Help_Dir@.+  The default value is @~\/.local\/share\/SuperCollider/Help@.+-} sc3_scdoc_help_dir :: IO String sc3_scdoc_help_dir = do   h <- getEnv "HOME"   let d = h </> ".local/share/SuperCollider/Help"-  Base.System.get_env_default "SC3_SCDOC_HTML_HELP_DIR" d+  Base.System.get_env_default "Sc3_ScDoc_Html_Help_Dir" d  {- | Path to indicated Sc3 class help file. -> sc3_scdoc_help_class "SinOsc" == "Classes/SinOsc.html"+>>> sc3_scdoc_help_class "SinOsc"+"Classes/SinOsc.html" -} sc3_scdoc_help_class :: String -> String sc3_scdoc_help_class c = "Classes" </> c <.> "html"  {- | Generate path to indicated Sc3 operator help file. -> sc3_scdoc_help_operator "+" == "Overviews/Operators.html#+"+>>> sc3_scdoc_help_operator "+"+"Overviews/Operators.html#+" -} sc3_scdoc_help_operator :: String -> FilePath sc3_scdoc_help_operator = (++) "Overviews/Operators.html#"  {- | Generate path to indicated Sc3 method help. -> sc3_scdoc_help_method '*' ("C","m") == "Classes/C.html#*m"+>>> sc3_scdoc_help_method '*' ("C","m")+"Classes/C.html#*m" -}-sc3_scdoc_help_method :: Char -> (String,String) -> FilePath-sc3_scdoc_help_method z (c,m) = "Classes" </> c <.> "html#" ++ [z] ++ m+sc3_scdoc_help_method :: Char -> (String, String) -> FilePath+sc3_scdoc_help_method z (c, m) = "Classes" </> c <.> "html#" ++ [z] ++ m  {- | Generate path to indicated Sc3 class method help. -> sc3_scdoc_help_class_method ("C","m") == "Classes/C.html#*m"+>>> sc3_scdoc_help_class_method ("C","m")+"Classes/C.html#*m" -}-sc3_scdoc_help_class_method :: (String,String) -> FilePath+sc3_scdoc_help_class_method :: (String, String) -> FilePath sc3_scdoc_help_class_method = sc3_scdoc_help_method '*'  {- | Generate path to indicated Sc3 instance method help. -> sc3_scdoc_help_instance_method ("C","m") == "Classes/C.html#-m"+>>> sc3_scdoc_help_instance_method ("C","m")+"Classes/C.html#-m" -}-sc3_scdoc_help_instance_method :: (String,String) -> FilePath+sc3_scdoc_help_instance_method :: (String, String) -> FilePath sc3_scdoc_help_instance_method = sc3_scdoc_help_method '-'  {- | Sc3 help path documenting x. -> sc3_scdoc_help_path "Operator.distort" == "Overviews/Operators.html#.distort"-> sc3_scdoc_help_path "Collection.*fill" == "Classes/Collection.html#*fill"-> sc3_scdoc_help_path "Collection.inject" == "Classes/Collection.html#-inject"-> sc3_scdoc_help_path "SinOsc" == "Classes/SinOsc.html"+>>> sc3_scdoc_help_path "Operator.distort"+"Overviews/Operators.html#distort"++>>> sc3_scdoc_help_path "Collection.*fill"+"Classes/Collection.html#*fill"++>>> sc3_scdoc_help_path "Collection.inject"+"Classes/Collection.html#-inject"++>>> sc3_scdoc_help_path "SinOsc"+"Classes/SinOsc.html" -} sc3_scdoc_help_path :: String -> String sc3_scdoc_help_path s = do   case Split.splitOn "." s of-    ["Operator",m] -> sc3_scdoc_help_operator m-    [c,'*':m] -> sc3_scdoc_help_class_method (c,m)-    [c,m] -> sc3_scdoc_help_instance_method (c,m)+    ["Operator", m] -> sc3_scdoc_help_operator m+    [c, '*' : m] -> sc3_scdoc_help_class_method (c, m)+    [c, m] -> sc3_scdoc_help_instance_method (c, m)     _ -> sc3_scdoc_help_class s -{- | Open SC3 help path, either the local file or the online version.+{- | Open Sc3 help path, either the local file or the online version.      Use @BROWSER@ or @x-www-browser@.  > Base.System.get_env_default "BROWSER" "x-www-browser"@@ -158,10 +171,10 @@ -} sc3_scdoc_help_server_command_path :: String -> FilePath sc3_scdoc_help_server_command_path c =-    let c' = case c of-               '/':_ -> c-               _ -> '/':c-    in "Reference/Server-Command-Reference.html" ++ ('#' : c')+  let c' = case c of+        '/' : _ -> c+        _ -> '/' : c+  in "Reference/Server-Command-Reference.html" ++ ('#' : c')  {- | 'sc3_scdoc_help_open' of 'sc3_server_command_path' @@ -170,8 +183,8 @@ -} sc3_scdoc_help_server_command_open :: Bool -> String -> IO () sc3_scdoc_help_server_command_open use_loc =-  sc3_scdoc_help_open use_loc .-  sc3_scdoc_help_server_command_path+  sc3_scdoc_help_open use_loc+    . sc3_scdoc_help_server_command_path  -- * Fragments @@ -184,18 +197,99 @@ Fragments are separated by empty lines. A line containing the special character sequence ---- indicates the end of the fragments. -> on_lines_of split_multiple_fragments ";a\nb\n\n\n;c\nd" == [";a\nb\n",";c\nd\n"]+>>> on_lines_of split_multiple_fragments ";a\nb\n\n\n;c\nd"+[";a\nb\n",";c\nd\n"] -} split_multiple_fragments :: [String] -> [[String]] split_multiple_fragments = filter (not . null) . Split.splitOn [[]] --- | The text ---- indicates the end of graph fragments.+{- | The text '----' appearing anywhere in a line indicates the end of the graph fragments.+The text '# ' appearing at the start of a line also indicates the end of the graph fragments.++>>> drop_post_graph_section ["a","b","c","","----d","e","f"]+["a","b","c",""]++>>> drop_post_graph_section ["a","b","c","","----d","# e","","f"]+["a","b","c",""]+-} drop_post_graph_section :: [String] -> [String]-drop_post_graph_section = takeWhile (not . isInfixOf "----")+drop_post_graph_section =+  let isEnd x = "----" `isInfixOf` x || "# " `isPrefixOf` x+  in takeWhile (not . isEnd) +{- | Some help files are in Markdown format.+These are recognised by examing the first two characters, which must be a '#' and ' '.+-}+is_md_help :: String -> Bool+is_md_help x =+  case x of+    '#' : ' ' : _ -> True+    _ -> False++{- | There are two code block formats in markdown help files.+The first indents the block using a single tab or four spaces.+The second marks the start and end of the block by lines starting with three back ticks (`).++See:+<https://spec.commonmark.org/0.30/#indented-code-blocks>+and+<https://spec.commonmark.org/0.30/#fenced-code-blocks>+-}+data CodeBlockType = IndentedCodeBlock | FencedCodeBlock+  deriving (Bounded, Enum, Eq, Read, Show)++-- | Get code blocks from Markdown help file.+md_help_get_code_blocks :: [String] -> [(CodeBlockType, [String])]+md_help_get_code_blocks x =+  case x of+    [] -> []+    "```" : x' ->+      let (q, x'') = break (== "```") x'+      in (FencedCodeBlock, q) : md_help_get_code_blocks (drop 1 x'')+    ('\t' : _) : _ ->+      let (q, x') = span ((==) ['\t'] . take 1) x+      in (IndentedCodeBlock, (map (drop 1) q)) : md_help_get_code_blocks x'+    _ : x' ->+      md_help_get_code_blocks x'++is_doctest_block :: [String] -> Bool+is_doctest_block =+  let f x p = p `isPrefixOf` x+  in any (\x -> f x ">>> " || f x ">> ")++md_help_get_tab_indented_code_blocks :: [String] -> [[String]]+md_help_get_tab_indented_code_blocks =+  filter (not . is_doctest_block)+    . map snd+    . filter ((== IndentedCodeBlock) . fst)+    . md_help_get_code_blocks++{- | Get indented code blocks from Markdown help file.++>>> s <- readFile "/home/rohan/sw/spl/Help/Reference/AllpassC.help.sl"+>>> is_md_help s+True++>>> let b = md_help_get_fenced_code_blocks (lines s)+>>> length b+3+-}+md_help_get_fenced_code_blocks :: [String] -> [[String]]+md_help_get_fenced_code_blocks =+  filter (not . is_doctest_block)+    . map snd+    . filter ((== FencedCodeBlock) . fst)+    . md_help_get_code_blocks++get_help_file_fragments :: String -> [String]+get_help_file_fragments s =+  if is_md_help s+    then on_lines_of md_help_get_fenced_code_blocks s+    else on_lines_of (split_multiple_fragments . drop_post_graph_section) s+ -- | Read text fragments from file. read_file_fragments :: FilePath -> IO [String]-read_file_fragments = fmap (on_lines_of (split_multiple_fragments . drop_post_graph_section)) . readFile+read_file_fragments = fmap get_help_file_fragments . readFile  -- | Read text fragments from set of files. read_file_set_fragments :: [FilePath] -> IO [String]

@@ -8,174 +8,231 @@ -} sc2_ugen_categories :: [(String, [String])] sc2_ugen_categories =-  [("Analysis"-   ,["Pitch"-    ,"RunningSum"-    ,"Slope"-    ,"ZeroCrossing"])-  ,("BinaryOps"-   ,[])-  ,("Buffers"-   ,["TGrains"])-  ,("Controls"-   ,["DegreeToKey"-   ,"GetTempo"-   ,"Impulse"-   ,"Index"-   ,"Integrator"-   ,"K2A"-   ,"Lag"-   ,"Latch"-   ,"LFPulse"-   ,"LFSaw"-   ,"LFTri"-   ,"LinExp"-   ,"MouseX"-   ,"MouseY"-   ,"Osc1"-   ,"Slew"-   ,"WrapIndex"])-  ,("Delays"-   ,["AllpassC"-   ,"CombC"-   ,"Delay1"-   ,"Delay2"-   ,"DelayC"-   ,"DelayWrite"-   ,"MultiTapDelay"-   ,"PingPongDelay"-   ,"PitchShift"])-  ,("Envelopes"-   ,["Cutoff"-   ,"Decay2"-   ,"Decay"-   ,"Ln"-   ,"XLn"])-  ,("Events"-   ,["OverlapTexture"])-  ,("Filters"-   ,["BPF"-   ,"BPZ2"-   ,"BRF"-   ,"BRZ2"-   ,"Formlet"-   ,"FOS"-   ,"HPF"-   ,"HPZ1"-   ,"HPZ2"-   ,"LeakDC"-   ,"Limiter"-   ,"LPF"-   ,"LPZ1"-   ,"LPZ2"-   ,"Median"-   ,"Normalizer"-   ,"OnePole"-   ,"OneZero"-   ,"Resonz"-   ,"RHPF"-   ,"RingzBank"-   ,"Ringz"-   ,"RLPF"-   ,"SOS"-   ,"TwoPole"-   ,"TwoZero"])-  ,("Misc"-   ,["Mix"])-  ,("Noise"-   ,["BrownNoise"-   ,"ClipNoise"-   ,"Crackle"-   ,"Dust2"-   ,"Dust"-   ,"GrayNoise"-   ,"LatoocarfianC"-   ,"LFClipNoise"-   ,"LFNoise0"-   ,"LFNoise1"-   ,"LFNoise2"-   ,"LinCongC"-   ,"PinkNoise"-   ,"WhiteNoise"])-  ,("Oscillators"-   ,["Blip"-   ,"Formant"-   ,"FSinOsc"-   ,"Impulse"-   ,"LFPulse"-   ,"LFSaw"-   ,"LFTri"-   ,"PMOsc"-   ,"Pulse"-   ,"Saw"-   ,"SinOsc"-   ,"SyncSaw"-   ,"VarSaw"])-  ,("Panners"-   ,["LinPan2"-   ,"LinXFade2"-   ,"Pan2"-   ,"PanAz"-   ,"PanB"])-  ,("Random"-   ,["CoinGate"-   ,"ExpRand"-   ,"IRand"-   ,"LinRand"-   ,"NRand"-   ,"Rand"-   ,"TExpRand"-   ,"TIRand"-   ,"TRand"])-  ,("Samples"-   ,["AudioIn"-   ,"BufRd"-   ,"PlayBuf"])-  ,("Triggers"-   ,["Gate"-   ,"InRange"-   ,"PeakFollower"-   ,"Phasor"-   ,"PulseCount"-   ,"PulseDivider"-   ,"Schmidt"-   ,"Stepper"-   ,"Sweep"-   ,"TDelay"-   ,"Timer"-   ,"ToggleFF"])-  ,("UnaryOperators"-   ,["abs"-   ,"acos"-   ,"ampdb"-   ,"asin"-   ,"atan"-   ,"ceil"-   ,"cos"-   ,"cosh"-   ,"cpsmidi"-   ,"cpsoct"-   ,"cubed"-   ,"dbamp"-   ,"distort"-   ,"exp"-   ,"floor"-   ,"frac"-   ,"isNegative"-   ,"isPositive"-   ,"isStrictlyPositive"-   ,"log10"-   ,"log2"-   ,"log"-   ,"midicps"-   ,"neg"-   ,"octcps"-   ,"reciprocal"-   ,"sign"-   ,"sin"-   ,"sinh"-   ,"softclip"-   ,"sqrt"-   ,"squared"-   ,"tan"-   ,"tanh"])]+  [+    ( "Analysis"+    ,+      [ "Pitch"+      , "RunningSum"+      , "Slope"+      , "ZeroCrossing"+      ]+    )+  ,+    ( "BinaryOps"+    , []+    )+  ,+    ( "Buffers"+    , ["TGrains"]+    )+  ,+    ( "Controls"+    ,+      [ "DegreeToKey"+      , "GetTempo"+      , "Impulse"+      , "Index"+      , "Integrator"+      , "K2A"+      , "Lag"+      , "Latch"+      , "LFPulse"+      , "LFSaw"+      , "LFTri"+      , "LinExp"+      , "MouseX"+      , "MouseY"+      , "Osc1"+      , "Slew"+      , "WrapIndex"+      ]+    )+  ,+    ( "Delays"+    ,+      [ "AllpassC"+      , "CombC"+      , "Delay1"+      , "Delay2"+      , "DelayC"+      , "DelayWrite"+      , "MultiTapDelay"+      , "PingPongDelay"+      , "PitchShift"+      ]+    )+  ,+    ( "Envelopes"+    ,+      [ "Cutoff"+      , "Decay2"+      , "Decay"+      , "Ln"+      , "XLn"+      ]+    )+  ,+    ( "Events"+    , ["OverlapTexture"]+    )+  ,+    ( "Filters"+    ,+      [ "BPF"+      , "BPZ2"+      , "BRF"+      , "BRZ2"+      , "Formlet"+      , "FOS"+      , "HPF"+      , "HPZ1"+      , "HPZ2"+      , "LeakDC"+      , "Limiter"+      , "LPF"+      , "LPZ1"+      , "LPZ2"+      , "Median"+      , "Normalizer"+      , "OnePole"+      , "OneZero"+      , "Resonz"+      , "RHPF"+      , "RingzBank"+      , "Ringz"+      , "RLPF"+      , "SOS"+      , "TwoPole"+      , "TwoZero"+      ]+    )+  ,+    ( "Misc"+    , ["Mix"]+    )+  ,+    ( "Noise"+    ,+      [ "BrownNoise"+      , "ClipNoise"+      , "Crackle"+      , "Dust2"+      , "Dust"+      , "GrayNoise"+      , "LatoocarfianC"+      , "LFClipNoise"+      , "LFNoise0"+      , "LFNoise1"+      , "LFNoise2"+      , "LinCongC"+      , "PinkNoise"+      , "WhiteNoise"+      ]+    )+  ,+    ( "Oscillators"+    ,+      [ "Blip"+      , "Formant"+      , "FSinOsc"+      , "Impulse"+      , "LFPulse"+      , "LFSaw"+      , "LFTri"+      , "PMOsc"+      , "Pulse"+      , "Saw"+      , "SinOsc"+      , "SyncSaw"+      , "VarSaw"+      ]+    )+  ,+    ( "Panners"+    ,+      [ "LinPan2"+      , "LinXFade2"+      , "Pan2"+      , "PanAz"+      , "PanB"+      ]+    )+  ,+    ( "Random"+    ,+      [ "CoinGate"+      , "ExpRand"+      , "IRand"+      , "LinRand"+      , "NRand"+      , "Rand"+      , "TExpRand"+      , "TIRand"+      , "TRand"+      ]+    )+  ,+    ( "Samples"+    ,+      [ "AudioIn"+      , "BufRd"+      , "PlayBuf"+      ]+    )+  ,+    ( "Triggers"+    ,+      [ "Gate"+      , "InRange"+      , "PeakFollower"+      , "Phasor"+      , "PulseCount"+      , "PulseDivider"+      , "Schmidt"+      , "Stepper"+      , "Sweep"+      , "TDelay"+      , "Timer"+      , "ToggleFF"+      ]+    )+  ,+    ( "UnaryOperators"+    ,+      [ "abs"+      , "acos"+      , "ampdb"+      , "asin"+      , "atan"+      , "ceil"+      , "cos"+      , "cosh"+      , "cpsmidi"+      , "cpsoct"+      , "cubed"+      , "dbamp"+      , "distort"+      , "exp"+      , "floor"+      , "frac"+      , "isNegative"+      , "isPositive"+      , "isStrictlyPositive"+      , "log10"+      , "log2"+      , "log"+      , "midicps"+      , "neg"+      , "octcps"+      , "reciprocal"+      , "sign"+      , "sin"+      , "sinh"+      , "softclip"+      , "sqrt"+      , "squared"+      , "tan"+      , "tanh"+      ]+    )+  ]

@@ -8,15 +8,19 @@  import qualified Sound.Sc3.Common.Base as Common.Base {- hsc3 -} --- | Half pi.------ > half_pi == 1.5707963267948966+{- | Half pi.++>>> half_pi+1.5707963267948966+-} half_pi :: Floating a => a half_pi = pi / 2 --- | Two pi.------ > two_pi == 6.283185307179586+{- | Two pi.++>>> two_pi+6.283185307179586+-} two_pi :: Floating n => n two_pi = 2 * pi @@ -24,27 +28,43 @@ absdif :: Num a => a -> a -> a absdif i j = abs (j - i) --- | SC3 MulAdd type signature, arguments in SC3 order of input, multiply, add.-type SC3_MulAdd t = t -> t -> t -> t+-- | Sc3 MulAdd type signature, arguments in Sc3 order of input, multiply, add.+type Sc3_MulAdd t = t -> t -> t -> t --- | Ordinary (un-optimised) multiply-add, see also mulAdd Ugen.------ > sc3_mul_add 2 3 4 == 2 * 3 + 4--- > map (\x -> sc3_mul_add x 2 3) [1,5] == [5,13] && map (\x -> sc3_mul_add x 3 2) [1,5] == [5,17]-sc3_mul_add :: Num t => SC3_MulAdd t+{- | Ordinary (un-optimised) multiply-add, see also mulAdd Ugen.++>>> sc3_mul_add 2 3 4 == 2 * 3 + 4+True++>>> map (\x -> sc3_mul_add x 2 3) [1,5]+[5,13]++>>> map (\x -> sc3_mul_add x 3 2) [1,5]+[5,17]+-}+sc3_mul_add :: Num t => Sc3_MulAdd t sc3_mul_add i m a = i * m + a --- | Ordinary Haskell order (un-optimised) multiply-add.------ > mul_add 3 4 2 == 2 * 3 + 4--- > map (mul_add 2 3) [1,5] == [5,13] && map (mul_add 3 4) [1,5] == [7,19]+{- | Ordinary Haskell order (un-optimised) multiply-add.++>>> mul_add 3 4 2 == 2 * 3 + 4+True++>>> map (mul_add 2 3) [1,5]+[5,13]++>> map (mul_add 3 4) [1,5]+[7,19]+-} mul_add :: Num t => t -> t -> t -> t mul_add m a = (+ a) . (* m) --- | 'uncurry' 'mul_add'------ > mul_add_hs (3,4) 2 == 2 * 3 + 4-mul_add_hs :: Num t => (t,t) -> t -> t+{- | 'uncurry' 'mul_add'++>>> mul_add_hs (3,4) 2 == 2 * 3 + 4+True+-}+mul_add_hs :: Num t => (t, t) -> t -> t mul_add_hs = uncurry mul_add  -- | 'fromInteger' of 'truncate'.@@ -63,13 +83,17 @@ sc3_floor :: RealFrac a => a -> a sc3_floor = fromInteger . floor --- | Variant of @SC3@ @roundTo@ function.------ > sc3_round_to (2/3) 0.25 == 0.75------ > let r = [0,0,0.25,0.25,0.5,0.5,0.5,0.75,0.75,1,1]--- > map (`sc3_round_to` 0.25) [0,0.1 .. 1] == r--- > map (`sc3_round_to` 5.0) [100.0 .. 110.0]+{- | Variant of @Sc3@ @roundTo@ function.++>>> sc3_round_to (2/3) 0.25+0.75++>>> map (`sc3_round_to` 0.25) [0,0.1 .. 1]+[0.0,0.0,0.25,0.25,0.5,0.5,0.5,0.75,0.75,1.0,1.0]++>>> map (`sc3_round_to` 5.0) [100.0 .. 110.0]+[100.0,100.0,100.0,105.0,105.0,105.0,105.0,105.0,110.0,110.0,110.0]+-} sc3_round_to :: RealFrac n => n -> n -> n sc3_round_to a b = if b == 0 then a else sc3_floor ((a / b) + 0.5) * b @@ -84,12 +108,23 @@ makes it consistent with the lattice-theoretical interpretation and its idempotency, commutative, associative, absorption laws. -> lcm 4 6 == 12-> lcm 1 1 == 1-> lcm 1624 26 == 21112-> lcm 1624 (-26) /= (-21112)-> lcm (-1624) (-26) /= (-21112)-> lcm 513 (gcd 513 44) == 513+>>> lcm 4 6+12++>>> lcm 1 1+1++>>> lcm 1624 26+21112++>>> lcm 1624 (-26) /= (-21112)+True++>>> lcm (-1624) (-26) /= (-21112)+True++>>> lcm 513 (gcd 513 44)+513 -} sc3_lcm :: t -> t -> t sc3_lcm = error "sc3_lcm: undefined"@@ -102,42 +137,70 @@ interpretation and its idempotency, commutative, associative, absorption laws. <https://www.jsoftware.com/papers/eem/gcd.htm> -> gcd 4 6 == 2-> gcd 0 1 == 1-> gcd 1024 256 == 256-> gcd 1024 (-256) == 256-> gcd (-1024) (-256) /= (-256)-> gcd (-1024) (lcm (-1024) 256) /= (-1024)-> gcd 66 54 * lcm 66 54 == 66 * 54+>>> gcd 4 6+2 +>>> gcd 0 1+1++>>> gcd 1024 256+256++>>> gcd 1024 (-256)+256++>>> gcd (-1024) (-256) /= (-256)+True++>>> gcd (-1024) (lcm (-1024) 256) /= (-1024)+True++>>> gcd 66 54 * lcm 66 54 == 66 * 54+True -} sc3_gcd :: t -> t -> t sc3_gcd = error "sc3_gcd: undefined" -{- | The SC3 @%@ Ugen operator is the 'Data.Fixed.mod'' function.+{- | The Sc3 @%@ Ugen operator is the 'Data.Fixed.mod'' function. -> > 1.5 % 1.2 // ~= 0.3-> > -1.5 % 1.2 // ~= 0.9-> > 1.5 % -1.2 // ~= -0.9-> > -1.5 % -1.2 // ~= -0.3+> 1.5 % 1.2 // ~= 0.3+> -1.5 % 1.2 // ~= 0.9+> 1.5 % -1.2 // ~= -0.9+> -1.5 % -1.2 // ~= -0.3 -> let (%) = sc3_mod-> 1.5 % 1.2 ~= 0.3-> (-1.5) % 1.2 ~= 0.9-> 1.5 % (-1.2) ~= -0.9-> (-1.5) % (-1.2) ~= -0.3+>>> let (~=) p q = abs (p - q) < 0.000001+>>> let (%) = sc3_mod+>>> (1.5 % 1.2) ~= 0.3+True -> > 1.2 % 1.5 // ~= 1.2-> > -1.2 % 1.5 // ~= 0.3-> > 1.2 % -1.5 // ~= -0.3-> > -1.2 % -1.5 // ~= -1.2+>>> ((-1.5) % 1.2) ~= 0.9+True -> 1.2 % 1.5 ~= 1.2-> (-1.2) % 1.5 ~= 0.3-> 1.2 % (-1.5) ~= -0.3-> (-1.2) % (-1.5) ~= -1.2+>>> (1.5 % (-1.2)) ~= (-0.9)+True -> map (\n -> sc3_mod n 12.0) [-1.0,12.25,15.0] == [11.0,0.25,3.0]+>>> ((-1.5) % (-1.2)) ~= (-0.3)+True++> 1.2 % 1.5 // ~= 1.2+> -1.2 % 1.5 // ~= 0.3+> 1.2 % -1.5 // ~= -0.3+> -1.2 % -1.5 // ~= -1.2++>>> (1.2 % 1.5) ~= 1.2+True++>>> ((-1.2) % 1.5) ~= 0.3+True++>>> (1.2 % (-1.5)) ~= (-0.3)+True++>>> ((-1.2) % (-1.5)) ~= (-1.2)+True++>>> map (\n -> sc3_mod n 12.0) [-1.0,12.25,15.0]+[11.0,0.25,3.0] -} sc3_mod :: RealFrac n => n -> n -> n sc3_mod = Data.Fixed.mod'@@ -150,136 +213,183 @@ fmod_f64 :: Double -> Double -> Double fmod_f64 = sc3_mod --- | @SC3@ clip function.  Clip /n/ to within range /(i,j)/.  'clip' is a 'Ugen'.------ > map (\n -> sc3_clip n 5 10) [3..12] == [5,5,5,6,7,8,9,10,10,10]+{- | @Sc3@ clip function.  Clip /n/ to within range /(i,j)/.  'clip' is a 'Ugen'.++>>> map (\n -> sc3_clip n 5 10) [3..12]+[5,5,5,6,7,8,9,10,10,10]+-} sc3_clip :: Ord a => a -> a -> a -> a sc3_clip n i j = if n < i then i else if n > j then j else n --- | Variant of 'sc3_clip' with haskell argument structure.------ > map (clip_hs (5,10)) [3..12] == [5,5,5,6,7,8,9,10,10,10]-clip_hs :: (Ord a) => (a,a) -> a -> a-clip_hs (i,j) n = sc3_clip n i j+{- | Variant of 'sc3_clip' with haskell argument structure. --- | Fractional modulo, alternate implementation.------ > map (\n -> sc3_mod_alt n 12.0) [-1.0,12.25,15.0] == [11.0,0.25,3.0]+>>> map (clip_hs (5,10)) [3..12]+[5,5,5,6,7,8,9,10,10,10]+-}+clip_hs :: (Ord a) => (a, a) -> a -> a+clip_hs (i, j) n = sc3_clip n i j++{- | Fractional modulo, alternate implementation.++>>> map (\n -> sc3_mod_alt n 12.0) [-1.0,12.25,15.0]+[11.0,0.25,3.0]+-} sc3_mod_alt :: RealFrac a => a -> a -> a sc3_mod_alt n hi =-    let lo = 0.0-    in if n >= lo && n < hi-       then n-       else if hi == lo-            then lo-            else n - hi * sc3_floor (n / hi)+  let lo = 0.0+  in if n >= lo && n < hi+      then n+      else+        if hi == lo+          then lo+          else n - hi * sc3_floor (n / hi)  {- | Wrap function that is /non-inclusive/ at right edge, ie. the Wrap Ugen rule. -> map (sc3_wrap_ni 0 5) [4,5,6] == [4,0,1]-> map (sc3_wrap_ni 5 10) [3..12] == [8,9,5,6,7,8,9,5,6,7]-> Sound.Sc3.Plot.plot_fn_r1_ln (sc3_wrap_ni (-1) 1) (-2,2)+>>> map (round . sc3_wrap_ni 0 5) [4,5,6]+[4,0,1] +>>> map (round . sc3_wrap_ni 5 10) [3..12]+[8,9,5,6,7,8,9,5,6,7]++> Sound.Sc3.Plot.plot_fn_r1_ln (sc3_wrap_ni (-1) 1) (-2,2) -} sc3_wrap_ni :: RealFrac a => a -> a -> a -> a sc3_wrap_ni lo hi n = sc3_mod (n - lo) (hi - lo) + lo  {- | sc_wrap::int -> > [5,6].wrap(0,5) == [5,0]-> map (wrap_hs_int (0,5)) [5,6] == [5,0]+> [5,6].wrap(0,5) == [5,0] -> > [9,10,5,6,7,8,9,10,5,6].wrap(5,10) == [9,10,5,6,7,8,9,10,5,6]-> map (wrap_hs_int (5,10)) [3..12] == [9,10,5,6,7,8,9,10,5,6]+>>> map (wrap_hs_int (0,5)) [5,6]+[5,0]++> [9,10,5,6,7,8,9,10,5,6].wrap(5,10) == [9,10,5,6,7,8,9,10,5,6]++>>> map (wrap_hs_int (5,10)) [3..12]+[9,10,5,6,7,8,9,10,5,6] -} wrap_hs_int :: Integral a => (a, a) -> a -> a-wrap_hs_int (i,j) n = ((n - i) `mod` (j - i + 1)) + i+wrap_hs_int (i, j) n = ((n - i) `mod` (j - i + 1)) + i  {- | Wrap /n/ to within range /(i,j)/, ie. @AbstractFunction.wrap@, ie. /inclusive/ at right edge.  'wrap' is a 'Ugen', hence prime. -> > [5.0,6.0].wrap(0.0,5.0) == [0.0,1.0]-> map (wrap_hs (0,5)) [5,6] == [0,1]-> map (wrap_hs (5,10)) [3..12] == [8,9,5,6,7,8,9,5,6,7]+> [5.0,6.0].wrap(0.0,5.0) == [0.0,1.0] -> Sound.Sc3.Plot.plot_fn_r1_ln (wrap_hs (-1,1)) (-2,2)+>>> map (round . wrap_hs (0,4)) [-1,0 .. 5]+[3,0,1,2,3,0,1] +>>> map (round . wrap_hs (0,5)) [5,6]+[0,1]++>>> map (round . wrap_hs (5,10)) [3..12]+[8,9,5,6,7,8,9,5,6,7]++> Sound.Sc3.Plot.plot_fn_r1_ln (wrap_hs (-1,1)) (-2,2) -}-wrap_hs :: RealFrac n => (n,n) -> n -> n-wrap_hs (i,j) n =-    let r = j - i -- + 1-        n' = if n >= j then n - r else if n < i then n + r else n-    in if n' >= i && n' < j-       then n'-       else n' - r * sc3_floor ((n' - i) / r)+wrap_hs :: RealFrac n => (n, n) -> n -> n+wrap_hs (i, j) n =+  let r = j - i -- + 1+      n' = if n >= j then n - r else if n < i then n + r else n+  in if n' >= i && n' < j+      then n'+      else n' - r * sc3_floor ((n' - i) / r) --- | Variant of 'wrap_hs' with @SC3@ argument ordering.------ > map (\n -> sc3_wrap n 5 10) [3..12] == map (wrap_hs (5,10)) [3..12]+{- | Variant of 'wrap_hs' with @Sc3@ argument ordering.++>>> map (\n -> sc3_wrap n 5 10) [3..12] == map (wrap_hs (5,10)) [3..12]+True++>>> map (\n -> sc3_wrap n 0 4) [-1, 0 .. 5]+[3.0,0.0,1.0,2.0,3.0,0.0,1.0]+-} sc3_wrap :: RealFrac n => n -> n -> n -> n-sc3_wrap a b c = wrap_hs (b,c) a+sc3_wrap index start end = wrap_hs (start, end) index  {- | Generic variant of 'wrap''. -> > [5,6].wrap(0,5) == [5,0]-> map (generic_wrap (0,5)) [5,6] == [5,0]+> [5,6].wrap(0,5) == [5,0] -> > [9,10,5,6,7,8,9,10,5,6].wrap(5,10) == [9,10,5,6,7,8,9,10,5,6]-> map (generic_wrap (5::Integer,10)) [3..12] == [9,10,5,6,7,8,9,10,5,6]+>>> map (generic_wrap (0,5)) [5,6]+[5,0]++> [9,10,5,6,7,8,9,10,5,6].wrap(5,10) == [9,10,5,6,7,8,9,10,5,6]++>>> map (generic_wrap (5::Integer,10)) [3..12]+[9,10,5,6,7,8,9,10,5,6] -}-generic_wrap :: (Ord a, Num a) => (a,a) -> a -> a-generic_wrap (l,r) n =-    let d = r - l + 1-        f = generic_wrap (l,r)-    in if n < l-       then f (n + d)-       else if n > r then f (n - d) else n+generic_wrap :: (Ord a, Num a) => (a, a) -> a -> a+generic_wrap (l, r) n =+  let d = r - l + 1+      f = generic_wrap (l, r)+  in if n < l+      then f (n + d)+      else if n > r then f (n - d) else n --- | Given sample-rate /sr/ and bin-count /n/ calculate frequency of /i/th bin.------ > bin_to_freq 44100 2048 32 == 689.0625+{- | Given sample-rate /sr/ and bin-count /n/ calculate frequency of /i/th bin.++>>> bin_to_freq 44100 2048 32+689.0625+-} bin_to_freq :: (Fractional n, Integral i) => n -> i -> i -> n bin_to_freq sr n i = fromIntegral i * sr / fromIntegral n --- | Fractional midi note number to cycles per second.------ > map (floor . midi_to_cps) [0,24,69,120,127] == [8,32,440,8372,12543]--- > map (floor . midi_to_cps) [-36,138] == [1,23679]--- > map (floor . midi_to_cps) [69.0,69.25 .. 70.0] == [440,446,452,459,466]+{- | Fractional midi note number to cycles per second.++>>> map (floor . midi_to_cps) [0,24,69,120,127]+[8,32,440,8372,12543]++>>> map (floor . midi_to_cps) [-36,138]+[1,23679]++>>> map (floor . midi_to_cps) [69.0,69.25 .. 70.0]+[440,446,452,459,466]+-} midi_to_cps :: Floating a => a -> a midi_to_cps i = 440.0 * (2.0 ** ((i - 69.0) * (1.0 / 12.0))) --- | Cycles per second to fractional midi note number.------ > map (round . cps_to_midi) [8,32,440,8372,12543] == [0,24,69,120,127]--- > map (round . cps_to_midi) [1,24000] == [-36,138]+{- | Cycles per second to fractional midi note number.++>>> map (round . cps_to_midi) [8,32,440,8372,12543]+[0,24,69,120,127]++>>> map (round . cps_to_midi) [1,24000]+[-36,138]+-} cps_to_midi :: Floating a => a -> a cps_to_midi a = (logBase 2 (a * (1.0 / 440.0)) * 12.0) + 69.0 --- | Cycles per second to linear octave (4.75 = A4 = 440).------ > map (cps_to_oct . midi_to_cps) [60,63,69] == [4.0,4.25,4.75]+{- | Cycles per second to linear octave (4.75 = A4 = 440).++>>> map (cps_to_oct . midi_to_cps) [60,63,69]+[4.0,4.25,4.75]+-} cps_to_oct :: Floating a => a -> a cps_to_oct a = logBase 2 (a * (1.0 / 440.0)) + 4.75 --- | Linear octave to cycles per second.------ > > [4.0,4.25,4.75].octcps.cpsmidi == [60,63,69]--- > map (cps_to_midi . oct_to_cps) [4.0,4.25,4.75] == [60,63,69]+{- | Linear octave to cycles per second.++> [4.0,4.25,4.75].octcps.cpsmidi == [60,63,69]++>>> map (cps_to_midi . oct_to_cps) [4.0,4.25,4.75]+[60.0,63.0,69.0]+-} oct_to_cps :: Floating a => a -> a oct_to_cps a = 440.0 * (2.0 ** (a - 4.75))  -- | Degree, scale and steps per octave to key. degree_to_key :: RealFrac a => [a] -> a -> a -> a degree_to_key s n d =-    let l = length s-        d' = round d-        a = (d - fromIntegral d') * 10.0 * (n / 12.0)-    in (n * fromIntegral (d' `div` l)) + Common.Base.at_with_error_message "degree_to_key" s (d' `mod` l) + a+  let l = length s+      d' = round d+      a = (d - fromIntegral d') * 10.0 * (n / 12.0)+  in (n * fromIntegral (d' `div` l)) + Common.Base.at_with_error_message "degree_to_key" s (d' `mod` l) + a  {- | One-indexed piano key number (for standard 88 key piano) to midi note number. -> map pianokey_to_midi [1,49,88] == [21,69,108]+>>> map pianokey_to_midi [1,49,88]+[21,69,108] -} pianokey_to_midi :: Num n => n -> n pianokey_to_midi = (+) 20@@ -288,82 +398,104 @@      This is useful as a more musical gamut than midi note numbers.      Ie. if x is in (0,1) then pianokey_to_cps of (x * 88) is in (26,4168) -> map (round . pianokey_to_cps) [0,1,40,49,88] == [26,28,262,440,4186]-> map (round . midi_to_cps) [0,60,69,127] == [8,262,440,12544]+>>> map (round . pianokey_to_cps) [0,1,40,49,88]+[26,28,262,440,4186]++>>> map (round . midi_to_cps) [0,60,69,127]+[8,262,440,12544] -} pianokey_to_cps :: Floating n => n -> n pianokey_to_cps = midi_to_cps . pianokey_to_midi --- | Linear amplitude to decibels.------ > map (round . amp_to_db) [0.01,0.05,0.0625,0.125,0.25,0.5] == [-40,-26,-24,-18,-12,-6]+{- | Linear amplitude to decibels.++>>> map (round . amp_to_db) [0.01,0.05,0.0625,0.125,0.25,0.5]+[-40,-26,-24,-18,-12,-6]+-} amp_to_db :: Floating a => a -> a amp_to_db = (* 20) . logBase 10  {- | Decibels to linear amplitude. -map (floor . (* 100). db_to_amp) [-40,-26,-24,-18,-12,-6] == [01,05,06,12,25,50]+>>> map (floor . (* 100). db_to_amp) [-40,-26,-24,-18,-12,-6]+[1,5,6,12,25,50] -let amp = map (2 **) [0 .. 15]-let db = [0,-6 .. -90]-map (round . ampDb . (/) 1) amp == db-map (round . amp_to_db . (/) 1) amp == db- zip amp db+>>> let amp = map (2 **) [0 .. 15]+>>> let db = [0,-6 .. -90]+>>> map (round . amp_to_db . (/) 1) amp == db+True -db_to_amp (-3) == 0.7079457843841379-amp_to_db 0.7079457843841379 == -3+>>> db_to_amp (-3)+0.7079457843841379++>>> amp_to_db 0.7079457843841379+-3.0 -} db_to_amp :: Floating a => a -> a-db_to_amp = (10 **) .  (* 0.05)+db_to_amp = (10 **) . (* 0.05) --- | Fractional midi note interval to frequency multiplier.------ > map midi_to_ratio [-12,0,7,12] == [0.5,1,1.4983070768766815,2]+{- | Fractional midi note interval to frequency multiplier.++>>> map midi_to_ratio [-12,0,7,12]+[0.5,1.0,1.4983070768766815,2.0]+-} midi_to_ratio :: Floating a => a -> a midi_to_ratio a = 2.0 ** (a * (1.0 / 12.0)) --- | Inverse of 'midi_to_ratio'.------ > map ratio_to_midi [3/2,2] == [7.019550008653875,12]+{- | Inverse of 'midi_to_ratio'.++>>> map ratio_to_midi [3/2,2]+[7.019550008653875,12.0]+-} ratio_to_midi :: Floating a => a -> a ratio_to_midi a = 12.0 * logBase 2 a --- | /sr/ = sample rate, /r/ = cycle (two-pi), /cps/ = frequency------ > cps_to_incr 48000 128 375 == 1--- > cps_to_incr 48000 two_pi 458.3662361046586 == 6e-2+{- | /sr/ = sample rate, /r/ = cycle (two-pi), /cps/ = frequency++>>> cps_to_incr 48000 128 375+1.0++>>> cps_to_incr 48000 two_pi 458.3662361046586+6.0e-2+-} cps_to_incr :: Fractional a => a -> a -> a -> a cps_to_incr sr r cps = (r / sr) * cps --- | Inverse of 'cps_to_incr'.------ > incr_to_cps 48000 128 1 == 375+{- | Inverse of 'cps_to_incr'.++>>> incr_to_cps 48000 128 1+375.0+-} incr_to_cps :: Fractional a => a -> a -> a -> a incr_to_cps sr r ic = ic / (r / sr)  -- | Pan2 function, identity is linear, sqrt is equal power. pan2_f :: Fractional t => (t -> t) -> t -> t -> (t, t) pan2_f f p q =-    let q' = (q / 2) + 0.5-    in (p * f (1 - q'),p * f q')+  let q' = (q / 2) + 0.5+  in (p * f (1 - q'), p * f q') --- | Linear pan.------ > map (lin_pan2 1) [-1,-0.5,0,0.5,1] == [(1,0),(0.75,0.25),(0.5,0.5),(0.25,0.75),(0,1)]+{- | Linear pan.++>>> map (lin_pan2 1) [-1,-0.5,0,0.5,1]+[(1.0,0.0),(0.75,0.25),(0.5,0.5),(0.25,0.75),(0.0,1.0)]+-} lin_pan2 :: Fractional t => t -> t -> (t, t) lin_pan2 = pan2_f id --- | Equal power pan.------ > map (eq_pan2 1) [-1,-0.5,0,0.5,1]+{- | Equal power pan.++>>> map (eq_pan2 1) [-1,-0.5,0,0.5,1]+[(1.0,0.0),(0.8660254037844386,0.5),(0.7071067811865476,0.7071067811865476),(0.5,0.8660254037844386),(0.0,1.0)]+-} eq_pan2 :: Floating t => t -> t -> (t, t) eq_pan2 = pan2_f sqrt  -- | 'fromInteger' of 'properFraction'.-sc3_properFraction :: RealFrac t => t -> (t,t)+sc3_properFraction :: RealFrac t => t -> (t, t) sc3_properFraction a =-    let (p,q) = properFraction a-    in (fromInteger p,q)+  let (p, q) = properFraction a+  in (fromInteger p, q)  -- | a^2 - b^2. sc3_dif_sqr :: Num a => a -> a -> a@@ -377,27 +509,31 @@ sc3_hypotx :: (Ord a, Floating a) => a -> a -> a sc3_hypotx x y = abs x + abs y - ((sqrt 2 - 1) * min (abs x) (abs y)) --- | Fold /k/ to within range /(i,j)/, ie. @AbstractFunction.fold@------ > map (foldToRange 5 10) [3..12] == [7,6,5,6,7,8,9,10,9,8]-foldToRange :: (Ord a,Num a) => a -> a -> a -> a+{- | Fold /k/ to within range /(i,j)/, ie. @AbstractFunction.fold@++>>> map (foldToRange 5 10) [3..12]+[7,6,5,6,7,8,9,10,9,8]+-}+foldToRange :: (Ord a, Num a) => a -> a -> a -> a foldToRange i j =-    let f n = if n > j-              then f (j - (n - j))-              else if n < i-                   then f (i - (n - i))-                   else n-    in f+  let f n =+        if n > j+          then f (j - (n - j))+          else+            if n < i+              then f (i - (n - i))+              else n+  in f --- | Variant of 'foldToRange' with @SC3@ argument ordering.-sc3_fold :: (Ord a,Num a) => a -> a -> a -> a+-- | Variant of 'foldToRange' with @Sc3@ argument ordering.+sc3_fold :: (Ord a, Num a) => a -> a -> a -> a sc3_fold n i j = foldToRange i j n --- | SC3 distort operator.+-- | Sc3 distort operator. sc3_distort :: Fractional n => n -> n sc3_distort x = x / (1 + abs x) --- | SC3 softclip operator.+-- | Sc3 softclip operator. sc3_softclip :: (Ord n, Fractional n) => n -> n sc3_softclip x = let x' = abs x in if x' <= 0.5 then x else (x' - 0.25) / x @@ -411,11 +547,15 @@ sc3_false :: Num n => n sc3_false = 0 --- | Lifted 'not'.------ > sc3_not sc3_true == sc3_false--- > sc3_not sc3_false == sc3_true-sc3_not :: (Ord n,Num n) => n -> n+{- | Lifted 'not'.++>>> sc3_not sc3_true == sc3_false+True++>>> sc3_not sc3_false == sc3_true+True+-}+sc3_not :: (Ord n, Num n) => n -> n sc3_not = sc3_bool . (<= 0)  -- | Translate 'Bool' to 'sc3_true' and 'sc3_false'.@@ -458,139 +598,177 @@  -- | Enumeration of clipping rules. data Clip_Rule = Clip_None | Clip_Left | Clip_Right | Clip_Both-                 deriving (Enum,Bounded)+  deriving (Enum, Bounded) --- | Clip a value that is expected to be within an input range to an output range,---   according to a rule.------ > let f r = map (\x -> apply_clip_rule r 0 1 (-1) 1 x) [-1,0,0.5,1,2]--- > in map f [minBound .. maxBound]+{- | Clip a value that is expected to be within an input range to an output range, according to a rule.++>>> let f r = map (\x -> apply_clip_rule r 0 1 (-1) 1 x) [-1,0,0.5,1,2]+>>> map f [minBound .. maxBound]+[[Nothing,Nothing,Nothing,Nothing,Nothing],[Just (-1.0),Just (-1.0),Nothing,Nothing,Nothing],[Nothing,Nothing,Nothing,Just 1.0,Just 1.0],[Just (-1.0),Just (-1.0),Nothing,Just 1.0,Just 1.0]]+-} apply_clip_rule :: Ord n => Clip_Rule -> n -> n -> n -> n -> n -> Maybe n apply_clip_rule clip_rule sl sr dl dr x =-    case clip_rule of-      Clip_None -> Nothing-      Clip_Left -> if x <= sl then Just dl else Nothing-      Clip_Right -> if x >= sr then Just dr else Nothing-      Clip_Both -> if x <= sl then Just dl else if x >= sr then Just dr else Nothing+  case clip_rule of+    Clip_None -> Nothing+    Clip_Left -> if x <= sl then Just dl else Nothing+    Clip_Right -> if x >= sr then Just dr else Nothing+    Clip_Both -> if x <= sl then Just dl else if x >= sr then Just dr else Nothing  -- * LinLin  -- | Scale uni-polar (0,1) input to linear (l,r) range.-urange_ma :: Fractional a => SC3_MulAdd a -> a -> a -> a -> a+urange_ma :: Fractional a => Sc3_MulAdd a -> a -> a -> a -> a urange_ma mul_add_f l r i = mul_add_f i (r - l) l --- | Scale (0,1) input to linear (l,r) range. u = uni-polar.------ > map (urange 3 4) [0,0.5,1] == [3,3.5,4]+{- | Scale (0,1) input to linear (l,r) range. u = uni-polar.++>>> map (urange 3 4) [0,0.5,1]+[3.0,3.5,4.0]+-} urange :: Fractional a => a -> a -> a -> a urange = urange_ma sc3_mul_add --- | Calculate multiplier and add values for (-1,1) 'range' transform.------ > range_muladd 3 4 == (0.5,3.5)-range_muladd :: Fractional t => t -> t -> (t,t)+{- | Calculate multiplier and add values for (-1,1) 'range' transform.++>>> range_muladd 3 4+(0.5,3.5)+-}+range_muladd :: Fractional t => t -> t -> (t, t) range_muladd = linlin_muladd (-1) 1 --- | Scale bi-polar (-1,1) input to linear (l,r) range.  Note that the--- argument order is not the same as 'linLin'.-range_ma :: Fractional a => SC3_MulAdd a -> a -> a -> a -> a+{- | Scale bi-polar (-1,1) input to linear (l,r) range.+Note that the argument order is not the same as 'linLin'.+-}+range_ma :: Fractional a => Sc3_MulAdd a -> a -> a -> a -> a range_ma mul_add_f l r i =-  let (m,a) = range_muladd l r+  let (m, a) = range_muladd l r   in mul_add_f i m a --- | Scale (-1,1) input to linear (l,r) range.  Note that the argument--- order is not the same as 'linlin'. Note also that the various range--- Ugen methods at sclang select mul-add values given the output range--- of the Ugen, ie LFPulse.range selects a (0,1) input range.------ > map (range 3 4) [-1,0,1] == [3,3.5,4]--- > map (\x -> let (m,a) = linlin_muladd (-1) 1 3 4 in x * m + a) [-1,0,1] == [3,3.5,4]+{- | Scale (-1,1) input to linear (l,r) range.+Note that the argument order is not the same as 'linlin'.+Note also that the various range Ugen methods at sclang select mul-add values given the output range of the Ugen, ie LFPulse.range selects a (0,1) input range.++>>> map (range 3 4) [-1,0,1]+[3.0,3.5,4.0]++>>> map (\x -> let (m,a) = linlin_muladd (-1) 1 3 4 in x * m + a) [-1,0,1]+[3.0,3.5,4.0]+-} range :: Fractional a => a -> a -> a -> a range = range_ma sc3_mul_add  -- | 'uncurry' 'range'-range_hs :: Fractional a => (a,a) -> a -> a+range_hs :: Fractional a => (a, a) -> a -> a range_hs = uncurry range  -- | 'flip' 'range_hs'.  This allows cases such as osc `in_range` (0,1)-in_range :: Fractional a => a -> (a,a) -> a+in_range :: Fractional a => a -> (a, a) -> a in_range = flip range_hs --- | Calculate multiplier and add values for 'linlin' transform.---   Inputs are: input-min input-max output-min output-max------ > range_muladd 3 4 == (0.5,3.5)--- > linlin_muladd (-1) 1 3 4 == (0.5,3.5)--- > linlin_muladd 0 1 3 4 == (1,3)--- > linlin_muladd (-1) 1 0 1 == (0.5,0.5)--- > linlin_muladd (-0.3) 1 (-1) 1-linlin_muladd :: Fractional t => t -> t -> t -> t -> (t,t)+{- | Calculate multiplier and add values for 'linlin' transform.+Inputs are: input-min input-max output-min output-max++>>> range_muladd 3 4+(0.5,3.5)++>>> linlin_muladd (-1) 1 3 4+(0.5,3.5)++>>> linlin_muladd 0 1 3 4+(1.0,3.0)++>>> linlin_muladd (-1) 1 0 1+(0.5,0.5)++>>> linlin_muladd (-0.3) 1 (-1) 1+(1.5384615384615383,-0.5384615384615385)+-}+linlin_muladd :: Fractional t => t -> t -> t -> t -> (t, t) linlin_muladd sl sr dl dr =-    let m = (dr - dl) / (sr - sl)-        a = dl - (m * sl)-    in (m,a)+  let m = (dr - dl) / (sr - sl)+      a = dl - (m * sl)+  in (m, a) --- | Map from one linear range to another linear range.------ > linlin_ma hs_muladd 5 0 10 (-1) 1 == 0-linlin_ma :: Fractional a => SC3_MulAdd a -> a -> a -> a -> a -> a -> a+{- | Map from one linear range to another linear range.++>>> linlin_ma sc3_mul_add 5 0 10 (-1) 1+0.0+-}+linlin_ma :: Fractional a => Sc3_MulAdd a -> a -> a -> a -> a -> a -> a linlin_ma mul_add_f i sl sr dl dr =-  let (m,a) = linlin_muladd sl sr dl dr+  let (m, a) = linlin_muladd sl sr dl dr   in mul_add_f i m a --- | 'linLin' with a more typical haskell argument structure, ranges as pairs and input last.------ > map (linlin_hs (0,127) (-0.5,0.5)) [0,63.5,127] == [-0.5,0.0,0.5]+{- | 'linLin' with a more typical haskell argument structure, ranges as pairs and input last.++>>> map (linlin_hs (0,127) (-0.5,0.5)) [0,63.5,127]+[-0.5,0.0,0.5]+-} linlin_hs :: Fractional a => (a, a) -> (a, a) -> a -> a-linlin_hs (sl,sr) (dl,dr) = let (m,a) = linlin_muladd sl sr dl dr in (+ a) . (* m)+linlin_hs (sl, sr) (dl, dr) = let (m, a) = linlin_muladd sl sr dl dr in (+ a) . (* m)  {- | Map from one linear range to another linear range. -> r = [0,0.125,0.25,0.375,0.5,0.625,0.75,0.875,1]-> map (\i -> sc3_linlin i (-1) 1 0 1) [-1,-0.75 .. 1] == r-+>>> map (\i -> sc3_linlin i (-1) 1 0 1) [-1,-0.75 .. 1]+[0.0,0.125,0.25,0.375,0.5,0.625,0.75,0.875,1.0] -} sc3_linlin :: Fractional a => a -> a -> a -> a -> a -> a-sc3_linlin i sl sr dl dr = linlin_hs (sl,sr) (dl,dr) i+sc3_linlin i sl sr dl dr = linlin_hs (sl, sr) (dl, dr) i --- | Given enumeration from /dst/ that is in the same relation as /n/ is from /src/.------ > linlin _enum_plain 'a' 'A' 'e' == 'E'--- > linlin_enum_plain 0 (-50) 16 == -34--- > linlin_enum_plain 0 (-50) (-1) == -51-linlin_enum_plain :: (Enum t,Enum u) => t -> u -> t -> u+{- | Given enumeration from /dst/ that is in the same relation as /n/ is from /src/.++>>> linlin_enum_plain 'a' 'A' 'e'+'E'++>>> linlin_enum_plain 0 (-50) 16+-34++>>> linlin_enum_plain 0 (-50) (-1)+-51+-}+linlin_enum_plain :: (Enum t, Enum u) => t -> u -> t -> u linlin_enum_plain src dst n = toEnum (fromEnum dst + (fromEnum n - fromEnum src)) --- | Variant of 'linlin_enum_plain' that requires /src/ and /dst/ ranges to be of equal size,+{- | Variant of 'linlin_enum_plain' that requires /src/ and /dst/ ranges to be of equal size, -- and for /n/ to lie in /src/.------ > linlin_enum (0,100) (-50,50) 0x10 == Just (-34)--- > linlin_enum (-50,50) (0,100) (-34) == Just 0x10--- > linlin_enum (0,100) (-50,50) (-1) == Nothing-linlin_enum :: (Enum t,Enum u) => (t,t) -> (u,u) -> t -> Maybe u-linlin_enum (l,r) (l',r') n =-    if fromEnum n >= fromEnum l && fromEnum r - fromEnum l == fromEnum r' - fromEnum l'++>>> linlin_enum (0,100) (-50,50) 0x10 -- 16+Just (-34)++>>> linlin_enum (-50,50) (0,100) (-34)+Just 16++>>> linlin_enum (0,100) (-50,50) (-1)+Nothing+-}+linlin_enum :: (Enum t, Enum u) => (t, t) -> (u, u) -> t -> Maybe u+linlin_enum (l, r) (l', r') n =+  if fromEnum n >= fromEnum l && fromEnum r - fromEnum l == fromEnum r' - fromEnum l'     then Just (linlin_enum_plain l l' n)     else Nothing  -- | Erroring variant.-linlin_enum_err :: (Enum t,Enum u) => (t,t) -> (u,u) -> t -> u+linlin_enum_err :: (Enum t, Enum u) => (t, t) -> (u, u) -> t -> u linlin_enum_err src dst = fromMaybe (error "linlin_enum") . linlin_enum src dst --- | Variant of 'linlin' that requires /src/ and /dst/ ranges to be of+{- | Variant of 'linlin' that requires /src/ and /dst/ ranges to be of -- equal size, thus with constraint of 'Num' and 'Eq' instead of -- 'Fractional'.------ > linlin_eq (0,100) (-50,50) 0x10 == Just (-34)--- > linlin_eq (-50,50) (0,100) (-34) == Just 0x10-linlin_eq :: (Eq a, Num a) => (a,a) -> (a,a) -> a -> Maybe a-linlin_eq (l,r) (l',r') n =-    let d = r - l-        d' = r' - l'-    in if d == d' then Just (l' + (n - l)) else Nothing +>>> linlin_eq (0,100) (-50,50) 0x10 -- 16+Just (-34)++>>> linlin_eq (-50,50) (0,100) (-34)+Just 16+-}+linlin_eq :: (Eq a, Num a) => (a, a) -> (a, a) -> a -> Maybe a+linlin_eq (l, r) (l', r') n =+  let d = r - l+      d' = r' - l'+  in if d == d' then Just (l' + (n - l)) else Nothing+ -- | Erroring variant.-linlin_eq_err :: (Eq a,Num a) => (a,a) -> (a,a) -> a -> a+linlin_eq_err :: (Eq a, Num a) => (a, a) -> (a, a) -> a -> a linlin_eq_err src dst = fromMaybe (error "linlin_eq") . linlin_eq src dst  -- * LinExp@@ -599,55 +777,69 @@      Rule is as at linExp Ugen, haskell manner argument ordering.      Destination values must be nonzero and have the same sign. -> map (floor . linexp_hs (1,2) (10,100)) [0,1,1.5,2,3] == [1,10,31,100,1000]-> map (floor . linexp_hs (-2,2) (1,100)) [-3,-2,-1,0,1,2,3] == [0,1,3,10,31,100,316]+>>> map (floor . linexp_hs (1,2) (10,100)) [0,1,1.5,2,3]+[1,10,31,100,1000] +>>> map (floor . linexp_hs (-2,2) (1,100)) [-3,-2,-1,0,1,2,3]+[0,1,3,10,31,100,316] -}-linexp_hs :: Floating a => (a,a) -> (a,a) -> a -> a-linexp_hs (in_l,in_r) (out_l,out_r) x =-    let rt = out_r / out_l-        rn = 1.0 / (in_r - in_l)-        rr = rn * negate in_l-    in out_l * (rt ** (x * rn + rr))+linexp_hs :: Floating a => (a, a) -> (a, a) -> a -> a+linexp_hs (in_l, in_r) (out_l, out_r) x =+  let rt = out_r / out_l+      rn = 1.0 / (in_r - in_l)+      rr = rn * negate in_l+  in out_l * (rt ** (x * rn + rr)) --- | Variant of 'linexp_hs' with argument ordering as at 'linExp' Ugen.------ > map (\i -> lin_exp i 1 2 1 3) [1,1.1 .. 2]--- > map (\i -> floor (lin_exp i 1 2 10 100)) [0,1,1.5,2,3]+{- | Variant of 'linexp_hs' with argument ordering as at 'linExp' Ugen.++>>> map (\i -> lin_exp i 1 2 1 3) [1,1.1,1.9,2]+[1.0,1.1161231740339046,2.6878753795222865,3.0]++>>> map (\i -> floor (lin_exp i 1 2 10 100)) [0,1,1.5,2,3]+[1,10,31,100,1000]+-} lin_exp :: Floating a => a -> a -> a -> a -> a -> a-lin_exp x in_l in_r out_l out_r = linexp_hs (in_l,in_r) (out_l,out_r) x+lin_exp x in_l in_r out_l out_r = linexp_hs (in_l, in_r) (out_l, out_r) x --- | @SimpleNumber.linexp@ shifts from linear to exponential ranges.------ > map (sc3_linexp 1 2 1 3) [1,1.1 .. 2]------ > > [1,1.5,2].collect({|i| i.linexp(1,2,10,100).floor}) == [10,31,100]--- > map (floor . sc3_linexp 1 2 10 100) [0,1,1.5,2,3] == [10,10,31,100,100]+{- | @SimpleNumber.linexp@ shifts from linear to exponential ranges.++>>> map (sc3_linexp 1 2 1 3) [1,1.1,1.9,2]+[1.0,1.1161231740339046,2.6878753795222865,3.0]++> [1,1.5,2].collect({|i| i.linexp(1,2,10,100).floor}) == [10,31,100]++>>> map (floor . sc3_linexp 1 2 10 100) [0,1,1.5,2,3]+[10,10,31,100,100]+-} sc3_linexp :: (Ord a, Floating a) => a -> a -> a -> a -> a -> a sc3_linexp src_l src_r dst_l dst_r x =-    case apply_clip_rule Clip_Both src_l src_r dst_l dst_r x of-      Just r -> r-      Nothing -> ((dst_r / dst_l) ** ((x - src_l) / (src_r - src_l))) * dst_l+  case apply_clip_rule Clip_Both src_l src_r dst_l dst_r x of+    Just r -> r+    Nothing -> ((dst_r / dst_l) ** ((x - src_l) / (src_r - src_l))) * dst_l --- | @SimpleNumber.explin@ is the inverse of linexp.------ > map (sc3_explin 10 100 1 2) [10,10,31,100,100]+{- | @SimpleNumber.explin@ is the inverse of linexp.++>>> map (sc3_explin 10 100 1 2) [10,10,31,100,100]+[1.0,1.0,1.4913616938342726,2.0,2.0]+-} sc3_explin :: (Ord a, Floating a) => a -> a -> a -> a -> a -> a sc3_explin src_l src_r dst_l dst_r x =   fromMaybe-  (logBase (src_r / src_l) (x / src_l) * (dst_r - dst_l) + dst_l)-  (apply_clip_rule Clip_Both src_l src_r dst_l dst_r x)+    (logBase (src_r / src_l) (x / src_l) * (dst_r - dst_l) + dst_l)+    (apply_clip_rule Clip_Both src_l src_r dst_l dst_r x)  -- * ExpExp --- | Translate from one exponential range to another.------ > map (sc3_expexp 0.1 10 4.3 100) [1 .. 10]+{- | Translate from one exponential range to another.++>>> map (round . sc3_expexp 0.1 10 4.3 100) [1 .. 10]+[21,33,44,53,62,71,78,86,93,100]+-} sc3_expexp :: (Ord a, Floating a) => a -> a -> a -> a -> a -> a sc3_expexp src_l src_r dst_l dst_r x =   fromMaybe-  ((dst_r / dst_l) ** logBase (src_r / src_l) (x / src_l) * dst_l)-  (apply_clip_rule Clip_Both src_l src_r dst_l dst_r x)+    ((dst_r / dst_l) ** logBase (src_r / src_l) (x / src_l) * dst_l)+    (apply_clip_rule Clip_Both src_l src_r dst_l dst_r x)  -- * LinCurve @@ -656,69 +848,77 @@ parameter in Env.  Unlike with linexp, the output range may include zero. -> > (0..10).lincurve(0,10,-4.3,100,-3).round == [-4,24,45,61,72,81,87,92,96,98,100]+> (0..10).lincurve(0,10,-4.3,100,-3).round == [-4,24,45,61,72,81,87,92,96,98,100] -> let f = round . sc3_lincurve (-3) 0 10 (-4.3) 100-> in map f [0 .. 10] == [-4,24,45,61,72,81,87,92,96,98,100]+>>> let f = round . sc3_lincurve (-3) 0 10 (-4.3) 100+>>> map f [0 .. 10]+[-4,24,45,61,72,81,87,92,96,98,100] -> import Sound.Sc3.Plot {- hsc3-plot -}+> import Sound.Sc3.Plot {\- hsc3-plot -\} > plotTable (map (\c-> map (sc3_lincurve c 0 1 (-1) 1) [0,0.01 .. 1]) [-6,-4 .. 6])- -} sc3_lincurve :: (Ord a, Floating a) => a -> a -> a -> a -> a -> a -> a sc3_lincurve curve src_l src_r dst_l dst_r x =-    case apply_clip_rule Clip_Both src_l src_r dst_l dst_r x of-      Just r -> r-      Nothing ->-          if abs curve < 0.001-          then linlin_hs (src_l,src_r) (dst_l,dst_r) x-          else let grow = exp curve-                   a = (dst_r - dst_l) / (1.0 - grow)-                   b = dst_l + a-                   scaled = (x - src_l) / (src_r - src_l)-               in b - (a * (grow ** scaled))+  case apply_clip_rule Clip_Both src_l src_r dst_l dst_r x of+    Just r -> r+    Nothing ->+      if abs curve < 0.001+        then linlin_hs (src_l, src_r) (dst_l, dst_r) x+        else+          let grow = exp curve+              a = (dst_r - dst_l) / (1.0 - grow)+              b = dst_l + a+              scaled = (x - src_l) / (src_r - src_l)+          in b - (a * (grow ** scaled)) --- | Inverse of 'sc3_lincurve'.------ > let f = round . sc3_curvelin (-3) (-4.3) 100 0 10--- > in map f [-4,24,45,61,72,81,87,92,96,98,100] == [0..10]+{- | Inverse of 'sc3_lincurve'.++>>> let f = round . sc3_curvelin (-3) (-4.3) 100 0 10+>>> map f [-4,24,45,61,72,81,87,92,96,98,100] == [0..10]+True+-} sc3_curvelin :: (Ord a, Floating a) => a -> a -> a -> a -> a -> a -> a sc3_curvelin curve src_l src_r dst_l dst_r x =-    case apply_clip_rule Clip_Both src_l src_r dst_l dst_r x of-      Just r -> r-      Nothing ->-          if abs curve < 0.001-          then linlin_hs (src_l,src_r) (dst_l,dst_r) x-          else let grow = exp curve-                   a = (src_r - src_l) / (1.0 - grow)-                   b = src_l + a-               in log ((b - x) / a) * (dst_r - dst_l) / curve + dst_l+  case apply_clip_rule Clip_Both src_l src_r dst_l dst_r x of+    Just r -> r+    Nothing ->+      if abs curve < 0.001+        then linlin_hs (src_l, src_r) (dst_l, dst_r) x+        else+          let grow = exp curve+              a = (src_r - src_l) / (1.0 - grow)+              b = src_l + a+          in log ((b - x) / a) * (dst_r - dst_l) / curve + dst_l --- * PP+-- * Pp (pretty print)  -- | Removes all but the last trailing zero from floating point string. double_pp_rm0 :: String -> String double_pp_rm0 =-    let rev_f f = reverse . f . reverse-        remv l = case l of-                   '0':'.':_ -> l-                   '0':l' -> remv l'-                   _ -> l-    in rev_f remv+  let rev_f f = reverse . f . reverse+      remv l = case l of+        '0' : '.' : _ -> l+        '0' : l' -> remv l'+        _ -> l+  in rev_f remv --- | The default show is odd, 0.05 shows as 5.0e-2.------ > unwords (map (double_pp 4) [0.0001,0.001,0.01,0.1,1.0]) == "0.0001 0.001 0.01 0.1 1.0"+{- | The default show is odd, 0.05 shows as 5.0e-2.++>>> unwords (map (double_pp 4) [0.0001,0.001,0.01,0.1,1.0])+"0.0001 0.001 0.01 0.1 1.0"+-} double_pp :: Int -> Double -> String double_pp k n = double_pp_rm0 (Numeric.showFFloat (Just k) n "") --- | Print as integer if integral, else as real.------ > unwords (map (real_pp 5) [0.0001,0.001,0.01,0.1,1.0]) == "0.0001 0.001 0.01 0.1 1"+{- | Print as integer if integral, else as real.++>>> unwords (map (real_pp 5) [0.0001,0.001,0.01,0.1,1.0])+"0.0001 0.001 0.01 0.1 1"+-} real_pp :: Int -> Double -> String real_pp k n =-    let r = toRational n-    in if denominator r == 1 then show (numerator r) else double_pp k n+  let r = toRational n+  in if denominator r == 1 then show (numerator r) else double_pp k n  -- * Parser @@ -733,8 +933,8 @@ sum_opt_f f3 f4 =   let recur l =         case l of-          p:q:r:s:l' -> recur (f4 p q r s : l')-          p:q:r:l' -> recur (f3 p q r : l')+          p : q : r : s : l' -> recur (f4 p q r s : l')+          p : q : r : l' -> recur (f3 p q r : l')           _ -> sum l   in recur 

@@ -1,51 +1,51 @@ -- | Filter coefficient calculations. module Sound.Sc3.Common.Math.Filter where --- | SOS filter coefficients, (a0,a1,a2,b1,b2)-type SosCoef t = (t,t,t,t,t)+-- | Sos filter coefficients, (a0, a1, a2, b1, b2)+type SosCoef t = (t, t, t, t, t) --- | Butterworth low pass or high pass SOS filter coefficients, (a0,a1,a2,b1,b2).+-- | Butterworth low pass or high pass Sos filter coefficients. bw_lpf_or_hpf_coef :: Floating n => Bool -> n -> n -> SosCoef n bw_lpf_or_hpf_coef is_hpf sample_rate f =-    let f' = f * pi / sample_rate-        c = if is_hpf then tan f' else 1.0 / tan f'-        c2 = c * c-        s2c = sqrt 2.0 * c-        a0 = 1.0 / (1.0 + s2c + c2)-        a1 = if is_hpf then -2.0 * a0 else 2.0 * a0-        a2 = a0-        b1 = if is_hpf then 2.0 * (c2 - 1.0) * a0 else 2.0 * (1.0 - c2) * a0-        b2 = (1.0 - s2c + c2) * a0-    in (a0,a1,a2,b1,b2)+  let f' = f * pi / sample_rate+      c = if is_hpf then tan f' else 1 / tan f'+      c2 = c * c+      s2c = sqrt 2 * c+      a0 = 1 / (1 + s2c + c2)+      a1 = if is_hpf then -2 * a0 else 2 * a0+      a2 = a0+      b1 = if is_hpf then 2 * (c2 - 1.0) * a0 else 2 * (1 - c2) * a0+      b2 = (1 - s2c + c2) * a0+  in (a0, a1, a2, b1, b2) --- | Two place infinite impulse response filter coefficients, (a0,b1,b2)-type Iir2Coef t = (t,t,t)+-- | Two place infinite impulse response filter coefficients, (a0, b1, b2)+type Iir2Coef t = (t, t, t)  -- | rlpf coefficients, (a0,b1,b2).-rlpf_coef :: Floating n => (n -> n -> n) -> (n,n,n) -> Iir2Coef n-rlpf_coef max_f (radians_per_sample,f,rq) =-    let qr = max_f 0.001 rq-        pf = f * radians_per_sample-        d = tan (pf * qr * 0.5)-        c = (1.0 - d) / (1.0 + d)-        b1 = (1.0 + c) * cos pf-        b2 = negate c-        a0 = (1.0 + c - b1) * 0.25-    in (a0,b1,b2)+rlpf_coef :: Floating n => (n -> n -> n) -> (n, n, n) -> Iir2Coef n+rlpf_coef max_f (radians_per_sample, f, rq) =+  let qr = max_f 0.001 rq+      pf = f * radians_per_sample+      d = tan (pf * qr * 0.5)+      c = (1 - d) / (1 + d)+      b1 = (1 + c) * cos pf+      b2 = negate c+      a0 = (1 + c - b1) * 0.25+  in (a0, b1, b2)  -- | resonz coefficients, (a0,b1,b2).-resonz_coef :: Floating n => (n,n,n) -> Iir2Coef n-resonz_coef (radians_per_sample,f,rq) =-    let ff = f * radians_per_sample-        b = ff * rq-        r = 1.0 - b * 0.5-        two_r = 2.0 * r-        r2 = r * r-        ct = (two_r * cos ff) / (1.0 + r2)-        b1 = two_r * ct-        b2 = negate r2-        a0 = (1.0 - r2) * 0.5-    in (a0,b1,b2)+resonz_coef :: Floating n => (n, n, n) -> Iir2Coef n+resonz_coef (radians_per_sample, f, rq) =+  let ff = f * radians_per_sample+      b = ff * rq+      r = 1 - b * 0.5+      two_r = 2 * r+      r2 = r * r+      ct = (two_r * cos ff) / (1 + r2)+      b1 = two_r * ct+      b2 = negate r2+      a0 = (1 - r2) * 0.5+  in (a0, b1, b2)  -- * Pinking @@ -64,20 +64,26 @@ pinking_filter_freq_192000 :: Fractional t => Pinking_Param t pinking_filter_freq_192000 = (9211.912, 8621.096, 8555.228, 8292.754, 518.334, 163.712, 240.241) --- > pinking_filter_coef 48000 pinking_filter_freq_48000+{- | Pinking filter coefficients++>>> pinking_filter_coef 48000 pinking_filter_freq_48000+(0.5368186045507747,0.5899888969306109,0.6945314610687594,0.8175983529924599,0.9542588306160661,0.9908788735874952,0.9960807097281633)+-} pinking_filter_coef :: Floating t => t -> Pinking_Param t -> Pinking_Param t pinking_filter_coef sr (f0, f1, f2, f3, f4, f5, f6) =-  let f n = exp ((- 2) * pi * n / sr)+  let f n = exp ((-2) * pi * n / sr)   in (f f0, f f1, f f2, f f3, f f4, f f5, f f6)  pinking_filter_next :: Floating t => Pinking_Param t -> Pinking_Param t -> t -> (t, Pinking_Param t) pinking_filter_next (k0, k1, k2, k3, k4, k5, k6) (m0, m1, m2, m3, m4, m5, m6) white =-  let (b0, b1, b2, b3, b4, b5, b6) = ((k0 * white) + (k0 * m0)-                                     ,(k1 * white) + (k1 * m1)-                                     ,(k2 * white) + (k2 * m2)-                                     ,(k3 * white) + (k3 * m3)-                                     ,(k4 * white) + (k4 * m4)-                                     ,(k5 * white) + (k5 * m5)-                                     ,(k6 * white) + (k6 * m6))+  let (b0, b1, b2, b3, b4, b5, b6) =+        ( (k0 * white) + (k0 * m0)+        , (k1 * white) + (k1 * m1)+        , (k2 * white) + (k2 * m2)+        , (k3 * white) + (k3 * m3)+        , (k4 * white) + (k4 * m4)+        , (k5 * white) + (k5 * m5)+        , (k6 * white) + (k6 * m6)+        )       pink = b0 + b1 + b2 + b3 + b4 + b5 + white - b6   in (pink, (b0, b1, b2, b3, b4, b5, b6))

@@ -1,22 +1,25 @@--- | BEQ filter coefficient calculations, results are (a0,a1,a2,b0,b1).+-- | Beq filter coefficient calculations. module Sound.Sc3.Common.Math.Filter.Beq where +-- | Beq coefficients, (a0, a1, a2, b1, b2).+type Beq t = (t, t, t, t, t)+ -- | Calculate coefficients for bi-quad low pass filter.-bLowPassCoef :: Floating a => a -> a -> a -> (a,a,a,a,a)+bLowPassCoef :: Floating t => t -> t -> t -> Beq t bLowPassCoef sr freq rq =-    let w0 = pi * 2 * freq * (1 / sr)-        cos_w0 = cos w0-        i = 1 - cos_w0-        alpha = sin w0 * 0.5 * rq-        b0rz = recip (1 + alpha)-        a0 = i * 0.5 * b0rz-        a1 = i * b0rz-        b1 = cos_w0 * 2 * b0rz-        b2 = (1 - alpha) * negate b0rz-    in (a0,a1,a0,b1,b2)+  let w0 = pi * 2 * freq * (1 / sr)+      cos_w0 = cos w0+      i = 1 - cos_w0+      alpha = sin w0 * 0.5 * rq+      b0rz = recip (1 + alpha)+      a0 = i * 0.5 * b0rz+      a1 = i * b0rz+      b1 = cos_w0 * 2 * b0rz+      b2 = (1 - alpha) * negate b0rz+  in (a0, a1, a0, b1, b2)  -- | Calculate coefficients for bi-quad high pass filter.-bHiPassCoef :: Floating t => t -> t -> t -> (t, t, t, t, t)+bHiPassCoef :: Floating t => t -> t -> t -> Beq t bHiPassCoef sr freq rq =   let w0 = pi * 2 * freq * (1 / sr)       cos_w0 = cos w0@@ -30,17 +33,17 @@   in (a0, a1, a0, b1, b2)  -- | Calculate coefficients for bi-quad all pass filter.-bAllPassCoef :: Floating t => t -> t -> t -> (t, t, t, t, t)+bAllPassCoef :: Floating t => t -> t -> t -> Beq t bAllPassCoef sr freq rq =   let w0 = pi * 2 * freq * (1 / sr)       alpha = sin w0 * 0.5 * rq       b0rz = recip (1 + alpha)       a0 = (1 - alpha) * b0rz       b1 = 2.0 * cos w0 * b0rz-  in (a0,negate b1, 1.0, b1,negate a0)+  in (a0, negate b1, 1.0, b1, negate a0)  -- | Calculate coefficients for bi-quad band pass filter.-bBandPassCoef :: Floating t => t -> t -> t -> (t, t, t, t, t)+bBandPassCoef :: Floating t => t -> t -> t -> Beq t bBandPassCoef sr freq bw =   let w0 = pi * 2 * freq * (1 / sr)       sin_w0 = sin w0@@ -52,7 +55,7 @@   in (a0, 0.0, negate a0, b1, b2)  -- | Calculate coefficients for bi-quad stop band filter.-bBandStopCoef :: Floating t => t -> t -> t -> (t, t, t, t, t)+bBandStopCoef :: Floating t => t -> t -> t -> Beq t bBandStopCoef sr freq bw =   let w0 = pi * 2 * freq * (1 / sr)       sin_w0 = sin w0@@ -62,9 +65,9 @@       b2 = (1 - alpha) * negate b0rz   in (b0rz, negate b1, b0rz, b1, b2) --- | Calculate coefficients for bi-quad peaking EQ filter.-bPeakEQCoef :: Floating t => t -> t -> t -> t -> (t, t, t, t, t)-bPeakEQCoef sr freq rq db =+-- | Calculate coefficients for bi-quad peaking Eq filter.+bPeakEqCoef :: Floating t => t -> t -> t -> t -> Beq t+bPeakEqCoef sr freq rq db =   let a = 10 ** (db / 40)       w0 = pi * 2 * freq * (1 / sr)       alpha = sin w0 * 0.5 * rq@@ -76,7 +79,7 @@   in (a0, negate b1, a2, b1, b2)  -- | Calculate coefficients for bi-quad low shelf filter.-bLowShelfCoef :: Floating t => t -> t -> t -> t -> (t, t, t, t, t)+bLowShelfCoef :: Floating t => t -> t -> t -> t -> Beq t bLowShelfCoef sr freq rs db =   let a = 10 ** (db / 40)       w0 = pi * 2 * freq * (1 / sr)@@ -95,15 +98,15 @@   in (a0, a1, a2, b1, b2)  -- | Calculate coefficients for bi-quad high shelf filter.-bHiShelfCoef :: Floating t => t -> t -> t -> t -> (t, t, t, t, t)+bHiShelfCoef :: Floating t => t -> t -> t -> t -> Beq t bHiShelfCoef sr freq rs db =   let a = 10 ** (db / 40)       w0 = pi * 2 * freq * (1 / sr)       cos_w0 = cos w0       sin_w0 = sin w0-      alpha = sin_w0 * 0.5 * sqrt((a + recip a) * (rs - 1) + 2.0)-      i = (a+1) * cos_w0-      j = (a-1) * cos_w0+      alpha = sin_w0 * 0.5 * sqrt ((a + recip a) * (rs - 1) + 2.0)+      i = (a + 1) * cos_w0+      j = (a - 1) * cos_w0       k = 2 * sqrt a * alpha       b0rz = recip ((a + 1) - j + k)       a0 = a * ((a + 1) + j + k) * b0rz

@@ -1,28 +1,33 @@--- | Interpolation functions, ie. for envelope segments.  Present naming is for qualified import.+{- | Interpolation functions, ie. for envelope segments.+Present naming is for qualified import.+-} module Sound.Sc3.Common.Math.Interpolate where -import Sound.Sc3.Common.Math {- hsc3 -}+import qualified Sound.Sc3.Common.Math as Math {- hsc3 -}  {- | An interpolation function takes three arguments.      x0 is the left or begin value, x1 is the right or end value, t is a (0,1) index. -} type Interpolation_f t = t -> t -> t -> t --- | Clip x to (0,1) and run f.------ > interpolate linear (-1,1) 0.5 == 0-interpolate :: (Num t,Ord t) => Interpolation_f t -> (t,t) -> t -> t-interpolate f (l,r) x = if x < 0 then l else if x > 1 then r else f l r x+{- | Clip x to (0,1) and run f. +>>> interpolate linear (-1,1) 0.5+0.0+-}+interpolate :: (Num t, Ord t) => Interpolation_f t -> (t, t) -> t -> t+interpolate f (l, r) x = if x < 0 then l else if x > 1 then r else f l r x+ -- | Step function, ignores t and returns x1. step :: Interpolation_f t step _ x1 _ = x1  {- | Linear interpolation funtion. -> map (linear 1 10) [0,0.25 .. 1] == [1,3.25,5.5,7.75,10]+>>> map (linear 1 10) [0,0.25 .. 1]+[1.0,3.25,5.5,7.75,10.0] -> import Sound.Sc3.Plot {- hsc3-plot -}+> import Sound.Sc3.Plot {\- hsc3-plot -\} > plot_fn_r1_ln (linear (-1) 1) (0,1) -} linear :: Num t => Interpolation_f t@@ -31,47 +36,51 @@ {- | Exponential interpolation.      x0 must not be zero and (x0,x1) must not span zero. -> plot_fn_r1_ln (exponential 0.001 1) (0,1)-> plot_fn_r1_ln (exponential 1 2) (0,1)-> plot_fn_r1_ln (exponential 20 20000) (0,1)+> plot_fn_r1_ln [exponential 0.001 1] (0,1)+> plot_fn_r1_ln [exponential 1 2] (0,1)+> plot_fn_r1_ln [exponential 20 20000] (0,1) -} exponential :: Floating t => Interpolation_f t exponential x0 x1 t = x0 * ((x1 / x0) ** t)  {- | Variant that allows x0 to be zero, though (x0,x1) must not span zero. -> plot_fn_r1_ln (exponential_0 0 1) (0,1)-> plot_fn_r1_ln (exponential_0 0 (-1)) (0,1)+> plot_fn_r1_ln [exponential_0 0 1] (0,1)+> plot_fn_r1_ln [exponential_0 0 (-1)] (0,1) -}-exponential_0 :: (Eq t,Floating t) => Interpolation_f t+exponential_0 :: (Eq t, Floating t) => Interpolation_f t exponential_0 x0 x1 =-    let epsilon = 1e-6-        x0' = if x0 == 0 then epsilon * signum x1 else x0-    in exponential x0' x1+  let epsilon = 1e-6+      x0' = if x0 == 0 then epsilon * signum x1 else x0+  in exponential x0' x1 --- | 'linear' of 'exponential_0' of (0,1), ie. allows (x0,x1) to span zero.------ > plot_fn_r1_ln (exponential_lin (-1) 1) (0,1)-exponential_lin :: (Eq t,Floating t) => Interpolation_f t+{- | 'linear' of 'exponential_0' of (0,1), ie. allows (x0,x1) to span zero.++> plot_fn_r1_ln [exponential_lin (-1) 1] (0,1)+-}+exponential_lin :: (Eq t, Floating t) => Interpolation_f t exponential_lin x0 x1 t = linear x0 x1 (exponential_0 0 1 t) --- | 'linear' with t transformed by sine function over (-pi/2,pi/2).------ > plot_fn_r1_ln (sine (-1) 1) (0,1)+{- | 'linear' with t transformed by sine function over (-pi/2,pi/2).++> plot_fn_r1_ln [sine (-1) 1] (0,1)+> plot_fn_r1_ln [sine 1 (-1)] (0,1)+-} sine :: Floating t => Interpolation_f t sine x0 x1 t =-    let t' = - cos (pi * t) * 0.5 + 0.5-    in linear x0 x1 t'+  let t' = -cos (pi * t) * 0.5 + 0.5+  in linear x0 x1 t' --- | If x0 '<' x1 rising sine segment (0,pi/2), else falling segment (pi/2,pi).------ > plot_fn_r1_ln (welch (-1) 1) (0,1)--- > plot_fn_r1_ln (welch 1 (-1)) (0,1)+{- | If x0 '<' x1 rising sine segment (0,pi/2), else falling segment (pi/2,pi).++> plot_fn_r1_ln [welch (-1) 1] (0,1)+> plot_fn_r1_ln [welch 1 (-1)] (0,1)+-} welch :: (Ord t, Floating t) => Interpolation_f t welch x0 x1 t =-    if x0 < x1-    then x0 + (x1 - x0) * sin (half_pi * t)-    else x1 - (x1 - x0) * sin (half_pi - (half_pi * t))+  if x0 < x1+    then x0 + (x1 - x0) * sin (Math.half_pi * t)+    else x1 - (x1 - x0) * sin (Math.half_pi - (Math.half_pi * t))  {- | Curvature controlled by single parameter c.      Zero is 'linear', increasing c approaches 'exponential' and continues past it.@@ -84,40 +93,42 @@ -} curve :: (Ord t, Floating t) => t -> Interpolation_f t curve c x0 x1 t =-    if abs c < 0.0001+  if abs c < 0.0001     then linear x0 x1 t-    else let d = 1 - exp c-             n = 1 - exp (t * c)-         in x0 + (x1 - x0) * (n/d)+    else+      let d = 1 - exp c+          n = 1 - exp (t * c)+      in x0 + (x1 - x0) * (n / d)  {- | Square of 'linear' of 'sqrt' of x0 and x1, therefore neither may be negative. -> plot_fn_r1_ln (squared 0 1) (0,1)+> plot_fn_r1_ln [squared 0 1] (0,1) > plot_p1_ln (map (\f -> map f [0,0.01 .. 1]) [curve 2.05 0 1,squared 0 1]) -} squared :: Floating t => Interpolation_f t squared x0 x1 t =-    let x0' = sqrt x0-        x1' = sqrt x1-        l = linear x0' x1' t-    in l * l+  let x0' = sqrt x0+      x1' = sqrt x1+      l = linear x0' x1' t+  in l * l  {- | Cubic variant of 'squared'. -> plot_fn_r1_ln (cubed 0 1) (0,1)+> plot_fn_r1_ln [cubed 0 1] (0,1) > plot_p1_ln (map (\f -> map f [0,0.01 .. 1]) [curve 3.25 0 1,cubed 0 1]) -} cubed :: Floating t => Interpolation_f t cubed x0 x1 t =-    let x0' = x0 ** (1/3)-        x1' = x1 ** (1/3)-        l = linear x0' x1' t-    in l * l * l+  let x0' = x0 ** (1 / 3)+      x1' = x1 ** (1 / 3)+      l = linear x0' x1' t+  in l * l * l --- | x0 until end, then immediately x1.------ > plot_fn_r1_ln (hold 0 1) (0,2)-hold :: (Num t,Ord t) => Interpolation_f t+{- | x0 until end, then immediately x1.++> plot_fn_r1_ln [hold 0 1] (0,2)+-}+hold :: (Num t, Ord t) => Interpolation_f t hold x0 x1 t = if t >= 1 then x1 else x0  {- | Fader curve, equal to 'squared' when x1 > x0.@@ -125,7 +136,7 @@ > plot_p1_ln (map (\f -> map f [0,0.01 .. 1]) [squared 0 1,fader 0 1]) > plot_p1_ln (map (\f -> map f [0,0.01 .. 1]) [curve 2 1 0,fader 1 0]) -}-fader :: (Num t,Ord t) => Interpolation_f t+fader :: (Num t, Ord t) => Interpolation_f t fader x0 x1 t =   let rng = x1 - x0       sqr i = i * i

@@ -7,19 +7,21 @@ cusp_f :: Floating t => t -> t -> t -> t cusp_f a b x = a - (b * sqrt (abs x)) --- | x(n+1) = sin(im * y(n) + fb * x(n))---   y(n+1) = (a * y(n) + c) % 2pi+{- | x(n+1) = sin(im * y(n) + fb * x(n))+  y(n+1) = (a * y(n) + c) % 2pi+-} fbSine_f :: (Floating t, RealFrac t) => t -> t -> t -> t -> (t, t) -> (t, t)-fbSine_f im fb a c (x,y) = (sin ((im * y) + (fb * x)),((a * y) + c) `sc3_mod` (2 * pi))+fbSine_f im fb a c (x, y) = (sin ((im * y) + (fb * x)), ((a * y) + c) `sc3_mod` (2 * pi))  -- | x(n+2) = 1 - a * x(n+1)^2 + b * x(n) henon_f :: Floating t => t -> t -> (t, t) -> (t, t)-henon_f a b (x1,x0) = (1 - (a * (x1 ** 2)) + (b * x0),x1)+henon_f a b (x1, x0) = (1 - (a * (x1 ** 2)) + (b * x0), x1) --- | x(n+1) = sin(b * y(n)) + c * sin(b * x(n))---   y(n+1) = sin(a * x(n)) + d * sin(a * y(n))+{- | x(n+1) = sin(b * y(n)) + c * sin(b * x(n))+  y(n+1) = sin(a * x(n)) + d * sin(a * y(n))+-} latoocarfian_f :: Floating t => t -> t -> t -> t -> (t, t) -> (t, t)-latoocarfian_f a b c d (x,y) = (sin(b * y) + (c * sin (b * x)),sin(a * x) + (d * sin (a * y)))+latoocarfian_f a b c d (x, y) = (sin (b * y) + (c * sin (b * x)), sin (a * x) + (d * sin (a * y)))  -- | x(n+1) = (a * x(n) + c) % m linCong_f :: RealFrac t => t -> t -> t -> t -> t@@ -29,19 +31,21 @@ logistic_f :: Num t => t -> t -> t logistic_f a x = a * x * (1 - x) --- | x' = s * (y - x)---   y' = x * (r - z) - y---   z' = x * y - b * z+{- | x' = s * (y - x)+  y' = x * (r - z) - y+  z' = x * y - b * z+-} lorenz_f :: Num t => t -> t -> t -> (t, t, t) -> (t, t, t)-lorenz_f s r b (x,y,z) = (s * (y - x),x * (r - z) - y,x * y - b * z)+lorenz_f s r b (x, y, z) = (s * (y - x), x * (r - z) - y, x * y - b * z)  -- | x(n+1) = a * x(n)^2 + b * x(n) + c quad_f :: Floating t => t -> t -> t -> t -> t quad_f a b c x = (a * (x ** 2)) + (b * x) + c --- | x(n+1) = (x(n) + y(n+1)) % 2pi---   y(n+1) = (y(n) + k * sin(x(n))) % 2pi+{- | x(n+1) = (x(n) + y(n+1)) % 2pi+  y(n+1) = (y(n) + k * sin(x(n))) % 2pi+-} standard_f :: (RealFrac t, Floating t) => t -> (t, t) -> (t, t)-standard_f k (x,y) =+standard_f k (x, y) =   let y' = (y + (k * sin x)) `sc3_mod` two_pi-  in ((x + y') `sc3_mod` two_pi,y')+  in ((x + y') `sc3_mod` two_pi, y')

@@ -7,7 +7,6 @@ True is 1.0, False is 0.0  The RealFrac class requires Integral results, hence RealFracE.- -} module Sound.Sc3.Common.Math.Operator where @@ -75,15 +74,15 @@   | OpSoftClip -- 43   | OpCoin   | OpDigitValue -- 45-  | OpSilence-  | OpThru-  | OpRectWindow-  | OpHanWindow+  | OpSilence -- 46+  | OpThru -- 47+  | OpRectWindow -- 48+  | OpHanWindow -- 49   | OpWelchWindow -- 50   | OpTriWindow   | OpRamp_ -- 52 ; Ugen   | OpScurve-  deriving (Eq,Show,Enum,Bounded,Read)+  deriving (Eq, Show, Enum, Bounded, Read)  -- | Enum name without Op prefix. sc3_unary_op_name :: Sc3_Unary_Op -> String@@ -91,19 +90,21 @@  {- | 'Base.parse_enum' with Op prefix. -> Data.Maybe.mapMaybe (parse_unary Cs) (words "Abs Rand")+>>> Data.Maybe.mapMaybe (parse_unary Base.Cs) (words "Abs Rand")+[OpAbs] -} parse_unary :: Base.Case_Rule -> String -> Maybe Sc3_Unary_Op parse_unary cr = Base.parse_enum cr . (++) "Op" --- | Table of operator names (non-symbolic) and indices.------ > map fst sc3_unary_op_tbl-sc3_unary_op_tbl :: [(String,Int)]-sc3_unary_op_tbl = zip (map sc3_unary_op_name [minBound .. maxBound]) [0..]+{- | Table of operator names (non-symbolic) and indices. +> map fst sc3_unary_op_tbl+-}+sc3_unary_op_tbl :: [(String, Int)]+sc3_unary_op_tbl = zip (map sc3_unary_op_name [minBound .. maxBound]) [0 ..]+ -- | Table of symbolic names for standard unary operators.-unary_sym_tbl :: [(Sc3_Unary_Op,String)]+unary_sym_tbl :: [(Sc3_Unary_Op, String)] unary_sym_tbl = [] -- (Neg,"-"),(Not,"!")  -- | Lookup possibly symbolic name for standard unary operators.@@ -112,30 +113,41 @@   let e = toEnum n   in fromMaybe (sc3_unary_op_name e) (lookup e unary_sym_tbl) --- | Given name of unary operator derive index.------ > Data.Maybe.mapMaybe (unaryIndex Ci) (words "abs Cubed midiCps Neg") == [5,13,17,0]--- > unaryIndex Cs "SinOsc" == Nothing+{- | Given name of unary operator derive index.++>>> Data.Maybe.mapMaybe (unaryIndex Base.Ci) (words "abs Cubed midiCps Neg")+[5,13,17,0]++>>> unaryIndex Base.Cs "SinOsc"+Nothing+-} unaryIndex :: Base.Case_Rule -> String -> Maybe Int unaryIndex cr nm =-    let ix = Base.rlookup_str cr nm unary_sym_tbl-        ix' = parse_unary cr nm-    in fmap fromEnum (mplus ix' ix)+  let ix = Base.rlookup_str cr nm unary_sym_tbl+      ix' = parse_unary cr nm+  in fmap fromEnum (mplus ix' ix) --- | 'isJust' of 'unaryIndex'.------ > map (is_unary Ci) (words "Abs MidiCps Neg")--- > map (is_unary Ci) (words "- rand")--- > map (is_unary Ci) (words "arctan atan")+{- | 'isJust' of 'unaryIndex'.++>>> map (is_unary Base.Ci) (words "Abs MidiCps Neg")+[True,True,True]++>>> map (is_unary Base.Ci) (words "- rand")+[False,False]++>>> map (is_unary Base.Ci) (words "arctan atan")+[True,False]+-} is_unary :: Base.Case_Rule -> String -> Bool is_unary cr = isJust . unaryIndex cr  -- * Binary --- | Enumeration of @Sc3@ unary operator Ugens.---   The names here are from the enumeration at "server/plugins/BinaryOpUgens.cpp".------ > zip (map show [minBound :: Sc3_Binary_Op .. maxBound]) [0..]+{- | Enumeration of @Sc3@ unary operator Ugens.+The names here are from the enumeration at "server/plugins/BinaryOpUgens.cpp".++> zip (map show [minBound :: Sc3_Binary_Op .. maxBound]) [0..]+-} data Sc3_Binary_Op   = OpAdd -- 0   | OpSub -- 1@@ -159,7 +171,7 @@   | OpRoundTo -- 19 -- i.e. roundTo: (renamed)   | OpRoundUp -- 20   | OpTrunc -- 21-  | OpAtan2+  | OpAtan2 -- 22   | OpHypot -- 23   | OpHypotx   | OpPow -- 25@@ -182,56 +194,61 @@   | OpClip2 -- 42   | OpExcess   | OpFold2 -- 44-  | OpWrap2-  | OpFirstArg-  | OpRandRange-  | OpExpRandRange-  deriving (Eq,Show,Enum,Bounded,Read)+  | OpWrap2 -- 45+  | OpFirstArg -- 46+  | OpRandRange -- 47+  | OpExpRandRange -- 48+  deriving (Eq, Show, Enum, Bounded, Read)  -- | Enum name without Op prefix. sc3_binary_op_name :: Sc3_Binary_Op -> String sc3_binary_op_name = drop 2 . show  -- | Table of operator names (non-symbolic) and indices.-sc3_binary_op_tbl :: [(String,Int)]-sc3_binary_op_tbl = zip (map sc3_binary_op_name [minBound .. maxBound]) [0..]+sc3_binary_op_tbl :: [(String, Int)]+sc3_binary_op_tbl = zip (map sc3_binary_op_name [minBound .. maxBound]) [0 ..]  {- | 'parse_enum' with Op prefix. -> parse_binary Ci "mul" == Just OpMul+>>> parse_binary Base.Ci "mul"+Just OpMul -} parse_binary :: Base.Case_Rule -> String -> Maybe Sc3_Binary_Op parse_binary cr = Base.parse_enum cr . (++) "Op"  -- | Table of symbolic names for standard binary operators.-binary_sym_tbl :: [(Sc3_Binary_Op,String)]+binary_sym_tbl :: [(Sc3_Binary_Op, String)] binary_sym_tbl =-    [(OpAdd,"+")-    ,(OpSub,"-")-    ,(OpMul,"*")-    ,(OpFdiv,"/")-    ,(OpMod,"%")-    ,(OpEq,"==")-    ,(OpNe,"/=") -- or !=-    ,(OpLt,"<")-    ,(OpGt,">")-    ,(OpLe,"<=")-    ,(OpGe,">=")-    ,(OpBitAnd,".&.") -- or &-    ,(OpBitOr,".|.") -- or |-    ,(OpPow,"**")]+  [ (OpAdd, "+")+  , (OpSub, "-")+  , (OpMul, "*")+  , (OpFdiv, "/")+  , (OpMod, "%")+  , (OpEq, "==")+  , (OpNe, "/=") -- or !=+  , (OpLt, "<")+  , (OpGt, ">")+  , (OpLe, "<=")+  , (OpGe, ">=")+  , (OpBitAnd, ".&.") -- or &+  , (OpBitOr, ".|.") -- or |+  , (OpPow, "**")+  ] --- | Table of operator names (non-symbolic) and indices.------ > map fst sc3_binary_op_sym_tbl-sc3_binary_op_sym_tbl :: [(String,Int)]+{- | Table of operator names (non-symbolic) and indices.++> map fst sc3_binary_op_sym_tbl+-}+sc3_binary_op_sym_tbl :: [(String, Int)] sc3_binary_op_sym_tbl =   let f x = fromMaybe (sc3_binary_op_name x) (lookup x binary_sym_tbl)-  in zip (map f [minBound .. maxBound]) [0..]+  in zip (map f [minBound .. maxBound]) [0 ..] --- | Lookup possibly symbolic name for standard binary operators.------ > map binaryName [1,2,8,12] == ["-","*","<","Min"]+{- | Lookup possibly symbolic name for standard binary operators.++>>> map binaryName [1,2,8,12]+["-","*","<","Min"]+-} binaryName :: Int -> String binaryName n =   let e = toEnum n@@ -239,19 +256,26 @@  {- | Given name of binary operator derive index. -> Data.Maybe.mapMaybe (binaryIndex Ci) (words "* mul ring1 +") == [2,2,30,0]-> binaryIndex Ci "sinosc" == Nothing-> map (\x -> (x,binaryIndex Ci x)) (map snd binary_sym_tbl)+>>> Data.Maybe.mapMaybe (binaryIndex Base.Ci) (words "* mul ring1 +")+[2,2,30,0]++>>> binaryIndex Base.Ci "sinosc"+Nothing++>>> map (\x -> (x,binaryIndex Base.Ci x)) (map snd binary_sym_tbl)+[("+",Just 0),("-",Just 1),("*",Just 2),("/",Just 4),("%",Just 5),("==",Just 6),("/=",Just 7),("<",Just 8),(">",Just 9),("<=",Just 10),(">=",Just 11),(".&.",Just 14),(".|.",Just 15),("**",Just 25)] -} binaryIndex :: Base.Case_Rule -> String -> Maybe Int binaryIndex cr nm =-    let ix = Base.rlookup_str cr nm binary_sym_tbl-        ix' = parse_binary cr nm-    in fmap fromEnum (mplus ix' ix)+  let ix = Base.rlookup_str cr nm binary_sym_tbl+      ix' = parse_binary cr nm+  in fmap fromEnum (mplus ix' ix) --- | 'isJust' of 'binaryIndex'.------ > map (is_binary Ci) (words "== > % Trunc max")+{- | 'isJust' of 'binaryIndex'.++>>> map (is_binary Base.Ci) (words "== > % Trunc max")+[True,True,True,True,True]+-} is_binary :: Base.Case_Rule -> String -> Bool is_binary cr = isJust . binaryIndex cr @@ -260,54 +284,57 @@ -- | Lookup operator name for operator Ugens, else Ugen name. ugen_operator_name :: String -> Int -> Maybe String ugen_operator_name nm n =-    case nm of-      "UnaryOpUGen" -> Just (unaryName n)-      "BinaryOpUGen" -> Just (binaryName n)-      _ -> Nothing+  case nm of+    "UnaryOpUGen" -> Just (unaryName n)+    "BinaryOpUGen" -> Just (binaryName n)+    _ -> Nothing  {- | Order of lookup: binary then unary. -> map (resolve_operator Ci) (words "+ - Add sub Neg abs")-> map (resolve_operator Cs) (words "Abs")+>>> map (resolve_operator Base.Ci) (words "+ - sub abs max")+[("BinaryOpUGen",Just 0),("BinaryOpUGen",Just 1),("BinaryOpUGen",Just 1),("UnaryOpUGen",Just 5),("BinaryOpUGen",Just 13)]++>>> map (resolve_operator Base.Cs) (words "Abs Add Neg")+[("UnaryOpUGen",Just 5),("BinaryOpUGen",Just 0),("UnaryOpUGen",Just 0)] -}-resolve_operator :: Base.Case_Rule -> String -> (String,Maybe Int)+resolve_operator :: Base.Case_Rule -> String -> (String, Maybe Int) resolve_operator cr nm =-    case binaryIndex cr nm of-      Just sp -> ("BinaryOpUGen",Just sp)-      Nothing -> case unaryIndex cr nm of-                   Just sp -> ("UnaryOpUGen",Just sp)-                   _ -> (nm,Nothing)+  case binaryIndex cr nm of+    Just sp -> ("BinaryOpUGen", Just sp)+    Nothing -> case unaryIndex cr nm of+      Just sp -> ("UnaryOpUGen", Just sp)+      _ -> (nm, Nothing)  -- | Case-insensitive resolve_operator.-resolve_operator_ci :: String -> (String,Maybe Int)+resolve_operator_ci :: String -> (String, Maybe Int) resolve_operator_ci = resolve_operator Base.Ci  -- * Classes  -- | Variant on 'Eq' class, result is of the same type as the values compared.-class (Eq a,Num a) => EqE a where+class (Eq a, Num a) => EqE a where   equal_to :: a -> a -> a   equal_to = Math.sc3_eq   not_equal_to :: a -> a -> a   not_equal_to = Math.sc3_neq -instance EqE Int where-instance EqE Integer where-instance EqE Int32 where-instance EqE Int64 where-instance EqE Float where-instance EqE Double where+instance EqE Int+instance EqE Integer+instance EqE Int32+instance EqE Int64+instance EqE Float+instance EqE Double  -- | Variant on Ord class, result is of the same type as the values compared.-class (Ord a,Num a) => OrdE a where-    less_than :: a -> a -> a-    less_than = Math.sc3_lt-    less_than_or_equal_to :: a -> a -> a-    less_than_or_equal_to = Math.sc3_lte-    greater_than :: a -> a -> a-    greater_than = Math.sc3_gt-    greater_than_or_equal_to :: a -> a -> a-    greater_than_or_equal_to = Math.sc3_gte+class (Ord a, Num a) => OrdE a where+  less_than :: a -> a -> a+  less_than = Math.sc3_lt+  less_than_or_equal_to :: a -> a -> a+  less_than_or_equal_to = Math.sc3_lte+  greater_than :: a -> a -> a+  greater_than = Math.sc3_gt+  greater_than_or_equal_to :: a -> a -> a+  greater_than_or_equal_to = Math.sc3_gte  instance OrdE Int instance OrdE Integer@@ -318,7 +345,7 @@  -- | Variant of 'RealFrac' with non 'Integral' results. class RealFrac a => RealFracE a where-  properFractionE :: a -> (a,a)+  properFractionE :: a -> (a, a)   properFractionE = Math.sc3_properFraction   truncateE :: a -> a   truncateE = Math.sc3_truncate@@ -332,128 +359,130 @@ instance RealFracE Float instance RealFracE Double --- | Unary operator class.------ > map (floor . (* 1e4) . dbAmp) [-90,-60,-30,0] == [0,10,316,10000]+{- | Unary operator class.++>>> map (floor . (* 1e4) . dbAmp) [-90,-60,-30,0]+[0,10,316,10000]+-} class (Floating a, Ord a) => UnaryOp a where-    ampDb :: a -> a-    ampDb = Math.amp_to_db-    asFloat :: a -> a-    asFloat = error "asFloat"-    asInt :: a -> a-    asInt = error "asInt"-    cpsMidi :: a -> a-    cpsMidi = Math.cps_to_midi-    cpsOct :: a -> a-    cpsOct = Math.cps_to_oct-    cubed :: a -> a-    cubed n = n * n * n-    dbAmp :: a -> a-    dbAmp = Math.db_to_amp-    distort :: a -> a-    distort = Math.sc3_distort-    frac :: a -> a-    frac = error "frac"-    isNil :: a -> a-    isNil a = if a == 0.0 then 0.0 else 1.0-    log10 :: a -> a-    log10 = logBase 10-    log2 :: a -> a-    log2 = logBase 2-    midiCps :: a -> a-    midiCps = Math.midi_to_cps-    midiRatio :: a -> a-    midiRatio = Math.midi_to_ratio-    notE :: a -> a-    notE a = if a > 0.0 then 0.0 else 1.0-    notNil :: a -> a-    notNil a = if a /= 0.0 then 0.0 else 1.0-    octCps :: a -> a-    octCps = Math.oct_to_cps-    ramp_ :: a -> a-    ramp_ _ = error "ramp_"-    ratioMidi :: a -> a-    ratioMidi = Math.ratio_to_midi-    softClip :: a -> a-    softClip = Math.sc3_softclip-    squared :: a -> a-    squared = \z -> z * z+  ampDb :: a -> a+  ampDb = Math.amp_to_db+  asFloat :: a -> a+  asFloat = error "asFloat"+  asInt :: a -> a+  asInt = error "asInt"+  cpsMidi :: a -> a+  cpsMidi = Math.cps_to_midi+  cpsOct :: a -> a+  cpsOct = Math.cps_to_oct+  cubed :: a -> a+  cubed n = n * n * n+  dbAmp :: a -> a+  dbAmp = Math.db_to_amp+  distort :: a -> a+  distort = Math.sc3_distort+  frac :: a -> a+  frac = error "frac"+  isNil :: a -> a+  isNil a = if a == 0.0 then 0.0 else 1.0+  log10 :: a -> a+  log10 = logBase 10+  log2 :: a -> a+  log2 = logBase 2+  midiCps :: a -> a+  midiCps = Math.midi_to_cps+  midiRatio :: a -> a+  midiRatio = Math.midi_to_ratio+  notE :: a -> a+  notE a = if a > 0.0 then 0.0 else 1.0+  notNil :: a -> a+  notNil a = if a /= 0.0 then 0.0 else 1.0+  octCps :: a -> a+  octCps = Math.oct_to_cps+  ramp_ :: a -> a+  ramp_ _ = error "ramp_"+  ratioMidi :: a -> a+  ratioMidi = Math.ratio_to_midi+  softClip :: a -> a+  softClip = Math.sc3_softclip+  squared :: a -> a+  squared = \z -> z * z -instance UnaryOp Float where-instance UnaryOp Double where+instance UnaryOp Float+instance UnaryOp Double  -- | Sc3_Binary_Op operator class.-class (Floating a,RealFrac a, Ord a) => BinaryOp a where-    absDif :: a -> a -> a-    absDif a b = abs (a - b)-    amClip :: a -> a -> a-    amClip a b = if b <= 0 then 0 else a * b-    atan2E :: a -> a -> a-    atan2E a b = atan (b/a)-    clip2 :: a -> a -> a-    clip2 a b = Math.sc3_clip a (-b) b-    difSqr :: a -> a -> a-    difSqr = Math.sc3_dif_sqr-    excess :: a -> a -> a-    excess a b = a - Math.sc3_clip a (-b) b-    exprandRange :: a -> a -> a-    exprandRange = error "exprandRange"-    fill :: a -> a -> a-    fill = error "fill"-    firstArg :: a -> a -> a-    firstArg a _ = a-    fold2 :: a -> a -> a-    fold2 a b = Math.sc3_fold a (-b) b-    gcdE :: a -> a -> a-    gcdE = Math.sc3_gcd-    hypot :: a -> a -> a-    hypot = Math.sc3_hypot-    hypotx :: a -> a -> a-    hypotx = Math.sc3_hypotx-    iDiv :: a -> a -> a-    iDiv = Math.sc3_idiv-    lcmE :: a -> a -> a-    lcmE = Math.sc3_lcm-    modE :: a -> a -> a-    modE = Math.sc3_mod-    randRange :: a -> a -> a-    randRange = error "randRange"-    ring1 :: a -> a -> a-    ring1 a b = a * b + a-    ring2 :: a -> a -> a-    ring2 a b = a * b + a + b-    ring3 :: a -> a -> a-    ring3 a b = a * a * b-    ring4 :: a -> a -> a-    ring4 a b = a * a * b - a * b * b-    roundUp :: a -> a -> a-    roundUp = error "roundUp"-    scaleNeg :: a -> a -> a-    scaleNeg a b = (abs a - a) * b' + a where b' = 0.5 * b + 0.5-    sqrDif :: a -> a -> a-    sqrDif a b = (a-b) * (a-b)-    sqrSum :: a -> a -> a-    sqrSum a b = (a+b) * (a+b)-    sumSqr :: a -> a -> a-    sumSqr a b = (a*a) + (b*b)-    thresh :: a -> a -> a-    thresh a b = if a <  b then 0 else a-    trunc :: a -> a -> a-    trunc = error "trunc"-    wrap2 :: a -> a -> a-    wrap2 = error "wrap2"+class (Floating a, RealFrac a, Ord a) => BinaryOp a where+  absDif :: a -> a -> a+  absDif a b = abs (a - b)+  amClip :: a -> a -> a+  amClip a b = if b <= 0 then 0 else a * b+  atan2E :: a -> a -> a+  atan2E a b = atan (b / a)+  clip2 :: a -> a -> a+  clip2 a b = Math.sc3_clip a (-b) b+  difSqr :: a -> a -> a+  difSqr = Math.sc3_dif_sqr+  excess :: a -> a -> a+  excess a b = a - Math.sc3_clip a (-b) b+  exprandRange :: a -> a -> a+  exprandRange = error "exprandRange"+  fill :: a -> a -> a+  fill = error "fill"+  firstArg :: a -> a -> a+  firstArg a _ = a+  fold2 :: a -> a -> a+  fold2 a b = Math.sc3_fold a (-b) b+  gcdE :: a -> a -> a+  gcdE = Math.sc3_gcd+  hypot :: a -> a -> a+  hypot = Math.sc3_hypot+  hypotx :: a -> a -> a+  hypotx = Math.sc3_hypotx+  iDiv :: a -> a -> a+  iDiv = Math.sc3_idiv+  lcmE :: a -> a -> a+  lcmE = Math.sc3_lcm+  modE :: a -> a -> a+  modE = Math.sc3_mod+  randRange :: a -> a -> a+  randRange = error "randRange"+  ring1 :: a -> a -> a+  ring1 a b = a * b + a+  ring2 :: a -> a -> a+  ring2 a b = a * b + a + b+  ring3 :: a -> a -> a+  ring3 a b = a * a * b+  ring4 :: a -> a -> a+  ring4 a b = a * a * b - a * b * b+  roundUp :: a -> a -> a+  roundUp = error "roundUp"+  scaleNeg :: a -> a -> a+  scaleNeg a b = (abs a - a) * b' + a where b' = 0.5 * b + 0.5+  sqrDif :: a -> a -> a+  sqrDif a b = (a - b) * (a - b)+  sqrSum :: a -> a -> a+  sqrSum a b = (a + b) * (a + b)+  sumSqr :: a -> a -> a+  sumSqr a b = (a * a) + (b * b)+  thresh :: a -> a -> a+  thresh a b = if a < b then 0 else a+  trunc :: a -> a -> a+  trunc = error "trunc"+  wrap2 :: a -> a -> a+  wrap2 = error "wrap2"  instance BinaryOp Float where-    fold2 a b = Math.sc3_fold a (-b) b-    modE = F.mod'-    roundUp a b = if b == 0 then a else ceilingE (a/b + 0.5) * b-    wrap2 a b = Math.sc3_wrap_ni (-b) b a+  fold2 a b = Math.sc3_fold a (-b) b+  modE = F.mod'+  roundUp a b = if b == 0 then a else ceilingE (a / b + 0.5) * b+  wrap2 a b = Math.sc3_wrap_ni (-b) b a  instance BinaryOp Double where-    fold2 a b = Math.sc3_fold a (-b) b-    modE = F.mod'-    roundUp a b = if b == 0 then a else ceilingE (a/b + 0.5) * b-    wrap2 a b = Math.sc3_wrap_ni (-b) b a+  fold2 a b = Math.sc3_fold a (-b) b+  modE = F.mod'+  roundUp a b = if b == 0 then a else ceilingE (a / b + 0.5) * b+  wrap2 a b = Math.sc3_wrap_ni (-b) b a  -- * Infix @@ -478,49 +507,51 @@ -- * Tables  -- | Association table for 'Sc3_Binary_Op' to haskell function implementing operator.-binop_hs_tbl :: (Real n,Floating n,RealFrac n) => [(Sc3_Binary_Op,n -> n -> n)]+binop_hs_tbl :: (Real n, Floating n, RealFrac n) => [(Sc3_Binary_Op, n -> n -> n)] binop_hs_tbl =-    [(OpAdd,(+))-    ,(OpSub,(-))-    ,(OpFdiv,(/))-    ,(OpIdiv,Math.sc3_idiv)-    ,(OpMod,Math.sc3_mod)-    ,(OpEq,Math.sc3_eq)-    ,(OpNe,Math.sc3_neq)-    ,(OpLt,Math.sc3_lt)-    ,(OpLe,Math.sc3_lte)-    ,(OpGt,Math.sc3_gt)-    ,(OpGe,Math.sc3_gte)-    ,(OpMin,min)-    ,(OpMax,max)-    ,(OpMul,(*))-    ,(OpPow,(**))-    ,(OpMin,min)-    ,(OpMax,max)-    ,(OpRoundTo,Math.sc3_round_to)]+  [ (OpAdd, (+))+  , (OpSub, (-))+  , (OpFdiv, (/))+  , (OpIdiv, Math.sc3_idiv)+  , (OpMod, Math.sc3_mod)+  , (OpEq, Math.sc3_eq)+  , (OpNe, Math.sc3_neq)+  , (OpLt, Math.sc3_lt)+  , (OpLe, Math.sc3_lte)+  , (OpGt, Math.sc3_gt)+  , (OpGe, Math.sc3_gte)+  , (OpMin, min)+  , (OpMax, max)+  , (OpMul, (*))+  , (OpPow, (**))+  , (OpMin, min)+  , (OpMax, max)+  , (OpRoundTo, Math.sc3_round_to)+  ]  -- | 'lookup' 'binop_hs_tbl' via 'toEnum'.-binop_special_hs :: (RealFrac n,Floating n) => Int -> Maybe (n -> n -> n)+binop_special_hs :: (RealFrac n, Floating n) => Int -> Maybe (n -> n -> n) binop_special_hs z = lookup (toEnum z) binop_hs_tbl  -- | Association table for 'Unary' to haskell function implementing operator.-uop_hs_tbl :: (RealFrac n,Floating n) => [(Sc3_Unary_Op,n -> n)]+uop_hs_tbl :: (RealFrac n, Floating n) => [(Sc3_Unary_Op, n -> n)] uop_hs_tbl =-    [(OpNeg,negate)-    ,(OpNot,\z -> if z > 0 then 0 else 1)-    ,(OpAbs,abs)-    ,(OpCeil,Math.sc3_ceiling)-    ,(OpFloor,Math.sc3_floor)-    ,(OpSquared,\z -> z * z)-    ,(OpCubed,\z -> z * z * z)-    ,(OpSqrt,sqrt)-    ,(OpRecip,recip)-    ,(OpMidiCps,Math.midi_to_cps)-    ,(OpCpsMidi,Math.cps_to_midi)-    ,(OpSin,sin)-    ,(OpCos,cos)-    ,(OpTan,tan)]+  [ (OpNeg, negate)+  , (OpNot, \z -> if z > 0 then 0 else 1)+  , (OpAbs, abs)+  , (OpCeil, Math.sc3_ceiling)+  , (OpFloor, Math.sc3_floor)+  , (OpSquared, \z -> z * z)+  , (OpCubed, \z -> z * z * z)+  , (OpSqrt, sqrt)+  , (OpRecip, recip)+  , (OpMidiCps, Math.midi_to_cps)+  , (OpCpsMidi, Math.cps_to_midi)+  , (OpSin, sin)+  , (OpCos, cos)+  , (OpTan, tan)+  ]  -- | 'lookup' 'uop_hs_tbl' via 'toEnum'.-uop_special_hs :: (RealFrac n,Floating n) => Int -> Maybe (n -> n)+uop_special_hs :: (RealFrac n, Floating n) => Int -> Maybe (n -> n) uop_special_hs z = lookup (toEnum z) uop_hs_tbl

@@ -10,24 +10,32 @@  {- | Linear real value map. -> map (warp_lin 1 2) [0,1/2,1] == [1,3/2,2]-> map (warp_lin (-1) 1) [0,1/2,1] == [-1,0,1]+>>> map (warp_lin 1 2) [0,1/2,1] == [1,3/2,2]+True++>>> map (warp_lin (-1) 1) [0,1/2,1] == [-1,0,1]+True -} warp_lin :: Fractional t => Warp_f t warp_lin l r n = let z = r - l in n * z + l  {- | Inverse of 'warp_lin' -> map (warp_lin_inv 1 2) [1,3/2,2] == [0,1/2,1]-> map (warp_lin_inv (-1) 1) [-1,0,1] == [0,1/2,1]+>>> map (warp_lin_inv 1 2) [1,3/2,2] == [0,1/2,1]+True++>>> map (warp_lin_inv (-1) 1) [-1,0,1] == [0,1/2,1]+True -} warp_lin_inv :: Fractional t => Warp_f t warp_lin_inv l r n = let z = r - l in (n - l) / z  {- | The left and right must both be non zero and have the same sign. -> map (warp_exp 1 2) [0,0.5,1] == [1,2 ** 0.5,2]-> import Sound.Sc3.Plot {- hsc3-plot -}+>>> map (warp_exp 1 2) [0,0.5,1] == [1,2 ** 0.5,2]+True++> import Sound.Sc3.Plot {\- hsc3-plot -\} > plot_p1_ln [map (warp_exp 1 2) [0,0.01 .. 1]] -} warp_exp :: Floating a => Warp_f a@@ -99,20 +107,22 @@ warp_curve :: (Ord a, Floating a) => a -> Warp_f a warp_curve k l r n =   if abs k < 0.001-  then warp_lin l r n-  else let e = exp k-           a = (r - l) / (1 - e)-           b = l + a-       in b - ((e ** n) * a)+    then warp_lin l r n+    else+      let e = exp k+          a = (r - l) / (1 - e)+          b = l + a+      in b - ((e ** n) * a)  warp_curve_inv :: (Ord a, Floating a) => a -> Warp_f a warp_curve_inv k l r n =   if abs k < 0.001-  then warp_lin l r n-  else let e = exp k-           a = (r - l) / (1 - e)-           b = l + a-       in log ((b - n) / a) / k+    then warp_lin l r n+    else+      let e = exp k+          a = (r - l) / (1 - e)+          b = l + a+      in log ((b - n) / a) / k  {- | Select warp functions by name.  Numerical names are interpreted as /curve/ values for 'warpCurve'. @@ -123,13 +133,13 @@ -} warp_named :: (Floating t, RealFrac t) => String -> Maybe (Warp_f t, Warp_f t) warp_named nm =-    case nm of-      "lin" -> Just (warp_lin,warp_lin_inv)-      "exp" -> Just (warp_exp,warp_exp_inv)-      "sin" -> Just (warp_sin,warp_sin_inv)-      "cos" -> Just (warp_cos,warp_cos_inv)-      "amp" -> Just (warp_amp,warp_amp_inv)-      "db" -> Just (warp_db,warp_db_inv)-      _ -> case readSigned readFloat nm of-             [(c,"")] -> Just (warp_curve c,warp_curve_inv c)-             _ -> Nothing+  case nm of+    "lin" -> Just (warp_lin, warp_lin_inv)+    "exp" -> Just (warp_exp, warp_exp_inv)+    "sin" -> Just (warp_sin, warp_sin_inv)+    "cos" -> Just (warp_cos, warp_cos_inv)+    "amp" -> Just (warp_amp, warp_amp_inv)+    "db" -> Just (warp_db, warp_db_inv)+    _ -> case readSigned readFloat nm of+      [(c, "")] -> Just (warp_curve c, warp_curve_inv c)+      _ -> Nothing

@@ -21,13 +21,13 @@      The cycle argument decides if the end point should be equal to the start point, or one place short.      When using a table with an oscillator we want the latter, since the point following the end point is the start point. -}-window_table :: (Integral n,Fractional a,Enum a) => TableFormat -> n -> Window a -> Table a+window_table :: (Integral n, Fractional a, Enum a) => TableFormat -> n -> Window a -> Table a window_table fmt n f =   let k = 1 / (fromIntegral n - (if fmt == TableClosed then 1 else 0))   in take (fromIntegral (if fmt == TableGuarded then n + 1 else n)) (map f [0, k ..])  -- | window_table of TableClosed.-window_table_closed :: (Integral n,Fractional a,Enum a) => n -> Window a -> Table a+window_table_closed :: (Integral n, Fractional a, Enum a) => n -> Window a -> Table a window_table_closed = window_table TableClosed  -- * Math@@ -40,7 +40,7 @@  -- | Gaussian window, θ <= 0.5. gaussian :: Floating a => a -> Window a-gaussian theta i = exp (- (0.5 * square ((i - 0.5) / (theta * 0.5))))+gaussian theta i = exp (-(0.5 * square ((i - 0.5) / (theta * 0.5))))  -- | Hann raised cosine window. hann :: Floating a => Window a

@@ -7,14 +7,17 @@ The Mce type is a tree, however in hsc3 Mce_Vector will always hold Mce_Scalar elements. -} data Mce t = Mce_Scalar t | Mce_Vector [Mce t]-             deriving (Ord, Eq, Read, Show)+  deriving (Ord, Eq, Read, Show)  {- | There are two invariants: 1. Mce should not be empty, ie. Mce_Vector should not have a null list. 2. Scalar Mce values should not be written as one-place vectors. -> mce_is_well_formed (Mce_Vector []) == False-> mce_is_well_formed (Mce_Vector [Mce_Scalar 1]) == False+>>> mce_is_well_formed (Mce_Vector [])+False++>>> mce_is_well_formed (Mce_Vector [Mce_Scalar 1])+False -} mce_is_well_formed :: Mce t -> Bool mce_is_well_formed m =@@ -39,24 +42,28 @@  {- | toList for Mce. -> let v = Mce_Vector in mce_to_list (v[v[1, 2], 3, v[4, 5]]) == [1, 2, 3, 4, 5]+>>> let v = Mce_Vector+>>> mce_to_list (v[v[1, 2], 3, v[4, 5]])+[1,2,3,4,5] -} mce_to_list :: Mce t -> [t] mce_to_list m =-    case m of-      Mce_Scalar e -> [e]-      Mce_Vector e -> concatMap mce_to_list e+  case m of+    Mce_Scalar e -> [e]+    Mce_Vector e -> concatMap mce_to_list e  {- | Pretty printer for Mce. -> let v = Mce_Vector in mce_show (v[1, 2, v[3, 4]] * 5 + v[6, 7, 8]) == "[11, 17, [23, 28]]"+>>> let v = Mce_Vector+>>> mce_show (v[1, 2, v[3, 4]] * 5 + v[6, 7, 8])+"[11, 17, [23, 28]]" -} mce_show :: Show t => Mce t -> String mce_show m =-  let bracketed (l,r) x = l : x ++ [r]+  let bracketed (l, r) x = l : x ++ [r]   in case m of-       Mce_Scalar e -> show e-       Mce_Vector e -> bracketed ('[',']') (Sound.Sc3.Common.Base.concat_intersperse ", " (map mce_show e))+      Mce_Scalar e -> show e+      Mce_Vector e -> bracketed ('[', ']') (Sound.Sc3.Common.Base.concat_intersperse ", " (map mce_show e))  -- | Read value from Mce_Scalar, error if Mce is Mce_Vector mce_scalar_value :: Mce t -> t@@ -76,10 +83,18 @@  {- | The depth of an Mce is the longest sequence of nested Mce_Vector nodes. -> mce_depth 1 == 1-> mce_depth (Mce_Vector [1, 2]) == 1-> let v = Mce_Vector in mce_depth (v[v[1, 2], 3, v[4, 5]]) == 2-> let v = Mce_Vector in mce_depth (v[v[1, 2, 3, v[4, 5], 6], 7]) == 3+>>> mce_depth 1+1++>>> mce_depth (Mce_Vector [1, 2])+1++>>> let v = Mce_Vector+>>> mce_depth (v[v[1, 2], 3, v[4, 5]])+2++>>> mce_depth (v[v[1, 2, 3, v[4, 5], 6], 7])+3 -} mce_depth :: Mce a -> Int mce_depth m =@@ -92,16 +107,16 @@ -} mce_extend :: Int -> Mce t -> Mce t mce_extend n m =-    case m of-      Mce_Scalar _ -> Mce_Vector (replicate n m)-      Mce_Vector e -> if length e > n then error "mce_extend?" else Mce_Vector (take n (cycle e))+  case m of+    Mce_Scalar _ -> Mce_Vector (replicate n m)+    Mce_Vector e -> if length e > n then error "mce_extend?" else Mce_Vector (take n (cycle e))  -- | fmap for Mce, apply /f/ at elements of /m/. mce_map :: (a -> b) -> Mce a -> Mce b mce_map f m =-    case m of-      Mce_Scalar e -> Mce_Scalar (f e)-      Mce_Vector e -> Mce_Vector (map (mce_map f) e)+  case m of+    Mce_Scalar e -> Mce_Scalar (f e)+    Mce_Vector e -> Mce_Vector (map (mce_map f) e)  instance Functor Mce where fmap = mce_map @@ -110,27 +125,27 @@ -} mce_binop :: (a -> b -> c) -> Mce a -> Mce b -> Mce c mce_binop f m1 m2 =-    case (m1,m2) of-      (Mce_Scalar e1,Mce_Scalar e2) -> Mce_Scalar (f e1 e2)-      (Mce_Scalar _,Mce_Vector e2) -> Mce_Vector (map (mce_binop f m1) e2)-      (Mce_Vector e1,Mce_Scalar _) -> Mce_Vector (map (flip (mce_binop f) m2) e1)-      (Mce_Vector e1,Mce_Vector e2) ->-          let n = max (length e1) (length e2)-              ext = take n . cycle-          in Mce_Vector (zipWith (mce_binop f) (ext e1) (ext e2))+  case (m1, m2) of+    (Mce_Scalar e1, Mce_Scalar e2) -> Mce_Scalar (f e1 e2)+    (Mce_Scalar _, Mce_Vector e2) -> Mce_Vector (map (mce_binop f m1) e2)+    (Mce_Vector e1, Mce_Scalar _) -> Mce_Vector (map (flip (mce_binop f) m2) e1)+    (Mce_Vector e1, Mce_Vector e2) ->+      let n = max (length e1) (length e2)+          ext = take n . cycle+      in Mce_Vector (zipWith (mce_binop f) (ext e1) (ext e2))  instance Num n => Num (Mce n) where-    (+) = mce_binop (+)-    (-) = mce_binop (-)-    (*) = mce_binop (*)-    abs = mce_map abs-    negate = mce_map negate-    signum = mce_map signum-    fromInteger = Mce_Scalar . fromInteger+  (+) = mce_binop (+)+  (-) = mce_binop (-)+  (*) = mce_binop (*)+  abs = mce_map abs+  negate = mce_map negate+  signum = mce_map signum+  fromInteger = Mce_Scalar . fromInteger  instance Fractional n => Fractional (Mce n) where-    (/) = mce_binop (/)-    fromRational = Mce_Scalar . fromRational+  (/) = mce_binop (/)+  fromRational = Mce_Scalar . fromRational  instance Floating n => Floating (Mce n) where   pi = Mce_Scalar pi

@@ -15,8 +15,11 @@  {- | Right to left compositon of 'Monad' functions. -> fmap (== 7) (composeM [return . (+ 1),return . (* 2)] 3)-> fmap (== 8) (composeM [return . (* 2),return . (+ 1)] 3)+>>> composeM [return . (+ 1),return . (* 2)] 3+7++>>> composeM [return . (* 2),return . (+ 1)] 3+8 -} composeM :: Monad m => [a -> m a] -> a -> m a composeM = foldr (\f g -> \x -> g x >>= f) return -- foldr (<=<) return except hugs doesn't know of <=<

@@ -1,91 +1,133 @@ -- | Functions to make writing 'Applicative' and 'Monad' Ugen graphs less clumsy. module Sound.Sc3.Common.Monad.Operators where -import Control.Applicative {- base -}+infixl 7 .*, *., .*.+infixl 6 .+, +., .+. -infixl 7  .*,*.,.*.-infixl 6  .+,+.,.+.+infixl 7 ./, /., ./.+infixl 6 .-, -., .-. -infixl 7  ./,/.,./.-infixl 6  .-,-.,.-.+{- | '+' variant with 'Functor' at left. --- | '+' variant with 'Functor' at left.------ > fmap (== 5) (return 3 .+ 2)--- > [3,4] .+ 2 == [5,6]+>>> fmap (== 5) (return 3 .+ 2)+True++>>> [3,4] .+ 2+[5,6]+-} (.+) :: (Functor f, Num a) => f a -> a -> f a m .+ n = fmap (+ n) m --- | '+' variant with 'Functor' at right.------ > fmap (== 5) (3 +. return 2)--- > 3 +. [2,3] == [5,6]+{- | '+' variant with 'Functor' at right.++>>> fmap (== 5) (3 +. return 2)+True++>>> 3 +. [2,3]+[5,6]+-} (+.) :: (Functor f, Num a) => a -> f a -> f a m +. n = fmap (+ m) n --- | '+' variant with 'Applicative' at left and right.------ > fmap (== 5) (return 3 .+. return 2)--- > [3,4] .+. [2,3] == [5,6,6,7]--- > getZipList (ZipList [3,4] .+. ZipList [2,3]) == [5,7]+{- | '+' variant with 'Applicative' at left and right.++>>> fmap (== 5) (return 3 .+. return 2)+True++>>> [3,4] .+. [2,3]+[5,6,6,7]++>>> import Control.Applicative+>>> getZipList (ZipList [3,4] .+. ZipList [2,3])+[5,7]+-} (.+.) :: (Applicative m, Num a) => m a -> m a -> m a (.+.) = liftA2 (+) --- | '*' variant with 'Functor' at left.------ > fmap (== 6) (return 3 .* 2)+{- | '*' variant with 'Functor' at left.++>>> fmap (== 6) (return 3 .* 2)+True+-} (.*) :: (Functor f, Num a) => f a -> a -> f a m .* n = fmap (* n) m --- | '*' variant with 'Functor' at right.------ > fmap (== 6) (3 *. return 2)+{- | '*' variant with 'Functor' at right.++>>> fmap (== 6) (3 *. return 2)+True+-} (*.) :: (Functor f, Num a) => a -> f a -> f a m *. n = fmap (* m) n --- | '*' variant with 'Applicative' at left and right.------ > fmap (== 6) (return 3 .*. return 2)+{- | '*' variant with 'Applicative' at left and right.++>>> fmap (== 6) (return 3 .*. return 2)+True+-} (.*.) :: (Applicative m, Num a) => m a -> m a -> m a (.*.) = liftA2 (*) --- | '-' variant with 'Functor' at left.------ > fmap (== 1) (return 3 .- 2)--- > [3,4] .- 2 == [1,2]+{- | '-' variant with 'Functor' at left.++>>> fmap (== 1) (return 3 .- 2)+True++>>> [3,4] .- 2+[1,2]+-} (.-) :: (Functor f, Num a) => f a -> a -> f a m .- n = fmap (subtract n) m --- | '-' variant with 'Functor' at right.------ > fmap (== 1) (3 -. return 2)--- > 3 -. [2,3] == [1,0]+{- | '-' variant with 'Functor' at right.++>>> fmap (== 1) (3 -. return 2)+True++>>> 3 -. [2,3]+[1,0]+-} (-.) :: (Functor f, Num a) => a -> f a -> f a m -. n = fmap (m -) n --- | '-' variant with 'Applicative' at left and right.------ > fmap (== 1) (return 3 .-. return 2)--- > [3,4] .-. [2,3] == [1,0,2,1]--- > getZipList (ZipList [3,4] .-. ZipList [2,3]) == [1,1]+{- | '-' variant with 'Applicative' at left and right.++>>> fmap (== 1) (return 3 .-. return 2)+True++>>> [3,4] .-. [2,3]+[1,0,2,1]++>>> import Control.Applicative+>>> getZipList (ZipList [3,4] .-. ZipList [2,3])+[1,1]+-} (.-.) :: (Applicative m, Num a) => m a -> m a -> m a (.-.) = liftA2 (-) --- | '/' variant with 'Functor' at left.------ > fmap (== 3) (return 6 ./ 2)-(./) :: (Functor f,Fractional a) => f a -> a -> f a+{- | '/' variant with 'Functor' at left.++>>> fmap (== 3) (return 6 ./ 2)+True+-}+(./) :: (Functor f, Fractional a) => f a -> a -> f a m ./ n = fmap (/ n) m --- | '/' variant with 'Functor' at right.------ > fmap (== 3) (6 /. return 2)-(/.) :: (Functor f,Fractional a) => a -> f a -> f a+{- | '/' variant with 'Functor' at right.++>>> fmap (== 3) (6 /. return 2)+True+-}+(/.) :: (Functor f, Fractional a) => a -> f a -> f a m /. n = fmap (m /) n --- | '/' variant with 'Applicative' at left and right.------ > fmap (== 3) (return 6 ./. return 2)--- > [5,6] ./. [2,3] == [5/2,5/3,3,2]-(./.) :: (Applicative m,Fractional a) => m a -> m a -> m a+{- | '/' variant with 'Applicative' at left and right.++>>> fmap (== 3) (return 6 ./. return 2)+True++>>> [5,6] ./. [2,3] == [5/2,5/3,3,2]+True+-}+(./.) :: (Applicative m, Fractional a) => m a -> m a -> m a (./.) = liftA2 (/)

@@ -6,9 +6,10 @@ import Data.Word {- base -} import System.CPUTime {- base -} --- | Linear congruential generator given modulo function for type.------ See <http://en.wikipedia.org/wiki/Linear_congruential_generator> for possible parameters.+{- | Linear congruential generator given modulo function for type.++See <http://en.wikipedia.org/wiki/Linear_congruential_generator> for possible parameters.+-} lcg :: Num t => (t -> t) -> t -> t -> t -> t lcg modFunc a c x0 = modFunc (a * x0 + c) 

@@ -6,7 +6,7 @@  -- | Enumeration of operating rates of unit generators. data Rate = InitialisationRate | ControlRate | AudioRate | DemandRate-            deriving (Eq,Ord,Enum,Bounded,Show,Read)+  deriving (Eq, Ord, Enum, Bounded, Show, Read)  {- | Standard abbreviations of Rate values. ir = initialisation, kr = control, ar = audio, dr = demand.@@ -26,8 +26,9 @@ -} rateAbbrev :: Rate -> String rateAbbrev rt =-  fromMaybe (error "rateAbbrev?")-  (lookup (fromEnum rt) (zip [0..] (words "ir kr ar dr")))+  fromMaybe+    (error "rateAbbrev?")+    (lookup (fromEnum rt) (zip [0 ..] (words "ir kr ar dr")))  {- | Standard SuperCollider rate abbreviations. @@ -35,8 +36,9 @@ -} rateName :: Rate -> String rateName rt =-  fromMaybe (error "rateName?")-  (lookup (fromEnum rt) (zip [0..] (words "scalar control audio demand")))+  fromMaybe+    (error "rateName?")+    (lookup (fromEnum rt) (zip [0 ..] (words "scalar control audio demand")))  -- | Integer rate identifier, as required for scsynth bytecode. rateId :: Rate -> Int@@ -45,11 +47,11 @@ -- | Color identifiers for each 'Rate'. rate_color :: Rate -> String rate_color r =-    case r of-      AudioRate -> "black"-      ControlRate -> "blue"-      InitialisationRate -> "yellow"-      DemandRate -> "red"+  case r of+    AudioRate -> "black"+    ControlRate -> "blue"+    InitialisationRate -> "yellow"+    DemandRate -> "red"  -- | Set of all 'Rate' values. all_rates :: [Rate]@@ -61,12 +63,12 @@ -} rate_parse :: String -> Maybe Rate rate_parse r =-    case map toUpper r of-      "AR" -> Just AudioRate-      "KR" -> Just ControlRate-      "IR" -> Just InitialisationRate-      "DR" -> Just DemandRate-      _ -> Nothing+  case map toUpper r of+    "AR" -> Just AudioRate+    "KR" -> Just ControlRate+    "IR" -> Just InitialisationRate+    "DR" -> Just DemandRate+    _ -> Nothing  -- * Control rates @@ -74,17 +76,17 @@ I = initialisation, K = control, T = trigger, A = audio. -} data K_Type = K_InitialisationRate | K_ControlRate | K_TriggerRate | K_AudioRate-             deriving (Eq,Show,Ord)+  deriving (Eq, Show, Ord)  -- | Determine class of control given 'Rate' and /trigger/ status. ktype :: Rate -> Bool -> K_Type ktype r tr =-    if tr+  if tr     then case r of-           ControlRate -> K_TriggerRate-           _ -> error "ktype: non ControlRate trigger control"+      ControlRate -> K_TriggerRate+      _ -> error "ktype: non ControlRate trigger control"     else case r of-           InitialisationRate -> K_InitialisationRate-           ControlRate -> K_ControlRate-           AudioRate -> K_AudioRate-           DemandRate -> error "ktype: DemandRate control"+      InitialisationRate -> K_InitialisationRate+      ControlRate -> K_ControlRate+      AudioRate -> K_AudioRate+      DemandRate -> error "ktype: DemandRate control"

@@ -24,7 +24,6 @@     [r0] -> return (Just r0)     _ -> error "findFileFromDirectory: multiple files?" - {- | Find the file fn starting from dir. If dir/fn names a file return that file, else call findFileFromDirectory. Note this will not find dir/p/q/r given q/r, the query must be either p/q/r or r.@@ -44,7 +43,7 @@ findFileAtOrFromPath path fn =   case path of     [] -> return Nothing-    dir:path' -> do+    dir : path' -> do       m <- findFileAtOrFromDirectory dir fn       case m of         Just r -> return (Just r)@@ -79,7 +78,7 @@ sfResolveFile fn = do   m <- sfFindFile fn   case m of-    Nothing  -> error ("sfResolveFile: " ++ fn)+    Nothing -> error ("sfResolveFile: " ++ fn)     Just r -> return r  {- | Unsafe sfResolveFile.

@@ -1,4 +1,4 @@-{-# Language FlexibleInstances #-}+{-# LANGUAGE FlexibleInstances #-}  {- | Unique identifier types and classes. Used by non-deterministic (noise) and non-sharable (demand) unit generators.@@ -23,17 +23,17 @@  -- | A class indicating a monad (and functor and applicative) that will generate a sequence of unique integer identifiers. class (Functor m, Applicative m, Monad m) => Uid m where-   generateUid :: m Int+  generateUid :: m Int  -- | Requires FlexibleInstances. instance Uid (State.StateT Int Identity) where-    generateUid = State.get >>= \n -> State.put (n + 1) >> return n+  generateUid = State.get >>= \n -> State.put (n + 1) >> return n  instance Uid IO where-    generateUid = fmap Unique.hashUnique Unique.newUnique+  generateUid = fmap Unique.hashUnique Unique.newUnique  instance Uid m => Uid (Reader.ReaderT t m) where-   generateUid = Reader.ReaderT (const generateUid)+  generateUid = Reader.ReaderT (const generateUid)  -- * Uid_St @@ -52,11 +52,11 @@ uid_st_eval x = State.evalState x 0  -- | Thread state through sequence of 'State.runState'.-uid_st_seq :: [Uid_St t] -> ([t],Int)+uid_st_seq :: [Uid_St t] -> ([t], Int) uid_st_seq =-    let swap (p,q) = (q,p)-        step_f n x = swap (State.runState x n)-    in swap . mapAccumL step_f 0+  let swap (p, q) = (q, p)+      step_f n x = swap (State.runState x n)+  in swap . mapAccumL step_f 0  {- | 'fst' of 'uid_st_seq'. @@ -127,13 +127,13 @@ > map resolveID [('α', 'α', 'β'),('β', 'α', 'β')] == [0020082907, 2688286317] -} class Murmur32.Hashable32 a => ID a where-    resolveID :: a -> Id-    resolveID = fromIntegral . Murmur32.asWord32 . Murmur32.hash32+  resolveID :: a -> Id+  resolveID = fromIntegral . Murmur32.asWord32 . Murmur32.hash32 -instance ID Char where+instance ID Char instance ID Int where resolveID = id-instance (ID p,ID q) => ID (p,q) where-instance (ID p,ID q,ID r) => ID (p,q,r) where+instance (ID p, ID q) => ID (p, q)+instance (ID p, ID q, ID r) => ID (p, q, r)  {- | /n/ identifiers from /x/. 

@@ -1,5 +1,6 @@--- | Composite of "Sound.Sc3.Common", "Sound.Sc3.Server.Fd",---   "Sound.Sc3.Ugen" and "Sound.Sc3.Ugen.Bindings".+{- | Composite of "Sound.Sc3.Common", "Sound.Sc3.Server.Fd",+  "Sound.Sc3.Ugen" and "Sound.Sc3.Ugen.Bindings".+-} module Sound.Sc3.Fd (module M) where  import Sound.Sc3.Common as M

@@ -1,15 +1,16 @@--- | Collection of modules for communicating with the SuperCollider--- synthesis server, see also "Sound.Sc3.Server.FD" and--- "Sound.Sc3.Server.Monad".+{- | Collection of modules for communicating with the SuperCollider+synthesis server, see also "Sound.Sc3.Server.FD" and+"Sound.Sc3.Server.Monad".+-} module Sound.Sc3.Server (module S) where  import Sound.Sc3.Server.Command as S import Sound.Sc3.Server.Enum as S-import Sound.Sc3.Server.Synthdef as S-import Sound.Sc3.Server.Status as S import Sound.Sc3.Server.Nrt as S import Sound.Sc3.Server.Nrt.Edit as S import Sound.Sc3.Server.Nrt.Render as S import Sound.Sc3.Server.Param as S import Sound.Sc3.Server.Recorder as S import Sound.Sc3.Server.Scsynth as S+import Sound.Sc3.Server.Status as S+import Sound.Sc3.Server.Synthdef as S

@@ -1,5 +1,6 @@ -- | Collection of standard /command/ modules. module Sound.Sc3.Server.Command (module S) where +import Sound.Sc3.Server.Command.Completion as S import Sound.Sc3.Server.Command.Enum as S import Sound.Sc3.Server.Command.Plain as S

@@ -1,68 +1,26 @@--- | This module provides variations of the asynchronous server commands that--- expect a /completion packet/ as the first argument. The completion packet--- is executed by the server when the asynchronous command has finished. Note--- that this mechanism is for synchronizing server side processes only, for--- client side synchronization use @\/done@ message notification or the--- @\/sync@ barrier.+-- | Modify existing message to include completion message module Sound.Sc3.Server.Command.Completion where  import Sound.Osc.Core {- hosc -} -import Sound.Sc3.Server.Enum-import Sound.Sc3.Server.Synthdef---- | Encode an Osc packet as an Osc blob.-encode_blob :: Packet -> Datum-encode_blob = Blob . encodePacket---- | Install a bytecode instrument definition. (Asynchronous)-d_recv :: Packet -> Synthdef -> Message-d_recv pkt d = Message "/d_recv" [Blob (synthdefData d),encode_blob pkt]---- | Load an instrument definition from a named file. (Asynchronous)-d_load :: Packet -> String -> Message-d_load pkt p = Message "/d_load" [string p,encode_blob pkt]---- | Load a directory of instrument definitions files. (Asynchronous)-d_loadDir :: Packet -> String -> Message-d_loadDir pkt p = Message "/d_loadDir" [string p,encode_blob pkt]---- | Allocates zero filled buffer to number of channels and samples. (Asynchronous)-b_alloc :: Packet -> Int -> Int -> Int -> Message-b_alloc pkt nid frames channels = Message "/b_alloc" [int32 nid,int32 frames,int32 channels,encode_blob pkt]---- | Allocate buffer space and read a sound file. (Asynchronous)-b_allocRead :: Packet -> Int -> String -> Int -> Int -> Message-b_allocRead pkt nid p f n = Message "/b_allocRead" [int32 nid,string p,int32 f,int32 n,encode_blob pkt]---- | Allocate buffer space and read a sound file, picking specific channels. (Asynchronous)-b_allocReadChannel :: Packet -> Int -> String -> Int -> Int -> [Int] -> Message-b_allocReadChannel pkt nid p f n cs = Message "/b_allocReadChannel" ([int32 nid,string p,int32 f,int32 n] ++ map int32 cs ++ [encode_blob pkt])---- | Free buffer data. (Asynchronous)-b_free :: Packet -> Int -> Message-b_free pkt nid = Message "/b_free" [int32 nid,encode_blob pkt]---- | Close attached soundfile and write header information. (Asynchronous)-b_close :: Packet -> Int -> Message-b_close pkt nid = Message "/b_close" [int32 nid,encode_blob pkt]---- | Read sound file data into an existing buffer. (Asynchronous)-b_read :: Packet -> Int -> String -> Int -> Int -> Int -> Bool -> Message-b_read pkt nid p f n f' z = Message "/b_read" [int32 nid,string p,int32 f,int32 n,int32 f',int32 (fromEnum z),encode_blob pkt]---- | Read sound file data into an existing buffer. (Asynchronous)-b_readChannel :: Packet -> Int -> String -> Int -> Int -> Int -> Bool -> [Int] -> Message-b_readChannel pkt nid p f n f' z cs = Message "/b_readChannel" ([int32 nid,string p,int32 f,int32 n,int32 f',int32 (fromEnum z)] ++ map int32 cs ++ [encode_blob pkt])+import qualified Sound.Sc3.Server.Command.Enum as Server.Command.Enum {- hsc3 -} --- | Write sound file data. (Asynchronous)-b_write :: Packet -> Int -> String -> SoundFileFormat -> SampleFormat -> Int -> Int -> Bool -> Message-b_write pkt nid p h t f s z = Message "/b_write" [int32 nid,string p,string (soundFileFormatString h),string (sampleFormatString t),int32 f,int32 s,int32 (fromEnum z),encode_blob pkt]+-- | Add a completion packet to an existing asynchronous command.+with_completion_packet :: Message -> PacketOf Message -> Message+with_completion_packet (Message c xs) cm =+  if c `elem` Server.Command.Enum.async_cmds+    then+      let xs' = xs ++ [Blob (encodePacket cm)]+      in Message c xs'+    else error ("with_completion_packet: not async: " ++ c) --- | Zero sample data. (Asynchronous)-b_zero :: Packet -> Int -> Message-b_zero pkt nid = Message "/b_zero" [int32 nid,encode_blob pkt]+{- | Add a completion message to an existing asynchronous command. --- Local Variables:--- truncate-lines:t--- End:+>>> import Sound.Sc3.Server.Command.Plain+>>> let m = n_set1 0 "0" 0+>>> let e = encodeMessage m+>>> withCm (b_close 0) m == Message "/b_close" [Int32 0,Blob e]+True+-}+withCm :: Message -> Message -> Message+withCm m cm = with_completion_packet m (Packet_Message cm)

@@ -10,94 +10,96 @@ type SC3_Command = String  -- | Enumerate server command numbers.-sc3_cmd_enumeration :: [(SC3_Command,Int)]+sc3_cmd_enumeration :: [(SC3_Command, Int)] sc3_cmd_enumeration =-    [("/notify",1)-    ,("/status",2)-    ,("/quit",3)-    ,("/cmd",4)-    -- /d = synthdef-    ,("/d_recv",5)-    ,("/d_load",6)-    ,("/d_loadDir",7)-    ,("/d_freeAll",8)-    -- /s = synth-    ,("/s_new",9)-    -- /n = node-    ,("/n_trace",10)-    ,("/n_free",11)-    ,("/n_run",12)-    ,("/n_cmd",13)-    ,("/n_map",14)-    ,("/n_set",15)-    ,("/n_setn",16)-    ,("/n_fill",17)-    ,("/n_before",18)-    ,("/n_after",19)-    -- /u = ugen-    ,("/u_cmd",20)-    -- /g = group-    ,("/g_new",21)-    ,("/g_head",22)-    ,("/g_tail",23)-    ,("/g_freeAll",24)-    -- /c = control-    ,("/c_set",25)-    ,("/c_setn",26)-    ,("/c_fill",27)-    -- /b = buffer-    ,("/b_alloc",28)-    ,("/b_allocRead",29)-    ,("/b_read",30)-    ,("/b_write",31)-    ,("/b_free",32)-    ,("/b_close",33)-    ,("/b_zero",34)-    ,("/b_set",35)-    ,("/b_setn",36)-    ,("/b_fill",37)-    ,("/b_gen",38)-    ---    ,("/dumpOSC",39)-    -- _get-    ,("/c_get",40)-    ,("/c_getn",41)-    ,("/b_get",42)-    ,("/b_getn",43)-    ,("/s_get",44)-    ,("/s_getn",45)-    -- _query-    ,("/n_query",46)-    ,("/b_query",47)-    ---    ,("/n_mapn",48)-    ,("/s_noid",49)-    ---    ,("/g_deepFree",50)-    ,("/clearSched",51)-    ---    ,("/sync",52)-    ---    ,("/d_free",53)-    -- _channel-    ,("/b_allocReadChannel",54)-    ,("/b_readChannel",55)-    -- _tree-    ,("/g_dumpTree",56)-    ,("/g_queryTree",57)-    -- error-    ,("/error",58)-    -- _args-    ,("/s_newargs",59)-    ---    ,("/n_mapa",60)-    ,("/n_mapan",61)-    ,("/n_order",62)-    ]+  [ ("/notify", 1)+  , ("/status", 2)+  , ("/quit", 3)+  , ("/cmd", 4)+  , -- /d = synthdef+    ("/d_recv", 5)+  , ("/d_load", 6)+  , ("/d_loadDir", 7)+  , ("/d_freeAll", 8)+  , -- /s = synth+    ("/s_new", 9)+  , -- /n = node+    ("/n_trace", 10)+  , ("/n_free", 11)+  , ("/n_run", 12)+  , ("/n_cmd", 13)+  , ("/n_map", 14)+  , ("/n_set", 15)+  , ("/n_setn", 16)+  , ("/n_fill", 17)+  , ("/n_before", 18)+  , ("/n_after", 19)+  , -- /u = ugen+    ("/u_cmd", 20)+  , -- /g = group+    ("/g_new", 21)+  , ("/g_head", 22)+  , ("/g_tail", 23)+  , ("/g_freeAll", 24)+  , -- /c = control+    ("/c_set", 25)+  , ("/c_setn", 26)+  , ("/c_fill", 27)+  , -- /b = buffer+    ("/b_alloc", 28)+  , ("/b_allocRead", 29)+  , ("/b_read", 30)+  , ("/b_write", 31)+  , ("/b_free", 32)+  , ("/b_close", 33)+  , ("/b_zero", 34)+  , ("/b_set", 35)+  , ("/b_setn", 36)+  , ("/b_fill", 37)+  , ("/b_gen", 38)+  , --+    ("/dumpOSC", 39)+  , -- _get+    ("/c_get", 40)+  , ("/c_getn", 41)+  , ("/b_get", 42)+  , ("/b_getn", 43)+  , ("/s_get", 44)+  , ("/s_getn", 45)+  , -- _query+    ("/n_query", 46)+  , ("/b_query", 47)+  , --+    ("/n_mapn", 48)+  , ("/s_noid", 49)+  , --+    ("/g_deepFree", 50)+  , ("/clearSched", 51)+  , --+    ("/sync", 52)+  , --+    ("/d_free", 53)+  , -- _channel+    ("/b_allocReadChannel", 54)+  , ("/b_readChannel", 55)+  , -- _tree+    ("/g_dumpTree", 56)+  , ("/g_queryTree", 57)+  , -- error+    ("/error", 58)+  , -- _args+    ("/s_newargs", 59)+  , --+    ("/n_mapa", 60)+  , ("/n_mapan", 61)+  , ("/n_order", 62)+  ] --- | Lookup command number in 'sc3_cmd_enumeration'.------ > map sc3_cmd_number ["/b_alloc","/s_new"] == [Just 28,Just 9]+{- | Lookup command number in 'sc3_cmd_enumeration'.++>>> map sc3_cmd_number ["/b_alloc","/s_new"]+[Just 28,Just 9]+-} sc3_cmd_number :: SC3_Command -> Maybe Int sc3_cmd_number = flip lookup sc3_cmd_enumeration @@ -108,52 +110,56 @@ -- | List of asynchronous server commands, ie. commands that reply with @/done@. async_cmds :: [SC3_Command] async_cmds =-    ["/b_alloc"-    ,"/b_allocRead"-    ,"/b_allocReadChannel"-    ,"/b_close"-    ,"/b_free"-    ,"/b_read"-    ,"/b_readChannel"-    ,"/b_write"-    ,"/b_zero"-    ,"/d_load"-    ,"/d_loadDir"-    ,"/d_recv"-    ,"/notify"-    ,"/quit"-    ,"/sync"]+  [ "/b_alloc"+  , "/b_allocRead"+  , "/b_allocReadChannel"+  , "/b_close"+  , "/b_free"+  , "/b_read"+  , "/b_readChannel"+  , "/b_write"+  , "/b_zero"+  , "/d_load"+  , "/d_loadDir"+  , "/d_recv"+  , "/notify"+  , "/quit"+  , "/sync"+  ] --- | 'True' if 'Message' is an asynchronous 'Message'.------ > import Sound.Sc3--- > map isAsync [b_close 0,n_set1 0 "0" 0,status] == [True,False,False]+{- | 'True' if 'Message' is an asynchronous 'Message'.++> import Sound.Sc3.Server.Command.Plain+> map isAsync [b_close 0,n_set1 0 "0" 0,status] == [True,False,False]+-} isAsync :: Osc.Message -> Bool isAsync (Osc.Message a _) = a `elem` async_cmds --- | Asynchronous commands are at the left.  This function should--- preserve the ordering of both branches.------ > partition_async [b_close 0,n_set1 0 "0" 0]-partition_async :: [Osc.Message] -> ([Osc.Message],[Osc.Message])+{- | Asynchronous commands are at the left.+This function should preserve the ordering of both branches.++> partition_async [b_close 0,n_set1 0 "0" 0]+-}+partition_async :: [Osc.Message] -> ([Osc.Message], [Osc.Message]) partition_async = partition isAsync  -- | Types & names for @b_info@ message fields.-b_info_fields :: [(String,String)]+b_info_fields :: [(String, String)] b_info_fields =-    [("int","buffer-id")-    ,("int","frame-count")-    ,("int","channels-count")-    ,("float","sample-rate")]+  [ ("int", "buffer-id")+  , ("int", "frame-count")+  , ("int", "channels-count")+  , ("float", "sample-rate")+  ]  -- | Type, name and value descriptors for fields of @n_info@ message.-n_info_fields :: [(String,String,String)]+n_info_fields :: [(String, String, String)] n_info_fields =-    [("int","node-id","")-    ,("int","parent group-id","-1 = nil")-    ,("int","previous node-id","-1 = nil")-    ,("int","next node-id","-1 = nil")-    ,("int","node-type","0 = synth,1 = group")-    ,("int","head node-id","-1 = nil")-    ,("int","tail node-id","-1 = nil")]-+  [ ("int", "node-id", "")+  , ("int", "parent group-id", "-1 = nil")+  , ("int", "previous node-id", "-1 = nil")+  , ("int", "next node-id", "-1 = nil")+  , ("int", "node-type", "0 = synth,1 = group")+  , ("int", "head node-id", "-1 = nil")+  , ("int", "tail node-id", "-1 = nil")+  ]

@@ -7,7 +7,7 @@ import Sound.Osc.Core {- hosc -}  import qualified Sound.Sc3.Common.Base as Common.Base-import qualified Sound.Sc3.Server.Command.Enum as Server.Command.Enum+import qualified Sound.Sc3.Server.Command.Completion as Server.Command.Completion import qualified Sound.Sc3.Server.Enum as Server.Enum import qualified Sound.Sc3.Server.Graphdef as Server.Graphdef import qualified Sound.Sc3.Server.Graphdef.Binary as Server.Graphdef@@ -18,40 +18,56 @@  -- * Buffer commands (b_) --- | BUF-NUM must be >= 0+-- | Buf-Num must be >= 0 b_bufnum :: Integral t => t -> Datum b_bufnum = int32 . cmd_check_arg "buffer-number < 0?" (>= 0) --- | BUF-FRAME-IX must be >= 0+-- | Buf-Frame-Ix must be >= 0 b_ix :: Integral t => t -> Datum b_ix = int32 . cmd_check_arg "buffer-ix < 0?" (>= 0) --- | BUF-CHANNEL must be >= 0+-- | Buf-Channel must be >= 0 b_ch :: Integral t => t -> Datum b_ch = int32 . cmd_check_arg "buffer-channel < 0?" (>= 0) --- | BUF-FRAME-CNT must be >= 0+-- | Buf-Frame-Cnt must be >= 0 b_size :: Integral t => t -> Datum b_size = int32 . cmd_check_arg "buffer-size < 0?" (>= 0)  -- | Allocates zero filled buffer to number of channels and samples. (Asynchronous) b_alloc :: Integral i => i -> i -> i -> Message-b_alloc b frames channels = message "/b_alloc" [b_bufnum b,b_size frames,int32 channels]+b_alloc b frames channels = message "/b_alloc" [b_bufnum b, b_size frames, int32 channels]  -- | Allocate buffer space and read a sound file. (Asynchronous) b_allocRead :: Integral i => i -> String -> i -> i -> Message-b_allocRead b p f n = message "/b_allocRead" [b_bufnum b,string p,b_ix f,b_ix n]+b_allocRead bufferNumber fileName startFrame frameCount =+  message+    "/b_allocRead"+    [ b_bufnum bufferNumber+    , string fileName+    , b_ix startFrame+    , b_ix frameCount+    ]  -- | Allocate buffer space and read a sound file, picking specific channels. (Asynchronous) b_allocReadChannel :: Integral i => i -> String -> i -> i -> [i] -> Message-b_allocReadChannel b p f n cs = message "/b_allocReadChannel" ([b_bufnum b,string p,b_ix f,b_ix n] ++ map b_ch cs)+b_allocReadChannel bufferNumber fileName startFrame frameCount channels =+  message+    "/b_allocReadChannel"+    ( [ b_bufnum bufferNumber+      , string fileName+      , b_ix startFrame+      , b_ix frameCount+      ]+        ++ map b_ch channels+    )  -- | Close attached soundfile and write header information. (Asynchronous) b_close :: Integral i => i -> Message b_close b = message "/b_close" [b_bufnum b]  -- | Fill ranges of sample values.-b_fill :: (Integral i,Real n) => i -> [(i,i,n)] -> Message+b_fill :: (Integral i, Real n) => i -> [(i, i, n)] -> Message b_fill b l = message "/b_fill" (b_bufnum b : Common.Base.mk_triples int32 int32 float l)  -- | Free buffer data. (Asynchronous)@@ -63,33 +79,33 @@ b_gen b name arg = message "/b_gen" (b_bufnum b : string name : arg)  -- | Call @sine1@ 'b_gen' command.-b_gen_sine1 :: (Integral i,Real n) => i -> [Server.Enum.B_Gen] -> [n] -> Message+b_gen_sine1 :: (Integral i, Real n) => i -> [Server.Enum.B_Gen] -> [n] -> Message b_gen_sine1 z f n = b_gen z "sine1" (int32 (Server.Enum.b_gen_flag f) : map float n)  -- | Call @sine2@ 'b_gen' command.-b_gen_sine2 :: (Integral i,Real n) => i -> [Server.Enum.B_Gen] -> [(n,n)] -> Message+b_gen_sine2 :: (Integral i, Real n) => i -> [Server.Enum.B_Gen] -> [(n, n)] -> Message b_gen_sine2 z f n = b_gen z "sine2" (int32 (Server.Enum.b_gen_flag f) : Common.Base.mk_duples float float n)  -- | Call @sine3@ 'b_gen' command.-b_gen_sine3 :: (Integral i,Real n) => i -> [Server.Enum.B_Gen] -> [(n,n,n)] -> Message+b_gen_sine3 :: (Integral i, Real n) => i -> [Server.Enum.B_Gen] -> [(n, n, n)] -> Message b_gen_sine3 z f n = b_gen z "sine3" (int32 (Server.Enum.b_gen_flag f) : Common.Base.mk_triples float float float n)  -- | Call @cheby@ 'b_gen' command.-b_gen_cheby :: (Integral i,Real n) => i -> [Server.Enum.B_Gen] -> [n] -> Message+b_gen_cheby :: (Integral i, Real n) => i -> [Server.Enum.B_Gen] -> [n] -> Message b_gen_cheby z f n = b_gen z "cheby" (int32 (Server.Enum.b_gen_flag f) : map float n)  -- | Call @copy@ 'b_gen' command. b_gen_copy :: Integral i => i -> i -> i -> i -> Maybe i -> Message b_gen_copy dst_b dst_ix src_b src_ix nf =-    let nf' = fromMaybe (-1) nf-    in b_gen dst_b "copy" (map int32 [dst_ix,src_b,src_ix,nf'])+  let nf' = fromMaybe (-1) nf+  in b_gen dst_b "copy" (map int32 [dst_ix, src_b, src_ix, nf'])  -- | Get sample values. b_get :: Integral i => i -> [i] -> Message b_get b i = message "/b_get" (b_bufnum b : map int32 i)  -- | Get ranges of sample values.-b_getn :: Integral i => i -> [(i,i)] -> Message+b_getn :: Integral i => i -> [(i, i)] -> Message b_getn b l = message "/b_getn" (b_bufnum b : Common.Base.mk_duples b_ix b_size l)  -- | Request \/b_info messages.@@ -101,28 +117,28 @@ -} b_read :: Integral i => i -> String -> i -> i -> i -> Bool -> Message b_read bufId pathName startFrame numFrames bufFrame leaveOpen =-  message "/b_read" [b_bufnum bufId,string pathName,int32 startFrame,int32 numFrames,int32 bufFrame,int32 (fromEnum leaveOpen)]+  message "/b_read" [b_bufnum bufId, string pathName, int32 startFrame, int32 numFrames, int32 bufFrame, int32 (fromEnum leaveOpen)]  -- | Read sound file data into an existing buffer, picking specific channels. (Asynchronous) b_readChannel :: Integral i => i -> String -> i -> i -> i -> Bool -> [i] -> Message-b_readChannel b p f n f' z cs = message "/b_readChannel" ([b_bufnum b,string p,int32 f,int32 n,int32 f',int32 (fromEnum z)] ++ map int32 cs)+b_readChannel b p f n f' z cs = message "/b_readChannel" ([b_bufnum b, string p, int32 f, int32 n, int32 f', int32 (fromEnum z)] ++ map int32 cs)  -- | Set sample values.-b_set :: (Integral i,Real n) => i -> [(i,n)] -> Message+b_set :: (Integral i, Real n) => i -> [(i, n)] -> Message b_set b l = message "/b_set" (b_bufnum b : Common.Base.mk_duples int32 float l)  -- | Set ranges of sample values.-b_setn :: (Integral i,Real n) => i -> [(i,[n])] -> Message+b_setn :: (Integral i, Real n) => i -> [(i, [n])] -> Message b_setn b l =-    let f (i,d) = int32 i : int32 (length d) : map float d-    in message "/b_setn" (b_bufnum b : concatMap f l)+  let f (i, d) = int32 i : int32 (length d) : map float d+  in message "/b_setn" (b_bufnum b : concatMap f l)  -- | Write sound file data. (Asynchronous) b_write :: Integral i => i -> String -> Server.Enum.SoundFileFormat -> Server.Enum.SampleFormat -> i -> i -> Bool -> Message b_write b p h t f s z =-    let h' = string (Server.Enum.soundFileFormatString h)-        t' = string (Server.Enum.sampleFormatString t)-    in message "/b_write" [b_bufnum b,string p,h',t',int32 f,int32 s,int32 (fromEnum z)]+  let h' = string (Server.Enum.soundFileFormatString h)+      t' = string (Server.Enum.sampleFormatString t)+  in message "/b_write" [b_bufnum b, string p, h', t', int32 f, int32 s, int32 (fromEnum z)]  -- | Zero sample data. (Asynchronous) b_zero :: Integral i => i -> Message@@ -131,7 +147,7 @@ -- * Control bus commands (c_)  -- |  Fill ranges of bus values.-c_fill :: (Integral i,Real n) => [(i,i,n)] -> Message+c_fill :: (Integral i, Real n) => [(i, i, n)] -> Message c_fill = message "/c_fill" . Common.Base.mk_triples int32 int32 float  -- | Get bus values.@@ -139,18 +155,18 @@ c_get = message "/c_get" . map int32  -- | Get ranges of bus values.-c_getn :: Integral i => [(i,i)] -> Message+c_getn :: Integral i => [(i, i)] -> Message c_getn = message "/c_getn" . Common.Base.mk_duples int32 int32  -- | Set bus values.-c_set :: (Integral i,Real n) => [(i,n)] -> Message+c_set :: (Integral i, Real n) => [(i, n)] -> Message c_set = message "/c_set" . Common.Base.mk_duples int32 float  -- | Set ranges of bus values.-c_setn :: (Integral i,Real n) => [(i,[n])] -> Message+c_setn :: (Integral i, Real n) => [(i, [n])] -> Message c_setn l =-    let f (i,d) = int32 i : int32 (length d) : map float d-    in message "/c_setn" (concatMap f l)+  let f (i, d) = int32 i : int32 (length d) : map float d+  in message "/c_setn" (concatMap f l)  -- * Instrument definition commands (d_) @@ -189,85 +205,88 @@ g_freeAll = message "/g_freeAll" . map int32  -- | Add node to head of group.-g_head :: Integral i => [(i,i)] -> Message+g_head :: Integral i => [(i, i)] -> Message g_head = message "/g_head" . Common.Base.mk_duples int32 int32  -- | Create a new group.-g_new :: Integral i => [(i,Server.Enum.AddAction,i)] -> Message+g_new :: Integral i => [(i, Server.Enum.AddAction, i)] -> Message g_new = message "/g_new" . Common.Base.mk_triples int32 (int32 . fromEnum) int32  -- | Add node to tail of group.-g_tail :: Integral i => [(i,i)] -> Message+g_tail :: Integral i => [(i, i)] -> Message g_tail = message "/g_tail" . Common.Base.mk_duples int32 int32  -- | Post a representation of a group's node subtree, optionally including the current control values for synths.-g_dumpTree :: Integral i => [(i,Bool)] -> Message+g_dumpTree :: Integral i => [(i, Bool)] -> Message g_dumpTree = message "/g_dumpTree" . Common.Base.mk_duples int32 (int32 . fromEnum) --- | Request a representation of a group's node subtree, optionally including the current control values for synths.------ Replies to the sender with a @/g_queryTree.reply@ message listing all of the nodes contained within the group in the following format:------ > int32 - if synth control values are included 1, else 0--- > int32 - node ID of the requested group--- > int32 - number of child nodes contained within the requested group--- >--- > For each node in the subtree:--- > [--- >   int32 - node ID--- >   int32 - number of child nodes contained within this node. If -1 this is a synth, if >= 0 it's a group.--- >--- >   If this node is a synth:--- >     symbol - the SynthDef name for this node.--- >--- >   If flag (see above) is true:--- >     int32 - numControls for this synth (M)--- >     [--- >       symbol or int: control name or index--- >       float or symbol: value or control bus mapping symbol (e.g. 'c1')--- >     ] * M--- > ] * the number of nodes in the subtree------ N.Common.Base. The order of nodes corresponds to their execution order on the server. Thus child nodes (those contained within a group) are listed immediately following their parent.-g_queryTree :: Integral i => [(i,Bool)] -> Message+{- | Request a representation of a group's node subtree, optionally including the current control values for synths.++Replies to the sender with a @/g_queryTree.reply@ message listing all of the nodes contained within the group in the following format:++@+int32 - if synth control values are included 1, else 0+int32 - node ID of the requested group+int32 - number of child nodes contained within the requested group++For each node in the subtree:+[+  int32 - node ID+  int32 - number of child nodes contained within this node. If -1 this is a synth, if >= 0 it's a group.++  If this node is a synth:+    symbol - the SynthDef name for this node.++  If flag (see above) is true:+    int32 - numControls for this synth (M)+    [+      symbol or int: control name or index+      float or symbol: value or control bus mapping symbol (e.g. 'c1')+    ] * M+] * the number of nodes in the subtree+@+N.b. The order of nodes corresponds to their execution order on the server. Thus child nodes (those contained within a group) are listed immediately following their parent.+-}+g_queryTree :: Integral i => [(i, Bool)] -> Message g_queryTree = message "/g_queryTree" . Common.Base.mk_duples int32 (int32 . fromEnum)  -- * Node commands (n_) --- | NODE-ID must be >= -1+-- | Node-Id must be >= -1 n_id :: Integral t => t -> Datum n_id = int32 . cmd_check_arg "node-id < -1?" (>= (-1))  -- | Place a node after another.-n_after :: Integral i => [(i,i)] -> Message+n_after :: Integral i => [(i, i)] -> Message n_after = message "/n_after" . Common.Base.mk_duples n_id n_id  -- | Place a node before another.-n_before :: Integral i => [(i,i)] -> Message+n_before :: Integral i => [(i, i)] -> Message n_before = message "/n_before" . Common.Base.mk_duples int32 int32  -- | Fill ranges of a node's control values.-n_fill :: (Integral i,Real f) => i -> [(String,i,f)] -> Message+n_fill :: (Integral i, Real f) => i -> [(String, i, f)] -> Message n_fill n l = message "/n_fill" (n_id n : Common.Base.mk_triples string int32 float l)  -- | Delete a node. n_free :: Integral i => [i] -> Message n_free = message "/n_free" . map n_id -n_map :: Integral i => i -> [(String,i)] -> Message+n_map :: Integral i => i -> [(String, i)] -> Message n_map n l = message "/n_map" (n_id n : Common.Base.mk_duples string int32 l) --- | Map a node's controls to read from buses.---   n_mapn only works if the control is given as an index and not as a name (3.8.0).-n_mapn :: Integral i => i -> [(i,i,i)] -> Message+{- | Map a node's controls to read from buses.+  n_mapn only works if the control is given as an index and not as a name (3.8.0).+-}+n_mapn :: Integral i => i -> [(i, i, i)] -> Message n_mapn n l = message "/n_mapn" (n_id n : Common.Base.mk_triples int32 int32 int32 l)  -- | Map a node's controls to read from an audio bus.-n_mapa :: Integral i => i -> [(String,i)] -> Message+n_mapa :: Integral i => i -> [(String, i)] -> Message n_mapa n l = message "/n_mapa" (n_id n : Common.Base.mk_duples string int32 l)  -- | Map a node's controls to read from audio buses.-n_mapan :: Integral i => i -> [(String,i,i)] -> Message+n_mapan :: Integral i => i -> [(String, i, i)] -> Message n_mapan n l = message "/n_mapan" (n_id n : Common.Base.mk_triples string int32 int32 l)  -- | Get info about a node.@@ -275,19 +294,20 @@ n_query = message "/n_query" . map n_id  -- | Turn node on or off.-n_run :: Integral i => [(i,Bool)] -> Message+n_run :: Integral i => [(i, Bool)] -> Message n_run = message "/n_run" . Common.Base.mk_duples n_id (int32 . fromEnum)  -- | Set a node's control values.-n_set :: (Integral i,Real n) => i -> [(String,n)] -> Message+n_set :: (Integral i, Real n) => i -> [(String, n)] -> Message n_set n c = message "/n_set" (n_id n : Common.Base.mk_duples string float c) --- | Set ranges of a node's control values.--- n_mapn and n_setn only work if the control is given as an index and not as a name.-n_setn :: (Integral i,Real n) => i -> [(i,[n])] -> Message+{- | Set ranges of a node's control values.+n_mapn and n_setn only work if the control is given as an index and not as a name.+-}+n_setn :: (Integral i, Real n) => i -> [(i, [n])] -> Message n_setn n l =-    let f (s,d) = int32 s : int32 (length d) : map float d-    in message "/n_setn" (n_id n : concatMap f l)+  let f (s, d) = int32 s : int32 (length d) : map float d+  in message "/n_setn" (n_id n : concatMap f l)  -- | Trace a node. n_trace :: Integral i => [i] -> Message@@ -300,7 +320,7 @@ -- * Par commands (p_)  -- | Create a new parallel group (supernova specific).-p_new :: Integral i => [(i,Server.Enum.AddAction,i)] -> Message+p_new :: Integral i => [(i, Server.Enum.AddAction, i)] -> Message p_new = message "/p_new" . Common.Base.mk_triples int32 (int32 . fromEnum) int32  -- * Synthesis node commands (s_)@@ -310,12 +330,20 @@ s_get n i = message "/s_get" (n_id n : map string i)  -- | Get ranges of control values.-s_getn :: Integral i => i -> [(String,i)] -> Message+s_getn :: Integral i => i -> [(String, i)] -> Message s_getn n l = message "/s_getn" (n_id n : Common.Base.mk_duples string int32 l)  -- | Create a new synth.-s_new :: (Integral i,Real n) => String -> i -> Server.Enum.AddAction -> i -> [(String,n)] -> Message-s_new n i a t c = message "/s_new" (string n : int32 i : int32 (fromEnum a) : int32 t : Common.Base.mk_duples string float c)+s_new :: (Integral i, Real n) => String -> i -> Server.Enum.AddAction -> i -> [(String, n)] -> Message+s_new synthdefName nodeId addAction targetId controlValues =+  message+    "/s_new"+    ( string synthdefName+        : int32 nodeId+        : int32 (fromEnum addAction)+        : int32 targetId+        : Common.Base.mk_duples string float controlValues+    )  -- | Auto-reassign synth's ID to a reserved value. s_noid :: Integral i => [i] -> Message@@ -325,7 +353,7 @@  -- | Send a command to a unit generator. u_cmd :: Integral i => i -> i -> String -> [Datum] -> Message-u_cmd n uid name arg = message "/u_cmd" ([n_id n,int32 uid,string name] ++ arg)+u_cmd n uid name arg = message "/u_cmd" ([n_id n, int32 uid, string name] ++ arg)  -- * Server operation commands @@ -344,10 +372,10 @@ -- | Set error posting scope and mode. errorMode :: Server.Enum.ErrorScope -> Server.Enum.ErrorMode -> Message errorMode scope mode =-    let e = case scope of-              Server.Enum.Globally -> fromEnum mode-              Server.Enum.Locally  -> -1 - fromEnum mode-    in message "/error" [int32 e]+  let e = case scope of+        Server.Enum.Globally -> fromEnum mode+        Server.Enum.Locally -> -1 - fromEnum mode+  in message "/error" [int32 e]  -- | Select reception of notification messages. (Asynchronous) notify :: Bool -> Message@@ -369,35 +397,17 @@ sync :: Integral i => i -> Message sync sid = message "/sync" [int32 sid] --- * Modify existing message to include completion message---- | Add a completion packet to an existing asynchronous command.-with_completion_packet :: Message -> Packet -> Message-with_completion_packet (Message c xs) cm =-    if c `elem` Server.Command.Enum.async_cmds-    then let xs' = xs ++ [Blob (encodePacket cm)]-         in Message c xs'-    else error ("with_completion_packet: not async: " ++ c)---- | Add a completion message to an existing asynchronous command.------ > let m = n_set1 0 "0" 0--- > let e = encodeMessage m--- > withCM (b_close 0) m == Message "/b_close" [Int32 0,Blob e]-withCM :: Message -> Message -> Message-withCM m cm = with_completion_packet m (Packet_Message cm)- -- * Variants to simplify common cases  -- | Pre-allocate for b_setn1, values preceding offset are zeroed.-b_alloc_setn1 :: (Integral i,Real n) => i -> i -> [n] -> Message+b_alloc_setn1 :: (Integral i, Real n) => i -> i -> [n] -> Message b_alloc_setn1 b i xs =-    let k = i + genericLength xs-        xs' = genericReplicate i 0 ++ xs-    in withCM (b_alloc b k 1) (b_setn1 b 0 xs')+  let k = i + genericLength xs+      xs' = genericReplicate i 0 ++ xs+  in Server.Command.Completion.withCm (b_alloc b k 1) (b_setn1 b 0 xs')  -- | Get ranges of sample values.-b_getn1 :: Integral i => i -> (i,i) -> Message+b_getn1 :: Integral i => i -> (i, i) -> Message b_getn1 b = b_getn b . return  -- | Variant on 'b_query'.@@ -405,66 +415,73 @@ b_query1 = b_query . return  -- | Set single sample value.-b_set1 :: (Integral i,Real n) => i -> i -> n -> Message-b_set1 b i x = b_set b [(i,x)]+b_set1 :: (Integral i, Real n) => i -> i -> n -> Message+b_set1 b i x = b_set b [(i, x)]  -- | Set a range of sample values.-b_setn1 :: (Integral i,Real n) => i -> i -> [n] -> Message-b_setn1 b i xs = b_setn b [(i,xs)]+b_setn1 :: (Integral i, Real n) => i -> i -> [n] -> Message+b_setn1 b i xs = b_setn b [(i, xs)]  -- | Segmented variant of 'b_setn1'.-b_setn1_segmented :: (Integral i,Real n) => i -> i -> i -> [n] -> [Message]+b_setn1_segmented :: (Integral i, Real n) => i -> i -> i -> [n] -> [Message] b_setn1_segmented k b i d =-    if genericLength d < k+  if genericLength d < k     then [b_setn1 b i d]     else b_setn1 b i (genericTake k d) : b_setn1_segmented k b (i + k) (genericDrop k d)  -- | Get ranges of sample values.-c_getn1 :: Integral i => (i,i) -> Message+c_getn1 :: Integral i => (i, i) -> Message c_getn1 = c_getn . return  -- | Set single bus values.-c_set1 :: (Integral i,Real n) => i -> n -> Message-c_set1 i x = c_set [(i,x)]+c_set1 :: (Integral i, Real n) => i -> n -> Message+c_set1 i x = c_set [(i, x)]  -- | Set single range of bus values.-c_setn1 :: (Integral i,Real n) => (i,[n]) -> Message+c_setn1 :: (Integral i, Real n) => (i, [n]) -> Message c_setn1 = c_setn . return  -- | Turn a single node on or off. n_run1 :: Integral i => i -> Bool -> Message-n_run1 n k = n_run [(n,k)]+n_run1 n k = n_run [(n, k)]  -- | Set a single node control value.-n_set1 :: (Integral i,Real n) => i -> String -> n -> Message-n_set1 n k v = n_set n [(k,v)]+n_set1 :: (Integral i, Real n) => i -> String -> n -> Message+n_set1 n k v = n_set n [(k, v)]  -- | @s_new@ with no parameters. s_new0 :: Integral i => String -> i -> Server.Enum.AddAction -> i -> Message-s_new0 n i a t = s_new n i a t ([]::[(String,Double)])+s_new0 n i a t = s_new n i a t ([] :: [(String, Double)])  -- * Buffer segmentation and indices --- | Segment a request for /m/ places into sets of at most /n/.------ > b_segment 1024 2056 == [8,1024,1024]--- > b_segment 1 5 == replicate 5 1+{- | Segment a request for /m/ places into sets of at most /n/.++>>> b_segment 1024 2056+[8,1024,1024]++>>> b_segment 1 5 == replicate 5 1+True+-} b_segment :: Integral i => i -> i -> [i] b_segment n m =-    let (q,r) = m `quotRem` n-        s = genericReplicate q n-    in if r == 0 then s else r : s+  let (q, r) = m `quotRem` n+      s = genericReplicate q n+  in if r == 0 then s else r : s --- | Variant of 'b_segment' that takes a starting index and returns--- /(index,size)/ duples.------ > b_indices 1 5 0 == zip [0..4] (replicate 5 1)--- > b_indices 1024 2056 16 == [(16,8),(24,1024),(1048,1024)]-b_indices :: Integral i => i -> i -> i -> [(i,i)]+{- | Variant of 'b_segment' that takes a starting index and returns /(index,size)/ duples.++>>> b_indices 1 5 0 == zip [0..4] (replicate 5 1)+True++>>> b_indices 1024 2056 16+[(16,8),(24,1024),(1048,1024)]+-}+b_indices :: Integral i => i -> i -> i -> [(i, i)] b_indices n m k =-    let s = b_segment n m-        i = 0 : Common.Base.dx_d s-    in zip (map (+ k) i) s+  let s = b_segment n m+      i = 0 : Common.Base.dx_d s+  in zip (map (+ k) i) s  -- * Ugen commands. @@ -477,65 +494,65 @@ -- | Result is null for non-conforming data, or has five or seven elements. unpack_n_info_datum_plain :: Num i => [Datum] -> [i] unpack_n_info_datum_plain m =-    let to_i = fromIntegral-    in case m of-         [Int32 i1,Int32 i2,Int32 i3,Int32 i4,Int32 i5] -> [to_i i1,to_i i2,to_i i3,to_i i4,to_i i5]-         [Int32 i1,Int32 i2,Int32 i3,Int32 i4,Int32 i5,Int32 i6,Int32 i7] -> [to_i i1,to_i i2,to_i i3,to_i i4,to_i i5,to_i i6,to_i i7]-         _ -> []+  let to_i = fromIntegral+  in case m of+      [Int32 i1, Int32 i2, Int32 i3, Int32 i4, Int32 i5] -> [to_i i1, to_i i2, to_i i3, to_i i4, to_i i5]+      [Int32 i1, Int32 i2, Int32 i3, Int32 i4, Int32 i5, Int32 i6, Int32 i7] -> [to_i i1, to_i i2, to_i i3, to_i i4, to_i i5, to_i i6, to_i i7]+      _ -> []  unpack_n_info_plain :: Num i => Message -> [i] unpack_n_info_plain m =-    case m of-      Message "/n_info" dat -> unpack_n_info_datum_plain dat-      _ -> []+  case m of+    Message "/n_info" dat -> unpack_n_info_datum_plain dat+    _ -> []  -- | Unpack @n_info@ message.-unpack_n_info :: Num i => Message -> Maybe (i,i,i,i,i,Maybe (i,i))+unpack_n_info :: Num i => Message -> Maybe (i, i, i, i, i, Maybe (i, i)) unpack_n_info m =-    case unpack_n_info_plain m of-      [i1,i2,i3,i4,i5] -> Just (i1,i2,i3,i4,i5,Nothing)-      [i1,i2,i3,i4,i5,i6,i7] -> Just (i1,i2,i3,i4,i5,Just (i6,i7))-      _ -> Nothing+  case unpack_n_info_plain m of+    [i1, i2, i3, i4, i5] -> Just (i1, i2, i3, i4, i5, Nothing)+    [i1, i2, i3, i4, i5, i6, i7] -> Just (i1, i2, i3, i4, i5, Just (i6, i7))+    _ -> Nothing -unpack_n_info_err :: Num i => Message -> (i,i,i,i,i,Maybe (i,i))+unpack_n_info_err :: Num i => Message -> (i, i, i, i, i, Maybe (i, i)) unpack_n_info_err = fromMaybe (error "unpack_n_info") . unpack_n_info  -- | Unpack the '/tr' messages sent by 'sendTrig'.-unpack_tr :: (Num i,Fractional f) => Message -> Maybe (i,i,f)+unpack_tr :: (Num i, Fractional f) => Message -> Maybe (i, i, f) unpack_tr m =-    let to_i = fromIntegral-        to_f = realToFrac-    in case m of-         Message "/tr" [Int32 p,Int32 q,Float r] -> Just (to_i p,to_i q,to_f r)-         _ -> Nothing+  let to_i = fromIntegral+      to_f = realToFrac+  in case m of+      Message "/tr" [Int32 p, Int32 q, Float r] -> Just (to_i p, to_i q, to_f r)+      _ -> Nothing -unpack_tr_err :: (Num i,Fractional f) => Message -> (i,i,f)+unpack_tr_err :: (Num i, Fractional f) => Message -> (i, i, f) unpack_tr_err = fromMaybe (error "unpack_tr") . unpack_tr -unpack_b_setn :: (Num i,Fractional f) => Message -> Maybe (i,i,i,[f])+unpack_b_setn :: (Num i, Fractional f) => Message -> Maybe (i, i, i, [f]) unpack_b_setn m =-    let to_i = fromIntegral-        to_f d = case d of-                    Float n -> realToFrac n-                    _ -> error "unpack_b_setn: non-float data"-    in case m of-         Message "/b_setn" (Int32 p:Int32 q:Int32 r:z) -> Just (to_i p,to_i q,to_i r,map to_f z)-         _ -> Nothing+  let to_i = fromIntegral+      to_f d = case d of+        Float n -> realToFrac n+        _ -> error "unpack_b_setn: non-float data"+  in case m of+      Message "/b_setn" (Int32 p : Int32 q : Int32 r : z) -> Just (to_i p, to_i q, to_i r, map to_f z)+      _ -> Nothing -unpack_b_setn_err :: (Num i,Fractional f) => Message -> (i,i,i,[f])+unpack_b_setn_err :: (Num i, Fractional f) => Message -> (i, i, i, [f]) unpack_b_setn_err = fromMaybe (error "unpack_b_setn") . unpack_b_setn  -- | Unpack b_info message, fields are (id,frames,channels,sample-rate).-unpack_b_info :: (Num i,Fractional f) => Message -> Maybe (i,i,i,f)+unpack_b_info :: (Num i, Fractional f) => Message -> Maybe (i, i, i, f) unpack_b_info m =-    let to_i = fromIntegral-        to_f = realToFrac-    in case m of-         Message "/b_info" [Int32 p,Int32 q,Int32 r,Float s] -> Just (to_i p,to_i q,to_i r,to_f s)-         _ -> Nothing+  let to_i = fromIntegral+      to_f = realToFrac+  in case m of+      Message "/b_info" [Int32 p, Int32 q, Int32 r, Float s] -> Just (to_i p, to_i q, to_i r, to_f s)+      _ -> Nothing  -- | Variant generating 'error'.-unpack_b_info_err :: (Num i,Fractional f) => Message -> (i,i,i,f)+unpack_b_info_err :: (Num i, Fractional f) => Message -> (i, i, i, f) unpack_b_info_err = fromMaybe (error "unpack_b_info") . unpack_b_info  -- Local Variables: