summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAntonKholomiov <>2017-03-22 18:18:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-03-22 18:18:00 (GMT)
commit0470a5ba9ed182f74c94eaf27b4283cdc61924a3 (patch)
treea4e533d0397626b1fb5d53ff68ef80f07e109ce6
parent758f76314f0c34ed2630ddef162476285eef86ca (diff)
version 0.2.0.00.2.0.0
-rw-r--r--csound-expression-typed.cabal37
-rw-r--r--data/opcodes/MultiFX/AnalogDelay.udo35
-rw-r--r--data/opcodes/MultiFX/Distortion.udo28
-rw-r--r--data/opcodes/MultiFX/EnvelopeFollower.udo29
-rw-r--r--data/opcodes/MultiFX/Flanger.udo32
-rw-r--r--data/opcodes/MultiFX/FreqShifter.udo38
-rw-r--r--data/opcodes/MultiFX/LoFi.udo23
-rw-r--r--data/opcodes/MultiFX/MonoTrem.udo35
-rw-r--r--data/opcodes/MultiFX/PanTrem.udo42
-rw-r--r--data/opcodes/MultiFX/Phaser.udo22
-rw-r--r--data/opcodes/MultiFX/PitchShifter.udo30
-rw-r--r--data/opcodes/MultiFX/Reverse.udo29
-rw-r--r--data/opcodes/MultiFX/RingModulator.udo32
-rw-r--r--data/opcodes/MultiFX/StChorus.udo33
-rw-r--r--data/opcodes/MultiFX/StereoPingPongDelay.udo30
-rw-r--r--data/opcodes/PitchShifterDelay.udo49
-rw-r--r--data/opcodes/Utility/Delay1k.udo6
-rw-r--r--src/Csound/Typed/Control.hs12
-rw-r--r--src/Csound/Typed/Control/Api.hs13
-rw-r--r--src/Csound/Typed/Control/ArrayTraverse.hs160
-rw-r--r--src/Csound/Typed/Control/Evt.hs61
-rw-r--r--src/Csound/Typed/Control/Instr.hs7
-rw-r--r--src/Csound/Typed/Control/InstrRef.hs97
-rw-r--r--src/Csound/Typed/Control/MacrosArgs.hs18
-rw-r--r--src/Csound/Typed/Control/Mix.hs28
-rw-r--r--src/Csound/Typed/Control/Osc.hs106
-rw-r--r--src/Csound/Typed/Control/Ref.hs84
-rw-r--r--src/Csound/Typed/GlobalState.hs2
-rw-r--r--src/Csound/Typed/GlobalState/Elements.hs114
-rw-r--r--src/Csound/Typed/GlobalState/GE.hs44
-rw-r--r--src/Csound/Typed/GlobalState/InstrApi.hs74
-rw-r--r--src/Csound/Typed/GlobalState/Opcodes.hs34
-rw-r--r--src/Csound/Typed/GlobalState/Options.hs130
-rw-r--r--src/Csound/Typed/GlobalState/Port.hs113
-rw-r--r--src/Csound/Typed/GlobalState/SE.hs22
-rw-r--r--src/Csound/Typed/Gui/BoxModel.hs1
-rw-r--r--src/Csound/Typed/Gui/Cabbage/Cabbage.hs1
-rw-r--r--src/Csound/Typed/Gui/Gui.hs107
-rw-r--r--src/Csound/Typed/Gui/Widget.hs11
-rw-r--r--src/Csound/Typed/InnerOpcodes.hs16
-rw-r--r--src/Csound/Typed/Plugins.hs17
-rw-r--r--src/Csound/Typed/Plugins/Adsr140.hs3
-rw-r--r--src/Csound/Typed/Plugins/Audaciouseq.hs1
-rw-r--r--src/Csound/Typed/Plugins/Diode.hs1
-rw-r--r--src/Csound/Typed/Plugins/Iain.hs313
-rw-r--r--src/Csound/Typed/Plugins/Korg35.hs1
-rw-r--r--src/Csound/Typed/Plugins/SolinaChorus.hs1
-rw-r--r--src/Csound/Typed/Plugins/TabQueue.hs1
-rw-r--r--src/Csound/Typed/Plugins/Utilities.hs23
-rw-r--r--src/Csound/Typed/Plugins/Zdf.hs1
-rw-r--r--src/Csound/Typed/Plugins/ZeroDelayConvolution.hs1
-rw-r--r--src/Csound/Typed/Render.hs17
-rw-r--r--src/Csound/Typed/Types.hs12
-rw-r--r--src/Csound/Typed/Types/Array.hs612
-rw-r--r--src/Csound/Typed/Types/MixSco.hs40
-rw-r--r--src/Csound/Typed/Types/MonoArg.hs38
-rw-r--r--src/Csound/Typed/Types/Prim.hs277
-rw-r--r--src/Csound/Typed/Types/SigSpace.hs702
-rw-r--r--src/Csound/Typed/Types/Tuple.hs131
59 files changed, 3643 insertions, 334 deletions
diff --git a/csound-expression-typed.cabal b/csound-expression-typed.cabal
index dc434b2..5880d0b 100644
--- a/csound-expression-typed.cabal
+++ b/csound-expression-typed.cabal
@@ -1,5 +1,5 @@
Name: csound-expression-typed
-Version: 0.1.0.0
+Version: 0.2.0.0
Cabal-Version: >= 1.22
License: BSD3
License-file: LICENSE
@@ -34,6 +34,22 @@ Data-Files :
data/opcodes/diode.udo
data/opcodes/korg35.udo
data/opcodes/zero-delay-convolution.udo
+ data/opcodes/PitchShifterDelay.udo
+ data/opcodes/MultiFX/AnalogDelay.udo
+ data/opcodes/MultiFX/Distortion.udo
+ data/opcodes/MultiFX/EnvelopeFollower.udo
+ data/opcodes/MultiFX/Flanger.udo
+ data/opcodes/MultiFX/FreqShifter.udo
+ data/opcodes/MultiFX/LoFi.udo
+ data/opcodes/MultiFX/PanTrem.udo
+ data/opcodes/MultiFX/MonoTrem.udo
+ data/opcodes/MultiFX/Phaser.udo
+ data/opcodes/MultiFX/PitchShifter.udo
+ data/opcodes/MultiFX/Reverse.udo
+ data/opcodes/MultiFX/RingModulator.udo
+ data/opcodes/MultiFX/StChorus.udo
+ data/opcodes/MultiFX/StereoPingPongDelay.udo
+ data/opcodes/Utility/Delay1k.udo
Homepage: https://github.com/anton-k/csound-expression-typed
@@ -48,7 +64,7 @@ Library
Ghc-Options: -Wall
Build-Depends:
base >= 4, base < 5, ghc-prim, containers, transformers >= 0.3, Boolean >= 0.1.0, colour >= 2.0, data-default, deepseq,
- wl-pprint, csound-expression-dynamic >= 0.2.0, temporal-media >= 0.6.0, hashable
+ wl-pprint, csound-expression-dynamic >= 0.3.0, temporal-media >= 0.6.0, hashable
Hs-Source-Dirs: src/
Exposed-Modules:
Csound.Typed
@@ -60,10 +76,13 @@ Library
Csound.Typed.Gui
Csound.Typed.Gui.Cab
- Csound.Typed.Types.Prim
+ Csound.Typed.Types.Prim
Csound.Typed.Types.Evt
Csound.Typed.Types.Tuple
Csound.Typed.Types.Lift
+ Csound.Typed.Types.Array
+ Csound.Typed.Types.MonoArg
+ Csound.Typed.Types.SigSpace
Csound.Typed.Plugins
@@ -73,9 +92,12 @@ Library
Csound.Typed.GlobalState.GE
Csound.Typed.GlobalState.SE
Csound.Typed.GlobalState.Instr
+ Csound.Typed.GlobalState.InstrApi
Csound.Typed.GlobalState.Cache
Csound.Typed.GlobalState.Elements
- Csound.Typed.GlobalState.Opcodes
+ Csound.Typed.GlobalState.Opcodes
+ Csound.Typed.GlobalState.Port
+ Csound.Typed.InnerOpcodes
Csound.Typed.Types.TupleHelpers
Csound.Typed.Types.MixSco
@@ -88,8 +110,11 @@ Library
Csound.Typed.Control.Sf2
Csound.Typed.Control.Osc
Csound.Typed.Control.Channel
- Csound.Typed.Control.Ref
+ Csound.Typed.Control.Ref
Csound.Typed.Control.Instr
+ Csound.Typed.Control.InstrRef
+ Csound.Typed.Control.ArrayTraverse
+ Csound.Typed.Control.MacrosArgs
Csound.Typed.Gui.Gui
Csound.Typed.Gui.Widget
@@ -108,6 +133,8 @@ Library
Csound.Typed.Plugins.Audaciouseq
Csound.Typed.Plugins.SolinaChorus
Csound.Typed.Plugins.ZeroDelayConvolution
+ Csound.Typed.Plugins.Iain
+ Csound.Typed.Plugins.Utilities
Paths_csound_expression_typed
diff --git a/data/opcodes/MultiFX/AnalogDelay.udo b/data/opcodes/MultiFX/AnalogDelay.udo
new file mode 100644
index 0000000..ea20f37
--- /dev/null
+++ b/data/opcodes/MultiFX/AnalogDelay.udo
@@ -0,0 +1,35 @@
+; AnalogDelay
+; ----------------
+; A analog style delay with signal degradation and saturation options
+;
+; aout AnalogDelay ain,kmix,ktime,kfback,ktone
+;
+; Performance
+; -----------
+; ain -- input audio to which the flanging effect will be applied
+; kmix -- dry / wet mix of the output signal (range 0 to 1)
+; ktime -- delay time of the effect in seconds
+; kfback -- control of the amount of output signal fed back into the input of the effect (exceeding 1 (100%) is possible and will result in saturation clipping effects)
+; ktone -- control of the amount of output signal fed back into the input of the effect (range 0 to 1)
+
+
+opcode AnalogDelay,a,aKKKK
+ ain,kmix,ktime,kfback,ktone xin ;READ IN INPUT ARGUMENTS
+ ktone expcurve ktone,4 ;CREATE AN EXPONENTIAL REMAPPING OF ktone
+ ktone scale ktone,12000,100 ;RESCALE 0 - 1 VALUE
+ iWet ftgentmp 0,0,1024,-7,0,512,1,512,1 ;RESCALING FUNCTION FOR WET LEVEL CONTROL
+ iDry ftgentmp 0,0,1024,-7,1,512,1,512,0 ;RESCALING FUNCTION FOR DRY LEVEL CONTROL
+ kWet table kmix, iWet, 1 ;RESCALE WET LEVEL CONTROL ACCORDING TO FUNCTION TABLE iWet
+ kDry table kmix, iDry, 1 ;RESCALE DRY LEVEL CONTROL ACCORDING TO FUNCTION TABLE iWet
+ kporttime linseg 0,0.001,0.1 ;RAMPING UP PORTAMENTO TIME
+ kTime portk ktime, kporttime*3 ;APPLY PORTAMENTO SMOOTHING TO DELAY TIME PARAMETER
+ kTone portk ktone, kporttime ;APPLY PORTAMENTO SMOOTHING TO TONE PARAMETER
+ aTime interp kTime ;INTERPOLATE AND CREAT A-RATE VERSION OF DELAY TIME PARAMETER
+ aBuffer delayr 5 ;READ FROM (AND INITIALIZE) BUFFER
+ atap deltap3 aTime ;TAP DELAY BUFFER
+ atap clip atap, 0, 0dbfs*0.8 ;SIGNAL IS CLIPPED AT MAXIMUM AMPLITUDE USING BRAM DE JONG METHOD
+ atap tone atap, kTone ;LOW-PASS FILTER DELAY TAP WITHIN DELAY BUFFER
+ delayw ain+(atap*kfback) ;WRITE INPUT AUDIO AND FEEDBACK SIGNAL INTO DELAY BUFFER
+ aout sum ain*kDry, atap*kWet ;MIX DRY AND WET SIGNALS
+ xout aout ;SEND AUDIO BACK TO CALLER INSTRUMENT
+endop
diff --git a/data/opcodes/MultiFX/Distortion.udo b/data/opcodes/MultiFX/Distortion.udo
new file mode 100644
index 0000000..b59f386
--- /dev/null
+++ b/data/opcodes/MultiFX/Distortion.udo
@@ -0,0 +1,28 @@
+; Distortion
+; ----------------
+; A distortion effect offering stomp-box-like controls
+;
+; aout Distortion ain,klevel,kdrive,ktone
+;
+; Performance
+; -----------
+; ain -- input audio to be distorted
+; klevel -- output level of the effect (range: 0 to 1)
+; kdrive -- intensity of the distortion effect (range: 0 to 1)
+; ktone -- tone of a lowpass filter (range: 0 to 1)
+
+opcode Distortion, a, aKKK
+ ain,klevel,kdrive,ktone xin ;READ IN INPUT ARGUMENTS
+ klevel scale klevel,0.8,0 ;RESCALE LEVEL CONTROL
+ kdrive expcurve kdrive,8 ;EXPONENTIALLY REMAP kdrive
+ kdrive scale kdrive,0.4,0.01 ;RESCALE kdrive
+ kLPF expcurve ktone,4 ;EXPONENTIALLY REMAP ktone
+ kLPF scale kLPF,12000,200 ;RESCALE klpf
+ kGainComp1 logcurve ktone,700 ;LOGARITHMIC RESCALING OF ktone TO CREAT A GAIN COMPENSATION VARIABLE FOR WHEN TONE IS LOWERED
+ kGainComp1 scale kGainComp1,1,5 ;RESCALE GAIN COMPENSATION VARIABLE
+ kpregain = (kdrive*100) ;DEFINE PREGAIN FROM kdrive
+ kpostgain = 0.5 * (((1-kdrive) * 0.4) + 0.6) ;DEFINE POSTGAIN FROM kdrive
+ aDist distort1 ain*(32768/0dbfs), kpregain, kpostgain, 0, 0 ;CREATE DISTORTION SIGNAL
+ aDist butlp aDist/(32768/0dbfs), kLPF ;LOWPASS FILTER DISTORTED SIGNAL
+ xout aDist*klevel*kGainComp1 ;SEND AUDIO BACK TO CALLER INSTRUMENT. RESCALE WITH USER LEVEL CONTROL AND GAIN COMPENSATION
+endop
diff --git a/data/opcodes/MultiFX/EnvelopeFollower.udo b/data/opcodes/MultiFX/EnvelopeFollower.udo
new file mode 100644
index 0000000..22afa9a
--- /dev/null
+++ b/data/opcodes/MultiFX/EnvelopeFollower.udo
@@ -0,0 +1,29 @@
+; EnvelopeFollower
+; ----------------
+; A dynamic envelope following resonant lowpass filter
+;
+; aout EnvelopeFollower ain,ksens,kfreq,kres
+;
+; Performance
+; -----------
+; ain -- input audio to be filtered
+; ksens -- sensitivity of the envelope follower (suggested range: 0 to 1)
+; kfreq -- base frequency of the filter before modulation by the input dynamics (range: 0 to 1)
+; kres -- resonance of the lowpass filter (suggested range: 0 to 0.99)
+
+
+opcode EnvelopeFollower,a,aKKK
+ ain,ksens,kfreq,kres xin ;READ IN INPUT ARGUMENTS
+ kfreq expcurve kfreq,4 ;CREATE AN EXPONENTIAL REMAPPING OF kfreq
+ kfreq scale kfreq,10000,10 ;RESCALE 0 - 1 VALUE
+ ksens logcurve ksens,100 ;CREATE LOGARITHMIC REMAPPING OF ksens
+ aFollow follow2 ain, 0.01, 0.05 ;AMPLITUDE FOLLOWING AUDIO SIGNAL
+ kFollow downsamp aFollow ;DOWNSAMPLE TO K-RATE
+ kFollow expcurve kFollow/0dbfs,3 ;ADJUSTMENT OF THE RESPONSE OF DYNAMICS TO FILTER FREQUENCY MODULATION
+ kFrq = kfreq + (cpsoct(kFollow*ksens*150)) ;CREATE A LEFT CHANNEL MODULATING FREQUENCY BASE ON THE STATIC VALUE CREATED BY kfreq AND THE AMOUNT OF DYNAMIC ENVELOPE FOLLOWING GOVERNED BY ksens
+ kFrq port kFrq, 0.05 ;SMOOTH CONTROL SIGNAL USING PORTAMENTO
+ kFrq limit kFrq, 20,sr/2 ;LIMIT FREQUENCY RANGE TO PREVENT OUT OF RANGE FREQUENCIES
+ ;IF REALTIME PERFORMNCE IS AN ISSUE, USE moogvcf2 INSTEAD OF moogladder
+ aout moogladder ain, kFrq, kres ;REDEFINE GLOBAL AUDIO SIGNAL AS FILTERED VERSION OF ITSELF
+ xout aout ;SEND AUDIO BACK TO CALLER INSTRUMENT
+endop
diff --git a/data/opcodes/MultiFX/Flanger.udo b/data/opcodes/MultiFX/Flanger.udo
new file mode 100644
index 0000000..3d163ae
--- /dev/null
+++ b/data/opcodes/MultiFX/Flanger.udo
@@ -0,0 +1,32 @@
+; Flanger
+; ----------------
+; A flanger effect following the typical design of a so called 'stomp box'
+;
+; aout Flanger ain,krate,kdepth,kdelay,kfback
+;
+; Performance
+; -----------
+; ain -- input audio to which the flanging effect will be applied
+; krate -- rate control of the lfo of the effect *NOT IN HERTZ* (range 0 to 1)
+; kdepth -- depth of the lfo of the effect (range 0 to 1)
+; kdelay -- static delay offset of the flanging effect (range 0 to 1)
+; kfback -- feedback and therefore intensity of the effect (range 0 to 1)
+
+
+opcode Flanger,a,aKKKK
+ ain,krate,kdepth,kdelay,kfback xin ;READ IN INPUT ARGUMENTS
+ krate expcurve krate,50 ;CREATE AN EXPONENTIAL REMAPPING OF krate
+ krate scale krate,14,0.001 ;RESCALE VALUE
+ kdelay expcurve kdelay,200 ;CREATE AN EXPONENTIAL REMAPPING OF kdelay
+ kdelay scale kdelay,0.1,0.00015 ;RESCALE VALUE
+ ilfoshape ftgentmp 0, 0, 131072, 19, 0.5, 1, 180, 1 ;U-SHAPE PARABOLA FOR LFO
+ kporttime linseg 0, 0.001, 0.1 ;USE OF AN ENVELOPE VALUE THAT QUICKLY RAMPS UP FROM ZERON TO THE REQUIRED VALUE PREVENTS VARIABLES GLIDING TO THEIR REQUIRED VALUES EACH TIME THE INSTRUMENT IS STARTED
+ kdlt portk kdelay, kporttime ;PORTAMENTO IS APPLIED TO A VARIABLE. A NEW VARIABLE 'kdlt' IS CREATED.
+ adlt interp kdlt ;A NEW A-RATE VARIABLE 'adlt' IS CREATED BY INTERPOLATING THE K-RATE VARIABLE 'kdlt'
+ kdep portk kdepth*0.01, kporttime ;PORTAMENTO IS APPLIED TO A VARIABLE. A NEW VARIABLE 'kdep' IS CREATED.
+ amod oscili kdep, krate, ilfoshape ;OSCILLATOR THAT MAKES USE OF THE POSITIVE DOMAIN ONLY U-SHAPE PARABOLA WITH FUNCTION TABLE NUMBER ilfoshape
+ adlt sum adlt, amod ;STATIC DELAY TIME AND MODULATING DELAY TIME ARE SUMMED
+ adelsig flanger ain, adlt, kfback , 1.2 ;FLANGER SIGNAL CREATED
+ aout sum ain*0.5, adelsig*0.5 ;CREATE DRY/WET MIX
+ xout aout ;SEND AUDIO BACK TO CALLER INSTRUMENT
+endop
diff --git a/data/opcodes/MultiFX/FreqShifter.udo b/data/opcodes/MultiFX/FreqShifter.udo
new file mode 100644
index 0000000..70e476e
--- /dev/null
+++ b/data/opcodes/MultiFX/FreqShifter.udo
@@ -0,0 +1,38 @@
+; FreqShifter
+; ----------------
+; A frequency shifter effect using the hilbert filter
+;
+; aout FreqShifter adry,kmix,kfreq,kmult,kfback
+;
+; Performance
+; -----------
+; adry -- input audio to be frequency shifted
+; kmix -- dry / wet mix of the output signal (range 0 to 1)
+; kfreq -- frequency of frequency shifter effect (suggested range -1000 to 1000)
+; kmult -- multiplier of frequency value for fine tuning control (suggested range -1 to 1)
+; kfback -- control of the amount of output signal fed back into the input of the effect (suggested range 0 to 1)
+
+opcode FreqShifter,a,aKKKK
+ adry,kmix,kfreq,kmult,kfback xin ;READ IN INPUT ARGUMENTS
+ iWet ftgentmp 0,0,1024,-7,0,512,1,512,1 ;RESCALING FUNCTION FOR WET LEVEL CONTROL
+ iDry ftgentmp 0,0,1024,-7,1,512,1,512,0 ;RESCALING FUNCTION FOR DRY LEVEL CONTROL
+ isine ftgentmp 0,0,4096,10,1 ;A SINE WAVE SHAPE
+ kWet table kmix, iWet, 1 ;RESCALE WET LEVEL CONTROL ACCORDING TO FUNCTION TABLE giWet
+ kDry table kmix, iDry, 1 ;RESCALE DRY LEVEL CONTROL ACCORDING TO FUNCTION TABLE giWet
+ aFS init 0 ;INITILISE FEEDBACK SIGNAL (FOR FIRST K-PASS)
+ ain = adry + (aFS * kfback) ;ADD FEEDBACK SIGNAL TO INPUT (AMOUNT OF FEEDBACK CONTROLLED BY 'Feedback Gain' SLIDER)
+ areal, aimag hilbert ain ;HILBERT OPCODE OUTPUTS TWO PHASE SHIFTED SIGNALS, EACH 90 OUT OF PHASE WITH EACH OTHER
+ kporttime linseg 0,0.001,0.02
+ kfshift portk kfreq*kmult, kporttime
+ ;QUADRATURE OSCILLATORS. I.E. 90 OUT OF PHASE WITH RESPECT TO EACH OTHER
+ ;OUTUTS OPCODE AMPLITUDE | FREQ. | FUNCTION_TABLE | INITIAL_PHASE (OPTIONAL;DEFAULTS TO ZERO)
+ asin oscili 1, kfshift, isine, 0
+ acos oscili 1, kfshift, isine, 0.25
+ ;RING MODULATE EACH SIGNAL USING THE QUADRATURE OSCILLATORS AS MODULATORS
+ amod1 = areal * acos
+ amod2 = aimag * asin
+ ;UPSHIFTING OUTPUT
+ aFS = (amod1 - amod2)
+ aout sum aFS*kWet, adry*kDry ;CREATE WET/DRY MIX
+ xout aout ;SEND AUDIO BACK TO CALLER INSTRUMENT
+endop
diff --git a/data/opcodes/MultiFX/LoFi.udo b/data/opcodes/MultiFX/LoFi.udo
new file mode 100644
index 0000000..f374843
--- /dev/null
+++ b/data/opcodes/MultiFX/LoFi.udo
@@ -0,0 +1,23 @@
+; LoFi
+; ----------------
+; 'Low Fidelity' distorting effects of bit reduction and downsampling (foldover)
+;
+; aout LoFi ain,kbits,kfold
+;
+; Performance
+; -----------
+; ain -- input audio to have low fidelity distortion effects applied
+; kbits -- bit depth reduction (suggested range 0 to 0.6)
+; kfold -- amount of foldover (range 0 to 1)
+
+
+opcode LoFi,a,aKK
+ ain,kbits,kfold xin ;READ IN INPUT ARGUMENTS
+ kfold expcurve kfold,500 ;CREATE AN EXPONENTIAL REMAPPING OF kfold
+ kfold scale kfold,1024,1 ;RESCALE 0 - 1 VALUE TO 1 - 1024
+ kvalues pow 2, ((1-(kbits^0.25))*15)+1 ;RAISES 2 TO THE POWER OF kbitdepth. THE OUTPUT VALUE REPRESENTS THE NUMBER OF POSSIBLE VALUES AT THAT PARTICULAR BIT DEPTH
+ k16bit pow 2, 16 ;RAISES 2 TO THE POWER OF 16
+ aout = (int((ain*32768*kvalues)/k16bit)/32768)*(k16bit/kvalues) ;BIT DEPTH REDUCE AUDIO SIGNAL
+ aout fold aout, kfold ;APPLY SAMPLING RATE FOLDOVER
+ xout aout ;SEND AUDIO BACK TO CALLER INSTRUMENT
+endop
diff --git a/data/opcodes/MultiFX/MonoTrem.udo b/data/opcodes/MultiFX/MonoTrem.udo
new file mode 100644
index 0000000..44807cf
--- /dev/null
+++ b/data/opcodes/MultiFX/MonoTrem.udo
@@ -0,0 +1,35 @@
+
+; MonoTrem
+; ----------------
+; Tremolo effect
+;
+; aout MonoTrem ain,krate,kdepth,kwave
+;
+; Performance
+; -----------
+; ain -- input audio
+; krate -- rate control of the lfo of the effect *NOT IN HERTZ* (range 0 to 1)
+; kdepth -- depth of the lfo of the effect (range 0 to 1)
+; kwave -- waveform used by the lfo (0=sine 1=triangle 2=square)
+
+opcode MonoTrem,a,aKKK
+ ain,krate,kdepth,kwave xin ;READ IN INPUT ARGUMENTS
+ krate expcurve krate,5 ;CREATE AN EXPONENTIAL REMAPPING OF krate
+ krate scale krate,50,0.1 ;RESCALE VALUE
+ ktrig changed kwave ;IF LFO WAVEFORM TYPE IS CHANGED GENERATE A MOMENTARY '1' (BANG)
+ if ktrig=1 then ;IF A 'BANG' HAS BEEN GENERATED IN THE ABOVE LINE
+ reinit UPDATE ;BEGIN A REINITIALIZATION PASS FROM LABEL 'UPDATE' SO THAT LFO WAVEFORM TYPE CAN BE UPDATED
+ endif ;END OF THIS CONDITIONAL BRANCH
+ UPDATE: ;LABEL CALLED UPDATE
+ klfo lfo kdepth, krate, i(kwave) ;CREATE AN LFO
+ rireturn ;RETURN FROM REINITIALIZATION PASS
+ klfo = (klfo*0.5)+0.5 ;RESCALE AND OFFSET LFO SO IT STAY WITHIN THE RANGE 0 - 1 ABOUT THE VALUE 0.5
+ if kwave=2 then ;IF SQUARE WAVE MODULATION HAS BEEN CHOSEN...
+ klfo portk klfo, 0.001 ;SMOOTH THE SQUARE WAVE A TINY BIT TO PREVENT CLICKS
+ endif ;END OF THIS CONDITIONAL BRANCH
+
+ klfo = klfo+(0.5-(kdepth*0.5)) ;MODIFY LFO AT ZERO DEPTH VALUE IS 1 AND AT MAX DEPTH CENTRE OF MODULATION IS 0.5
+ alfo interp klfo ;INTERPOLATE K-RATE LFO AND CREATE A-RATE VARIABLE
+ aout = ain*(alfo^2) ;REDEFINE GLOBAL AUDIO LEFT CHANNEL SIGNAL WITH TREMELO
+ xout aout ;SEND AUDIO BACK TO CALLER INSTRUMENT
+endop \ No newline at end of file
diff --git a/data/opcodes/MultiFX/PanTrem.udo b/data/opcodes/MultiFX/PanTrem.udo
new file mode 100644
index 0000000..cbfd13d
--- /dev/null
+++ b/data/opcodes/MultiFX/PanTrem.udo
@@ -0,0 +1,42 @@
+; PanTrem
+; ----------------
+; Auto-panning and tremolo effects
+;
+; aout1,aout2 PanTrem ainL,ainR,,krate,kdepth,kmode,kwave
+;
+; Performance
+; -----------
+; ainL -- first/left input audio
+; ainR -- second/right input audio
+; krate -- rate control of the lfo of the effect *NOT IN HERTZ* (range 0 to 1)
+; kdepth -- depth of the lfo of the effect (range 0 to 1)
+; kmode -- mode of the effect (0=auto-panning 1=tremolo)
+; kwave -- waveform used by the lfo (0=sine 1=triangle 2=square)
+
+opcode PanTrem,aa,aaKKKK
+ ainL,ainR,krate,kdepth,kmode,kwave xin ;READ IN INPUT ARGUMENTS
+ krate expcurve krate,5 ;CREATE AN EXPONENTIAL REMAPPING OF krate
+ krate scale krate,50,0.1 ;RESCALE VALUE
+ ktrig changed kwave ;IF LFO WAVEFORM TYPE IS CHANGED GENERATE A MOMENTARY '1' (BANG)
+ if ktrig=1 then ;IF A 'BANG' HAS BEEN GENERATED IN THE ABOVE LINE
+ reinit UPDATE ;BEGIN A REINITIALIZATION PASS FROM LABEL 'UPDATE' SO THAT LFO WAVEFORM TYPE CAN BE UPDATED
+ endif ;END OF THIS CONDITIONAL BRANCH
+ UPDATE: ;LABEL CALLED UPDATE
+ klfo lfo kdepth, krate, i(kwave) ;CREATE AN LFO
+ rireturn ;RETURN FROM REINITIALIZATION PASS
+ klfo = (klfo*0.5)+0.5 ;RESCALE AND OFFSET LFO SO IT STAY WITHIN THE RANGE 0 - 1 ABOUT THE VALUE 0.5
+ if kwave=2 then ;IF SQUARE WAVE MODULATION HAS BEEN CHOSEN...
+ klfo portk klfo, 0.001 ;SMOOTH THE SQUARE WAVE A TINY BIT TO PREVENT CLICKS
+ endif ;END OF THIS CONDITIONAL BRANCH
+ if kmode=0 then ;PAN ;IF PANNING MODE IS CHOSEN FROM BUTTON BANK...
+ alfo interp klfo ;INTERPOLATE K-RATE LFO AND CREATE A-RATE VARIABLE
+ aoutL = ainL*sqrt(alfo) ;REDEFINE GLOBAL AUDIO LEFT CHANNEL SIGNAL WITH AUTO-PANNING
+ aoutR = ainR*(1-sqrt(alfo)) ;REDEFINE GLOBAL AUDIO RIGHT CHANNEL SIGNAL WITH AUTO-PANNING
+ elseif kmode=1 then ;TREM ;IF TREMELO MODE IS CHOSEN FROM BUTTON BANK...
+ klfo = klfo+(0.5-(kdepth*0.5)) ;MODIFY LFO AT ZERO DEPTH VALUE IS 1 AND AT MAX DEPTH CENTRE OF MODULATION IS 0.5
+ alfo interp klfo ;INTERPOLATE K-RATE LFO AND CREATE A-RATE VARIABLE
+ aoutL = ainL*(alfo^2) ;REDEFINE GLOBAL AUDIO LEFT CHANNEL SIGNAL WITH TREMELO
+ aoutR = ainR*(alfo^2) ;REDEFINE GLOBAL AUDIO RIGHT CHANNEL SIGNAL WITH TREMELO
+ endif ;END OF THIS CONDITIONAL BRANCH
+ xout aoutL,aoutR ;SEND AUDIO BACK TO CALLER INSTRUMENT
+endop
diff --git a/data/opcodes/MultiFX/Phaser.udo b/data/opcodes/MultiFX/Phaser.udo
new file mode 100644
index 0000000..2ec0ea2
--- /dev/null
+++ b/data/opcodes/MultiFX/Phaser.udo
@@ -0,0 +1,22 @@
+; Phaser
+; ----------------
+; An phase shifting effect that mimics the design of a so called 'stomp box'
+;
+; aout Phaser ain,krate,kdepth,kfreq,kfback
+;
+; Performance
+; -----------
+; ain -- input audio to be pitch shifted
+; krate -- rate of lfo of the effect (range 0 to 1)
+; kdepth -- depth of lfo of the effect (range 0 to 1)
+; kfreq -- centre frequency of the phase shifting effect in octaves (suggested range 6 to 11)
+; kfback -- feedback and therefore intensity of the effect (range 0 to 1)
+
+opcode Phaser,a,aKKKK
+ ain,krate,kdepth,kfreq,kfback xin ;READ IN INPUT ARGUMENTS
+ krate expcurve krate,10 ;CREATE AN EXPONENTIAL REMAPPING OF krate
+ krate scale krate,14,0.01 ;RESCALE 0 - 1 VALUE TO 0.01 - 14
+ klfo lfo kdepth*0.5, krate, 1 ;LFO FOR THE PHASER (TRIANGULAR SHAPE)
+ aout phaser1 ain, cpsoct((klfo+(kdepth*0.5)+kfreq)), 8, kfback ;PHASER1 IS APPLIED TO THE INPUT AUDIO
+ xout aout ;SEND AUDIO BACK TO CALLER INSTRUMENT
+endop
diff --git a/data/opcodes/MultiFX/PitchShifter.udo b/data/opcodes/MultiFX/PitchShifter.udo
new file mode 100644
index 0000000..5c04dce
--- /dev/null
+++ b/data/opcodes/MultiFX/PitchShifter.udo
@@ -0,0 +1,30 @@
+; PitchShifter
+; ------------
+; A pitch shifter effect based on FFT technology
+;
+; aout PitchShifter ain,kmix,kpitch,kfine,kfback
+;
+; Performance
+; -----------
+; ain -- input audio to be pitch shifted
+; kmix -- dry / wet mix of the output signal (range 0 to 1)
+; kpitch -- pitch shifting interval in thousands of a semitone (suggested range -0.012 to 0.012)
+; kfine -- fine control of pitch shifting interval in octaves (range -1/12 to 1/12)
+; kfback -- control of the amount of output signal fed back into the input of the effect (suggested range 0 to 1)
+
+opcode PitchShifter,a,aKKKi
+ ain,kmix,kscal,kfback,ifftsize xin ;READ IN INPUT ARGUMENTS
+ iWet ftgentmp 0,0,1024,-7,0,512,1,512,1 ;RESCALING FUNCTION FOR WET LEVEL CONTROL
+ iDry ftgentmp 0,0,1024,-7,1,512,1,512,0 ;RESCALING FUNCTION FOR DRY LEVEL CONTROL
+ kWet table kmix, iWet, 1 ;RESCALE WET LEVEL CONTROL ACCORDING TO FUNCTION TABLE iWet
+ kDry table kmix, iDry, 1 ;RESCALE DRY LEVEL CONTROL ACCORDING TO FUNCTION TABLE iWet
+ aPS init 0 ;INITIALIZE aOutL FOR FIRST PERFORMANCE TIME PASS
+ ; kscal = octave(((kpitch*1000)/12)+kfine) ;DERIVE PITCH SCALING RATIO. NOTE THAT THE 'COARSE' PITCH DIAL BECOMES STEPPED IN SEMITONE INTERVALS
+ ioverlap = ifftsize / 4
+ iwinsize = ifftsize
+ fsig1 pvsanal ain+(aPS*kfback), ifftsize,ioverlap,iwinsize,0 ;PHASE VOCODE ANALYSE LEFT CHANNEL
+ fsig2 pvscale fsig1, kscal ;RESCALE PITCH
+ aPS pvsynth fsig2 ;RESYNTHESIZE FROM FSIG
+ aout sum ain*kDry, aPS*kWet ;REDEFINE GLOBAL AUDIO SIGNAL FROM MIX OF DRY AND WET SIGNALS
+ xout aout ;SEND AUDIO BACK TO CALLER INSTRUMENT
+endop
diff --git a/data/opcodes/MultiFX/Reverse.udo b/data/opcodes/MultiFX/Reverse.udo
new file mode 100644
index 0000000..478b327
--- /dev/null
+++ b/data/opcodes/MultiFX/Reverse.udo
@@ -0,0 +1,29 @@
+; Reverse
+; ----------------
+; An effect that reverses an audio stream in chunks
+;
+; aout Reverse ain,ktime
+;
+; Performance
+; -----------
+; ain -- input audio to be reversed
+; ktime -- time duration of each chunk (suggested range: 0.3 to 2)
+
+opcode Reverse, a, aK ;nb. CAPITAL K CREATE A K-RATE VARIABLE THAT HAS A USEFUL VALUE ALSO AT I-TIME
+ ain,ktime xin ;READ IN INPUT ARGUMENTS
+ ktrig changed ktime ;IF ktime CONTROL IS MOVED GENERATE A MOMENTARY '1' IMPULSE
+ if ktrig=1 then ;IF A TRIGGER HAS BEEN GENERATED IN THE LINE ABOVE...
+ reinit UPDATE ;...BEGIN A REINITILISATION PASS FROM LABEL 'UPDATE'
+ endif ;END OF CONDITIONAL BRANCH
+ UPDATE: ;LABEL CALLED 'UPDATE'
+ itime = i(ktime) ;CREATE AN I-TIME VERSION OF ktime
+ aptr phasor 2/itime ;CREATE A MOVING PHASOR THAT WITH BE USED TO TAP THE DELAY BUFFER
+ aptr = aptr*itime ;SCALE PHASOR ACCORDING TO THE LENGTH OF THE DELAY TIME CHOSEN BY THE USER
+ ienv ftgentmp 0,0,1024,7,0,(1024*0.01),1,(1024*0.98),1,(0.01*1024),0 ;ANTI-CLICK ENVELOPE SHAPE
+ aenv poscil 1, 2/itime, ienv ;CREATE A CYCLING AMPLITUDE ENVELOPE THAT WILL SYNC TO THE TAP DELAY TIME PHASOR
+ abuffer delayr itime ;CREATE A DELAY BUFFER
+ atap deltap3 aptr ;READ AUDIO FROM A TAP WITHIN THE DELAY BUFFER
+ delayw ain ;WRITE AUDIO INTO DELAY BUFFER
+ rireturn ;RETURN FROM REINITIALISATION PASS
+ xout atap*aenv ;SEND AUDIO BACK TO CALLER INSTRUMENT. APPLY AMPLITUDE ENVELOPE TO PREVENT CLICKS.
+endop
diff --git a/data/opcodes/MultiFX/RingModulator.udo b/data/opcodes/MultiFX/RingModulator.udo
new file mode 100644
index 0000000..2ba8ff2
--- /dev/null
+++ b/data/opcodes/MultiFX/RingModulator.udo
@@ -0,0 +1,32 @@
+; RingModulator
+; ----------------
+; An ring modulating effect with an envelope follower
+;
+; aout RingModulator ain,kmix,kfreq,kenv
+;
+; Performance
+; -----------
+; ain -- input audio to be pitch shifted
+; kmix -- dry / wet mix of the output signal (range 0 to 1)
+; kfreq -- frequency of thew ring modulator *NOT IN HERTZ* (range 0 to 1)
+; kenv -- amount of dynamic envelope following modulation of frequency (range 0 to 1)
+
+opcode RingModulator,a,aKKK
+ ain,kmix,kfreq,kenv xin ;READ IN INPUT ARGUMENTS
+ kfreq expcurve kfreq,4 ;CREATE AN EXPONENTIAL REMAPPING OF kfreq
+ kfreq scale kfreq,5000,10 ;RESCALE 0 - 1 VALUE TO 10 - 5000
+ iWet ftgentmp 0,0,1024,-7,0,512,1,512,1 ;RESCALING FUNCTION FOR WET LEVEL CONTROL
+ iDry ftgentmp 0,0,1024,-7,1,512,1,512,0 ;RESCALING FUNCTION FOR DRY LEVEL CONTROL
+ isine ftgentmp 0,0,4096,10,1 ;SINE WAVE
+ kWet table kmix, iWet, 1 ;RESCALE WET LEVEL CONTROL ACCORDING TO FUNCTION TABLE iWet
+ kDry table kmix, iDry, 1 ;RESCALE DRY LEVEL CONTROL ACCORDING TO FUNCTION TABLE iDry
+ kporttime linseg 0,0.001,0.02 ;PORTAMENTO VARIABLE
+ kModFrq portk kfreq, kporttime ;SMOOTH VARIABLE CHANGES
+ aFollow follow2 ain, 0.01, 0.1 ;AMPLITUDE FOLLOWING AUDIO SIGNAL
+ kFollow downsamp aFollow
+ kFollow logcurve kFollow/0dbfs,20
+ kModFrq = kModFrq + (cpsoct(kFollow*kenv*30)) ;CREATE A LEFT CHANNEL MODULATING FREQUENCY BASE ON THE STATIC VALUE CREATED BY kfreq AND THE AMOUNT OF DYNAMIC ENVELOPE FOLLOWING GOVERNED BY kenv
+ aMod poscil 1, kModFrq, isine ;CREATE RING MODULATING SIGNAL
+ aout sum ain*kDry, ain*aMod*kWet ;MIX DRY AND WET SIGNALS
+ xout aout ;SEND AUDIO BACK TO CALLER INSTRUMENT
+endop
diff --git a/data/opcodes/MultiFX/StChorus.udo b/data/opcodes/MultiFX/StChorus.udo
new file mode 100644
index 0000000..e025852
--- /dev/null
+++ b/data/opcodes/MultiFX/StChorus.udo
@@ -0,0 +1,33 @@
+; StChorus
+; ----------------
+; A stereo chorus effect
+;
+; aout StChorus ainL,ainR,krate,kdepth,kwidth
+;
+; Performance
+; -----------
+; ainL -- first/left input audio
+; ainR -- second/right input audio
+; krate -- rate control of the lfo of the effect *NOT IN HERTZ* (range 0 to 1)
+; kdepth -- depth of the lfo of the effect (range 0 to 1)
+; kwidth -- width of stereo widening (range 0 to 1)
+
+
+opcode StChorus,aa,aaKKK
+ ainL,ainR,krate,kdepth,kwidth xin ;READ IN INPUT ARGUMENTS
+ krate expcurve krate,20 ;CREATE AN EXPONENTIAL REMAPPING OF krate
+ krate scale krate,7,0.001 ;RESCALE VALUE
+ ilfoshape ftgentmp 0, 0, 131072, 19, 1, 0.5, 0, 0.5 ;POSITIVE DOMAIN ONLY SINE WAVE
+ kporttime linseg 0,0.001,0.02 ;RAMPING UP PORTAMENTO VARIABLE
+ kChoDepth portk kdepth*0.01, kporttime ;SMOOTH VARIABLE CHANGES WITH PORTK
+ aChoDepth interp kChoDepth ;INTERPOLATE TO CREATE A-RATE VERSION OF K-RATE VARIABLE
+ amodL osciliktp krate, ilfoshape, 0 ;LEFT CHANNEL LFO
+ amodR osciliktp krate, ilfoshape, kwidth*0.5 ;THE PHASE OF THE RIGHT CHANNEL LFO IS ADJUSTABLE
+ amodL = (amodL*aChoDepth)+.01 ;RESCALE AND OFFSET LFO (LEFT CHANNEL)
+ amodR = (amodR*aChoDepth)+.01 ;RESCALE AND OFFSET LFO (RIGHT CHANNEL)
+ aChoL vdelay ainL, amodL*1000, 1.2*1000 ;CREATE VARYING DELAYED / CHORUSED SIGNAL (LEFT CHANNEL)
+ aChoR vdelay ainR, amodR*1000, 1.2*1000 ;CREATE VARYING DELAYED / CHORUSED SIGNAL (RIGHT CHANNEL)
+ aoutL sum aChoL*0.6, ainL*0.6 ;MIX DRY AND WET SIGNAL (LEFT CHANNEL)
+ aoutR sum aChoR*0.6, ainR*0.6 ;MIX DRY AND WET SIGNAL (RIGHT CHANNEL)
+ xout aoutL,aoutR ;SEND AUDIO BACK TO CALLER INSTRUMENT
+endop \ No newline at end of file
diff --git a/data/opcodes/MultiFX/StereoPingPongDelay.udo b/data/opcodes/MultiFX/StereoPingPongDelay.udo
new file mode 100644
index 0000000..3321c90
--- /dev/null
+++ b/data/opcodes/MultiFX/StereoPingPongDelay.udo
@@ -0,0 +1,30 @@
+opcode StereoPingPongDelay, aa, aaKKKKKi
+ aInL, aInR, kdelayTime, kFeedback, kMix, kWidth, kDamp, iMaxDelayTime xin
+
+ iporttime = .1 ;PORTAMENTO TIME
+ kporttime linseg 0, .001, iporttime ;USE OF AN ENVELOPE VALUE THAT QUICKLY RAMPS UP FROM ZERO TO THE REQUIRED VALUE. THIS PREVENTS VARIABLES GLIDING TO THEIR REQUIRED VALUES EACH TIME THE INSTRUMENT IS STARTED
+ kdlt portk kdelayTime, kporttime ;PORTAMENTO IS APPLIED TO THE VARIABLE 'gkdlt'. A NEW VARIABLE 'kdlt' IS CREATED.
+ adlt interp kdlt ;A NEW A-RATE VARIABLE 'adlt' IS CREATED BY INTERPOLATING THE K-RATE VARIABLE 'kdlt'
+
+ ;;;LEFT CHANNEL OFFSET;;;NO FEEDBACK!!;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ abufferL_OS delayr iMaxDelayTime ;CREATE A DELAY BUFFER OF imaxdelay SECONDS DURATION
+ adelsigL_OS deltap3 adlt ;TAP THE DELAY LINE AT adlt SECONDS
+ adelsigL_OS tone adelsigL_OS, kDamp
+ delayw aInL ;WRITE AUDIO SOURCE INTO THE BEGINNING OF THE BUFFER
+
+ ;;;LEFT CHANNEL DELAY;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ abufferL delayr iMaxDelayTime*2 ;CREATE A DELAY BUFFER OF 5 SECONDS DURATION (EQUIVALENT TO THE MAXIMUM DELAY TIME POSSIBLE USING THIS EXAMPLE)
+ adelsigL deltap3 adlt*2 ;TAP THE DELAY LINE AT gkdlt SECONDS
+ adelsigL tone adelsigL, kDamp
+ delayw adelsigL_OS + (adelsigL * kFeedback) ;WRITE AUDIO SOURCE FROM OFFSETTTING DELAY AND FEEDBACK SIGNAL INTO THE BEGINNING OF THE BUFFER
+
+ abufferR delayr iMaxDelayTime*2 ;CREATE A DELAY BUFFER OF 5 SECONDS DURATION (EQUIVALENT TO THE MAXIMUM DELAY TIME POSSIBLE USING THIS EXAMPLE)
+ adelsigR deltap3 adlt*2 ;TAP THE DELAY LINE AT gkdlt SECONDS
+ adelsigR tone adelsigR, kDamp
+ delayw aInR+(adelsigR*kFeedback) ;WRITE AUDIO SOURCE AND FEEDBACK SIGNAL INTO THE BEGINNING OF THE BUFFER
+
+ ;CREATE LEFT AND RIGHT CHANNEL MIXES
+ aOutL sum (adelsigL + adelsigL_OS)* kMix, aInL * (1-kMix), (1 - kWidth) * adelsigR
+ aOutR sum adelsigR * kMix, aInR * (1-kMix), (1 - kWidth) * adelsigL
+ xout aOutL, aOutR ;CREATE A MIX BETWEEN THE WET AND THE DRY SIGNALS AT THE OUTPUT
+endop
diff --git a/data/opcodes/PitchShifterDelay.udo b/data/opcodes/PitchShifterDelay.udo
new file mode 100644
index 0000000..f874883
--- /dev/null
+++ b/data/opcodes/PitchShifterDelay.udo
@@ -0,0 +1,49 @@
+; PitchShifterDelay
+; ----------------
+; A pitch shifter effect that employs delay lines
+;
+; aout PitchShifterDelay ain,ktrans,kdlt,kFB1,kFB2,imaxdlt
+;
+; Initialisation
+; --------------
+; imaxdlt -- maximum delay time (kdlt should not exceed this value)
+;
+; Performance
+; -----------
+; ain -- input audio to be pitch shifted
+; ktrans -- pitch transposition (in semitones)
+; kdlt -- delay time employed by the pitch shifter effect (should be within the range ksmps/sr and imaxdlt)
+; kFB1 -- feedback using method 1 (output from delay taps are fed back directly into their own buffers before enveloping and mixing)
+; kFB2 -- feedback using method 2 (enveloped and mixed output from both taps is fed back into both buffers)
+
+opcode PitchShifterDelay,a,aKKKKi
+ ; setksmps 1 ;UDO ksmps CAN BE SET INDEPENDENTLY OF GLOBAL ksmps
+ ain,ktrans,kdlt,kFB1,kFB2,imaxdlt xin
+ ihalfsine ftgen 0, 0, 1025, 9, 0.5, 1, 0 ;HALF SINE WINDOW FUNCTION USED FOR AMPLITUDE ENVELOPING
+ koctfract = ktrans/12 ;TRANSPOSITION AS FRACTION OF AN OCTAVE
+ kratio = octave(koctfract) ;RATIO TO PRODUCE PITCH SHIFT
+ krate = (kratio-1)/kdlt ;SUBTRACT 1/1 SPEED
+
+ aphase1 phasor -krate ;MOVING PHASE 1-0
+ aphase2 phasor -krate, .5 ;MOVING PHASE 1-0 - PHASE OFFSET BY 180 DEGREES (.5 RADIANS)
+
+ agate1 tablei aphase1, ihalfsine, 1, 0, 1 ;WINDOW FUNC =HALF SINE
+ agate2 tablei aphase2, ihalfsine, 1, 0, 1 ;WINDOW FUNC =HALF SINE
+
+ adlt interp kdlt ;CREATE A RATE (INTERPOLATED FROM K-RATE) VERSION OF kdlt
+ aout init 0 ;INITIALISE OUTPUT AUDIO SIGNAL (NEEDED FOR FEEDBACK SIGNAL (METHOD 2))
+
+ abuffer delayr imaxdlt ;DECLARE DELAY BUFFER
+ adelsig1 deltap3 aphase1 * adlt ;VARIABLE TAP
+ aGatedSig1 = adelsig1 * agate1
+ delayw ain + (aGatedSig1*kFB1) + (aout*kFB2) ;WRITE AUDIO TO THE BEGINNING OF THE DELAY BUFFER, MIX IN FEEDBACK SIGNAL - PROPORTION DEFINED BY gkFB
+
+ abuffer delayr imaxdlt ;DECLARE DELAY BUFFER
+ adelsig2 deltap3 aphase2 * adlt ;VARIABLE TAP
+ aGatedSig2 = adelsig2 * agate2
+ delayw ain + (aGatedSig2*kFB1) + (aout*kFB2) ;WRITE AUDIO TO THE BEGINNING OF THE DELAY BUFFER, MIX IN FEEDBACK SIGNAL - PROPORTION DEFINED BY gkFB
+ aout = (aGatedSig1 + aGatedSig2) * 0.5
+ aout dcblock2 aout ;REMOVE DC OFFSET (DC OFFSET CAN SOMETIMES BE A PROBLEM WHEN BOTH FEEDBACKS ARE COMBINED)
+ xout aout ;SUM AND RESCALE PITCH SHIFTER OUTPUTS (LEFT CHANNEL)
+endop
+
diff --git a/data/opcodes/Utility/Delay1k.udo b/data/opcodes/Utility/Delay1k.udo
new file mode 100644
index 0000000..32f38c0
--- /dev/null
+++ b/data/opcodes/Utility/Delay1k.udo
@@ -0,0 +1,6 @@
+opcode Delay1k,k,k
+kmem init 0
+kin xin
+xout kmem
+kmem = kin
+endop \ No newline at end of file
diff --git a/src/Csound/Typed/Control.hs b/src/Csound/Typed/Control.hs
index 188f9bc..d55042f 100644
--- a/src/Csound/Typed/Control.hs
+++ b/src/Csound/Typed/Control.hs
@@ -22,7 +22,13 @@ module Csound.Typed.Control (
-- * Events
module Csound.Typed.Control.Evt,
-- * Band-limited oscillators
- module Csound.Typed.Control.Vco
+ module Csound.Typed.Control.Vco,
+ -- * Imperative instruments
+ module Csound.Typed.Control.InstrRef,
+ -- * Array folding and traversals
+ module Csound.Typed.Control.ArrayTraverse,
+ -- * Reads global config arguments from command line
+ module Csound.Typed.Control.MacrosArgs
) where
import Csound.Typed.GlobalState.SE
@@ -36,6 +42,9 @@ import Csound.Typed.Control.Osc
import Csound.Typed.Control.Channel
import Csound.Typed.Control.Sf2
import Csound.Typed.Control.Vco
+import Csound.Typed.Control.InstrRef
+import Csound.Typed.Control.ArrayTraverse
+import Csound.Typed.Control.MacrosArgs
import Csound.Typed.Types
import Csound.Typed.GlobalState
@@ -68,7 +77,6 @@ setDur mdt as = toTuple $ do
setDurationForce dt
return vals
-
-- | Gets new id.
freshId :: SE D
freshId = SE $ fmap fromE freeChn
diff --git a/src/Csound/Typed/Control/Api.hs b/src/Csound/Typed/Control/Api.hs
index f2a45e6..7cc2979 100644
--- a/src/Csound/Typed/Control/Api.hs
+++ b/src/Csound/Typed/Control/Api.hs
@@ -7,6 +7,7 @@ module Csound.Typed.Control.Api(
import Data.Boolean
import Control.Monad.Trans.Class
+import Control.Applicative
import qualified Csound.Dynamic as D
import Csound.Dynamic(Rate(..), opcs, depT_)
@@ -16,6 +17,7 @@ import Csound.Typed.Types
import Csound.Typed.Control.Ref
import Csound.Typed.GlobalState
import Csound.Typed.GlobalState.Opcodes(eventi, Event(..), turnoff, port, downsamp)
+import Csound.Typed.InnerOpcodes
import Csound.Typed.Plugins.TabQueue
@@ -96,8 +98,8 @@ trigByNameMidi name instr = do
readRef ref
where go ref x = mixRef ref =<< instr x
-namedMonoMsg :: D -> D -> String -> SE (Sig, Sig)
-namedMonoMsg portTime relTime name = do
+namedMonoMsg ::String -> SE MonoArg
+namedMonoMsg name = do
refPch <- newGlobalRef 0
refVol <- newGlobalRef 0
tab <- newGlobalTab 24
@@ -111,8 +113,11 @@ namedMonoMsg portTime relTime name = do
writeRef refVol 0
pchKey <- readRef refPch
volKey <- readRef refVol
- let resStatus = ifB onFlag 1 0
- return (port' (downsamp' volKey) portTime * port' resStatus relTime, port' (downsamp' pchKey) portTime)
+ let kgate = ifB onFlag 1 0
+ kamp = downsamp' volKey
+ kcps = downsamp' pchKey
+ trig = changed [kamp, kcps]
+ return $ MonoArg kamp kcps kgate trig
where
onNote = tabQueue2_append
offNote tab (pch, vol) = tabQueue2_delete tab pch
diff --git a/src/Csound/Typed/Control/ArrayTraverse.hs b/src/Csound/Typed/Control/ArrayTraverse.hs
new file mode 100644
index 0000000..55407a1
--- /dev/null
+++ b/src/Csound/Typed/Control/ArrayTraverse.hs
@@ -0,0 +1,160 @@
+{-# Language ScopedTypeVariables #-}
+-- | Array traversals and folds
+module Csound.Typed.Control.ArrayTraverse(
+ foreachArr, foreachArrD, forRowArr, forColumnArr, forRowArrD, forColumnArrD,
+ foldArr, foldRowArr, foldColumnArr, foldRowsArrD, foldColumnsArrD
+) where
+
+import Csound.Typed.Types
+import Csound.Typed.Control.Ref
+import Csound.Typed.GlobalState
+import Data.Boolean
+import qualified Csound.Dynamic as D
+
+-------------------------------------------------------------------------
+-- Functional style traversals
+
+whileRefBegin :: SigOrD a => Ref a -> SE ()
+whileRefBegin (Ref vars) = fromDep_ $ D.whileRef $ head vars
+
+-- | Traverses all elements of the array array and applies a procedure to each element.
+-- The procedure takes in a pair of index and the current value at the given index.
+foreachArr :: (Tuple ix, Tuple a) => Arr ix a -> ((ix, a) -> SE ()) -> SE ()
+foreachArr = foreachArrBy getArrayLength
+ where
+ getArrayLength :: Int -> Arr ix a -> Sig
+ getArrayLength n array = lenarray array `withD` (int n)
+
+-- | Traverses all elements of the array at the **init rate** and applies a procedure to each element.
+-- The procedure takes in a pair of index and the current value at the given index.
+foreachArrD :: (Tuple ix, Tuple a) => Arr ix a -> ((ix, a) -> SE ()) -> SE ()
+foreachArrD = foreachArrBy getArrayLength
+ where
+ getArrayLength :: Int -> Arr ix a -> D
+ getArrayLength n array = lenarray array `withD` (int n)
+
+foreachArrBy :: forall a b ix . (OrdB b, IfB b, Num b, SigOrD b, Tuple b, Tuple ix, Tuple a) => (Int -> Arr ix a -> b) -> Arr ix a -> ((ix, a) -> SE ()) -> SE ()
+foreachArrBy getArrayLength array body = do
+ vars <- mapM newCtrlRef $ replicate arity (0 :: b)
+ condVars <- mapM newCtrlRef $ replicate arity (1 :: b)
+ recWhile vars $ zip3 [1 ..] vars condVars
+ where
+ recWhile :: [Ref b] -> [(Int, Ref b, Ref b)] -> SE ()
+ recWhile vars xs = case xs of
+ [] -> do
+ ix <- readRef $ concatRef vars
+ val <- readArr array ix
+ body (ix, val)
+ (n, var, condVar) : rest -> do
+ whileRefBegin condVar
+
+ recWhile vars rest
+
+ modifyRef var (+ 1)
+ ix <- readRef var
+ writeRef condVar (ifB (ix `lessThan` getArrayLength n array) 1 0)
+
+ fromDep_ D.whileEnd
+
+ arity = tupleArity $ proxy array
+
+ proxy :: Arr ix a -> ix
+ proxy = const undefined
+
+ concatRef :: [Ref b] -> Ref ix
+ concatRef vs = Ref $ vs >>= \(Ref xs) -> xs
+
+-- | Traverses all elements in the given row of 2D array at the signal rate and applies a procedure to all elements.
+forRowArr :: (Tuple a) => Sig -> Arr Sig2 a -> ((Sig, a) -> SE ()) -> SE ()
+forRowArr rowId array phi = whileRef 0 cond body
+ where
+ cond ix = return $ ix `lessThan` lenarray array `withD` 2
+
+ body ix = do
+ val <- readArr array (rowId, ix)
+ phi (ix, val)
+ return $ ix + 1
+
+
+-- | Traverses all elements in the given column of 2D array at the signal rate and applies a procedure to all elements.
+forColumnArr :: (Tuple a) => Sig -> Arr Sig2 a -> ((Sig, a) -> SE ()) -> SE ()
+forColumnArr colId array phi = whileRef 0 cond body
+ where
+ cond ix = return $ ix `lessThan` lenarray array `withD` 1
+
+ body ix = do
+ val <- readArr array (ix, colId)
+ phi (ix, val)
+ return $ ix + 1
+
+-- | Traverses all elements in the given row of 2D array at the init rate and applies a procedure to all elements.
+forRowArrD :: Tuple a => D -> Arr D2 a -> ((D, a) -> SE ()) -> SE ()
+forRowArrD rowId array phi = whileRefD 0 cond body
+ where
+ cond ix = return $ ix `lessThan` lenarray array `withD` 2
+
+ body ix = do
+ val <- readArr array (rowId, ix)
+ phi (ix, val)
+ return $ ix + 1
+
+-- | Traverses all elements in the given column of 2D array at the init rate and applies a procedure to all elements.
+forColumnArrD :: Tuple a => D -> Arr D2 a -> ((D, a) -> SE ()) -> SE ()
+forColumnArrD colId array phi = whileRefD 0 cond body
+ where
+ cond ix = return $ ix `lessThan` lenarray array `withD` 1
+
+ body ix = do
+ val <- readArr array (ix, colId)
+ phi (ix, val)
+ return $ ix + 1
+
+-- | Traverses an array and accumulates a value. We invoke the function with accumulator function, initial value and the array.
+foldArr :: (Tuple ix, Tuple a, Tuple b) => ((ix, a) -> b -> SE b) -> b -> Arr ix a -> SE b
+foldArr phi z array = do
+ res <- newRef z
+ foreachArr array (toFoldFun phi res)
+ readRef res
+
+toFoldFun :: Tuple b => (a -> b -> SE b) -> Ref b -> a -> SE ()
+toFoldFun phi ref a = writeRef ref =<< phi a =<< readRef ref
+
+-- | Traverses a row in the array and accumulates a value. We invoke the function
+-- with accumulator function, initial value and the array with signal of the row number.
+--
+-- > foldRowArr accum initValue rowId array
+foldRowArr :: (Tuple a, Tuple b) => ((Sig, a) -> b -> SE b) -> b -> Sig -> Arr Sig2 a -> SE b
+foldRowArr phi z rowId array = do
+ res <- newRef z
+ forRowArr rowId array $ toFoldFun phi res
+ readRef res
+
+-- | Traverses a column in the array and accumulates a value. We invoke the function
+-- with accumulator function, initial value and the array with signal of the row number.
+--
+-- > foldColumnArr accum initValue columnId array
+foldColumnArr :: (Tuple a, Tuple b) => ((Sig, a) -> b -> SE b) -> b -> Sig -> Arr Sig2 a -> SE b
+foldColumnArr phi z rowId array = do
+ res <- newRef z
+ forColumnArr rowId array $ toFoldFun phi res
+ readRef res
+
+-- | Traverses a row at the **init rate** in the array and accumulates a value. We invoke the function
+-- with accumulator function, initial value and the array with signal of the row number.
+--
+-- > foldRowArr accum initValue rowId array
+foldRowsArrD :: (Tuple a, Tuple b) => ((D, a) -> b -> SE b) -> b -> D -> Arr D2 a -> SE b
+foldRowsArrD phi z rowId array = do
+ res <- newRef z
+ forRowArrD rowId array $ toFoldFun phi res
+ readRef res
+
+-- | Traverses a column at the **init rate** in the array and accumulates a value. We invoke the function
+-- with accumulator function, initial value and the array with signal of the row number.
+--
+-- > foldColumnArr accum initValue columnId array
+foldColumnsArrD :: (Tuple a, Tuple b) => ((D, a) -> b -> SE b) -> b -> D -> Arr D2 a -> SE b
+foldColumnsArrD phi z rowId array = do
+ res <- newRef z
+ forColumnArrD rowId array $ toFoldFun phi res
+ readRef res
diff --git a/src/Csound/Typed/Control/Evt.hs b/src/Csound/Typed/Control/Evt.hs
index a06fcaf..94356e0 100644
--- a/src/Csound/Typed/Control/Evt.hs
+++ b/src/Csound/Typed/Control/Evt.hs
@@ -1,11 +1,13 @@
{-# Language FlexibleContexts #-}
module Csound.Typed.Control.Evt(
sched, sched_, schedBy, schedHarp, schedHarpBy,
- retrigs, evtLoop, evtLoopOnce
+ monoSched, monoSchedUntil, monoSchedHarp,
+ retrigs, evtLoop, evtLoopOnce
) where
import System.Mem.StableName
+import Data.Monoid
import Data.Boolean
import Control.Applicative
@@ -22,9 +24,12 @@ import Csound.Typed.GlobalState
import Csound.Typed.GlobalState.Opcodes(primInstrId)
import Csound.Typed.Control.Instr
import Csound.Typed.Control.Mix(Sco)
+import qualified Csound.Typed.GlobalState.InstrApi as I
+import qualified Csound.Typed.GlobalState.Port as I
import Csound.Typed.Control.Ref
import Csound.Typed.Constants(infiniteDur)
+import Csound.Typed.InnerOpcodes
renderEvts :: Evt (Sco a) -> Evt [(D, D, a)]
renderEvts = fmap (fmap unEvt . T.render)
@@ -33,8 +38,7 @@ renderEvts = fmap (fmap unEvt . T.render)
sched :: (Arg a, Sigs b) => (a -> SE b) -> Evt (Sco a) -> b
sched instr evts = apInstr0 $ do
instrId <- saveSourceInstrCachedWithLivenessWatch (funArity instr) (insExp instr)
- saveEvtInstr (arityOuts $ funArity instr) instrId (renderEvts evts)
- where unEvt e = (T.eventStart e, T.eventDur e, T.eventContent e)
+ saveEvtInstr (arityOuts $ funArity instr) instrId (renderEvts evts)
-- | Triggers a procedure on the event stream.
sched_ :: (Arg a) => (a -> SE ()) -> Evt (Sco a) -> SE ()
@@ -268,3 +272,54 @@ samNext = undefined
samLoop :: (Sigs a) => Evt Unit -> a -> a
samLoop = undefined
+-------------------------------------------------------------
+-- monophonic scheduling
+
+-- | Turns
+monoSched :: Evt (Sco (D, D)) -> SE MonoArg
+monoSched evts = evtPort instr evts read
+ where
+ instr ((amp, cps), p) = do
+ (_, _, gate) <- I.readPort p
+ I.writePort p (sig amp, sig cps, gate + 1)
+
+ read :: I.Port (Sig, Sig, Sig) -> SE MonoArg
+ read p = do
+ (amp, cps, gate) <- I.readPort p
+ I.writePort p (amp, cps, 0)
+ return $ MonoArg amp cps (ifB (gate `equalsTo` 0) 0 1) (changed [amp, cps, gate])
+
+runSco :: Arg a => Evt (Sco a) -> ((D,D,a) -> SE ()) -> SE ()
+runSco evts f = runEvt (renderEvts evts) $ mapM_ f
+
+-- | Plays the note until next note comes or something happens on the second event stream.
+monoSchedUntil :: Evt (D, D) -> Evt a -> SE MonoArg
+monoSchedUntil evts stop = do
+ ref <- newRef (MonoArg 0 0 0 0)
+ clearTrig ref
+ runEvt (fmap Left evts <> fmap Right stop) (go ref)
+ readRef ref
+ where
+ go ref = either (ons ref) (const $ offs ref)
+
+ ons ref (amp, cps) =
+ writeRef ref $ MonoArg { monoAmp = sig amp, monoCps = sig cps, monoGate = 1, monoTrig = 1 }
+
+ offs ref = modifyRef ref $ \arg -> arg { monoGate = 0 }
+
+ clearTrig ref = modifyRef ref $ \arg -> arg { monoTrig = 0 }
+
+-- | Plays the note until next note comes
+monoSchedHarp :: Evt (D, D) -> SE MonoArg
+monoSchedHarp evts = monoSchedUntil evts mempty
+
+
+evtPort :: (Arg a, Sigs p) => ((a, I.Port p) -> SE ()) -> Evt (Sco a) -> (I.Port p -> SE b) -> SE b
+evtPort instr evts read = do
+ port <- I.freePort
+ idx <- I.newInstrLinked instr
+ runSco evts $ go idx port
+ read port
+ where
+ go idx port (start,dur,a) = I.event idx (start, dur, (a, port))
+
diff --git a/src/Csound/Typed/Control/Instr.hs b/src/Csound/Typed/Control/Instr.hs
index 3ecf7e1..ac45cff 100644
--- a/src/Csound/Typed/Control/Instr.hs
+++ b/src/Csound/Typed/Control/Instr.hs
@@ -4,13 +4,15 @@ module Csound.Typed.Control.Instr(
funArity, constArity,
insExp, effExp, masterExp, midiExp, unitExp,
apInstr, apInstr0
-) where
+) where
-import Csound.Dynamic(InstrId)
+import Data.Default
+import Csound.Dynamic(InstrId(..))
import qualified Csound.Typed.GlobalState.Elements as C
import Csound.Typed.Types
import Csound.Typed.GlobalState
+import Csound.Typed.GlobalState.Opcodes(primInstrId)
funProxy :: (a -> f b) -> (a, b)
funProxy = const (msg, msg)
@@ -48,4 +50,3 @@ apInstr instrIdGE args = res
apInstr0 :: (Sigs b) => GE InstrId -> b
apInstr0 instrId = apInstr instrId unit
-
diff --git a/src/Csound/Typed/Control/InstrRef.hs b/src/Csound/Typed/Control/InstrRef.hs
new file mode 100644
index 0000000..6b335fb
--- /dev/null
+++ b/src/Csound/Typed/Control/InstrRef.hs
@@ -0,0 +1,97 @@
+-- | Imperative csound instruments
+module Csound.Typed.Control.InstrRef(
+ InstrRef, newInstr, scheduleEvent, turnoff2, negateInstrRef, addFracInstrRef,
+ newOutInstr, noteOn, noteOff
+) where
+
+import Control.Monad
+import Control.Monad.Trans.Class
+
+import Control.Applicative
+import Data.Default
+import Csound.Dynamic(InstrId(..), Rate(..), DepT, depT_, opcs)
+import qualified Csound.Typed.GlobalState.Elements as C
+
+import Csound.Typed.Types
+import Csound.Typed.GlobalState hiding (turnoff2)
+import Csound.Typed.Control.Ref
+
+-- | Fractional part of the instrument dentifier.
+data InstrFrac = InstrFrac
+ { instrFracValue :: D
+ , instrFracSize :: D
+ }
+
+-- | Instrument reference. we can invoke or stop the instrument by the identifier.
+data InstrRef a = InstrRef
+ { instrRefMain :: D
+ , instrRefFrac :: Maybe InstrFrac }
+
+-- | Creates a new instrument and generates a unique identifier.
+newInstr :: (Arg a) => (a -> SE ()) -> SE (InstrRef a)
+newInstr instr = geToSe $ fmap fromInstrId $ saveInstr $ instr toArg
+
+-- | Schedules an event for the instrument.
+--
+-- > scheduleEvent instrRef delay duration args
+--
+-- The arguments for time values are set in seconds.
+scheduleEvent :: (Arg a) => InstrRef a -> D -> D -> a -> SE ()
+scheduleEvent instrRef start end args = SE $ hideGEinDep $ fmap C.event $ C.Event <$> toGE (getInstrId instrRef) <*> toGE start <*> toGE end <*> toNote args
+
+getInstrId :: InstrRef a -> D
+getInstrId (InstrRef value frac) = value + maybe 0 fromFrac frac
+ where
+ fromFrac (InstrFrac value size) = (value * 10 + 1) / (size * 10)
+
+-- | Negates the instrument identifier. This trick is used in Csound to update the instrument arguments while instrument is working.
+negateInstrRef :: InstrRef a -> InstrRef a
+negateInstrRef ref = ref { instrRefMain = negate $ instrRefMain ref }
+
+-- | Adds fractional part to the instrument reference. This trick is used in Csound to identify the notes (or specific instrument invokation).
+addFracInstrRef :: D -> D -> InstrRef a -> InstrRef a
+addFracInstrRef maxSize value instrRef = instrRef { instrRefFrac = Just (InstrFrac value maxSize) }
+
+fromInstrId :: InstrId -> InstrRef a
+fromInstrId x = case x of
+ InstrId frac ceil -> InstrRef (int ceil) Nothing
+ InstrLabel _ -> error "No reference for string instrument id. (Csound.Typed.Control.Instr.hs: fromInstrId)"
+
+-- | Creates an insturment that produces a value.
+newOutInstr :: (Arg a, Sigs b) => (a -> SE b) -> SE (InstrRef a, b)
+newOutInstr f = do
+ ref <- newClearableGlobalRef 0
+ instrId <- newInstr $ \a -> mixRef ref =<< f a
+ aout <- readRef ref
+ return (instrId, aout)
+
+-- | Triggers a note with fractional instrument reference. We can later stop the instrument on specific note with function @noteOff@.
+noteOn :: (Arg a) => D -> D -> InstrRef a -> a -> SE ()
+noteOn maxSize noteId instrId args = scheduleEvent (addFracInstrRef maxSize noteId instrId) 0 (-1) args
+
+-- | Stops a note with fractional instrument reference.
+noteOff :: (Default a, Arg a) => D -> D -> InstrRef a -> SE ()
+noteOff maxSize noteId instrId = scheduleEvent (negateInstrRef $ addFracInstrRef maxSize noteId instrId) 0 0.01 def
+
+-- | Turns off the note played on the given instrument.
+-- Use fractional instrument reference to turn off specific instance.
+--
+-- > turnoff2 instrRef mode releaseTime
+--
+-- The mode is sum of the following values:
+--
+-- * 0, 1, or 2: turn off all instances (0), oldest only (1), or newest only (2)
+--
+-- * 4: only turn off notes with exactly matching (fractional) instrument number, rather than ignoring fractional part
+--
+-- * 8: only turn off notes with indefinite duration (idur < 0 or MIDI)
+--
+-- @releaseTime@ if non-zero, the turned off instances are allowed to release, otherwise are deactivated immediately (possibly resulting in clicks).
+turnoff2 :: InstrRef a -> Sig -> Sig -> SE ()
+turnoff2 instrRef kmode krelease = go (sig $ getInstrId instrRef) kmode krelease
+ where
+ go :: Sig -> Sig -> Sig -> SE ()
+ go instr mode release = SE $ join $ lift $ csdTurnoff2 <$> (toGE instr) <*> (toGE mode) <*> (toGE release)
+
+ csdTurnoff2 :: Monad m => E -> E -> E -> DepT m ()
+ csdTurnoff2 instrId mode release = depT_ $ opcs "turnoff2" [(Xr, [Kr, Kr, Kr])] [instrId, mode, release] \ No newline at end of file
diff --git a/src/Csound/Typed/Control/MacrosArgs.hs b/src/Csound/Typed/Control/MacrosArgs.hs
new file mode 100644
index 0000000..d090e4f
--- /dev/null
+++ b/src/Csound/Typed/Control/MacrosArgs.hs
@@ -0,0 +1,18 @@
+-- | Defines functions to read global arguments from the command line as macros with D flag.
+module Csound.Typed.Control.MacrosArgs(
+ readMacrosString, readMacrosDouble, readMacrosInt
+) where
+
+import qualified Csound.Dynamic as D
+
+import Csound.Typed.Types
+import qualified Csound.Typed.GlobalState as G(readMacrosString, readMacrosDouble, readMacrosInt)
+
+readMacrosString :: String -> String -> Str
+readMacrosString name value = fromGE $ G.readMacrosString name value
+
+readMacrosDouble :: String -> Double -> D
+readMacrosDouble name value = fromGE $ G.readMacrosDouble name value
+
+readMacrosInt :: String -> Int -> D
+readMacrosInt name value = fromGE $ G.readMacrosInt name value
diff --git a/src/Csound/Typed/Control/Mix.hs b/src/Csound/Typed/Control/Mix.hs
index b6600e8..2e34106 100644
--- a/src/Csound/Typed/Control/Mix.hs
+++ b/src/Csound/Typed/Control/Mix.hs
@@ -1,13 +1,17 @@
-{-# Language FlexibleContexts #-}
+{-# Language FlexibleContexts, ScopedTypeVariables #-}
module Csound.Typed.Control.Mix(
Mix,
- sco, eff, mix, mixBy,
+ sco, eff, mix, mixBy, monoSco,
sco_, mix_, mixBy_,
Sco, CsdEventList(..), CsdEvent
) where
+import Data.Boolean
+
import Control.Applicative
import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
+import Control.Monad
import Data.Traversable
import System.Mem.StableName
@@ -20,6 +24,7 @@ import Csound.Typed.Types
import Csound.Typed.Types.MixSco
import Csound.Typed.GlobalState hiding (notes)
import Csound.Typed.Control.Instr
+import Csound.Typed.InnerOpcodes
toCsdEventList :: Sco a -> CsdEventList a
toCsdEventList = id
@@ -75,6 +80,25 @@ eff ef sigs = wrapSco sigs $ \events -> do
instrId <- saveEffectInstr (funArity ef) (effExp ef)
return $ Eff instrId notes (arityIns $ funArity ef)
+-- | Plays a bunch of notes with the given monophonic instrument. See details on type @MonoArg@.
+-- The scores contain the pairs of amplitude (0 to 1) and frequency (in Hz).
+--
+-- > res = monoSco instrument scores
+monoSco :: forall a . Sigs a => (MonoArg -> SE a) -> Sco (D, D) -> Sco (Mix a)
+monoSco instr notes = wrapSco notes $ \events -> do
+ events' <- traverse toNote events
+ argId <- saveSourceInstrCached_ (unitExp $ fmap (const unit) $ instrMonoArg toArg)
+ instrId <- saveEffectInstr ((funArity instr) { arityIns = 3 }) (effExp effInstr)
+ return $ MonoSnd instrId argId events'
+ where
+ instrMonoArg :: ((D, D), Port Sig3) -> SE ()
+ instrMonoArg ((amp, cps), port) =
+ modifyPort port $ \(_, _, notnum) -> (sig amp, sig cps, notnum + 1)
+
+ effInstr :: Sigs a => (Sig, Sig, Sig) -> SE a
+ effInstr (amp, cps, notnum) = instr (MonoArg amp cps gate (changed [amp, cps, gate]))
+ where gate = ifB (notnum ==* 0) 0 1
+
-- | Renders a scores to the sound signals. we can use it inside the other instruments.
mix :: (Sigs a) => Sco (Mix a) -> a
mix a = flip apInstr unit $ do
diff --git a/src/Csound/Typed/Control/Osc.hs b/src/Csound/Typed/Control/Osc.hs
index b25e7bd..3ffd9ff 100644
--- a/src/Csound/Typed/Control/Osc.hs
+++ b/src/Csound/Typed/Control/Osc.hs
@@ -2,10 +2,12 @@
{-# Language ScopedTypeVariables #-}
module Csound.Typed.Control.Osc(
OscRef, OscHost, OscPort, OscAddress, OscType,
- initOsc, listenOsc, sendOsc
+ initOsc, listenOsc, sendOsc,
+ OscVal, listenOscVal
) where
import Data.Boolean ((==*))
+import Csound.Dynamic(Rate(..))
import Csound.Typed.Types
import Csound.Typed.GlobalState hiding (oscInit, oscListen, oscSend)
@@ -33,16 +35,11 @@ type OscType = String
type OscHost = String
-- | Initializes host client. The process starts to run in the background.
-initOsc :: OscPort -> SE OscRef
-initOsc port = do
- oscRef <- fmap fromGE $ fromDep $ C.oscInit (fromIntegral port)
- varRef <- newGlobalRef (0 :: D)
- writeRef varRef oscRef
- ihandle <- readRef varRef
- return $ OscRef ihandle
+initOsc :: OscPort -> OscRef
+initOsc port = OscRef $ fromGE $ getOscPortHandle port
-- | Listens for the OSC-messages. The first argument is OSC-reference.
--- We can create it with the function @oscInit@. The next two arguments are strings.
+-- We can create it with the function @initOsc@. The next two arguments are strings.
-- The former specifies the path-like address to listen the messages. It can be:
--
-- > /foo/bar/baz
@@ -57,28 +54,32 @@ initOsc port = do
--
-- > runEvt :: Evt a -> (a -> SE ()) -> SE ()
listenOsc :: forall a . Tuple a => OscRef -> OscAddress -> OscType -> Evt a
-listenOsc oscRef oscAddr oscType = Evt $ \bam -> do
- (readCond, writeCond) <- sensorsSE (0 :: Sig)
- resRef <- newRef (defTuple :: a)
- writeCond =<< listen resRef
- readCond >>= (\cond -> whileDo (cond ==* 1) $ do
- bam =<< readRef resRef
- writeCond =<< listen resRef)
+listenOsc oscRef oscAddr oscType = Evt $ \bam -> do
+ resRef <- initOscRef oscType
+ cond <- listen resRef
+ when1 cond $ bam =<< readRef resRef
where
- listen :: Tuple a => Ref a -> SE Sig
- listen ref = csdOscListen ref oscRef oscAddr oscType
+ listen :: Tuple a => Ref a -> SE BoolSig
+ listen ref = fmap (==* 1) $ csdOscListen ref oscRef oscAddr oscType
csdOscListen :: Tuple a => Ref a -> OscRef -> OscAddress -> OscType -> SE Sig
- csdOscListen resRef oscHandle addr ty = do
- args <- readRef resRef
- res <- fmap fromGE $ fromDep $ hideGEinDep $ do
- expArgs <- fromTuple args
+ csdOscListen (Ref refVars) oscHandle addr ty =
+ fmap fromGE $ fromDep $ hideGEinDep $ do
expOscHandle <- toGE $ unOscRef oscHandle
expAddr <- toGE $ text addr
expOscType <- toGE $ text ty
- return $ C.oscListen $ expOscHandle : expAddr : expOscType : expArgs
- writeRef resRef args
- return res
+ return $ C.oscListen expOscHandle expAddr expOscType refVars
+
+ initOscRef :: OscType -> SE (Ref a)
+ initOscRef typeStr = fmap Ref $ newLocalVars (fmap getOscRate typeStr) (fromTuple $ (defTuple :: a))
+
+ getOscRate :: Char -> Rate
+ getOscRate x = case x of
+ 'a' -> Ar
+ 's' -> Sr
+ 'i' -> Kr
+ 'f' -> Kr
+ _ -> Kr
-- | Sends OSC-messages. It takes in a name of the host computer
-- (empty string is alocal machine), port on which the target
@@ -96,3 +97,58 @@ sendOsc host port addr ty evts = runEvt evts send
expTy <- toGE $ text $ ty
return $ C.oscSend $ 1 : expHost : expPort : expAddr : expTy : args
+
+class Tuple a => OscVal a where
+ getOscTypes :: a -> String
+ getOscRef :: a -> SE (Ref a)
+
+instance OscVal Sig where
+ getOscTypes = const "f"
+ getOscRef = newCtrlRef
+
+instance OscVal Str where
+ getOscTypes = const "s"
+ getOscRef = newRef
+
+instance (OscVal a, OscVal b) => OscVal (a, b) where
+ getOscTypes (a, b) = getOscTypes a ++ getOscTypes b
+ getOscRef (a, b) = do
+ refA <- getOscRef a
+ refB <- getOscRef b
+ return $ concatRef refA refB
+
+instance (OscVal a, OscVal b, OscVal c) => OscVal (a, b, c) where
+ getOscTypes (a, b, c) = getOscTypes a ++ getOscTypes b ++ getOscTypes c
+ getOscRef (a, b, c) = do
+ refA <- getOscRef a
+ refB <- getOscRef b
+ refC <- getOscRef c
+ return $ concatRef3 refA refB refC
+
+instance (OscVal a, OscVal b, OscVal c, OscVal d) => OscVal (a, b, c, d) where
+ getOscTypes (a, b, c, d) = getOscTypes a ++ getOscTypes b ++ getOscTypes c ++ getOscTypes d
+ getOscRef (a, b, c, d) = do
+ refA <- getOscRef a
+ refB <- getOscRef b
+ refC <- getOscRef c
+ refD <- getOscRef d
+ return $ concatRef4 refA refB refC refD
+
+instance (OscVal a, OscVal b, OscVal c, OscVal d, OscVal e) => OscVal (a, b, c, d, e) where
+ getOscTypes (a, b, c, d, e) = getOscTypes a ++ getOscTypes b ++ getOscTypes c ++ getOscTypes d ++ getOscTypes e
+ getOscRef (a, b, c, d, e) = do
+ refA <- getOscRef a
+ refB <- getOscRef b
+ refC <- getOscRef c
+ refD <- getOscRef d
+ refE <- getOscRef e
+ return $ concatRef5 refA refB refC refD refE
+
+-- | Listens for tuples of continuous signals read from OSC-channel.
+--
+-- > listenOscVal ref address initValue
+listenOscVal :: (Tuple a, OscVal a) => OscRef -> String -> a -> SE a
+listenOscVal port path initVal = do
+ ref <- getOscRef initVal
+ runEvt (listenOsc port path (getOscTypes initVal)) $ \a -> writeRef ref a
+ readRef ref
diff --git a/src/Csound/Typed/Control/Ref.hs b/src/Csound/Typed/Control/Ref.hs
index fd96877..5ed1668 100644
--- a/src/Csound/Typed/Control/Ref.hs
+++ b/src/Csound/Typed/Control/Ref.hs
@@ -1,20 +1,28 @@
+{-# Language ScopedTypeVariables, FlexibleContexts #-}
module Csound.Typed.Control.Ref(
- Ref, writeRef, readRef, newRef, mixRef, modifyRef, sensorsSE, newGlobalRef,
+ Ref(..), writeRef, readRef, newRef, mixRef, modifyRef, sensorsSE, newGlobalRef,
+ concatRef, concatRef3, concatRef4, concatRef5,
newCtrlRef, newGlobalCtrlRef,
- globalSensorsSE, newClearableGlobalRef, newTab, newGlobalTab
+ globalSensorsSE, newClearableGlobalRef, newTab, newGlobalTab,
+ -- conditionals
+ whileRef, whileRefD
) where
+import Data.Boolean
import Control.DeepSeq(deepseq)
import Control.Monad
+import Control.Applicative
import Control.Monad.Trans.Class
-import Csound.Dynamic hiding (newLocalVars)
+import Csound.Dynamic hiding (when1, newLocalVars, writeArr, readArr, whileRef)
import Csound.Typed.Types.Prim
import Csound.Typed.Types.Tuple
import Csound.Typed.GlobalState.SE
import Csound.Typed.GlobalState.GE
+import qualified Csound.Dynamic as D
+
-- | It describes a reference to mutable values.
newtype Ref a = Ref [Var]
{-
@@ -44,13 +52,25 @@ newRef t = fmap Ref $ newLocalVars (tupleRates t) (fromTuple t)
-- It contains control signals (k-rate) and constants for numbers (i-rates).
newCtrlRef :: Tuple a => a -> SE (Ref a)
newCtrlRef t = fmap Ref $ newLocalVars (fmap toCtrlRate $ tupleRates t) (fromTuple t)
- where
toCtrlRate x = case x of
Ar -> Kr
Kr -> Ir
_ -> x
+concatRef :: (Tuple a, Tuple b) => Ref a -> Ref b -> Ref (a, b)
+concatRef (Ref a) (Ref b) = Ref (a ++ b)
+
+concatRef3 :: (Tuple a, Tuple b, Tuple c) => Ref a -> Ref b -> Ref c -> Ref (a, b, c)
+concatRef3 (Ref a) (Ref b) (Ref c) = Ref (a ++ b ++ c)
+
+concatRef4 :: (Tuple a, Tuple b, Tuple c, Tuple d) => Ref a -> Ref b -> Ref c -> Ref d -> Ref (a, b, c, d)
+concatRef4 (Ref a) (Ref b) (Ref c) (Ref d) = Ref (a ++ b ++ c ++ d)
+
+concatRef5 :: (Tuple a, Tuple b, Tuple c, Tuple d, Tuple e) => Ref a -> Ref b -> Ref c -> Ref d -> Ref e -> Ref (a, b, c, d, e)
+concatRef5 (Ref a) (Ref b) (Ref c) (Ref d) (Ref e) = Ref (a ++ b ++ c ++ d ++ e)
+
+
-- | Adds the given signal to the value that is contained in the
-- reference.
mixRef :: (Num a, Tuple a) => Ref a -> a -> SE ()
@@ -149,4 +169,58 @@ ftgenonce b1 b2 b3 b4 b5 b6 = fmap ( Tab . return) $ SE $ (depT =<<) $ lift $ f
-- csound doc: <http://www.csounds.com/manual/html/ftgentmp.html>
ftgentmp :: D -> D -> D -> D -> D -> [D] -> SE Tab
ftgentmp b1 b2 b3 b4 b5 b6 = fmap ( Tab . return) $ SE $ (depT =<<) $ lift $ f <$> unD b1 <*> unD b2 <*> unD b3 <*> unD b4 <*> unD b5 <*> mapM unD b6
- where f a1 a2 a3 a4 a5 a6 = opcs "ftgentmp" [(Ir,(repeat Ir))] ([a1,a2,a3,a4,a5] ++ a6) \ No newline at end of file
+ where f a1 a2 a3 a4 a5 a6 = opcs "ftgentmp" [(Ir,(repeat Ir))] ([a1,a2,a3,a4,a5] ++ a6)
+
+------------------------------------------------
+
+{-
+whileSE :: SE BoolSig -> SE () -> SE ()
+whileSE mcond body = do
+ ref <- newCtrlRef $ (0 :: Sig)
+ writeCond ref
+ whileRefBegin ref
+ body
+ writeCond ref
+ whileRefEnd
+ where
+ writeCond :: Ref Sig -> SE ()
+ writeCond ref = writeRef ref =<< fmap (\x -> ifB x 1 0) mcond
+
+-- ifBegin :: BoolSig -> SE ()
+-- ifBegin a = fromDep_ $ D.ifBegin Kr =<< lift (toGE a)
+
+whileRefBegin :: Ref Sig -> SE ()
+whileRefBegin (Ref [var]) = fromDep_ $ D.whileBegin ((D.prim $ D.PrimVar D.Kr var) ==* 1)
+
+whileRefEnd :: SE ()
+whileRefEnd = fromDep_ D.whileEnd
+-}
+--------------------------------------------------------------------
+
+whileRef :: forall st . Tuple st => st -> (st -> SE BoolSig) -> (st -> SE st) -> SE ()
+whileRef initVal cond body = do
+ refSt <- newCtrlRef initVal
+ refCond <- newRef =<< condSig =<< readRef refSt
+ whileRefBegin refCond
+ writeRef refSt =<< body =<< readRef refSt
+ writeRef refCond =<< condSig =<< readRef refSt
+ fromDep_ whileEnd
+ where
+ condSig :: st -> SE Sig
+ condSig = fmap (\b -> ifB b 1 0) . cond
+
+
+whileRefD :: forall st . Tuple st => st -> (st -> SE BoolD) -> (st -> SE st) -> SE ()
+whileRefD initVal cond body = do
+ refSt <- newCtrlRef initVal
+ refCond <- newRef =<< condSig =<< readRef refSt
+ whileRefBegin refCond
+ writeRef refSt =<< body =<< readRef refSt
+ writeRef refCond =<< condSig =<< readRef refSt
+ fromDep_ whileEnd
+ where
+ condSig :: st -> SE D
+ condSig = fmap (\b -> ifB b 1 0) . cond
+
+whileRefBegin :: SigOrD a => Ref a -> SE ()
+whileRefBegin (Ref vars) = fromDep_ $ D.whileRef $ head vars
diff --git a/src/Csound/Typed/GlobalState.hs b/src/Csound/Typed/GlobalState.hs
index b68bdf9..a4e32e5 100644
--- a/src/Csound/Typed/GlobalState.hs
+++ b/src/Csound/Typed/GlobalState.hs
@@ -4,6 +4,7 @@ module Csound.Typed.GlobalState (
module Csound.Typed.GlobalState.SE,
module Csound.Typed.GlobalState.Instr,
module Csound.Typed.GlobalState.Cache,
+ module Csound.Typed.GlobalState.Port,
-- * Reexports dynamic
BandLimited(..), readBandLimited, readHardSyncBandLimited, renderBandLimited,
Instrs(..), IdMap(..), getInstrIds,
@@ -31,3 +32,4 @@ import Csound.Typed.GlobalState.Instr
import Csound.Typed.GlobalState.Cache
import Csound.Typed.GlobalState.Elements
import Csound.Typed.GlobalState.Opcodes
+import Csound.Typed.GlobalState.Port
diff --git a/src/Csound/Typed/GlobalState/Elements.hs b/src/Csound/Typed/GlobalState/Elements.hs
index fad0c58..3b2f75a 100644
--- a/src/Csound/Typed/GlobalState/Elements.hs
+++ b/src/Csound/Typed/GlobalState/Elements.hs
@@ -17,7 +17,8 @@ module Csound.Typed.GlobalState.Elements(
-- * Midi
MidiType(..), Channel, MidiMap, MidiKey(..), saveMidiInstr,
-- * Global variables
- Globals(..), newPersistentGlobalVar, newClearableGlobalVar,
+ Globals(..), newPersistentGlobalVar, newClearableGlobalVar,
+ newPersistentGloabalArrVar,
renderGlobals,
-- * Instruments
Instrs(..), saveInstr, getInstrIds, -- newInstrId, saveInstrById, saveInstr, CacheName, makeCacheName, saveCachedInstr, getInstrIds,
@@ -28,11 +29,20 @@ module Csound.Typed.GlobalState.Elements(
Event(..),
ChnRef(..), chnRefFromParg, chnRefAlloc, readChn, writeChn, chnUpdateUdo,
subinstr, subinstr_, event_i, event, safeOut, autoOff, changed,
+ -- * OSC listen ports
+ OscListenPorts, getOscPortVar,
+ -- * Macros inits
+ MacrosInits, MacrosInit(..), initMacros,
-- * Udo plugins
UdoPlugin, addUdoPlugin, getUdoPluginNames,
tabQueuePlugin, tabQueue2Plugin,
zdfPlugin, solinaChorusPlugin, audaciouseqPlugin, adsr140Plugin,
- diodePlugin, korg35Plugin, zeroDelayConvolutionPlugin
+ diodePlugin, korg35Plugin, zeroDelayConvolutionPlugin,
+ pitchShifterDelayPlugin,
+ analogDelayPlugin, distortionPlugin, envelopeFolollowerPlugin, flangerPlugin, freqShifterPlugin,
+ loFiPlugin, panTremPlugin, monoTremPlugin, phaserPlugin, pitchShifterPlugin, reversePlugin,
+ ringModulatorPlugin, stChorusPlugin, stereoPingPongDelayPlugin,
+ delay1kPlugin,
) where
import Data.List
@@ -80,11 +90,11 @@ newIdMapId = state $ \s ->
type GenMap = IdMap Gen
-newGen :: Gen -> State GenMap E
-newGen = fmap int . saveGenId
+newGen :: Gen -> State GenMap Int
+newGen = saveGenId
-newTabOfGens :: [Gen] -> State GenMap E
-newTabOfGens = fmap int . (saveGenId . intTab =<<) . mapM saveGenId
+newTabOfGens :: [Gen] -> State GenMap Int
+newTabOfGens = (saveGenId . intTab =<<) . mapM saveGenId
where intTab ns = Gen (length ns) (IntGenId (-2)) (fmap fromIntegral ns) Nothing
saveGenId :: Ord a => a -> State (IdMap a) Int
@@ -333,10 +343,13 @@ data Globals = Globals
, globalsVars :: [AllocVar] }
data AllocVar = AllocVar
- { allocVarType :: GlobalVarType
- , allocVar :: Var
- , allocVarInit :: E
- }
+ { allocVarType :: GlobalVarType
+ , allocVar :: Var
+ , allocVarInit :: E }
+ | AllocArrVar
+ { allocArrVar :: Var
+ , allocArrVarSizes :: [E] }
+
data GlobalVarType = PersistentGlobalVar | ClearableGlobalVar
deriving (Eq)
@@ -357,15 +370,35 @@ newPersistentGlobalVar = newGlobalVar PersistentGlobalVar
newClearableGlobalVar :: Rate -> E -> State Globals Var
newClearableGlobalVar = newGlobalVar ClearableGlobalVar
-
+
+newPersistentGloabalArrVar :: Rate -> [E] -> State Globals Var
+newPersistentGloabalArrVar rate sizes = state $ \s ->
+ let newId = globalsNewId s
+ var = Var GlobalVar rate ('g' : show newId)
+ s1 = s { globalsNewId = succ newId
+ , globalsVars = AllocArrVar var sizes : globalsVars s }
+ in (var, s1)
+
renderGlobals :: Monad m => Globals -> (DepT m (), DepT m ())
renderGlobals a = (initAll, clear)
where
- initAll = mapM_ (\x -> initVar (allocVar x) (allocVarInit x)) gs
- clear = mapM_ (\x -> writeVar (allocVar x) (allocVarInit x)) clearable
- clearable = filter ((== ClearableGlobalVar) . allocVarType) gs
+ initAll = mapM_ initAlloc gs
+ clear = mapM_ clearAlloc clearable
+ clearable = filter isClearable gs
gs = globalsVars a
+ initAlloc x = case x of
+ AllocVar _ var init -> initVar var init
+ AllocArrVar var sizes -> initArr var sizes
+
+ clearAlloc x = case x of
+ AllocVar _ var init -> writeVar var init
+ AllocArrVar _ _ -> return ()
+
+ isClearable x = case x of
+ AllocVar ty _ _ -> ty == ClearableGlobalVar
+ _ -> False
+
-----------------------------------------------------------------
-- instrs
@@ -491,6 +524,41 @@ chnPargId arityIns = 4 + arityIns
-- guis
+--------------------------------------------------------
+-- Osc listeners
+
+newtype OscListenPorts = OscListenPorts { unOscListenPorts :: IM.IntMap Var }
+
+instance Default OscListenPorts where
+ def = OscListenPorts IM.empty
+
+getOscPortVar :: Int -> State (OscListenPorts, Globals) Var
+getOscPortVar port = state $ \st@(OscListenPorts m, globals) -> case IM.lookup port m of
+ Just a -> (a, st)
+ Nothing -> onNothing port m globals
+ where
+ onNothing port m globals = (var, (OscListenPorts m1, newGlobals))
+ where
+ (var, newGlobals) = runState (allocOscPortVar port) globals
+ m1 = IM.insert port var m
+
+
+allocOscPortVar :: Int -> State Globals Var
+allocOscPortVar oscPort = newGlobalVar PersistentGlobalVar Ir $ oscInit (fromIntegral oscPort)
+
+----------------------------------------------------------
+-- macros arguments
+
+type MacrosInits = M.Map String MacrosInit
+
+data MacrosInit
+ = MacrosInitDouble { macrosInitName :: String, macrosInitValueDouble :: Double }
+ | MacrosInitString { macrosInitName :: String, macrosInitValueString :: String }
+ | MacrosInitInt { macrosInitName :: String, macrosInitValueInt :: Int }
+ deriving (Show, Eq, Ord)
+
+initMacros :: MacrosInit -> State MacrosInits ()
+initMacros macrosInit = modify $ \xs -> M.insert (macrosInitName macrosInit) macrosInit xs
--------------------------------------------------------
-- Udo plugins
@@ -518,3 +586,21 @@ adsr140Plugin = UdoPlugin "adsr140" -- adsr with retriggering
diodePlugin = UdoPlugin "diode" -- diode ladder filter
korg35Plugin = UdoPlugin "korg35" -- korg 35 filter
zeroDelayConvolutionPlugin = UdoPlugin "zero-delay-convolution" -- zero delay convolutio by Victor Lazzarini
+pitchShifterDelayPlugin = UdoPlugin "PitchShifterDelay" -- pitch shifter delay
+
+analogDelayPlugin = UdoPlugin "MultiFX/AnalogDelay"
+distortionPlugin = UdoPlugin "MultiFX/Distortion"
+envelopeFolollowerPlugin = UdoPlugin "MultiFX/EnvelopeFollower"
+flangerPlugin = UdoPlugin "MultiFX/Flanger"
+freqShifterPlugin = UdoPlugin "MultiFX/FreqShifter"
+loFiPlugin = UdoPlugin "MultiFX/LoFi"
+panTremPlugin = UdoPlugin "MultiFX/PanTrem"
+monoTremPlugin = UdoPlugin "MultiFX/MonoTrem"
+phaserPlugin = UdoPlugin "MultiFX/Phaser"
+pitchShifterPlugin = UdoPlugin "MultiFX/PitchShifter"
+reversePlugin = UdoPlugin "MultiFX/Reverse"
+ringModulatorPlugin = UdoPlugin "MultiFX/RingModulator"
+stChorusPlugin = UdoPlugin "MultiFX/StChorus"
+stereoPingPongDelayPlugin = UdoPlugin "MultiFX/StereoPingPongDelay"
+
+delay1kPlugin = UdoPlugin "Utility/Delay1k"
diff --git a/src/Csound/Typed/GlobalState/GE.hs b/src/Csound/Typed/GlobalState/GE.hs
index 7daa84b..3c7889e 100644
--- a/src/Csound/Typed/GlobalState/GE.hs
+++ b/src/Csound/Typed/GlobalState/GE.hs
@@ -17,6 +17,7 @@ module Csound.Typed.GlobalState.GE(
-- * Notes
addNote,
-- * GEN routines
+ GenId,
saveGen, saveTabs, getNextGlobalGenId,
saveWriteGen, saveWriteTab,
-- * Sf2
@@ -33,6 +34,10 @@ module Csound.Typed.GlobalState.GE(
guiInstrExp,
listenKeyEvt, Key(..), KeyEvt(..), Guis(..),
getKeyEventListener,
+ -- * OSC
+ getOscPortHandle,
+ -- * Macros
+ MacrosInit(..), readMacrosDouble, readMacrosString, readMacrosInt,
-- * Cabbage Guis
cabbage,
-- * Hrtf pan
@@ -55,7 +60,8 @@ import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Reader
-import Csound.Dynamic
+import Csound.Dynamic hiding (readMacrosDouble, readMacrosString, readMacrosInt)
+import qualified Csound.Dynamic as D(readMacrosDouble, readMacrosString, readMacrosInt)
import Csound.Typed.GlobalState.Options
import Csound.Typed.GlobalState.Cache
@@ -117,10 +123,12 @@ data History = History
, bandLimitedMap :: BandLimitedMap
, cache :: Cache GE
, guis :: Guis
- , cabbageGui :: Maybe Cabbage.Lang }
+ , oscListenPorts :: OscListenPorts
+ , cabbageGui :: Maybe Cabbage.Lang
+ , macrosInits :: MacrosInits }
instance Default History where
- def = History def def def def def def def def def def def def def def def (return ()) def def def def
+ def = History def def def def def def def def def def def def def def def (return ()) def def def def def def
data Msg = Msg
data MidiAssign = MidiAssign MidiType Channel InstrId
@@ -174,7 +182,7 @@ saveStr = fmap prim . onStringMap . newString
getNextGlobalGenId :: GE Int
getNextGlobalGenId = onHistory globalGenCounter (\a h -> h{ globalGenCounter = a }) nextGlobalGenCounter
-saveGen :: Gen -> GE E
+saveGen :: Gen -> GE Int
saveGen = onGenMap . newGen
onGenMap = onHistory genMap (\val h -> h{ genMap = val })
@@ -188,7 +196,7 @@ saveWriteTab = onWriteGenMap . newWriteTab
onWriteGenMap = onHistory writeGenMap (\val h -> h{ writeGenMap = val })
saveTabs :: [Gen] -> GE E
-saveTabs = onGenMap . newTabOfGens
+saveTabs = onGenMap . fmap int . newTabOfGens
onSfMap :: State SfMap a -> GE a
onSfMap = onHistory sfMap (\val h -> h{ sfMap = val })
@@ -520,6 +528,14 @@ getKeyEventListener = do
return $ Just (Instr keyEventInstrId body)
-----------------------------------------------
+-- osc port listen
+
+getOscPortHandle :: Int -> GE E
+getOscPortHandle port = onOscPorts (fmap inlineVar $ getOscPortVar port)
+ where
+ onOscPorts = onHistory (\h -> (oscListenPorts h, globals h)) (\(ports, gs) h -> h { oscListenPorts = ports, globals = gs })
+
+-----------------------------------------------
-- cabbage
cabbage :: Cabbage.Cab -> GE ()
@@ -549,6 +565,24 @@ hrtfFileNames sr = liftA2 (,) (getDataFileName (name "left" sr)) (getDataFileNam
where name dir n = concat ["data/hrtf-", show n, "-", dir, ".dat"]
-----------------------------------------------
+-- read macros
+
+readMacrosDouble :: String -> Double -> GE E
+readMacrosDouble = readMacrosBy D.readMacrosDouble MacrosInitDouble
+
+readMacrosString :: String -> String -> GE E
+readMacrosString = readMacrosBy D.readMacrosString MacrosInitString
+
+readMacrosInt :: String -> Int -> GE E
+readMacrosInt = readMacrosBy D.readMacrosInt MacrosInitInt
+
+readMacrosBy :: (String -> E) -> (String -> a -> MacrosInit) -> String -> a -> GE E
+readMacrosBy reader allocator name initValue = do
+ onMacrosInits $ initMacros $ allocator name initValue
+ return $ reader name
+ where onMacrosInits = onHistory macrosInits (\val h -> h { macrosInits = val })
+
+-----------------------------------------------
-- udo plugins
addUdoPlugin :: UdoPlugin -> GE ()
diff --git a/src/Csound/Typed/GlobalState/InstrApi.hs b/src/Csound/Typed/GlobalState/InstrApi.hs
new file mode 100644
index 0000000..a1824af
--- /dev/null
+++ b/src/Csound/Typed/GlobalState/InstrApi.hs
@@ -0,0 +1,74 @@
+{-# Language ScopedTypeVariables #-}
+module Csound.Typed.GlobalState.InstrApi(
+ InstrId, event, eventi,
+ newInstr, newInstrLinked,
+ turnoff, turnoff2
+) where
+
+import Control.Monad
+import Control.Monad.Trans.Class
+
+import Csound.Dynamic hiding (InstrId, when1)
+import Csound.Typed.GlobalState.Instr
+import Csound.Typed.GlobalState.GE
+import Csound.Typed.GlobalState.SE
+import Csound.Typed.Types.Tuple
+import Csound.Typed.Types.Prim
+
+import Csound.Typed.GlobalState.Port
+
+
+import qualified Csound.Typed.GlobalState.Opcodes as Opcodes(Event(..), event, eventi, turnoff2, turnoff, initSig, activeKr)
+
+data InstrId a
+ = InstrId { unInstrId :: GE E }
+ | InstrLinkedId { instrLivenessPort :: PortCtrl Sig, unInstrId :: GE E }
+
+newInstr :: Arg a => (a -> SE ()) -> InstrId a
+newInstr instr = InstrId $ fmap instrIdE $ saveInstr (instr toArg)
+
+event :: Arg a => InstrId a -> (D,D,a) -> SE ()
+event idx note = do
+ e <- getEvent idx note
+ SE $ Opcodes.event e
+
+eventi :: Arg a => InstrId a -> (D,D,a) -> SE ()
+eventi idx note = do
+ e <- getEvent idx note
+ SE $ Opcodes.eventi e
+
+getEvent :: Tuple a => InstrId a -> (D, D, a) -> SE Opcodes.Event
+getEvent (InstrId idx) (start, dur, args) = SE $ lift $ do
+ i <- idx
+ s <- toGE start
+ d <- toGE dur
+ as <- fromTuple args
+ return $ Opcodes.Event i s d as
+getEvent (InstrLinkedId port idx) (start, dur, arg) = do
+ getEvent (InstrId idx) (start, dur, (arg, port))
+
+turnoff2 :: InstrId a -> SE ()
+turnoff2 (InstrId expr) = SE $ Opcodes.turnoff2 =<< lift expr
+
+turnoff :: SE ()
+turnoff = SE $ Opcodes.turnoff
+
+newInstrLinked :: forall a. Arg a => (a -> SE ()) -> SE (InstrId a)
+newInstrLinked instr = do
+ p <- freePortCtrl
+ writePort p 10
+ let instrId = fmap instrIdE $ saveInstr (instr' toArg)
+ let resInstrId = InstrLinkedId p instrId
+ writePort p $ (fromGE $ fmap Opcodes.activeKr instrId) + 1
+ return resInstrId
+ where
+ instr' :: (a, PortCtrl Sig) -> SE ()
+ instr' (arg, port) = do
+ instr arg
+ testLiveness port
+
+testLiveness :: PortCtrl Sig -> SE ()
+testLiveness p = do
+ isAlive <- readPort p
+ when1 (isAlive `lessThan` 0) $ turnoff
+ modifyPort p (\x -> x - 1)
diff --git a/src/Csound/Typed/GlobalState/Opcodes.hs b/src/Csound/Typed/GlobalState/Opcodes.hs
index 07f0d80..d72ffe9 100644
--- a/src/Csound/Typed/GlobalState/Opcodes.hs
+++ b/src/Csound/Typed/GlobalState/Opcodes.hs
@@ -1,7 +1,7 @@
module Csound.Typed.GlobalState.Opcodes(
sprintf,
-- * channel opcodes
- ChnRef(..), chnRefFromParg, chnRefAlloc, readChn, writeChn, freeChn,
+ ChnRef(..), chnRefFromParg, chnRefAlloc, readChn, writeChn, overWriteChn, freeChn, chnName, chnget, chnset, chngetK, chnsetK, initSig, active, activeKr,
readChnEvtLoop,
chnUpdateUdo, masterUpdateChnAlive, servantUpdateChnAlive,
masterUpdateChnRetrig, servantUpdateChnRetrig,
@@ -65,6 +65,9 @@ readChn ref = do
writeChn :: Monad m => ChnRef -> [E] -> DepT m ()
writeChn ref sigs = zipWithM_ chnmix sigs $ chnRefNames ref
+
+overWriteChn :: Monad m => ChnRef -> [E] -> DepT m ()
+overWriteChn ref sigs = zipWithM_ chnset (chnRefNames ref) sigs
clearChn :: Monad m => ChnRef -> DepT m ()
clearChn = mapM_ chnclear . chnRefNames
@@ -76,10 +79,10 @@ chnName name chnId = sprintf formatString [chnId]
where formatString = str $ 'p' : show name ++ "_" ++ "%d"
masterUpdateChnAlive :: Monad m => ChnRef -> E -> DepT m ()
-masterUpdateChnAlive ref count = chnsetK count (chnAliveName $ chnRefId ref)
+masterUpdateChnAlive ref count = chnsetK (chnAliveName $ chnRefId ref) count
masterUpdateChnRetrig :: Monad m => ChnRef -> E -> DepT m ()
-masterUpdateChnRetrig ref count = chnsetK count (chnRetrigName $ chnRefId ref)
+masterUpdateChnRetrig ref count = chnsetK (chnRetrigName $ chnRefId ref) count
servantUpdateChnAlive :: Monad m => Int -> DepT m ()
servantUpdateChnAlive pargId = do
@@ -87,7 +90,7 @@ servantUpdateChnAlive pargId = do
kAlive <- chngetK sName
when1 Kr (kAlive <* -10) $ do
turnoff
- chnsetK (kAlive - 1) sName
+ chnsetK sName (kAlive - 1)
getRetrigVal :: Int -> E
getRetrigVal pargId = pn $ pargId + 1
@@ -104,7 +107,7 @@ servantUpdateChnEvtLoop :: Monad m => Int -> DepT m ()
servantUpdateChnEvtLoop pargId = do
let sName = chnEvtLoopName (pn pargId)
kEvtLoop <- chngetK sName
- chnsetK (ifB (kEvtLoop ==* 0) 1 0) sName
+ chnsetK sName (ifB (kEvtLoop ==* 0) 1 0)
turnoff
readChnEvtLoop :: Monad m => ChnRef -> DepT m E
@@ -132,6 +135,9 @@ chnmix asig name = do
val <- readVar var
depT_ $ opcsNoInlineArgs "chnmix" [(Xr, [Ar, Sr])] [val, name]
+chnset :: Monad m => E -> E -> DepT m ()
+chnset name value = depT_ $ opcs "chnset" [(Xr, [Ar, Sr])] [value, name]
+
chnget :: Monad m => E -> DepT m E
chnget name = depT $ opcs "chnget" [(Ar, [Sr])] [name]
@@ -139,7 +145,7 @@ chngetK :: Monad m => E -> DepT m E
chngetK name = depT $ opcs "chnget" [(Kr, [Sr])] [name]
chnsetK :: Monad m => E -> E -> DepT m ()
-chnsetK val name = depT_ $ opcsNoInlineArgs "chnset" [(Xr, [Kr, Sr])] [val, name]
+chnsetK name val = depT_ $ opcsNoInlineArgs "chnset" [(Xr, [Kr, Sr])] [val, name]
chnclear :: Monad m => E -> DepT m ()
chnclear name = depT_ $ opcs "chnclear" [(Xr, [Sr])] [name]
@@ -241,11 +247,14 @@ autoOff dt a = do
follow :: E -> E -> E
follow asig dt = opcs "follow" [(Ar, [Ar, Ir])] [asig, dt]
+initSig :: E -> E
+initSig a = opcs "init" [(Kr, [Ir])] [a]
+
turnoff :: Monad m => DepT m ()
turnoff = depT_ $ opcs "turnoff" [(Xr, [])] []
turnoff2 :: Monad m => E -> DepT m ()
-turnoff2 instrId = depT_ $ opcs "turnoff2" [(Xr, [Ir, Ir, Ir])] [instrId, 0, 0]
+turnoff2 instrId = depT_ $ opcs "turnoff2" [(Xr, [Kr, Kr, Kr])] [instrId, 0, 0]
exitnow :: Monad m => DepT m ()
exitnow = depT_ $ opcs "exitnow" [(Xr, [])] []
@@ -313,11 +322,11 @@ tableikt xndx kfn = opcs "tableikt" [(Ar, [Xr, Kr, Ir, Ir, Ir])] [xndx, kfn, 1]
-----------------------------------------------------------
-- OSC
-oscInit :: Monad m => E -> DepT m E
-oscInit port = depT $ opcs "OSCinit" [(Ir, [Ir])] [port]
+oscInit :: E -> E
+oscInit port = opcs "OSCinit" [(Ir, [Ir])] [port]
-oscListen :: Monad m => [E] -> DepT m E
-oscListen args = depT $ opcs "OSClisten" [(Kr, Ir:Ir:Ir:repeat Xr)] args
+oscListen :: Monad m => E -> E -> E -> [Var] -> DepT m E
+oscListen oscHandle addr oscType vars = depT $ opcs "OSClisten" [(Kr, Ir:Ir:Ir:repeat Xr)] (oscHandle : addr : oscType : fmap inlineVar vars)
oscSend :: Monad m => [E] -> DepT m ()
oscSend args = depT_ $ opcs "OSCsend" [(Xr, Kr:Ir:Ir:Ir:Ir:repeat Xr)] args
@@ -390,6 +399,9 @@ active instrId = opcs "active" [(Kr, [Ir]), (Ir, [Ir])] [instrId]
activeIr :: E -> E
activeIr instrId = opcs "active" [(Ir, [Ir])] [instrId]
+activeKr :: E -> E
+activeKr instrId = opcs "active" [(Kr, [Ir])] [instrId]
+
port :: E -> E -> E
port a b = opcs "portk" [(Kr, [Kr, Ir])] [a, b]
diff --git a/src/Csound/Typed/GlobalState/Options.hs b/src/Csound/Typed/GlobalState/Options.hs
index c866c7e..328c3dc 100644
--- a/src/Csound/Typed/GlobalState/Options.hs
+++ b/src/Csound/Typed/GlobalState/Options.hs
@@ -1,18 +1,25 @@
module Csound.Typed.GlobalState.Options (
Options(..),
- defGain, defSampleRate, defBlockSize, defTabFi,
+ defGain, defSampleRate, defBlockSize, defTabFi, defScaleUI,
-- * Table fidelity
- TabFi(..), fineFi, coarseFi,
+ TabFi(..), fineFi, coarseFi,
-- ** Gen identifiers
-- | Low level Csound integer identifiers for tables. These names can be used in the function 'Csound.Base.fineFi'
-- *** Integer identifiers
idWavs, idMp3s, idDoubles, idSines, idSines3, idSines2,
idPartials, idSines4, idBuzzes, idConsts, idLins, idCubes,
idExps, idSplines, idStartEnds, idPolys, idChebs1, idChebs2, idBessels, idWins,
+ idTabHarmonics, idMixOnTab, idMixTabs,
+ idNormTab, idPolynomFuns, idLinTab, idRandDists, idReadNumFile, idReadNumTab,
+ idExpsBreakPoints, idLinsBreakPoints, idReadTrajectoryFile, idMixSines1, idMixSines2,
+ idRandHist, idRandPairs, idRandRanges, idPvocex, idTuning, idMultichannel,
-- *** String identifiers
- idPadsynth, idTanh, idExp, idSone, idFarey, idWave
+ idPadsynth, idTanh, idExp, idSone, idFarey, idWave,
+ -- * Jacko
+ Jacko(..), JackoConnect, renderJacko
) where
+import Data.Monoid
import Control.Applicative
import Data.Default
@@ -29,16 +36,19 @@ import Csound.Dynamic hiding (csdFlags)
-- > blockSize = 64
-- > gain = 0.5
-- > tabFi = fineFi 13 [(idLins, 11), (idExps, 11), (idConsts, 9), (idSplines, 11), (idStartEnds, 12)] }
+-- > scaleUI = (1, 1)
data Options = Options
- { csdFlags :: Flags -- ^ Csound command line flags
- , csdSampleRate :: Maybe Int -- ^ The sample rate
- , csdBlockSize :: Maybe Int -- ^ The number of audio samples in one control step
- , csdGain :: Maybe Double -- ^ A gain of the final output
- , csdTabFi :: Maybe TabFi -- ^ Default fidelity of the arrays
+ { csdFlags :: Flags -- ^ Csound command line flags
+ , csdSampleRate :: Maybe Int -- ^ The sample rate
+ , csdBlockSize :: Maybe Int -- ^ The number of audio samples in one control step
+ , csdGain :: Maybe Double -- ^ A gain of the final output
+ , csdTabFi :: Maybe TabFi -- ^ Default fidelity of the arrays
+ , csdScaleUI :: Maybe (Double, Double) -- ^ Scale factors for UI-window
+ , csdJacko :: Maybe Jacko
}
instance Default Options where
- def = Options def def def def def
+ def = Options def def def def def def def
instance Monoid Options where
mempty = def
@@ -47,7 +57,12 @@ instance Monoid Options where
, csdSampleRate = csdSampleRate a <|> csdSampleRate b
, csdBlockSize = csdBlockSize a <|> csdBlockSize b
, csdGain = csdGain a <|> csdGain b
- , csdTabFi = csdTabFi a <|> csdTabFi b }
+ , csdTabFi = csdTabFi a <|> csdTabFi b
+ , csdScaleUI = csdScaleUI a <|> csdScaleUI b
+ , csdJacko = csdJacko a <|> csdJacko b }
+
+defScaleUI :: Options -> (Double, Double)
+defScaleUI = maybe (1, 1) id . csdScaleUI
defGain :: Options -> Double
defGain = maybe 0.8 id . csdGain
@@ -69,7 +84,7 @@ data TabFi = TabFi
instance Default TabFi where
def = fineFi 13
- [(idLins, 11), (idExps, 11), (idConsts, 9), (idSplines, 11), (idStartEnds, 12)]
+ [(idLins, 11), (idExps, 11), (idConsts, 9), (idSplines, 11), (idStartEnds, 12), (idExpsBreakPoints, 11), (idLinsBreakPoints, 11), (idRandDists, 6)]
[(idPadsynth, 18), (idSone, 14), (idTanh, 13), (idExp, 13)]
@@ -98,8 +113,11 @@ coarseFi n = TabFi n IM.empty M.empty
idWavs, idMp3s, idDoubles, idSines, idSines3, idSines2,
idPartials, idSines4, idBuzzes, idConsts, idLins, idCubes,
- idExps, idSplines, idStartEnds, idPolys, idChebs1, idChebs2, idBessels, idWins :: Int
-
+ idExps, idSplines, idStartEnds, idPolys, idChebs1, idChebs2, idBessels, idWins,
+ idTabHarmonics, idMixOnTab, idMixTabs,
+ idNormTab, idPolynomFuns, idLinTab, idRandDists, idReadNumFile, idReadNumTab,
+ idExpsBreakPoints, idLinsBreakPoints, idReadTrajectoryFile, idMixSines1, idMixSines2,
+ idRandHist, idRandPairs, idRandRanges, idPvocex, idTuning, idMultichannel :: Int
-- Human readable Csound identifiers for GEN-routines
@@ -123,14 +141,90 @@ idChebs2 = 14
idBessels = 12
idWins = 20
idMp3s = 49
+idTabHarmonics = 30
+idMixOnTab = 31
+idMixTabs = 32
+
+idNormTab = 4
+idLinTab = 18
+
+idRandDists = 21
+idReadNumFile = 23
+idReadNumTab = 24
+idExpsBreakPoints = 25
+idLinsBreakPoints = 27
+idReadTrajectoryFile = 28
+idMixSines1 = 33
+idMixSines2 = 34
+idRandHist = 40
+idRandPairs = 41
+idRandRanges = 42
+idPvocex = 43
+idTuning = 51
+idMultichannel = 52
--- Identifiers for named GEN-routines
-
-idPadsynth, idTanh, idExp, idSone, idFarey, idWave :: String
-
-idPadsynth = "padsynth"
idTanh = "tanh"
idExp = "exp"
idSone = "sone"
idFarey = "farey"
idWave = "wave"
+
+-- Identifiers for named GEN-routines
+
+idPadsynth, idTanh, idExp, idSone, idFarey, idWave :: String
+
+idPadsynth = "padsynth"
+
+---------------------------------------------
+-- not implemented yet (hard to implement within the current model)
+
+idPolynomFuns = 15
+
+
+----------------------------------------------------------
+-- Jacko
+
+type JackoConnect = (String, String)
+
+-- | Describes the Jacko header. All information that is going to be set in the global settings for Jacko opcodes.
+-- The jacko opcodes allows us to easily turn our app into Jack-client. We can also do it with command line flags.
+-- But the Jacko opcodes provide more options.
+--
+-- see the Csound docs for details: <http://csound.github.io/docs/manual/JackoOpcodes.html>
+data Jacko = Jacko
+ { jackoClient :: String
+ , jackoServer :: String
+ , jackoAudioIns :: [JackoConnect]
+ , jackoAudioOuts :: [JackoConnect]
+ , jackoMidiIns :: [JackoConnect]
+ , jackoMidiOuts :: [JackoConnect]
+ , jackoFreewheel :: Bool
+ , jackoInfo :: Bool }
+
+instance Default Jacko where
+ def = Jacko
+ { jackoClient = "csound-exp"
+ , jackoServer = "default"
+ , jackoAudioIns = []
+ , jackoAudioOuts = []
+ , jackoMidiIns = []
+ , jackoMidiOuts = []
+ , jackoFreewheel = False
+ , jackoInfo = False }
+
+renderJacko :: Jacko -> String
+renderJacko spec = unlines $ filter ( /= "")
+ [ "JackoInit " ++ (str $ jackoServer spec) ++ ", " ++ (str $ jackoClient spec)
+ , if (jackoFreewheel spec) then "JackoFreewheel 1" else ""
+ , if (jackoInfo spec) then "JackoInfo" else ""
+ , renderConnections "JackoAudioInConnect" $ jackoAudioIns spec
+ , renderConnections "JackoAudioOutConnect" $ jackoAudioOuts spec
+ , renderConnections "JackoMidiInConnect" $ jackoMidiIns spec
+ , renderConnections "JackoMidiOutConnect" $ jackoMidiOuts spec
+ , "JackoOn" ]
+ where
+ renderConnections name links = unlines $ fmap (renderLink name) links
+
+ renderLink name (a, b) = name ++ " " ++ (str a) ++ ", " ++ (str b)
+
+ str x = "\"" ++ x ++ "\""
diff --git a/src/Csound/Typed/GlobalState/Port.hs b/src/Csound/Typed/GlobalState/Port.hs
new file mode 100644
index 0000000..e900013
--- /dev/null
+++ b/src/Csound/Typed/GlobalState/Port.hs
@@ -0,0 +1,113 @@
+{-# Language ScopedTypeVariables #-}
+-- | The port is a tool to route the auio signals between instruments.
+-- We can allocate the port at the instance of the instrument (at the note)
+-- and pass the reference in the note to another instrument. That instrument
+-- cn write a signal to the port or can read the singals.
+module Csound.Typed.GlobalState.Port(
+ IsPort(..), mixPort, modifyPort,
+ Port(..), freePort,
+ PortCtrl(..), freePortCtrl
+) where
+
+import Control.Monad
+import Control.Monad.Trans.Class
+
+import Csound.Dynamic
+
+import Csound.Typed.GlobalState.GE
+import Csound.Typed.GlobalState.SE
+import Csound.Typed.Types.Tuple
+import Csound.Typed.Types.Prim
+
+import Csound.Typed.GlobalState.Opcodes(freeChn, chnName, chnget, chnset, chngetK, chnsetK)
+
+-- port class
+
+class IsPort p where
+ readPort :: Sigs a => p a -> SE a
+ writePort :: Sigs a => p a -> a -> SE ()
+
+mixPort :: (Sigs a) => IsPort port => port a -> a -> SE ()
+mixPort p value = modifyPort p (value + )
+
+modifyPort :: (Sigs a, IsPort port) => port a -> (a -> a) -> SE ()
+modifyPort p f = do
+ value <- readPort p
+ writePort p $ f value
+
+-- port for audio signals
+
+newtype Port a = Port { unPort :: GE E }
+
+freePort :: forall a . Sigs a => SE (Port a)
+freePort = SE $ fmap (Port . return) $ freeChn
+
+instance Sigs a => Tuple (Port a) where
+ tupleMethods = makeTupleMethods to from
+ where
+ to :: D -> Port a
+ to = Port . toGE
+
+ from :: Port a -> D
+ from (Port e) = fromGE e
+
+instance Sigs a => Arg (Port a) where
+
+instance IsPort Port where
+ readPort port = SE $ hideGEinDep $ do
+ names <- getNames port
+ return $ fmap (toTuple . return) $ mapM chnget names
+
+ writePort port a = SE $ do
+ (names, values) <- lift getNamesAndValues
+ zipWithM_ chnset names values
+ where
+ getNamesAndValues = do
+ names <- getNames port
+ values <- fromTuple a
+ return (names, values)
+
+-------------------------------------------------------------
+-- ports for control signals
+
+newtype PortCtrl a = PortCtrl { unPortCtrl :: GE E }
+
+freePortCtrl :: forall a . Sigs a => SE (PortCtrl a)
+freePortCtrl = SE $ fmap (PortCtrl . return) $ freeChn
+
+instance Sigs a => Tuple (PortCtrl a) where
+ tupleMethods = makeTupleMethods to from
+ where
+ to :: D -> PortCtrl a
+ to = PortCtrl . toGE
+
+ from :: PortCtrl a -> D
+ from (PortCtrl e) = fromGE e
+
+instance Sigs a => Arg (PortCtrl a) where
+
+instance IsPort PortCtrl where
+ readPort port = SE $ hideGEinDep $ do
+ names <- getNamesCtrl port
+ return $ fmap (toTuple . return) $ mapM chngetK names
+
+ writePort port a = SE $ do
+ (names, values) <- lift getNamesAndValues
+ zipWithM_ chnsetK names values
+ where
+ getNamesAndValues = do
+ names <- getNamesCtrl port
+ values <- fromTuple a
+ return (names, values)
+
+-------------------------------------------------------
+
+getNames :: forall a . Sigs a => Port a -> GE [E]
+getNames (Port ref) = do
+ idx <- ref
+ return $ fmap (flip chnName idx) [1 .. (tupleArity ((error "No def here") :: a))]
+
+getNamesCtrl :: forall a . Sigs a => PortCtrl a -> GE [E]
+getNamesCtrl (PortCtrl ref) = do
+ idx <- ref
+ return $ fmap (flip chnName idx) [1 .. (tupleArity ((error "No def here") :: a))]
diff --git a/src/Csound/Typed/GlobalState/SE.hs b/src/Csound/Typed/GlobalState/SE.hs
index 4bb7903..7813464 100644
--- a/src/Csound/Typed/GlobalState/SE.hs
+++ b/src/Csound/Typed/GlobalState/SE.hs
@@ -2,17 +2,19 @@ module Csound.Typed.GlobalState.SE(
SE(..), LocalHistory(..),
runSE, execSE, evalSE, execGEinSE, hideGEinDep,
fromDep, fromDep_, geToSe,
- newLocalVar, newLocalVars, newGlobalVars, newClearableGlobalVars
+ newLocalVar, newLocalVars, newGlobalVars, newClearableGlobalVars,
+ -- array variables
+ newLocalArrVar, newGlobalArrVar, newTmpArrVar
) where
import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Class
-import Csound.Dynamic hiding (newLocalVar, newLocalVars)
-import qualified Csound.Dynamic as D(newLocalVar, newLocalVars)
+import Csound.Dynamic hiding (newLocalVar, newLocalVars, newLocalArrVar, newTmpArrVar)
+import qualified Csound.Dynamic as D(newLocalVar, newLocalVars, newLocalArrVar, newTmpArrVar)
import Csound.Typed.GlobalState.GE
-import Csound.Typed.GlobalState.Elements(newPersistentGlobalVar, newClearableGlobalVar)
+import Csound.Typed.GlobalState.Elements(newPersistentGlobalVar, newClearableGlobalVar, newPersistentGloabalArrVar)
-- | The Csound's @IO@-monad. All values that produce side effects are wrapped
-- in the @SE@-monad.
@@ -78,3 +80,15 @@ newGlobalVars rs vs = geToSe $ zipWithM f rs =<< vs
newClearableGlobalVars :: [Rate] -> GE [E] -> SE [Var]
newClearableGlobalVars rs vs = geToSe $ zipWithM f rs =<< vs
where f r v = onGlobals $ newClearableGlobalVar r v
+
+------------------------------------------------------------------
+-- allocation of array vars
+
+newLocalArrVar :: Rate -> GE [E] -> SE Var
+newLocalArrVar rate val = SE $ D.newLocalArrVar rate val
+
+newTmpArrVar :: Rate -> SE Var
+newTmpArrVar rate = SE $ D.newTmpArrVar rate
+
+newGlobalArrVar :: Rate -> GE [E] -> SE Var
+newGlobalArrVar r v = geToSe $ onGlobals . newPersistentGloabalArrVar r =<< v
diff --git a/src/Csound/Typed/Gui/BoxModel.hs b/src/Csound/Typed/Gui/BoxModel.hs
index deafbe9..b14b1a0 100644
--- a/src/Csound/Typed/Gui/BoxModel.hs
+++ b/src/Csound/Typed/Gui/BoxModel.hs
@@ -7,6 +7,7 @@ module Csound.Typed.Gui.BoxModel(
) where
import Control.Monad
+import Control.Applicative
import Control.Monad.Trans.State.Strict
import Data.Default
import Data.Monoid
diff --git a/src/Csound/Typed/Gui/Cabbage/Cabbage.hs b/src/Csound/Typed/Gui/Cabbage/Cabbage.hs
index e93594e..5da6acc 100644
--- a/src/Csound/Typed/Gui/Cabbage/Cabbage.hs
+++ b/src/Csound/Typed/Gui/Cabbage/Cabbage.hs
@@ -20,6 +20,7 @@ import Prelude hiding (show, min, max)
import Data.Maybe
import Control.Monad.Trans.Writer.Strict
+import Control.Applicative
import Csound.Typed.Gui.Cabbage.CabbageLang
diff --git a/src/Csound/Typed/Gui/Gui.hs b/src/Csound/Typed/Gui/Gui.hs
index 225763f..12f0b3d 100644
--- a/src/Csound/Typed/Gui/Gui.hs
+++ b/src/Csound/Typed/Gui/Gui.hs
@@ -7,7 +7,7 @@ module Csound.Typed.Gui.Gui (
-- * Layout
hor, ver, space, sca, horSca, verSca,
- padding, margin,
+ padding, margin, ScaleFactor, resizeGui,
-- * Props
props, forceProps,
Prop(..), BorderType(..), Color,
@@ -187,13 +187,20 @@ data Elem
data Props = Props
{ propsBorder :: Maybe BorderType
+ , propsScaleFactor :: Maybe ScaleFactor
, otherProps :: [Prop] }
+type ScaleFactor = (Double, Double)
+
instance Monoid Props where
- mempty = Props Nothing []
- mappend a b = Props { propsBorder = (propsBorder a) <|> (propsBorder b)
+ mempty = Props Nothing Nothing []
+ mappend a b = Props { propsBorder = propsBorder a <|> propsBorder b
+ , propsScaleFactor = propsScaleFactor a <|> propsScaleFactor b
, otherProps = mappend (otherProps a) (otherProps b) }
+instance Default Props where
+ def = mempty
+
-- | Properties of the widgets.
data Prop
= SetLabel String
@@ -333,14 +340,18 @@ margin n = onLowGui1 (Box.margin n)
-- | Sets the properties for a GUI element.
props :: [Prop] -> Gui -> Gui
-props ps = onLowGui1 (Box.appendContext (Props Nothing ps))
+props ps = onLowGui1 (Box.appendContext $ def { otherProps = ps })
+
+-- | Rescales the default sizes for the UI elements.
+resizeGui :: ScaleFactor -> Gui -> Gui
+resizeGui factorXY = onLowGui1 (Box.appendContext $ def { propsScaleFactor = Just factorXY })
-- | Sets the properties for a GUI element on all levels.
forceProps :: [Prop] -> Gui -> Gui
forceProps = error "forceProps: TODO"
setBorder :: BorderType -> Gui -> Gui
-setBorder a = onLowGui1 (Box.appendContext (Props (Just a) []))
+setBorder a = onLowGui1 (Box.appendContext $ def { propsBorder = Just a })
type GuiMap = IM.IntMap Gui
@@ -354,20 +365,20 @@ restoreTree m x = Gui $ (unGui x) >>= rec
_ -> return elem
-guiStmt :: Monad m => [Panel] -> DepT m ()
-guiStmt panels = depT_ $ noRate phi
- where phi
+guiStmt :: Monad m => ScaleFactor -> [Panel] -> DepT m ()
+guiStmt defaultScaleUI panels = depT_ $ noRate (phi defaultScaleUI)
+ where phi scaleUI
| null panels = EmptyExp
- | otherwise = Verbatim $ show $ vcat [vcat $ fmap drawGui panels, text "FLrun"]
+ | otherwise = Verbatim $ show $ vcat [vcat $ fmap (drawGui scaleUI) panels, text "FLrun"]
-drawGui :: Panel -> Doc
-drawGui x = case x of
+drawGui :: ScaleFactor -> Panel -> Doc
+drawGui defaultScaleUI x = case x of
Single w isKeybd -> panel isKeybd boundingRect $ drawWin (withWinMargin boundingRect) w
Tabs _ _ ws isKeybd -> panel isKeybd tabPanelRect $ case ws of
[] -> empty
_ -> onTabs mainTabRect $ vcat $ fmap (uncurry $ drawTab shift) tabsRs
- where boundingRect = panelRect (fmap fst tabsRs) x
- tabsRs = tabsRects x
+ where boundingRect = panelRect defaultScaleUI (fmap fst tabsRs) x
+ tabsRs = tabsRects defaultScaleUI x
(mainTabRect, shift) = mainTabRectAndShift boundingRect
tabPanelRect = Rect
@@ -397,9 +408,9 @@ panelTitle x = case x of
Single w _ -> winTitle w
Tabs title _ _ _ -> title
-panelRect :: [Rect] -> Panel -> Rect
-panelRect rs x = case x of
- Single w _ -> winBoundingRect w
+panelRect :: ScaleFactor -> [Rect] -> Panel -> Rect
+panelRect defaultScaleUI rs x = case x of
+ Single w _ -> winBoundingRect defaultScaleUI w
Tabs _ mrect _ _ -> case rs of
[] -> Box.zeroRect
_ -> maybe (foldr boundingRect (head rs) rs) id mrect
@@ -422,13 +433,13 @@ mainTabRectAndShift r = (res, (dx, dy))
-tabsRects :: Panel -> [(Rect, Win)]
-tabsRects x = case x of
+tabsRects :: ScaleFactor -> Panel -> [(Rect, Win)]
+tabsRects defaultScaleUI x = case x of
Single _ _ -> []
- Tabs _ _ ws _ -> zip (fmap winBoundingRect ws) ws
+ Tabs _ _ ws _ -> zip (fmap (winBoundingRect defaultScaleUI) ws) ws
-winBoundingRect :: Win -> Rect
-winBoundingRect w = maybe (shiftBy 50 $ bestRect $ winGui w) id $ winRect w
+winBoundingRect :: ScaleFactor -> Win -> Rect
+winBoundingRect defaultScaleUI w = maybe (shiftBy 50 $ bestRect defaultScaleUI $ winGui w) id $ winRect w
where shiftBy n r = r { px = n + px r, py = n + py r }
drawTab :: (Int, Int) -> Rect -> Win -> Doc
@@ -855,33 +866,41 @@ withRelWinMargin r = r
, width = width r - 2 * winMargin
}
-bestRect :: Gui -> Rect
-bestRect
+bestRect :: ScaleFactor -> Gui -> Rect
+bestRect defaultScaleUI
= appendWinMargin . Box.boundingRect
- . mapWithOrient (\curOrient x -> uncurry noShiftRect $ bestElemSizes curOrient $ elemContent x)
+ . mapWithOrientAndScale defaultScaleUI (\curOrient curScaleFactor x -> uncurry noShiftRect $ bestElemSizesRescaled curScaleFactor $ bestElemSizes curOrient $ elemContent x)
. unGui
where noShiftRect w h = Rect { px = 0, py = 0, width = w, height = h }
-mapWithOrient :: (Orient -> a -> b) -> Box.Scene ctx a -> Box.Scene ctx b
-mapWithOrient f = iter Hor
+mapWithOrientAndScale :: ScaleFactor -> (Orient -> ScaleFactor -> a -> b) -> Box.Scene Props a -> Box.Scene Props b
+mapWithOrientAndScale defaultScaleUI f = iter Hor defaultScaleUI
where
- iter curOrient x = case x of
- Box.Prim a -> Box.Prim $ f curOrient a
+ iter curOrient curScale x = case x of
+ Box.Prim a -> Box.Prim $ f curOrient curScale a
Box.Space -> Box.Space
- Box.Scale d a -> Box.Scale d $ iter curOrient a
- Box.Hor offs as -> Box.Hor offs $ fmap (iter Hor) as
- Box.Ver offs as -> Box.Ver offs $ fmap (iter Ver) as
- Box.Context ctx a -> Box.Context ctx $ iter curOrient a
-
+ Box.Scale d a -> Box.Scale d $ iter curOrient curScale a
+ Box.Hor offs as -> Box.Hor offs $ fmap (iter Hor curScale) as
+ Box.Ver offs as -> Box.Ver offs $ fmap (iter Ver curScale) as
+ Box.Context ctx a -> case propsScaleFactor ctx of
+ Nothing -> Box.Context ctx $ iter curOrient curScale a
+ Just newScale -> Box.Context ctx $ iter curOrient (mulFactors curScale newScale) a
+ where
+ mulFactors (x1, y1) (x2, y2) = (x1 * x2, y1 * y2)
+
+bestElemSizesRescaled :: ScaleFactor -> (Int, Int) -> (Int, Int)
+bestElemSizesRescaled (scaleX, scaleY) (sizeX, sizeY) = (mul scaleX sizeX, mul scaleY sizeY)
+ where mul double int = round $ double * fromIntegral int
+
bestElemSizes :: Orient -> Elem -> (Int, Int)
bestElemSizes orient x = case x of
-- valuators
- Count _ _ _ -> (150, 35)
- Joy _ _ -> (350, 350)
- Knob _ -> (170, 170)
- Roller _ _ -> inVer (250, 35)
- Slider _ -> inVer (300, 35)
- Text _ _ -> (120, 35)
+ Count _ _ _ -> (120, 30)
+ Joy _ _ -> (200, 200)
+ Knob _ -> (80, 80)
+ Roller _ _ -> inVer (150, 30)
+ Slider _ -> inVer (150, 25)
+ Text _ _ -> (100, 35)
-- other widgets
Box label ->
@@ -889,11 +908,11 @@ bestElemSizes orient x = case x of
numOfLines = succ $ div (length label) symbolsPerLine
in (xBox 15 symbolsPerLine, yBox 15 numOfLines)
- ButBank xn yn -> (xn * 80, yn * 35)
- Button _ -> (80, 35)
- Toggle -> (80, 35)
- Value -> (100, 35)
- Vkeybd -> (1280, 240)
+ ButBank xn yn -> (xn * 70, yn * 35)
+ Button _ -> (75, 35)
+ Toggle -> (75, 35)
+ Value -> (80, 35)
+ Vkeybd -> (1080, 240)
-- error
GuiVar h -> orphanGuiVar h
diff --git a/src/Csound/Typed/Gui/Widget.hs b/src/Csound/Typed/Gui/Widget.hs
index c59d210..6f1186b 100644
--- a/src/Csound/Typed/Gui/Widget.hs
+++ b/src/Csound/Typed/Gui/Widget.hs
@@ -35,6 +35,7 @@ import qualified Csound.Typed.GlobalState.Opcodes as C
import Csound.Typed.Gui.Gui
import Csound.Typed.GlobalState
import Csound.Typed.Types hiding (whens)
+import Csound.Typed.InnerOpcodes
-- | Renders a list of panels.
panels :: [Gui] -> SE ()
@@ -499,16 +500,6 @@ flPrintk2 :: Sig -> D -> SE ()
flPrintk2 val handle = SE $ (depT_ =<<) $ lift $ f <$> toGE val <*> toGE handle
where f a b = opcs "FLprintk2" [(Xr, [Kr, Ir])] [a, b]
--- | This opcode outputs a trigger signal that informs when any one of its k-rate
--- arguments has changed. Useful with valuator widgets or MIDI controllers.
---
--- > ktrig changed kvar1 [, kvar2,..., kvarN]
---
--- doc: <http://www.csounds.com/manual/html/changed.html>
-changed :: [Sig] -> Sig
-changed = Sig . fmap f . mapM toGE
- where f = opcs "changed" [(Kr, repeat Kr)]
-
-----------------------------------------------------
sourceSlice :: SinkSource a -> Source a
diff --git a/src/Csound/Typed/InnerOpcodes.hs b/src/Csound/Typed/InnerOpcodes.hs
new file mode 100644
index 0000000..ec5d793
--- /dev/null
+++ b/src/Csound/Typed/InnerOpcodes.hs
@@ -0,0 +1,16 @@
+module Csound.Typed.InnerOpcodes(
+ changed
+) where
+
+import Csound.Typed.Types.Prim
+import Csound.Dynamic
+
+-- | This opcode outputs a trigger signal that informs when any one of its k-rate
+-- arguments has changed. Useful with valuator widgets or MIDI controllers.
+--
+-- > ktrig changed kvar1 [, kvar2,..., kvarN]
+--
+-- doc: <http://www.csounds.com/manual/html/changed.html>
+changed :: [Sig] -> Sig
+changed = Sig . fmap f . mapM toGE
+ where f = opcs "changed" [(Kr, repeat Kr)]
diff --git a/src/Csound/Typed/Plugins.hs b/src/Csound/Typed/Plugins.hs
index fbc9483..d999cc4 100644
--- a/src/Csound/Typed/Plugins.hs
+++ b/src/Csound/Typed/Plugins.hs
@@ -27,7 +27,18 @@ module Csound.Typed.Plugins(
linKorg_lp, linKorg_hp, korg_lp, korg_hp,
-- zero delay convolution
- ZConvSpec(..), zconv, zconv'
+ ZConvSpec(..), zconv, zconv',
+
+ -- ptich shifter delay
+ pitchShifterDelay,
+
+ -- Iain's fxs
+ fxAnalogDelay, fxDistortion, fxEnvelopeFollower, fxFlanger, fxFreqShifter, fxLoFi,
+ fxPanTrem, fxMonoTrem, fxPhaser, fxPitchShifter, fxReverse, fxRingModulator, fxChorus2, fxPingPong,
+
+ -- utilities
+ delay1k
+
) where
import Csound.Typed.Plugins.Adsr140
@@ -36,4 +47,6 @@ import Csound.Typed.Plugins.Diode
import Csound.Typed.Plugins.Audaciouseq
import Csound.Typed.Plugins.Korg35
import Csound.Typed.Plugins.SolinaChorus
-import Csound.Typed.Plugins.ZeroDelayConvolution \ No newline at end of file
+import Csound.Typed.Plugins.ZeroDelayConvolution
+import Csound.Typed.Plugins.Iain
+import Csound.Typed.Plugins.Utilities
diff --git a/src/Csound/Typed/Plugins/Adsr140.hs b/src/Csound/Typed/Plugins/Adsr140.hs
index 75fefaa..2b7062e 100644
--- a/src/Csound/Typed/Plugins/Adsr140.hs
+++ b/src/Csound/Typed/Plugins/Adsr140.hs
@@ -4,10 +4,11 @@ module Csound.Typed.Plugins.Adsr140(
import Data.Boolean
import Control.Monad.Trans.Class
+import Control.Applicative
import Csound.Dynamic
-import Csound.Typed.Types
+import Csound.Typed.Types.Prim
import Csound.Typed.GlobalState
import qualified Csound.Typed.GlobalState.Elements as E(adsr140Plugin)
diff --git a/src/Csound/Typed/Plugins/Audaciouseq.hs b/src/Csound/Typed/Plugins/Audaciouseq.hs
index d35b33c..9a62ea3 100644
--- a/src/Csound/Typed/Plugins/Audaciouseq.hs
+++ b/src/Csound/Typed/Plugins/Audaciouseq.hs
@@ -4,6 +4,7 @@ module Csound.Typed.Plugins.Audaciouseq(
import Data.Boolean
import Control.Monad.Trans.Class
+import Control.Applicative
import Csound.Dynamic
diff --git a/src/Csound/Typed/Plugins/Diode.hs b/src/Csound/Typed/Plugins/Diode.hs
index 81d46dd..a51d9f4 100644
--- a/src/Csound/Typed/Plugins/Diode.hs
+++ b/src/Csound/Typed/Plugins/Diode.hs
@@ -4,6 +4,7 @@ module Csound.Typed.Plugins.Diode(
import Data.Boolean
import Control.Monad.Trans.Class
+import Control.Applicative
import Csound.Dynamic
diff --git a/src/Csound/Typed/Plugins/Iain.hs b/src/Csound/Typed/Plugins/Iain.hs
new file mode 100644
index 0000000..3a24861
--- /dev/null
+++ b/src/Csound/Typed/Plugins/Iain.hs
@@ -0,0 +1,313 @@
+module Csound.Typed.Plugins.Iain(
+ pitchShifterDelay,
+ fxAnalogDelay, fxDistortion, fxEnvelopeFollower, fxFlanger, fxFreqShifter, fxLoFi,
+ fxPanTrem, fxMonoTrem, fxPhaser, fxPitchShifter, fxReverse, fxRingModulator, fxChorus2, fxPingPong
+) where
+
+import Data.Boolean
+import Control.Monad.Trans.Class
+import Control.Applicative
+
+import Csound.Dynamic
+
+import Csound.Typed.Types
+import Csound.Typed.GlobalState
+import qualified Csound.Typed.GlobalState.Elements as E(pitchShifterDelayPlugin,
+ analogDelayPlugin, distortionPlugin, envelopeFolollowerPlugin, flangerPlugin, freqShifterPlugin,
+ loFiPlugin, panTremPlugin, monoTremPlugin, phaserPlugin, pitchShifterPlugin, reversePlugin, ringModulatorPlugin, stChorusPlugin, stereoPingPongDelayPlugin)
+
+pitchShifterDelay :: D -> (Sig, Sig) -> Sig -> Sig -> Sig -> Sig
+pitchShifterDelay imaxdlt (fb1, fb2) kdel ktrans ain = csdPitchShifterDelay ain ktrans kdel fb1 fb2 imaxdlt
+
+-- | PitchShifterDelay
+-- ; ----------------
+-- ; A pitch shifter effect that employs delay lines
+-- ;
+-- ; aout PitchShifterDelay ain,ktrans,kdlt,kFB1,kFB2,imaxdlt
+--;
+--; Initialisation
+--; --------------
+--; imaxdlt -- maximum delay time (kdlt should not exceed this value)
+--;
+--; Performance
+--; -----------
+--; ain -- input audio to be pitch shifted
+--; ktrans -- pitch transposition (in semitones)
+--; kdlt -- delay time employed by the pitch shifter effect (should be within the range ksmps/sr and imaxdlt)
+--; kFB1 -- feedback using method 1 (output from delay taps are fed back directly into their own buffers before enveloping and mixing)
+--; kFB2 -- feedback using method 2 (enveloped and mixed output from both taps is fed back into both buffers)
+--
+-- opcode PitchShifterDelay,a,akkkki
+csdPitchShifterDelay :: Sig -> Sig -> Sig -> Sig -> Sig -> D -> Sig
+csdPitchShifterDelay ain ktrans kdlt kFB1 kFB2 imaxdlt = fromGE $ do
+ addUdoPlugin E.pitchShifterDelayPlugin
+ f <$> toGE ain <*> toGE ktrans <*> toGE kdlt <*> toGE kFB1 <*> toGE kFB2 <*> toGE imaxdlt
+ where f ain ktrans kdlt kFB1 kFB2 imaxdlt = opcs "PitchShifterDelay" [(Ar, [Ar, Kr, Kr, Kr, Kr, Ir])] [ain, ktrans, kdlt, kFB1, kFB2, imaxdlt]
+
+--------------------------------------------------------
+-- multi fx
+
+fxAnalogDelay :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig
+fxAnalogDelay kmix ktime kfback ktone ain = csdAnalogDelay ain kmix ktime kfback ktone
+
+-- ; AnalogDelay
+-- ; ----------------
+-- ; A analog style delay with signal degradation and saturation options
+-- ;
+-- ; aout AnalogDelay ain,kmix,ktime,kfback,ktone
+-- ;
+-- ; Performance
+-- ; -----------
+-- ; ain -- input audio to which the flanging effect will be applied
+-- ; kmix -- dry / wet mix of the output signal (range 0 to 1)
+-- ; ktime -- delay time of the effect in seconds
+-- ; kfback -- control of the amount of output signal fed back into the input of the effect (exceeding 1 (100%) is possible and will result in saturation clipping effects)
+-- ; ktone -- control of the amount of output signal fed back into the input of the effect (range 0 to 1)
+csdAnalogDelay :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig
+csdAnalogDelay ain kmix ktime kfback ktone = fromGE $ do
+ addUdoPlugin E.analogDelayPlugin
+ f <$> toGE ain <*> toGE kmix <*> toGE ktime <*> toGE kfback <*> toGE ktone
+ where f ain kmix ktime kfback ktone = opcs "AnalogDelay" [(Ar,[Ar,Kr,Kr,Kr,Kr])] [ain, kmix, ktime, kfback, ktone]
+
+fxDistortion :: Sig -> Sig -> Sig -> Sig -> Sig
+fxDistortion klevel kdrive ktone ain = csdDistortion ain klevel kdrive ktone
+
+-- ; Distortion
+-- ; ----------------
+-- ; A distortion effect offering stomp-box-like controls
+-- ;
+-- ; aout Distortion ain,klevel,kdrive,ktone
+-- ;
+-- ; Performance
+-- ; -----------
+-- ; ain -- input audio to be distorted
+-- ; klevel -- output level of the effect (range: 0 to 1)
+-- ; kdrive -- intensity of the distortion effect (range: 0 to 1)
+-- ; ktone -- tone of a lowpass filter (range: 0 to 1)
+csdDistortion :: Sig -> Sig -> Sig -> Sig -> Sig
+csdDistortion ain klevel kdrive ktone = fromGE $ do
+ addUdoPlugin E.distortionPlugin
+ f <$> toGE ain <*> toGE klevel <*> toGE kdrive <*> toGE ktone
+ where f ain klevel kdrive ktone = opcs "Distortion" [(Ar,[Ar,Kr,Kr,Kr])] [ain, klevel, kdrive, ktone]
+
+
+fxEnvelopeFollower :: Sig -> Sig -> Sig -> Sig -> Sig
+fxEnvelopeFollower ksens kfreq kres ain = csdEnvelopeFollower ain ksens kfreq kres
+
+-- ; EnvelopeFollower
+-- ; ----------------
+-- ; A dynamic envelope following resonant lowpass filter
+-- ;
+-- ; aout EnvelopeFollower ain,ksens,kfreq,kres
+-- ;
+-- ; Performance
+-- ; -----------
+-- ; ain -- input audio to be filtered
+-- ; ksens -- sensitivity of the envelope follower (suggested range: 0 to 1)
+-- ; kfreq -- base frequency of the filter before modulation by the input dynamics (range: 0 to 1)
+-- ; kres -- resonance of the lowpass filter (suggested range: 0 to 0.99)
+csdEnvelopeFollower :: Sig -> Sig -> Sig -> Sig -> Sig
+csdEnvelopeFollower ain ksens kfreq kres = fromGE $ do
+ addUdoPlugin E.envelopeFolollowerPlugin
+ f <$> toGE ain <*> toGE ksens <*> toGE kfreq <*> toGE kres
+ where f ain ksens kfreq kres = opcs "EnvelopeFollower" [(Ar,[Ar,Kr,Kr,Kr])] [ain, ksens, kfreq, kres]
+
+-- ; Flanger
+-- ; ----------------
+-- ; A flanger effect following the typical design of a so called 'stomp box'
+-- ;
+-- ; aout Flanger ain,krate,kdepth,kdelay,kfback
+-- ;
+-- ; Performance
+-- ; -----------
+-- ; ain -- input audio to which the flanging effect will be applied
+-- ; krate -- rate control of the lfo of the effect *NOT IN HERTZ* (range 0 to 1)
+-- ; kdepth -- depth of the lfo of the effect (range 0 to 1)
+-- ; kdelay -- static delay offset of the flanging effect (range 0 to 1)
+-- ; kfback -- feedback and therefore intensity of the effect (range 0 to 1)
+fxFlanger :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig
+fxFlanger krate kdepth kdelay kfback ain = fromGE $ do
+ addUdoPlugin E.flangerPlugin
+ f <$> toGE ain <*> toGE krate <*> toGE kdepth <*> toGE kdelay <*> toGE kfback
+ where f ain krate kdepth kdelay kfback = opcs "Flanger" [(Ar,[Ar,Kr,Kr,Kr,Kr])] [ain, krate, kdepth, kdelay, kfback]
+
+
+-- ; FreqShifter
+-- ; ----------------
+-- ; A frequency shifter effect using the hilbert filter
+-- ;
+-- ; aout FreqShifter adry,kmix,kfreq,kmult,kfback
+-- ;
+-- ; Performance
+-- ; -----------
+-- ; adry -- input audio to be frequency shifted
+-- ; kmix -- dry / wet mix of the output signal (range 0 to 1)
+-- ; kfreq -- frequency of frequency shifter effect (suggested range -1000 to 1000)
+-- ; kmult -- multiplier of frequency value for fine tuning control (suggested range -1 to 1)
+-- ; kfback -- control of the amount of output signal fed back into the input of the effect (suggested range 0 to 1)
+fxFreqShifter :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig
+fxFreqShifter kmix kfreq kmult kfback adry = fromGE $ do
+ addUdoPlugin E.freqShifterPlugin
+ f <$> toGE adry <*> toGE kmix <*> toGE kfreq <*> toGE kmult <*> toGE kfback
+ where f adry kmix kfreq kmult kfback = opcs "FreqShifter" [(Ar,[Ar,Kr,Kr,Kr,Kr])] [adry, kmix, kfreq, kmult, kfback]
+
+
+-- ; LoFi
+-- ; ----------------
+-- ; 'Low Fidelity' distorting effects of bit reduction and downsampling (foldover)
+-- ;
+-- ; aout LoFi ain,kbits,kfold
+-- ;
+-- ; Performance
+-- ; -----------
+-- ; ain -- input audio to have low fidelity distortion effects applied
+-- ; kbits -- bit depth reduction (suggested range 0 to 0.6)
+-- ; kfold -- amount of foldover (range 0 to 1)
+fxLoFi :: Sig -> Sig -> Sig -> Sig
+fxLoFi kbits kfold ain = fromGE $ do
+ addUdoPlugin E.loFiPlugin
+ f <$> toGE ain <*> toGE kbits <*> toGE kfold
+ where f ain kbits kfold = opcs "LoFi" [(Ar,[Ar,Kr,Kr])] [ain, kbits, kfold]
+
+-- ; PanTrem
+-- ; ----------------
+-- ; Auto-panning and tremolo effects
+-- ;
+-- ; aout1,aout2 PanTrem ainL,ainR,,krate,kdepth,kmode,kwave
+-- ;
+-- ; Performance
+-- ; -----------
+-- ; ainL -- first/left input audio
+-- ; ainR -- second/right input audio
+-- ; krate -- rate control of the lfo of the effect *NOT IN HERTZ* (range 0 to 1)
+-- ; kdepth -- depth of the lfo of the effect (range 0 to 1)
+-- ; kmode -- mode of the effect (0=auto-panning 1=tremolo)
+-- ; kwave -- waveform used by the lfo (0=sine 1=triangle 2=square)
+fxPanTrem :: Sig -> Sig -> Sig -> Sig -> Sig2 -> Sig2
+fxPanTrem krate kdepth kmode kwave (ainL, ainR) = toTuple $ do
+ addUdoPlugin E.panTremPlugin
+ f <$> toGE ainL <*> toGE ainR <*> toGE krate <*> toGE kdepth <*> toGE kmode <*> toGE kwave
+ where f ainL ainR krate kdepth kmode kwave = ($ 2) $ mopcs "PanTrem" ([Ar,Ar], [Ar,Ar, Kr,Kr,Kr,Kr]) [ainL, ainR, krate, kdepth, kmode, kwave]
+
+-- ; Tremolo
+-- ; ----------------
+-- ; Tremolo effect
+-- ;
+-- ; aout MonoTrem ain,krate,kdepth,kwave
+-- ;
+-- ; Performance
+-- ; -----------
+-- ; ain -- input audio
+-- ; krate -- rate control of the lfo of the effect *NOT IN HERTZ* (range 0 to 1)
+-- ; kdepth -- depth of the lfo of the effect (range 0 to 1)
+-- ; kwave -- waveform used by the lfo (0=sine 1=triangle 2=square)
+fxMonoTrem :: Sig -> Sig -> Sig -> Sig -> Sig
+fxMonoTrem krate kdepth kwave ain = fromGE $ do
+ addUdoPlugin E.monoTremPlugin
+ f <$> toGE ain <*> toGE krate <*> toGE kdepth <*> toGE kwave
+ where f ain krate kdepth kwave = opcs "MonoTrem" [(Ar, [Ar,Kr,Kr,Kr])] [ain, krate, kdepth, kwave]
+
+-- ; Phaser
+-- ; ----------------
+-- ; An phase shifting effect that mimics the design of a so called 'stomp box'
+-- ;
+-- ; aout Phaser ain,krate,kdepth,kfreq,kfback
+-- ;
+-- ; Performance
+-- ; -----------
+-- ; ain -- input audio to be pitch shifted
+-- ; krate -- rate of lfo of the effect (range 0 to 1)
+-- ; kdepth -- depth of lfo of the effect (range 0 to 1)
+-- ; kfreq -- centre frequency of the phase shifting effect in octaves (suggested range 6 to 11)
+-- ; kfback -- feedback and therefore intensity of the effect (range 0 to 1)
+fxPhaser :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig
+fxPhaser krate kdepth kfreq kfback ain = fromGE $ do
+ addUdoPlugin E.phaserPlugin
+ f <$> toGE ain <*> toGE krate <*> toGE kdepth <*> toGE kfreq <*> toGE kfback
+ where f ain krate kdepth kfreq kfback = opcs "Phaser" [(Ar,[Ar,Kr,Kr,Kr,Kr])] [ain, krate, kdepth, kfreq, kfback]
+
+-- ; PitchShifter
+-- ; ------------
+-- ; A pitch shifter effect based on FFT technology
+-- ;
+-- ; aout PitchShifter ain,kmix,kpitch,kfine,kfback
+-- ;
+-- ; Performance
+-- ; -----------
+-- ; ain -- input audio to be pitch shifted
+-- ; kmix -- dry / wet mix of the output signal (range 0 to 1)
+-- ; kscal -- pitch ratio
+-- #### ; kpitch -- pitch shifting interval in thousands of a semitone (suggested range -0.012 to 0.012)
+-- #### ; kfine -- fine control of pitch shifting interval in octaves (range -1/12 to 1/12)
+-- ; kfback -- control of the amount of output signal fed back into the input of the effect (suggested range 0 to 1)
+fxPitchShifter :: D -> Sig -> Sig -> Sig -> Sig -> Sig
+fxPitchShifter ifftsize kmix kscal kfback ain = fromGE $ do
+ addUdoPlugin E.pitchShifterPlugin
+ f <$> toGE ain <*> toGE kmix <*> toGE kscal <*> toGE kfback <*> toGE ifftsize
+ where f ain kmix kscal kfback ifftsize = opcs "PitchShifter" [(Ar,[Ar,Kr,Kr,Kr,Ir])] [ain, kmix, kscal, kfback, ifftsize]
+
+
+-- ; Reverse
+-- ; ----------------
+-- ; An effect that reverses an audio stream in chunks
+-- ;
+-- ; aout Reverse ain,ktime
+-- ;
+-- ; Performance
+-- ; -----------
+-- ; ain -- input audio to be reversed
+-- ; ktime -- time duration of each chunk (suggested range: 0.3 to 2)--
+fxReverse :: Sig -> Sig -> Sig
+fxReverse ktime ain = fromGE $ do
+ addUdoPlugin E.reversePlugin
+ f <$> toGE ain <*> toGE ktime
+ where f ain ktime = opcs "Reverse" [(Ar,[Ar,Kr])] [ain, ktime]
+
+-- ; RingModulator
+-- ; ----------------
+-- ; An ring modulating effect with an envelope follower
+-- ;
+-- ; aout RingModulator ain,kmix,kfreq,kenv
+-- ;
+-- ; Performance
+-- ; -----------
+-- ; ain -- input audio to be pitch shifted
+-- ; kmix -- dry / wet mix of the output signal (range 0 to 1)
+-- ; kfreq -- frequency of thew ring modulator *NOT IN HERTZ* (range 0 to 1)
+-- ; kenv -- amount of dynamic envelope following modulation of frequency (range 0 to 1)
+fxRingModulator :: Sig -> Sig -> Sig -> Sig -> Sig
+fxRingModulator kmix kfreq kenv ain = fromGE $ do
+ addUdoPlugin E.ringModulatorPlugin
+ f <$> toGE ain <*> toGE kmix <*> toGE kfreq <*> toGE kenv
+ where f ain kmix kfreq kenv = opcs "RingModulator" [(Ar,[Ar,Kr,Kr,Kr])] [ain, kmix, kfreq, kenv]
+
+-- ; StChorus
+-- ; ----------------
+-- ; A stereo chorus effect
+-- ;
+-- ; aout StChorus ainL,ainR,krate,kdepth,kwidth
+-- ;
+-- ; Performance
+-- ; -----------
+-- ; ainL -- first/left input audio
+-- ; ainR -- second/right input audio
+-- ; krate -- rate control of the lfo of the effect *NOT IN HERTZ* (range 0 to 1)
+-- ; kdepth -- depth of the lfo of the effect (range 0 to 1)
+-- ; kwidth -- width of stereo widening (range 0 to 1)
+fxChorus2 :: Sig -> Sig -> Sig -> Sig2 -> Sig2
+fxChorus2 krate kdepth kwidth (ainL, ainR) = toTuple $ do
+ addUdoPlugin E.stChorusPlugin
+ f <$> toGE ainL <*> toGE ainR <*> toGE krate <*> toGE kdepth <*> toGE kwidth
+ where f ainL ainR krate kdepth kwidth = ($ 2) $ mopcs "StChorus" ([Ar,Ar], [Ar,Ar,Kr,Kr,Kr]) [ainL, ainR, krate, kdepth, kwidth]
+
+-- aInL, aInR, kdelayTime, kFeedback, kMix, iMaxDelayTime xin
+
+-- | Stereo ping-pong delay effect
+--
+-- > fxPingPong maxDelayTime kmix width tone time feedback (ainL, ainR)
+fxPingPong :: D -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig2 -> Sig2
+fxPingPong iMaxDelTime kmix kwidth ktone ktime kfeedback (ainL, ainR) = toTuple $ do
+ addUdoPlugin E.stereoPingPongDelayPlugin
+ f <$> toGE ainL <*> toGE ainR <*> toGE ktime <*> toGE kfeedback <*> toGE kmix <*> toGE kwidth <*> toGE ktone <*> toGE iMaxDelTime
+ where f ainL ainR ktime kfeedback kmix kwidth ktone iMaxDelTime = ($ 2) $ mopcs "StereoPingPongDelay" ([Ar,Ar], [Ar,Ar,Kr,Kr,Kr,Kr,Kr,Ir]) [ainL, ainR, ktime, kfeedback, kmix, kwidth, ktone, iMaxDelTime]
+
diff --git a/src/Csound/Typed/Plugins/Korg35.hs b/src/Csound/Typed/Plugins/Korg35.hs
index 6395db9..9a69776 100644
--- a/src/Csound/Typed/Plugins/Korg35.hs
+++ b/src/Csound/Typed/Plugins/Korg35.hs
@@ -4,6 +4,7 @@ module Csound.Typed.Plugins.Korg35(
import Data.Boolean
import Control.Monad.Trans.Class
+import Control.Applicative
import Csound.Dynamic
diff --git a/src/Csound/Typed/Plugins/SolinaChorus.hs b/src/Csound/Typed/Plugins/SolinaChorus.hs
index 80bc046..4a91385 100644
--- a/src/Csound/Typed/Plugins/SolinaChorus.hs
+++ b/src/Csound/Typed/Plugins/SolinaChorus.hs
@@ -4,6 +4,7 @@ module Csound.Typed.Plugins.SolinaChorus(
import Data.Boolean
import Control.Monad.Trans.Class
+import Control.Applicative
import Csound.Dynamic
diff --git a/src/Csound/Typed/Plugins/TabQueue.hs b/src/Csound/Typed/Plugins/TabQueue.hs
index 6bd5bcf..9872416 100644
--- a/src/Csound/Typed/Plugins/TabQueue.hs
+++ b/src/Csound/Typed/Plugins/TabQueue.hs
@@ -4,6 +4,7 @@ module Csound.Typed.Plugins.TabQueue(
import Data.Boolean
import Control.Monad.Trans.Class
+import Control.Applicative
import Csound.Dynamic
diff --git a/src/Csound/Typed/Plugins/Utilities.hs b/src/Csound/Typed/Plugins/Utilities.hs
new file mode 100644
index 0000000..3d87a16
--- /dev/null
+++ b/src/Csound/Typed/Plugins/Utilities.hs
@@ -0,0 +1,23 @@
+module Csound.Typed.Plugins.Utilities(
+ delay1k
+) where
+
+import Data.Boolean
+import Control.Monad.Trans.Class
+import Control.Applicative
+
+import Csound.Dynamic
+
+import Csound.Typed.Types.Prim
+import Csound.Typed.GlobalState
+import qualified Csound.Typed.GlobalState.Elements as E(delay1kPlugin)
+
+
+-------------------------------------------------------------------------------
+
+-- | Delay a control signal by single sample.
+delay1k :: Sig -> Sig
+delay1k ain = fromGE $ do
+ addUdoPlugin E.delay1kPlugin
+ f <$> toGE ain
+ where f ain = opcs "Delay1k" [(Kr, [Kr])] [ain]
diff --git a/src/Csound/Typed/Plugins/Zdf.hs b/src/Csound/Typed/Plugins/Zdf.hs
index b071647..0b57041 100644
--- a/src/Csound/Typed/Plugins/Zdf.hs
+++ b/src/Csound/Typed/Plugins/Zdf.hs
@@ -18,6 +18,7 @@ module Csound.Typed.Plugins.Zdf(
import Data.Boolean
import Control.Monad.Trans.Class
+import Control.Applicative
import Csound.Dynamic
diff --git a/src/Csound/Typed/Plugins/ZeroDelayConvolution.hs b/src/Csound/Typed/Plugins/ZeroDelayConvolution.hs
index 75f37ce..d8ed643 100644
--- a/src/Csound/Typed/Plugins/ZeroDelayConvolution.hs
+++ b/src/Csound/Typed/Plugins/ZeroDelayConvolution.hs
@@ -5,6 +5,7 @@ module Csound.Typed.Plugins.ZeroDelayConvolution(
import Data.Boolean
import Data.Default
import Control.Monad.Trans.Class
+import Control.Applicative
import Csound.Dynamic
diff --git a/src/Csound/Typed/Render.hs b/src/Csound/Typed/Render.hs
index df22da3..9465c8d 100644
--- a/src/Csound/Typed/Render.hs
+++ b/src/Csound/Typed/Render.hs
@@ -15,7 +15,9 @@ import Data.Monoid
import Data.Ord
import Data.List(sortBy, groupBy)
import qualified Data.IntMap as IM
+import Control.Monad
import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
import Text.PrettyPrint.Leijen(displayS, renderPretty)
@@ -98,6 +100,8 @@ renderHistory mnchnls_i nchnls opt = do
getInstr0 :: Maybe Int -> Int -> Options -> Dep () -> History -> Dep ()
getInstr0 mnchnls_i nchnls opt udos hist = do
+ macroses
+ defaultScaleUI <- fmap defScaleUI $ lift getOptions
globalConstants
midiAssigns
midiInitCtrls
@@ -106,8 +110,9 @@ getInstr0 mnchnls_i nchnls opt udos hist = do
userInstr0 hist
chnUpdateUdo
udos
- sf2
- guiStmt $ getPanels hist
+ sf2
+ jackos
+ guiStmt defaultScaleUI $ getPanels hist
where
globalConstants = do
setSr $ defSampleRate opt
@@ -127,6 +132,14 @@ getInstr0 mnchnls_i nchnls opt udos hist = do
getName = sfName . fst
phi as = (getName $ head as, fmap (\(sf, index) -> (sfBank sf, sfProgram sf, index)) as)
+ macroses = forM_ (fmap snd $ M.toList $ macrosInits hist) $ \x -> case x of
+ MacrosInitDouble name value -> initMacrosDouble name value
+ MacrosInitString name value -> initMacrosString name value
+ MacrosInitInt name value -> initMacrosInt name value
+
+ jackos = maybe (return ()) (verbatim . renderJacko) $ csdJacko opt
+
+
reactOnMidi :: History -> Flags -> Flags
reactOnMidi h flags
| midiIsActive h && midiDeviceIsEmpty flags = setMidiDevice flags
diff --git a/src/Csound/Typed/Types.hs b/src/Csound/Typed/Types.hs
index 81dc042..12bf6a9 100644
--- a/src/Csound/Typed/Types.hs
+++ b/src/Csound/Typed/Types.hs
@@ -12,6 +12,15 @@ module Csound.Typed.Types(
-- * Events
module Csound.Typed.Types.Evt,
+ -- * Arrays
+ module Csound.Typed.Types.Array,
+
+ -- * Arguments for monophonic synths
+ module Csound.Typed.Types.MonoArg,
+
+ -- * Signal space (generic signal transformers)
+ module Csound.Typed.Types.SigSpace,
+
-- * Tab helpers
getNextGlobalGenId
) where
@@ -22,6 +31,9 @@ import Csound.Typed.Types.Prim
import Csound.Typed.Types.Tuple
import Csound.Typed.Types.Evt
import Csound.Typed.Types.Lift
+import Csound.Typed.Types.Array
+import Csound.Typed.Types.MonoArg
+import Csound.Typed.Types.SigSpace
import Csound.Typed.GlobalState(evalSE, SE, geToSe)
diff --git a/src/Csound/Typed/Types/Array.hs b/src/Csound/Typed/Types/Array.hs
new file mode 100644
index 0000000..35bba17
--- /dev/null
+++ b/src/Csound/Typed/Types/Array.hs
@@ -0,0 +1,612 @@
+{-# Language FlexibleInstances, ScopedTypeVariables #-}
+module Csound.Typed.Types.Array(
+ Arr(..),
+ newLocalArr, newGlobalArr, newLocalCtrlArr, newGlobalCtrlArr,
+ fillLocalArr, fillGlobalArr, fillLocalCtrlArr, fillGlobalCtrlArr,
+ readArr, writeArr, writeInitArr, modifyArr, mixArr,
+ -- * Misc functions to help the type inverence
+ Arr1, DArr1, Arr2, DArr2, Arr3, DArr3,
+ arr1, darr1, arr2, darr2, arr3, darr3,
+
+ -- * Array opcodes
+ maparrayNew, lenarray, copyf2array, copya2ftab, minarray, maxarray, sumarray,
+ scalearray, slicearrayNew,
+
+ maparrayCopy, slicearrayCopy,
+
+ -- * Spectral opcodes
+ SpecArr,
+
+ fftNew, fftinvNew, rfftNew, rifftNew, pvs2tab, tab2pvs, cmplxprodNew,
+ rect2polNew, pol2rectNew, pol2rect2New, windowArrayNew,
+ r2cNew, c2rNew, magsArrayNew, phsArrayNew,
+
+ fftCopy, fftinvCopy, rfftCopy, rifftCopy, cmplxprodCopy,
+ rect2polCopy, pol2rectCopy, pol2rect2Copy, windowArrayCopy,
+ r2cCopy, c2rCopy, magsArrayCopy, phsArrayCopy
+) where
+
+
+import Control.Monad
+import Control.Monad.Trans.Class
+
+import Csound.Dynamic hiding (writeArr, writeInitArr, readArr, newLocalArrVar, newTmpArrVar, int)
+import qualified Csound.Dynamic as D
+
+import Csound.Typed.Types.Prim
+import Csound.Typed.Types.Tuple
+import Csound.Typed.GlobalState.SE
+import Csound.Typed.GlobalState.GE
+
+-- | An array with single signal index.
+type Arr1 a = Arr Sig a
+
+-- | An array with single constant index.
+type DArr1 a = Arr D a
+
+
+-- | A matrix (2D array) with signal index.
+type Arr2 a = Arr (Sig, Sig) a
+
+-- | A matrix (2D array) with constant index.
+type DArr2 a = Arr (D, D) a
+
+-- | A 3D array with signal index.
+type Arr3 a = Arr (Sig, Sig, Sig) a
+
+-- | A 3D array with constant index.
+type DArr3 a = Arr (D, D, D) a
+
+-- | Function to help the type inference.
+arr1 :: SE (Arr Sig a) -> SE (Arr Sig a)
+arr1 = id
+
+-- | Function to help the type inference.
+darr1 :: SE (Arr D a) -> SE (Arr D a)
+darr1 = id
+
+-- | Function to help the type inference.
+arr2 :: SE (Arr (Sig,Sig) a) -> SE (Arr (Sig,Sig) a)
+arr2 = id
+
+-- | Function to help the type inference.
+darr2 :: SE (Arr (D,D) a) -> SE (Arr (D,D) a)
+darr2 = id
+
+-- | Function to help the type inference.
+arr3 :: SE (Arr (Sig,Sig,Sig) a) -> SE (Arr (Sig,Sig,Sig) a)
+arr3 = id
+
+-- | Function to help the type inference.
+darr3 :: SE (Arr (D,D,D) a) -> SE (Arr (D,D,D) a)
+darr3 = id
+
+-- | Arrays. The array data type is parametrized with type of the index and the type of the value.
+-- Note that the data tpyes for indices and values can be tuples.
+newtype Arr ix a = Arr { unArr :: [Var] }
+
+newArrBy :: forall ix a . (Tuple a, Tuple ix) => (Rate -> GE [E] -> SE Var) -> [D] -> SE (Arr ix a)
+newArrBy mkVar sizes =
+ fmap Arr $ mapM (\x -> mkVar x (mapM toGE sizes)) (tupleRates $ (undefined :: a))
+
+getIndices :: Tuple ix => [Int] -> [ix]
+getIndices xs = fmap (toTuple . return . fmap D.int) $ getIntIndices xs
+
+getIntIndices :: [Int] -> [[Int]]
+getIntIndices xs = fmap reverse $ foldl go [] xs
+ where
+ go :: [[Int]] -> Int -> [[Int]]
+ go res n = case res of
+ [] -> fmap (\x -> [x]) ix
+ xs -> [ first : rest | first <- ix, rest <- xs ]
+ where ix = [0 .. n - 1]
+
+fillArrBy :: (Tuple a, Tuple ix) => (Rate -> GE [E] -> SE Var) -> [Int] -> [a] -> SE (Arr ix a)
+fillArrBy mkVar sizes inits = do
+ arr <- newArrBy mkVar (fmap int sizes)
+ zipWithM_ (writeInitArr arr) (getIndices sizes) inits
+ return arr
+
+-- | Creates an array that is local to the body of Csound instrument where it's defined.
+-- The array contains audio signals.
+--
+-- > newLocalArr sizes
+newLocalArr :: (Tuple a, Tuple ix) => [D] -> SE (Arr ix a)
+newLocalArr = newArrBy newLocalArrVar
+
+-- | Creates a global array. The array contains audio signals.
+--
+-- > newGlobalArr sizes
+newGlobalArr :: (Tuple a, Tuple ix) => [D] -> SE (Arr ix a)
+newGlobalArr = newArrBy newGlobalArrVar
+
+-- | Creates an array that is local to the body of Csound instrument where it's defined.
+-- The array contains control signals.
+--
+-- > newLocalCtrlArr sizes
+newLocalCtrlArr :: (Tuple a, Tuple ix) => [D] -> SE (Arr ix a)
+newLocalCtrlArr = newArrBy newLocalCtrlArrVar
+
+-- | Creates a global array. The array contains control signals.
+--
+-- > newGlobalCtrlArr sizes
+newGlobalCtrlArr :: (Tuple a, Tuple ix) => [D] -> SE (Arr ix a)
+newGlobalCtrlArr = newArrBy newGlobalCtrlArrVar
+
+-- | Creates an array that is local to the body of Csound instrument where it's defined.
+-- The array contains audio signals. It fills the array from the list of values (the last argument).
+--
+-- > fillLocalArr sizes initValues = ...
+fillLocalArr :: (Tuple a, Tuple ix) => [Int] -> [a] -> SE (Arr ix a)
+fillLocalArr = fillArrBy newLocalArrVar
+
+-- | Creates a global array. The array contains audio signals. It fills the array from the list of values (the last argument).
+--
+-- > fillGlobalArr sizes initValues = ...
+fillGlobalArr :: (Tuple a, Tuple ix) => [Int] -> [a] -> SE (Arr ix a)
+fillGlobalArr = fillArrBy newGlobalArrVar
+
+-- | Creates an array that is local to the body of Csound instrument where it's defined.
+-- The array contains control signals. It fills the array from the list of values (the last argument).
+--
+-- > fillLocalCtrlArr sizes initValues = ...
+fillLocalCtrlArr :: (Tuple a, Tuple ix) => [Int] -> [a] -> SE (Arr ix a)
+fillLocalCtrlArr = fillArrBy newLocalCtrlArrVar
+
+-- | Creates a global array. The array contains control signals. It fills the array from the list of values (the last argument).
+--
+-- > fillGlobalCtrlArr sizes initValues = ...
+fillGlobalCtrlArr :: (Tuple a, Tuple ix) => [Int] -> [a] -> SE (Arr ix a)
+fillGlobalCtrlArr = fillArrBy newGlobalCtrlArrVar
+
+newLocalCtrlArrVar = newLocalArrVar . toCtrlRate
+newGlobalCtrlArrVar = newGlobalArrVar . toCtrlRate
+
+toCtrlRate x = case x of
+ Ar -> Kr
+ Kr -> Ir
+ _ -> x
+
+-- | Reads data from the array.
+readArr :: (Tuple a, Tuple ix) => Arr ix a -> ix -> SE a
+readArr (Arr vars) ixs = fmap (toTuple . return) $ SE $ hideGEinDep $ do
+ ixsExp <- fromTuple ixs
+ return $ mapM (\v -> read v ixsExp) vars
+ where
+ read :: Var -> [E] -> Dep E
+ read = D.readArr
+
+-- | Writes data to the array.
+writeArr :: (Tuple ix, Tuple a) => Arr ix a -> ix -> a -> SE ()
+writeArr (Arr vars) ixs b = SE $ hideGEinDep $ do
+ ixsExp <- fromTuple ixs
+ bsExp <- fromTuple b
+ return $ zipWithM_ (\var value -> write var ixsExp value) vars bsExp
+ where
+ write :: Var -> [E] -> E -> Dep ()
+ write = D.writeArr
+
+-- | Writes data to the array.
+writeInitArr :: (Tuple ix, Tuple a) => Arr ix a -> ix -> a -> SE ()
+writeInitArr (Arr vars) ixs b = SE $ hideGEinDep $ do
+ ixsExp <- fromTuple ixs
+ bsExp <- fromTuple b
+ return $ zipWithM_ (\var value -> write var ixsExp value) vars bsExp
+ where
+ write :: Var -> [E] -> E -> Dep ()
+ write = D.writeInitArr
+
+-- | Updates the value of the array with pure function.
+modifyArr :: (Tuple a, Tuple ix) => Arr ix a -> ix -> (a -> a) -> SE ()
+modifyArr ref ixs f = do
+ value <- readArr ref ixs
+ writeArr ref ixs (f value)
+
+mixArr :: (Tuple ix, Tuple a, Num a) => Arr ix a -> ix -> a -> SE ()
+mixArr ref ixs a = modifyArr ref ixs (+ a)
+
+-----------------------------------------------------
+-- opcodes with array allocation
+
+-- | Multiplies two numeric arrays and save the result in the third array.
+mulArrayNew :: (Tuple b, Num b) => Arr a b -> Arr a b -> SE (Arr a b)
+mulArrayNew = binOp "*"
+
+-- | Summs two numeric arrays and save the result in the third array.
+addArrayNew :: (Tuple b, Num b) => Arr a b -> Arr a b -> SE (Arr a b)
+addArrayNew = binOp "+"
+
+-- | Substraction of two numeric arrays and save the result in the third array.
+subArrayNew :: (Tuple b, Num b) => Arr a b -> Arr a b -> SE (Arr a b)
+subArrayNew = binOp "-"
+
+-- | Division of two numeric arrays and save the result in the third array.
+divArrayNew :: (Tuple b, Num b) => Arr a b -> Arr a b -> SE (Arr a b)
+divArrayNew = binOp "/"
+
+lenarray :: SigOrD c => Arr a b -> c
+lenarray (Arr vs) = fromGE $ return $ f (inlineVar $ head vs)
+ where f a = opcs "lenarray" [(Kr, [Xr, Ir]), (Ir, [Xr, Ir])] [a]
+
+-- | Copies table to array.
+copyf2array :: Arr Sig Sig -> Tab -> SE ()
+copyf2array (Arr vs) t = SE $ hideGEinDep $ do
+ tabExp <- toGE t
+ return $ depT_ $ opcs "copyf2array" [(Xr, [varRate $ head vs, Ir])] [inlineVar $ head vs, tabExp]
+
+-- | Copies array to table.
+copya2ftab :: Arr Sig Sig -> Tab -> SE ()
+copya2ftab (Arr vs) t = SE $ hideGEinDep $ do
+ tabExp <- toGE t
+ return $ depT_ $ opcs "copya2ftab" [(Xr, [varRate $ head vs, Ir])] [inlineVar $ head vs, tabExp]
+
+-- | Mapps all values in the array with the function.
+--
+-- Csound docs: <http://csound.github.io/docs/manual/maparray.html>
+maparrayNew :: Arr a b -> Str -> SE (Arr a b)
+maparrayNew (Arr vs) str = SE $ fmap Arr $ hideGEinDep $ do
+ strExp <- toGE str
+ return $ mapM (\var -> go var strExp) vs
+ where
+ go var strExp = do
+ outVar <- unSE $ newTmpArrVar (varRate var)
+ opcsArr isArrayInit outVar "slicearray" idRate [inlineVar var, strExp]
+ return $ outVar
+
+ idRate = fmap (\rate -> (rate, [rate, Ir, Ir])) [Ir, Kr, Ar]
+
+-- | Finds a minimum value of the array.
+minarray :: (Tuple b, Num b) => Arr a b -> SE b
+minarray = extractArray "minarray"
+
+-- | Finds a maximum value of the array.
+maxarray :: (Tuple b, Num b) => Arr a b -> SE b
+maxarray = extractArray "maxarray"
+
+-- | Summs all elements in the array.
+sumarray :: (Tuple b, Num b) => Arr a b -> SE b
+sumarray = extractArray "sumarray"
+
+-- | Scales all elements in the array.
+scalearray :: (Tuple b, Num b) => Arr a b -> (b, b) -> SE ()
+scalearray (Arr vs) (a, b) = SE $ hideGEinDep $ do
+ aExps <- fromTuple a
+ bExps <- fromTuple b
+ return $ zipWithM_ (\var (aExp, bExp) -> go var (aExp, bExp)) vs (zip aExps bExps)
+ where
+ go v (aExp, bExp) =
+ depT_ $ opcs "copyf2array" [(Xr, [varRate $ head vs, Ir])] [inlineVar $ head vs, aExp, bExp]
+
+-- | Creates a copy of some part of the given array
+slicearrayNew :: Arr D a -> (D, D) -> SE (Arr D a)
+slicearrayNew (Arr vs) (from, to) = SE $ fmap Arr $ hideGEinDep $ do
+ fromExp <- toGE from
+ toExp <- toGE to
+ return $ mapM (\var -> go var (fromExp, toExp)) vs
+ where
+ go var (from, to) = do
+ outVar <- unSE $ newTmpArrVar (varRate var)
+ opcsArr isArrayInit outVar "slicearray" idRate [inlineVar var, from, to]
+ return $ outVar
+
+ idRate = fmap (\rate -> (rate, [rate, Ir, Ir])) [Ir, Kr, Ar]
+
+-- spectral opcodes
+
+-- | Spectral array.
+type SpecArr = Arr Sig Sig
+
+-- | Complex-to-complex Fast Fourier Transform.
+--
+-- csound docs: <http://csound.github.io/docs/manual/fft.html>
+fftNew :: SpecArr -> SE SpecArr
+fftNew = convert "fft"
+
+-- | Complex-to-complex Inverse Fast Fourier Transform.
+--
+-- csound docs: <http://csound.github.io/docs/manual/fftinv.html>
+fftinvNew :: SpecArr -> SE SpecArr
+fftinvNew = convert "fftinvi"
+
+-- | Fast Fourier Transform of a real-value array.
+--
+-- csound docs: <http://csound.github.io/docs/manual/rfft.html>
+rfftNew :: SpecArr -> SE SpecArr
+rfftNew = convert "rfft"
+
+-- | Complex-to-real Inverse Fast Fourier Transform.
+--
+-- csound docs: <http://csound.github.io/docs/manual/rifft.html>
+rifftNew :: SpecArr -> SE SpecArr
+rifftNew = convert "rifft"
+
+-- | Copies spectral data to k-rate arrays (or t-variables). Also known as pvs2array.
+--
+-- csound docs: <http://csound.github.io/docs/manual/pvs2tab.html>
+pvs2tab :: SpecArr -> Spec -> SE Sig
+pvs2tab = extractWith "pvs2tab" (Kr, [Xr, Fr])
+
+-- | Copies spectral data from k-rate arrays (or t-variables.). Also known as pvsfromarray.
+--
+-- csound docs: <http://csound.github.io/docs/manual/tab2pvs.html>
+tab2pvs :: SpecArr -> SE Spec
+tab2pvs = extract1 Fr "tab2pvs"
+
+-- | Complex product of two arrays.
+--
+-- > kout[] cmplxprod kin1[], kin2[]
+--
+-- csound docs: <http://csound.github.io/docs/manual/cmplxprod.html>
+cmplxprodNew :: SpecArr -> SpecArr -> SE SpecArr
+cmplxprodNew = convert2 "cmplxprod"
+
+-- | Rectangular to polar format conversion.
+--
+-- > kout[] rect2pol kin[]
+--
+-- csound docs: <http://csound.github.io/docs/manual/rect2pol.html>
+rect2polNew :: SpecArr -> SE SpecArr
+rect2polNew = convert "rect2pol"
+
+-- | Polar to rectangular format conversion.
+--
+-- > kout[] pol2rect kin[]
+--
+-- csound docs: <http://csound.github.io/docs/manual/pol2rect.html>
+pol2rectNew :: SpecArr -> SE SpecArr
+pol2rectNew = convert "pol2rect"
+
+
+-- | Polar to rectangular format conversion.
+--
+-- > kout[] pol2rect kmags[], kphs[]
+--
+-- csound docs: <http://csound.github.io/docs/manual/pol2rect.html>
+pol2rect2New :: SpecArr -> SpecArr -> SE SpecArr
+pol2rect2New = convert2 "pol2rect"
+
+-- | Applies a window to an array.
+--
+-- > kout[] window kin[][, koff, itype]
+--
+-- csound docs: <http://csound.github.io/docs/manual/window.html>
+windowArrayNew :: SpecArr -> SE SpecArr
+windowArrayNew = convert "window"
+
+-- | Real to complex format conversion.
+--
+-- > kout[] r2c kin[]
+--
+-- csound docs: <http://csound.github.io/docs/manual/r2c.html>
+r2cNew :: SpecArr -> SE SpecArr
+r2cNew = convert "r2c"
+
+-- | Complex to real format conversion.
+--
+-- > kout[] c2r kin[]
+--
+-- csound docs: <http://csound.github.io/docs/manual/c2r.html>
+c2rNew :: SpecArr -> SE SpecArr
+c2rNew = convert "c2r"
+
+-- | Obtains the magnitudes of a complex-number array
+--
+-- > kout[] mags kin[]
+--
+-- csound docs: <http://csound.github.io/docs/manual/mags.html>
+magsArrayNew :: SpecArr -> SE SpecArr
+magsArrayNew = convert "mags"
+
+-- | Obtains the phases of a complex-number array
+--
+-- kout[] phs kin[]
+--
+-- > csound docs: <http://csound.github.io/docs/manual/phs.html>
+phsArrayNew :: SpecArr -> SE SpecArr
+phsArrayNew = convert "phs"
+
+-----------------------------
+
+isArrayInit = True
+noArrayInit = False
+
+binOp :: String -> Arr a b -> Arr a b -> SE (Arr a b)
+binOp name (Arr xs) (Arr ys) = fmap Arr $ zipWithM go xs ys
+ where
+ go x y = SE $ do
+ outVar <- unSE $ newTmpArrVar (varRate x)
+ infOprArr isArrayInit outVar name (inlineVar x) (inlineVar y)
+ return outVar
+
+convert :: String -> Arr a b -> SE (Arr a b)
+convert name (Arr vars) = fmap Arr $ mapM go vars
+ where
+ go v = SE $ do
+ outVar <- unSE $ newTmpArrVar (varRate v)
+ opcsArr isArrayInit outVar name idRate1 [inlineVar v]
+ return outVar
+
+ idRate1 = fmap (\r -> (r, [r])) [Kr, Ar, Ir, Sr, Fr]
+
+convert2 :: String -> Arr a b -> Arr a b -> SE (Arr a b)
+convert2 name (Arr xs) (Arr ys) = fmap Arr $ zipWithM go xs ys
+ where
+ go x y = SE $ do
+ outVar <- unSE $ newTmpArrVar (varRate x)
+ opcsArr isArrayInit outVar name idRate2 [inlineVar x, inlineVar y]
+ return outVar
+
+ idRate2 = fmap (\r -> (r, [r, r])) [Kr, Ar, Ir, Sr, Fr]
+
+extractArray :: (Tuple b) => String -> Arr a b -> SE b
+extractArray name (Arr vs) = SE $ fmap (toTuple . return) $ mapM (f . inlineVar) vs
+ where f a = depT $ opcs name [(Xr, [Xr])] [a]
+
+extract1 :: (Tuple b, Tuple c) => Rate -> String -> Arr a b -> SE c
+extract1 rate name (Arr vs) = SE $ fmap (toTuple . return) $ mapM (f . inlineVar) vs
+ where f a = depT $ opcs name [(rate, [Xr])] [a]
+
+extractWith :: (Tuple b, Tuple c, Tuple d) => String -> (Rate, [Rate]) -> Arr a b -> c -> SE d
+extractWith name rates (Arr vs) arg = SE $ fmap (toTuple . return) $ hideGEinDep $ do
+ argExps <- fromTuple arg
+ return $ zipWithM (\var x -> f (inlineVar var) x) vs argExps
+ where f a b = depT $ opcs name [rates] [a, b]
+
+---------------------------------------------------
+-- opcodes with copy
+
+-- | Transforms the dta of the array and copies it to the second array.
+maparrayCopy :: Arr a b -> Str -> Arr a b -> SE ()
+maparrayCopy (Arr vs) str (Arr outs) = SE $ hideGEinDep $ do
+ strExp <- toGE str
+ return $ zipWithM_ (\var outVar -> go var strExp outVar) vs outs
+ where
+ go var strExp outVar = opcsArr noArrayInit outVar "slicearray" idRate [inlineVar var, strExp]
+ idRate = fmap (\rate -> (rate, [rate, Ir, Ir])) [Ir, Kr, Ar]
+
+-- | Copies a part of array to another array.
+slicearrayCopy :: Arr D a -> (D, D) -> Arr D a -> SE ()
+slicearrayCopy (Arr vs) (from, to) (Arr outs) = SE $ hideGEinDep $ do
+ fromExp <- toGE from
+ toExp <- toGE to
+ return $ zipWithM_ (\var outVar -> go var (fromExp, toExp) outVar) vs outs
+ where
+ go var (from, to) outVar = opcsArr noArrayInit outVar "slicearray" idRate [inlineVar var, from, to]
+ idRate = fmap (\rate -> (rate, [rate, Ir, Ir])) [Ir, Kr, Ar]
+
+-- | Multiplies two arrays and copies the result into third array.
+mulArrayCopy :: (Tuple b, Num b) => Arr a b -> Arr a b -> Arr a b -> SE ()
+mulArrayCopy = binOpCopy "*"
+
+-- | Summs two arrays and copies the result into third array.
+addArrayCopy :: (Tuple b, Num b) => Arr a b -> Arr a b -> Arr a b -> SE ()
+addArrayCopy = binOpCopy "+"
+
+-- | Substracts two arrays and copies the result into third array.
+subArrayCopy :: (Tuple b, Num b) => Arr a b -> Arr a b -> Arr a b -> SE ()
+subArrayCopy = binOpCopy "-"
+
+-- | Divides two arrays and copies the result into third array.
+divArrayCopy :: (Tuple b, Num b) => Arr a b -> Arr a b -> Arr a b -> SE ()
+divArrayCopy = binOpCopy "/"
+
+-- spectral opcodes
+
+
+-- | Complex-to-complex Fast Fourier Transform.
+--
+-- csound docs: <http://csound.github.io/docs/manual/fft.html>
+fftCopy :: SpecArr -> SpecArr -> SE ()
+fftCopy = convertCopy "fft"
+
+-- | Complex-to-complex Inverse Fast Fourier Transform.
+--
+-- csound docs: <http://csound.github.io/docs/manual/fftinv.html>
+fftinvCopy :: SpecArr -> SpecArr -> SE ()
+fftinvCopy = convertCopy "fftinvi"
+
+-- | Fast Fourier Transform of a real-value array.
+--
+-- csound docs: <http://csound.github.io/docs/manual/rfft.html>
+rfftCopy :: SpecArr -> SpecArr -> SE ()
+rfftCopy = convertCopy "rfft"
+
+-- | Complex-to-real Inverse Fast Fourier Transform.
+--
+-- csound docs: <http://csound.github.io/docs/manual/rifft.html>
+rifftCopy :: SpecArr -> SpecArr -> SE ()
+rifftCopy = convertCopy "rifft"
+
+
+-- | Complex product of two arrays.
+--
+-- > kout[] cmplxprod kin1[], kin2[]
+--
+-- csound docs: <http://csound.github.io/docs/manual/cmplxprod.html>
+cmplxprodCopy :: SpecArr -> SpecArr -> SpecArr -> SE ()
+cmplxprodCopy = convert2Copy "cmplxprod"
+
+-- | Rectangular to polar format conversion.
+--
+-- > kout[] rect2pol kin[]
+--
+-- csound docs: <http://csound.github.io/docs/manual/rect2pol.html>
+rect2polCopy :: SpecArr -> SpecArr -> SE ()
+rect2polCopy = convertCopy "rect2pol"
+
+-- | Polar to rectangular format conversion.
+--
+-- > kout[] pol2rect kin[]
+--
+-- csound docs: <http://csound.github.io/docs/manual/pol2rect.html>
+pol2rectCopy :: SpecArr -> SpecArr -> SE ()
+pol2rectCopy = convertCopy "pol2rect"
+
+-- | Polar to rectangular format conversion.
+--
+-- > kout[] pol2rect kmags[], kphs[]
+--
+-- csound docs: <http://csound.github.io/docs/manual/pol2rect.html>
+pol2rect2Copy :: SpecArr -> SpecArr -> SpecArr -> SE ()
+pol2rect2Copy = convert2Copy "pol2rect2"
+
+-- | Applies a window to an array.
+--
+-- > kout[] window kin[][, koff, itype]
+--
+-- csound docs: <http://csound.github.io/docs/manual/window.html>
+windowArrayCopy :: SpecArr -> SpecArr -> SE ()
+windowArrayCopy = convertCopy "window"
+
+-- | Real to complex format conversion.
+--
+-- > kout[] r2c kin[]
+--
+-- csound docs: <http://csound.github.io/docs/manual/r2c.html>
+r2cCopy :: SpecArr -> SpecArr -> SE ()
+r2cCopy = convertCopy "r2c"
+
+-- | Complex to real format conversion.
+--
+-- > kout[] c2r kin[]
+--
+-- csound docs: <http://csound.github.io/docs/manual/c2r.html>
+c2rCopy :: SpecArr -> SpecArr -> SE ()
+c2rCopy = convertCopy "c2r"
+
+
+-- | Obtains the magnitudes of a complex-number array
+--
+-- > kout[] mags kin[]
+--
+-- csound docs: <http://csound.github.io/docs/manual/mags.html>
+magsArrayCopy :: SpecArr -> SpecArr -> SE ()
+magsArrayCopy = convertCopy "mags"
+
+-- | Obtains the phases of a complex-number array
+--
+-- kout[] phs kin[]
+--
+-- > csound docs: <http://csound.github.io/docs/manual/phs.html>
+phsArrayCopy :: SpecArr -> SpecArr -> SE ()
+phsArrayCopy = convertCopy "phs"
+
+---------------------------------------------------------------
+
+binOpCopy :: String -> Arr a b -> Arr a b -> Arr a b -> SE ()
+binOpCopy name (Arr xs) (Arr ys) (Arr outs) = mapM_ go $ zip3 xs ys outs
+ where
+ go (x, y, outVar) = SE $ infOprArr noArrayInit outVar name (inlineVar x) (inlineVar y)
+
+convertCopy :: String -> Arr a b -> Arr a b -> SE ()
+convertCopy name (Arr vars) (Arr outs) = zipWithM_ go vars outs
+ where
+ go v outVar = SE $ opcsArr noArrayInit outVar name idRate1 [inlineVar v]
+ idRate1 = fmap (\r -> (r, [r])) [Kr, Ar, Ir, Sr, Fr]
+
+convert2Copy :: String -> Arr a b -> Arr a b -> Arr a b -> SE ()
+convert2Copy name (Arr xs) (Arr ys) (Arr outs) = mapM_ go $ zip3 xs ys outs
+ where
+ go (x, y, outVar) = SE $ opcsArr noArrayInit outVar name idRate2 [inlineVar x, inlineVar y]
+ idRate2 = fmap (\r -> (r, [r, r])) [Kr, Ar, Ir, Sr, Fr]
+
diff --git a/src/Csound/Typed/Types/MixSco.hs b/src/Csound/Typed/Types/MixSco.hs
index a3da253..21d2db0 100644
--- a/src/Csound/Typed/Types/MixSco.hs
+++ b/src/Csound/Typed/Types/MixSco.hs
@@ -30,8 +30,13 @@ rescaleCsdEventList = T.str
delayCsdEventList :: D -> CsdEventList a -> CsdEventList a
delayCsdEventList = T.del
+
+type TupleMonoArg = (E,E,E,E)
+type RawMonoInstr = TupleMonoArg -> Dep [E]
+
data M
= Snd InstrId (CsdEventList [E])
+ | MonoSnd { monoSndInstr :: InstrId, monoSndArgs :: InstrId, monoSndNotes :: (CsdEventList [E]) }
| Eff InstrId (CsdEventList M) Int
delayAndRescaleCsdEventListM :: CsdEventList M -> CsdEventList M
@@ -43,8 +48,9 @@ delayCsdEventListM = T.mapEvents delayCsdEventM
delayCsdEventM :: T.Event D M -> T.Event D M
delayCsdEventM (T.Event start dur evt) = T.Event start dur (phi evt)
where phi x = case x of
- Snd n evts -> Snd n $ delayCsdEventList start evts
- Eff n evts arityIn -> Eff n (delayCsdEventListM $ delayCsdEventList start evts) arityIn
+ Snd n evts -> Snd n $ delayCsdEventList start evts
+ MonoSnd instrId argId evts -> MonoSnd instrId argId $ delayCsdEventList start evts
+ Eff n evts arityIn -> Eff n (delayCsdEventListM $ delayCsdEventList start evts) arityIn
rescaleCsdEventListM :: CsdEventList M -> CsdEventList M
rescaleCsdEventListM = T.mapEvents rescaleCsdEventM
@@ -52,16 +58,18 @@ rescaleCsdEventListM = T.mapEvents rescaleCsdEventM
rescaleCsdEventM :: T.Event D M -> T.Event D M
rescaleCsdEventM (T.Event start dur evt) = T.Event start dur (phi evt)
where phi x = case x of
- Snd n evts -> Snd n $ rescaleCsdEventList (dur/localDur) evts
- Eff n evts arityIn -> Eff n (rescaleCsdEventListM $ rescaleCsdEventList (dur/localDur) evts) arityIn
+ Snd n evts -> Snd n $ rescaleCsdEventList (dur/localDur) evts
+ MonoSnd instrId argId evts -> MonoSnd instrId argId $ rescaleCsdEventList (dur/localDur) evts
+ Eff n evts arityIn -> Eff n (rescaleCsdEventListM $ rescaleCsdEventList (dur/localDur) evts) arityIn
where localDur = case x of
- Snd _ evts -> csdEventListDur evts
- Eff _ evts _ -> csdEventListDur evts
+ Snd _ evts -> csdEventListDur evts
+ MonoSnd _ _ evts -> csdEventListDur evts
+ Eff _ evts _ -> csdEventListDur evts
renderMixSco :: Int -> CsdEventList M -> Dep [E]
renderMixSco arity evts = do
chnId <- chnRefAlloc arity
- aliveCountRef <- unSE $ newRef (10 :: D)
+ aliveCountRef <- unSE $ newRef (10 :: D)
go aliveCountRef chnId evts
readChn chnId
where
@@ -78,6 +86,7 @@ renderMixSco arity evts = do
onEvent :: Ref D -> ChnRef -> (D, D, M) -> Dep ()
onEvent aliveCountRef outId (start, dur, x) = case x of
Snd instrId es -> onSnd aliveCountRef instrId outId es
+ MonoSnd instr arg es -> onMonoSnd instr arg start dur outId es
Eff instrId es arityIn -> onEff aliveCountRef instrId start dur outId es arityIn
onSnd _ instrId outId es = forM_ (csdEventListNotes es) $ \(start, dur, args) ->
@@ -88,13 +97,24 @@ renderMixSco arity evts = do
mkEvent instrId start dur [chnRefId inId, chnRefId outId]
go aliveCountRef inId es
+ onMonoSnd instrId argId start dur outId es = do
+ inId <- chnRefAlloc arityMonoIn
+
+ forM_ (csdEventListNotes es) $ \(startLocal, durLocal, args) ->
+ mkEvent argId startLocal durLocal (args ++ [chnRefId inId])
+
+ mkEvent instrId start dur [chnRefId inId, chnRefId outId]
+ where arityMonoIn = 3
+
+
renderMixSco_ :: CsdEventList M -> Dep ()
renderMixSco_ evts = mapM_ onEvent $ csdEventListNotes evts
where
onEvent :: (D, D, M) -> Dep ()
onEvent (start, dur, x) = case x of
- Snd instrId es -> onSnd instrId es
- Eff instrId es _ -> onEff instrId start dur es
+ Snd instrId es -> onSnd instrId es
+ MonoSnd instr arg es -> onMonoSnd instr arg es
+ Eff instrId es _ -> onEff instrId start dur es
onSnd instrId es = forM_ (csdEventListNotes es) $ \(start, dur, args) ->
mkEvent instrId start dur args
@@ -103,6 +123,8 @@ renderMixSco_ evts = mapM_ onEvent $ csdEventListNotes evts
mkEvent instrId start dur []
renderMixSco_ es
+ onMonoSnd instr arg es = undefined
+
mkEvent :: InstrId -> D -> D -> [E] -> Dep ()
mkEvent instrId startD durD args = hideGEinDep $ do
diff --git a/src/Csound/Typed/Types/MonoArg.hs b/src/Csound/Typed/Types/MonoArg.hs
new file mode 100644
index 0000000..4a52388
--- /dev/null
+++ b/src/Csound/Typed/Types/MonoArg.hs
@@ -0,0 +1,38 @@
+module Csound.Typed.Types.MonoArg(
+ MonoArg(..), MonoAdsr, adsrMonoSynt, monoAdsr
+) where
+
+import Csound.Typed.Types.Prim
+import Csound.Typed.Types.Tuple
+import Csound.Typed.Plugins.Adsr140
+
+-- | Input argument for monophonic synthesizer.
+-- It includes signals for amplitude, frequency (Cycles Per second), gate, trigger.
+-- The gate equals to 1 when any note is pressed or zero when nothing is pressed.
+-- The trigger equals to 1 at the moment when new note is pressed otherwise it's 0.
+data MonoArg = MonoArg
+ { monoAmp :: Sig
+ , monoCps :: Sig
+ , monoGate :: Sig
+ , monoTrig :: Sig }
+
+instance Tuple MonoArg where
+ tupleMethods = makeTupleMethods to from
+ where
+ to :: Sig4 -> MonoArg
+ to (amp, cps, gate, trig) = MonoArg amp cps gate trig
+
+ from :: MonoArg -> Sig4
+ from (MonoArg amp cps gate trig) = (amp, cps, gate, trig)
+
+-- | ADSR that's used in monophonic instruments.
+type MonoAdsr = Sig -> Sig -> Sig -> Sig -> Sig
+
+-- | Turns the function that expects ADSR-function and amplitude and frequency to the
+-- function on monophonic argument.
+adsrMonoSynt :: (MonoAdsr -> (Sig, Sig) -> a) -> (MonoArg -> a)
+adsrMonoSynt f arg = f env (monoAmp arg, monoCps arg)
+ where env = monoAdsr arg
+
+monoAdsr :: MonoArg -> MonoAdsr
+monoAdsr arg = adsr140 (monoGate arg) (monoTrig arg) \ No newline at end of file
diff --git a/src/Csound/Typed/Types/Prim.hs b/src/Csound/Typed/Types/Prim.hs
index 5782da5..ea86e3e 100644
--- a/src/Csound/Typed/Types/Prim.hs
+++ b/src/Csound/Typed/Types/Prim.hs
@@ -1,7 +1,9 @@
{-# Language TypeFamilies, FlexibleInstances, FlexibleContexts, ScopedTypeVariables, Rank2Types #-}
module Csound.Typed.Types.Prim(
- Sig(..), unSig, D(..), unD, Tab(..), unTab, Str(..), Spec(..), Wspec(..),
+ Sig(..), unSig, D(..), unD, Tab(..), unTab, Str(..), Spec(..), Wspec(..), renderTab,
BoolSig(..), unBoolSig, BoolD(..), unBoolD, Unit(..), unit, Val(..), hideGE, SigOrD,
+ Sig2, Sig3, Sig4, Sig5, Sig6, Sig7, Sig8,
+ D2, D3, D4, D5, D6,
-- ** Tables
preTab, preStringTab, TabSize(..), TabArgs(..), updateTabSize,
@@ -39,11 +41,13 @@ import Data.Monoid
import qualified Data.IntMap as IM
import qualified Data.Map as M
+import Control.Monad.Trans.Reader
+
import Data.Default
import Data.Boolean
-import Csound.Dynamic hiding (double, int, str, when1, whens, ifBegin, ifEnd, elseBegin, untilBegin, untilEnd, untilDo)
-import qualified Csound.Dynamic as D(double, int, str, ifBegin, ifEnd, elseBegin, untilBegin, untilEnd)
+import Csound.Dynamic hiding (double, int, str, when1, whens, ifBegin, ifEnd, elseBegin, untilBegin, untilEnd, untilDo, whileBegin, whileEnd, whileDo)
+import qualified Csound.Dynamic as D(double, int, str, ifBegin, ifEnd, elseBegin, untilBegin, untilEnd, whileBegin, whileEnd)
import Csound.Typed.GlobalState.GE
import Csound.Typed.GlobalState.SE
import Csound.Typed.GlobalState.Options
@@ -74,6 +78,20 @@ newtype Spec = Spec { unSpec :: GE E }
-- | Another type for spectrum. It's @wsig@ in the Csound.
newtype Wspec = Wspec { unWspec :: GE E }
+type D2 = (D, D)
+type D3 = (D, D, D)
+type D4 = (D, D, D, D)
+type D5 = (D, D, D, D, D)
+type D6 = (D, D, D, D, D, D)
+
+type Sig2 = (Sig, Sig)
+type Sig3 = (Sig, Sig, Sig)
+type Sig4 = (Sig, Sig, Sig, Sig)
+type Sig5 = (Sig, Sig, Sig, Sig, Sig)
+type Sig6 = (Sig, Sig, Sig, Sig, Sig, Sig)
+type Sig7 = (Sig, Sig, Sig, Sig, Sig, Sig, Sig)
+type Sig8 = (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)
+
-- Booleans
-- | A signal of booleans.
@@ -151,15 +169,15 @@ instance Default TabSize where
-- Table arguments can be
data TabArgs
-- absolute
- = ArgsPlain [Double]
- -- or relative to the table size (used for tables that implement interpolation)
+ = ArgsPlain (Reader Int [Double])
+{- -- or relative to the table size (used for tables that implement interpolation)
| ArgsRelative [Double]
-- GEN 16 uses unusual interpolation scheme, so we need a special case
- | ArgsGen16 [Double]
+ | ArgsGen16 [Double] -}
| FileAccess String [Double]
-renderTab :: PreTab -> GE E
-renderTab a = saveGen =<< fromPreTab a
+renderPreTab :: PreTab -> GE E
+renderPreTab a = (fmap D.int . saveGen) =<< fromPreTab a
getPreTabUnsafe :: String -> Tab -> PreTab
getPreTabUnsafe msg x = case x of
@@ -193,38 +211,9 @@ defineTabSize base x = case x of
defineTabArgs :: Int -> TabArgs -> ([Double], Maybe String)
defineTabArgs size args = case args of
- ArgsPlain as -> (as, Nothing)
- ArgsRelative as -> (fromRelative size as, Nothing)
- ArgsGen16 as -> (formRelativeGen16 size as, Nothing)
+ ArgsPlain as -> (runReader as size, Nothing)
FileAccess filename as -> (as, Just filename)
- where fromRelative n as = substEvens (mkRelative n $ getEvens as) as
- getEvens xs = case xs of
- [] -> []
- _:[] -> []
- _:b:as -> b : getEvens as
-
- substEvens evens xs = case (evens, xs) of
- ([], as) -> as
- (_, []) -> []
- (e:es, a:_:as) -> a : e : substEvens es as
- _ -> error "table argument list should contain even number of elements"
-
- mkRelative n as = fmap ((fromIntegral :: (Int -> Double)) . round . (s * )) as
- where s = fromIntegral n / sum as
- -- special case. subst relatives for Gen16
- formRelativeGen16 n as = substGen16 (mkRelative n $ getGen16 as) as
-
- getGen16 xs = case xs of
- _:durN:_:rest -> durN : getGen16 rest
- _ -> []
-
- substGen16 durs xs = case (durs, xs) of
- ([], as) -> as
- (_, []) -> []
- (d:ds, valN:_:typeN:rest) -> valN : d : typeN : substGen16 ds rest
- (_, _) -> xs
-
-- | Skips normalization (sets table size to negative value)
skipNorm :: Tab -> Tab
skipNorm x = case x of
@@ -255,7 +244,6 @@ updateTabSize phi x = case x of
Tab _ -> error "you can change size only for primitive tables (made with gen-routines)"
TabPre a -> TabPre $ a{ preTabSize = phi $ preTabSize a }
-
----------------------------------------------------------------------------
-- Tab of tabs
@@ -375,7 +363,12 @@ instance Val Tab where
unTab :: Tab -> GE E
unTab x = case x of
Tab a -> a
- TabPre a -> renderTab a
+ TabPre a -> renderPreTab a
+
+renderTab :: Tab -> GE Int
+renderTab x = case x of
+ TabPre a -> saveGen =<< fromPreTab a
+ Tab _ -> error "table should be primitive"
instance Val BoolSig where
fromGE = BoolSig
@@ -656,7 +649,16 @@ untilDo p body = do
untilEnd
whileDo :: BoolSig -> SE () -> SE ()
-whileDo p = untilDo (notB p)
+whileDo p body = do
+ whileBegin p
+ body
+ whileEnd
+
+whileBegin :: BoolSig -> SE ()
+whileBegin a = fromDep_ $ D.whileBegin =<< lift (toGE a)
+
+whileEnd :: SE ()
+whileEnd = fromDep_ D.whileEnd
untilBegin :: BoolSig -> SE ()
untilBegin a = fromDep_ $ D.untilBegin =<< lift (toGE a)
@@ -671,7 +673,13 @@ untilDoD p body = do
untilEnd
whileDoD :: BoolD -> SE () -> SE ()
-whileDoD p = untilDoD (notB p)
+whileDoD p body = do
+ whileBeginD p
+ body
+ whileEnd
+
+whileBeginD :: BoolD -> SE ()
+whileBeginD a = fromDep_ $ D.whileBegin =<< lift (toGE a)
untilBeginD :: BoolD -> SE ()
untilBeginD a = fromDep_ $ D.untilBegin =<< lift (toGE a)
@@ -728,3 +736,188 @@ ftsr = on1 $ opr1 "ftsr"
ftcps :: Tab -> D
ftcps = on1 $ opr1 "ftcps"
+
+-------------------------------------------------
+-- numeric instances
+
+instance Num Sig2 where
+ (a1, a2) + (b1, b2) = (a1 + b1, a2 + b2)
+ (a1, a2) * (b1, b2) = (a1 * b1, a2 * b2)
+ negate (a1, a2) = (negate a1, negate a2)
+
+ fromInteger n = (fromInteger n, fromInteger n)
+ signum (a1, a2) = (signum a1, signum a2)
+ abs (a1, a2) = (abs a1, abs a2)
+
+instance Fractional Sig2 where
+ recip (a1, a2) = (recip a1, recip a2)
+ fromRational n = (fromRational n, fromRational n)
+
+instance Num Sig3 where
+ (a1, a2, a3) + (b1, b2, b3) = (a1 + b1, a2 + b2, a3 + b3)
+ (a1, a2, a3) * (b1, b2, b3) = (a1 * b1, a2 * b2, a3 * b3)
+ negate (a1, a2, a3) = (negate a1, negate a2, negate a3)
+
+ fromInteger n = (fromInteger n, fromInteger n, fromInteger n)
+ signum (a1, a2, a3) = (signum a1, signum a2, signum a3)
+ abs (a1, a2, a3) = (abs a1, abs a2, abs a3)
+
+instance Fractional Sig3 where
+ recip (a1, a2, a3) = (recip a1, recip a2, recip a3)
+ fromRational n = (fromRational n, fromRational n, fromRational n)
+
+instance Num Sig4 where
+ (a1, a2, a3, a4) + (b1, b2, b3, b4) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4)
+ (a1, a2, a3, a4) * (b1, b2, b3, b4) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4)
+ negate (a1, a2, a3, a4) = (negate a1, negate a2, negate a3, negate a4)
+
+ fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n)
+ signum (a1, a2, a3, a4) = (signum a1, signum a2, signum a3, signum a4)
+ abs (a1, a2, a3, a4) = (abs a1, abs a2, abs a3, abs a4)
+
+instance Fractional Sig4 where
+ recip (a1, a2, a3, a4) = (recip a1, recip a2, recip a3, recip a4)
+ fromRational n = (fromRational n, fromRational n, fromRational n, fromRational n)
+
+instance Num Sig5 where
+ (a1, a2, a3, a4, a5) + (b1, b2, b3, b4, b5) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4, a5 + b5)
+ (a1, a2, a3, a4, a5) * (b1, b2, b3, b4, b5) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4, a5 * b5)
+ negate (a1, a2, a3, a4, a5) = (negate a1, negate a2, negate a3, negate a4, negate a5)
+
+ fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)
+ signum (a1, a2, a3, a4, a5) = (signum a1, signum a2, signum a3, signum a4, signum a5)
+ abs (a1, a2, a3, a4, a5) = (abs a1, abs a2, abs a3, abs a4, abs a5)
+
+instance Fractional Sig5 where
+ recip (a1, a2, a3, a4, a5) = (recip a1, recip a2, recip a3, recip a4, recip a5)
+ fromRational n = (fromRational n, fromRational n, fromRational n, fromRational n, fromRational n)
+
+instance Num Sig6 where
+ (a1, a2, a3, a4, a5, a6) + (b1, b2, b3, b4, b5, b6) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4, a5 + b5, a6 + b6)
+ (a1, a2, a3, a4, a5, a6) * (b1, b2, b3, b4, b5, b6) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4, a5 * b5, a6 * b6)
+ negate (a1, a2, a3, a4, a5, a6) = (negate a1, negate a2, negate a3, negate a4, negate a5, negate a6)
+
+ fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)
+ signum (a1, a2, a3, a4, a5, a6) = (signum a1, signum a2, signum a3, signum a4, signum a5, signum a6)
+ abs (a1, a2, a3, a4, a5, a6) = (abs a1, abs a2, abs a3, abs a4, abs a5, abs a6)
+
+instance Fractional Sig6 where
+ recip (a1, a2, a3, a4, a5, a6) = (recip a1, recip a2, recip a3, recip a4, recip a5, recip a6)
+ fromRational n = (fromRational n, fromRational n, fromRational n, fromRational n, fromRational n, fromRational n)
+
+instance Num Sig7 where
+ (a1, a2, a3, a4, a5, a6, a7) + (b1, b2, b3, b4, b5, b6, b7) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4, a5 + b5, a6 + b6, a7 + b7)
+ (a1, a2, a3, a4, a5, a6, a7) * (b1, b2, b3, b4, b5, b6, b7) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4, a5 * b5, a6 * b6, a7 * b7)
+ negate (a1, a2, a3, a4, a5, a6, a7) = (negate a1, negate a2, negate a3, negate a4, negate a5, negate a6, negate a7)
+
+ fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)
+ signum (a1, a2, a3, a4, a5, a6, a7) = (signum a1, signum a2, signum a3, signum a4, signum a5, signum a6, signum a7)
+ abs (a1, a2, a3, a4, a5, a6, a7) = (abs a1, abs a2, abs a3, abs a4, abs a5, abs a6, abs a7)
+
+instance Fractional Sig7 where
+ recip (a1, a2, a3, a4, a5, a6, a7) = (recip a1, recip a2, recip a3, recip a4, recip a5, recip a6, recip a7)
+ fromRational n = (fromRational n, fromRational n, fromRational n, fromRational n, fromRational n, fromRational n, fromRational n)
+
+instance Num Sig8 where
+ (a1, a2, a3, a4, a5, a6, a7, a8) + (b1, b2, b3, b4, b5, b6, b7, b8) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4, a5 + b5, a6 + b6, a7 + b7, a8 + b8)
+ (a1, a2, a3, a4, a5, a6, a7, a8) * (b1, b2, b3, b4, b5, b6, b7, b8) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4, a5 * b5, a6 * b6, a7 + b7, a8 + b8)
+ negate (a1, a2, a3, a4, a5, a6, a7, a8) = (negate a1, negate a2, negate a3, negate a4, negate a5, negate a6, negate a7, negate a8)
+
+ fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)
+ signum (a1, a2, a3, a4, a5, a6, a7, a8) = (signum a1, signum a2, signum a3, signum a4, signum a5, signum a6, signum a7, signum a8)
+ abs (a1, a2, a3, a4, a5, a6, a7, a8) = (abs a1, abs a2, abs a3, abs a4, abs a5, abs a6, abs a7, abs a8)
+
+instance Fractional Sig8 where
+ recip (a1, a2, a3, a4, a5, a6, a7, a8) = (recip a1, recip a2, recip a3, recip a4, recip a5, recip a6, recip a7, recip a8)
+ fromRational n = (fromRational n, fromRational n, fromRational n, fromRational n, fromRational n, fromRational n, fromRational n, fromRational n)
+
+instance Num (Sig8, Sig8) where
+ (a1, a2) + (b1, b2) = (a1 + b1, a2 + b2)
+ (a1, a2) * (b1, b2) = (a1 * b1, a2 * b2)
+ negate (a1, a2) = (negate a1, negate a2)
+
+ fromInteger n = (fromInteger n, fromInteger n)
+ signum (a1, a2) = (signum a1, signum a2)
+ abs (a1, a2) = (abs a1, abs a2)
+
+instance Fractional (Sig8, Sig8) where
+ recip (a1, a2) = (recip a1, recip a2)
+ fromRational n = (fromRational n, fromRational n)
+
+instance Num (Sig8, Sig8, Sig8, Sig8) where
+ (a1, a2, a3, a4) + (b1, b2, b3, b4) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4)
+ (a1, a2, a3, a4) * (b1, b2, b3, b4) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4)
+ negate (a1, a2, a3, a4) = (negate a1, negate a2, negate a3, negate a4)
+
+ fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n)
+ signum (a1, a2, a3, a4) = (signum a1, signum a2, signum a3, signum a4)
+ abs (a1, a2, a3, a4) = (abs a1, abs a2, abs a3, abs a4)
+
+instance Fractional (Sig8, Sig8, Sig8, Sig8) where
+ recip (a1, a2, a3, a4) = (recip a1, recip a2, recip a3, recip a4)
+ fromRational n = (fromRational n, fromRational n, fromRational n, fromRational n)
+
+instance Num (Sig2, Sig2) where
+ (a1, a2) + (b1, b2) = (a1 + b1, a2 + b2)
+ (a1, a2) * (b1, b2) = (a1 * b1, a2 * b2)
+ negate (a1, a2) = (negate a1, negate a2)
+
+ fromInteger n = (fromInteger n, fromInteger n)
+ signum (a1, a2) = (signum a1, signum a2)
+ abs (a1, a2) = (abs a1, abs a2)
+
+instance Fractional (Sig2, Sig2) where
+ recip (a1, a2) = (recip a1, recip a2)
+ fromRational n = (fromRational n, fromRational n)
+
+instance Num (Sig2, Sig2, Sig2) where
+ (a1, a2, a3) + (b1, b2, b3) = (a1 + b1, a2 + b2, a3 + b3)
+ (a1, a2, a3) * (b1, b2, b3) = (a1 * b1, a2 * b2, a3 * b3)
+ negate (a1, a2, a3) = (negate a1, negate a2, negate a3)
+
+ fromInteger n = (fromInteger n, fromInteger n, fromInteger n)
+ signum (a1, a2, a3) = (signum a1, signum a2, signum a3)
+ abs (a1, a2, a3) = (abs a1, abs a2, abs a3)
+
+instance Fractional (Sig2, Sig2, Sig2) where
+ recip (a1, a2, a3) = (recip a1, recip a2, recip a3)
+ fromRational n = (fromRational n, fromRational n, fromRational n)
+
+instance Num (Sig2, Sig2, Sig2, Sig2) where
+ (a1, a2, a3, a4) + (b1, b2, b3, b4) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4)
+ (a1, a2, a3, a4) * (b1, b2, b3, b4) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4)
+ negate (a1, a2, a3, a4) = (negate a1, negate a2, negate a3, negate a4)
+
+ fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n)
+ signum (a1, a2, a3, a4) = (signum a1, signum a2, signum a3, signum a4)
+ abs (a1, a2, a3, a4) = (abs a1, abs a2, abs a3, abs a4)
+
+instance Fractional (Sig2, Sig2, Sig2, Sig2) where
+ recip (a1, a2, a3, a4) = (recip a1, recip a2, recip a3, recip a4)
+ fromRational n = (fromRational n, fromRational n, fromRational n, fromRational n)
+
+instance Num (Sig2, Sig2, Sig2, Sig2, Sig2) where
+ (a1, a2, a3, a4, a5) + (b1, b2, b3, b4, b5) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4, a5 + b5)
+ (a1, a2, a3, a4, a5) * (b1, b2, b3, b4, b5) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4, a5 * b5)
+ negate (a1, a2, a3, a4, a5) = (negate a1, negate a2, negate a3, negate a4, negate a5)
+
+ fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)
+ signum (a1, a2, a3, a4, a5) = (signum a1, signum a2, signum a3, signum a4, signum a5)
+ abs (a1, a2, a3, a4, a5) = (abs a1, abs a2, abs a3, abs a4, abs a5)
+
+instance Fractional (Sig2, Sig2, Sig2, Sig2, Sig2) where
+ recip (a1, a2, a3, a4, a5) = (recip a1, recip a2, recip a3, recip a4, recip a5)
+ fromRational n = (fromRational n, fromRational n, fromRational n, fromRational n, fromRational n)
+
+instance Num (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where
+ (a1, a2, a3, a4, a5, a6) + (b1, b2, b3, b4, b5, b6) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4, a5 + b5, a6 + b6)
+ (a1, a2, a3, a4, a5, a6) * (b1, b2, b3, b4, b5, b6) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4, a5 * b5, a6 * b6)
+ negate (a1, a2, a3, a4, a5, a6) = (negate a1, negate a2, negate a3, negate a4, negate a5, negate a6)
+
+ fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)
+ signum (a1, a2, a3, a4, a5, a6) = (signum a1, signum a2, signum a3, signum a4, signum a5, signum a6)
+ abs (a1, a2, a3, a4, a5, a6) = (abs a1, abs a2, abs a3, abs a4, abs a5, abs a6)
+
+instance Fractional (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where
+ recip (a1, a2, a3, a4, a5, a6) = (recip a1, recip a2, recip a3, recip a4, recip a5, recip a6)
+ fromRational n = (fromRational n, fromRational n, fromRational n, fromRational n, fromRational n, fromRational n)
diff --git a/src/Csound/Typed/Types/SigSpace.hs b/src/Csound/Typed/Types/SigSpace.hs
new file mode 100644
index 0000000..57e9082
--- /dev/null
+++ b/src/Csound/Typed/Types/SigSpace.hs
@@ -0,0 +1,702 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# Language
+ TypeFamilies,
+ MultiParamTypeClasses,
+ FlexibleInstances,
+ FlexibleContexts #-}
+module Csound.Typed.Types.SigSpace(
+ SigSpace(..), BindSig(..), mul, mul', on, uon, At(..), MixAt(..),
+ cfd, genCfds, cfd4, cfds,
+
+ -- * Stereo sig-space
+ SigSpace2(..), BindSig2(..), mul2, mul2',
+) where
+
+import Control.Monad
+import Control.Applicative
+import Csound.Typed.Types.Prim
+import Csound.Typed.GlobalState.SE
+
+-- | A class for easy way to process the outputs of the instruments.
+class SigSpace a where
+ mapSig :: (Sig -> Sig) -> a -> a
+
+-- | A class for easy way to process the outputs of the instruments.
+class SigSpace a => BindSig a where
+ bindSig :: (Sig -> SE Sig) -> a -> SE a
+
+-- | A class for easy way to process the outputs of the instruments.
+class SigSpace2 a where
+ mapSig2 :: (Sig2 -> Sig2) -> a -> a
+
+-- | A class for easy way to process the outputs of the instruments.
+class SigSpace2 a => BindSig2 a where
+ bindSig2 :: (Sig2 -> SE Sig2) -> a -> SE a
+
+
+-- | Scaling the sound.
+mul :: SigSpace a => Sig -> a -> a
+mul k = mapSig (k * )
+
+-- | Scaling the sound with effectful signal.
+mul' :: BindSig a => SE Sig -> a -> SE a
+mul' k = bindSig (\x -> fmap (* x) k)
+
+-- | Scaling the sound with a pair.
+mul2 :: SigSpace2 a => Sig2 -> a -> a
+mul2 (ka, kb) = mapSig2 (\(a, b) -> (ka * a, kb * b))
+
+-- | Scaling the sound with effectful pair of signals.
+mul2' :: BindSig2 a => SE Sig2 -> a -> SE a
+mul2' k = bindSig2 (\(xa, xb) -> fmap (\(ka, kb) -> (ka * xa, kb * xb)) k)
+
+-- rescaling
+
+-- | Rescaling of the bipolar signal (-1, 1) -> (a, b)
+--
+-- > on a b biSig
+on :: SigSpace a => Sig -> Sig -> a -> a
+on a b x = uon a b $ mapSig unipolar x
+ where unipolar a = 0.5 + 0.5 * a
+
+-- | Rescaling of the unipolar signal (0, 1) -> (a, b)
+--
+-- > on a b uniSig
+uon :: SigSpace a => Sig -> Sig -> a -> a
+uon a b = mapSig (\x -> a + (b - a) * x)
+
+-- | Crossfade.
+--
+-- > cfd coeff sig1 sig2
+--
+-- If coeff equals 0 then we get the first signal and if it equals 1 we get the second signal.
+cfd :: (Num a, SigSpace a) => Sig -> a -> a -> a
+cfd coeff a b = (1 - coeff) `mul` a + coeff `mul` b
+
+genCfds :: a -> (Sig -> a -> a -> a) -> [Sig] -> [a] -> a
+genCfds zero mixFun cs xs = case xs of
+ [] -> zero
+ a:as -> foldl (\x f -> f x) a $ zipWith mix' cs as
+ where mix' c a b = mixFun c b a
+
+-- | Bilinear interpolation for four signals.
+-- The signals are placed in the corners of the unit square.
+-- The first two signals are the xy coordinates in the square.
+--
+-- > cfd4 x y a b c d
+--
+-- * (0, 0) is for a
+--
+-- * (1, 0) is for b
+--
+-- * (1, 1) is for c
+--
+-- * (0, 1) is for d
+cfd4 :: (Num a, SigSpace a) => Sig -> Sig -> a -> a -> a -> a -> a
+cfd4 x y a b c d = sum $ zipWith mul [(1 - x) * (1 - y), x * (1 - y) , x * y, (1 - x) * y] [a, b, c, d]
+
+-- | Generic crossfade for n coefficients and n+1 signals.
+--
+-- > cfds coeffs sigs
+cfds :: (Num a, SigSpace a) => [Sig] -> [a] -> a
+cfds = genCfds 0 cfd
+
+
+instance SigSpace Sig where mapSig = id
+instance BindSig Sig where bindSig = id
+
+instance SigSpace (Sig, Sig) where mapSig f (a1, a2) = (f a1, f a2)
+instance BindSig (Sig, Sig) where bindSig f (a1, a2) = (,) <$> f a1 <*> f a2
+
+instance SigSpace (Sig, Sig, Sig) where mapSig f (a1, a2, a3) = (f a1, f a2, f a3)
+instance BindSig (Sig, Sig, Sig) where bindSig f (a1, a2, a3) = (,,) <$> f a1 <*> f a2 <*> f a3
+
+instance SigSpace (Sig, Sig, Sig, Sig) where mapSig f (a1, a2, a3, a4) = (f a1, f a2, f a3, f a4)
+instance BindSig (Sig, Sig, Sig, Sig) where bindSig f (a1, a2, a3, a4) = (,,,) <$> f a1 <*> f a2 <*> f a3 <*> f a4
+
+instance SigSpace (Sig, Sig, Sig, Sig, Sig) where mapSig f (a1, a2, a3, a4, a5) = (f a1, f a2, f a3, f a4, f a5)
+instance BindSig (Sig, Sig, Sig, Sig, Sig) where bindSig f (a1, a2, a3, a4, a5) = (,,,,) <$> f a1 <*> f a2 <*> f a3 <*> f a4 <*> f a5
+
+instance SigSpace (Sig, Sig, Sig, Sig, Sig, Sig) where mapSig f (a1, a2, a3, a4, a5, a6) = (f a1, f a2, f a3, f a4, f a5, f a6)
+instance BindSig (Sig, Sig, Sig, Sig, Sig, Sig) where bindSig f (a1, a2, a3, a4, a5, a6) = (,,,,,) <$> f a1 <*> f a2 <*> f a3 <*> f a4 <*> f a5 <*> f a6
+
+instance SigSpace (Sig, Sig, Sig, Sig, Sig, Sig, Sig) where mapSig f (a1, a2, a3, a4, a5, a6, a7) = (f a1, f a2, f a3, f a4, f a5, f a6, f a7)
+instance BindSig (Sig, Sig, Sig, Sig, Sig, Sig, Sig) where bindSig f (a1, a2, a3, a4, a5, a6, a7) = (,,,,,,) <$> f a1 <*> f a2 <*> f a3 <*> f a4 <*> f a5 <*> f a6 <*> f a7
+
+instance SigSpace (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) where mapSig f (a1, a2, a3, a4, a5, a6, a7, a8) = (f a1, f a2, f a3, f a4, f a5, f a6, f a7, f a8)
+instance BindSig (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) where bindSig f (a1, a2, a3, a4, a5, a6, a7, a8) = (,,,,,,,) <$> f a1 <*> f a2 <*> f a3 <*> f a4 <*> f a5 <*> f a6 <*> f a7 <*> f a8
+
+instance SigSpace (Sig2, Sig2) where mapSig f (a1, a2) = (mapSig f a1, mapSig f a2)
+instance BindSig (Sig2, Sig2) where bindSig f (a1, a2) = (,) <$> bindSig f a1 <*> bindSig f a2
+
+instance SigSpace (Sig2, Sig2, Sig2) where mapSig f (a1, a2, a3) = (mapSig f a1, mapSig f a2, mapSig f a3)
+instance BindSig (Sig2, Sig2, Sig2) where bindSig f (a1, a2, a3) = (,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3
+
+instance SigSpace (Sig2, Sig2, Sig2, Sig2) where mapSig f (a1, a2, a3, a4) = (mapSig f a1, mapSig f a2, mapSig f a3, mapSig f a4)
+instance BindSig (Sig2, Sig2, Sig2, Sig2) where bindSig f (a1, a2, a3, a4) = (,,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 <*> bindSig f a4
+
+instance SigSpace (Sig2, Sig2, Sig2, Sig2, Sig2) where mapSig f (a1, a2, a3, a4, a5) = (mapSig f a1, mapSig f a2, mapSig f a3, mapSig f a4, mapSig f a5)
+instance BindSig (Sig2, Sig2, Sig2, Sig2, Sig2) where bindSig f (a1, a2, a3, a4, a5) = (,,,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 <*> bindSig f a4 <*> bindSig f a5
+
+instance SigSpace (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where mapSig f (a1, a2, a3, a4, a5, a6) = (mapSig f a1, mapSig f a2, mapSig f a3, mapSig f a4, mapSig f a5, mapSig f a6)
+instance BindSig (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where bindSig f (a1, a2, a3, a4, a5, a6) = (,,,,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 <*> bindSig f a4 <*> bindSig f a5 <*> bindSig f a6
+
+instance SigSpace (Sig8, Sig8) where mapSig f (a1, a2) = (mapSig f a1, mapSig f a2)
+instance BindSig (Sig8, Sig8) where bindSig f (a1, a2) = (,) <$> bindSig f a1 <*> bindSig f a2
+
+instance SigSpace (Sig8, Sig8, Sig8, Sig8) where mapSig f (a1, a2, a3, a4) = (mapSig f a1, mapSig f a2, mapSig f a3, mapSig f a4)
+instance BindSig (Sig8, Sig8, Sig8, Sig8) where bindSig f (a1, a2, a3, a4) = (,,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 <*> bindSig f a4
+
+instance SigSpace (SE Sig) where mapSig f = fmap (mapSig f)
+instance BindSig (SE Sig) where bindSig f = fmap (bindSig f)
+
+instance SigSpace (SE (Sig, Sig)) where mapSig f = fmap (mapSig f)
+instance BindSig (SE (Sig, Sig)) where bindSig f = fmap (bindSig f)
+
+instance SigSpace (SE (Sig, Sig, Sig)) where mapSig f = fmap (mapSig f)
+instance BindSig (SE (Sig, Sig, Sig)) where bindSig f = fmap (bindSig f)
+
+instance SigSpace (SE (Sig, Sig, Sig, Sig)) where mapSig f = fmap (mapSig f)
+instance BindSig (SE (Sig, Sig, Sig, Sig)) where bindSig f = fmap (bindSig f)
+
+----------------------------------------------------------------------------------------------------------
+
+-- | Converts stereosignal to mono with function mean.
+toMono :: (Sig, Sig) -> Sig
+toMono (a, b) = 0.5 * a + 0.5 * b
+
+instance SigSpace2 Sig where mapSig2 f a = toMono $ f (a, a)
+instance BindSig2 Sig where bindSig2 f a = fmap toMono $ f (a, a)
+
+instance SigSpace2 (Sig, Sig) where mapSig2 = id
+instance BindSig2 (Sig, Sig) where bindSig2 = id
+
+instance SigSpace2 (Sig, Sig, Sig) where
+ mapSig2 f (a1, a2, a3) = (b1, b2, toMono (b3, b4))
+ where
+ (b1, b2, b3, b4) = mapSig2 f (a1, a2, a3, a4)
+ a4 = a3
+
+instance BindSig2 (Sig, Sig, Sig) where
+ bindSig2 f (a1, a2, a3) = do
+ (b1, b2, b3, b4) <- bindSig2 f (a1, a2, a3, a4)
+ return (b1, b2, toMono (b3, b4))
+ where
+ a4 = a3
+
+instance SigSpace2 (Sig, Sig, Sig, Sig) where
+ mapSig2 f (a1, a2, a3, a4) = (b1, b2, b3, b4)
+ where
+ (b1, b2) = f (a1, a2)
+ (b3, b4) = f (a3, a4)
+
+instance BindSig2 (Sig, Sig, Sig, Sig) where
+ bindSig2 f (a1, a2, a3, a4) = do
+ (b1, b2) <- f (a1, a2)
+ (b3, b4) <- f (a3, a4)
+ return (b1, b2, b3, b4)
+
+instance SigSpace2 (Sig, Sig, Sig, Sig, Sig) where
+ mapSig2 f (a1, a2, a3, a4, a5) = (b1, b2, b3, b4, toMono (b5, b6))
+ where
+ (b1, b2, b3, b4, b5, b6) = mapSig2 f (a1, a2, a3, a4, a5, a6)
+ a6 = a5
+
+instance BindSig2 (Sig, Sig, Sig, Sig, Sig) where
+ bindSig2 f (a1, a2, a3, a4, a5) = do
+ (b1, b2, b3, b4, b5, b6) <- bindSig2 f (a1, a2, a3, a4, a5, a6)
+ return (b1, b2, b3, b4, toMono (b5, b6))
+ where
+ a6 = a5
+
+instance SigSpace2 (Sig, Sig, Sig, Sig, Sig, Sig) where
+ mapSig2 f (a1, a2, a3, a4, a5, a6) = (b1, b2, b3, b4, b5, b6)
+ where
+ (b1, b2, b3, b4) = mapSig2 f (a1, a2, a3, a4)
+ (b5, b6) = f (a5, a6)
+
+instance BindSig2 (Sig, Sig, Sig, Sig, Sig, Sig) where
+ bindSig2 f (a1, a2, a3, a4, a5, a6) = do
+ (b1, b2, b3, b4) <- bindSig2 f (a1, a2, a3, a4)
+ (b5, b6) <- f (a5, a6)
+ return (b1, b2, b3, b4, b5, b6)
+
+instance SigSpace2 (Sig, Sig, Sig, Sig, Sig, Sig, Sig) where
+ mapSig2 f (a1, a2, a3, a4, a5, a6, a7) = (b1, b2, b3, b4, b5, b6, toMono (b7, b8))
+ where
+ (b1, b2, b3, b4, b5, b6, b7, b8) = mapSig2 f (a1, a2, a3, a4, a5, a6, a7, a8)
+ a8 = a7
+
+instance BindSig2 (Sig, Sig, Sig, Sig, Sig, Sig, Sig) where
+ bindSig2 f (a1, a2, a3, a4, a5, a6, a7) = do
+ (b1, b2, b3, b4, b5, b6, b7, b8) <- bindSig2 f (a1, a2, a3, a4, a5, a6, a7, a8)
+ return (b1, b2, b3, b4, b5, b6, toMono (b7, b8))
+ where
+ a8 = a7
+
+instance SigSpace2 (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) where
+ mapSig2 f (a1, a2, a3, a4, a5, a6, a7, a8) = (b1, b2, b3, b4, b5, b6, b7, b8)
+ where
+ (b1, b2, b3, b4, b5, b6) = mapSig2 f (a1, a2, a3, a4, a5, a6)
+ (b7, b8) = f (a7, a8)
+
+instance BindSig2 (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) where
+ bindSig2 f (a1, a2, a3, a4, a5, a6, a7, a8) = do
+ (b1, b2, b3, b4, b5, b6) <- bindSig2 f (a1, a2, a3, a4, a5, a6)
+ (b7, b8) <- f (a7, a8)
+ return (b1, b2, b3, b4, b5, b6, b7, b8)
+
+instance SigSpace2 (Sig2, Sig2) where mapSig2 f (a1, a2) = (mapSig2 f a1, mapSig2 f a2)
+instance BindSig2 (Sig2, Sig2) where bindSig2 f (a1, a2) = (,) <$> bindSig2 f a1 <*> bindSig2 f a2
+
+instance SigSpace2 (Sig2, Sig2, Sig2) where mapSig2 f (a1, a2, a3) = (mapSig2 f a1, mapSig2 f a2, mapSig2 f a3)
+instance BindSig2 (Sig2, Sig2, Sig2) where bindSig2 f (a1, a2, a3) = (,,) <$> bindSig2 f a1 <*> bindSig2 f a2 <*> bindSig2 f a3
+
+instance SigSpace2 (Sig2, Sig2, Sig2, Sig2) where mapSig2 f (a1, a2, a3, a4) = (mapSig2 f a1, mapSig2 f a2, mapSig2 f a3, mapSig2 f a4)
+instance BindSig2 (Sig2, Sig2, Sig2, Sig2) where bindSig2 f (a1, a2, a3, a4) = (,,,) <$> bindSig2 f a1 <*> bindSig2 f a2 <*> bindSig2 f a3 <*> bindSig2 f a4
+
+instance SigSpace2 (Sig2, Sig2, Sig2, Sig2, Sig2) where mapSig2 f (a1, a2, a3, a4, a5) = (mapSig2 f a1, mapSig2 f a2, mapSig2 f a3, mapSig2 f a4, mapSig2 f a5)
+instance BindSig2 (Sig2, Sig2, Sig2, Sig2, Sig2) where bindSig2 f (a1, a2, a3, a4, a5) = (,,,,) <$> bindSig2 f a1 <*> bindSig2 f a2 <*> bindSig2 f a3 <*> bindSig2 f a4 <*> bindSig2 f a5
+
+instance SigSpace2 (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where mapSig2 f (a1, a2, a3, a4, a5, a6) = (mapSig2 f a1, mapSig2 f a2, mapSig2 f a3, mapSig2 f a4, mapSig2 f a5, mapSig2 f a6)
+instance BindSig2 (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where bindSig2 f (a1, a2, a3, a4, a5, a6) = (,,,,,) <$> bindSig2 f a1 <*> bindSig2 f a2 <*> bindSig2 f a3 <*> bindSig2 f a4 <*> bindSig2 f a5 <*> bindSig2 f a6
+
+instance SigSpace2 (Sig8, Sig8) where mapSig2 f (a1, a2) = (mapSig2 f a1, mapSig2 f a2)
+instance BindSig2 (Sig8, Sig8) where bindSig2 f (a1, a2) = (,) <$> bindSig2 f a1 <*> bindSig2 f a2
+
+instance SigSpace2 (Sig8, Sig8, Sig8, Sig8) where mapSig2 f (a1, a2, a3, a4) = (mapSig2 f a1, mapSig2 f a2, mapSig2 f a3, mapSig2 f a4)
+instance BindSig2 (Sig8, Sig8, Sig8, Sig8) where bindSig2 f (a1, a2, a3, a4) = (,,,) <$> bindSig2 f a1 <*> bindSig2 f a2 <*> bindSig2 f a3 <*> bindSig2 f a4
+
+instance SigSpace2 (SE Sig) where mapSig2 f = fmap (mapSig2 f)
+instance BindSig2 (SE Sig) where bindSig2 f = fmap (bindSig2 f)
+
+instance SigSpace2 (SE (Sig, Sig)) where mapSig2 f = fmap (mapSig2 f)
+instance BindSig2 (SE (Sig, Sig)) where bindSig2 f = fmap (bindSig2 f)
+
+instance SigSpace2 (SE (Sig, Sig, Sig)) where mapSig2 f = fmap (mapSig2 f)
+instance BindSig2 (SE (Sig, Sig, Sig)) where bindSig2 f = fmap (bindSig2 f)
+
+instance SigSpace2 (SE (Sig, Sig, Sig, Sig)) where mapSig2 f = fmap (mapSig2 f)
+instance BindSig2 (SE (Sig, Sig, Sig, Sig)) where bindSig2 f = fmap (bindSig2 f)
+
+----------------------------------------------------------------------------------------------------------
+-- numeric instances
+
+-- Num
+
+instance Num (SE Sig) where
+ (+) = liftA2 (+)
+ (*) = liftA2 (*)
+ negate = fmap negate
+
+ fromInteger = return . fromInteger
+ signum = fmap signum
+ abs = fmap abs
+
+instance Num (SE (Sig, Sig)) where
+ (+) = liftA2 (+)
+ (*) = liftA2 (*)
+ negate = fmap negate
+
+ fromInteger = return . fromInteger
+ signum = fmap signum
+ abs = fmap abs
+
+instance Num (SE (Sig, Sig, Sig)) where
+ (+) = liftA2 (+)
+ (*) = liftA2 (*)
+ negate = fmap negate
+
+ fromInteger = return . fromInteger
+ signum = fmap signum
+ abs = fmap abs
+
+instance Num (SE (Sig, Sig, Sig, Sig)) where
+ (+) = liftA2 (+)
+ (*) = liftA2 (*)
+ negate = fmap negate
+
+ fromInteger = return . fromInteger
+ signum = fmap signum
+ abs = fmap abs
+
+instance Num (a -> Sig) where
+ (+) = liftA2 (+)
+ (*) = liftA2 (*)
+ negate = fmap negate
+
+ fromInteger = return . fromInteger
+ signum = fmap signum
+ abs = fmap abs
+
+instance Num (a -> (Sig, Sig)) where
+ (+) = liftA2 (+)
+ (*) = liftA2 (*)
+ negate = fmap negate
+
+ fromInteger = return . fromInteger
+ signum = fmap signum
+ abs = fmap abs
+
+instance Num (a -> (Sig, Sig, Sig)) where
+ (+) = liftA2 (+)
+ (*) = liftA2 (*)
+ negate = fmap negate
+
+ fromInteger = return . fromInteger
+ signum = fmap signum
+ abs = fmap abs
+
+instance Num (a -> (Sig, Sig, Sig, Sig)) where
+ (+) = liftA2 (+)
+ (*) = liftA2 (*)
+ negate = fmap negate
+
+ fromInteger = return . fromInteger
+ signum = fmap signum
+ abs = fmap abs
+
+
+instance Num (a -> SE Sig) where
+ (+) = liftA2 (+)
+ (*) = liftA2 (*)
+ negate = fmap negate
+
+ fromInteger = return . fromInteger
+ signum = fmap signum
+ abs = fmap abs
+
+instance Num (a -> SE (Sig, Sig)) where
+ (+) = liftA2 (+)
+ (*) = liftA2 (*)
+ negate = fmap negate
+
+ fromInteger = return . fromInteger
+ signum = fmap signum
+ abs = fmap abs
+
+instance Num (a -> SE (Sig, Sig, Sig)) where
+ (+) = liftA2 (+)
+ (*) = liftA2 (*)
+ negate = fmap negate
+
+ fromInteger = return . fromInteger
+ signum = fmap signum
+ abs = fmap abs
+
+instance Num (a -> SE (Sig, Sig, Sig, Sig)) where
+ (+) = liftA2 (+)
+ (*) = liftA2 (*)
+ negate = fmap negate
+
+ fromInteger = return . fromInteger
+ signum = fmap signum
+ abs = fmap abs
+
+-- Fractional
+
+
+instance Fractional (SE Sig) where
+ (/) = liftA2 (/)
+ fromRational = return . fromRational
+
+instance Fractional (SE (Sig, Sig)) where
+ (/) = liftA2 (/)
+ fromRational = return . fromRational
+
+instance Fractional (SE (Sig, Sig, Sig)) where
+ (/) = liftA2 (/)
+ fromRational = return . fromRational
+
+instance Fractional (SE (Sig, Sig, Sig, Sig)) where
+ (/) = liftA2 (/)
+ fromRational = return . fromRational
+
+instance Fractional (a -> SE Sig) where
+ (/) = liftA2 (/)
+ fromRational = return . fromRational
+
+instance Fractional (a -> SE (Sig, Sig)) where
+ (/) = liftA2 (/)
+ fromRational = return . fromRational
+
+instance Fractional (a -> SE (Sig, Sig, Sig)) where
+ (/) = liftA2 (/)
+ fromRational = return . fromRational
+
+instance Fractional (a -> SE (Sig, Sig, Sig, Sig)) where
+ (/) = liftA2 (/)
+ fromRational = return . fromRational
+
+instance Fractional (a -> Sig) where
+ (/) = liftA2 (/)
+ fromRational = return . fromRational
+
+instance Fractional (a -> (Sig, Sig)) where
+ (/) = liftA2 (/)
+ fromRational = return . fromRational
+
+instance Fractional (a -> (Sig, Sig, Sig)) where
+ (/) = liftA2 (/)
+ fromRational = return . fromRational
+
+instance Fractional (a -> (Sig, Sig, Sig, Sig)) where
+ (/) = liftA2 (/)
+ fromRational = return . fromRational
+
+-----------------------------------------------------------------------
+-----------------------------------------------------------------------
+
+class SigSpace b => At a b c where
+ type AtOut a b c :: *
+ at :: (a -> b) -> c -> AtOut a b c
+
+instance SigSpace a => At Sig Sig a where
+ type AtOut Sig Sig a = a
+ at f a = mapSig f a
+
+------------------------------------------------------
+-- for (Sig -> SE Sig)
+
+instance At Sig (SE Sig) Sig where
+ type AtOut Sig (SE Sig) Sig = SE Sig
+ at f a = f a
+
+instance At Sig (SE Sig) Sig2 where
+ type AtOut Sig (SE Sig) Sig2 = SE Sig2
+ at f a = bindSig f a
+
+instance At Sig (SE Sig) Sig3 where
+ type AtOut Sig (SE Sig) Sig3 = SE Sig3
+ at f a = bindSig f a
+
+instance At Sig (SE Sig) Sig4 where
+ type AtOut Sig (SE Sig) Sig4 = SE Sig4
+ at f a = bindSig f a
+
+instance At Sig (SE Sig) (SE Sig) where
+ type AtOut Sig (SE Sig) (SE Sig) = SE Sig
+ at f a = join $ bindSig f a
+
+instance At Sig (SE Sig) (SE Sig2) where
+ type AtOut Sig (SE Sig) (SE Sig2) = SE Sig2
+ at f a = join $ bindSig f a
+
+instance At Sig (SE Sig) (SE Sig3) where
+ type AtOut Sig (SE Sig) (SE Sig3) = SE Sig3
+ at f a = join $ bindSig f a
+
+instance At Sig (SE Sig) (SE Sig4) where
+ type AtOut Sig (SE Sig) (SE Sig4) = SE Sig4
+ at f a = join $ bindSig f a
+
+-----------------------------------------------------
+-- mono to stereo
+
+instance At Sig Sig2 Sig where
+ type AtOut Sig Sig2 Sig = Sig2
+ at f a = f a
+
+instance At Sig Sig2 (SE Sig) where
+ type AtOut Sig Sig2 (SE Sig) = SE Sig2
+ at f a = fmap f a
+
+instance At Sig Sig2 Sig2 where
+ type AtOut Sig Sig2 Sig2 = Sig2
+ at f a = 0.5 * (f (fst a) + f (snd a))
+
+instance At Sig Sig2 (SE Sig2) where
+ type AtOut Sig Sig2 (SE Sig2) = SE Sig2
+ at f a = fmap (at f) a
+
+---------------------------------------------------------
+
+---------------------------------------------------------
+-- Sig2 -> Sig2
+
+fromMono a = (a, a)
+
+instance At Sig2 Sig2 Sig where
+ type AtOut Sig2 Sig2 Sig = Sig2
+ at f a = f $ fromMono a
+
+instance At Sig2 Sig2 Sig2 where
+ type AtOut Sig2 Sig2 Sig2 = Sig2
+ at f a = f a
+
+instance At Sig2 Sig2 (SE Sig) where
+ type AtOut Sig2 Sig2 (SE Sig) = SE Sig2
+ at f a = fmap (f . fromMono) a
+
+instance At Sig2 Sig2 (SE Sig2) where
+ type AtOut Sig2 Sig2 (SE Sig2) = SE Sig2
+ at f a = fmap f a
+
+---------------------------------------------
+-- Sig2 -> SE Sig2
+
+instance At Sig2 (SE Sig2) Sig where
+ type AtOut Sig2 (SE Sig2) Sig = SE Sig2
+ at f a = f $ fromMono a
+
+instance At Sig2 (SE Sig2) Sig2 where
+ type AtOut Sig2 (SE Sig2) Sig2 = SE Sig2
+ at f a = f a
+
+instance At Sig2 (SE Sig2) (SE Sig) where
+ type AtOut Sig2 (SE Sig2) (SE Sig) = SE Sig2
+ at f a = (f . fromMono) =<< a
+
+instance At Sig2 (SE Sig2) (SE Sig2) where
+ type AtOut Sig2 (SE Sig2) (SE Sig2) = SE Sig2
+ at f a = f =<< a
+
+-----------------------------------------------------------------------
+-----------------------------------------------------------------------
+-- MixAt
+
+-- | It applies an effect and mixes the processed signal with original one.
+-- The first argument is for proportion of dry/wet (original/processed).
+-- It's like @at@ but it allows to balance processed signal with original one.
+class (SigSpace b, At a b c) => MixAt a b c where
+ mixAt :: Sig -> (a -> b) -> c -> AtOut a b c
+
+---------------------------------------------------
+
+instance SigSpace a => MixAt Sig Sig a where
+ mixAt k f a = mapSig (\x -> cfd k x (f x)) a
+
+------------------------------------------------------
+-- for (Sig -> SE Sig)
+
+instance MixAt Sig (SE Sig) Sig where
+ mixAt k f dry = do
+ wet <- f dry
+ return $ cfd k dry wet
+
+instance MixAt Sig (SE Sig) Sig2 where
+ mixAt k f (dry1, dry2) = do
+ wet1 <- f dry1
+ wet2 <- f dry2
+ return $ cfd k (dry1, dry2) (wet1, wet2)
+
+instance MixAt Sig (SE Sig) Sig3 where
+ mixAt k f (dry1, dry2, dry3) = do
+ wet1 <- f dry1
+ wet2 <- f dry2
+ wet3 <- f dry3
+ return $ cfd k (dry1, dry2, dry3) (wet1, wet2, wet3)
+
+instance MixAt Sig (SE Sig) Sig4 where
+ mixAt k f (dry1, dry2, dry3, dry4) = do
+ wet1 <- f dry1
+ wet2 <- f dry2
+ wet3 <- f dry3
+ wet4 <- f dry4
+ return $ cfd k (dry1, dry2, dry3, dry4) (wet1, wet2, wet3, wet4)
+
+instance MixAt Sig (SE Sig) (SE Sig) where
+ mixAt k f dry = do
+ dry1 <- dry
+ wet1 <- f dry1
+ return $ cfd k dry1 wet1
+
+instance MixAt Sig (SE Sig) (SE Sig2) where
+ mixAt k f dry = do
+ (dry1, dry2) <- dry
+ wet1 <- f dry1
+ wet2 <- f dry2
+ return $ cfd k (dry1, dry2) (wet1, wet2)
+
+instance MixAt Sig (SE Sig) (SE Sig3) where
+ mixAt k f dry = do
+ (dry1, dry2, dry3) <- dry
+ wet1 <- f dry1
+ wet2 <- f dry2
+ wet3 <- f dry3
+ return $ cfd k (dry1, dry2, dry3) (wet1, wet2, wet3)
+
+instance MixAt Sig (SE Sig) (SE Sig4) where
+ mixAt k f dry = do
+ (dry1, dry2, dry3, dry4) <- dry
+ wet1 <- f dry1
+ wet2 <- f dry2
+ wet3 <- f dry3
+ wet4 <- f dry4
+ return $ cfd k (dry1, dry2, dry3, dry4) (wet1, wet2, wet3, wet4)
+
+-----------------------------------------------------
+-- mono to stereo
+
+instance MixAt Sig Sig2 Sig where
+ mixAt k f dry = cfd k (dry, dry) wet
+ where wet = f dry
+
+instance MixAt Sig Sig2 (SE Sig) where
+ mixAt k f dry = fmap (\x -> cfd k (x, x) (f x)) dry
+
+instance MixAt Sig Sig2 Sig2 where
+ mixAt k f dry = cfd k dry wet
+ where wet = 0.5 * (f (fst dry) + f (snd dry))
+
+instance MixAt Sig Sig2 (SE Sig2) where
+ mixAt k f dry = do
+ (dry1, dry2) <- dry
+ let wet = 0.5 * (f dry1 + f dry2)
+ return $ cfd k (dry1, dry2) wet
+
+---------------------------------------------------------
+
+---------------------------------------------------------
+-- Sig2 -> Sig2
+
+instance MixAt Sig2 Sig2 Sig where
+ mixAt k f dry1 = cfd k dry wet
+ where
+ dry = fromMono dry1
+ wet = f dry
+
+instance MixAt Sig2 Sig2 Sig2 where
+ mixAt k f dry = cfd k dry wet
+ where
+ wet = f dry
+
+instance MixAt Sig2 Sig2 (SE Sig) where
+ mixAt k f dry1 = do
+ dry <- fmap fromMono dry1
+ let wet = f dry
+ return $ cfd k dry wet
+
+instance MixAt Sig2 Sig2 (SE Sig2) where
+ mixAt k f drySe = do
+ dry <- drySe
+ let wet = f dry
+ return $ cfd k dry wet
+
+
+---------------------------------------------
+-- Sig2 -> SE Sig2
+
+instance MixAt Sig2 (SE Sig2) Sig where
+ mixAt k f dry1 = do
+ wet <- f dry
+ return $ cfd k dry wet
+ where
+ dry = fromMono dry1
+
+instance MixAt Sig2 (SE Sig2) Sig2 where
+ mixAt k f dry = do
+ wet <- f dry
+ return $ cfd k dry wet
+
+instance MixAt Sig2 (SE Sig2) (SE Sig) where
+ mixAt k f dry1 = do
+ dry <- fmap fromMono dry1
+ wet <- f dry
+ return $ cfd k dry wet
+
+instance MixAt Sig2 (SE Sig2) (SE Sig2) where
+ mixAt k f drySe = do
+ dry <- drySe
+ wet <- f dry
+ return $ cfd k dry wet
diff --git a/src/Csound/Typed/Types/Tuple.hs b/src/Csound/Typed/Types/Tuple.hs
index e5d766a..25a3a91 100644
--- a/src/Csound/Typed/Types/Tuple.hs
+++ b/src/Csound/Typed/Types/Tuple.hs
@@ -7,9 +7,7 @@ module Csound.Typed.Types.Tuple(
-- ** Tuple
Tuple(..), TupleMethods, makeTupleMethods,
fromTuple, toTuple, tupleArity, tupleRates, defTuple, mapTuple,
-
- Sig2, Sig3, Sig4, Sig5, Sig6, Sig8,
-
+
-- ** Outs
Sigs, outArity,
@@ -38,6 +36,7 @@ import Data.Boolean
import Csound.Dynamic
import Csound.Typed.Types.Prim
+import Csound.Typed.Types.SigSpace
import Csound.Typed.GlobalState.GE
import Csound.Typed.GlobalState.SE
import Csound.Typed.Types.TupleHelpers
@@ -149,19 +148,15 @@ ar1 = id; ar2 = id; ar4 = id; ar6 = id; ar8 = id
-- out instances
-- | The tuples of signals.
-class (Tuple a, Num a) => Sigs a where
-
-type Sig2 = (Sig, Sig)
-type Sig3 = (Sig, Sig, Sig)
-type Sig4 = (Sig, Sig, Sig, Sig)
-type Sig5 = (Sig, Sig, Sig, Sig, Sig)
-type Sig6 = (Sig, Sig, Sig, Sig, Sig, Sig)
-type Sig8 = (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)
+class (Tuple a, Num a, Fractional a, SigSpace a, BindSig a, SigSpace2 a, BindSig2 a) => Sigs a where
instance Sigs Sig
instance Sigs Sig2
+instance Sigs Sig3
instance Sigs Sig4
+instance Sigs Sig5
instance Sigs Sig6
+instance Sigs Sig7
instance Sigs Sig8
instance Sigs (Sig2, Sig2)
@@ -292,115 +287,5 @@ dirtyTuple a = res
proxy :: SE a -> a
proxy = const undefined
-
-
--------------------------------------------------
--- numeric instances
-
-instance Num Sig2 where
- (a1, a2) + (b1, b2) = (a1 + b1, a2 + b2)
- (a1, a2) * (b1, b2) = (a1 * b1, a2 * b2)
- negate (a1, a2) = (negate a1, negate a2)
-
- fromInteger n = (fromInteger n, fromInteger n)
- signum (a1, a2) = (signum a1, signum a2)
- abs (a1, a2) = (abs a1, abs a2)
-
-instance Num Sig3 where
- (a1, a2, a3) + (b1, b2, b3) = (a1 + b1, a2 + b2, a3 + b3)
- (a1, a2, a3) * (b1, b2, b3) = (a1 * b1, a2 * b2, a3 * b3)
- negate (a1, a2, a3) = (negate a1, negate a2, negate a3)
-
- fromInteger n = (fromInteger n, fromInteger n, fromInteger n)
- signum (a1, a2, a3) = (signum a1, signum a2, signum a3)
- abs (a1, a2, a3) = (abs a1, abs a2, abs a3)
-
-instance Num Sig4 where
- (a1, a2, a3, a4) + (b1, b2, b3, b4) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4)
- (a1, a2, a3, a4) * (b1, b2, b3, b4) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4)
- negate (a1, a2, a3, a4) = (negate a1, negate a2, negate a3, negate a4)
-
- fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n)
- signum (a1, a2, a3, a4) = (signum a1, signum a2, signum a3, signum a4)
- abs (a1, a2, a3, a4) = (abs a1, abs a2, abs a3, abs a4)
-
-instance Num Sig6 where
- (a1, a2, a3, a4, a5, a6) + (b1, b2, b3, b4, b5, b6) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4, a5 + b5, a6 + b6)
- (a1, a2, a3, a4, a5, a6) * (b1, b2, b3, b4, b5, b6) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4, a5 * b5, a6 * b6)
- negate (a1, a2, a3, a4, a5, a6) = (negate a1, negate a2, negate a3, negate a4, negate a5, negate a6)
-
- fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)
- signum (a1, a2, a3, a4, a5, a6) = (signum a1, signum a2, signum a3, signum a4, signum a5, signum a6)
- abs (a1, a2, a3, a4, a5, a6) = (abs a1, abs a2, abs a3, abs a4, abs a5, abs a6)
-
-instance Num Sig8 where
- (a1, a2, a3, a4, a5, a6, a7, a8) + (b1, b2, b3, b4, b5, b6, b7, b8) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4, a5 + b5, a6 + b6, a7 + b7, a8 + b8)
- (a1, a2, a3, a4, a5, a6, a7, a8) * (b1, b2, b3, b4, b5, b6, b7, b8) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4, a5 * b5, a6 * b6, a7 + b7, a8 + b8)
- negate (a1, a2, a3, a4, a5, a6, a7, a8) = (negate a1, negate a2, negate a3, negate a4, negate a5, negate a6, negate a7, negate a8)
-
- fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)
- signum (a1, a2, a3, a4, a5, a6, a7, a8) = (signum a1, signum a2, signum a3, signum a4, signum a5, signum a6, signum a7, signum a8)
- abs (a1, a2, a3, a4, a5, a6, a7, a8) = (abs a1, abs a2, abs a3, abs a4, abs a5, abs a6, abs a7, abs a8)
-
-instance Num (Sig8, Sig8) where
- (a1, a2) + (b1, b2) = (a1 + b1, a2 + b2)
- (a1, a2) * (b1, b2) = (a1 * b1, a2 * b2)
- negate (a1, a2) = (negate a1, negate a2)
-
- fromInteger n = (fromInteger n, fromInteger n)
- signum (a1, a2) = (signum a1, signum a2)
- abs (a1, a2) = (abs a1, abs a2)
-
-instance Num (Sig8, Sig8, Sig8, Sig8) where
- (a1, a2, a3, a4) + (b1, b2, b3, b4) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4)
- (a1, a2, a3, a4) * (b1, b2, b3, b4) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4)
- negate (a1, a2, a3, a4) = (negate a1, negate a2, negate a3, negate a4)
-
- fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n)
- signum (a1, a2, a3, a4) = (signum a1, signum a2, signum a3, signum a4)
- abs (a1, a2, a3, a4) = (abs a1, abs a2, abs a3, abs a4)
-
-instance Num (Sig2, Sig2) where
- (a1, a2) + (b1, b2) = (a1 + b1, a2 + b2)
- (a1, a2) * (b1, b2) = (a1 * b1, a2 * b2)
- negate (a1, a2) = (negate a1, negate a2)
-
- fromInteger n = (fromInteger n, fromInteger n)
- signum (a1, a2) = (signum a1, signum a2)
- abs (a1, a2) = (abs a1, abs a2)
-
-instance Num (Sig2, Sig2, Sig2) where
- (a1, a2, a3) + (b1, b2, b3) = (a1 + b1, a2 + b2, a3 + b3)
- (a1, a2, a3) * (b1, b2, b3) = (a1 * b1, a2 * b2, a3 * b3)
- negate (a1, a2, a3) = (negate a1, negate a2, negate a3)
-
- fromInteger n = (fromInteger n, fromInteger n, fromInteger n)
- signum (a1, a2, a3) = (signum a1, signum a2, signum a3)
- abs (a1, a2, a3) = (abs a1, abs a2, abs a3)
-
-instance Num (Sig2, Sig2, Sig2, Sig2) where
- (a1, a2, a3, a4) + (b1, b2, b3, b4) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4)
- (a1, a2, a3, a4) * (b1, b2, b3, b4) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4)
- negate (a1, a2, a3, a4) = (negate a1, negate a2, negate a3, negate a4)
-
- fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n)
- signum (a1, a2, a3, a4) = (signum a1, signum a2, signum a3, signum a4)
- abs (a1, a2, a3, a4) = (abs a1, abs a2, abs a3, abs a4)
-
-instance Num (Sig2, Sig2, Sig2, Sig2, Sig2) where
- (a1, a2, a3, a4, a5) + (b1, b2, b3, b4, b5) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4, a5 + b5)
- (a1, a2, a3, a4, a5) * (b1, b2, b3, b4, b5) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4, a5 * b5)
- negate (a1, a2, a3, a4, a5) = (negate a1, negate a2, negate a3, negate a4, negate a5)
-
- fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)
- signum (a1, a2, a3, a4, a5) = (signum a1, signum a2, signum a3, signum a4, signum a5)
- abs (a1, a2, a3, a4, a5) = (abs a1, abs a2, abs a3, abs a4, abs a5)
-
-instance Num (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where
- (a1, a2, a3, a4, a5, a6) + (b1, b2, b3, b4, b5, b6) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4, a5 + b5, a6 + b6)
- (a1, a2, a3, a4, a5, a6) * (b1, b2, b3, b4, b5, b6) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4, a5 * b5, a6 * b6)
- negate (a1, a2, a3, a4, a5, a6) = (negate a1, negate a2, negate a3, negate a4, negate a5, negate a6)
-
- fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)
- signum (a1, a2, a3, a4, a5, a6) = (signum a1, signum a2, signum a3, signum a4, signum a5, signum a6)
- abs (a1, a2, a3, a4, a5, a6) = (abs a1, abs a2, abs a3, abs a4, abs a5, abs a6)
+
+