csound-expression-typed 0.1.0.0 → 0.2.0.0

raw patch · 59 files changed

+3638/−329 lines, 59 filesdep ~csound-expression-dynamicPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: csound-expression-dynamic

API changes (from Hackage documentation)

Files

• csound-expression-typed.cabal +32/−5
• data/opcodes/MultiFX/AnalogDelay.udo +35/−0
• data/opcodes/MultiFX/Distortion.udo +28/−0
• data/opcodes/MultiFX/EnvelopeFollower.udo +29/−0
• data/opcodes/MultiFX/Flanger.udo +32/−0
• data/opcodes/MultiFX/FreqShifter.udo +38/−0
• data/opcodes/MultiFX/LoFi.udo +23/−0
• data/opcodes/MultiFX/MonoTrem.udo +35/−0
• data/opcodes/MultiFX/PanTrem.udo +42/−0
• data/opcodes/MultiFX/Phaser.udo +22/−0
• data/opcodes/MultiFX/PitchShifter.udo +30/−0
• data/opcodes/MultiFX/Reverse.udo +29/−0
• data/opcodes/MultiFX/RingModulator.udo +32/−0
• data/opcodes/MultiFX/StChorus.udo +33/−0
• data/opcodes/MultiFX/StereoPingPongDelay.udo +30/−0
• data/opcodes/PitchShifterDelay.udo +49/−0
• data/opcodes/Utility/Delay1k.udo +6/−0
• src/Csound/Typed/Control.hs +10/−2
• src/Csound/Typed/Control/Api.hs +9/−4
• src/Csound/Typed/Control/ArrayTraverse.hs +160/−0
• src/Csound/Typed/Control/Evt.hs +58/−3
• src/Csound/Typed/Control/Instr.hs +4/−3
• src/Csound/Typed/Control/InstrRef.hs +97/−0
• src/Csound/Typed/Control/MacrosArgs.hs +18/−0
• src/Csound/Typed/Control/Mix.hs +26/−2
• src/Csound/Typed/Control/Osc.hs +81/−25
• src/Csound/Typed/Control/Ref.hs +78/−4
• src/Csound/Typed/GlobalState.hs +2/−0
• src/Csound/Typed/GlobalState/Elements.hs +100/−14
• src/Csound/Typed/GlobalState/GE.hs +39/−5
• src/Csound/Typed/GlobalState/InstrApi.hs +74/−0
• src/Csound/Typed/GlobalState/Opcodes.hs +23/−11
• src/Csound/Typed/GlobalState/Options.hs +110/−16
• src/Csound/Typed/GlobalState/Port.hs +113/−0
• src/Csound/Typed/GlobalState/SE.hs +18/−4
• src/Csound/Typed/Gui/BoxModel.hs +1/−0
• src/Csound/Typed/Gui/Cabbage/Cabbage.hs +1/−0
• src/Csound/Typed/Gui/Gui.hs +63/−44
• src/Csound/Typed/Gui/Widget.hs +1/−10
• src/Csound/Typed/InnerOpcodes.hs +16/−0
• src/Csound/Typed/Plugins.hs +14/−1
• src/Csound/Typed/Plugins/Adsr140.hs +2/−1
• src/Csound/Typed/Plugins/Audaciouseq.hs +1/−0
• src/Csound/Typed/Plugins/Diode.hs +1/−0
• src/Csound/Typed/Plugins/Iain.hs +313/−0
• src/Csound/Typed/Plugins/Korg35.hs +1/−0
• src/Csound/Typed/Plugins/SolinaChorus.hs +1/−0
• src/Csound/Typed/Plugins/TabQueue.hs +1/−0
• src/Csound/Typed/Plugins/Utilities.hs +23/−0
• src/Csound/Typed/Plugins/Zdf.hs +1/−0
• src/Csound/Typed/Plugins/ZeroDelayConvolution.hs +1/−0
• src/Csound/Typed/Render.hs +15/−2
• src/Csound/Typed/Types.hs +12/−0
• src/Csound/Typed/Types/Array.hs +612/−0
• src/Csound/Typed/Types/MixSco.hs +31/−9
• src/Csound/Typed/Types/MonoArg.hs +38/−0
• src/Csound/Typed/Types/Prim.hs +235/−42
• src/Csound/Typed/Types/SigSpace.hs +702/−0
• src/Csound/Typed/Types/Tuple.hs +7/−122

@@ -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/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 @@   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 @@     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 @@     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 @@     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 @@     Csound.Typed.Plugins.Audaciouseq     Csound.Typed.Plugins.SolinaChorus     Csound.Typed.Plugins.ZeroDelayConvolution+    Csound.Typed.Plugins.Iain+    Csound.Typed.Plugins.Utilities      Paths_csound_expression_typed 

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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
+

@@ -0,0 +1,6 @@+opcode Delay1k,k,k+kmem init 0+kin xin+xout kmem+kmem = kin+endop

@@ -22,7 +22,13 @@     -- * 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.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@@ -67,7 +76,6 @@     vals <- fromTuple as     setDurationForce dt     return vals-  -- | Gets new id. freshId :: SE D

@@ -7,6 +7,7 @@  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.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 @@     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 @@         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

@@ -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

@@ -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.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 @@ 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 ()@@ -267,4 +271,55 @@  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)) 

@@ -4,13 +4,15 @@     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 @@  apInstr0 :: (Sigs b) => GE InstrId -> b apInstr0 instrId = apInstr instrId unit-

@@ -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]

@@ -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

@@ -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.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 @@     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

@@ -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 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,29 +54,33 @@ -- -- > 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  -- machine is listening, OSC-addres and type. The last argument@@ -96,3 +97,58 @@             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

