'******************************************** '* < TUBO > * '* musical robot by dr.Godfried-Willem Raes * '* 2019 * '* User interface test code * '******************************************** '20.09.2019: start coding. '24.09.2019: parser on hub should be working now. '30.09.2019: 3 boards up and running... '24.10.2019: test code for vibrato motors added '25.11.2019: test code to determine the velo-scalings added. ' beater 6691 board up and running. '27.11.2019: Tubo_note_test added: individual note+velo on followed by noteoff with release. '29.11.2019: light tests added. '01.12.2019: Note test added in multiples, to compare scalings. '04.12.2019: Bug killed in the test code for the vibrato motors. '07.12.2019: Test added for note-on and note-off using noteon+velo=0, with cc25 damping. '14-15.12.2019: Further work on the demo piece for : 'Eindjes' %Tubo_Scale_Test = 48 %Tubo_Dyna_Test = 49 %Tubo_Damp_Test = 50 %Tubo_Note1_Test = 51 %Tubo_Note2_Test = 52 ' for comparisson of 2 notes %Tubo_Note3_Test = 53 ' for comparisson of 3 notes %Tubo_Note4_Test = 54 ' compare 4 notes %Tubo_Noton_Test = 55 %Tubo_Ctrl_Test = 60 %Tubo_120 = 17 %Tubo_121 = 18 %Tubo_122 = 19 %Tubo_123 = 20 %Tubo_124 = 21 %Tubo_125 = 22 %Tubo_126 = 23 %Tubo_Lites = 24 %Tubo_White = 25 %Tubo_Blue = 26 %Tubo_Harm = 28 %Tubo_HarSol = 29 'individual board tests: %Tubo_4865_Beat = 32 %Tubo_4865_Damp = 33 %Tubo_6691_Beat = 34 %Tubo_6691_Damp = 35 %Tubo_Vib4865 = 36 %Tubo_Vib6691 = 37 DECLARE FUNCTION Init_Tubo () AS LONG DECLARE SUB Tubo_Scale_Test () ' full scale DECLARE SUB Tubo_Dyna_Test () ' without note-off's DECLARE SUB Tubo_Damp_Test () ' using nothing but note-off + release commands DECLARE SUB Tubo_Note1_Test () DECLARE SUB Tubo_Note2_Test () DECLARE SUB Tubo_Note3_Test () DECLARE SUB Tubo_Note4_Test () DECLARE SUB Tubo_Noton_Test () DECLARE SUB Tubo_Lites () DECLARE SUB Tubo_Lites_Off () DECLARE SUB Tubo_White () DECLARE SUB Tubo_Blue () DECLARE SUB Tubo_Ctrl_Test () ' dempers DECLARE SUB Tubo_4865_Beat () DECLARE SUB Tubo_4865_Damp () DECLARE SUB Tubo_6691_Beat () DECLARE SUB Tubo_6691_Damp () DECLARE SUB Tubo_Vib4865 () DECLARE SUB Tubo_Vib6691 () FUNCTION Init_Tubo () AS LONG LOCAL m AS ASCIIZ * 40 LOCAL i AS DWORD LOCAL j AS LONG LOCAL retval AS LONG LOCAL pmask AS QUAD PTR CONTROL SET TEXT gh.Cockpit,0, " test code 2019 " IF ISFALSE hMidiI(0) THEN ButnSw(0).tag0 = "" ButnSw(0).cptr = %False END IF ButnSW(2).tag0 = "Pow On" ButnSW(2).tag1 = "Pow Off" ButnSW(2).cptr = CODEPTR(Tubo_Power) ButnSW(3).tag0 = "" ButnSW(4).tag0 = "" ' harm ButnSW(5).tag0 = "" ' melo ButnSW(6).tag0 = "" ' psy ButnSW(7).tag0 = "" ' spec ButnSW(8).tag0 = "" ButnSW(9).tag0 = "" ButnSW(10).tag0 = "" ButnSW(11).tag0 = "" ButnOs(2).tag="PrgChng" ButnOs(2).cptr = CODEPTR(MM_ProgchangeWindow) ButnOS(5).tag = "" ButnOS(6).tag = "" CONTROL SET TEXT gh.cockpit, %GMT_TITLE, " CONTROL SET TEXT gh.cockpit, %GMT_AUTHOR, $gwr Task(%Tubo_Scale_Test).naam = "Scale" Task(%Tubo_Scale_Test).cptr = CODEPTR(Tubo_Scale_Test) Task(%Tubo_Scale_Test).freq = 4 Task(%Tubo_Scale_Test).flags = %False Task(%Tubo_Dyna_Test).naam = "Dyna" Task(%Tubo_Dyna_Test).cptr = CODEPTR(Tubo_Dyna_Test) Task(%Tubo_Dyna_Test).freq = 4 Task(%Tubo_Dyna_Test).flags = %False Task(%Tubo_Damp_Test).naam = "Damp" Task(%Tubo_Damp_Test).cptr = CODEPTR(Tubo_Damp_Test) Task(%Tubo_Damp_Test).freq = 2 Task(%Tubo_Damp_Test).flags = %False Task(%Tubo_Note1_Test).naam = "Notes1" Task(%Tubo_Note1_Test).cptr = CODEPTR(Tubo_Note1_Test) Task(%Tubo_Note1_Test).freq = 2 Task(%Tubo_Note1_Test).flags = %False Task(%Tubo_Note2_Test).naam = "Notes2" Task(%Tubo_Note2_Test).cptr = CODEPTR(Tubo_Note2_Test) Task(%Tubo_Note2_Test).freq = 2 Task(%Tubo_Note2_Test).flags = %False Task(%Tubo_Note3_Test).naam = "Notes3" Task(%Tubo_Note3_Test).cptr = CODEPTR(Tubo_Note3_Test) Task(%Tubo_Note3_Test).freq = 2 Task(%Tubo_Note3_Test).flags = %False Task(%Tubo_Note4_Test).naam = "Notes4" Task(%Tubo_Note4_Test).cptr = CODEPTR(Tubo_Note4_Test) Task(%Tubo_Note4_Test).freq = 2 Task(%Tubo_Note4_Test).flags = %False Task(%Tubo_Noton_Test).naam = "NotOn" Task(%Tubo_Noton_Test).cptr = CODEPTR(Tubo_Noton_Test) Task(%Tubo_Noton_Test).freq = 2 Task(%Tubo_Noton_Test).flags = %False Task(%Tubo_Ctrl_Test).naam = "Ctrl" Task(%Tubo_Ctrl_Test).cptr = CODEPTR(Tubo_Ctrl_Test) Task(%Tubo_Ctrl_Test).freq = 4 Task(%Tubo_Ctrl_Test).flags = %False Task(%Tubo_4865_beat).naam = "4865beat" Task(%Tubo_4865_beat).cptr = CODEPTR(Tubo_4865_beat) Task(%Tubo_4865_beat).freq = 2 Task(%Tubo_4865_beat).flags = %False Task(%Tubo_4865_damp).naam = "4865damp" Task(%Tubo_4865_damp).cptr = CODEPTR(Tubo_4865_damp) Task(%Tubo_4865_damp).freq = 2 Task(%Tubo_4865_damp).flags = %False Task(%Tubo_6691_beat).naam = "6691beat" Task(%Tubo_6691_beat).cptr = CODEPTR(Tubo_6691_beat) Task(%Tubo_6691_beat).freq = 2 Task(%Tubo_6691_beat).flags = %False Task(%Tubo_6691_damp).naam = "6691damp" Task(%Tubo_6691_damp).cptr = CODEPTR(Tubo_6691_damp) Task(%Tubo_6691_damp).freq = 2 Task(%Tubo_6691_damp).flags = %False Task(%Tubo_lites).naam = "Lights" Task(%Tubo_lites).cptr = CODEPTR(Tubo_lites) Task(%Tubo_lites).freq = 4 Task(%Tubo_lites).flags = %False Taskex(%Tubo_lites).stopcptr = CODEPTR(Tubo_lites_off) Task(%Tubo_Vib4865).naam = "Vib4865" Task(%Tubo_Vib4865).cptr = CODEPTR(Tubo_Vib4865) Task(%Tubo_Vib4865).freq = 2 Task(%Tubo_Vib4865).flags = %False Task(%Tubo_Vib6691).naam = "Vib6691" Task(%Tubo_Vib6691).cptr = CODEPTR(Tubo_Vib6691) Task(%Tubo_Vib6691).freq = 2 Task(%Tubo_Vib6691).flags = %False ' Task(%Tubo_Yellow).naam = "Yellow" ' Task(%Tubo_Yellow).cptr = CODEPTR(Tubo_Yellow) ' Task(%Tubo_Yellow).freq = 1 ' Task(%Tubo_Yellow).flags = %False ' Taskex(%Tubo_Yellow).stopcptr = CODEPTR(Tubo_Yellow_off) ' Task(%Tubo_White).naam = "White" Task(%Tubo_White).cptr = CODEPTR(Tubo_White) Task(%Tubo_White).freq = 1 Task(%Tubo_White).flags = %False Taskex(%Tubo_White).stopcptr = CODEPTR(Tubo_White_off) Task(%Tubo_Blue).naam = "Blue" Task(%Tubo_Blue).cptr = CODEPTR(Tubo_Blue) Task(%Tubo_Blue).freq = 1 Task(%Tubo_Blue).flags = %False Taskex(%Tubo_Blue).stopcptr = CODEPTR(Tubo_Blue_off) Task(%Tubo_120).naam = "L120" Task(%Tubo_120).cptr = CODEPTR(Tubo_120) Task(%Tubo_120).freq = 1 Task(%Tubo_120).flags = %False Taskex(%Tubo_120).stopcptr = CODEPTR(Tubo_120_off) Task(%Tubo_121).naam = "L121" Task(%Tubo_121).cptr = CODEPTR(Tubo_121) Task(%Tubo_121).freq = 1 Task(%Tubo_121).flags = %False Taskex(%Tubo_121).stopcptr = CODEPTR(Tubo_121_off) Task(%Tubo_122).naam = "L122" Task(%Tubo_122).cptr = CODEPTR(Tubo_122) Task(%Tubo_122).freq = 1 Task(%Tubo_122).flags = %False Taskex(%Tubo_122).stopcptr = CODEPTR(Tubo_122_off) Task(%Tubo_123).naam = "L123" Task(%Tubo_123).cptr = CODEPTR(Tubo_123) Task(%Tubo_123).freq = 1 Task(%Tubo_123).flags = %False Taskex(%Tubo_123).stopcptr = CODEPTR(Tubo_123_off) Task(%Tubo_124).naam = "L124" Task(%Tubo_124).cptr = CODEPTR(Tubo_124) Task(%Tubo_124).freq = 1 Task(%Tubo_124).flags = %False Taskex(%Tubo_124).stopcptr = CODEPTR(Tubo_124_off) Task(%Tubo_125).naam = "L125" Task(%Tubo_125).cptr = CODEPTR(Tubo_125) Task(%Tubo_125).freq = 1 Task(%Tubo_125).flags = %False Taskex(%Tubo_125).stopcptr = CODEPTR(Tubo_125_off) Task(%Tubo_126).naam = "L126" Task(%Tubo_126).cptr = CODEPTR(Tubo_126) Task(%Tubo_126).freq = 1 Task(%Tubo_126).flags = %False Taskex(%Tubo_126).stopcptr = CODEPTR(Tubo_126_off) ' ' Task(%Tubo_Piece).naam = "Piece" ' Task(%Tubo_Piece).cptr = CODEPTR(Tubo_Piece) ' Task(%Tubo_Piece).freq = 0.2 ' Task(%Tubo_Piece).flags = %False ' Taskex(%Tubo_Piece).stopcptr = CODEPTR(MM_Tubo_off) ' Task(%Tubo_Harm).cptr = CODEPTR(Tubo_Harm) Task(%Tubo_Harm).naam = "TuboHarm" Task(%Tubo_Harm).freq = 1 Task(%Tubo_Harm).level = 96 Task(%Tubo_Harm).tempo = 240 ' Task(%Tubo_Harm).pan = 64 Task(%Tubo_Harm).flags = %MIDI_TASK OR %HARM_TASK TaskEX(%Tubo_Harm).StopCptr = CODEPTR(Tubo_Harm_Off) Task(%Tubo_HarSol).cptr = CODEPTR(Tubo_HarSol) Task(%Tubo_HarSol).naam = "HarSol" Task(%Tubo_HarSol).freq = 1 Task(%Tubo_HarSol).level = 96 Task(%Tubo_HarSol).tempo = 240 ' Task(%Tubo_HarSol).pan = 64 Task(%Tubo_HarSol).flags = %MIDI_TASK OR %HARM_TASK ' TaskEX(%Tubo_HarSol).StopCptr = CODEPTR(Tubo_Harm_Off) TaskEx(%Tubo_Harsol).StopCptr = CODEPTR(Tubo_Harsol_Stop) FUNCTION = %true END FUNCTION SUB Tubo_Power () ' buttonswitch handler IF ISFALSE ButnSW(2).flag THEN Tubo.ctrl(66) = %False Controller Tubo.channel, 66, Tubo.ctrl(66) ELSE Tubo.ctrl(66) = %True Controller Tubo.channel, 66, Tubo.ctrl(66) END IF END SUB SUB Tubo_Scale_test () ' test note on/off with dampers. ' full scale. STATIC note, oldnote AS INTEGER STATIC cnt AS LONG LOCAL velo AS DWORD STATIC slnr() AS INTEGER IF ISFALSE Task(%Tubo_Scale_Test).tog THEN note = Tubo.lowtes ' create sliders: DIM Slnr(0 TO 2) AS STATIC INTEGER DIM TaskParamLabels(0 TO 2) AS STATIC ASCIIZ*8 TaskParamLabels(0)="Velo" ' attack force for beaters TaskParamLabels(1)="Freq" ' speed TaskParamLabels(2)="Demp" ' damping time for release IF ISFALSE Task(%Tubo_Scale_Test).hParam THEN MakeTaskParameterDialog BYVAL %Tubo_Scale_Test,3, Slider(),0,UdCtrl(), TaskParamLabels() END IF slnr(0) = TaskEX(%Tubo_Scale_Test).SliderNumbers(0) slnr(1) = TaskEX(%Tubo_Scale_Test).SliderNumbers(1) slnr(2) = TaskEX(%Tubo_Scale_Test).SliderNumbers(2) Slider(Slnr(0)).value = 16 Slider(Slnr(1)).value = 4 Slider(Slnr(2)).value = 64 SendMessage Slider(Slnr(0)).h, %TBM_SETPOS,%True, Slider(Slnr(0)).value SendMessage Slider(Slnr(1)).h, %TBM_SETPOS,%True, Slider(Slnr(1)).value SendMessage Slider(Slnr(2)).h, %TBM_SETPOS,%True, Slider(Slnr(2)).value Task(%Tubo_Scale_Test).tog = %True END IF IF cnt = 0 THEN velo = Slider(Slnr(0)).value IF velo THEN CONTROL SET TEXT gh.cockpit,%GMT_MSG1, STR$(note) mPlay Tubo.channel, note, velo oldnote = note INCR note IF note > Tubo.hightes THEN note = Tubo.lowtes ELSE IF oldnote THEN Release Tubo.channel, oldnote, Slider(Slnr(2)).value oldnote = %False END IF END IF ELSE IF oldnote THEN Release Tubo.channel, oldnote, Slider(Slnr(2)).value oldnote = %False END IF END IF INCR cnt cnt = cnt MOD 2 Task(%Tubo_Scale_Test).freq = MAX(.5, Slider(Slnr(1)).value / 2!) END SUB SUB Tubo_Dyna_Test () ' this proc. does not send any note-off's ' test for the beater-pic's, to check the velocity scaling in the firmware. STATIC note AS INTEGER LOCAL velo AS DWORD STATIC slnr() AS INTEGER STATIC ud AS INTEGER STATIC init AS LONG IF ISFALSE init THEN init = 1 ' create sliders: DIM Slnr(0 TO 1) AS STATIC INTEGER DIM TaskParamLabels(0 TO 2) AS STATIC ASCIIZ*8 TaskParamLabels(0)="Velo" ' attack force for beaters TaskParamLabels(1)="Freq" ' speed TaskParamLabels(2)="Note" ' up down for the note IF Task(%Tubo_Dyna_Test).hParam = %Null THEN MakeTaskParameterDialog BYVAL %Tubo_Dyna_Test,2, Slider(),1,UdCtrl(), TaskParamLabels() END IF slnr(0) = TaskEX(%Tubo_Dyna_Test).SliderNumbers(0) slnr(1) = TaskEX(%Tubo_Dyna_Test).SliderNumbers(1) ud = TaskEX(%Tubo_Dyna_Test).UpDownNumbers(0) Slider(Slnr(0)).value = 1 Slider(Slnr(1)).value = 4 UdCtrl(ud).value = Tubo.lowtes UdCtrl(ud).minval = Tubo.lowtes UdCtrl(ud).maxval = Tubo.hightes UdCtrl(ud).resetval = Tubo.lowtes UdCtrl(ud).stap = 1 UDctrl(ud).cptr = CODEPTR(Tubo_UD_Noot_CB) SendMessage Slider(Slnr(0)).h, %TBM_SETPOS,%True, Slider(Slnr(0)).value SendMessage Slider(Slnr(1)).h, %TBM_SETPOS,%True, Slider(Slnr(1)).value Task(%Tubo_Dyna_Test).tog = %True END IF note = UdCtrl(ud).value velo = Slider(Slnr(0)).value IF velo THEN mPlay Tubo.channel, note, velo Task(%Tubo_Dyna_Test).freq = MAX(.5, Slider(Slnr(1)).value / 2!) END SUB SUB Tubo_UD_Noot_CB () ' for callback on parameter UpDown. LOCAL note AS SINGLE note = UDCtrl(TaskEX(%Tubo_Dyna_Test).UpdownNumbers(0)).value CONTROL SET TEXT Task(%Tubo_Dyna_Test).hparam, %GMT_TEXT0_ID + 16, "N=" & STR$(note) END SUB SUB Tubo_Damp_Test () ' this proc. does not send any note-on's ' test for the damper-pic's, to check the velocity scaling in the firmware. STATIC note AS INTEGER LOCAL velo AS DWORD STATIC slnr() AS INTEGER STATIC ud AS INTEGER STATIC init AS LONG IF ISFALSE init THEN init = 1 ' create sliders: DIM Slnr(0 TO 1) AS STATIC INTEGER DIM TaskParamLabels(0 TO 2) AS STATIC ASCIIZ*8 TaskParamLabels(0)="Velo" ' contact time for the dampers TaskParamLabels(1)="Freq" ' speed TaskParamLabels(2)="Note" ' up down for the note IF Task(%Tubo_Damp_Test).hParam = %Null THEN MakeTaskParameterDialog BYVAL %Tubo_Damp_Test,2, Slider(),1,UdCtrl(), TaskParamLabels() END IF slnr(0) = TaskEX(%Tubo_Damp_Test).SliderNumbers(0) slnr(1) = TaskEX(%Tubo_Damp_Test).SliderNumbers(1) ud = TaskEX(%Tubo_Damp_Test).UpDownNumbers(0) Slider(Slnr(0)).value = 1 Slider(Slnr(1)).value = 4 UdCtrl(ud).value = Tubo.lowtes UdCtrl(ud).minval = Tubo.lowtes UdCtrl(ud).maxval = Tubo.hightes UdCtrl(ud).resetval = Tubo.lowtes UdCtrl(ud).stap = 1 UDctrl(ud).cptr = CODEPTR(Tubo_UD_Damp_CB) SendMessage Slider(Slnr(0)).h, %TBM_SETPOS,%True, Slider(Slnr(0)).value SendMessage Slider(Slnr(1)).h, %TBM_SETPOS,%True, Slider(Slnr(1)).value Task(%Tubo_Damp_Test).tog = %True END IF note = UdCtrl(ud).value velo = Slider(Slnr(0)).value Release Tubo.channel, note, velo ' noteoff + release only!!! Task(%Tubo_Damp_Test).freq = MAX(.2, Slider(Slnr(1)).value / 8!) END SUB SUB Tubo_UD_Damp_CB () ' for callback on parameter UpDown. LOCAL note AS SINGLE note = UDCtrl(TaskEX(%Tubo_Damp_Test).UpdownNumbers(0)).value CONTROL SET TEXT Task(%Tubo_Damp_Test).hparam, %GMT_TEXT0_ID + 16, "N=" & STR$(note) END SUB SUB Tubo_Note1_Test () ' this proc. does send note-on + velo and note-off with release ' 27.11.2019 STATIC note AS INTEGER LOCAL velo AS INTEGER LOCAL demping AS INTEGER STATIC slnr() AS INTEGER STATIC ud, oldnote AS INTEGER STATIC init AS LONG IF ISFALSE init THEN init = 1 ' create sliders: DIM Slnr(0 TO 2) AS STATIC INTEGER DIM TaskParamLabels(0 TO 3) AS STATIC ASCIIZ*8 TaskParamLabels(0)="Velo" ' attack force for beaters TaskParamLabels(1)="Release" ' release time for dampers TaskParamLabels(2)="Freq" ' speed TaskParamLabels(3)="Note" ' up down for the note IF Task(%Tubo_Note1_Test).hParam = %Null THEN MakeTaskParameterDialog BYVAL %Tubo_Note1_Test,3, Slider(),1,UdCtrl(), TaskParamLabels() END IF slnr(0) = TaskEX(%Tubo_Note1_Test).SliderNumbers(0) slnr(1) = TaskEX(%Tubo_Note1_Test).SliderNumbers(1) slnr(2) = TaskEX(%Tubo_Note1_Test).sliderNumbers(2) ud = TaskEX(%Tubo_Note1_Test).UpDownNumbers(0) Slider(Slnr(0)).value = 1 Slider(Slnr(1)).value = 1 Slider(Slnr(2)).value = 2 UdCtrl(ud).value = Tubo.lowtes UdCtrl(ud).minval = Tubo.lowtes UdCtrl(ud).maxval = Tubo.hightes UdCtrl(ud).resetval = Tubo.lowtes UdCtrl(ud).stap = 1 UDctrl(ud).cptr = CODEPTR(Tubo_UD_Notes_CB) SendMessage Slider(Slnr(0)).h, %TBM_SETPOS,%True, Slider(Slnr(0)).value SendMessage Slider(Slnr(1)).h, %TBM_SETPOS,%True, Slider(Slnr(1)).value SendMessage Slider(Slnr(2)).h, %TBM_SETPOS,%True, Slider(Slnr(2)).value Task(%Tubo_Note1_Test).tog = %True END IF note = UdCtrl(ud).value velo = Slider(Slnr(0)).value demping = Slider(slnr(1)).value Task(%Tubo_Note1_Test).freq = MAX(.5, Slider(Slnr(2)).value / 2!) IF oldnote THEN IF demping THEN Release Tubo.channel, oldnote, demping END IF oldnote = %False 'exit sub ELSE IF velo THEN mPlay Tubo.channel, note, velo oldnote = note END IF END IF END SUB SUB Tubo_UD_Notes_CB () ' for callback on parameter UpDown. LOCAL note AS SINGLE note = UDCtrl(TaskEX(%Tubo_Note1_Test).UpdownNumbers(0)).value CONTROL SET TEXT Task(%Tubo_Note1_Test).hparam, %GMT_TEXT0_ID + 16, "N=" & STR$(note) END SUB SUB Tubo_Note2_Test () ' this proc. does send note-on + velo and note-off with release STATIC note AS INTEGER LOCAL velo AS INTEGER LOCAL demping AS INTEGER STATIC slnr() AS INTEGER STATIC ud, oldnote AS INTEGER STATIC init AS LONG IF ISFALSE init THEN init = 1 ' create sliders: DIM Slnr(0 TO 2) AS STATIC INTEGER DIM TaskParamLabels(0 TO 3) AS STATIC ASCIIZ*8 TaskParamLabels(0)="Velo" ' attack force for beaters TaskParamLabels(1)="Release" ' release time for dampers TaskParamLabels(2)="Freq" ' speed TaskParamLabels(3)="Note" ' up down for the note IF Task(%Tubo_Note2_Test).hParam = %Null THEN MakeTaskParameterDialog BYVAL %Tubo_Note2_Test,3, Slider(),1,UdCtrl(), TaskParamLabels() END IF slnr(0) = TaskEX(%Tubo_Note2_Test).SliderNumbers(0) slnr(1) = TaskEX(%Tubo_Note2_Test).SliderNumbers(1) slnr(2) = TaskEX(%Tubo_Note2_Test).sliderNumbers(2) ud = TaskEX(%Tubo_Note2_Test).UpDownNumbers(0) Slider(Slnr(0)).value = 1 Slider(Slnr(1)).value = 1 Slider(Slnr(2)).value = 2 UdCtrl(ud).value = Tubo.lowtes UdCtrl(ud).minval = Tubo.lowtes UdCtrl(ud).maxval = Tubo.hightes UdCtrl(ud).resetval = Tubo.lowtes UdCtrl(ud).stap = 1 UDctrl(ud).cptr = CODEPTR(Tubo_UD_Notes2_CB) SendMessage Slider(Slnr(0)).h, %TBM_SETPOS,%True, Slider(Slnr(0)).value SendMessage Slider(Slnr(1)).h, %TBM_SETPOS,%True, Slider(Slnr(1)).value SendMessage Slider(Slnr(2)).h, %TBM_SETPOS,%True, Slider(Slnr(2)).value Task(%Tubo_Note2_Test).tog = %True END IF note = UdCtrl(ud).value velo = Slider(Slnr(0)).value demping = Slider(slnr(1)).value Task(%Tubo_Note2_Test).freq = MAX(.5, Slider(Slnr(2)).value / 2!) IF oldnote THEN IF demping THEN Release Tubo.channel, oldnote, demping END IF oldnote = %False 'exit sub ELSE IF velo THEN mPlay Tubo.channel, note, velo oldnote = note END IF END IF END SUB SUB Tubo_UD_Notes2_CB () ' for callback on parameter UpDown. LOCAL note AS SINGLE note = UDCtrl(TaskEX(%Tubo_Note2_Test).UpdownNumbers(0)).value CONTROL SET TEXT Task(%Tubo_Note2_Test).hparam, %GMT_TEXT0_ID + 16, "N=" & STR$(note) END SUB SUB Tubo_Note3_Test () ' this proc. does send note-on + velo and note-off with release STATIC note AS INTEGER LOCAL velo AS INTEGER LOCAL demping AS INTEGER STATIC slnr() AS INTEGER STATIC ud, oldnote AS INTEGER STATIC init AS LONG IF ISFALSE init THEN init = 1 ' create sliders: DIM Slnr(0 TO 2) AS STATIC INTEGER DIM TaskParamLabels(0 TO 3) AS STATIC ASCIIZ*8 TaskParamLabels(0)="Velo" ' attack force for beaters TaskParamLabels(1)="Release" ' release time for dampers TaskParamLabels(2)="Freq" ' speed TaskParamLabels(3)="Note" ' up down for the note IF Task(%Tubo_Note3_Test).hParam = %Null THEN MakeTaskParameterDialog BYVAL %Tubo_Note3_Test,3, Slider(),1,UdCtrl(), TaskParamLabels() END IF slnr(0) = TaskEX(%Tubo_Note3_Test).SliderNumbers(0) slnr(1) = TaskEX(%Tubo_Note3_Test).SliderNumbers(1) slnr(2) = TaskEX(%Tubo_Note3_Test).sliderNumbers(2) ud = TaskEX(%Tubo_Note3_Test).UpDownNumbers(0) Slider(Slnr(0)).value = 1 Slider(Slnr(1)).value = 1 Slider(Slnr(2)).value = 2 UdCtrl(ud).value = Tubo.lowtes UdCtrl(ud).minval = Tubo.lowtes UdCtrl(ud).maxval = Tubo.hightes UdCtrl(ud).resetval = Tubo.lowtes UdCtrl(ud).stap = 1 UDctrl(ud).cptr = CODEPTR(Tubo_UD_Notes3_CB) SendMessage Slider(Slnr(0)).h, %TBM_SETPOS,%True, Slider(Slnr(0)).value SendMessage Slider(Slnr(1)).h, %TBM_SETPOS,%True, Slider(Slnr(1)).value SendMessage Slider(Slnr(2)).h, %TBM_SETPOS,%True, Slider(Slnr(2)).value Task(%Tubo_Note3_Test).tog = %True END IF note = UdCtrl(ud).value velo = Slider(Slnr(0)).value demping = Slider(slnr(1)).value Task(%Tubo_Note3_Test).freq = MAX(.5, Slider(Slnr(2)).value / 2!) IF oldnote THEN IF demping THEN Release Tubo.channel, oldnote, demping END IF oldnote = %False 'exit sub ELSE IF velo THEN mPlay Tubo.channel, note, velo oldnote = note END IF END IF END SUB SUB Tubo_UD_Notes3_CB () ' for callback on parameter UpDown. LOCAL note AS SINGLE note = UDCtrl(TaskEX(%Tubo_Note3_Test).UpdownNumbers(0)).value CONTROL SET TEXT Task(%Tubo_Note3_Test).hparam, %GMT_TEXT0_ID + 16, "N=" & STR$(note) END SUB SUB Tubo_Note4_Test () ' this proc. does send note-on + velo and note-off with release STATIC note AS INTEGER LOCAL velo AS INTEGER LOCAL demping AS INTEGER STATIC slnr() AS INTEGER STATIC ud, oldnote AS INTEGER STATIC init AS LONG IF ISFALSE init THEN init = 1 ' create sliders: DIM Slnr(0 TO 2) AS STATIC INTEGER DIM TaskParamLabels(0 TO 3) AS STATIC ASCIIZ*8 TaskParamLabels(0)="Velo" ' attack force for beaters TaskParamLabels(1)="Release" ' release time for dampers TaskParamLabels(2)="Freq" ' speed TaskParamLabels(3)="Note" ' up down for the note IF Task(%Tubo_Note4_Test).hParam = %Null THEN MakeTaskParameterDialog BYVAL %Tubo_Note4_Test,3, Slider(),1,UdCtrl(), TaskParamLabels() END IF slnr(0) = TaskEX(%Tubo_Note4_Test).SliderNumbers(0) slnr(1) = TaskEX(%Tubo_Note4_Test).SliderNumbers(1) slnr(2) = TaskEX(%Tubo_Note4_Test).sliderNumbers(2) ud = TaskEX(%Tubo_Note4_Test).UpDownNumbers(0) Slider(Slnr(0)).value = 1 Slider(Slnr(1)).value = 1 Slider(Slnr(2)).value = 2 UdCtrl(ud).value = Tubo.lowtes UdCtrl(ud).minval = Tubo.lowtes UdCtrl(ud).maxval = Tubo.hightes UdCtrl(ud).resetval = Tubo.lowtes UdCtrl(ud).stap = 1 UDctrl(ud).cptr = CODEPTR(Tubo_UD_Notes4_CB) SendMessage Slider(Slnr(0)).h, %TBM_SETPOS,%True, Slider(Slnr(0)).value SendMessage Slider(Slnr(1)).h, %TBM_SETPOS,%True, Slider(Slnr(1)).value SendMessage Slider(Slnr(2)).h, %TBM_SETPOS,%True, Slider(Slnr(2)).value Task(%Tubo_Note4_Test).tog = %True END IF note = UdCtrl(ud).value velo = Slider(Slnr(0)).value demping = Slider(slnr(1)).value Task(%Tubo_Note4_Test).freq = MAX(.5, Slider(Slnr(2)).value / 2!) IF oldnote THEN IF demping THEN Release Tubo.channel, oldnote, demping END IF oldnote = %False 'exit sub ELSE IF velo THEN mPlay Tubo.channel, note, velo oldnote = note END IF END IF END SUB SUB Tubo_UD_Notes4_CB () ' for callback on parameter UpDown. LOCAL note AS SINGLE note = UDCtrl(TaskEX(%Tubo_Note4_Test).UpdownNumbers(0)).value CONTROL SET TEXT Task(%Tubo_Note4_Test).hparam, %GMT_TEXT0_ID + 16, "N=" & STR$(note) END SUB SUB Tubo_Lites () ' 20.09.2019: following lights fitted: White LED strip under low beater assembly (122) ' Blue LED spotlites above and under power supply unit (120-121) ' 27.11.2019: White LED strip under high beater assembly (126) ' Blue LED strip on high damper assembly (123) STATIC n AS BYTE IF ISFALSE Task(%Tubo_lites).tog THEN n = 120 Task(%Tubo_lites).tog = %True END IF NoteOff Tubo.channel, n INCR n IF n > 126 THEN n = 120 mPlay Tubo.channel, n, 127 END SUB SUB Tubo_Blue () IF ISFALSE Task(%Tubo_Blue).tog THEN Task(%Tubo_Blue).tog = %True END IF mPlay Tubo.channel, 121, 64 mPlay Tubo.channel, 122, 64 mPlay Tubo.channel, 123, 64 mPlay Tubo.channel, 124, 64 mPlay Tubo.channel, 125, 64 END SUB SUB Tubo_Blue_Off () NoteOff Tubo.channel, 121 NoteOff Tubo.channel, 122 NoteOff Tubo.channel, 123 NoteOff Tubo.channel, 124 NoteOff Tubo.channel, 125 END SUB SUB Tubo_White () IF ISFALSE Task(%Tubo_White).tog THEN Task(%Tubo_White).tog = %True END IF mPlay Tubo.channel, 120, 64 mPlay Tubo.channel, 126, 64 END SUB SUB Tubo_White_Off () NoteOff Tubo.channel, 120 NoteOff Tubo.channel, 126 END SUB SUB Tubo_Ctrl_Test () ' to be adapted to what's implemented in ... ' 24.09.2019: voorlopig alleen ctrl 25 geimplementeerd voor dempkracht notes 48-65 ' 29.09.2019: Ctrl64, sustain implemented. (switch) STATIC CC25, CC64 AS INTEGER STATIC slnr AS INTEGER STATIC ud AS INTEGER STATIC init AS LONG IF ISFALSE init THEN init = 1 ' create sliders: DIM TaskParamLabels(0 TO 1) AS STATIC ASCIIZ*8 TaskParamLabels(0)="CC25" ' damping time TaskParamLabels(1)="CC64" ' sustain on/off IF Task(%Tubo_Ctrl_Test).hParam = %Null THEN MakeTaskParameterDialog BYVAL %Tubo_Ctrl_Test,1, Slider(),1,UdCtrl(), TaskParamLabels() END IF slnr = TaskEX(%Tubo_Ctrl_Test).SliderNumbers(0) ud = TaskEX(%Tubo_Ctrl_Test).UpDownNumbers(0) Slider(Slnr).value = 64 ' = default UdCtrl(ud).value = 0 UdCtrl(ud).minval = 0 UdCtrl(ud).maxval = 64 UdCtrl(ud).resetval = 0 UdCtrl(ud).stap = 64 UDctrl(ud).cptr = CODEPTR(Tubo_UD_Sustain_CB) SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value Task(%Tubo_Ctrl_Test).tog = %True END IF CC64 = UdCtrl(ud).value CC25 = Slider(Slnr).value IF Tubo.ctrl(64) <> CC64 THEN Controller Tubo.channel, 64, CC64 Tubo.ctrl(64) = CC64 END IF IF Tubo.ctrl(25) <> CC25 THEN Controller Tubo.channel, 25, CC25 Tubo.ctrl(25) = CC25 END IF Task(%Tubo_Ctrl_Test).freq = 20 END SUB SUB Tubo_UD_Sustain_CB () ' for callback on parameter UpDown. LOCAL sustain AS SINGLE sustain = UDCtrl(TaskEX(%Tubo_Ctrl_Test).UpdownNumbers(0)).value CONTROL SET TEXT Task(%Tubo_Ctrl_Test).hparam, %GMT_TEXT0_ID + 16, "S=" & STR$(sustain) END SUB SUB Tubo_Lites_Off () ' all lites ' this also works simply with ctrl 123. LOCAL n AS BYTE FOR n = 120 TO 126 Noteoff Tubo.channel, n NEXT n END SUB SUB Tubo_4865_Beat () 'scale test for the low beater board 'in this test we do not send note-off commands. STATIC note AS INTEGER STATIC init AS LONG LOCAL velo AS DWORD STATIC slnr() AS INTEGER IF ISFALSE init THEN 'Task(%Tubo_Scale_Test).tog THEN init = 1 note = Tubo.lowtes ' create sliders: DIM Slnr(0 TO 1) AS STATIC INTEGER DIM TaskParamLabels(0 TO 2) AS STATIC ASCIIZ*8 TaskParamLabels(0)="Velo" ' attack force for beaters TaskParamLabels(1)="Freq" ' speed IF ISFALSE Task(%Tubo_4865_Beat).hParam THEN MakeTaskParameterDialog BYVAL %Tubo_4865_Beat,2, Slider(),0,UdCtrl(), TaskParamLabels() END IF slnr(0) = TaskEX(%Tubo_4865_Beat).SliderNumbers(0) slnr(1) = TaskEX(%Tubo_4865_Beat).SliderNumbers(1) Slider(Slnr(0)).value = 1 Slider(Slnr(1)).value = 4 SendMessage Slider(Slnr(0)).h, %TBM_SETPOS,%True, Slider(Slnr(0)).value SendMessage Slider(Slnr(1)).h, %TBM_SETPOS,%True, Slider(Slnr(1)).value Task(%Tubo_4865_Beat).tog = %True END IF velo = Slider(Slnr(0)).value IF velo THEN 'CONTROL SET TEXT gh.cockpit,%GMT_MSG1, STR$(note) mPlay Tubo.channel, note, velo 'oldnote = note INCR note IF note > 65 THEN note = Tubo.lowtes END IF Task(%Tubo_4865_Beat).freq = MAX(.5, Slider(Slnr(1)).value / 2!) END SUB SUB Tubo_6691_Beat () 'scale test for the high beater board 'in this test we do not send note-off commands. STATIC note AS INTEGER STATIC init AS LONG LOCAL velo AS DWORD STATIC slnr() AS INTEGER IF ISFALSE init THEN init = 1 note = 66 ' create sliders: DIM Slnr(0 TO 1) AS STATIC INTEGER DIM TaskParamLabels(0 TO 2) AS STATIC ASCIIZ*8 TaskParamLabels(0)="Velo" ' attack force for beaters TaskParamLabels(1)="Freq" ' speed IF ISFALSE Task(%Tubo_6691_Beat).hParam THEN MakeTaskParameterDialog BYVAL %Tubo_6691_Beat,2, Slider(),0,UdCtrl(), TaskParamLabels() END IF slnr(0) = TaskEX(%Tubo_6691_Beat).SliderNumbers(0) slnr(1) = TaskEX(%Tubo_6691_Beat).SliderNumbers(1) Slider(Slnr(0)).value = 1 Slider(Slnr(1)).value = 4 SendMessage Slider(Slnr(0)).h, %TBM_SETPOS,%True, Slider(Slnr(0)).value SendMessage Slider(Slnr(1)).h, %TBM_SETPOS,%True, Slider(Slnr(1)).value Task(%Tubo_6691_Beat).tog = %True END IF velo = Slider(Slnr(0)).value IF velo THEN 'CONTROL SET TEXT gh.cockpit,%GMT_MSG1, STR$(note) mPlay Tubo.channel, note, velo 'oldnote = note INCR note IF note > Tubo.hightes THEN note = 66 END IF Task(%Tubo_6691_Beat).freq = MAX(.5, Slider(Slnr(1)).value / 2!) END SUB SUB Tubo_4865_Damp () ' here we only test the low damper board. ' hence we only send note-off with releases here ' check firmware: maybe we did not activate dampers without note on... STATIC note AS INTEGER STATIC init AS LONG LOCAL damp AS DWORD STATIC slnr() AS INTEGER IF ISFALSE init THEN init = 1 note = Tubo.lowtes ' create sliders: DIM Slnr(0 TO 1) AS STATIC INTEGER DIM TaskParamLabels(0 TO 2) AS STATIC ASCIIZ*8 TaskParamLabels(0)="Damp" ' attack force for dampers TaskParamLabels(1)="Freq" ' speed IF ISFALSE Task(%Tubo_4865_Damp).hParam THEN MakeTaskParameterDialog BYVAL %Tubo_4865_Damp,2, Slider(),0,UdCtrl(), TaskParamLabels() END IF slnr(0) = TaskEX(%Tubo_4865_Damp).SliderNumbers(0) slnr(1) = TaskEX(%Tubo_4865_Damp).SliderNumbers(1) Slider(Slnr(0)).value = 1 Slider(Slnr(1)).value = 4 SendMessage Slider(Slnr(0)).h, %TBM_SETPOS,%True, Slider(Slnr(0)).value SendMessage Slider(Slnr(1)).h, %TBM_SETPOS,%True, Slider(Slnr(1)).value Task(%Tubo_4865_Damp).tog = %True END IF damp = Slider(Slnr(0)).value IF damp THEN 'CONTROL SET TEXT gh.cockpit,%GMT_MSG1, STR$(note) Release Tubo.channel, note, damp INCR note IF note > 65 THEN note = Tubo.lowtes END IF Task(%Tubo_4865_Damp).freq = MAX(.5, Slider(Slnr(1)).value / 2!) END SUB SUB Tubo_6691_Damp () ' here we only test the low damper board. ' hence we only send note-off with releases here ' check firmware: maybe we did not activate dampers without note on... STATIC note AS INTEGER STATIC init AS LONG LOCAL damp AS DWORD STATIC slnr() AS INTEGER IF ISFALSE init THEN init = 1 note = 66 ' create sliders: DIM Slnr(0 TO 1) AS STATIC INTEGER DIM TaskParamLabels(0 TO 2) AS STATIC ASCIIZ*8 TaskParamLabels(0)="Damp" ' attack force for dampers TaskParamLabels(1)="Freq" ' speed IF ISFALSE Task(%Tubo_6691_Damp).hParam THEN MakeTaskParameterDialog BYVAL %Tubo_6691_Damp,2, Slider(),0,UdCtrl(), TaskParamLabels() END IF slnr(0) = TaskEX(%Tubo_6691_Damp).SliderNumbers(0) slnr(1) = TaskEX(%Tubo_6691_Damp).SliderNumbers(1) Slider(Slnr(0)).value = 1 Slider(Slnr(1)).value = 4 SendMessage Slider(Slnr(0)).h, %TBM_SETPOS,%True, Slider(Slnr(0)).value SendMessage Slider(Slnr(1)).h, %TBM_SETPOS,%True, Slider(Slnr(1)).value Task(%Tubo_6691_Damp).tog = %True END IF damp = Slider(Slnr(0)).value IF damp THEN 'CONTROL SET TEXT gh.cockpit,%GMT_MSG1, STR$(note) Release Tubo.channel, note, damp INCR note IF note > Tubo.hightes THEN note = 66 END IF Task(%Tubo_6691_Damp).freq = MAX(.5, Slider(Slnr(1)).value / 2!) END SUB SUB Tubo_Vib4865 () STATIC slnr() AS INTEGER STATIC udnr() AS INTEGER IF ISFALSE Task(%Tubo_Vib4865).tog THEN ' create slider: DIM Slnr(0) AS STATIC INTEGER DIM Udnr(0) AS STATIC INTEGER DIM TaskParamLabels(1) AS STATIC ASCIIZ*8 TaskParamLabels(0)="Speed" TaskParamLabels(1)="Off" IF ISFALSE Task(%Tubo_Vib4865).hParam THEN MakeTaskParameterDialog BYVAL %Tubo_Vib4865,1, Slider(),1,UdCtrl(), TaskParamLabels() END IF slnr(0) = TaskEX(%Tubo_Vib4865).SliderNumbers(0) Slider(Slnr(0)).value = Tubo.ctrl(20) SendMessage Slider(Slnr(0)).h, %TBM_SETPOS,%True, Tubo.ctrl(20) udnr(0) = TaskEX(%Tubo_Vib4865).UpDownNumbers(0) UdCtrl(udnr(0)).value = 0 UdCtrl(udnr(0)).minval = 0 UdCtrl(udnr(0)).maxval = 1 UdCtrl(udnr(0)).resetval = 0 UDctrl(udnr(0)).cptr = CODEPTR(Tubo_UD_Vib4865_CB) Task(%Tubo_Vib4865).tog = %True END IF 'IF udCtrl(udnr(0)).value > 0 THEN ' this was a bug!!! IF Tubo.ctrl(20) <> Slider(slnr(0)).value THEN Tubo.ctrl(20) = Slider(Slnr(0)).value Controller Tubo.channel, 20, Tubo.ctrl(20) IF Tubo.ctrl(20) > 0 THEN UdCtrl(udnr(0)).value = 1 END IF 'END IF END SUB SUB Tubo_UD_Vib4865_CB () ' for callback on vibrato off switch LOCAL slnr AS SINGLE slnr = TaskEX(%Tubo_Vib4865).Slidernumbers(0) ' on reception of a click on the UD we send a vibrato off command. Tubo.ctrl(20) = 0 sendMessage Slider(slnr).h, %TBM_SETPOS,%True, 0 Slider(slnr).value = Tubo.ctrl(20) Controller Tubo.channel, 20, Tubo.ctrl(20) END SUB SUB Tubo_Vib6691 () STATIC slnr() AS INTEGER STATIC udnr() AS INTEGER IF ISFALSE Task(%Tubo_Vib6691).tog THEN ' create slider: DIM Slnr(0) AS STATIC INTEGER DIM Udnr(0) AS STATIC INTEGER DIM TaskParamLabels(1) AS STATIC ASCIIZ*8 TaskParamLabels(0)="Speed" TaskParamLabels(1)="Off" ' one shot IF ISFALSE Task(%Tubo_Vib6691).hParam THEN MakeTaskParameterDialog BYVAL %Tubo_Vib6691,1, Slider(),1,UdCtrl(), TaskParamLabels() END IF slnr(0) = TaskEX(%Tubo_Vib6691).SliderNumbers(0) Slider(Slnr(0)).value = 0 Tubo.ctrl(21) = 0 SendMessage Slider(Slnr(0)).h, %TBM_SETPOS,%True, Slider(Slnr(0)).value udnr(0) = TaskEX(%Tubo_Vib6691).UpDownNumbers(0) UdCtrl(udnr(0)).value = 0 UdCtrl(udnr(0)).minval = 0 UdCtrl(udnr(0)).maxval = 1 UdCtrl(udnr(0)).resetval = 0 UDctrl(udnr(0)).cptr = CODEPTR(Tubo_UD_Vib6691_CB) Task(%Tubo_Vib6691).tog = %True END IF 'IF UdCtrl(udnr(0)).value > 0 THEN IF Tubo.ctrl(21) <> Slider(slnr(0)).value THEN Tubo.ctrl(21) = Slider(Slnr(0)).value Controller Tubo.channel, 21, Tubo.ctrl(21) IF Tubo.ctrl(21) > 0 THEN UdCtrl(udnr(0)).value = 1 END IF 'END IF END SUB SUB Tubo_UD_Vib6691_CB () ' for callback on vibrato off switch LOCAL slnr AS SINGLE slnr = TaskEX(%Tubo_Vib6691).Slidernumbers(0) ' on reception of a click on the UD we send a vibrato off command. Tubo.ctrl(21) = 0 sendMessage Slider(slnr).h, %TBM_SETPOS,%True, 0 slider(slnr).value = Tubo.ctrl(21) Controller Tubo.channel, 21, Tubo.ctrl(21) END SUB SUB Tubo_120 () STATIC tog AS BYTE IF ISFALSE tog THEN mPlay Tubo.channel, 120, 100 ELSE NoteOff Tubo.channel, 120 END IF BIT TOGGLE tog, 0 Task(%Tubo_120).freq = 1 END SUB SUB Tubo_120_off () NoteOff Tubo.channel, 120 END SUB SUB Tubo_121 () STATIC tog AS BYTE IF ISFALSE tog THEN mPlay Tubo.channel, 121, 100 ELSE NoteOff Tubo.channel, 121 END IF BIT TOGGLE tog,0 Task(%Tubo_121).freq = 1 END SUB SUB Tubo_121_off () NoteOff Tubo.channel, 121 END SUB SUB Tubo_122 () STATIC tog AS BYTE IF ISFALSE tog THEN mPlay Tubo.channel, 122, 100 ELSE NoteOff Tubo.channel, 122 END IF BIT TOGGLE tog, 0 Task(%Tubo_122).freq = 1 END SUB SUB Tubo_122_off () NoteOff Tubo.channel, 122 END SUB SUB Tubo_123 () STATIC tog AS BYTE IF ISFALSE tog THEN mPlay Tubo.channel, 123, 100 ELSE NoteOff Tubo.channel, 123 END IF BIT TOGGLE tog,0 Task(%Tubo_123).freq = 1 END SUB SUB Tubo_123_off () NoteOff Tubo.channel, 123 END SUB SUB Tubo_124 () STATIC tog AS BYTE IF ISFALSE tog THEN mPlay Tubo.channel, 124, 100 ELSE NoteOff Tubo.channel, 124 END IF BIT TOGGLE tog, 0 Task(%Tubo_124).freq = 1 END SUB SUB Tubo_124_off () NoteOff Tubo.channel, 124 END SUB SUB Tubo_125 () STATIC tog AS BYTE IF ISFALSE tog THEN mPlay Tubo.channel, 125, 100 ELSE NoteOff Tubo.channel, 125 END IF BIT TOGGLE tog, 0 Task(%Tubo_125).freq = 1 END SUB SUB Tubo_125_off () NoteOff Tubo.channel, 125 END SUB SUB Tubo_126 () STATIC tog AS BYTE IF ISFALSE tog THEN mPlay Tubo.channel, 126, 100 ELSE NoteOff Tubo.channel, 126 END IF BIT TOGGLE tog, 0 Task(%Tubo_126).freq = 1 END SUB SUB Tubo_126_off () NoteOff Tubo.channel, 126 END SUB SUB Tubo_Noton_test () ' test note on/off with dampers, using CC25 ' using note-on with velo=0 for note-off. ' 07.12.2019 - tested o.k. STATIC note, oldnote AS INTEGER STATIC cnt AS LONG LOCAL velo AS DWORD STATIC slnr() AS INTEGER IF ISFALSE Task(%Tubo_Noton_Test).tog THEN note = Tubo.lowtes ' create sliders: DIM Slnr(0 TO 2) AS STATIC INTEGER DIM TaskParamLabels(0 TO 2) AS STATIC ASCIIZ*8 TaskParamLabels(0)="Velo" ' attack force for beaters TaskParamLabels(1)="Freq" ' speed TaskParamLabels(2)="CC25" ' damping time for note off IF ISFALSE Task(%Tubo_Noton_Test).hParam THEN MakeTaskParameterDialog BYVAL %Tubo_Noton_Test,3, Slider(),0,UdCtrl(), TaskParamLabels() END IF slnr(0) = TaskEX(%Tubo_Noton_Test).SliderNumbers(0) slnr(1) = TaskEX(%Tubo_Noton_Test).SliderNumbers(1) slnr(2) = TaskEX(%Tubo_Noton_Test).SliderNumbers(2) Slider(Slnr(0)).value = 16 Slider(Slnr(1)).value = 4 Slider(Slnr(2)).value = 64 Tubo.ctrl(25) = 64 SendMessage Slider(Slnr(0)).h, %TBM_SETPOS,%True, Slider(Slnr(0)).value SendMessage Slider(Slnr(1)).h, %TBM_SETPOS,%True, Slider(Slnr(1)).value SendMessage Slider(Slnr(2)).h, %TBM_SETPOS,%True, Slider(Slnr(2)).value Task(%Tubo_Noton_Test).tog = %True END IF IF cnt = 0 THEN velo = Slider(Slnr(0)).value IF velo THEN CONTROL SET TEXT gh.cockpit,%GMT_MSG1, STR$(note) mPlay Tubo.channel, note, velo oldnote = note INCR note IF note > Tubo.hightes THEN note = Tubo.lowtes ELSE IF oldnote THEN mPlay Tubo.channel, oldnote, 0 oldnote = %False END IF END IF ELSE IF oldnote THEN mPlay Tubo.channel, oldnote, 0 oldnote = %False END IF END IF INCR cnt cnt = cnt MOD 2 ' controller 25: IF Tubo.ctrl(25) <> Slider(slnr(2)).value THEN Tubo.ctrl(25) = Slider(slnr(2)).value Controller Tubo.channel, 25, Tubo.ctrl(25) END IF Task(%Tubo_Noton_Test).freq = MAX(.5, Slider(Slnr(1)).value / 2!) END SUB ' tests with some composition code: SUB Tubo_Harm () ' 02.12.2019: 4-klank akkoorden-testkode stukje gwr ' nog lang niet af! ' af te wisselen met Tubo_Harsol LOCAL done AS LONG LOCAL n AS DWORD STATIC tc AS INTEGER STATIC tog AS DWORD STATIC n1, n2, n3, n4, oldn1, oldn2, oldn3, oldn4 AS INTEGER STATIC h AS HarmType IF ISFALSE Task(%Tubo_Harm).tog THEN DIM slnr(2) AS STATIC LONG DIM TaskParamLabels(2) AS STATIC ASCIIZ*8 TaskParamLabels(0)="Volume" TaskParamLabels(1)="Damping" TaskParamLabels(2)="Tempo" IF ISFALSE Task(%Tubo_Harm).hParam THEN MakeTaskParameterDialog BYVAL %Tubo_Harm,3, Slider(),0,UdCtrl(), TaskParamLabels() END IF slnr(0) = TaskEX(%Tubo_Harm).SliderNumbers(0) slnr(1) = TaskEX(%Tubo_Harm).SliderNumbers(1) slnr(2) = TaskEX(%Tubo_Harm).SliderNumbers(2) Slider(slnr(0)).minval = 1 Slider(slnr(0)).maxval = 96 Slider(slnr(0)).value = 32 ' p at start Slider(slnr(1)).minval = 0 'release Slider(slnr(1)).maxval = 96 Slider(slnr(1)).value = 0 Slider(slnr(2)).value = 4 Task(%Tubo_Harm).Har.vel = STRING$(128,0) h.vel = STRING$(128,0) FillHarType h SendMessage Slider(slnr(0)).h, %TBM_SETRANGE,%True, MakeLong(Slider(slnr(0)).minval, Slider(slnr(0)).maxval) 'SendMessage Slider(0).h, %TBM_SETPAGESIZE,0,Slider(0).stap SendMessage Slider(slnr(0)).h, %TBM_SETPOS,%True, Slider(slnr(0)).value SendMessage Slider(slnr(1)).h, %TBM_SETRANGE,%True, MakeLong(Slider(slnr(1)).minval, Slider(slnr(1)).maxval) SendMessage Slider(slnr(1)).h, %TBM_SETPOS,%True, Slider(slnr(1)).value SendMessage Slider(slnr(2)).h, %TBM_SETPOS,%True, Slider(slnr(2)).value tog = %False SetDlgItemText gh.Cockpit, %GMT_TITLE, "" SetDlgItemText gh.Cockpit, %GMT_AUTHOR, "Godfried-Willem Raes" Task(%Tubo_Harm).tog = %True END IF IF ISFALSE BIT (tog,0) THEN Task(%Tubo_Harm).Har.vel = STRING$(128,0) n1 = GetRndNote (%md1, tc) ' minor DO n2 = GetRndNote (%md1, tc) LOOP UNTIL n2 <> n1 DO n3 = GetRndNote (%md1, tc) LOOP UNTIL (n3 <> n1) AND (n3 <> n2) DO n4 = GetRndNote (%md1, tc) LOOP UNTIL n4 <> n3 n1 = n1 + 48 n2 = n2 + 60 n3 = n3 + 72 n4 = n4 + 84 IF n1 < Tubo.lowtes THEN n1 = n1 + 12 IF n4 > Tubo.hightes THEN n4 = n4 - 12 IF n1<>oldn1 THEN Release Tubo.channel,oldn1, Slider(slnr(1)).value AddNote2Har Task(%Tubo_Harm).Har, n1, Slider(slnr(0)).value mPlay Tubo.channel, n1, Slider(Slnr(0)).value oldn1 = n1 ELSE ' laat de noot hangen: AddNote2Har Task(%Tubo_Harm).Har, n1, Slider(slnr(0)).value END IF IF n2<>oldn2 THEN Release Tubo.channel,oldn2, Slider(slnr(1)).value AddNote2Har Task(%Tubo_Harm).Har, n2, Slider(Slnr(0)).value mPlay Tubo.channel, n2, Slider(Slnr(0)).value oldn2 = n2 ELSE AddNote2Har Task(%Tubo_Harm).Har, n2, Slider(slnr(0)).value END IF IF n3 <> oldn3 THEN Release Tubo.channel,oldn3, Slider(slnr(1)).value AddNote2Har Task(%Tubo_Harm).har, n3, Slider(slnr(0)).value mPlay Tubo.channel, n3, Slider(slnr(0)).value oldn3 = n3 ELSE AddNote2Har Task(%Tubo_Harm).Har, n3, Slider(slnr(0)).value END IF IF n4 <> oldn4 THEN Release Tubo.channel,oldn4, Slider(slnr(1)).value AddNote2Har Task(%Tubo_Harm).har, n4, Slider(slnr(0)).value mPlay Tubo.channel, n4, Slider(slnr(0)).value oldn4 = n4 ELSE AddNote2Har Task(%Tubo_Harm).Har, n4, Slider(slnr(0)).value END IF ' lichtjes: wit NoteOff Tubo.channel, 123 NoteOff Tubo.channel, 124 mPlay Tubo.channel, 120, 127 mPlay Tubo.channel, 126, 127 ELSE ' solve chord: h.vel = SolveHar$ (Task(%Tubo_Harm).har, tc, 0) '0.5) Task(%Tubo_Harm).Har.vel = STRING$(128,0) n1 = StealNoteFromHar (h, n1, Tubo.lowtes, Tubo.hightes) n2 = StealNoteFromHar (h, n2, Tubo.hightes, Tubo.lowtes) n3 = StealNoteFromHar (h, n3, Tubo.hightes, Tubo.lowtes) n4 = StealNoteFromHar (h, n4, Tubo.hightes, Tubo.lowtes) IF n1 <> oldn1 THEN Release Tubo.channel,oldn1, Slider(slnr(1)).value AddNote2Har Task(%Tubo_Harm).Har, n1, Slider(slnr(0)).value mPlay Tubo.channel, n1, Slider(slnr(0)).value oldn1 = n1 ELSE AddNote2Har Task(%Tubo_Harm).Har, n1, Slider(slnr(0)).value END IF IF n2 <> oldn2 THEN Release Tubo.channel,oldn2, Slider(slnr(1)).value AddNote2Har Task(%Tubo_Harm).Har, n2, Slider(slnr(0)).value mPlay Tubo.channel, n2, Slider(slnr(0)).value oldn2 = n2 ELSE AddNote2Har Task(%Tubo_Harm).Har, n2, Slider(slnr(0)).value END IF IF n3 <> oldn3 THEN Release Tubo.channel,oldn3, Slider(slnr(1)).value AddNote2Har Task(%Tubo_Harm).Har, n3, Slider(slnr(0)).value mPlay Tubo.channel, n3, Slider(slnr(0)).value oldn3 = n3 ELSE AddNote2Har Task(%Tubo_Harm).Har, n3, Slider(slnr(0)).value END IF IF n4 <> oldn4 THEN Release Tubo.channel,oldn4, Slider(slnr(1)).value AddNote2Har Task(%Tubo_Harm).Har, n4, Slider(slnr(0)).value mPlay Tubo.channel, n4, Slider(slnr(0)).value oldn4 = n4 ELSE AddNote2Har Task(%Tubo_Harm).Har, n4, Slider(slnr(0)).value END IF ' lichtjes: blauw mplay Tubo.channel, 123, 127 mPlay Tubo.channel, 124, 127 NoteOff Tubo.channel, 120 NoteOff Tubo.channel, 126 END IF INCR tog IF ISFALSE tog MOD 12 THEN tc = (tc + 5) MOD 12 ' in kwarten END IF Task(%Tubo_Harm).freq = 0.05 + (Slider(slnr(2)).value / 16) END SUB SUB Tubo_Harm_Off () SetDlgItemText gh.Cockpit, %GMT_TITLE, " " 'Controller Tubo.channel, 123, 0 - beter noten laten uitklinken... END SUB SUB Tubo_HarSol () ' derived from - the complete catalogue of different chords, each chord having a different interval ' constellation. Ordering is in increasing level of dissonance. ' With their possible solutions... ' adapted to work on Tubo ' 09.12.2019: works, but not the dampers! (PlayHar, in g_lib.dll uses NoteOff commands...) ' changed in g_lib.dll to use mPlay with velo=0 ' Now this plays in a 3/4 meter. ' 14.12.2019: chord exception list added. ' 15.12.2019: interactivity added using the UD controller ' Task().patch field used to communicate with the callback function STATIC i AS WORD STATIC temposlnr AS BYTE STATIC ppslnr AS BYTE STATIC levelslnr AS BYTE STATIC Ritmeteller% STATIC init AS BYTE STATIC Akk() AS INTEGER STATIC tc AS INTEGER STATIC udnr AS LONG LOCAL tiks! LOCAL zandloper AS ASCIIZ PTR ' silly !!! (caused by declaration of WinApi) LOCAL hCursor AS LONG LOCAL j AS INTEGER STATIC Exclude() AS INTEGER IF ISFALSE init THEN REDIM Akk(0 TO &HFFF) AS STATIC INTEGER hCursor = GetCursor () zandloper = %IDC_WAIT SetCursor LoadCursor (%Null, BYVAL(zandloper)) ' cfr. declaration PB WinApi SortChordsOnDissonance Akk(), &HFC1C, 127 ' dll procedure ' parameters: %SortNoIsomorphs OR %SortPsyChord ' MSGBOX "Chords sorted. Ubound Akk = " & STR$(UBOUND(Akk)) ' = 350 ' since this takes pretty long, it would be better to save the lookup to a diskfile init = %True DIM TaskParamLabels(0 TO 3) AS ASCIIZ * 8 TaskParamLabels(0) = "Tempo" TaskParamLabels(1) = "0/1 rit" TaskParamLabels(2) = "Level" TaskParamLabels(3) = "Rit" ' hiermee kunnen we een stap versnellen of vertragen IF Task(%Tubo_Harsol).hParam = %Null THEN MakeTaskParameterDialog BYVAL %Tubo_Harsol,3,Slider(),1,UDctrl(),TaskParamLabels() END IF temposlnr = TaskEX(%Tubo_Harsol).SliderNumbers(0) ppslnr = TaskEX(%Tubo_Harsol).SliderNumbers(1) levelslnr = TaskEX(%Tubo_Harsol).SliderNumbers(2) udnr = TaskEX(%Tubo_Harsol).UpDownNumbers(0) SendMessage Slider(temposlnr).h, %TBM_SETPOS,%True, 10 ' starttempo Slider(temposlnr).value = 10 SendMessage Slider(ppslnr).h, %TBM_SETPOS,%True, 110 ' legato Slider(ppslnr).value = 110 SendMessage Slider(levelslnr).h, %TBM_SETPOS,%True, 32 ' aanslag Slider(levelslnr).value = 32 SetDlgItemText gh.Cockpit, %GMT_TEXT_TEMPO, STR$(App.tempo) Task(%Tubo_Harsol).freq = App.tempo / 60! UdCtrl(udnr).value = 100 UdCtrl(udnr).minval = 99 UdCtrl(udnr).maxval = 101 UdCtrl(udnr).resetval = 100 UdCtrl(udnr).stap = 1 UDctrl(udnr).cptr = CODEPTR(Tubo_UD_Rit_CB) SetCursor hCursor Task(%Tubo_Harsol).tog = %False DIM Exclude(0 TO 56)AS STATIC INTEGER ' fill Exclude aray: Exclude(0) = 13 Exclude(1) = 14 Exclude(2) = 17 Exclude(3) = 34 Exclude(4) = 50 Exclude(5) = 75 Exclude(6) = 77 Exclude(7) = 122 Exclude(8) = 137 Exclude(9) = 154 Exclude(10) = 167 Exclude(11) = 174 Exclude(12) = 188 Exclude(13) = 189 Exclude(14) = 209 Exclude(15) = 214 Exclude(16) = 216 Exclude(17) = 217 Exclude(18) = 218 Exclude(19) = 222 Exclude(20) = 223 Exclude(21) = 241 Exclude(22) = 252 Exclude(23) = 259 Exclude(24) = 256 Exclude(25) = 269 Exclude(26) = 270 Exclude(27) = 273 Exclude(28) = 275 Exclude(29) = 284 Exclude(30) = 292 Exclude(31) = 296 Exclude(32) = 306 Exclude(33) = 313 Exclude(34) = 315 Exclude(35) = 317 Exclude(36) = 318 Exclude(37) = 319 Exclude(38) = 322 Exclude(39) = 323 Exclude(40) = 325 Exclude(41) = 329 Exclude(42) = 332 Exclude(43) = 335 Exclude(44) = 337 Exclude(45) = 338 Exclude(46) = 339 Exclude(47) = 340 Exclude(48) = 341 Exclude(49) = 342 Exclude(50) = 344 Exclude(51) = 345 Exclude(52) = 346 Exclude(53) = 347 Exclude(54) = 348 Exclude(55) = 349 Exclude(56) = 27 Stoptask %Tubo_Harsol EXIT SUB END IF '------------------------------------------------- IF ISFALSE Task(%Tubo_Harsol).tog THEN Task(%Tubo_Harsol).tog = %True 'SetDlgItemText gh.Cockpit, %GMT_MSG1, "Solving all 350-56 different harmonies" SetDlgItemText gh.Cockpit, %GMT_TITLE, "" SetDlgItemText gh.Cockpit, %GMT_AUTHOR, $gwr 'i = %False so, on restart it will start where we stopped previous time. END IF IF Task(%Tubo_Harsol).tempo <> Slider(temposlnr).value THEN Task(%Tubo_Harsol).tempo = Slider(temposlnr).value IF ISFALSE Task(%Tubo_Harsol).tempo THEN Task(%Tubo_Harsol).tempo = %True SetDlgItemText gh.Cockpit, %GMT_TEXT_TEMPO, STR$(Task(%Tubo_Harsol).tempo) ' tempo display END IF IF ISFALSE Task(%Tubo_Harsol).Rit.pattern(Ritmeteller%) THEN ' now 3/4 maat Ritmeteller% = %False Task(%Tubo_Harsol).Rit.pattern(0)= Slider(ppslnr).value + 1 ' ON time - steeds akkoord Task(%Tubo_Harsol).Rit.pattern(1)= -(128 - Slider(ppslnr).value) ' OFF time Task(%Tubo_Harsol).Rit.pattern(2)= 2 * (Slider(ppslnr).value + 1) ' ON time - steeds 'oplossing' Task(%Tubo_Harsol).Rit.pattern(3)= 2 * (-(128 - Slider(ppslnr).value)) ' OFF time Task(%Tubo_Harsol).Rit.pattern(4)= %False END IF tiks! = RitmSigma!(Task(%Tubo_Harsol).Rit) IF tiks! < 1 THEN EXIT SUB ' het tempo voor een gehele maat is frq = task(tasknr%).tempo / 60 ' zo'n gehele maat beslaat een aantal eenheden gegeven in tiks! Task(%Tubo_Harsol).freq = (tiks! * Task(%Tubo_Harsol).tempo ) / (60 * ABS(Task(%Tubo_Harsol).Rit.pattern(Ritmeteller%))) IF Task(%Tubo_Harsol).Rit.pattern(Ritmeteller%) > 0 THEN IF Ritmeteller% = %False THEN IF i > UBOUND(Akk) THEN Stoptask %Tubo_Harsol : EXIT SUB ' here we insert a clause to exclude certain chords... j = 0 DO IF i = Exclude(j) THEN INCR i INCR j LOOP UNTIL j > UBOUND(Exclude) AddCnr2Har Task(%Tubo_Harsol).Har, Akk(i) OR &HF000, Tubo.lowtes, Tubo.hightes, Slider(levelslnr).value ' velo from slider IF tc > 0 THEN TransHarm Task(%Tubo_Harsol).Har, tc FillHarType Task(%Tubo_Harsol).Har , %use_fuzzypsy SetDlgItemText gh.Cockpit, %GMT_MSG1, "Solve "& STR$(i) '& " " & BIN$(Akk(i)AND &H0FFF) & " d=" & STR$(Task(%Tubo_Harsol).Har.Dis) PlayHar Task(%Tubo_Harsol).Har, Tubo.channel Task(%Tubo_Harsol).patch = 1 ' sounding the input chord ' do something with the lights: MM_Tubo_Off %MM_Blue ' white on: - hoe dissonanter, het sneller geknipper: mPlay Tubo.channel, 120, (Task(%Tubo_Harsol).Har.dis * 126) mPlay Tubo.channel, 126, (Task(%Tubo_Harsol).Har.dis * 125) ' interactivity on UD: SELECT CASE UDctrl(udnr).value CASE 99 ' fermata Task(%Tubo_Harsol).freq = Task(%Tubo_Harsol).freq / 4 UDCtrl(udnr).value = 100 ' reset CASE 101 ' doubling Task(%Tubo_Harsol).freq = Task(%Tubo_Harsol).freq * 2 UDctrl(udnr).value = 100 END SELECT INCR i ELSE ' solve the chord AddCnr2Har Task(%Tubo_Harsol).Har, Akk(i-1) OR &HF000, Tubo.lowtes, Tubo.hightes, Slider(levelslnr).value IF tc > 0 THEN TransHarm Task(%Tubo_Harsol).Har, tc Task(%Tubo_Harsol).har.vel = SolveHar$ (Task(%Tubo_Harsol).Har, -1, 0) ' SetDlgItemText gh.Cockpit, %GMT_TEXT0_ID + 10, STR$(i) & "Solved" ' crashes without these writes... PlayHar Task(%Tubo_Harsol).Har, Tubo.channel ' SetDlgItemText gh.Cockpit, %GMT_TEXT0_ID + 10, STR$(i) & "Solve played " ' crashes without these writes... tc = QuestTcHar (Task(%Tubo_Harsol).Har, 0.3) ' this may cause the crash... FillHarType Task(%Tubo_Harsol).Har , %use_fuzzypsy ' SetDlgItemText gh.Cockpit, %GMT_TEXT0_ID + 10, STR$(i) & "tc found =" & STR$(ABS(tc)) ' crashes without these writes... Task(%Tubo_Harsol).patch = 2 ' sounding the solved chord ' do something with the lights: (blue) MM_Tubo_Off %MM_Blue ' hoe konsonanter hoe trager geknipper mPlay Tubo.channel, 123, 127 - (Task(%Tubo_Harsol).Har.kon * 126) mPlay Tubo.channel, 124, 127 - (Task(%Tubo_Harsol).Har.kon * 125) mPlay Tubo.channel, 125, 127 - (Task(%Tubo_Harsol).Har.kon * 124) MM_Tubo_Off %MM_White ' interactivity on UD: SELECT CASE UDctrl(udnr).value CASE 99 ' fermata Task(%Tubo_Harsol).freq = Task(%Tubo_Harsol).freq / 4 UDCtrl(udnr).value = 100 ' reset CASE 101 ' doubling Task(%Tubo_Harsol).freq = Task(%Tubo_Harsol).freq * 2 UDctrl(udnr).value = 100 END SELECT END IF ELSEIF Task(%Tubo_Harsol).Rit.pattern(Ritmeteller%) < 0 THEN Task(%Tubo_Harsol).Har.vel = STRING$(128,0) PlayHar Task(%Tubo_Harsol).Har, Tubo.channel Task(%Tubo_Harsol).patch = 0 ' silence MM_Tubo_Off %MM_Lights ' bottom blue: IF Ritmeteller% MOD 2 = 0 THEN mPlay Tubo.channel, 121, 127 ELSE mPlay Tubo.channel, 122, 127 END IF IF i > UBOUND(Akk) THEN Stoptask %Tubo_Harsol END IF INCR Ritmeteller% END SUB SUB Tubo_UD_Rit_CB () ' for callback on parameter UpDown. ' the ud value is reset on use in the main procedure. ' it's a one shot. LOCAL rit AS INTEGER LOCAL m AS STRING rit = UDCtrl(TaskEX(%Tubo_Harsol).UpdownNumbers(0)).value SELECT CASE rit CASE <=99 m = "hold" SELECT CASE Task(%Tubo_Harsol).patch CASE 0 ' there is a rest CASE 1 ' sounding the input chord Task(%Tubo_Harsol).freq = Task(%Tubo_Harsol).freq / 2 CASE 2 ' sounding the solved chord Task(%Tubo_Harsol).freq = Task(%Tubo_Harsol).freq / 4 END SELECT CASE 100 m = "norm" CASE >= 101 m = "fast" SELECT CASE Task(%Tubo_Harsol).patch CASE 0 ' there is a rest CASE 1 ' sounding the input chord Task(%Tubo_Harsol).freq = Task(%Tubo_Harsol).freq * 3 CASE 2 ' sounding the solved chord Task(%Tubo_Harsol).freq = Task(%Tubo_Harsol).freq * 2 END SELECT END SELECT CONTROL SET TEXT Task(%Tubo_Harsol).hparam, %GMT_TEXT0_ID + 16, m END SUB SUB Tubo_Harsol_Stop () IF Task(%Tubo_Harsol).Har.vel <> STRING$(128,0) THEN Task(%Tubo_Harsol).har.vel = SolveHar$ (Task(%Tubo_Harsol).Har, -1, 0) PlayHar Task(%Tubo_Harsol).Har, Tubo.channel END IF END SUB '[EOF]