diff --git a/csound-expression-typed.cabal b/csound-expression-typed.cabal --- a/csound-expression-typed.cabal +++ b/csound-expression-typed.cabal @@ -1,5 +1,5 @@ Name: csound-expression-typed -Version: 0.2.0.1 +Version: 0.2.0.2 Cabal-Version: >= 1.22 License: BSD3 License-file: LICENSE @@ -63,8 +63,8 @@ Library Ghc-Options: -Wall Build-Depends: - base >= 4, base < 5, ghc-prim, containers, transformers >= 0.3, Boolean >= 0.1.0, colour >= 2.0, data-default, deepseq, NumInstances, - wl-pprint, csound-expression-dynamic >= 0.3.0, temporal-media >= 0.6.0, hashable + base >= 4, base < 5, ghc-prim, containers, transformers >= 0.3, Boolean >= 0.1.0, colour >= 2.0, data-default, deepseq, NumInstances, filepath, directory, + wl-pprint, csound-expression-dynamic >= 0.3.2, temporal-media >= 0.6.0, hashable Hs-Source-Dirs: src/ Exposed-Modules: Csound.Typed diff --git a/data/opcodes/MultiFX/AnalogDelay.udo b/data/opcodes/MultiFX/AnalogDelay.udo --- a/data/opcodes/MultiFX/AnalogDelay.udo +++ b/data/opcodes/MultiFX/AnalogDelay.udo @@ -1,35 +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 +; AnalogDelay +; ---------------- +; A analog style delay with signal degradation and saturation options +; +; aout AnalogDelay ain,kmix,ktime,kfback,ktone +; +; Performance +; ----------- +; ain -- input audio to which the flanging effect will be applied +; kmix -- dry / wet mix of the output signal (range 0 to 1) +; ktime -- delay time of the effect in seconds +; kfback -- control of the amount of output signal fed back into the input of the effect (exceeding 1 (100%) is possible and will result in saturation clipping effects) +; ktone -- control of the amount of output signal fed back into the input of the effect (range 0 to 1) + + +opcode AnalogDelay,a,aKKKK + ain,kmix,ktime,kfback,ktone xin ;READ IN INPUT ARGUMENTS + ktone expcurve ktone,4 ;CREATE AN EXPONENTIAL REMAPPING OF ktone + ktone scale ktone,12000,100 ;RESCALE 0 - 1 VALUE + iWet ftgentmp 0,0,1024,-7,0,512,1,512,1 ;RESCALING FUNCTION FOR WET LEVEL CONTROL + iDry ftgentmp 0,0,1024,-7,1,512,1,512,0 ;RESCALING FUNCTION FOR DRY LEVEL CONTROL + kWet table kmix, iWet, 1 ;RESCALE WET LEVEL CONTROL ACCORDING TO FUNCTION TABLE iWet + kDry table kmix, iDry, 1 ;RESCALE DRY LEVEL CONTROL ACCORDING TO FUNCTION TABLE iWet + kporttime linseg 0,0.001,0.1 ;RAMPING UP PORTAMENTO TIME + kTime portk ktime, kporttime*3 ;APPLY PORTAMENTO SMOOTHING TO DELAY TIME PARAMETER + kTone portk ktone, kporttime ;APPLY PORTAMENTO SMOOTHING TO TONE PARAMETER + aTime interp kTime ;INTERPOLATE AND CREAT A-RATE VERSION OF DELAY TIME PARAMETER + aBuffer delayr 5 ;READ FROM (AND INITIALIZE) BUFFER + atap deltap3 aTime ;TAP DELAY BUFFER + atap clip atap, 0, 0dbfs*0.8 ;SIGNAL IS CLIPPED AT MAXIMUM AMPLITUDE USING BRAM DE JONG METHOD + atap tone atap, kTone ;LOW-PASS FILTER DELAY TAP WITHIN DELAY BUFFER + delayw ain+(atap*kfback) ;WRITE INPUT AUDIO AND FEEDBACK SIGNAL INTO DELAY BUFFER + aout sum ain*kDry, atap*kWet ;MIX DRY AND WET SIGNALS + xout aout ;SEND AUDIO BACK TO CALLER INSTRUMENT +endop diff --git a/data/opcodes/MultiFX/Distortion.udo b/data/opcodes/MultiFX/Distortion.udo --- a/data/opcodes/MultiFX/Distortion.udo +++ b/data/opcodes/MultiFX/Distortion.udo @@ -1,28 +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 +; Distortion +; ---------------- +; A distortion effect offering stomp-box-like controls +; +; aout Distortion ain,klevel,kdrive,ktone +; +; Performance +; ----------- +; ain -- input audio to be distorted +; klevel -- output level of the effect (range: 0 to 1) +; kdrive -- intensity of the distortion effect (range: 0 to 1) +; ktone -- tone of a lowpass filter (range: 0 to 1) + +opcode Distortion, a, aKKK + ain,klevel,kdrive,ktone xin ;READ IN INPUT ARGUMENTS + klevel scale klevel,0.8,0 ;RESCALE LEVEL CONTROL + kdrive expcurve kdrive,8 ;EXPONENTIALLY REMAP kdrive + kdrive scale kdrive,0.4,0.01 ;RESCALE kdrive + kLPF expcurve ktone,4 ;EXPONENTIALLY REMAP ktone + kLPF scale kLPF,12000,200 ;RESCALE klpf + kGainComp1 logcurve ktone,700 ;LOGARITHMIC RESCALING OF ktone TO CREAT A GAIN COMPENSATION VARIABLE FOR WHEN TONE IS LOWERED + kGainComp1 scale kGainComp1,1,5 ;RESCALE GAIN COMPENSATION VARIABLE + kpregain = (kdrive*100) ;DEFINE PREGAIN FROM kdrive + kpostgain = 0.5 * (((1-kdrive) * 0.4) + 0.6) ;DEFINE POSTGAIN FROM kdrive + aDist distort1 ain*(32768/0dbfs), kpregain, kpostgain, 0, 0 ;CREATE DISTORTION SIGNAL + aDist butlp aDist/(32768/0dbfs), kLPF ;LOWPASS FILTER DISTORTED SIGNAL + xout aDist*klevel*kGainComp1 ;SEND AUDIO BACK TO CALLER INSTRUMENT. RESCALE WITH USER LEVEL CONTROL AND GAIN COMPENSATION +endop diff --git a/data/opcodes/MultiFX/EnvelopeFollower.udo b/data/opcodes/MultiFX/EnvelopeFollower.udo --- a/data/opcodes/MultiFX/EnvelopeFollower.udo +++ b/data/opcodes/MultiFX/EnvelopeFollower.udo @@ -1,29 +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 +; EnvelopeFollower +; ---------------- +; A dynamic envelope following resonant lowpass filter +; +; aout EnvelopeFollower ain,ksens,kfreq,kres +; +; Performance +; ----------- +; ain -- input audio to be filtered +; ksens -- sensitivity of the envelope follower (suggested range: 0 to 1) +; kfreq -- base frequency of the filter before modulation by the input dynamics (range: 0 to 1) +; kres -- resonance of the lowpass filter (suggested range: 0 to 0.99) + + +opcode EnvelopeFollower,a,aKKK + ain,ksens,kfreq,kres xin ;READ IN INPUT ARGUMENTS + kfreq expcurve kfreq,4 ;CREATE AN EXPONENTIAL REMAPPING OF kfreq + kfreq scale kfreq,10000,10 ;RESCALE 0 - 1 VALUE + ksens logcurve ksens,100 ;CREATE LOGARITHMIC REMAPPING OF ksens + aFollow follow2 ain, 0.01, 0.05 ;AMPLITUDE FOLLOWING AUDIO SIGNAL + kFollow downsamp aFollow ;DOWNSAMPLE TO K-RATE + kFollow expcurve kFollow/0dbfs,3 ;ADJUSTMENT OF THE RESPONSE OF DYNAMICS TO FILTER FREQUENCY MODULATION + kFrq = kfreq + (cpsoct(kFollow*ksens*150)) ;CREATE A LEFT CHANNEL MODULATING FREQUENCY BASE ON THE STATIC VALUE CREATED BY kfreq AND THE AMOUNT OF DYNAMIC ENVELOPE FOLLOWING GOVERNED BY ksens + kFrq port kFrq, 0.05 ;SMOOTH CONTROL SIGNAL USING PORTAMENTO + kFrq limit kFrq, 20,sr/2 ;LIMIT FREQUENCY RANGE TO PREVENT OUT OF RANGE FREQUENCIES + ;IF REALTIME PERFORMNCE IS AN ISSUE, USE moogvcf2 INSTEAD OF moogladder + aout moogladder ain, kFrq, kres ;REDEFINE GLOBAL AUDIO SIGNAL AS FILTERED VERSION OF ITSELF + xout aout ;SEND AUDIO BACK TO CALLER INSTRUMENT +endop diff --git a/data/opcodes/MultiFX/Flanger.udo b/data/opcodes/MultiFX/Flanger.udo --- a/data/opcodes/MultiFX/Flanger.udo +++ b/data/opcodes/MultiFX/Flanger.udo @@ -1,32 +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 +; Flanger +; ---------------- +; A flanger effect following the typical design of a so called 'stomp box' +; +; aout Flanger ain,krate,kdepth,kdelay,kfback +; +; Performance +; ----------- +; ain -- input audio to which the flanging effect will be applied +; krate -- rate control of the lfo of the effect *NOT IN HERTZ* (range 0 to 1) +; kdepth -- depth of the lfo of the effect (range 0 to 1) +; kdelay -- static delay offset of the flanging effect (range 0 to 1) +; kfback -- feedback and therefore intensity of the effect (range 0 to 1) + + +opcode Flanger,a,aKKKK + ain,krate,kdepth,kdelay,kfback xin ;READ IN INPUT ARGUMENTS + krate expcurve krate,50 ;CREATE AN EXPONENTIAL REMAPPING OF krate + krate scale krate,14,0.001 ;RESCALE VALUE + kdelay expcurve kdelay,200 ;CREATE AN EXPONENTIAL REMAPPING OF kdelay + kdelay scale kdelay,0.1,0.00015 ;RESCALE VALUE + ilfoshape ftgentmp 0, 0, 131072, 19, 0.5, 1, 180, 1 ;U-SHAPE PARABOLA FOR LFO + kporttime linseg 0, 0.001, 0.1 ;USE OF AN ENVELOPE VALUE THAT QUICKLY RAMPS UP FROM ZERON TO THE REQUIRED VALUE PREVENTS VARIABLES GLIDING TO THEIR REQUIRED VALUES EACH TIME THE INSTRUMENT IS STARTED + kdlt portk kdelay, kporttime ;PORTAMENTO IS APPLIED TO A VARIABLE. A NEW VARIABLE 'kdlt' IS CREATED. + adlt interp kdlt ;A NEW A-RATE VARIABLE 'adlt' IS CREATED BY INTERPOLATING THE K-RATE VARIABLE 'kdlt' + kdep portk kdepth*0.01, kporttime ;PORTAMENTO IS APPLIED TO A VARIABLE. A NEW VARIABLE 'kdep' IS CREATED. + amod oscili kdep, krate, ilfoshape ;OSCILLATOR THAT MAKES USE OF THE POSITIVE DOMAIN ONLY U-SHAPE PARABOLA WITH FUNCTION TABLE NUMBER ilfoshape + adlt sum adlt, amod ;STATIC DELAY TIME AND MODULATING DELAY TIME ARE SUMMED + adelsig flanger ain, adlt, kfback , 1.2 ;FLANGER SIGNAL CREATED + aout sum ain*0.5, adelsig*0.5 ;CREATE DRY/WET MIX + xout aout ;SEND AUDIO BACK TO CALLER INSTRUMENT +endop diff --git a/data/opcodes/MultiFX/FreqShifter.udo b/data/opcodes/MultiFX/FreqShifter.udo --- a/data/opcodes/MultiFX/FreqShifter.udo +++ b/data/opcodes/MultiFX/FreqShifter.udo @@ -1,38 +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 +; FreqShifter +; ---------------- +; A frequency shifter effect using the hilbert filter +; +; aout FreqShifter adry,kmix,kfreq,kmult,kfback +; +; Performance +; ----------- +; adry -- input audio to be frequency shifted +; kmix -- dry / wet mix of the output signal (range 0 to 1) +; kfreq -- frequency of frequency shifter effect (suggested range -1000 to 1000) +; kmult -- multiplier of frequency value for fine tuning control (suggested range -1 to 1) +; kfback -- control of the amount of output signal fed back into the input of the effect (suggested range 0 to 1) + +opcode FreqShifter,a,aKKKK + adry,kmix,kfreq,kmult,kfback xin ;READ IN INPUT ARGUMENTS + iWet ftgentmp 0,0,1024,-7,0,512,1,512,1 ;RESCALING FUNCTION FOR WET LEVEL CONTROL + iDry ftgentmp 0,0,1024,-7,1,512,1,512,0 ;RESCALING FUNCTION FOR DRY LEVEL CONTROL + isine ftgentmp 0,0,4096,10,1 ;A SINE WAVE SHAPE + kWet table kmix, iWet, 1 ;RESCALE WET LEVEL CONTROL ACCORDING TO FUNCTION TABLE giWet + kDry table kmix, iDry, 1 ;RESCALE DRY LEVEL CONTROL ACCORDING TO FUNCTION TABLE giWet + aFS init 0 ;INITILISE FEEDBACK SIGNAL (FOR FIRST K-PASS) + ain = adry + (aFS * kfback) ;ADD FEEDBACK SIGNAL TO INPUT (AMOUNT OF FEEDBACK CONTROLLED BY 'Feedback Gain' SLIDER) + areal, aimag hilbert ain ;HILBERT OPCODE OUTPUTS TWO PHASE SHIFTED SIGNALS, EACH 90 OUT OF PHASE WITH EACH OTHER + kporttime linseg 0,0.001,0.02 + kfshift portk kfreq*kmult, kporttime + ;QUADRATURE OSCILLATORS. I.E. 90 OUT OF PHASE WITH RESPECT TO EACH OTHER + ;OUTUTS OPCODE AMPLITUDE | FREQ. | FUNCTION_TABLE | INITIAL_PHASE (OPTIONAL;DEFAULTS TO ZERO) + asin oscili 1, kfshift, isine, 0 + acos oscili 1, kfshift, isine, 0.25 + ;RING MODULATE EACH SIGNAL USING THE QUADRATURE OSCILLATORS AS MODULATORS + amod1 = areal * acos + amod2 = aimag * asin + ;UPSHIFTING OUTPUT + aFS = (amod1 - amod2) + aout sum aFS*kWet, adry*kDry ;CREATE WET/DRY MIX + xout aout ;SEND AUDIO BACK TO CALLER INSTRUMENT +endop diff --git a/data/opcodes/MultiFX/LoFi.udo b/data/opcodes/MultiFX/LoFi.udo --- a/data/opcodes/MultiFX/LoFi.udo +++ b/data/opcodes/MultiFX/LoFi.udo @@ -1,23 +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 +; LoFi +; ---------------- +; 'Low Fidelity' distorting effects of bit reduction and downsampling (foldover) +; +; aout LoFi ain,kbits,kfold +; +; Performance +; ----------- +; ain -- input audio to have low fidelity distortion effects applied +; kbits -- bit depth reduction (suggested range 0 to 0.6) +; kfold -- amount of foldover (range 0 to 1) + + +opcode LoFi,a,aKK + ain,kbits,kfold xin ;READ IN INPUT ARGUMENTS + kfold expcurve kfold,500 ;CREATE AN EXPONENTIAL REMAPPING OF kfold + kfold scale kfold,1024,1 ;RESCALE 0 - 1 VALUE TO 1 - 1024 + kvalues pow 2, ((1-(kbits^0.25))*15)+1 ;RAISES 2 TO THE POWER OF kbitdepth. THE OUTPUT VALUE REPRESENTS THE NUMBER OF POSSIBLE VALUES AT THAT PARTICULAR BIT DEPTH + k16bit pow 2, 16 ;RAISES 2 TO THE POWER OF 16 + aout = (int((ain*32768*kvalues)/k16bit)/32768)*(k16bit/kvalues) ;BIT DEPTH REDUCE AUDIO SIGNAL + aout fold aout, kfold ;APPLY SAMPLING RATE FOLDOVER + xout aout ;SEND AUDIO BACK TO CALLER INSTRUMENT +endop diff --git a/data/opcodes/MultiFX/PanTrem.udo b/data/opcodes/MultiFX/PanTrem.udo --- a/data/opcodes/MultiFX/PanTrem.udo +++ b/data/opcodes/MultiFX/PanTrem.udo @@ -1,42 +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 +; PanTrem +; ---------------- +; Auto-panning and tremolo effects +; +; aout1,aout2 PanTrem ainL,ainR,,krate,kdepth,kmode,kwave +; +; Performance +; ----------- +; ainL -- first/left input audio +; ainR -- second/right input audio +; krate -- rate control of the lfo of the effect *NOT IN HERTZ* (range 0 to 1) +; kdepth -- depth of the lfo of the effect (range 0 to 1) +; kmode -- mode of the effect (0=auto-panning 1=tremolo) +; kwave -- waveform used by the lfo (0=sine 1=triangle 2=square) + +opcode PanTrem,aa,aaKKKK + ainL,ainR,krate,kdepth,kmode,kwave xin ;READ IN INPUT ARGUMENTS + krate expcurve krate,5 ;CREATE AN EXPONENTIAL REMAPPING OF krate + krate scale krate,50,0.1 ;RESCALE VALUE + ktrig changed kwave ;IF LFO WAVEFORM TYPE IS CHANGED GENERATE A MOMENTARY '1' (BANG) + if ktrig=1 then ;IF A 'BANG' HAS BEEN GENERATED IN THE ABOVE LINE + reinit UPDATE ;BEGIN A REINITIALIZATION PASS FROM LABEL 'UPDATE' SO THAT LFO WAVEFORM TYPE CAN BE UPDATED + endif ;END OF THIS CONDITIONAL BRANCH + UPDATE: ;LABEL CALLED UPDATE + klfo lfo kdepth, krate, i(kwave) ;CREATE AN LFO + rireturn ;RETURN FROM REINITIALIZATION PASS + klfo = (klfo*0.5)+0.5 ;RESCALE AND OFFSET LFO SO IT STAY WITHIN THE RANGE 0 - 1 ABOUT THE VALUE 0.5 + if kwave=2 then ;IF SQUARE WAVE MODULATION HAS BEEN CHOSEN... + klfo portk klfo, 0.001 ;SMOOTH THE SQUARE WAVE A TINY BIT TO PREVENT CLICKS + endif ;END OF THIS CONDITIONAL BRANCH + if kmode=0 then ;PAN ;IF PANNING MODE IS CHOSEN FROM BUTTON BANK... + alfo interp klfo ;INTERPOLATE K-RATE LFO AND CREATE A-RATE VARIABLE + aoutL = ainL*sqrt(alfo) ;REDEFINE GLOBAL AUDIO LEFT CHANNEL SIGNAL WITH AUTO-PANNING + aoutR = ainR*(1-sqrt(alfo)) ;REDEFINE GLOBAL AUDIO RIGHT CHANNEL SIGNAL WITH AUTO-PANNING + elseif kmode=1 then ;TREM ;IF TREMELO MODE IS CHOSEN FROM BUTTON BANK... + klfo = klfo+(0.5-(kdepth*0.5)) ;MODIFY LFO AT ZERO DEPTH VALUE IS 1 AND AT MAX DEPTH CENTRE OF MODULATION IS 0.5 + alfo interp klfo ;INTERPOLATE K-RATE LFO AND CREATE A-RATE VARIABLE + aoutL = ainL*(alfo^2) ;REDEFINE GLOBAL AUDIO LEFT CHANNEL SIGNAL WITH TREMELO + aoutR = ainR*(alfo^2) ;REDEFINE GLOBAL AUDIO RIGHT CHANNEL SIGNAL WITH TREMELO + endif ;END OF THIS CONDITIONAL BRANCH + xout aoutL,aoutR ;SEND AUDIO BACK TO CALLER INSTRUMENT +endop diff --git a/data/opcodes/MultiFX/Phaser.udo b/data/opcodes/MultiFX/Phaser.udo --- a/data/opcodes/MultiFX/Phaser.udo +++ b/data/opcodes/MultiFX/Phaser.udo @@ -1,22 +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 +; Phaser +; ---------------- +; An phase shifting effect that mimics the design of a so called 'stomp box' +; +; aout Phaser ain,krate,kdepth,kfreq,kfback +; +; Performance +; ----------- +; ain -- input audio to be pitch shifted +; krate -- rate of lfo of the effect (range 0 to 1) +; kdepth -- depth of lfo of the effect (range 0 to 1) +; kfreq -- centre frequency of the phase shifting effect in octaves (suggested range 6 to 11) +; kfback -- feedback and therefore intensity of the effect (range 0 to 1) + +opcode Phaser,a,aKKKK + ain,krate,kdepth,kfreq,kfback xin ;READ IN INPUT ARGUMENTS + krate expcurve krate,10 ;CREATE AN EXPONENTIAL REMAPPING OF krate + krate scale krate,14,0.01 ;RESCALE 0 - 1 VALUE TO 0.01 - 14 + klfo lfo kdepth*0.5, krate, 1 ;LFO FOR THE PHASER (TRIANGULAR SHAPE) + aout phaser1 ain, cpsoct((klfo+(kdepth*0.5)+kfreq)), 8, kfback ;PHASER1 IS APPLIED TO THE INPUT AUDIO + xout aout ;SEND AUDIO BACK TO CALLER INSTRUMENT +endop diff --git a/data/opcodes/MultiFX/PitchShifter.udo b/data/opcodes/MultiFX/PitchShifter.udo --- a/data/opcodes/MultiFX/PitchShifter.udo +++ b/data/opcodes/MultiFX/PitchShifter.udo @@ -1,30 +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 +; PitchShifter +; ------------ +; A pitch shifter effect based on FFT technology +; +; aout PitchShifter ain,kmix,kpitch,kfine,kfback +; +; Performance +; ----------- +; ain -- input audio to be pitch shifted +; kmix -- dry / wet mix of the output signal (range 0 to 1) +; kpitch -- pitch shifting interval in thousands of a semitone (suggested range -0.012 to 0.012) +; kfine -- fine control of pitch shifting interval in octaves (range -1/12 to 1/12) +; kfback -- control of the amount of output signal fed back into the input of the effect (suggested range 0 to 1) + +opcode PitchShifter,a,aKKKi + ain,kmix,kscal,kfback,ifftsize xin ;READ IN INPUT ARGUMENTS + iWet ftgentmp 0,0,1024,-7,0,512,1,512,1 ;RESCALING FUNCTION FOR WET LEVEL CONTROL + iDry ftgentmp 0,0,1024,-7,1,512,1,512,0 ;RESCALING FUNCTION FOR DRY LEVEL CONTROL + kWet table kmix, iWet, 1 ;RESCALE WET LEVEL CONTROL ACCORDING TO FUNCTION TABLE iWet + kDry table kmix, iDry, 1 ;RESCALE DRY LEVEL CONTROL ACCORDING TO FUNCTION TABLE iWet + aPS init 0 ;INITIALIZE aOutL FOR FIRST PERFORMANCE TIME PASS + ; kscal = octave(((kpitch*1000)/12)+kfine) ;DERIVE PITCH SCALING RATIO. NOTE THAT THE 'COARSE' PITCH DIAL BECOMES STEPPED IN SEMITONE INTERVALS + ioverlap = ifftsize / 4 + iwinsize = ifftsize + fsig1 pvsanal ain+(aPS*kfback), ifftsize,ioverlap,iwinsize,0 ;PHASE VOCODE ANALYSE LEFT CHANNEL + fsig2 pvscale fsig1, kscal ;RESCALE PITCH + aPS pvsynth fsig2 ;RESYNTHESIZE FROM FSIG + aout sum ain*kDry, aPS*kWet ;REDEFINE GLOBAL AUDIO SIGNAL FROM MIX OF DRY AND WET SIGNALS + xout aout ;SEND AUDIO BACK TO CALLER INSTRUMENT +endop diff --git a/data/opcodes/MultiFX/Reverse.udo b/data/opcodes/MultiFX/Reverse.udo --- a/data/opcodes/MultiFX/Reverse.udo +++ b/data/opcodes/MultiFX/Reverse.udo @@ -1,29 +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 +; Reverse +; ---------------- +; An effect that reverses an audio stream in chunks +; +; aout Reverse ain,ktime +; +; Performance +; ----------- +; ain -- input audio to be reversed +; ktime -- time duration of each chunk (suggested range: 0.3 to 2) + +opcode Reverse, a, aK ;nb. CAPITAL K CREATE A K-RATE VARIABLE THAT HAS A USEFUL VALUE ALSO AT I-TIME + ain,ktime xin ;READ IN INPUT ARGUMENTS + ktrig changed ktime ;IF ktime CONTROL IS MOVED GENERATE A MOMENTARY '1' IMPULSE + if ktrig=1 then ;IF A TRIGGER HAS BEEN GENERATED IN THE LINE ABOVE... + reinit UPDATE ;...BEGIN A REINITILISATION PASS FROM LABEL 'UPDATE' + endif ;END OF CONDITIONAL BRANCH + UPDATE: ;LABEL CALLED 'UPDATE' + itime = i(ktime) ;CREATE AN I-TIME VERSION OF ktime + aptr phasor 2/itime ;CREATE A MOVING PHASOR THAT WITH BE USED TO TAP THE DELAY BUFFER + aptr = aptr*itime ;SCALE PHASOR ACCORDING TO THE LENGTH OF THE DELAY TIME CHOSEN BY THE USER + ienv ftgentmp 0,0,1024,7,0,(1024*0.01),1,(1024*0.98),1,(0.01*1024),0 ;ANTI-CLICK ENVELOPE SHAPE + aenv poscil 1, 2/itime, ienv ;CREATE A CYCLING AMPLITUDE ENVELOPE THAT WILL SYNC TO THE TAP DELAY TIME PHASOR + abuffer delayr itime ;CREATE A DELAY BUFFER + atap deltap3 aptr ;READ AUDIO FROM A TAP WITHIN THE DELAY BUFFER + delayw ain ;WRITE AUDIO INTO DELAY BUFFER + rireturn ;RETURN FROM REINITIALISATION PASS + xout atap*aenv ;SEND AUDIO BACK TO CALLER INSTRUMENT. APPLY AMPLITUDE ENVELOPE TO PREVENT CLICKS. +endop diff --git a/data/opcodes/MultiFX/RingModulator.udo b/data/opcodes/MultiFX/RingModulator.udo --- a/data/opcodes/MultiFX/RingModulator.udo +++ b/data/opcodes/MultiFX/RingModulator.udo @@ -1,32 +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 +; RingModulator +; ---------------- +; An ring modulating effect with an envelope follower +; +; aout RingModulator ain,kmix,kfreq,kenv +; +; Performance +; ----------- +; ain -- input audio to be pitch shifted +; kmix -- dry / wet mix of the output signal (range 0 to 1) +; kfreq -- frequency of thew ring modulator *NOT IN HERTZ* (range 0 to 1) +; kenv -- amount of dynamic envelope following modulation of frequency (range 0 to 1) + +opcode RingModulator,a,aKKK + ain,kmix,kfreq,kenv xin ;READ IN INPUT ARGUMENTS + kfreq expcurve kfreq,4 ;CREATE AN EXPONENTIAL REMAPPING OF kfreq + kfreq scale kfreq,5000,10 ;RESCALE 0 - 1 VALUE TO 10 - 5000 + iWet ftgentmp 0,0,1024,-7,0,512,1,512,1 ;RESCALING FUNCTION FOR WET LEVEL CONTROL + iDry ftgentmp 0,0,1024,-7,1,512,1,512,0 ;RESCALING FUNCTION FOR DRY LEVEL CONTROL + isine ftgentmp 0,0,4096,10,1 ;SINE WAVE + kWet table kmix, iWet, 1 ;RESCALE WET LEVEL CONTROL ACCORDING TO FUNCTION TABLE iWet + kDry table kmix, iDry, 1 ;RESCALE DRY LEVEL CONTROL ACCORDING TO FUNCTION TABLE iDry + kporttime linseg 0,0.001,0.02 ;PORTAMENTO VARIABLE + kModFrq portk kfreq, kporttime ;SMOOTH VARIABLE CHANGES + aFollow follow2 ain, 0.01, 0.1 ;AMPLITUDE FOLLOWING AUDIO SIGNAL + kFollow downsamp aFollow + kFollow logcurve kFollow/0dbfs,20 + kModFrq = kModFrq + (cpsoct(kFollow*kenv*30)) ;CREATE A LEFT CHANNEL MODULATING FREQUENCY BASE ON THE STATIC VALUE CREATED BY kfreq AND THE AMOUNT OF DYNAMIC ENVELOPE FOLLOWING GOVERNED BY kenv + aMod poscil 1, kModFrq, isine ;CREATE RING MODULATING SIGNAL + aout sum ain*kDry, ain*aMod*kWet ;MIX DRY AND WET SIGNALS + xout aout ;SEND AUDIO BACK TO CALLER INSTRUMENT +endop diff --git a/data/opcodes/MultiFX/StChorus.udo b/data/opcodes/MultiFX/StChorus.udo --- a/data/opcodes/MultiFX/StChorus.udo +++ b/data/opcodes/MultiFX/StChorus.udo @@ -1,33 +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 +; 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 diff --git a/src/Csound/Typed/GlobalState/GE.hs b/src/Csound/Typed/GlobalState/GE.hs --- a/src/Csound/Typed/GlobalState/GE.hs +++ b/src/Csound/Typed/GlobalState/GE.hs @@ -5,15 +5,15 @@ -- * Globals onGlobals, -- * Midi - MidiAssign(..), Msg(..), renderMidiAssign, saveMidi, saveToMidiInstr, + MidiAssign(..), Msg(..), renderMidiAssign, saveMidi, saveToMidiInstr, MidiCtrl(..), saveMidiCtrl, renderMidiCtrl, -- * Instruments saveAlwaysOnInstr, onInstr, saveUserInstr0, getSysExpr, -- * Named instruments saveNamedInstr, -- * Total duration - TotalDur(..), pureGetTotalDurForF0, getTotalDurForTerminator, - setDurationForce, setDuration, setDurationToInfinite, + TotalDur(..), pureGetTotalDurForF0, getTotalDurForTerminator, + setDurationForce, setDuration, setDurationToInfinite, -- * Notes addNote, -- * GEN routines @@ -29,7 +29,7 @@ -- * Cache GetCache, SetCache, withCache, -- * Guis - newGuiHandle, saveGuiRoot, saveDefKeybdPanel, appendToGui, + newGuiHandle, saveGuiRoot, saveDefKeybdPanel, appendToGui, newGuiVar, getPanels, guiHandleToVar, guiInstrExp, listenKeyEvt, Key(..), KeyEvt(..), Guis(..), @@ -43,7 +43,7 @@ -- * Hrtf pan simpleHrtfmove, simpleHrtfstat, -- * Udo plugins - addUdoPlugin, renderUdoPlugins + addUdoPlugin, renderUdoPlugins ) where import Paths_csound_expression_typed @@ -60,7 +60,7 @@ import Control.Monad.Trans.State.Strict import Control.Monad.Trans.Reader -import Csound.Dynamic hiding (readMacrosDouble, readMacrosString, readMacrosInt) +import Csound.Dynamic hiding (readMacrosDouble, readMacrosString, readMacrosInt) import qualified Csound.Dynamic as D(readMacrosDouble, readMacrosString, readMacrosInt) import Csound.Typed.GlobalState.Options @@ -102,11 +102,11 @@ instance MonadIO GE where liftIO = GE . liftIO . liftIO - + data History = History { genMap :: GenMap , writeGenMap :: WriteGenMap - , globalGenCounter :: Int + , globalGenCounter :: Int , stringMap :: StringMap , sfMap :: SfMap , midiMap :: MidiMap GE @@ -144,7 +144,7 @@ renderMidiCtrl :: Monad m => MidiCtrl -> DepT m () renderMidiCtrl (MidiCtrl chno ctrlno val) = initc7 chno ctrlno val - where + where initc7 :: Monad m => E -> E -> E -> DepT m () initc7 a b c = depT_ $ opcs "initc7" [(Xr, [Ir, Ir, Ir])] [a, b, c] @@ -154,17 +154,17 @@ getTotalDurForTerminator = fmap (getTotalDurForTerminator' . totalDur) getHistory pureGetTotalDurForF0 :: Maybe TotalDur -> Double -pureGetTotalDurForF0 = toDouble . maybe InfiniteDur id +pureGetTotalDurForF0 = toDouble . maybe InfiniteDur id where - toDouble x = case x of + toDouble x = case x of _ -> infiniteDur - + getTotalDurForTerminator' :: Maybe TotalDur -> E getTotalDurForTerminator' = toExpr . maybe InfiniteDur id where - toExpr x = case x of + toExpr x = case x of InfiniteDur -> infiniteDur - ExpDur e -> e + ExpDur e -> e setDurationToInfinite :: GE () setDurationToInfinite = setTotalDur InfiniteDur @@ -173,7 +173,7 @@ setDuration = setTotalDur . ExpDur setDurationForce :: E -> GE () -setDurationForce = setTotalDur . ExpDur +setDurationForce = setTotalDur . ExpDur saveStr :: String -> GE E saveStr = fmap prim . onStringMap . newString @@ -202,15 +202,15 @@ onSfMap = onHistory sfMap (\val h -> h{ sfMap = val }) saveSf :: SfSpec -> GE Int -saveSf = onSfMap . newSf +saveSf = onSfMap . newSf sfTable :: History -> [(SfSpec, Int)] sfTable = M.toList . idMapContent . sfMap saveBandLimitedWave :: BandLimited -> GE BandLimitedId saveBandLimitedWave = onBandLimitedMap . saveBandLimited - where onBandLimitedMap = onHistory - (\a -> (bandLimitedMap a)) + where onBandLimitedMap = onHistory + (\a -> (bandLimitedMap a)) (\(blm) h -> h { bandLimitedMap = blm}) setTotalDur :: TotalDur -> GE () @@ -237,7 +237,7 @@ getSysExpr terminatorInstrId = do e1 <- withHistory $ clearGlobals . globals dt <- getTotalDurForTerminator - let e2 = event_i $ Event (primInstrId terminatorInstrId) dt 0.01 [] + let e2 = event_i $ Event (primInstrId terminatorInstrId) dt 0.01 [] return $ e1 >> e2 where clearGlobals = snd . renderGlobals @@ -283,9 +283,9 @@ -- update fields onHistory :: (History -> a) -> (a -> History -> History) -> State a b -> GE b -onHistory getter setter st = GE $ ReaderT $ \_ -> StateT $ \history -> +onHistory getter setter st = GE $ ReaderT $ \_ -> StateT $ \history -> let (res, s1) = runState st (getter history) - in return (res, setter s1 history) + in return (res, setter s1 history) type UpdField a b = State a b -> GE b @@ -314,11 +314,11 @@ type SetCache a b = a -> b -> Cache GE -> Cache GE -toCache :: SetCache a b -> a -> b -> GE () +toCache :: SetCache a b -> a -> b -> GE () toCache f key val = modifyHistory $ \h -> h { cache = f key val (cache h) } withCache :: TotalDur -> GetCache key val -> SetCache key val -> key -> GE val -> GE val -withCache dur lookupResult saveResult key getResult = do +withCache dur lookupResult saveResult key getResult = do ma <- fromCache lookupResult key res <- case ma of Just a -> return a @@ -335,19 +335,19 @@ data Guis = Guis { guiStateNewId :: Int , guiStateInstr :: DepT GE () - , guiStateToDraw :: [GuiNode] + , guiStateToDraw :: [GuiNode] , guiStateRoots :: [Panel] , guiKeyEvents :: KeyCodeMap } --- it maps integer key codes to global variables +-- it maps integer key codes to global variables -- that acts like sensors. type KeyCodeMap = IM.IntMap Var -instance Default Guis where +instance Default Guis where def = Guis 0 (return ()) [] [] def -newGuiHandle :: GE GuiHandle -newGuiHandle = modifyWithHistory $ \h -> +newGuiHandle :: GE GuiHandle +newGuiHandle = modifyWithHistory $ \h -> let (n, g') = bumpGuiStateId $ guis h in (GuiHandle n, h{ guis = g' }) @@ -366,12 +366,12 @@ , guiStateInstr = guiStateInstr st >> act } saveGuiRoot :: Panel -> GE () -saveGuiRoot g = modifyGuis $ \st -> +saveGuiRoot g = modifyGuis $ \st -> st { guiStateRoots = g : guiStateRoots st } saveDefKeybdPanel :: GE () saveDefKeybdPanel = saveGuiRoot $ Single (Win "" Nothing g) isKeybd - where + where g = defText "keyboard listener" isKeybd = True @@ -379,12 +379,12 @@ bumpGuiStateId s = (guiStateNewId s, s{ guiStateNewId = succ $ guiStateNewId s }) getPanels :: History -> [Panel] -getPanels h = fmap (mapGuiOnPanel (restoreTree m)) $ guiStateRoots $ guis h +getPanels h = fmap (mapGuiOnPanel (restoreTree m)) $ guiStateRoots $ guis h where m = guiMap $ guiStateToDraw $ guis h -- have to be executed after all instruments guiInstrExp :: GE (DepT GE ()) -guiInstrExp = withHistory (guiStateInstr . guis) +guiInstrExp = withHistory (guiStateInstr . guis) -- key codes @@ -394,16 +394,16 @@ deriving (Show, Eq) -- | Keys. -data Key +data Key = CharKey Char | F1 | F2 | F3 | F4 | F5 | F6 | F7 | F8 | F9 | F10 | F11 | F12 | Scroll - | CapsLook | LeftShift | RightShift | LeftCtrl | RightCtrl | Enter | LeftAlt | RightAlt | LeftWinKey | RightWinKey - | Backspace | ArrowUp | ArrowLeft | ArrowRight | ArrowDown + | CapsLook | LeftShift | RightShift | LeftCtrl | RightCtrl | Enter | LeftAlt | RightAlt | LeftWinKey | RightWinKey + | Backspace | ArrowUp | ArrowLeft | ArrowRight | ArrowDown | Insert | Home | PgUp | Delete | End | PgDown - | NumLock | NumDiv | NumMul | NumSub | NumHome | NumArrowUp - | NumPgUp | NumArrowLeft | NumSpace | NumArrowRight | NumEnd - | NumArrowDown | NumPgDown | NumIns | NumDel | NumEnter | NumPlus - | Num7 | Num8 | Num9 | Num4 | Num5 | Num6 | Num1 | Num2 | Num3 | Num0 | NumDot + | NumLock | NumDiv | NumMul | NumSub | NumHome | NumArrowUp + | NumPgUp | NumArrowLeft | NumSpace | NumArrowRight | NumEnd + | NumArrowDown | NumPgDown | NumIns | NumDel | NumEnter | NumPlus + | Num7 | Num8 | Num9 | Num4 | Num5 | Num6 | Num1 | Num2 | Num3 | Num0 | NumDot deriving (Show, Eq) keyToCode :: Key -> Int @@ -411,7 +411,7 @@ CharKey a -> fromEnum a F1 -> 446 F2 -> 447 - F3 -> 448 + F3 -> 448 F4 -> 449 F5 -> 450 F6 -> 451 @@ -422,7 +422,7 @@ F11 -> 457 F12 -> 458 Scroll-> 276 - CapsLook -> 485 + CapsLook -> 485 LeftShift -> 481 RightShift -> 482 LeftCtrl -> 483 @@ -432,7 +432,7 @@ RightAlt -> 490 LeftWinKey -> 491 RightWinKey -> 492 - Backspace -> 264 + Backspace -> 264 ArrowUp -> 338 ArrowLeft -> 337 ArrowRight -> 339 @@ -491,7 +491,7 @@ Nothing -> do var <- onGlobals $ newClearableGlobalVar Kr 0 hist2 <- getHistory - let newKeyMap = IM.insert code var keyMap + let newKeyMap = IM.insert code var keyMap newG = g { guiKeyEvents = newKeyMap } hist3 = hist2 { guis = newG } putHistory hist3 @@ -507,7 +507,7 @@ isChange = changed keys ==* 1 when1 Kr isChange $ do whens Kr (fmap (uncurry $ listenEvt keys) events) doNothing - where + where doNothing = return () listenEvt keySig keyCode var = (keySig ==* int keyCode, writeVar var 1) @@ -520,7 +520,7 @@ getKeyEventListener :: GE (Maybe Instr) getKeyEventListener = do h <- getHistory - if (IM.null $ guiKeyEvents $ guis h) + if (IM.null $ guiKeyEvents $ guis h) then return Nothing else do saveAlwaysOnInstr keyEventInstrId @@ -539,7 +539,7 @@ -- cabbage cabbage :: Cabbage.Cab -> GE () -cabbage cab = modifyHistory $ \h -> h { cabbageGui = Just $ Cabbage.runCab cab } +cabbage cab = modifyHistory $ \h -> h { cabbageGui = Just $ Cabbage.runCab cab } ----------------------------------------------- -- head pan @@ -580,7 +580,7 @@ readMacrosBy reader allocator name initValue = do onMacrosInits $ initMacros $ allocator name initValue return $ reader name - where onMacrosInits = onHistory macrosInits (\val h -> h { macrosInits = val }) + where onMacrosInits = onHistory macrosInits (\val h -> h { macrosInits = val }) ----------------------------------------------- -- udo plugins @@ -589,7 +589,7 @@ addUdoPlugin p = onUdo (E.addUdoPlugin p) where onUdo = onHistory udoPlugins (\val h -> h{ udoPlugins = val }) -renderUdoPlugins :: History -> IO String +renderUdoPlugins :: History -> IO String renderUdoPlugins h = fmap concat $ mapM getUdoPluginBody $ getUdoPluginNames $ udoPlugins h getUdoPluginBody :: String -> IO String diff --git a/src/Csound/Typed/GlobalState/Options.hs b/src/Csound/Typed/GlobalState/Options.hs --- a/src/Csound/Typed/GlobalState/Options.hs +++ b/src/Csound/Typed/GlobalState/Options.hs @@ -1,8 +1,8 @@ module Csound.Typed.GlobalState.Options ( Options(..), - defGain, defSampleRate, defBlockSize, defTabFi, defScaleUI, + 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 @@ -12,7 +12,7 @@ idTabHarmonics, idMixOnTab, idMixTabs, idNormTab, idPolynomFuns, idLinTab, idRandDists, idReadNumFile, idReadNumTab, idExpsBreakPoints, idLinsBreakPoints, idReadTrajectoryFile, idMixSines1, idMixSines2, - idRandHist, idRandPairs, idRandRanges, idPvocex, idTuning, idMultichannel, + idRandHist, idRandPairs, idRandRanges, idPvocex, idTuning, idMultichannel, -- *** String identifiers idPadsynth, idTanh, idExp, idSone, idFarey, idWave, -- * Jacko @@ -30,23 +30,23 @@ -- | Csound options. The default values are -- --- > flags = def -- the only flag set by default is "no-displays" +-- > flags = def -- the only flag set by default is "no-displays" -- > -- to supress the display of the tables -- > sampleRate = 44100 -- > blockSize = 64 -- > gain = 0.5 -- > tabFi = fineFi 13 [(idLins, 11), (idExps, 11), (idConsts, 9), (idSplines, 11), (idStartEnds, 12)] } -- > scaleUI = (1, 1) -data Options = Options +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 - , csdScaleUI :: Maybe (Double, Double) -- ^ Scale factors for UI-window + , csdTabFi :: Maybe TabFi -- ^ Default fidelity of the arrays + , csdScaleUI :: Maybe (Double, Double) -- ^ Scale factors for UI-window , csdJacko :: Maybe Jacko - } - + } deriving (Eq, Show, Read) + instance Default Options where def = Options def def def def def def def @@ -58,7 +58,7 @@ , csdBlockSize = csdBlockSize a <|> csdBlockSize b , csdGain = csdGain a <|> csdGain b , csdTabFi = csdTabFi a <|> csdTabFi b - , csdScaleUI = csdScaleUI a <|> csdScaleUI b + , csdScaleUI = csdScaleUI a <|> csdScaleUI b , csdJacko = csdJacko a <|> csdJacko b } defScaleUI :: Options -> (Double, Double) @@ -75,35 +75,36 @@ defTabFi :: Options -> TabFi defTabFi = maybe def id . csdTabFi - + -- | Table size fidelity (how many points in the table by default). data TabFi = TabFi { tabFiBase :: Int , tabFiGens :: IM.IntMap Int - , tabNamedFiGens :: M.Map String Int } + , tabNamedFiGens :: M.Map String Int + } deriving (Eq, Show, Read) instance Default TabFi where - def = fineFi 13 - [(idLins, 11), (idExps, 11), (idConsts, 9), (idSplines, 11), (idStartEnds, 12), (idExpsBreakPoints, 11), (idLinsBreakPoints, 11), (idRandDists, 6)] + def = fineFi 13 + [(idLins, 11), (idExps, 11), (idConsts, 9), (idSplines, 11), (idStartEnds, 12), (idExpsBreakPoints, 11), (idLinsBreakPoints, 11), (idRandDists, 6)] [(idPadsynth, 18), (idSone, 14), (idTanh, 13), (idExp, 13)] - --- | Sets different table size for different GEN-routines. + +-- | Sets different table size for different GEN-routines. -- --- > fineFi n ps +-- > fineFi n ps -- --- where --- +-- where +-- -- * @n@ is the default value for table size (size is a @n@ power of 2) for all gen routines that are not listed in the next argument @ps@. -- --- * @ps@ is a list of pairs @(genRoutineId, tableSizeDegreeOf2)@ that sets the given table size for a +-- * @ps@ is a list of pairs @(genRoutineId, tableSizeDegreeOf2)@ that sets the given table size for a -- given GEN-routine. -- -- with this function we can set lower table sizes for tables that are usually used in the envelopes. fineFi :: Int -> [(Int, Int)] -> [(String, Int)] -> TabFi fineFi n xs ys = TabFi n (IM.fromList xs) (M.fromList ys) --- | Sets the same table size for all tables. +-- | Sets the same table size for all tables. -- -- > coarseFi n -- @@ -134,7 +135,7 @@ idCubes = 6 idExps = 5 idStartEnds = 16 -idSplines = 8 +idSplines = 8 idPolys = 3 idChebs1 = 13 idChebs2 = 14 @@ -191,7 +192,7 @@ -- But the Jacko opcodes provide more options. -- -- see the Csound docs for details: -data Jacko = Jacko +data Jacko = Jacko { jackoClient :: String , jackoServer :: String , jackoAudioIns :: [JackoConnect] @@ -199,10 +200,11 @@ , jackoMidiIns :: [JackoConnect] , jackoMidiOuts :: [JackoConnect] , jackoFreewheel :: Bool - , jackoInfo :: Bool } + , jackoInfo :: Bool + } deriving (Eq, Show, Read) instance Default Jacko where - def = Jacko + def = Jacko { jackoClient = "csound-exp" , jackoServer = "default" , jackoAudioIns = [] @@ -210,7 +212,7 @@ , jackoMidiIns = [] , jackoMidiOuts = [] , jackoFreewheel = False - , jackoInfo = False } + , jackoInfo = False } renderJacko :: Jacko -> String renderJacko spec = unlines $ filter ( /= "") @@ -222,7 +224,7 @@ , renderConnections "JackoMidiInConnect" $ jackoMidiIns spec , renderConnections "JackoMidiOutConnect" $ jackoMidiOuts spec , "JackoOn" ] - where + where renderConnections name links = unlines $ fmap (renderLink name) links renderLink name (a, b) = name ++ " " ++ (str a) ++ ", " ++ (str b) diff --git a/src/Csound/Typed/Gui/Widget.hs b/src/Csound/Typed/Gui/Widget.hs --- a/src/Csound/Typed/Gui/Widget.hs +++ b/src/Csound/Typed/Gui/Widget.hs @@ -1,22 +1,23 @@ +{-# Language DeriveFunctor #-} module Csound.Typed.Gui.Widget( -- * Panels - panel, keyPanel, tabs, keyTabs, panels, + panel, keyPanel, tabs, keyTabs, panels, keyPanels, panelBy, keyPanelBy, tabsBy, keyTabsBy, -- * Types - Input, Output, Inner, + Input(..), Output(..), Inner(..), noInput, noOutput, noInner, - Widget, widget, Source, source, Sink, sink, Display, display, SinkSource, sinkSource, sourceSlice, sinkSlice, + Widget, widget, Source(..), source, Sink(..), sink, Display(..), display, SinkSource(..), sinkSource, sourceSlice, sinkSlice, mapSource, mapGuiSource, mhor, mver, msca, -- * Widgets count, countSig, joy, knob, roller, slider, sliderBank, numeric, meter, box, button, butBank, butBankSig, butBank1, butBankSig1, toggle, toggleSig, - setNumeric, + setNumeric, setToggle, setToggleSig, setKnob, setSlider, -- * Transformers setTitle, - -- * Keyboard + -- * Keyboard KeyEvt(..), Key(..), keyIn ) where @@ -108,7 +109,7 @@ -- | A value for widgets that consume nothing. noOutput :: Output () -noOutput = return +noOutput = return -- | A value for widgets that produce nothing. noInput :: Input () @@ -118,33 +119,34 @@ noInner :: Inner noInner = return () --- | A widget consists of visible element (Gui), value consumer (Output) +-- | A widget consists of visible element (Gui), value consumer (Output) -- and producer (Input) and an inner state (Inner). type Widget a b = SE (Gui, Output a, Input b, Inner) -- | A consumer of the values. -type Sink a = SE (Gui, Output a) +newtype Sink a = Sink { unSink :: SE (Gui, Output a) } -- | A producer of the values. -type Source a = SE (Gui, Input a) +newtype Source a = Source { unSource :: SE (Gui, Input a) } + deriving (Functor) -type SinkSource a = SE (Gui, Output a, Input a) +newtype SinkSource a = SinkSource { unSinkSource :: SE (Gui, Output a, Input a) } -- | A static element. We can only look at it. -type Display = SE Gui +newtype Display = Display { unDisplay :: SE Gui } -- | A handy function for transforming the value of producers. mapSource :: (a -> b) -> Source a -> Source b -mapSource f = fmap $ \(gui, ins) -> (gui, f ins) +mapSource = fmap -- | A handy function for transforming the GUIs of producers. mapGuiSource :: (Gui -> Gui) -> Source a -> Source a -mapGuiSource f = fmap $ \(gui, ins) -> (f gui, ins) +mapGuiSource f (Source x) = Source $ fmap (\(gui, ins) -> (f gui, ins)) x mGroup :: Monoid a => ([Gui] -> Gui) -> [Source a] -> Source a -mGroup guiGroup as = do - (gs, fs) <- fmap unzip $ sequence as +mGroup guiGroup as = Source $ do + (gs, fs) <- fmap unzip $ sequence $ fmap unSource as return (guiGroup gs, mconcat fs) -- | Horizontal grouping of widgets that can produce monoidal values. @@ -164,72 +166,72 @@ widget x = go =<< x where go :: (Gui, Output a, Input b, Inner) -> Widget a b - go (gui, outs, ins, inner) = geToSe $ do + go (gui, outs, ins, inner) = geToSe $ do handle <- newGuiHandle appendToGui (GuiNode gui handle) (unSE inner) return (fromGuiHandle handle, outs, ins, inner) -- | A producer constructor. source :: SE (Gui, Input a) -> Source a -source x = fmap select $ widget $ fmap append x - where +source x = Source $ fmap select $ widget $ fmap append x + where select (g, _, i, _) = (g, i) append (g, i) = (g, noOutput, i, noInner) -- | A consumer constructor. sink :: SE (Gui, Output a) -> Sink a -sink x = fmap select $ widget $ fmap append x - where +sink x = Sink $ fmap select $ widget $ fmap append x + where select (g, o, _, _) = (g, o) append (g, o) = (g, o, noInput, noInner) sinkSource :: SE (Gui, Output a, Input a) -> SinkSource a -sinkSource x = fmap select $ widget $ fmap append x +sinkSource x = SinkSource $ fmap select $ widget $ fmap append x where select (g, o, i, _) = (g, o, i) append (g, o, i) = (g, o, i, noInner) -- | A display constructor. -display :: SE Gui -> Display -display x = fmap select $ widget $ fmap append x - where +display :: SE Gui -> Display +display x = Display $ fmap select $ widget $ fmap append x + where select (g, _, _, _) = g - append g = (g, noOutput, noInput, noInner) + append g = (g, noOutput, noInput, noInner) ------------------------------------------------------------------------------ +----------------------------------------------------------------------------- -- primitive elements -- | Appends a title to a group of widgets. setTitle :: String -> Gui -> SE Gui -setTitle name g +setTitle name g | null name = return g | otherwise = do - gTitle <- box name + gTitle <- unDisplay $ box name return $ ver [sca 0.01 gTitle, g] setSourceTitle :: String -> Source a -> Source a -setSourceTitle name ma = source $ do +setSourceTitle name (Source ma) = source $ do (gui, val) <- ma newGui <- setTitle name gui return (newGui, val) setLabelSource :: String -> Source a -> Source a -setLabelSource a +setLabelSource a | null a = id - | otherwise = fmap (first $ setLabel a) + | otherwise = Source . fmap (first $ setLabel a) . unSource setLabelSink :: String -> Sink a -> Sink a -setLabelSink a +setLabelSink a | null a = id - | otherwise = fmap (first $ setLabel a) + | otherwise = Sink . fmap (first $ setLabel a) . unSink setLabelSnkSource :: String -> SinkSource a -> SinkSource a -setLabelSnkSource a +setLabelSnkSource a | null a = id - | otherwise = fmap (\(x, y, z) -> (setLabel a x, y, z)) + | otherwise = SinkSource . fmap (\(x, y, z) -> (setLabel a x, y, z)) . unSinkSource -singleOut :: Maybe Double -> Elem -> Source Sig -singleOut v0 el = geToSe $ do +singleOut :: Maybe Double -> Elem -> Source Sig +singleOut v0 el = Source $ geToSe $ do (var, handle) <- newGuiVar let handleVar = guiHandleToVar handle inits = maybe [] (return . InitMe handleVar) v0 @@ -237,17 +239,17 @@ appendToGui (GuiNode gui handle) (unSE noInner) return (fromGuiHandle handle, readSig var) -singleIn :: (GuiHandle -> Output Sig) -> Maybe Double -> Elem -> Sink Sig -singleIn outs v0 el = geToSe $ do +singleIn :: (GuiHandle -> Output Sig) -> Maybe Double -> Elem -> Sink Sig +singleIn outs v0 el = Sink $ geToSe $ do (var, handle) <- newGuiVar - let handleVar = guiHandleToVar handle + let handleVar = guiHandleToVar handle inits = maybe [] (return . InitMe handleVar) v0 gui = fromElem [var, handleVar] inits el appendToGui (GuiNode gui handle) (unSE noInner) return (fromGuiHandle handle, outs handle) singleInOut :: (GuiHandle -> Output Sig) -> Maybe Double -> Elem -> SinkSource Sig -singleInOut outs v0 el = geToSe $ do +singleInOut outs v0 el = SinkSource $ geToSe $ do (var, handle) <- newGuiVar let handleVar = guiHandleToVar handle inits = maybe [] (return . InitMe handleVar) v0 @@ -255,29 +257,29 @@ appendToGui (GuiNode gui handle) (unSE noInner) return (fromGuiHandle handle, outs handle, readSig var) --- | A variance on the function 'Csound.Gui.Widget.count', but it produces --- a signal of piecewise constant function. +-- | A variance on the function 'Csound.Gui.Widget.count', but it produces +-- a signal of piecewise constant function. countSig :: ValDiap -> ValStep -> Maybe ValStep -> Double -> Source Sig countSig diap step1 mValStep2 v0 = singleOut (Just v0) $ Count diap step1 mValStep2 --- | Allows the user to increase/decrease a value with mouse --- clicks on a corresponding arrow button. Output is an event stream that contains +-- | Allows the user to increase/decrease a value with mouse +-- clicks on a corresponding arrow button. Output is an event stream that contains -- values when counter changes. --- --- > count diapason fineValStep maybeCoarseValStep initValue --- +-- +-- > count diapason fineValStep maybeCoarseValStep initValue +-- -- doc: http://www.csounds.com/manual/html/FLcount.html count :: ValDiap -> ValStep -> Maybe ValStep -> Double -> Source (Evt D) count diap step1 mValStep2 v0 = mapSource snaps $ countSig diap step1 mValStep2 v0 --- | It is a squared area that allows the user to modify two output values --- at the same time. It acts like a joystick. --- --- > joy valueSpanX valueSpanY (initX, initY) +-- | It is a squared area that allows the user to modify two output values +-- at the same time. It acts like a joystick. -- +-- > joy valueSpanX valueSpanY (initX, initY) +-- -- doc: joy :: ValSpan -> ValSpan -> (Double, Double) -> Source (Sig, Sig) -joy sp1 sp2 (x, y) = geToSe $ do +joy sp1 sp2 (x, y) = Source $ geToSe $ do (var1, handle1) <- newGuiVar (var2, handle2) <- newGuiVar let handleVar1 = guiHandleToVar handle1 @@ -296,7 +298,7 @@ knob :: String -> ValSpan -> Double -> Source Sig knob name sp v0 = setLabelSource name $ singleOut (Just v0) $ Knob sp --- | FLroller is a sort of knob, but put transversally. +-- | FLroller is a sort of knob, but put transversally. -- -- > roller valueSpan step initVal -- @@ -306,7 +308,7 @@ -- | FLslider puts a slider into the corresponding container. -- --- > slider valueSpan initVal +-- > slider valueSpan initVal -- -- doc: slider :: String -> ValSpan -> Double -> Source Sig @@ -316,18 +318,18 @@ -- of init values. sliderBank :: String -> [Double] -> Source [Sig] sliderBank name ds = source $ do - (gs, vs) <- fmap unzip $ zipWithM (\n d -> slider (show n) uspan d) [(1::Int) ..] ds + (gs, vs) <- fmap unzip $ zipWithM (\n d -> unSource $ slider (show n) uspan d) [(1::Int) ..] ds gui <- setTitle name $ hor gs return (gui, vs) --- | numeric (originally FLtext in the Csound) allows the user to modify +-- | numeric (originally FLtext in the Csound) allows the user to modify -- a parameter value by directly typing it into a text field. -- --- > numeric diapason step initValue +-- > numeric diapason step initValue -- -- doc: numeric :: String -> ValDiap -> ValStep -> Double -> Source Sig -numeric name diap step v0 = setLabelSource name $ singleOut (Just v0) $ Text diap step +numeric name diap step v0 = setLabelSource name $ singleOut (Just v0) $ Text diap step -- | A FLTK widget that displays text inside of a box. -- If the text is longer than 255 characters the text @@ -337,59 +339,59 @@ -- -- doc: box :: String -> Display -box label +box label | length label < lim = rawBox label - | otherwise = fmap (padding 0 . ver) $ mapM rawBox $ parts lim label - where - parts n xs + | otherwise = Display $ fmap (padding 0 . ver) $ mapM (unDisplay . rawBox) $ parts lim label + where + parts n xs | length xs < n = [xs] | otherwise = a : parts n b where (a, b) = splitAt n xs lim = 255 rawBox :: String -> Display -rawBox label = geToSe $ do +rawBox label = Display $ geToSe $ do (_, handle) <- newGuiVar let gui = fromElem [guiHandleToVar handle] [] (Box label) appendToGui (GuiNode gui handle) (unSE noInner) return $ fromGuiHandle handle --- | A FLTK widget opcode that creates a button. +-- | A FLTK widget opcode that creates a button. -- -- > button text --- +-- -- doc: button :: String -> Source (Evt Unit) button name = setLabelSource name $ source $ do flag <- geToSe $ onGlobals $ C.newPersistentGlobalVar Kr 0 - flagChanged <- geToSe $ onGlobals $ C.newPersistentGlobalVar Kr 0 + flagChanged <- geToSe $ onGlobals $ C.newPersistentGlobalVar Kr 0 instrId <- geToSe $ saveInstr $ instr flag geToSe $ (saveAlwaysOnInstr =<< ) $ saveInstr $ instrCh flag flagChanged - (g, _) <- singleOut Nothing (Button instrId) + (g, _) <- unSource $ singleOut Nothing (Button instrId) val <- fmap fromGE $ fromDep $ readVar flagChanged return (g, sigToEvt val) where instr ref = SE $ do val <- readVar ref - whens Kr + whens Kr [ (val ==* 0, writeVar ref 1) - ] (writeVar ref 0) + ] (writeVar ref 0) turnoff instrCh ref refCh = SE $ do val <- readVar ref - writeVar refCh (C.changed val) - + writeVar refCh (C.changed val) + -- | A FLTK widget opcode that creates a toggle button. -- -- > button text --- +-- -- doc: toggle :: String -> Bool -> Source (Evt D) toggle name initVal = mapSource snaps $ toggleSig name initVal - --- | A variance on the function 'Csound.Gui.Widget.toggle', but it produces --- a signal of piecewise constant function. + +-- | A variance on the function 'Csound.Gui.Widget.toggle', but it produces +-- a signal of piecewise constant function. toggleSig :: String -> Bool -> Source Sig toggleSig name initVal = setLabelSource name $ singleOut (initToggle initVal) Toggle @@ -398,9 +400,9 @@ -- | A FLTK widget opcode that creates a bank of buttons. -- Result is (x, y) coordinate of the triggered button. --- +-- -- > butBank xNumOfButtons yNumOfButtons --- +-- -- doc: butBank :: String -> Int -> Int -> (Int, Int) -> Source (Evt (D, D)) butBank name xn yn inits = mapSource (fmap split2 . snaps) $ butBankSig1 name xn yn inits @@ -409,31 +411,31 @@ x = int xn y = int yn --- | A variance on the function 'Csound.Gui.Widget.butBank', but it produces --- a signal of piecewise constant function. +-- | A variance on the function 'Csound.Gui.Widget.butBank', but it produces +-- a signal of piecewise constant function. -- Result is (x, y) coordinate of the triggered button. butBankSig :: String -> Int -> Int -> (Int, Int) -> Source (Sig, Sig) butBankSig name xn yn inits = mapSource split2 $ butBankSig1 name xn yn inits - where + where split2 a = (floor' $ a / y, mod' a x) x = sig $ int xn y = sig $ int yn -- | A FLTK widget opcode that creates a bank of buttons. --- +-- -- > butBank xNumOfButtons yNumOfButtons --- +-- -- doc: butBank1 :: String -> Int -> Int -> (Int, Int) -> Source (Evt D) butBank1 name xn yn inits = mapSource snaps $ butBankSig1 name xn yn inits - -butBankSig1 :: String -> Int -> Int -> (Int, Int) -> Source Sig + +butBankSig1 :: String -> Int -> Int -> (Int, Int) -> Source Sig butBankSig1 name xn yn (x0, y0) = setSourceTitle name $ singleOut (Just n) $ ButBank xn yn where n = fromIntegral $ y0 + x0 * yn -- | FLtext that is sink shows current the value of a valuator in a text field. setNumeric :: String -> ValDiap -> ValStep -> Double -> Sink Sig -setNumeric name diap step v0 = setLabelSource name $ singleIn printk2 (Just v0) $ Text diap step +setNumeric name diap step v0 = setLabelSink name $ singleIn printk2 (Just v0) $ Text diap step -- | A slider that serves as indicator. It consumes values instead of producing. -- @@ -449,7 +451,7 @@ setToggle :: String -> Bool -> SinkSource (Evt D) setToggle name initVal = sinkSource $ do - (g, outs, ins) <- setToggleSig name initVal + (g, outs, ins) <- unSinkSource $ setToggleSig name initVal let evtOuts a = outs =<< stepper 0 (fmap sig a) return (g, evtOuts, snaps ins) @@ -464,16 +466,16 @@ -- | The stream of keyboard press/release events. keyIn :: KeyEvt -> Evt Unit -keyIn evt = boolToEvt $ asig ==* 1 +keyIn evt = boolToEvt $ asig ==* 1 where asig = Sig $ fmap readOnlyVar $ listenKeyEvt evt -- Outputs readD :: Var -> SE D -readD v = fmap (D . return) $ SE $ readVar v +readD v = fmap (D . return) $ SE $ readVar v readSig :: Var -> Sig -readSig v = Sig $ return $ readOnlyVar v +readSig v = Sig $ return $ readOnlyVar v refHandle :: GuiHandle -> SE D @@ -503,8 +505,8 @@ ----------------------------------------------------- sourceSlice :: SinkSource a -> Source a -sourceSlice = fmap (\(gui, _, a) -> (gui, a)) +sourceSlice = Source . (fmap (\(gui, _, a) -> (gui, a))) . unSinkSource sinkSlice :: SinkSource a -> Sink a -sinkSlice = fmap (\(gui, a, _) -> (gui, a)) +sinkSlice = Sink . (fmap (\(gui, a, _) -> (gui, a))) . unSinkSource diff --git a/src/Csound/Typed/Render.hs b/src/Csound/Typed/Render.hs --- a/src/Csound/Typed/Render.hs +++ b/src/Csound/Typed/Render.hs @@ -1,10 +1,11 @@ module Csound.Typed.Render( - renderOut, renderOutBy, + renderOut, renderOutBy, renderEff, renderEffBy, - renderOut_, renderOutBy_, + renderOut_, renderOutBy_, -- * Options module Csound.Typed.GlobalState.Options, - module Csound.Dynamic.Types.Flags + module Csound.Dynamic.Types.Flags, + saveUserOptions, getUserOptions ) where import qualified Data.Map as M @@ -19,6 +20,10 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Class +import System.Directory +import System.FilePath +import Text.Read (readMaybe) + import Text.PrettyPrint.Leijen(displayS, renderPretty) import Csound.Dynamic hiding (csdFlags) @@ -35,7 +40,7 @@ toCsd :: Tuple a => Maybe Int -> Options -> SE a -> GE Csd -toCsd mnchnls_i options sigs = do +toCsd mnchnls_i options sigs = do saveMasterInstr (constArity sigs) (masterExp sigs) saveMidiMap -- save midi innstruments handleMissingKeyPannel @@ -51,47 +56,53 @@ return () renderOut_ :: SE () -> IO String -renderOut_ = renderOutBy_ def +renderOut_ = renderOutBy_ def renderOutBy_ :: Options -> SE () -> IO String -renderOutBy_ options sigs = evalGE options $ fmap renderCsd $ toCsd Nothing options (fmap (const unit) sigs) +renderOutBy_ options sigs = do + finalOptions <- fmap (maybe options (options <> )) getUserOptions + evalGE finalOptions $ fmap renderCsd $ toCsd Nothing finalOptions (fmap (const unit) sigs) renderOut :: Sigs a => SE a -> IO String renderOut = renderOutBy def renderOutBy :: Sigs a => Options -> SE a -> IO String -renderOutBy options sigs = evalGE options $ fmap renderCsd $ toCsd Nothing options sigs +renderOutBy options sigs = do + finalOptions <- fmap (maybe options (options <> )) getUserOptions + evalGE finalOptions $ fmap renderCsd $ toCsd Nothing finalOptions sigs renderEff :: (Sigs a, Sigs b) => (a -> SE b) -> IO String renderEff = renderEffBy def renderEffBy :: (Sigs a, Sigs b) => Options -> (a -> SE b) -> IO String -renderEffBy options eff = evalGE options $ fmap renderCsd $ toCsd (Just (arityIns $ funArity eff)) options (eff =<< getIns) +renderEffBy options eff = do + finalOptions <- fmap (maybe options (options <> )) getUserOptions + evalGE finalOptions $ fmap renderCsd $ toCsd (Just (arityIns $ funArity eff)) finalOptions (eff =<< getIns) renderHistory :: Maybe Int -> Int -> Options -> GE Csd renderHistory mnchnls_i nchnls opt = do keyEventListener <- getKeyEventListener hist1 <- getHistory udos <- fmap verbatim $ liftIO $ renderUdoPlugins hist1 - instr0 <- execDepT $ getInstr0 mnchnls_i nchnls opt udos hist1 + instr0 <- execDepT $ getInstr0 mnchnls_i nchnls opt udos hist1 terminatorInstrId <- saveInstr =<< terminatorInstr - expr2 <- getSysExpr terminatorInstrId + expr2 <- getSysExpr terminatorInstrId saveAlwaysOnInstr =<< saveInstr (SE expr2) - expr3 <- guiInstrExp - saveAlwaysOnInstr =<< saveInstr (SE expr3) - hist2 <- getHistory + expr3 <- guiInstrExp + saveAlwaysOnInstr =<< saveInstr (SE expr3) + hist2 <- getHistory let namedIntruments = fmap (\(name, body) -> Instr (InstrLabel name) body) $ unNamedInstrs $ namedInstrs hist2 - let orc = Orc instr0 ((namedIntruments ++ ) $ maybeAppend keyEventListener $ fmap (uncurry Instr) $ instrsContent $ instrs hist2) - hist3 <- getHistory + let orc = Orc instr0 ((namedIntruments ++ ) $ maybeAppend keyEventListener $ fmap (uncurry Instr) $ instrsContent $ instrs hist2) + hist3 <- getHistory let flags = reactOnMidi hist3 $ csdFlags opt - sco = Sco (Just $ pureGetTotalDurForF0 $ totalDur hist3) + sco = Sco (Just $ pureGetTotalDurForF0 $ totalDur hist3) (renderGens (genMap hist3) (writeGenMap hist3)) $ - ((fmap alwaysOn $ alwaysOnInstrs hist3) ++ (getNoteEvents $ notes hist3)) + ((fmap alwaysOn $ alwaysOnInstrs hist3) ++ (getNoteEvents $ notes hist3)) let plugins = getPlugins opt hist3 return $ Csd flags orc sco plugins where renderGens gens writeGens = (fmap swap $ M.toList $ idMapContent gens) ++ writeGens - maybeAppend ma = maybe id (:) ma + maybeAppend ma = maybe id (:) ma getNoteEvents = fmap $ \(instrId, evt) -> (instrId, [evt]) getPlugins opt hist = case cabbageGui hist of @@ -110,17 +121,17 @@ userInstr0 hist chnUpdateUdo udos - sf2 - jackos + sf2 + jackos guiStmt defaultScaleUI $ getPanels hist where globalConstants = do setSr $ defSampleRate opt setKsmps $ defBlockSize opt - setNchnls (max 1 nchnls) + setNchnls (max 1 nchnls) setZeroDbfs 1 - maybe (return ()) setNchnls_i mnchnls_i - + maybe (return ()) setNchnls_i mnchnls_i + midiAssigns = mapM_ renderMidiAssign $ midis hist midiInitCtrls = mapM_ renderMidiCtrl $ midiCtrls hist @@ -128,7 +139,7 @@ sf2 = mapM_ (uncurry sfSetList) $ sfGroup $ sfTable hist sfGroup = fmap phi . groupBy (\a b -> getName a == getName b) . sortBy (comparing getName) - where + where getName = sfName . fst phi as = (getName $ head as, fmap (\(sf, index) -> (sfBank sf, sfProgram sf, index)) as) @@ -138,8 +149,8 @@ MacrosInitInt name value -> initMacrosInt name value jackos = maybe (return ()) (verbatim . renderJacko) $ csdJacko opt - + reactOnMidi :: History -> Flags -> Flags reactOnMidi h flags | midiIsActive h && midiDeviceIsEmpty flags = setMidiDevice flags @@ -149,3 +160,33 @@ midiDeviceIsEmpty = isNothing . midiDevice . midiRT setMidiDevice x = x { midiRT = (midiRT x) { midiDevice = Just "a" } } +getUserOptions :: IO (Maybe Options) +getUserOptions = do + mHome <- getAt getHomeDirectory + mCur <- getAt getCurrentDirectory + return $ case (mHome, mCur) of + (_, Just opt) -> Just opt + (Just opt, Nothing) -> Just opt + (Nothing, Nothing) -> Nothing + where + getAt getPath = do + fileName <- fmap rcFileAt getPath + isExist <- doesFileExist fileName + if isExist + then do + fileContent <- readFile fileName + return $ readMaybe fileContent + else do + return Nothing + +rcFileAt :: FilePath -> String +rcFileAt dir = dir ".csound-expression-rc" + +-- | Saves the user options in the current directory. +-- +-- If it's saved in the User's home directory it becomes +-- global options. +saveUserOptions :: Options -> IO () +saveUserOptions opts = do + fileName <- fmap rcFileAt getCurrentDirectory + writeFile fileName (show opts)