@@ -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 @@ -- 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 ()@@ -150,3 +170,57 @@ 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)++------------------------------------------------++{-+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

@@ -4,6 +4,7 @@     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.Cache import Csound.Typed.GlobalState.Elements import Csound.Typed.GlobalState.Opcodes+import Csound.Typed.GlobalState.Port

@@ -17,7 +17,8 @@     -- * 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 @@     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 @@  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,11 +343,14 @@     , 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 @@  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,7 +524,42 @@  -- 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 @@ 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"

@@ -17,6 +17,7 @@     -- * Notes     addNote,     -- * GEN routines+    GenId,     saveGen, saveTabs, getNextGlobalGenId,     saveWriteGen, saveWriteTab,     -- * Sf2@@ -33,6 +34,10 @@     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.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 @@     , 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 @@ 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 @@ 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 @@             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 ()@@ -547,6 +563,24 @@ hrtfFileNames :: Int -> IO (String, String) hrtfFileNames sr = liftA2 (,) (getDataFileName (name "left" sr)) (getDataFileName (name "right" sr))     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

@@ -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)

@@ -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 @@  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 @@     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 @@     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 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 @@     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 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 @@ 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 @@ ----------------------------------------------------------- -- 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@@ -389,6 +398,9 @@  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]

@@ -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 @@ -- > 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,8 +57,13 @@         , 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 @@  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 @@  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 @@ idBessels = 12 idWins = 20 idMp3s = 49+idTabHarmonics = 30+idMixOnTab = 31+idMixTabs = 32 --- Identifiers for named GEN-routines+idNormTab = 4+idLinTab = 18 -idPadsynth, idTanh, idExp, idSone, idFarey, idWave :: String+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 -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 ++ "\""

@@ -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))]

@@ -2,17 +2,19 @@     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 @@ 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

@@ -7,6 +7,7 @@ ) where  import Control.Monad+import Control.Applicative import Control.Monad.Trans.State.Strict import Data.Default import Data.Monoid

@@ -20,6 +20,7 @@  import Data.Maybe import Control.Monad.Trans.Writer.Strict+import Control.Applicative  import Csound.Typed.Gui.Cabbage.CabbageLang	 

@@ -7,7 +7,7 @@      -- * Layout     hor, ver, space, sca, horSca, verSca,     -    padding, margin,+    padding, margin, ScaleFactor, resizeGui,     -- * Props     props, forceProps,     Prop(..), BorderType(..), Color,@@ -187,13 +187,20 @@  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 @@  -- | 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 @@             _        -> 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 @@     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 @@       -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 @@     , 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 @@             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

@@ -35,6 +35,7 @@ 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 ()@@ -498,16 +499,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)]  ----------------------------------------------------- 

@@ -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)]

@@ -27,7 +27,18 @@     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@@ -37,3 +48,5 @@ import Csound.Typed.Plugins.Korg35 import Csound.Typed.Plugins.SolinaChorus import Csound.Typed.Plugins.ZeroDelayConvolution+import Csound.Typed.Plugins.Iain+import Csound.Typed.Plugins.Utilities

@@ -4,10 +4,11 @@  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) 

@@ -4,6 +4,7 @@  import Data.Boolean import Control.Monad.Trans.Class+import Control.Applicative  import Csound.Dynamic 

@@ -4,6 +4,7 @@  import Data.Boolean import Control.Monad.Trans.Class+import Control.Applicative  import Csound.Dynamic 

@@ -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]+

@@ -4,6 +4,7 @@  import Data.Boolean import Control.Monad.Trans.Class+import Control.Applicative  import Csound.Dynamic 

@@ -4,6 +4,7 @@  import Data.Boolean import Control.Monad.Trans.Class+import Control.Applicative  import Csound.Dynamic 

@@ -4,6 +4,7 @@  import Data.Boolean import Control.Monad.Trans.Class+import Control.Applicative  import Csound.Dynamic 

@@ -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]

@@ -18,6 +18,7 @@  import Data.Boolean import Control.Monad.Trans.Class+import Control.Applicative  import Csound.Dynamic 

@@ -5,6 +5,7 @@ import Data.Boolean import Data.Default import Control.Monad.Trans.Class+import Control.Applicative  import Csound.Dynamic 

@@ -15,7 +15,9 @@ 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 @@  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 @@     userInstr0 hist     chnUpdateUdo     udos-    sf2-    guiStmt $ getPanels hist+    sf2 +    jackos   +    guiStmt defaultScaleUI $ getPanels hist     where         globalConstants = do             setSr       $ defSampleRate opt@@ -126,6 +131,14 @@             where                  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

@@ -12,6 +12,15 @@     -- * 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.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) 

@@ -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]+

@@ -30,8 +30,13 @@ 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 @@ 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 @@ 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 @@         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 @@             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@@ -102,6 +122,8 @@         onEff instrId start dur es = do             mkEvent instrId start dur []              renderMixSco_ es++        onMonoSnd instr arg es = undefined   mkEvent :: InstrId -> D -> D -> [E] -> Dep ()

@@ -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) 

@@ -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 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 @@ -- | 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 @@ -- 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 @@  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 @@     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,8 +363,13 @@ 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      toGE x = case x of@@ -656,8 +649,17 @@     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,8 +673,14 @@     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 @@ 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)

@@ -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

@@ -7,9 +7,7 @@     -- ** Tuple     Tuple(..), TupleMethods, makeTupleMethods,      fromTuple, toTuple, tupleArity, tupleRates, defTuple, mapTuple,--    Sig2, Sig3, Sig4, Sig5, Sig6, Sig8,-+         -- ** Outs     Sigs, outArity,  @@ -38,6 +36,7 @@  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 @@ -- 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 @@          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)