' *************************************************************** ' * test and debug code for midi controlled robots and automats * ' * * ' * an automated sousaphone * ' * by Godfried-Willem Raes * ' * Version 1 : 2003 * ' * Version 2 : 2007 * ' * Version 3 : 2020 * ' *************************************************************** ' 26.07.2003: creation date of this code module in GMT ' Low level details of the functioning of can be looked up ' in the FUNCTION So_Lookup (BYREF s() AS SoType) AS LONG in g_midi.inc ' The procedure to make play is called MiRobotPlay ' 27.07.2003: first tests of code module. Resources upgraded. ' 02.08.2003: specific hardware adressing procedures written and added to g_midi.inc ' 03.08.2003: smoother valve switching code implemented. ' 19.08.2003: further debug ' 20.08.2003: seems to work now... ' 23.08.2003: Hardware mapping changed for reduction of glitches. DLL adapted accordingly ' 24.08.2003: lookup code moved to g_indep.dll ' 12.12.2004: So_Off() moved to g_mm.inc ' 23.07.2007: New hardware version. Version 2. ' 29.07.2007: tests for new controllers added. ' 30.07.2007: range extended. Now starts at midi note 0. ' 04.08.2007: controller 13 implemented. (valves) ' 11.08.2007: display controllers 14-17 implemented. Tuning controller 20. Wind controller 1 rescaled. ' program changes 0, 120-126, 127 implemented for the wind controller lookups. ' refer to the so web page for meaning and documentation ' 22.12.2007: Bono option added in So What (alternative for Bourdonola) ' 24.11.2008: quartertone scale test added. ' 02.11.2012: So suffers and wears out quite a bit by using it in pop music contexts. In particular, if it ' is used with the wind controller turned off... ' If we would want to allow such use in the future, we should consider changing the design and ' use a membrane compressor driven by an ARM processor (as done in Klar and Fa). ' 08.02.2020: Rebuilding . This will become version 3. ' This work is projected to take about a full month. ' 13.02.2020: VERSION 3: new controllers added. ' ADSR now works as in ' new controllers: 3,4,5,6 for vibrato and tremolo as on Flut. ' display controllers must change to 34,35,36,37 instead of 14,15,16,17 ' Ambitus extended. Now the range is 15 to 69, conforming to the real range of the sousaphone. ' 14.02.2020: further update... ' 15.02.2020: quite some bugs removed... ' controller 80 added. ' 17.02.2020: voetje remapped, lights adapted. ' 18.02.2020: dsPIC 30F3010 reprogrammed, according to the new implementation. ' 21.02.2020: Wave displays added. ' 28.02.2020: So_wave8 added. ' 03.03.2020: Some bugs removed. Conformity to PIC firmware checked. ' 05.03.2020: dsPIC3010 reprogrammed to solve some bugs with the display ' bugs in scale code killed. ' 06.02.2020: new tuba sample implemented. ' 07.02.2020: Prog.change proc. adapted to newest firmware version. ' some bugs removed. ' 17.03.2020: batch processing task added for series of sample files ' 20.03.2020: controllers 40-43 added. ' 13.12.2020: Firmware up[graded: better ADSR, defaults changed. %So_voetnoot = 84 ' was 48 in version 2 ' SO Tasks %So_What = 32 ' first demo piece for so by gwr. %So_Mel = 33 %So_Test = 48 ' demo en test kode voor %So_Voet = 49 ' remapped for version 3 %So_Scale = 50 %So_QScale = 51 ' quartertone scale %So_Lites = 52 ' remapped for version 3, now notes 120, 121, 123 '%So_Volume = 35 ' ctrl 7 %So_Lookup = 36 ' ctrl 13 'to do - valves %So_Display = 37 ' ctrl 34, 35, 36, 37 version 3 %So_Bend = 38 ' no longer needed. - functionally integrated in so test. %So_ADSR = 39 ' ctrl 7,15,16,17,18,19 - version 3 %So_Tune = 40 ' ctrl 20 %So_C80 = 42 ' dynamic scaling controller - for research ' to do: (evt. Xtof) '%So_Valve_Sx = 61 ' sys-ex tests - valve lookup tables '%So_Wind_Sx = 62 ' sys-ex tests - wind control tables - removed for V3 '%So_ds_Sx = 63 ' moving coil driver tables %So_Vibrato = 21 %So_Tremolo = 22 %So_Progchange = 24 ' this is conform the PIC firmware %So_ProgChangeSub = 25 ' no longer implemented. %So_ProgChangeLow = 26 ' no longer implemented. %So_ProgchangeMed = 27 ' no longer implemented in the PIC firmware '%So_2007 = 1 ' metakompilatiekonstante '%So_Channel = 14 ' automated sousaphone - set in g_kons.bi %So_Wave = 2 %So_Waves = 3 ' batch processing of input files %So_CC40 = 10 %So_CC41 = 11 %So_CC42 = 12 %So_CC43 = 13 DECLARE SUB So_Test () DECLARE SUB So_SLwind () ' slider callback DECLARE SUB So_UD0 () DECLARE SUB So_UD1 () 'DECLARE SUB So_UD2 () DECLARE SUB So_Voet () DECLARE SUB So_What () ' first little demo piece for DECLARE SUB So_What_UD0 () DECLARE SUB So_What_UD1 () DECLARE SUB So_Mel () DECLARE SUB So_Scale () DECLARE SUB So_Scale_UD0 () DECLARE SUB So_Scale_UD1 () DECLARE SUB So_QScale () ' new test procedures: DECLARE SUB So_Lites () 'DECLARE SUB So_Volume () DECLARE SUB So_Lookup_Ctrl () DECLARE SUB So_Display () DECLARE SUB So_Display_UD () 'DECLARE SUB So_Bend () 'DECLARE SUB So_Bend_UD () DECLARE SUB So_Tune () DECLARE SUB So_ADSR () 'DECLARE SUB So_f1 () 'DECLARE SUB So_f2 () DECLARE SUB So_CC80 () DECLARE SUB So_Valves DECLARE CALLBACK FUNCTION So_Valves_cb DECLARE SUB So_Wave () DECLARE SUB So_Wave8 (Wave8() AS WORD) 'DECLARE FUNCTION So_Valve_Sysx AS LONG ' no longer implemented 'DECLARE FUNCTION So_Wind_Sysx AS LONG DECLARE FUNCTION Init_So () AS LONG GLOBAL So_Prog AS BYTE FUNCTION Init_So () AS LONG LOCAL retval AS LONG LOCAL i AS INTEGER ' GetInstrumentParams So, %IDM_SO ' retval = SetRobotPort (So, Inifilename, hMidiO()) Task(%So_Test).naam = "" Task(%So_Test).cptr = CODEPTR(So_Test) Task(%So_Test).freq = 2 Task(%So_Test).flags = %False TaskEx(%so_test).stopcptr = CODEPTR(MM_So_Off) TaskEx(%so_test).startcptr = CODEPTR(MM_So_On) Task(%So_Voet).naam = "Foot" Task(%So_Voet).cptr = CODEPTR(So_Voet) Task(%So_Voet).freq = 8 Task(%So_Voet).flags = %False Task(%So_Scale).naam = "Scale" Task(%So_Scale).cptr = CODEPTR(So_Scale) Task(%So_Scale).freq = 2 Task(%So_Scale).flags = %False Task(%So_QScale).naam = "QScale" Task(%So_QScale).cptr = CODEPTR(So_QScale) Task(%So_QScale).freq = 2 Task(%So_QScale).flags = %False Task(%So_What).naam = "SoWhat" Task(%So_What).cptr = CODEPTR(So_What) Task(%So_What).freq = 10 Task(%So_What).flags = %False Task(%So_Mel).naam = "SoMel" Task(%So_Mel).cptr = CODEPTR(So_Mel) Task(%So_Mel).freq = 8 Task(%So_Mel).flags = %False Task(%So_Lites).naam = "lites" Task(%So_Lites).cptr = CODEPTR(So_Lites) Task(%So_Lites).freq = 3 Task(%So_Lites).flags = %False ' Task(%So_Volume).naam = "volume" ' Task(%So_Volume).cptr = CODEPTR(So_Volume) ' Task(%So_Volume).freq = 4 ' Task(%So_Volume).flags = %False ' Task(%So_Lookup).naam = "lookup" 'use So_Valve / cockpit button ' Task(%So_Lookup).cptr = CODEPTR(So_Lookup_Ctrl) ' Task(%So_Lookup).freq = 3 ' Task(%So_Lookup).flags = %False ' following needs revision!!! ' Task(%So_ProgChange).naam = "Prog" ' Task(%So_ProgChange).cptr = CODEPTR(So_ProgChange) ' Task(%So_Progchange).freq = 2 ' Task(%So_ProgChange).flags = %False ' Task(%So_ProgChangeSub).naam = "Pr_Sub" ' Task(%So_ProgChangeSub).cptr = CODEPTR(So_ProgChangeSub) ' Task(%So_ProgchangeSub).freq = 1 ' Task(%So_ProgChangeSub).flags = %False ' ' Task(%So_ProgChangeLow).naam = "Pr_Low" ' Task(%So_ProgChangeLow).cptr = CODEPTR(So_ProgChangeLow) ' Task(%So_ProgchangeLow).freq = 1 ' Task(%So_ProgChangeLow).flags = %False ' ' Task(%So_CC40).naam = "CC40Sub" Task(%So_CC40).cptr = CODEPTR(So_CC40) Task(%So_CC40).freq = 1 Task(%So_CC40).flags = %False Task(%So_CC41).naam = "CC41Low" Task(%So_CC41).cptr = CODEPTR(So_CC41) Task(%So_CC41).freq = 1 Task(%So_CC41).flags = %False Task(%So_CC42).naam = "CC42Med" Task(%So_CC42).cptr = CODEPTR(So_CC42) Task(%So_CC42).freq = 1 Task(%So_CC42).flags = %False Task(%So_CC43).naam = "CC43High" Task(%So_CC43).cptr = CODEPTR(So_CC43) Task(%So_CC43).freq = 1 Task(%So_CC43).flags = %False Task(%So_vibrato).naam = "Vibrato" ' frequency modulation Task(%So_vibrato).freq = 12 Task(%So_vibrato).cptr = CODEPTR(So_Vibrato) TaskEx(%So_Vibrato).stopcptr = CODEPTR(So_Vibrato_Stop) Task(%So_tremolo).naam = "Tremolo" ' amplitude modulation Task(%So_tremolo).cptr = CODEPTR(So_Tremolo) Task(%So_tremolo).freq = 16 Task(%So_tremolo).flags = %False TaskEX(%So_tremolo).stopcptr = CODEPTR(So_Tremolo_Stop) Task(%So_Display).naam = "display" ' adapted version 3 Task(%So_Display).cptr = CODEPTR(So_Display) Task(%So_Display).freq = 3 Task(%So_Display).flags = %False Task(%So_ADSR).naam = "ADSR" ' adapted version 3 Task(%So_ADSR).cptr = CODEPTR(So_ADSR) Task(%So_ADSR).freq = 10 Task(%So_ADSR).flags = %False Task(%So_Tune).naam = "Tune" ' adapted version 3 Task(%So_Tune).cptr = CODEPTR(So_Tune) Task(%So_Tune).freq = 10 Task(%So_Tune).flags = %False Task(%So_C80).naam = "CC80" Task(%So_C80).cptr = CODEPTR(So_CC80) Task(%So_C80).freq = 2 Task(%So_C80).flags = %False ' ' Task(%So_f2).naam = "f2" ' Task(%So_f2).cptr = CODEPTR(So_f2) ' Task(%So_f2).freq = 10 ' Task(%So_f2).flags = %False ' Task(%So_Valve_sx).naam = "ValveSysx" ' Task(%So_Valve_sx).freq = .33 ' Task(%So_Valve_sx).cptr = CODEPTR(So_Valve_Sysx) 'in m_robots.inc ??? Task(%So_Wave).naam = "Waves" Task(%So_Wave).freq = .33 Task(%So_Wave).cptr = CODEPTR(So_Wave) 'in m_robots.inc Task(%So_Waves).naam = "Wav_batch" Task(%So_Waves).freq = .1 Task(%So_Waves).cptr = CODEPTR(So_Waves) ' ' test dll functions: ' DIM Wave0(255) AS STATIC WORD ' DIM Wave1(255) AS STATIC WORD ' DIM Wave2(255) AS STATIC WORD ' DIM Arr(255) AS STATIC SINGLE ' So_Wave0 64, Wave0() ' dll test g_wave.dll p0 = 64 ' FOR i = 0 TO 255 ' Arr(i) = (Wave0(i) / 2048) - 0.5 ' NEXT i ' ShowNormarray gh.spec, Arr() ' seems to do nothing, but doing it here made in work in the prog. changes... IF ISFALSE gh.spec THEN MakeSpectrumWindow ' should fill gh.spec. new, make window to display waveforms... END IF ButnOS(2).tag = "So Off" ButnOS(2).cptr = CODEPTR(MM_So_Off) ButnSw(7).tag0 = "Valves" ButnSw(7).tag1 = "Valves" ButnSw(7).cptr = CODEPTR(So_Valves) FUNCTION = %True END FUNCTION SUB So_Test() STATIC slnr AS DWORD STATIC udnr AS DWORD STATIC wind AS BYTE STATIC motor AS LONG LOCAL value AS LONG STATIC noot AS BYTE STATIC onfreq AS SINGLE STATIC offFreq AS SINGLE STATIC oldnote AS BYTE STATIC resetval AS BYTE STATIC init AS DWORD LOCAL velo AS BYTE LOCAL period AS SINGLE LOCAL onpart AS SINGLE LOCAL offpart AS SINGLE IF ISFALSE init THEN 'Task(%So_Test).tog THEN 'tasks that reset their sliders each time they get toggled off/on are very annoying!! - xof DIM TaskParamLabels(0 TO 5) AS ASCIIZ * 8 init = 1 TaskParamLabels(0) = "Tempo" ' rescaled in proc. TaskParamLabels(1) = "Wind" ' noise TaskParamLabels(2) = "Velo" ' 0-127 TaskParamLabels(3) = "Stac" ' staccato - legato up down ' UD0 TaskParamLabels(4) = "Note" ' pitch ' UD1 TaskParamLabels(5) = "Bend" ' pitch-bend value ' UD2 IF ISFALSE Task(%So_Test).hParam THEN MakeTaskParameterDialog %So_Test,3,Slider(),3,UDctrl(),TaskParamLabels() END IF IF slnr = %False THEN slnr = TaskEX(%So_Test).SliderNumbers(0) Slider(slnr).minval = 1 ' tempo Slider(slnr).maxval = 127 Slider(slnr+1).cptr = CODEPTR(So_SLwind) Slider(slnr+1).minval = 0 Slider(slnr+1).maxval = 127 Slider(slnr+1).value = 8 END IF Slider(slnr).value = 16 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value IF udnr = %False THEN udnr = TaskEX(%So_Test).UpDownNumbers(0) UDctrl(udnr).cptr = CODEPTR(So_UD0) ' staccato - legato updown UDctrl(udnr).value = 50 UDctrl(udnr).minval = 0 '1 UDctrl(udnr).maxval = 100 '99 UDctrl(udnr).stap = 1 UDctrl(udnr+1).cptr = CODEPTR(So_UD1) ' pitch up down (note) UDctrl(udnr+1).value = 22 'So.lowtes UDctrl(udnr+1).minval = So.lowtes UDctrl(udnr+1).maxval = So.Hightes UDctrl(udnr+2).cptr = CODEPTR(So_UD2) ' pitchbend value UDctrl(udnr+2).value = 64 UDctrl(udnr+2).minval = 0 UDctrl(udnr+2).maxval = 127 resetval = 64 END IF Task(%So_Test).tog = %True StartTask %So_ADSR 'as we want to see this task allways in combination with the volume task anyway.. EXIT SUB END IF period = 1! / (Slider(slnr).value / 10!) ' tempo Task(%So_Test).tempo = 60 / period ' on-off periods: onpart = period * (UDctrl(udnr).value / 100!) ' 0 - 100 offpart = period - onpart ' 100 - 0 IF UDctrl(udnr).value < 1 THEN ' silence IF oldnote THEN 'NoteOff So.channel, oldnote ' this makes release impossible... mPlay So.channel, oldnote, 0 oldnote = %False END IF offFreq = 1! / period 'OffPart Task(%So_Test).freq = OffFreq EXIT SUB ELSE onfreq = 1!/onpart END IF IF UDctrl(udnr).value > 99 THEN ' legato, no note offs oldnote = %False ELSE offFreq = 1! /Offpart END IF IF oldnote THEN 'NoteOff So.channel, oldnote mPlay So.channel, oldnote, 0 Task(%So_Test).freq = OffFreq oldnote = %False ELSE noot = UDctrl(udnr+1).value velo = Slider(slnr+2).value CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "vol:" + STR$(So.ctrl(7)) + ", velo:" + STR$(velo) + ", att:" + STR$(So.ctrl(18)) 'if fingerings are set with So.ctrl(13) we need to resend it for every single note, even if we repeat a note.. 'note: ctrl(13) can be set by the So_Valves_cb function IF BIT(So.ctrl(13), 2) THEN Controller So.channel, 13, So.ctrl(13) mPLAY So.channel, noot, velo ' IF resetval <> 64 THEN Bend So.channel, 0, UDctrl(udnr+2).value ' resetval = UDctrl(udnr+2).value ' END IF Task(%So_Test).freq = OnFreq oldnote = noot IF So.ctrl(1) <> Slider(slnr+1).value THEN So.ctrl(1) = Slider(slnr+1).value Controller So.channel, 1, So.ctrl(1) END IF END IF IF Task(%So_Test).freq < 0.2 THEN Task(%So_Test).freq = 0.2 END SUB SUB So_valves 'in current implementation, the valve settings are forgotten with each note off! 'this forces you to resend controllers for every note, even if you just want the same fingering.. STATIC hw AS DWORD IF ISFALSE hw THEN DIALOG NEW 0, "valves control", , , 125, 40, %WS_BORDER OR %WS_CAPTION OR %WS_POPUP TO hw CONTROL ADD LABEL, hw, 1, "lookup:", 1, 1, 40, 12 CONTROL ADD CHECKBOX, hw, 10, "0", 42, 1, 20, 12, %BS_PUSHLIKE ' default empirical CONTROL ADD CHECKBOX, hw, 11, "1", 63, 1, 20, 12, %BS_PUSHLIKE ' acoustic ' CONTROL ADD CHECKBOX, hw, 12, "2", 84, 1, 20, 12, %BS_PUSHLIKE ' user table 1 ' CONTROL ADD CHECKBOX, hw, 13, "3", 105, 1, 20, 12, %BS_PUSHLIKE ' user table 2 ' CONTROL ADD LABEL, hw, 2, "valves:",1, 14, 40, 12 ' CONTROL ADD CHECKBOX, hw, 20, "-1/2", 63, 14, 20, 12, %BS_PUSHLIKE ' CONTROL ADD CHECKBOX, hw, 21, "-1", 84 , 14, 20, 12, %BS_PUSHLIKE ' CONTROL ADD CHECKBOX, hw, 22, "-2", 42, 14, 20, 12, %BS_PUSHLIKE CONTROL ADD LABEL, hw, 30, "Ctrl(13): ?", 1, 27, 123, 12 DIALOG SHOW MODELESS hw, CALL So_Valves_cb ELSE DIALOG END hw END IF END SUB CALLBACK FUNCTION So_Valves_cb ' needs update! LOCAL i AS LONG LOCAL j AS LONG IF CBMSG <> %WM_COMMAND THEN EXIT FUNCTION IF CBCTLMSG <> %BN_CLICKED THEN EXIT FUNCTION SELECT CASE CBCTL CASE 10 TO 13 FOR i = 10 TO 13 IF i = CBCTL THEN ITERATE FOR CONTROL SET CHECK CBHNDL, i, 0 NEXT FOR i = 20 TO 22 CONTROL SET CHECK CBHNDL, i, 0 NEXT So.ctrl(13) = CBCTL - 10 ' 0 - 3 CASE 20 TO 22 FOR i = 10 TO 13 CONTROL SET CHECK CBHNDL, i, 0 NEXT So.ctrl(13) = &B0100 FOR i = 20 TO 22 CONTROL GET CHECK CBHNDL, i TO j BIT CALC So.ctrl(13), i - 17, j NEXT CASE ELSE EXIT FUNCTION END SELECT Controller So.channel, 13, So.ctrl(13) CONTROL SET TEXT CBHNDL, 30, "Ctrl(13):" + STR$(So.ctrl(13)) + " (" + BIN$(So.ctrl(13)) + ")" END FUNCTION SUB So_SLwind () ' this slider will work even if its task is off. ' in version 3, this controls the noisyness in the sound produced. STATIC slnr AS DWORD slnr = TaskEX(%So_Test).SliderNumbers(1) IF Slider(slnr).value <> So.ctrl(1) THEN ' send the appropriate midi controller... So.ctrl(1) = Slider(slnr).value ' 0-127 Controller So.channel, 1, So.Ctrl(1) END IF END SUB SUB So_UD0 () ' callback on parameter UpDowns. : on/off proportion LOCAL value AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%So_Test).UpdownNumbers(0) value = UDCtrl(udnr).value IF value > 99 THEN UDctrl(udnr).value = 100 : value = 100 IF value < 0 THEN UDCTRL(udnr).value = 0 : value = 0 SetDlgItemText Task(%So_Test).hparam, %GMT_TEXT0_ID + 16, "L=" & STR$(value) END SUB SUB So_UD1 () ' controls the notes to be played. LOCAL noot AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%So_Test).UpDownNumbers(1) noot = UDCtrl(udnr).value SetDlgItemText Task(%So_Test).hparam, %GMT_TEXT0_ID + 17, "N=" & STR$(noot) END SUB SUB So_UD2 () ' ' pitchbend UD LOCAL value AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%So_Test).UpDownNumbers(2) value = UDCtrl(udnr).value SetDlgItemText Task(%So_Test).hparam, %GMT_TEXT0_ID + 18, "b=" & STR$(value) END SUB SUB So_Voet () 'task So_Voet 'to be remapped on another note!!! 'voetnoot is a global now. 'note 84 STATIC slnr AS LONG IF ISFALSE Task(%So_Voet).tog THEN DIM TaskParamLabels(0 TO 5) AS ASCIIZ * 8 TaskParamLabels(0) = "Tempo" TaskParamLabels(1) = "Velo" IF ISFALSE Task(%So_Voet).hParam THEN MakeTaskParameterDialog %So_Voet,2,Slider(),0,UDctrl(),TaskParamLabels() END IF IF slnr = %False THEN slnr = TaskEX(%So_Voet).SliderNumbers(0) Slider(slnr).minval =1 ' tempo Slider(slnr).maxval = 127 Slider(slnr+1).minval = 0 Slider(slnr+1).maxval = 127 Slider(slnr+1).value = 90 END IF Slider(slnr).value = 16 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value Slider(slnr+1).value = 84 SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, Slider(Slnr+1).value Task(%So_Voet).tog = %True END IF mPlay So.channel, %So_voetnoot,Slider(slnr+1).value Task(%So_Voet).freq = Slider(slnr).value / 8 END SUB SUB So_Mel () ' demo piece. - running melodic bass ' modelled after AutoSax_Lyrics () - recoded 23.07.2007 LOCAL d AS SINGLE LOCAL i AS DWORD STATIC mel() AS INTEGER STATIC cnt AS LONG STATIC length AS LONG STATIC TaskParamLabels() AS ASCIIZ*8 STATIC slnr AS INTEGER STATIC crit AS SINGLE STATIC rest AS LONG STATIC n AS DWORD IF ISFALSE Task(%So_Mel).tog THEN IF ISFALSE Task(%So_Mel).hParam THEN DIM TaskParamLabels(1) TaskParamLabels(0)="volu" TaskParamLabels(1)="speed" MakeTaskParameterDialog %So_Mel,2, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%So_Mel).SliderNumbers(0) Slider(slnr).value = 64 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value Slider(slnr+1).value = 36 SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, Slider(Slnr+1).value END IF REDIM mel(32) cnt = %False Task(%So_Mel).tog = %True d = Dismel (60,64) EXIT SUB END IF IF rest THEN IF n THEN mPlay So.channel, n, 0 n= %False END IF Task(%So_Mel).freq = (0.1 + (RND(1) * 0.9)) * (Slider(slnr+1).value/ 32) rest = %False EXIT SUB END IF SELECT CASE cnt CASE 0 IF mel(length) THEN IF mel(cnt) THEN mPlay So.channel, Mel(cnt),(127 - (cnt * 2)) * (Slider(slnr).value /128) n = mel(cnt) END IF mPlay So.channel, 48, 127 ' foot END IF mel(0) = 12 + (RND(1) * (So.Hightes- 12)) length = 3 + (RND(1) * 28) REDIM mel(length) crit = 0.8 Task(%So_Mel).freq = (1 + (RND(1) * 4)) * (Slider(slnr+1).value/ 32) CASE ELSE DO i = 0 DO mel(cnt) = 12 + (RND(1) * (So.Hightes - 12)) 'mel(0) = So.lowtes + (RND(1) * (30 - So.Lowtes)) ' ' d = Flue (mel(cnt-2),mel(cnt-1),mel(cnt)) d = MelFrameQual (mel(),cnt+1) IF d >= crit THEN EXIT LOOP INCR i IF i > 250 THEN EXIT LOOP LOOP IF d >= crit THEN EXIT LOOP IF i > 250 THEN crit = crit - 0.1 IF crit < 0 THEN crit = 0 END IF LOOP n = mel(cnt) mPlay So.channel, mel(cnt), (127 - (cnt * 2)) * (Slider(slnr).value /128) Task(%So_Mel).freq = (0.1 + (RND(1) * 0.9)) * (Slider(slnr+1).value/ 32) END SELECT INCR cnt IF cnt > length THEN cnt = %False rest = %True END IF END SUB SUB So_Scale () LOCAL i AS DWORD STATIC onoff AS DWORD STATIC cnt AS LONG STATIC TaskParamLabels() AS ASCIIZ*8 STATIC slnr AS INTEGER STATIC udnr AS INTEGER STATIC n AS INTEGER IF ISFALSE Task(%So_Scale).tog THEN IF ISFALSE Task(%So_Scale).hParam THEN DIM TaskParamLabels(4) TaskParamLabels(0)="velo" TaskParamLabels(1)="speed" TaskParamLabels(2)="step" TaskParamLabels(3)="hilim" TaskParamLabels(4)="lowlim" MakeTaskParameterDialog %So_Scale,2, Slider(),3,UdCtrl(), TaskParamLabels() slnr = TaskEX(%So_Scale).SliderNumbers(0) Slider(slnr).value = 64 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value Slider(slnr+1).value = 36 SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, Slider(Slnr+1).value IF udnr = %False THEN udnr = TaskEX(%So_Scale).UpDownNumbers(0) UDctrl(udnr).cptr = CODEPTR(So_Scale_UD0) ' step size UDctrl(udnr).value = 1 UDctrl(udnr).minval = 0 UDctrl(udnr).maxval = 12 UDctrl(udnr).stap = 1 UDctrl(udnr+1).cptr = CODEPTR(So_Scale_UD1) ' high note limit UDctrl(udnr+1).value = So.HighTes '22 UDctrl(udnr+1).minval = So.lowtes + 1 ' 15 UDctrl(udnr+1).maxval = So.Hightes ' 69 UDctrl(udnr+2).cptr = CODEPTR(So_Scale_UD2) ' low note limit UDctrl(udnr+2).value = So.LowTes '22 UDctrl(udnr+2).minval = So.lowtes UDctrl(udnr+2).maxval = So.Hightes -1 END IF END IF Task(%So_Scale).tog = %True cnt = So.Lowtes EXIT SUB END IF IF ISFALSE onoff THEN IF n THEN mPlay So.channel, n, 0 'NoteOff So.channel, n ' no release byte n = %False onoff = %True ELSE n = cnt mPlay So.channel, n, Slider(slnr).value cnt = cnt + UDCtrl(udnr).value IF cnt > So.Hightes THEN cnt = UDctrl(udnr+2).value onoff = %False END IF Task(%So_Scale).freq = Slider(slnr+1).value / 16 END SUB SUB So_Scale_UD0 () ' callback on parameter UpDowns. : step size LOCAL value AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%So_Scale).UpdownNumbers(0) value = UDCtrl(udnr).value IF value > 12 THEN UDctrl(udnr).value = 12 : value = 12 IF value < 0 THEN UDCTRL(udnr).value = 0 : value = 0 SetDlgItemText Task(%So_Scale).hparam, %GMT_TEXT0_ID + 16, "s=" & STR$(value) END SUB SUB So_Scale_UD1 () ' controls the high limit of the note scale to be played. LOCAL noot AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%So_Scale).UpDownNumbers(1) noot = UDCtrl(udnr).value IF noot < So.lowtes + 1 THEN UDctrl(udnr).value = So.lowtes +1: noot = so.lowtes +1 IF noot > So.HighTes THEN UDctrl(udnr).value = So.HighTes : noot = So.hightes IF noot < UDctrl(udnr+1).value THEN noot = UDctrl(udnr+1).value SetDlgItemText Task(%So_Scale).hparam, %GMT_TEXT0_ID + 17, "Hi=" & STR$(noot) END SUB SUB So_Scale_UD2 () ' controls the low limit of the note scale to be played. LOCAL noot AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%So_Scale).UpDownNumbers(2) noot = UDCtrl(udnr).value IF noot < So.lowtes THEN UDctrl(udnr).value = So.lowtes : noot = so.lowtes IF noot > So.HighTes -1 THEN UDctrl(udnr).value = So.HighTes -1: noot = So.hightes -1 IF noot > UDctrl(udnr-1).value THEN noot = UDctrl(udnr-1).value SetDlgItemText Task(%So_Scale).hparam, %GMT_TEXT0_ID + 18, "Lo=" & STR$(noot) END SUB SUB So_What () ' demo piece. - running melodic bass ' rewritten 07.2007 - gwr ' 15.02.2020: rechecked. ' no noteoff's in this code! STATIC i AS DWORD STATIC j AS DWORD STATIC cnt AS LONG STATIC TaskParamLabels() AS ASCIIZ*8 STATIC slnr AS INTEGER STATIC oldnote AS INTEGER STATIC lastj AS DWORD STATIC lasti AS DWORD STATIC oldbourdonolanote AS DWORD STATIC oldpiperolanote AS DWORD STATIC oldbononote AS DWORD STATIC udnr AS INTEGER STATIC n AS INTEGER IF ISFALSE Task(%So_What).tog THEN IF ISFALSE Task(%So_What).hParam THEN DIM TaskParamLabels(3) TaskParamLabels(0)="volu" TaskParamLabels(1)="speed" TaskParamLabels(2)="Bo" TaskParamLabels(3)="Pip" MakeTaskParameterDialog %So_What,2, Slider(),3,UdCtrl(), TaskParamLabels() slnr = TaskEX(%So_What).SliderNumbers(0) Slider(slnr).value = 63 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value Slider(slnr+1).value = 24 SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, Slider(Slnr+1).value END IF IF ISFALSE udnr THEN udnr = TaskEX(%So_What).UpDownNumbers(0) UDctrl(udnr).cptr = CODEPTR(So_What_UD0) ' bourdonola or bono toggle UDctrl(udnr).value = 0 UDctrl(udnr).minval = 0 UDctrl(udnr).maxval = 1 UDctrl(udnr).stap = 1 UDctrl(udnr+1).cptr = CODEPTR(So_What_UD1) ' piperola toggle UDctrl(udnr+1).value = 0 UDctrl(udnr+1).minval = 0 UDctrl(udnr+1).maxval = 1 UDctrl(udnr+1).stap = 1 END IF cnt = %False Task(%So_What).tog = %True Controller So.channel, 123, %False IF ISFALSE So.ctrl(66) THEN Controller So.channel, 66, 127 So.ctrl(66) = 127 END IF i = 22 '%False j = i + 2 '%False EXIT SUB END IF IF ISFALSE cnt MOD 2 THEN IF j - i > 13 THEN i = i + 12 IF i < 22 THEN DO i = i + 12 LOOP UNTIL i > 21 END IF 'i = 22 mPlay So.channel, i, Slider(slnr).value lasti = i oldnote = i ELSE IF j < 22 THEN DO j = j+ 12 LOOP UNTIL j > 21 END IF mPlay So.channel, j, Slider(slnr).value lastj = j oldnote = j j = j + 7 IF j > So.Hightes - 12 THEN j = j - (25 - RND(1) * 4) IF (j MOD 12) = (i MOD 12) THEN i = i + 5 IF i > So.hightes - 12 THEN i = i - (25 - RND(1) * 4) END IF END IF INCR cnt IF oldbourdonolanote THEN NoteOff Bourdonola.channel, oldbourdonolanote oldbourdonolanote = %False END IF IF oldbononote THEN NoteOff Bono.channel, oldbononote oldbononote = %False END IF IF oldpiperolanote THEN NoteOff Piperola.channel, oldpiperolanote oldpiperolanote = %False END IF SELECT CASE ABS ((lastj-lasti) MOD 12) CASE 0 Task(%So_What).freq = Slider(slnr+1).value / 32 IF UdCtrl(UdNr).value THEN IF UdCtrl(Udnr).value = 1 THEN oldbourdonolanote = oldnote + 7 mPlay Bourdonola.channel, oldbourdonolanote, 64 ELSE oldbononote = oldnote + 7 mPlay Bono.channel, oldbononote, 64 END IF END IF IF UdCtrl(UdNr+1).value THEN oldpiperolanote = 84 + (oldnote MOD 12) + 10 ' dim7 mPlay Piperola.channel, oldpiperolanote, 64 END IF CASE 7 Task(%So_What).freq = Slider(slnr+1).value / 32 IF UdCtrl(UdNr).value THEN IF Udctrl(Udnr).value = 1 THEN oldbourdonolanote = oldnote + 7 mPlay Bourdonola.channel, oldbourdonolanote, 64 ELSE oldbononote = oldnote + 7 mPlay Bono.channel, oldbononote, 64 END IF END IF IF UdCtrl(UdNr+1).value THEN oldpiperolanote = 84 + (oldnote MOD 12) + 4 ' maj 3th mPlay Piperola.channel, oldpiperolanote, 64 END IF CASE 5 Task(%So_What).freq = Slider(slnr+1).value / 16 IF UdCtrl(UdNr).value THEN IF Udctrl(Udnr).value = 1 THEN oldbourdonolanote = oldnote + 4 mPlay Bourdonola.channel, oldbourdonolanote, 64 ELSE oldbononote = oldnote + 16 IF oldbononote > 48 THEN oldbononote = oldbononote - 12 mPlay Bono.channel, oldbononote, 64 END IF END IF IF UdCtrl(UdNr+1).value THEN oldpiperolanote = 72 + (oldnote MOD 12) + 7 mPlay Piperola.channel, oldpiperolanote, 64 END IF CASE 3,4,8,9 Task(%So_What).freq = Slider(slnr+1).value / 8 IF UdCTRl(UDnr+1).value THEN oldpiperolanote = 72 + (j MOD 12) mPlay Piperola.channel, oldpiperolanote, 64 END IF CASE 2,10 Task(%So_What).freq = Slider(slnr+1).value / 8 IF UdCTRl(UDnr+1).value THEN oldpiperolanote = 72 + (i MOD 12) mPlay Piperola.channel, oldpiperolanote, 64 END IF CASE 1,11,6 Task(%So_What).freq = Slider(slnr+1).value / 8 IF UdCTRl(UDnr+1).value THEN oldpiperolanote = 72 + ((lastj - lasti) MOD 12) + 3 mPlay Piperola.channel, oldpiperolanote, 64 END IF END SELECT END SUB SUB So_What_UD0 () ' callback on parameter UpDowns. : on/off bourdonola or bono LOCAL value AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%So_What).UpdownNumbers(0) value = UDCtrl(udnr).value IF value > 2 THEN UDctrl(udnr).value = 2 : value = 2 IF value < 0 THEN UDCTRL(udnr).value = 0 : value = 0 SELECT CASE value CASE 0 MM_Bourdonola_Off MM_Bono_Off CASE 1 MM_Bourdonola_On MM_Bono_off MM_Bourdonola_On %MM_Lights CASE 2 MM_Bono_On MM_Bourdonola_Off Controller Bono.channel, 7, 127 Controller Bono.channel, 18, 105 Controller Bono.channel, 17, 64 Controller Bono.channel, 19, 107 'MM_Bono_On %MM_Lights END SELECT SetDlgItemText Task(%So_What).hparam, %GMT_TEXT0_ID + 16, "b=" & STR$(value) END SUB SUB So_What_UD1 () ' callback on parameter UpDowns. : on/off piperola LOCAL value AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%So_What).UpdownNumbers(1) value = UDCtrl(udnr).value IF value > 1 THEN UDctrl(udnr).value = 1 : value = 1 IF value < 0 THEN UDCTRL(udnr).value = 0 : value = 0 IF value THEN MM_Piperola_On ' motor ON, full power ELSE MM_Piperola_Off END IF SetDlgItemText Task(%So_What).hparam, %GMT_TEXT0_ID + 17, "p=" & STR$(value) END SUB SUB So_Lites () ' mapped on notes 49 - 50 - 51(logos display) in version 2 ' in version 3, mapped on 120, 121, 122, 123 ' changed 13.02.2020 ' changed on the PIC level. ' now on notes 120,121,122,123 STATIC cnt AS DWORD IF ISFALSE Task(%So_Lites).tog THEN cnt = 120 Task(%So_Lites).tog = %true END IF NoteOff So.channel, cnt INCR cnt IF cnt > 123 THEN cnt = 120 mPlay So.channel, cnt, 127 END SUB 'SUB So_Volume () '' controller 7 test - included in ADSR test ' STATIC slnr AS DWORD ' STATIC TaskParamLabels() AS ASCIIZ*8 ' IF ISFALSE Task(%So_Volume).tog THEN ' IF ISFALSE Task(%So_Volume).hParam THEN ' DIM TaskParamLabels(0) ' TaskParamLabels(0)="ctrl 7" ' MakeTaskParameterDialog %So_Volume,1, Slider(),0,UdCtrl(), TaskParamLabels() ' slnr = TaskEX(%So_Volume).SliderNumbers(0) ' Slider(slnr).value = 63 ' SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value ' END IF ' END IF ' IF slider(slnr).value <> So.ctrl(7) THEN ' So.ctrl(7) = Slider(slnr).value ' Controller So.channel, 7, So.ctrl(7) ' END IF 'END SUB SUB So_Display () ' controller 14 stelt de funktiewijze in (modus) ' 0 = display midi notes played ' 1 = shows value sent with controller 15 (0-99) ' 2 = display msb shows value send with controller 16 (0-15) ' lsb shows value send with controller 17 (0-15) ' 3 = displays gedoofd ' implemented on dsPIC 11.08.2007. ' 14.02.2020: to be changed to controllers 34 to 37 ' requires adapting firmware on the dsPIC ' 18.02.2020: dsPIC firmware adapted. STATIC slnr AS DWORD STATIC udnr AS DWORD STATIC cnt AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 IF ISFALSE Task(%So_Display).tog THEN IF ISFALSE Task(%So_Display).hParam THEN DIM TaskParamLabels(2) TaskParamLabels(0)="msb" TaskParamLabels(1)="lsb" TaskParamLabels(2)="mode" ' display modus u/d MakeTaskParameterDialog %So_Display,2, Slider(),1,UdCtrl(), TaskParamLabels() slnr = TaskEX(%So_Display).SliderNumbers(0) Slider(slnr).value = 0 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value Slider(slnr+1).value = 0 SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, Slider(Slnr+1).value END IF IF ISFALSE udnr THEN udnr = TaskEX(%So_Display).UpDownNumbers(0) UDctrl(udnr).cptr = CODEPTR(So_Display_UD) ' modus ud UDctrl(udnr).value = 0 UDctrl(udnr).minval = 0 UDctrl(udnr).maxval = 4 ' tmp UDctrl(udnr).stap = 1 END IF cnt = %False Task(%So_Display).freq = 2 Task(%So_Display).tog = %True END IF SELECT CASE UDctrl(udnr).value CASE 0 ' displays midi note played IF So.ctrl(34) <> 0 THEN Controller So.channel, 34, %False So.ctrl(34) = %False END IF CASE 1 ' count Controller So.channel, 35, cnt So.ctrl(35) = cnt INCR cnt IF cnt > 99 THEN cnt = %False CASE 2 IF So.ctrl(36) <> Slider(slnr).value THEN Controller So.channel, 36, slider(slnr).value MOD 16 So.ctrl(36) = Slider(slnr).value MOD 16 END IF IF So.ctrl(37) <> Slider(slnr+1).value THEN Controller So.channel, 37, slider(slnr+1).value MOD 16 So.ctrl(37) = Slider(slnr+1).value MOD 16 END IF CASE 3 ' blank displays cnt = %False END SELECT ' for debugging pic coding: ' Controller So.channel, 35, cnt ' So.ctrl(35) = cnt ' INCR cnt ' IF cnt > 99 THEN cnt = %False ' IF So.ctrl(36) <> Slider(slnr+1).value THEN ' Controller So.channel, 36, slider(slnr+1).value MOD 16 ' So.ctrl(36) = Slider(slnr+1).value MOD 16 ' END IF ' IF So.ctrl(37) <> Slider(slnr+2).value THEN ' Controller So.channel, 37, slider(slnr+2).value MOD 16 ' So.ctrl(37) = Slider(slnr+2).value MOD 16 ' END IF END SUB SUB So_Display_UD () ' callback on parameter UpDowns. : display modus controller LOCAL value AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%So_Display).UpdownNumbers(0) value = UDCtrl(udnr).value IF value > 4 THEN UDctrl(udnr).value = 4 : value = 4 ' must be 3 - for pic debug IF value < 0 THEN UDCTRL(udnr).value = 0 : value = 0 SetDlgItemText Task(%So_Display).hparam, %GMT_TEXT0_ID + 16, "m=" & STR$(value) IF So.ctrl(34) <> value THEN Controller So.channel, 34, value So.ctrl(34) = value END IF END SUB SUB So_Bend () ' test voor de pitchbend funktie: +/- 1 semitone. ' no longer needed. ' pitchbend must follow a note on! STATIC slnr AS DWORD STATIC udnr AS DWORD STATIC cnt AS INTEGER STATIC TaskParamLabels() AS ASCIIZ*8 IF ISFALSE Task(%So_Bend).tog THEN IF ISFALSE Task(%So_Bend).hParam THEN DIM TaskParamLabels(1) TaskParamLabels(0)="speed" TaskParamLabels(1)="U/D" MakeTaskParameterDialog %So_Bend,1, Slider(),1,UdCtrl(), TaskParamLabels() slnr = TaskEX(%So_Bend).SliderNumbers(0) Slider(slnr).value = 64 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value END IF IF ISFALSE udnr THEN udnr = TaskEX(%So_Bend).UpDownNumbers(0) UDctrl(udnr).cptr = CODEPTR(So_Bend_UD) ' up down bend ud UDctrl(udnr).value = 1 UDctrl(udnr).minval = 0 UDctrl(udnr).maxval = 1 UDctrl(udnr).stap = 1 END IF cnt = 64 Task(%So_Bend).tog = %True END IF Bend So.channel, 0, cnt IF UDctrl(udnr).value THEN INCR cnt IF cnt >127 THEN cnt = 64 ELSE DECR cnt IF cnt <=0 THEN cnt = 64 END IF Task(%So_Bend).freq = MAX(4, Slider(slnr).value / 3) END SUB SUB So_Bend_UD () ' callback on parameter UpDowns. : pitch bend direction LOCAL value AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%So_Bend).UpdownNumbers(0) value = UDCtrl(udnr).value IF value > 1 THEN UDctrl(udnr).value = 1 : value = 1 IF value < 0 THEN UDCTRL(udnr).value = 0 : value = 0 IF value = 0 THEN SetDlgItemText Task(%So_Bend).hparam, %GMT_TEXT0_ID + 16, "down" ELSE SetDlgItemText Task(%So_Bend).hparam, %GMT_TEXT0_ID + 16, "up" END IF END SUB SUB So_Tune () ' tuning to diapason. ' controller 20 ' implemented 29.01.2020 ' not a good interface, as allowable values are only 61 to 67 STATIC slnr AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 IF ISFALSE Task(%So_Tune).tog THEN IF ISFALSE Task(%So_Tune).hParam THEN DIM TaskParamLabels(0) TaskParamLabels(0)="tune" MakeTaskParameterDialog %So_Tune,1, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%So_Tune).SliderNumbers(0) Slider(slnr).cptr = CODEPTR(So_SL20) So.ctrl(20) = 64 ' set to 440Hz Slider(slnr).value = So.ctrl(20) ' we should limit slider range here to 61-67.... SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value END IF Task(%So_Tune).freq = 0.45 Task(%So_Tune).tog = %True END IF END SUB SUB So_SL20 () ' slider callback STATIC slnr AS DWORD slnr = TaskEX(%So_Tune).SliderNumbers(0) IF slider(slnr).value <> So.ctrl(20) THEN So.ctrl(20) = Slider(slnr).value Controller So.channel, 20, So.ctrl(20) END IF END SUB SUB So_CC80 () ' dynamic scaling to 20db- 40dB - 60dB ' controller 80 ' implemented 13.02.2020 ' not a good interface, as allowable values are only <64, 64 and >64 ' 15.02.2020: coded. ' 13.12.2020: now 5 ranges available: see manual. ' default is now 30dB STATIC slnr AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 IF ISFALSE Task(%So_C80).tog THEN IF ISFALSE Task(%So_C80).hParam THEN DIM TaskParamLabels(0) TaskParamLabels(0)="CC80" MakeTaskParameterDialog %So_C80,1, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%So_C80).SliderNumbers(0) So.ctrl(80) = 40 ' set to 30dB - this is the new default Slider(slnr).value = So.ctrl(80) SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value END IF Task(%So_C80).freq = 2 Task(%So_C80).tog = %True END IF SELECT CASE slider(slnr).value CASE < 64 IF So.ctrl(80) > 63 THEN So.ctrl(80) = 0 Controller So.channel, 80, 0 END IF CASE 64 IF So.ctrl(80) <> 64 THEN So.ctrl(80) = 64 Controller So.channel, 80, 64 END IF CASE > 64 IF So.ctrl(80) < 65 THEN So.ctrl(80) = 127 Controller So.channel, 80, 127 END IF END SELECT END SUB SUB So_adsr () ' This controls the enveloppe and the overall ADSR properties. ' 14.02.2020: starting from Flut coding. ' 13.12.2020: defaults and implementation changed. STATIC slnr AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 IF ISFALSE Task(%So_adsr).tog THEN IF ISFALSE Task(%So_adsr).hParam THEN DIM TaskParamLabels(5) TaskParamLabels(0)="C7" TaskParamlabels(1)="c15" TaskParamLabels(2)="c16" TaskParamlabels(3)="c17" TaskParamlabels(4)="c18" TaskParamLabels(5)="c19" MakeTaskParameterDialog %So_adsr,6, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%So_adsr).SliderNumbers(0) Slider(slnr).cptr = CODEPTR(So_SL7) Slider(slnr).value = 104 So.ctrl(7) = 104 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value Controller So.channel, 7, So.ctrl(7) Slider(slnr+1).cptr = CODEPTR(So_SL15) Slider(slnr+1).value = 32 So.ctrl(15) = 32 '50 '89 SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, Slider(Slnr+1).value Controller So.channel, 15, So.ctrl(15) Slider(slnr+2).cptr = CODEPTR(So_SL16) Slider(slnr+2).value = 26 '108 So.ctrl(16) = 26 '45 '108 SendMessage Slider(Slnr+2).h, %TBM_SETPOS,%True, Slider(Slnr+2).value Controller So.channel, 16, So.ctrl(16) Slider(slnr+3).cptr = CODEPTR(So_SL17) Slider(slnr+3).value = 120 So.ctrl(17) = 120 ' 120 SendMessage Slider(Slnr+3).h, %TBM_SETPOS,%True, Slider(Slnr+3).value Controller So.channel, 17, So.ctrl(17) Slider(slnr+4).cptr = CODEPTR(So_SL18) Slider(slnr+4).value = 17 '61 So.ctrl(18) = 17 ' 61 SendMessage Slider(Slnr+4).h, %TBM_SETPOS,%True, Slider(Slnr+4).value Controller So.channel, 18, So.ctrl(18) Slider(slnr+5).cptr = CODEPTR(So_SL19) Slider(slnr+5).value = 40 So.ctrl(19) = 40 SendMessage Slider(Slnr+5).h, %TBM_SETPOS,%True, Slider(Slnr+5).value Controller So.channel, 19, So.ctrl(19) END IF Task(%So_adsr).freq = 10 Task(%So_adsr).tog = %True END IF ' all sliders handled in callbacks. Task(%So_adsr).freq = 2 END SUB SUB So_SL7 () ' slider callback STATIC slnr AS DWORD slnr = TaskEX(%So_adsr).SliderNumbers(0) IF slider(slnr).value <> So.ctrl(7) THEN So.ctrl(7) = Slider(slnr).value Controller So.channel, 7, So.ctrl(7) END IF END SUB SUB So_SL15 () ' slider callback STATIC slnr AS DWORD slnr = TaskEX(%So_adsr).SliderNumbers(1) IF slider(slnr).value <> So.ctrl(15) THEN So.ctrl(15) = Slider(slnr).value Controller So.channel, 15, So.ctrl(15) END IF END SUB SUB So_SL16 () ' slider callback STATIC slnr AS DWORD slnr = TaskEX(%So_adsr).SliderNumbers(2) IF slider(slnr).value <> So.ctrl(16) THEN So.ctrl(16) = Slider(slnr).value Controller So.channel, 16, So.ctrl(16) END IF END SUB SUB So_SL17 () ' slider callback STATIC slnr AS DWORD slnr = TaskEX(%So_adsr).SliderNumbers(3) IF slider(slnr).value <> So.ctrl(17) THEN So.ctrl(17) = Slider(slnr).value Controller So.channel, 17, So.ctrl(17) END IF END SUB SUB So_SL18 () ' slider callback STATIC slnr AS DWORD slnr = TaskEX(%So_adsr).SliderNumbers(4) IF slider(slnr).value <> So.ctrl(18) THEN So.ctrl(18) = Slider(slnr).value Controller So.channel, 18, So.ctrl(18) END IF END SUB SUB So_SL19 () ' slider callback STATIC slnr AS DWORD slnr = TaskEX(%So_adsr).SliderNumbers(5) IF slider(slnr).value <> So.ctrl(19) THEN So.ctrl(19) = Slider(slnr).value Controller So.channel, 19, So.ctrl(19) END IF END SUB SUB So_QScale () ' quartertone scale test. STATIC onoff AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 STATIC slnr AS INTEGER STATIC n AS INTEGER IF ISFALSE Task(%So_Qscale).tog THEN IF ISFALSE Task(%So_QScale).hParam THEN DIM TaskParamLabels(2) TaskParamLabels(0)="velo" TaskParamLabels(1)="speed" MakeTaskParameterDialog %So_QScale,2, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%So_QScale).SliderNumbers(0) Slider(slnr).value = 64 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value Controller So.channel, 17, 84 So.ctrl(17) = 84 Controller So.channel, 18, 104 So.ctrl(18) = 104 Slider(slnr+1).value = 30 SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, Slider(Slnr+1).value END IF IF ISFALSE So.ctrl(66) THEN MM_So_On so.ctrl(66) = 127 END IF Task(%So_QScale).tog = %True n = So.Lowtes END IF IF ISFALSE onoff THEN Bend So.channel, 0, 64 ' if this is required there is a bug in the pic firmware. ' as of 23.11.2008 we do have this bug however!!! mPlay So.channel, n, Slider(slnr).value onoff = %True ELSE mPlay So.channel, n, Slider(slnr).value Bend So.channel, 0, 127 ' or, 64 + 50 = 114 if a step corresponds to a cent. onoff = %False INCR n END IF IF n > So.hightes THEN n= So.lowtes Task(%So_QScale).freq = MAX(0.25,Slider(slnr+1).value / 4) END SUB SUB So_Vibrato () ' 14.02.2020: test for PIC based FM in ' controllers 3 and 4 ' implemented on the synth board STATIC slnr AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 IF ISFALSE Task(%So_vibrato).tog THEN IF ISFALSE Task(%So_vibrato).hParam THEN DIM TaskParamLabels(1) TaskParamLabels(0)="Speed 4" ' ctrl 4 TaskParamlabels(1)="Depth 3" ' ctrl 3 MakeTaskParameterDialog %So_vibrato,2, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%So_vibrato).SliderNumbers(0) Slider(slnr).value = 94 ' robot defaults Slider(slnr+1).value = 8 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value Sendmessage Slider(slnr+1).h, %TBM_SETPOS,%True, Slider(slnr+1).value END IF IF ISFALSE So.ctrl(66) THEN MM_So_On So.ctrl(66) = 127 END IF Task(%So_Vibrato).tog = %True Task(%So_Vibrato).freq = 4 END IF IF Slider(slnr).value <> So.ctrl(4) THEN ' FM speed Controller So.channel, 4, slider(slnr).value So.ctrl(4) = slider(slnr).value END IF IF Slider(slnr+1).value <> So.ctrl(3) THEN ' FM depth Controller So.channel, 3, slider(slnr+1).value So.ctrl(3) = slider(slnr+1).value END IF END SUB SUB So_Vibrato_Stop () ' reset Controller So.channel, 4, 0 RESET So.ctrl(4) Controller So.channel, 3, 0 RESET So.ctrl(3) END SUB SUB So_Tremolo () ' controller test for tremolo - DS pic controlled. ' 09.12.2016 - synth board ' 28.01.2020 Works o.k. on flut ' 14.02.2020 Included and adapted for So STATIC slnr AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 STATIC cnt AS DWORD IF ISFALSE Task(%So_tremolo).tog THEN IF ISFALSE Task(%So_tremolo).hParam THEN DIM TaskParamLabels(1) TaskParamLabels(0)="Speed 6" ' ctrl 6 TaskParamlabels(1)="Depth 5" ' ctrl 5 MakeTaskParameterDialog %So_tremolo,2, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%So_tremolo).SliderNumbers(0) Slider(slnr).value = 20 Slider(slnr+1).value = 6 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value Sendmessage Slider(slnr+1).h, %TBM_SETPOS,%True, Slider(slnr+1).value END IF cnt = %False IF so.ctrl(66) = %False THEN MM_So_On So.ctrl(66) = 127 END IF Task(%So_Tremolo).tog = %True Task(%So_Tremolo).freq = 12 END IF IF Slider(slnr).value <> So.ctrl(6) THEN ' AM speed Controller So.channel, 6, slider(slnr).value So.ctrl(6) = slider(slnr).value END IF IF Slider(slnr+1).value <> So.ctrl(5) THEN ' AM depth Controller So.channel, 5, slider(slnr+1).value So.ctrl(5) = slider(slnr+1).value END IF END SUB SUB So_Tremolo_Stop () Controller So.channel, 5, 0 So.ctrl(5) = 0 Controller So.channel, 6, 0 So.ctrl(6) = 0 END SUB 'SUB So_ProgChange_bad () ' ' 17.12.2016: test voor de program changes: different waveform lookup tables. ' ' 18.12.2016: sliders added voor de golfvormparameters 100-110 ' ' 27.01.2020: bug removed here: we forgot to send the prog.change itself after the parameters ' ' 28.01.2020: rewritten. ' ' 02.02.2020: now serves the register 72-92 ' ' 14.02.2020: adapted to so tests ' ' this does not work as Windows refuses this amount of sliders... ' STATIC TaskParamLabels() AS ASCIIZ*8 ' STATIC udnr, slnr AS DWORD ' STATIC prog, oldprog AS INTEGER ' ' IF ISFALSE Task(%So_ProgChange).tog THEN ' IF ISFALSE Task(%So_ProgChange).hParam THEN ' DIM TaskParamLabels(10) ' TaskParamlabels(0)="c100" ' TaskParamlabels(1)="c101" ' TaskParamlabels(2)="c102-p20" ' TaskParamlabels(3)="c103" ' TaskParamlabels(4)="c104" ' TaskParamlabels(5)="c105" ' TaskParamlabels(6)="c106" ' TaskParamlabels(7)="c107" ' TaskParamlabels(8)="c108-p21" ' TaskParamlabels(9)="c109" ' TaskParamLabels(10)="prog" ' MakeTaskParameterDialog %So_Progchange,9, Slider(),1,UdCtrl(), TaskParamLabels() ' IF udnr = %False THEN ' udnr = TaskEX(%So_ProgChange).UpDownNumbers(0) ' UDctrl(udnr).cptr = CODEPTR(So_ProgChange_UD0) ' prog.nr. ' UDctrl(udnr).value = 0 ' UDctrl(udnr).minval = 0 ' UDctrl(udnr).maxval = 9 ' UDctrl(udnr).stap = 1 ' END IF ' IF ISFALSE slnr THEN ' slnr = TaskEX(%So_ProgChange).Slidernumbers(0) ' END IF ' So.ctrl(100) = 60 ' IF slider(slnr).value <> So.ctrl(100) THEN ' SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, So.ctrl(100) ' slider(slnr).value = So.ctrl(100) ' END IF ' So.ctrl(101) = 64 ' IF slider(slnr+1).value <> So.ctrl(101) THEN ' SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, So.ctrl(101) ' slider(slnr+1).value = So.ctrl(101) ' END IF ' So.ctrl(102) = 51 '20 ' IF slider(slnr+2).value <> So.ctrl(102) THEN ' SendMessage Slider(Slnr+2).h, %TBM_SETPOS,%True, So.ctrl(102) ' slider(slnr+2).value = So.ctrl(102) ' END IF ' So.ctrl(103) = 0 ' IF slider(slnr+3).value <> So.ctrl(103) THEN ' SendMessage Slider(Slnr+3).h, %TBM_SETPOS,%True, So.ctrl(103) ' slider(slnr+3).value = So.ctrl(103) ' END IF ' So.ctrl(104) = 6 ' IF slider(slnr+4).value <> So.ctrl(104) THEN ' SendMessage Slider(Slnr+4).h, %TBM_SETPOS,%True, So.ctrl(104) ' slider(slnr+4).value = So.ctrl(104) ' END IF ' So.ctrl(105) = 3 '31 ' IF slider(slnr+5).value <> So.ctrl(105) THEN ' SendMessage Slider(Slnr+5).h, %TBM_SETPOS,%True, So.ctrl(105) ' slider(slnr+5).value = So.ctrl(105) ' END IF ' So.ctrl(106) = 28 ' IF slider(slnr+6).value <> So.ctrl(106) THEN ' SendMessage Slider(Slnr+6).h, %TBM_SETPOS,%True, So.ctrl(106) ' slider(slnr+6).value = So.ctrl(106) ' END IF ' So.ctrl(107) = 64 ' IF slider(slnr+7).value <> So.ctrl(107) THEN ' SendMessage Slider(Slnr+7).h, %TBM_SETPOS,%True, So.ctrl(107) ' slider(slnr+7).value = So.ctrl(107) ' END IF ' So.ctrl(108) = 12 '64 ' IF slider(slnr+8).value <> So.ctrl(108) THEN ' SendMessage Slider(Slnr+8).h, %TBM_SETPOS,%True, So.ctrl(108) ' slider(slnr+8).value = So.ctrl(108) ' END IF ' So.ctrl(109) = 64 ' IF slider(slnr+9).value <> So.ctrl(109) THEN ' SendMessage Slider(Slnr+9).h, %TBM_SETPOS,%True, So.ctrl(109) ' slider(slnr+9).value = So.ctrl(109) ' END IF ' END IF ' RESET prog ' Task(%So_ProgChange).tog = %True ' END IF ' ' IF slider(slnr).value <> So.ctrl(100) THEN ' Controller So.channel, 100, slider(slnr).value ' So.ctrl(100) = slider(slnr).value ' END IF ' ' IF slider(slnr+1).value <> So.ctrl(101) THEN ' Controller So.channel, 101, slider(slnr+1).value ' So.ctrl(101) = slider(slnr+1).value ' END IF ' IF slider(slnr+2).value <> So.ctrl(102) THEN ' Controller So.channel, 102, slider(slnr+2).value ' So.ctrl(102) =slider(slnr+2).value ' END IF ' IF slider(slnr+3).value <> So.ctrl(103) THEN ' Controller So.channel, 103, slider(slnr+3).value ' So.ctrl(103) =slider(slnr+3).value ' END IF ' IF slider(slnr+4).value <> So.ctrl(104) THEN ' Controller So.channel, 104, slider(slnr+4).value ' So.ctrl(104) = slider(slnr+4).value ' END IF ' IF slider(slnr+5).value <> So.ctrl(105) THEN ' Controller So.channel, 105, slider(slnr+5).value ' So.ctrl(105) = slider(slnr+5).value ' END IF ' IF slider(slnr+6).value <> So.ctrl(106) THEN ' Controller So.channel, 106, slider(slnr+6).value ' So.ctrl(106) =slider(slnr+6).value ' END IF ' IF slider(slnr+7).value <> So.ctrl(107) THEN ' Controller So.channel, 107, slider(slnr+7).value ' So.ctrl(107) =slider(slnr+7).value ' END IF ' IF slider(slnr+8).value <> So.ctrl(108) THEN ' Controller So.channel, 108, slider(slnr+8).value ' So.ctrl(108) = slider(slnr+8).value ' END IF ' IF slider(slnr+9).value <> So.ctrl(109) THEN ' Controller So.channel, 109, slider(slnr+9).value ' So.ctrl(109) = slider(slnr+9).value ' END IF ' IF UDctrl(udnr).value <> prog THEN ' prog = UDctrl(udnr).value ' ' IF BIT(prog,2) = 1 THEN ' ' BIT SET So_Prog,2 ' ' ELSE ' ' BIT RESET So_Prog,2 ' ' END IF ' ' IF BIT(prog,1) = 1 THEN ' ' BIT SET So_Prog,1 ' ' ELSE ' ' BIT RESET So_Prog,1 ' ' END IF ' ' IF BIT(prog,0) = 1 THEN ' ' BIT SET So_Prog,0 ' ' ELSE ' ' BIT RESET So_Prog,0 ' ' END IF ' ProgChange So.channel, So_prog ' END IF 'END SUB ' 'SUB So_ProgChange () ' ' 17.12.2016: test voor de program changes: different waveform lookup tables. ' ' 18.12.2016: sliders added voor de golfvormparameters 100-110 ' ' 27.01.2020: bug removed here: we forgot to send the prog.change itself after the parameters ' ' 28.01.2020: rewritten. ' ' 02.02.2020: now serves the register 72-92 ' ' 14.02.2020: adapted to so tests ' ' the above remmed code does not work as Windows refuses this amount of sliders... ' ' 21.02.2020: Visualisation of waveforms added. ' ' 03.03.2020: only implemented on the PIC for low register, with waves 0 to 8 ' ' 06.03.2020: waves 7 and 8 sample based. ' ' 07.03.2020: Firmware changed. Only 5 prog. changes possible now. ' ' 18.03.2020: Doubled with ctrl. 41. 8 prog changes for the low register ' ' 19.03.2020: needs revision. we may remove prog.change altogether even... ' ' STATIC TaskParamLabels() AS ASCIIZ*8 ' STATIC udnr, slnr, hndl AS DWORD ' STATIC prog, oldprog, param AS INTEGER ' LOCAL i AS INTEGER ' ' IF ISFALSE Task(%So_ProgChange).tog THEN ' IF ISFALSE gh.spec THEN ' MakeSpectrumWindow ' should fill gh.spec. new, make window to display waveforms... ' END IF ' DIM Arr(255) AS STATIC SINGLE ' DIM Wave0(255) AS STATIC WORD ' DIM Wave1(255) AS STATIC WORD ' 'DIM Wave2(255) AS STATIC WORD ' 'DIM Wave3(255) AS STATIC WORD ' 'DIM Wave4(255) AS STATIC WORD ' DIM Wave5(255) AS STATIC WORD ' DIM Wave6(255) AS STATIC WORD ' DIM Wave7(511) AS STATIC WORD ' ' IF ISFALSE Task(%So_ProgChange).hParam THEN ' DIM TaskParamLabels(1) ' TaskParamlabels(0)="param" ' ' MakeTaskParameterDialog %So_Progchange,1, Slider(),1,UdCtrl(), TaskParamLabels() ' IF udnr = %False THEN ' udnr = TaskEX(%So_ProgChange).UpDownNumbers(0) ' UDctrl(udnr).cptr = CODEPTR(So_ProgChange_UD0) ' prog.nr. ' UDctrl(udnr).value = 0 ' UDctrl(udnr).minval = 0 ' UDctrl(udnr).maxval = 5 ' UDctrl(udnr).stap = 1 ' END IF ' IF ISFALSE slnr THEN ' slnr = TaskEX(%So_ProgChange).Slidernumbers(0) ' END IF ' ' defaults in de dsPIC: ' So.ctrl(100) = 64 ' So.ctrl(101) = 108 ' ' So.ctrl(102) = 101 ' no longer used ' ' So.ctrl(103) = 3 ' ' So.ctrl(104) = 12 ' So.ctrl(105) = 40 ' So.ctrl(106) = 50 ' ' So.ctrl(107) = 64 ' END IF ' RESET prog ' Task(%So_ProgChange).tog = %True ' END IF ' ' prog = UDctrl(udnr).value ' ' ' first determine the prog. change to be used: ' IF oldprog <> prog THEN ' 'Controller So.channel, 123, 0 ' all notes off! - should not be needed as this is done in the PIC firmware ' ProgChange So.channel, prog ' 0 - 5 ' oldprog = prog ' SELECT CASE prog ' CASE 0 ' ' wave8: 4-period sample ' REDIM Arr(511) AS STATIC SINGLE ' So_Wave8 Wave8() ' read sample file ' FOR i = 0 TO UBOUND(Wave8) ' Arr(i) = (Wave8(i)/ 2048) - 0.5 ' -0.5 to + 0.5 ' NEXT i ' Shownormarray gh.spec, Arr() ' CASE 1 ' ' wave7: 2-period sample ' REDIM Arr(255) AS STATIC SINGLE ' So_Wave7 Wave7() ' read sample file ' FOR i = 0 TO UBOUND(Wave7) ' Arr(i) = (Wave7(i)/ 2048) - 0.5 ' -0.5 to + 0.5 ' NEXT i ' Shownormarray gh.spec, Arr() ' CASE 2 ' ' Wave6 ' REDIM Arr(255) AS STATIC SINGLE ' IF slider(slnr).value <> So.ctrl(106) THEN ' So.ctrl(106) = slider(slnr).value ' Controller So.channel, 106, So.ctrl(106) ' END IF ' So_Wave6 So.ctrl(106), Wave6() ' crashes, so must have a bug... ' FOR i = 0 TO UBOUND(Wave6) ' Arr(i) = (Wave6(i)/ 2048) - 0.5 ' -0.5 to + 0.5 ' NEXT i ' Shownormarray gh.spec, Arr() ' CASE 3 ' ' Wave1 ' REDIM Arr(255) AS STATIC SINGLE ' IF slider(slnr).value <> So.ctrl(101) THEN ' So.ctrl(101) = slider(slnr).value ' Controller So.channel, 101, So.ctrl(101) ' END IF ' So_Wave1 So.ctrl(101), Wave1() ' FOR i = 0 TO 255 ' Arr(i) = (Wave1(i)/ 2048) - 0.5 ' -0.5 to + 0.5 ' NEXT i ' Shownormarray gh.spec, Arr() ' CASE 4 ' ' Wave0 ' REDIM Arr(255) AS STATIC SINGLE ' IF slider(slnr).value <> So.ctrl(100) THEN ' So.ctrl(100) = slider(slnr).value ' Controller So.channel, 100, So.ctrl(100) ' END IF ' 'i = So_Wave0 (So.ctrl(100), Wave0()) ' function in g_wave.bas - calculate the wave as in the PIC ' So_Wave0 So.ctrl(100), Wave0() ' FOR i = 0 TO 255 ' Arr(i) = (Wave0(i)/ 2048) - 0.5 ' -0.5 to + 0.5 ' NEXT i ' Shownormarray gh.spec, Arr() ' CASE 5 ' ' wave5 ' REDIM Arr(255) AS STATIC SINGLE ' IF slider(slnr).value <> So.ctrl(105) THEN ' So.ctrl(105) = slider(slnr).value ' Controller So.channel, 105, So.ctrl(105) ' END IF ' So_Wave5 So.ctrl(105), Wave5() ' FOR i = 0 TO UBOUND(Wave5) ' Arr(i) = (Wave5(i)/ 2048) - 0.5 ' -0.5 to + 0.5 ' NEXT i ' Shownormarray gh.spec, Arr() ' END SELECT ' END IF ' ' but even if we do not have a prog change, we should set the parameters: ' IF slider(slnr).value <> So.ctrl(i) THEN ' SELECT CASE prog ' CASE 0,1 ' ' no parameters implemented ' CASE 2 ' ' wave 6 ' REDIM Arr(255) AS STATIC SINGLE ' So_Wave6 So.ctrl(106), Wave6() ' FOR i = 0 TO UBOUND(Wave6) ' Arr(i) = (Wave6(i)/ 2048) - 0.5 ' -0.5 to + 0.5 ' NEXT i ' Shownormarray gh.spec, Arr() ' So.ctrl(106) = slider(slnr).value ' Controller So.channel, 106, So.ctrl(106) ' CASE 3 ' ' wave 1 ' REDIM Arr(255) AS STATIC SINGLE ' So_Wave1 So.ctrl(101), Wave1() ' FOR i = 0 TO UBOUND(Wave1) ' Arr(i) = (Wave1(i)/ 2048) - 0.5 ' -0.5 to + 0.5 ' NEXT i ' Shownormarray gh.spec, Arr() ' So.ctrl(101) = slider(slnr).value ' Controller So.channel, 101, So.ctrl(101) ' CASE 4 ' ' wave0 ' REDIM Arr(255) AS STATIC SINGLE ' So_Wave0 So.ctrl(100), Wave0() ' FOR i = 0 TO UBOUND(Wave0) ' Arr(i) = (Wave0(i)/ 2048) - 0.5 ' -0.5 to + 0.5 ' NEXT i ' Shownormarray gh.spec, Arr() ' So.ctrl(100) = slider(slnr).value ' Controller So.channel, 100, So.ctrl(100) ' CASE 5 ' REDIM Arr(255) AS STATIC SINGLE ' So_Wave5 So.ctrl(105), Wave5() ' FOR i = 0 TO UBOUND(Wave5) ' Arr(i) = (Wave5(i)/ 2048) - 0.5 ' -0.5 to + 0.5 ' NEXT i ' Shownormarray gh.spec, Arr() ' So.ctrl(105) = slider(slnr).value ' Controller So.channel, 105, So.ctrl(105) ' END SELECT ' END IF 'END SUB ' 'SUB So_ProgChange_UD0 () ' ' callback on parameter UpDowns ' LOCAL value AS BYTE ' LOCAL udnr, slnr AS DWORD ' udnr = TaskEX(%So_ProgChange).UpdownNumbers(0) ' slnr = TaskEX(%So_ProgChange).SliderNumbers(0) ' value = UDCtrl(udnr).value ' IF value > 5 THEN UDctrl(udnr).value = 5 : value = 5 ' IF value < 0 THEN UDCTRL(udnr).value = 0 : value = 0 ' SELECT CASE value ' CASE 2 ' SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, So.ctrl(106) ' CASE 3 ' SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, So.ctrl(101) ' CASE 4 ' SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, So.ctrl(100) ' CASE 5 ' SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, So.ctrl(105) ' END SELECT ' SetDlgItemText Task(%So_ProgChange).hparam, %GMT_TEXT0_ID + 16, "p=" & STR$(value) 'END SUB ' 'SUB So_ProgChangeMed () ' ' 17.12.2016: test voor de program changes: different waveform lookup tables. ' ' 18.12.2016: sliders added voor de golfvormparameters 100-110 ' ' 27.01.2020: bug removed here: we forgot to send the prog.change itself after the parameters ' ' 28.01.2020: rewritten. ' ' 02.02.2020: now serves the register 72-92 ' STATIC TaskParamLabels() AS ASCIIZ*8 ' STATIC udnr, slnr AS DWORD ' STATIC prog, oldprog AS INTEGER ' ' IF ISFALSE Task(%So_ProgChangeMed).tog THEN ' IF ISFALSE Task(%So_ProgChangeMed).hParam THEN ' DIM TaskParamLabels(9) ' TaskParamlabels(0)="c100" ' TaskParamlabels(1)="c101" ' TaskParamlabels(2)="c102-p20" ' TaskParamlabels(3)="c103" ' TaskParamlabels(4)="c104" ' TaskParamlabels(5)="c105" ' TaskParamlabels(6)="c106" ' TaskParamlabels(7)="c107" ' TaskParamlabels(8)="c108-p21" ' TaskParamLabels(9)="prog" ' MakeTaskParameterDialog %So_ProgchangeMed,9, Slider(),1,UdCtrl(), TaskParamLabels() ' IF udnr = %False THEN ' udnr = TaskEX(%So_ProgChangeMed).UpDownNumbers(0) ' UDctrl(udnr).cptr = CODEPTR(So_ProgChangeMed_UD0) ' prog.nr. ' UDctrl(udnr).value = 0 ' UDctrl(udnr).minval = 0 ' UDctrl(udnr).maxval = 7 ' UDctrl(udnr).stap = 1 ' END IF ' IF ISFALSE slnr THEN ' slnr = TaskEX(%So_ProgChangeMed).Slidernumbers(0) ' END IF ' So.ctrl(100) = 60 ' IF slider(slnr).value <> So.ctrl(100) THEN ' SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, So.ctrl(100) ' slider(slnr).value = So.ctrl(100) ' END IF ' So.ctrl(101) = 64 ' IF slider(slnr+1).value <> So.ctrl(101) THEN ' SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, So.ctrl(101) ' slider(slnr+1).value = So.ctrl(101) ' END IF ' So.ctrl(102) = 51 '20 ' IF slider(slnr+2).value <> So.ctrl(102) THEN ' SendMessage Slider(Slnr+2).h, %TBM_SETPOS,%True, So.ctrl(102) ' slider(slnr+2).value = So.ctrl(102) ' END IF ' So.ctrl(103) = 0 ' IF slider(slnr+3).value <> So.ctrl(103) THEN ' SendMessage Slider(Slnr+3).h, %TBM_SETPOS,%True, So.ctrl(103) ' slider(slnr+3).value = So.ctrl(103) ' END IF ' So.ctrl(104) = 6 ' IF slider(slnr+4).value <> So.ctrl(104) THEN ' SendMessage Slider(Slnr+4).h, %TBM_SETPOS,%True, So.ctrl(104) ' slider(slnr+4).value = So.ctrl(104) ' END IF ' So.ctrl(105) = 3 '31 ' IF slider(slnr+5).value <> So.ctrl(105) THEN ' SendMessage Slider(Slnr+5).h, %TBM_SETPOS,%True, So.ctrl(105) ' slider(slnr+5).value = So.ctrl(105) ' END IF ' So.ctrl(106) = 28 ' IF slider(slnr+6).value <> So.ctrl(106) THEN ' SendMessage Slider(Slnr+6).h, %TBM_SETPOS,%True, So.ctrl(106) ' slider(slnr+6).value = So.ctrl(106) ' END IF ' So.ctrl(107) = 64 ' IF slider(slnr+7).value <> So.ctrl(107) THEN ' SendMessage Slider(Slnr+7).h, %TBM_SETPOS,%True, So.ctrl(107) ' slider(slnr+7).value = So.ctrl(107) ' END IF ' So.ctrl(108) = 12 '64 ' IF slider(slnr+8).value <> So.ctrl(108) THEN ' SendMessage Slider(Slnr+8).h, %TBM_SETPOS,%True, So.ctrl(108) ' slider(slnr+8).value = So.ctrl(108) ' END IF ' END IF ' RESET prog ' Task(%So_ProgChangeMed).tog = %True ' END IF ' ' IF slider(slnr).value <> So.ctrl(100) THEN ' Controller So.channel, 100, slider(slnr).value ' So.ctrl(100) = slider(slnr).value ' END IF ' ' IF slider(slnr+1).value <> So.ctrl(101) THEN ' Controller So.channel, 101, slider(slnr+1).value ' So.ctrl(101) = slider(slnr+1).value ' END IF ' IF slider(slnr+2).value <> So.ctrl(102) THEN ' Controller So.channel, 102, slider(slnr+2).value ' So.ctrl(102) =slider(slnr+2).value ' END IF ' IF slider(slnr+3).value <> So.ctrl(103) THEN ' Controller So.channel, 103, slider(slnr+3).value ' So.ctrl(103) =slider(slnr+3).value ' END IF ' IF slider(slnr+4).value <> So.ctrl(104) THEN ' Controller So.channel, 104, slider(slnr+4).value ' So.ctrl(104) = slider(slnr+4).value ' END IF ' IF slider(slnr+5).value <> So.ctrl(105) THEN ' Controller So.channel, 105, slider(slnr+5).value ' So.ctrl(105) = slider(slnr+5).value ' END IF ' IF slider(slnr+6).value <> So.ctrl(106) THEN ' Controller So.channel, 106, slider(slnr+6).value ' So.ctrl(106) =slider(slnr+6).value ' END IF ' IF slider(slnr+7).value <> So.ctrl(107) THEN ' Controller So.channel, 107, slider(slnr+7).value ' So.ctrl(107) =slider(slnr+7).value ' END IF ' IF slider(slnr+8).value <> So.ctrl(108) THEN ' Controller So.channel, 108, slider(slnr+8).value ' So.ctrl(108) = slider(slnr+8).value ' END IF ' IF UDctrl(udnr).value <> prog THEN ' prog = UDctrl(udnr).value ' IF BIT(prog,2) = 1 THEN ' BIT SET So_Prog,2 ' ELSE ' BIT RESET So_Prog,2 ' END IF ' IF BIT(prog,1) = 1 THEN ' BIT SET So_Prog,1 ' ELSE ' BIT RESET So_Prog,1 ' END IF ' IF BIT(prog,0) = 1 THEN ' BIT SET So_Prog,0 ' ELSE ' BIT RESET So_Prog,0 ' END IF ' ProgChange So.channel, So_prog ' END IF 'END SUB ' 'SUB So_ProgChangeMed_UD0 () ' ' callback on parameter UpDowns ' LOCAL value AS BYTE ' LOCAL udnr AS DWORD ' udnr = TaskEX(%So_ProgChangeMed).UpdownNumbers(0) ' value = UDCtrl(udnr).value ' IF value > 7 THEN UDctrl(udnr).value = 7 : value = 7 ' IF value < 0 THEN UDCTRL(udnr).value = 0 : value = 0 ' SetDlgItemText Task(%So_ProgChangeMed).hparam, %GMT_TEXT0_ID + 16, "p=" & STR$(value) 'END SUB ' 'SUB So_ProgChangeSub () ' ' 17.12.2016: test voor de program changes: different waveform lookup tables. ' ' 18.12.2016: sliders added voor de golfvormparameters 100-110 ' ' 27.01.2020: bug removed here: we forgot to send the prog.change itself after the parameters ' ' 28.01.2020: rewritten. ' ' 02.02.2020: now split in 3 procs. ' ' global So_Prog is the 7bit prg value. ' STATIC TaskParamLabels() AS ASCIIZ*8 ' STATIC udnr, slnr AS DWORD ' STATIC prog, oldprog AS INTEGER ' ' IF ISFALSE Task(%So_ProgChangeSub).tog THEN ' IF ISFALSE Task(%So_ProgChangeSub).hParam THEN ' DIM TaskParamLabels(3) ' TaskParamlabels(0)="c101" ' TaskParamlabels(1)="c107" ' TaskParamLabels(2)="p_sub" ' MakeTaskParameterDialog %So_ProgchangeSub,2, Slider(),1,UdCtrl(), TaskParamLabels() ' IF udnr = %False THEN ' udnr = TaskEX(%So_ProgChangeSub).UpDownNumbers(0) ' UDctrl(udnr).cptr = CODEPTR(So_ProgChangeSub_UD0) ' prog.nr. ' UDctrl(udnr).value = 0 ' UDctrl(udnr).minval = 0 ' UDctrl(udnr).maxval = 3 ' UDctrl(udnr).stap = 1 ' END IF ' IF ISFALSE slnr THEN ' slnr = TaskEX(%So_ProgChangeSub).Slidernumbers(0) ' END IF ' So.ctrl(101) = 64 ' IF slider(slnr).value <> So.ctrl(101) THEN ' SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, So.ctrl(101) ' slider(slnr).value = So.ctrl(101) ' END IF ' So.ctrl(107) = 64 ' IF slider(slnr+1).value <> So.ctrl(107) THEN ' SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, So.ctrl(107) ' slider(slnr+1).value = So.ctrl(107) ' END IF ' END IF ' RESET prog ' Task(%So_ProgChangeSub).tog = %True ' END IF ' ' IF slider(slnr).value <> So.ctrl(101) THEN ' Controller So.channel, 101, slider(slnr).value ' So.ctrl(101) = slider(slnr).value ' END IF ' ' ' IF slider(slnr+1).value <> So.ctrl(107) THEN ' Controller So.channel, 101, slider(slnr+1).value ' So.ctrl(107) =slider(slnr+1).value ' END IF ' ' IF UDctrl(udnr).value * 32 <> prog THEN ' prog = UDctrl(udnr).value * 32 ' IF BIT(prog,6) = 1 THEN ' BIT SET So_Prog,6 ' ELSE ' BIT RESET So_Prog,6 ' END IF ' IF BIT(prog,5) = 1 THEN ' BIT SET So_Prog,5 ' ELSE ' BIT RESET So_Prog,5 ' END IF ' ProgChange So.channel, So_prog ' END IF 'END SUB ' 'SUB So_ProgChangeSub_UD0 () ' ' callback on parameter UpDowns ' LOCAL value AS BYTE ' LOCAL udnr AS DWORD ' udnr = TaskEX(%So_ProgChangeSub).UpdownNumbers(0) ' value = UDCtrl(udnr).value ' IF value > 3 THEN UDctrl(udnr).value = 3 : value = 3 ' IF value < 0 THEN UDCTRL(udnr).value = 0 : value = 0 ' SetDlgItemText Task(%So_ProgChangeSub).hparam, %GMT_TEXT0_ID + 16, "p=" & STR$(value) 'END SUB ' 'SUB So_ProgChangeLow () ' ' 02.02.2020: now split in 3 procs. ' ' global So_Prog is the 7bit prg value. ' STATIC TaskParamLabels() AS ASCIIZ*8 ' STATIC udnr, slnr AS DWORD ' STATIC prog, oldprog AS INTEGER ' ' IF ISFALSE Task(%So_ProgChangeLow).tog THEN ' IF ISFALSE Task(%So_ProgChangeLow).hParam THEN ' DIM TaskParamLabels(4) ' TaskParamlabels(0)="c105" ' TaskParamlabels(1)="c102" ' p2 ' TaskParamlabels(2)="c108" ' p21 ' TaskParamlabels(3)="c109" ' TaskParamLabels(4)="p_low" ' MakeTaskParameterDialog %So_ProgchangeLow,4, Slider(),1,UdCtrl(), TaskParamLabels() ' IF udnr = %False THEN ' udnr = TaskEX(%So_ProgChangeLow).UpDownNumbers(0) ' UDctrl(udnr).cptr = CODEPTR(So_ProgChangeLow_UD0) ' prog.nr. ' UDctrl(udnr).value = 0 ' UDctrl(udnr).minval = 0 ' UDctrl(udnr).maxval = 3 ' UDctrl(udnr).stap = 1 ' END IF ' IF ISFALSE slnr THEN ' slnr = TaskEX(%So_ProgChangeLow).Slidernumbers(0) ' END IF ' So.ctrl(105) = 3 ' IF slider(slnr).value <> So.ctrl(105) THEN ' SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, So.ctrl(105) ' slider(slnr).value = So.ctrl(105) ' END IF ' So.ctrl(102) = 51 ' IF slider(slnr+1).value <> So.ctrl(102) THEN ' SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, So.ctrl(102) ' slider(slnr+1).value = So.ctrl(102) ' END IF ' So.ctrl(108) = 12 ' IF slider(slnr+2).value <> So.ctrl(108) THEN ' SendMessage Slider(Slnr+2).h, %TBM_SETPOS,%True, So.ctrl(108) ' slider(slnr+2).value = So.ctrl(108) ' END IF ' So.ctrl(109) = 84 ' IF slider(slnr+3).value <> So.ctrl(109) THEN ' SendMessage Slider(Slnr+3).h, %TBM_SETPOS,%True, So.ctrl(109) ' slider(slnr+3).value = So.ctrl(109) ' END IF ' END IF ' RESET prog ' Task(%So_ProgChangeLow).tog = %True ' END IF ' ' IF slider(slnr).value <> So.ctrl(105) THEN ' Controller So.channel, 105, slider(slnr).value ' So.ctrl(105) = slider(slnr).value ' END IF ' IF slider(slnr+1).value <> So.ctrl(102) THEN ' Controller So.channel, 102, slider(slnr+1).value ' So.ctrl(102) =slider(slnr+1).value ' END IF ' IF slider(slnr+2).value <> So.ctrl(108) THEN ' Controller So.channel, 108, slider(slnr+2).value ' So.ctrl(108) =slider(slnr+2).value ' END IF ' IF slider(slnr+3).value <> So.ctrl(109) THEN ' Controller So.channel, 109, slider(slnr+3).value ' So.ctrl(109) =slider(slnr+3).value ' END IF ' ' IF UDctrl(udnr).value * 8 <> prog THEN ' prog = UDctrl(udnr).value * 8 ' IF BIT(prog,4) = 1 THEN ' BIT SET So_Prog,4 ' ELSE ' BIT RESET So_Prog,4 ' END IF ' IF BIT(prog,3) = 1 THEN ' BIT SET So_Prog,3 ' ELSE ' BIT RESET So_Prog,3 ' END IF ' ProgChange So.channel, So_prog ' END IF 'END SUB ' 'SUB So_ProgChangeLow_UD0 () ' ' callback on parameter UpDowns ' LOCAL value AS BYTE ' LOCAL udnr AS DWORD ' udnr = TaskEX(%So_ProgChangeLow).UpdownNumbers(0) ' value = UDCtrl(udnr).value ' IF value > 3 THEN UDctrl(udnr).value = 3 : value = 3 ' IF value < 0 THEN UDCTRL(udnr).value = 0 : value = 0 ' SetDlgItemText Task(%So_ProgChangeLow).hparam, %GMT_TEXT0_ID + 16, "p=" & STR$(value) 'END SUB SUB So_Wave () DIM Wav8 (511) AS STATIC WORD WaveFile2PicLookup "c:\b\pb\gmt\robots\so\tuba4p_2.wav", Wav8(), 4, "C:\b\pb\gmt\robots\so\tuba4p_2.inc" Stoptask %so_wave END SUB SUB So_Waves () ' for batch processing on 9 sample files, 4 periods ' files prepared by Lara 16.03.2020 ' DIM Wav(511) AS STATIC WORD ' WaveFile2PicLookup "c:\b\pb\gmt\robots\so\So_B2_cuivre_4p_01.wav", Wav(), 4, "C:\b\pb\gmt\robots\so\So_35_cuivre.inc" ' WaveFile2PicLookup "c:\b\pb\gmt\robots\so\So_B3_f_4p_01.wav", Wav(), 4, "C:\b\pb\gmt\robots\so\So_47_f.inc" ' WaveFile2PicLookup "c:\b\pb\gmt\robots\so\So_C2_p_4p_01.wav", Wav(), 4, "C:\b\pb\gmt\robots\so\So_24_p.inc" ' WaveFile2PicLookup "c:\b\pb\gmt\robots\so\So_C4_f_4p_01.wav", Wav(), 4, "C:\b\pb\gmt\robots\so\So_48_f.inc" ' WaveFile2PicLookup "c:\b\pb\gmt\robots\so\So_F4_mf_4p_01.wav", Wav(), 4, "C:\b\pb\gmt\robots\so\So_53_mf.inc" ' WaveFile2PicLookup "c:\b\pb\gmt\robots\so\So_Fis3_mf_4p_01.wav", Wav(), 4, "C:\b\pb\gmt\robots\so\So_42_mf.inc" ' WaveFile2PicLookup "c:\b\pb\gmt\robots\so\So_G3_f_4p_02.wav", Wav(), 4, "C:\b\pb\gmt\robots\so\So_43_f.inc" ' WaveFile2PicLookup "c:\b\pb\gmt\robots\so\So_Gis3_mf_4p_01.wav", Wav(), 4, "C:\b\pb\gmt\robots\so\So_44_mf.inc" ' second batch: 17.03.2020 ' dim Wav(1023)as static word ' WaveFile2PicLookup "c:\b\pb\gmt\robots\so\So_B3_f_8p_01.wav", Wav(), 8, "C:\b\pb\gmt\robots\so\So_47_f_8.inc" ' WaveFile2PicLookup "c:\b\pb\gmt\robots\so\So_B2_f_8p_01.wav", Wav(), 8, "C:\b\pb\gmt\robots\so\So_35_f_8.inc" ' ok ' WaveFile2PicLookup "c:\b\pb\gmt\robots\so\So_G4_f_8p_01.wav", Wav(), 8, "C:\b\pb\gmt\robots\so\So_55_f_8.inc" ' WaveFile2PicLookup "c:\b\pb\gmt\robots\so\So_Gis3_mf_8p_01.wav", Wav(), 8, "C:\b\pb\gmt\robots\so\So_44_mf_8.inc" ' Dim Wav8(511) as static word ' So_Wave8 Wav8() ' new file 20.03.2020 - Lara: DIM Wav2(511) AS STATIC WORD WaveFile2PicLookup "c:\b\pb\gmt\robots\so\So_C3_f_4p.wav", Wav2(), 4, "C:\b\pb\gmt\robots\so\So_36_f_4.inc" DIM Wav202(511) AS STATIC WORD WaveFile2PicLookup "c:\b\pb\gmt\robots\so\So_C3_f_4p_response.wav", Wav202(), 4, "C:\b\pb\gmt\robots\so\So_36_f_4_out.inc" logfile "Outputfile So_36_f_4_out.inc created" ' and now, we calculate the excitation wave: - tmp wave0 DIM ExWav203() AS STATIC WORD ExcitationWave wav2(), Wav202(), ExWav203(),"C:\b\pb\gmt\robots\so\wave4_36_excit.inc" 'ok logfile "Excitationfile wave4_36_excit.inc created" Stoptask %so_waves END SUB 'SUB So_Wave () '' local fn as asciiz ' ' 06.03.2020: Changed for 4-period format sample waves. ' ' 06.03.2020: Replaced with a call to the general dunction above, in mrobots.inc ' LOCAL i AS LONG ' LOCAL h AS SINGLE ' LOCAL v AS INTEGER ' LOCAL j, k AS INTEGER ' LOCAL hstep AS INTEGER ' LOCAL minval, maxval, absval, normcoef AS SINGLE ' ' ' should read a sample wave file and convert to 256 sized array ' ' for 4-period samples the array must be sized 512 ' ' to use as a lookup for the PIC. ' STATIC samp() AS INTEGER ' STATIC nsamp() AS SINGLE ' IF ISFALSE gh.spec THEN ' MakeSpectrumWindow ' should fill gh.spec. new, make window to display waveforms... ' END IF ' 'WaveFileToArray ("c:\b\pb\gmt\robots\so\TUBA_LOUD_E3_16b.wav", samp()) 'resizes samp! make sure to check dimension and,if used, pointer again after calling this function ' 'WaveFileToArray ("c:\b\pb\gmt\robots\so\tuba_4p_44100_16.wav", samp()) ' 06.03.2020 ' 'WaveFileToArray ("c:\b\pb\gmt\robots\so\tuba_4p_8000_16bit.wav", samp()) ' wrong file ' WaveFileToArray ("c:\b\pb\gmt\robots\so\tuba4p_2.wav", samp()) ' REDIM nsamp(UBOUND(samp())) ' FOR i = 0 TO UBOUND(samp) ' nsamp(i) = samp(i) / 32768 ' is the data bipolar? YES! ' ' nsamp(i) = (samp(i) - 32768 ) / 32768 ' -1 to + 1 in case word. ' logfile STR$(samp(i)) ' NEXT ' '' Shownormarray gh.spec, nsamp() ' ' now let's normalize the wave: ' minval = 1 ' maxval = -1 ' FOR i = 0 TO UBOUND (nsamp()) ' IF nsamp(i) > maxval THEN maxval = nsamp(i) ' IF nsamp(i) < minval THEN minval = nsamp(i) ' NEXT i ' absval = maxval ' IF absval < ABS(minval) THEN absval = ABS(minval) ' ' now we have the maximum amplitude in absval. in should be a value between -1 and +1 ' normcoef = 1! / absval ' ' now perform the normalisation to -1 --> + 1: ' FOR i = 0 TO UBOUND (nsamp()) ' nsamp(i) = nsamp(i) * normcoef ' NEXT i ' ' display it: ' ' Shownormarray gh.spec, nsamp() ' ' ' now convert to the format we need in the PIC firmware: ' ' horizontal compression: UBOUND(samp) / 256 ' ' vertical rescale to 0 - 2047 ' ' hstep = UBOUND(samp) / 512 '256 ' =2 ' 'DIM Wav(255) AS INTEGER ' dim Wav(511) as integer ' h = nsamp(0) ' FOR i = 0 TO UBOUND(nsamp()) ' j = i MOD hstep ' IF j = 0 THEN ' h = h / hstep ' average ' Wav(k) = (h * 1024.0) + 1023.0 ' IF Wav(k) < 0 THEN Wav(k) = 0 ' IF Wav(k) > 2047 THEN Wav(k) = 2047 ' h = 0 ' INCR k ' ELSE ' h = h + (nsamp(i)*2) ' samp() * 2 if nsamp runs -0.5 to + 0.5 !!! ' END IF ' NEXT i ' ' rescale to -0.5 --> +0.5 for Shownormarray: ' FOR i = 0 TO UBOUND(nsamp) ' nsamp(i) = nsamp(i) * 0.5 ' NEXT i ' ' display it: ' Shownormarray gh.spec, nsamp() ' ' 'write the Wav to a formatted file for the firmware... ' OPEN "So_Wave_lookup.inc" FOR OUTPUT AS #1 ' PRINT#1, "So_Wave8:" ' print#1, " ' based on sample file tuba4p_2.wav " ' print#1, " ' 4-periods - 512 words " ' print#1, " ' " & Date$ ' FOR i = 0 TO UBOUND(wav) ' PRINT#1, "Wave8[";TRIM$(STR$(i));"] = "; TRIM$(STR$(Wav(i))) ' NEXT i ' PRINT#1, "Return" ' CLOSE #1 ' ' Stoptask %so_wave ' 'END SUB 'SUB So_Wave7 (BYREF wav7() AS WORD) ' ' removed from pic ' WaveFile2PicLookup "c:\b\pb\gmt\robots\so\TUBA_LOUD_E3_16b.wav", Wav7(), 2, "C:\b\pb\gmt\robots\so\Tuba_Loud_2p.inc" 'END SUB SUB So_Wave8 (BYREF wav8() AS WORD) ' note: Wave8 became Wave7 in the firmware for the pic (19.03.2020) WaveFile2PicLookup "c:\b\pb\gmt\robots\so\tuba4p_2.wav", Wav8(), 4, "C:\b\pb\gmt\robots\so\tuba4p_2.inc" ' 19.03.2020: now that we have the output file, we can calculate excitation waves: ' first we convert the output file: DIM Wav801(511) AS STATIC WORD WaveFile2PicLookup "c:\b\pb\gmt\robots\so\So_C2_retake_wave8.wav", Wav801(), 4, "C:\b\pb\gmt\robots\so\tuba4p_out24.inc" logfile "Outputfile tuba4p_out24.inc created" ' ok ' and now, we calculate the excitation wave: - tmp wave1 DIM ExWav801() AS STATIC WORD ExcitationWave wav8(), Wav801(), ExWav801(),"C:\b\pb\gmt\robots\so\wave8_noot24_excit.inc" 'ok logfile "Excitationfile wave8_noot24_excit.inc created" DIM Wav803(511) AS STATIC WORD WaveFile2PicLookup "c:\b\pb\gmt\robots\so\So_F3_retake_wave8.wav", Wav803(), 4, "C:\b\pb\gmt\robots\so\tuba4p_out51.inc" logfile "Outputfile tuba4p_out51.inc created" ' and now, we calculate the excitation wave: - tmp wave0 DIM ExWav803() AS STATIC WORD ExcitationWave wav8(), Wav803(), ExWav803(),"C:\b\pb\gmt\robots\so\wave8_noot51_excit.inc" 'ok logfile "Excitationfile wave8_noot51_excit.inc created" DIM Wav802(511) AS STATIC WORD WaveFile2PicLookup "c:\b\pb\gmt\robots\so\So_G2_retake_wave8.wav", Wav802(), 4, "C:\b\pb\gmt\robots\so\tuba4p_out31.inc" logfile "Outputfile tuba4p_out31.inc created" ' and now, we calculate the excitation wave: - tmp wave0 DIM ExWav802() AS STATIC WORD ExcitationWave wav8(), Wav802(), ExWav802(),"C:\b\pb\gmt\robots\so\wave8_noot31_excit.inc" 'ok logfile "Excitationfile wave8_noot31_excit.inc created" END SUB 'SUB So_Wave8 (wav8() AS WORD) ' ' adapted to 4-period wave sample 06.03.2020 ' LOCAL i AS LONG ' LOCAL h AS SINGLE ' LOCAL v AS INTEGER ' LOCAL j, k AS INTEGER ' LOCAL hstep AS INTEGER ' LOCAL minval, maxval, absval, normcoef AS SINGLE ' 'DIM Wav(255) AS INTEGER ' dim Wav(511) as integer ' ' ' should read a sample wave file and convert to 256 sized array ' ' to use as a lookup for the PIC. ' STATIC samp() AS INTEGER ' STATIC nsamp() AS SINGLE ' ' IF ISFALSE gh.spec THEN ' ' MakeSpectrumWindow ' should fill gh.spec. new, make window to display waveforms... ' ' END IF ' ' WaveFileToArray ("c:\b\pb\gmt\robots\so\TUBA_LOUD_E3_16b.wav", samp()) 'resizes samp! make sure to check dimension and,if used, pointer again after calling this function ' 'WaveFileToArray ("c:\b\pb\gmt\robots\so\tuba_4p_44100_16.wav", samp()) ' gives wrong data... ' ' WaveFileToArray ("c:\b\pb\gmt\robots\so\tuba_4p_8000_16bit.wav", samp()) ' WaveFileToArray ("c:\b\pb\gmt\robots\so\tuba4p_2.wav", samp()) ' REDIM nsamp(UBOUND(samp())) ' FOR i = 0 TO UBOUND(samp) ' nsamp(i) = samp(i) / 32768 ' is the data bipolar? ' NEXT ' ' now let's normalize the wave: ' minval = 1 ' maxval = -1 ' FOR i = 0 TO UBOUND (nsamp()) ' IF nsamp(i) > maxval THEN maxval = nsamp(i) ' IF nsamp(i) < minval THEN minval = nsamp(i) ' NEXT i ' absval = maxval ' IF absval < ABS(minval) THEN absval = ABS(minval) ' ' now we have the maximum amplitude in absval. it should be a value between -1 and +1 ' normcoef = 1! / absval ' ' now perform the normalisation to -1 --> + 1: ' FOR i = 0 TO UBOUND (nsamp()) ' nsamp(i) = nsamp(i) * normcoef ' NEXT i ' ' now convert to the format we need in the PIC firmware: ' ' horizontal compression: UBOUND(samp) / 512 '256 ' ' vertical rescale to 0 - 2047 ' ' hstep = UBOUND(samp) / 512 ' 256 ' =2 ' ' h = nsamp(0) ' FOR i = 0 TO UBOUND(nsamp()) ' j = i MOD hstep ' IF j = 0 THEN ' h = h / hstep ' average ' Wav(k) = (h * 1024.0) + 1023.0 ' IF Wav(k) < 0 THEN Wav(k) = 0 ' IF Wav(k) > 2047 THEN Wav(k) = 2047 ' h = 0 ' INCR k ' ELSE ' h = h + (nsamp(i)*2) ' samp() * 2 if nsamp runs -0.5 to + 0.5 !!! ' END IF ' NEXT i ' ' output as word array: ' FOR i = 0 TO UBOUND(Wav) ' Wav8(i) = Wav(i) ' NEXT i 'END SUB SUB So_CC40 () ' sets waveform for the sub register STATIC TaskParamLabels() AS ASCIIZ*8 STATIC udnr , prog AS DWORD IF ISFALSE Task(%So_CC40).tog THEN IF ISFALSE Task(%So_CC40).hParam THEN DIM TaskParamLabels(0) MakeTaskParameterDialog %So_CC40,0, Slider(),1,UdCtrl(), TaskParamLabels() IF udnr = %False THEN udnr = TaskEX(%So_CC40).UpDownNumbers(0) UDctrl(udnr).cptr = CODEPTR(So_CC40_UD0) ' prog.nr. UDctrl(udnr).value = 0 UDctrl(udnr).minval = 0 UDctrl(udnr).maxval = 7 UDctrl(udnr).stap = 1 END IF RESET prog END IF Task(%So_CC40).tog = %True END IF IF UDctrl(udnr).value <> prog THEN prog = UDctrl(udnr).value Controller So.channel, 40, prog END IF END SUB SUB So_CC40_UD0 () ' callback on parameter UpDowns LOCAL value AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%So_CC40).UpdownNumbers(0) value = UDCtrl(udnr).value IF value > 7 THEN UDctrl(udnr).value = 7 : value = 7 IF value < 0 THEN UDCTRL(udnr).value = 0 : value = 0 SetDlgItemText Task(%So_CC40).hparam, %GMT_TEXT0_ID + 16, "p=" & STR$(value) END SUB SUB So_CC41 () ' sets waveform for the low register STATIC TaskParamLabels() AS ASCIIZ*8 STATIC udnr , prog AS DWORD IF ISFALSE Task(%So_CC41).tog THEN IF ISFALSE Task(%So_CC41).hParam THEN DIM TaskParamLabels(0) MakeTaskParameterDialog %So_CC41,0, Slider(),1,UdCtrl(), TaskParamLabels() IF udnr = %False THEN udnr = TaskEX(%So_CC41).UpDownNumbers(0) UDctrl(udnr).cptr = CODEPTR(So_CC41_UD0) ' prog.nr. UDctrl(udnr).value = 0 UDctrl(udnr).minval = 0 UDctrl(udnr).maxval = 7 UDctrl(udnr).stap = 1 END IF RESET prog END IF Task(%So_CC41).tog = %True END IF IF UDctrl(udnr).value <> prog THEN prog = UDctrl(udnr).value Controller So.channel, 41, prog END IF END SUB SUB So_CC41_UD0 () ' callback on parameter UpDowns LOCAL value AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%So_CC41).UpdownNumbers(0) value = UDCtrl(udnr).value IF value > 7 THEN UDctrl(udnr).value = 7 : value = 7 IF value < 0 THEN UDCTRL(udnr).value = 0 : value = 0 SetDlgItemText Task(%So_CC41).hparam, %GMT_TEXT0_ID + 16, "p=" & STR$(value) END SUB SUB So_CC42 () ' sets waveform for the med register STATIC TaskParamLabels() AS ASCIIZ*8 STATIC udnr , prog AS DWORD IF ISFALSE Task(%So_CC42).tog THEN IF ISFALSE Task(%So_CC42).hParam THEN DIM TaskParamLabels(0) MakeTaskParameterDialog %So_CC42,0, Slider(),1,UdCtrl(), TaskParamLabels() IF udnr = %False THEN udnr = TaskEX(%So_CC42).UpDownNumbers(0) UDctrl(udnr).cptr = CODEPTR(So_CC42_UD0) ' prog.nr. UDctrl(udnr).value = 0 UDctrl(udnr).minval = 0 UDctrl(udnr).maxval = 7 UDctrl(udnr).stap = 1 END IF RESET prog END IF Task(%So_CC42).tog = %True END IF IF UDctrl(udnr).value <> prog THEN prog = UDctrl(udnr).value Controller So.channel, 42, prog END IF END SUB SUB So_CC42_UD0 () ' callback on parameter UpDowns LOCAL value AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%So_CC42).UpdownNumbers(0) value = UDCtrl(udnr).value IF value > 7 THEN UDctrl(udnr).value = 7 : value = 7 IF value < 0 THEN UDCTRL(udnr).value = 0 : value = 0 SetDlgItemText Task(%So_CC42).hparam, %GMT_TEXT0_ID + 16, "p=" & STR$(value) END SUB SUB So_CC43 () ' sets waveform for the high register STATIC TaskParamLabels() AS ASCIIZ*8 STATIC udnr , prog AS DWORD IF ISFALSE Task(%So_CC43).tog THEN IF ISFALSE Task(%So_CC43).hParam THEN DIM TaskParamLabels(0) MakeTaskParameterDialog %So_CC43,0, Slider(),1,UdCtrl(), TaskParamLabels() IF udnr = %False THEN udnr = TaskEX(%So_CC43).UpDownNumbers(0) UDctrl(udnr).cptr = CODEPTR(So_CC43_UD0) ' prog.nr. UDctrl(udnr).value = 0 UDctrl(udnr).minval = 0 UDctrl(udnr).maxval = 7 UDctrl(udnr).stap = 1 END IF RESET prog END IF Task(%So_CC43).tog = %True END IF IF UDctrl(udnr).value <> prog THEN prog = UDctrl(udnr).value Controller So.channel, 43, prog END IF END SUB SUB So_CC43_UD0 () ' callback on parameter UpDowns LOCAL value AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%So_CC43).UpdownNumbers(0) value = UDCtrl(udnr).value IF value > 7 THEN UDctrl(udnr).value = 7 : value = 7 IF value < 0 THEN UDCTRL(udnr).value = 0 : value = 0 SetDlgItemText Task(%So_CC43).hparam, %GMT_TEXT0_ID + 16, "p=" & STR$(value) END SUB '[EOF]