' *************************************************************** ' * test and debug code for midi controlled robots and automats * ' * * ' * an automated Helicon * ' *************************************************************** ' 30.10.2008: creation date of this module ' pasted in from Bono code. To be checked. ' to be added: Proc. for external audio drive test. ' 02.11.2008: lite tests added. ' 11.11.2008: first PIC versions programmed. ' 15.11.2008: test en debug session. Heli plays its first scales. ' 16.11.2008: dsPIC gone to heaven after a short with the 18V ac supply... ' 23.11.2008: Heli back in working condition. ' 23.12.2008: test proc. added for ctrl. 8 ' 31.12.2008: hardware revised. Display now works. %Heli_Test = 48 ' demo en test kode voor %Heli_Scale = 50 %Heli_Qscale = 51 ' quartertone scale test %Heli_Lite120 = 54 ' yellow - not yet implemented %Heli_Lite127 = 55 ' white - should be implemented but we cannot get it to work... %Heli_Litetest = 56 ' range test 120-127 ' to do: (evt. Xtof) %Heli_Valve_Sx = 61 ' sys-ex tests - valve lookup tables - pin 'heva' ' pic 1 - valve pic %Heli_Lookup = 35 ' ctrl 13 - valves - use 3 bits for valves ' prog.change lets users select different lookup tables for fingerings %Heli_display = 36 ' ctrl 14,15,26,27 ' pic 3 - dspic %Heli_1 = 38 ' ctrl 1 ' test wind noise if implemented %Heli_7 = 39 ' ctrl 7 ' optor volume (sound color) %Heli_8 = 40 ' external audio AM %Heli_17 = 41 ' ctrl 17 ' attack amplitude %Heli_18 = 42 ' ctrl 18 ' attack time %Heli_19 = 43 %Heli_20 = 45 ' ctrl 20 ' main tuning to diapason %Heli_Tremolo = 46 ' tremolo met ctrl 7 - will not work here! %Heli_Vibrato = 47 ' pitch bend is implemented! %Heli_Audio = 58 ' test with periodic control of ctrl 8 for external audio drive 'GLOBAL Heli as musician done in g_mm.inc 'procedure declarations: DECLARE SUB Heli_1 () ' ctrl 1 & 66 DECLARE SUB Heli_SL1 () ' slider callback DECLARE SUB Heli_Test () DECLARE SUB Heli_UD0 () DECLARE SUB Heli_UD1 () DECLARE SUB Heli_UD2 () DECLARE SUB Heli_Scale () DECLARE SUB Heli_Scale_UD0 () DECLARE SUB Heli_Scale_UD1 () DECLARE SUB Heli_Scale_UD2 () DECLARE SUB Heli_Qscale () DECLARE SUB Heli_Lite120 () DECLARE SUB Heli_Lite127 () DECLARE SUB Heli_Litetest () DECLARE SUB Heli_7 () DECLARE SUB Heli_SL7 () DECLARE SUB Heli_8 () DECLARE SUB Heli_SL8 () DECLARE SUB Heli_Audio () DECLARE SUB Heli_Display () ' ctrl 14, 15, 26,27 DECLARE SUB Heli_Display_UD () DECLARE SUB Heli_17 () DECLARE SUB Heli_SL17 () DECLARE SUB Heli_18 () DECLARE SUB Heli_SL18 () DECLARE SUB Heli_19 () DECLARE SUB Heli_SL19 () DECLARE SUB Heli_Lookup_Ctrl () DECLARE SUB Heli_20 () ' tuning DECLARE SUB Heli_SL20 () DECLARE SUB Heli_Tremolo () DECLARE SUB Heli_Vibrato () DECLARE SUB Heli_Valves DECLARE CALLBACK FUNCTION Heli_Valves_cb DECLARE FUNCTION Heli_Valve_Sysx AS LONG DECLARE FUNCTION Init_Heli () AS LONG ' code starts here: ------------------------------------------------------------ FUNCTION Init_Heli () AS LONG LOCAL retval AS LONG LOCAL m AS ASCIIZ * 30 Task(%Heli_Test).naam = "" Task(%Heli_Test).cptr = CODEPTR(Heli_Test) Task(%Heli_Test).freq = 2 Task(%Heli_Test).flags = %False TaskEx(%Heli_test).stopcptr = CODEPTR(MM_Heli_Off) TaskEx(%Heli_test).startcptr = CODEPTR(MM_Heli_On) Task(%Heli_Scale).naam = "Scale" Task(%Heli_Scale).cptr = CODEPTR(Heli_Scale) Task(%Heli_Scale).freq = 2 Task(%Heli_Scale).flags = %False TaskEX(%Heli_Scale).stopcptr = CODEPTR(MM_Heli_Off) Task(%Heli_QScale).naam = "QScale" Task(%Heli_QScale).cptr = CODEPTR(Heli_QScale) Task(%Heli_QScale).freq = 3 Task(%Heli_QScale).flags = %False TaskEX(%Heli_Qscale).stopcptr =CODEPTR(MM_Heli_Off) Task(%Heli_Lite120).naam = "lite120" ' yellow Task(%Heli_Lite120).cptr = CODEPTR(Heli_Lite120) Task(%Heli_Lite120).freq = 8 Task(%Heli_Lite120).flags = %False Task(%Heli_Lite127).naam = "lite127" ' white Task(%Heli_Lite127).cptr = CODEPTR(Heli_Lite127) Task(%Heli_Lite127).freq = 6 Task(%Heli_Lite127).flags = %False Task(%Heli_Litetest).naam = "lites" ' test range 120-127 Task(%Heli_Litetest).cptr = CODEPTR(Heli_Litetest) Task(%Heli_Litetest).freq = 2 Task(%Heli_Litetest).flags = %False Task(%Heli_1).naam = "Vol_C1" Task(%Heli_1).cptr = CODEPTR(Heli_1) Task(%Heli_1).freq = 10 Task(%Heli_1).flags = %False Task(%Heli_17).naam = "Aa_C17" Task(%Heli_17).cptr = CODEPTR(Heli_17) Task(%Heli_17).freq = 10 Task(%Heli_17).flags = %False Task(%Heli_7).naam = "Vol_C7" Task(%Heli_7).cptr = CODEPTR(Heli_7) Task(%Heli_7).freq = 10 Task(%Heli_7).flags = %False Task(%Heli_8).naam = "Vol_C8" Task(%Heli_8).cptr = CODEPTR(Heli_8) Task(%Heli_8).freq = 10 Task(%Heli_8).flags = %False Task(%Heli_Display).naam = "display" Task(%Heli_Display).cptr = CODEPTR(Heli_Display) Task(%Heli_Display).freq = 3 Task(%Heli_Display).flags = %False Task(%Heli_tremolo).naam = "Tremolo" Task(%Heli_tremolo).cptr = CODEPTR(Heli_Tremolo) Task(%Heli_tremolo).freq = 16 Task(%Heli_tremolo).flags = %False Task(%Heli_18).naam = "At_C18" Task(%Heli_18).cptr = CODEPTR(Heli_18) Task(%Heli_18).freq = 10 Task(%Heli_18).flags = %False Task(%Heli_19).naam = "Re_C19" Task(%Heli_19).cptr = CODEPTR(Heli_19) Task(%Heli_19).freq = 9.9 Task(%Heli_19).flags = %False Task(%Heli_20).naam = "Tun_C20" Task(%Heli_20).cptr = CODEPTR(Heli_20) Task(%Heli_20).freq = 10 Task(%Heli_20).flags = %False Task(%Heli_Audio).naam = "Audio-8" ' modulating test task for ctrl 8. Task(%Heli_Audio).cptr = CODEPTR(Heli_Audio) Task(%Heli_Audio).freq = 50 Task(%Heli_Audio).flags = %False ' to be done: Task(%Heli_Valve_sx).naam = "ValveSysx" Task(%Heli_Valve_sx).freq = .33 Task(%Heli_Valve_sx).cptr = CODEPTR(Heli_Valve_Sysx) 'in m_robots.inc Task(%Heli_vibrato).naam = "Vibrato" Task(%Heli_vibrato).freq = 12 Task(%Heli_vibrato).cptr = CODEPTR(Heli_Vibrato) ButnOS(2).tag = "Heli Off" ButnOS(2).cptr = CODEPTR(MM_Heli_Off) ButnSw(7).tag0 = "Valves" ButnSw(7).tag1 = "Valves" ButnSw(7).cptr = CODEPTR(Heli_Valves) m = " test & debug" SendMessage gh.Cockpit, %WM_SETTEXT,0, VARPTR(m) SetDlgItemText gh.Cockpit, %GMT_TITLE, " - test cockpit" SetDlgItemText gh.Cockpit, %GMT_AUTHOR, $gwr SetDlgItemText gh.Cockpit, %GMT_MSG1, "test and evaluation procs" SetDlgItemText gh.Cockpit, %GMT_MSG2, "for our Heli robot" MM_Heli_On END FUNCTION SUB Heli_Test() STATIC slnr AS DWORD STATIC udnr AS DWORD LOCAL value AS LONG STATIC noot AS BYTE STATIC onfreq AS SINGLE STATIC offFreq AS SINGLE STATIC oldnote AS BYTE STATIC resetval AS BYTE LOCAL velo AS BYTE LOCAL period AS SINGLE LOCAL onpart AS SINGLE LOCAL offpart AS SINGLE IF ISFALSE Task(%Heli_Test).tog THEN 'tasks that reset their sliders each time they get toggled off/on are very annoying!! - xof DIM TaskParamLabels(0 TO 4) AS ASCIIZ * 8 TaskParamLabels(0) = "Tempo" ' rescaled in proc. TaskParamLabels(1) = "Velo" ' drive volume 0-127 - velocity byte TaskParamLabels(2) = "Stac" ' staccato - legato up down ' UD0 TaskParamLabels(3) = "Note" ' pitch ' UD1 TaskParamLabels(4) = "Bend" ' pitch-bend value ' UD2 IF ISFALSE Task(%Heli_Test).hParam THEN MakeTaskParameterDialog %Heli_Test,2,Slider(),3,UDctrl(),TaskParamLabels() END IF IF slnr = %False THEN slnr = TaskEX(%Heli_Test).SliderNumbers(0) Slider(slnr).minval =1 ' tempo Slider(slnr).maxval = 127 END IF Slider(slnr).value = 8 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value IF udnr = %False THEN udnr = TaskEX(%Heli_Test).UpDownNumbers(0) UDctrl(udnr).cptr = CODEPTR(Heli_UD0) ' staccato - legato updown UDctrl(udnr).value = 80 UDctrl(udnr).minval = 0 '1 UDctrl(udnr).maxval = 100 '99 UDctrl(udnr).stap = 1 UDctrl(udnr+1).cptr = CODEPTR(Heli_UD1) ' pitch up down (note) UDctrl(udnr+1).value = 22 'Heli.lowtes UDctrl(udnr+1).minval = 0 'Heli.lowtes UDctrl(udnr+1).maxval = 127 'Heli.Hightes UDctrl(udnr+2).cptr = CODEPTR(Heli_UD2) ' pitchbend value UDctrl(udnr+2).value = 64 UDctrl(udnr+2).minval = 0 UDctrl(udnr+2).maxval = 127 resetval = 64 END IF MM_Heli_On Task(%Heli_Test).tog = %True END IF period = 1! / (Slider(slnr).value / 10!) ' tempo Task(%Heli_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 Heli.channel, oldnote oldnote = %False END IF offFreq = 1! / period 'OffPart Task(%Heli_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 Heli.channel, oldnote Task(%Heli_Test).freq = OffFreq oldnote = %False ELSE noot = UDctrl(udnr+1).value velo = Slider(slnr+1).value 'CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "velo:" + STR$(velo) + ", att:" + STR$(Heli.ctrl(18)) 'if fingerings are set with Heli.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 Heli_Valves_cb function mPLAY Heli.channel, noot, velo IF BIT(Heli.ctrl(13), 2) THEN Controller Heli.channel, 13, Heli.ctrl(13) 'moved this - when sending it before the play instruction, play resets it to default.. Bend Heli.channel, 0, UDctrl(udnr+2).value Task(%Heli_Test).freq = OnFreq oldnote = noot END IF IF Task(%Heli_Test).freq < 0.2 THEN Task(%Heli_Test).freq = 0.2 END SUB SUB Heli_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", 63, 14, 20, 12, %BS_PUSHLIKE ' CONTROL ADD CHECKBOX, hw, 21, "-2", 84 , 14, 20, 12, %BS_PUSHLIKE CONTROL ADD CHECKBOX, hw, 22, "-4", 42, 14, 20, 12, %BS_PUSHLIKE 'same as ' control add checkbox, hw, 23, "-5", '--- series of mystical numbers... ' xtof: here we need one more checkbox for the fourth valve ( - 5) '??? since when does heli have 4 valves? CONTROL ADD LABEL, hw, 30, "Ctrl(13): ?", 1, 27, 123, 12 DIALOG SHOW MODELESS hw, CALL Heli_Valves_cb ELSE DIALOG END hw END IF END SUB CALLBACK FUNCTION Heli_Valves_cb 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 23 CONTROL SET CHECK CBHNDL, i, 0 NEXT Heli.ctrl(13) = CBCTL - 10 ' 0 - 3 CASE 20 TO 22 FOR i = 10 TO 13 CONTROL SET CHECK CBHNDL, i, 0 NEXT Heli.ctrl(13) = &B0100 FOR i = 20 TO 23 CONTROL GET CHECK CBHNDL, i TO j BIT CALC Heli.ctrl(13), i - 17, j NEXT CASE ELSE EXIT FUNCTION END SELECT Controller Heli.channel, 13, Heli.ctrl(13) CONTROL SET TEXT CBHNDL, 30, "Ctrl(13):" + STR$(Heli.ctrl(13)) + " (" + BIN$(Heli.ctrl(13)) + ")" END FUNCTION SUB Heli_UD0 () ' callback on parameter UpDowns. : on/off proportion LOCAL value AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%Heli_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(%Heli_Test).hparam, %GMT_TEXT0_ID + 16, "L=" & STR$(value) END SUB SUB Heli_UD1 () ' controls the notes to be played. LOCAL noot AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%Heli_Test).UpDownNumbers(1) noot = UDCtrl(udnr).value SetDlgItemText Task(%Heli_Test).hparam, %GMT_TEXT0_ID + 17, "N=" & STR$(noot) END SUB SUB Heli_UD2 () ' ' pitchbend UD - has to be send for each note!!! LOCAL value AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%Heli_Test).UpDownNumbers(2) value = UDCtrl(udnr).value IF value > 127 THEN value = 127 IF value < 0 THEN value = 0 SetDlgItemText Task(%Heli_Test).hparam, %GMT_TEXT0_ID + 18, "b=" & STR$(value) ' sending is in the main task. END SUB SUB Heli_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(%Heli_Scale).tog THEN IF ISFALSE Task(%Heli_Scale).hParam THEN DIM TaskParamLabels(4) TaskParamLabels(0)="velo" TaskParamLabels(1)="speed" TaskParamLabels(2)="step" TaskParamLabels(3)= "hilim" TaskParamLabels(4)="lowlim" MakeTaskParameterDialog %Heli_Scale,2, Slider(),3,UdCtrl(), TaskParamLabels() slnr = TaskEX(%Heli_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(%Heli_Scale).UpDownNumbers(0) UDctrl(udnr).cptr = CODEPTR(Heli_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(Heli_Scale_UD1) ' high note limit UDctrl(udnr+1).value = 75 UDctrl(udnr+1).minval = 0 'Heli.lowtes UDctrl(udnr+1).maxval = 96 'Heli.Hightes UDctrl(udnr+2).cptr = CODEPTR(Heli_Scale_UD2) ' low note limit UDctrl(udnr+2).value = 27 UDctrl(udnr+2).minval = 0 'Heli.lowtes UDctrl(udnr+2).maxval = 96 'Heli.Hightes END IF END IF Task(%Heli_Scale).tog = %True cnt = 27 'Heli.Lowtes MM_Heli_On EXIT SUB END IF IF ISFALSE onoff THEN IF n THEN NoteOff Heli.channel, n n = %False onoff = %True ELSE n = cnt mPlay Heli.channel, n, Slider(slnr).value 'Slider(slnr).value -(cnt * 2) cnt = cnt + UDCtrl(udnr).value IF cnt > UDctrl(udnr+1).value THEN cnt = UDctrl(udnr+2).value onoff = %False END IF Task(%Heli_Scale).freq = Slider(slnr+1).value / 16 END SUB SUB Heli_Scale_UD0 () ' callback on parameter UpDowns step size LOCAL value AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%Heli_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(%Heli_Scale).hparam, %GMT_TEXT0_ID + 16, "s=" & STR$(value) END SUB SUB Heli_Scale_UD1 () ' controls the high limit of the note scale to be played. LOCAL noot AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%Heli_Scale).UpDownNumbers(1) noot = UDCtrl(udnr).value IF noot < UDctrl(udnr+1).value THEN UDctrl(udnr).value = UDctrl(udnr+1).value : noot = UDctrl(udnr+1).value 'IF noot > Heli.HighTes THEN UDctrl(udnr).value = Heli.HighTes : noot = Heli.hightes SetDlgItemText Task(%Heli_Scale).hparam, %GMT_TEXT0_ID + 17, "Hi=" & STR$(noot) END SUB SUB Heli_Scale_UD2 () ' controls the low limit of the note scale to be played. LOCAL noot AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%Heli_Scale).UpDownNumbers(2) noot = UDCtrl(udnr).value ' IF noot < Heli.lowtes THEN UDctrl(udnr).value = Heli.lowtes : noot = Heli.lowtes IF noot > UDctrl(udnr-1).value THEN UDctrl(udnr).value = UDctrl(udnr-1).value : noot = UDctrl(udnr-1).value SetDlgItemText Task(%Heli_Scale).hparam, %GMT_TEXT0_ID + 18, "Lo=" & STR$(noot) END SUB SUB Heli_Lite120 () ' yellow mapped on notes 120 STATIC cnt AS DWORD IF ISFALSE Task(%Heli_Lite120).tog THEN cnt = %False Task(%Heli_Lite120).tog = %true END IF IF ISFALSE cnt MOD 2 THEN NoteOff Heli.channel, 120 ELSE mPlay Heli.channel, 120, 127 END IF INCR cnt END SUB SUB Heli_Lite127 () ' white dim lite - freq = 10 STATIC slnr AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 IF ISFALSE Task(%Heli_Lite127).tog THEN IF ISFALSE Task(%Heli_Lite127).hParam THEN DIM TaskParamLabels(0) TaskParamLabels(0)="Lite127" MakeTaskParameterDialog %Heli_Lite127,1, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%Heli_Lite127).SliderNumbers(0) Slider(slnr).value = 0 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value END IF Task(%Heli_Lite127).tog = %True END IF IF Heli.ctrl(127) <> Slider(slnr).value THEN Heli.ctrl(127) = Slider(slnr).value mPlay Heli.channel, 127, Heli.ctrl(127) END IF END SUB SUB Heli_Litetest () ' mapping test ' midihub board STATIC slnr AS DWORD STATIC cnt AS LONG STATIC TaskParamLabels() AS ASCIIZ*8 IF ISFALSE Task(%Heli_Litetest).tog THEN IF ISFALSE Task(%Heli_Litetest).hParam THEN DIM TaskParamLabels(0) TaskParamLabels(0)="Lites" MakeTaskParameterDialog %Heli_Litetest,1, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%Heli_Litetest).SliderNumbers(0) Slider(slnr).value = 0 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value END IF cnt = 120 Task(%Heli_Litetest).tog = %True Task(%Heli_Litetest).freq = 1.5 END IF IF slider(slnr).value THEN NoteOff Heli.channel, cnt INCR cnt IF cnt > 127 THEN cnt = 120 mPlay Heli.channel, cnt, slider(slnr).value ELSE NoteOff Heli.channel, cnt INCR cnt END IF IF cnt > 127 THEN cnt = 120 END SUB SUB Heli_7 () ' controller 7 test - DS pic controlled. - this is the overall sound level ' controlled with PWM to the Optor circuit. ' This works differently than on ' It can be used for global crescendo and descrescendo playing, indepently from the ADSR controls. STATIC slnr AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 IF ISFALSE Task(%Heli_7).tog THEN IF ISFALSE Task(%Heli_7).hParam THEN DIM TaskParamLabels(0) TaskParamLabels(0)="Cont 7" MakeTaskParameterDialog %Heli_7,1, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%Heli_7).SliderNumbers(0) Slider(slnr).value = 63 Slider(slnr).cptr = CODEPTR(Heli_SL7) ' works with callback, so also when the task is OFF SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value END IF Task(%Heli_7).tog = %True END IF Task(%Heli_7).freq = 0.5 END SUB SUB Heli_SL7 () ' slider callback for volume slider task STATIC slnr AS DWORD slnr = TaskEX(%Heli_7).SliderNumbers(0) IF Slider(slnr).value <> Heli.ctrl(7) THEN ' send the appropriate midi controller... Heli.ctrl(7) = Slider(slnr).value ' 0-127 Controller Heli.channel, 7, Heli.Ctrl(7) END IF END SUB SUB Heli_8 () ' controller 8 test - hub pic controlled! - this is the external input sound level ' controlled with PWM to the Optor circuit 0n the dsPIC board. STATIC slnr AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 IF ISFALSE Task(%Heli_8).tog THEN IF ISFALSE Task(%Heli_8).hParam THEN DIM TaskParamLabels(0) TaskParamLabels(0)="Cont 8" MakeTaskParameterDialog %Heli_8,1, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%Heli_8).SliderNumbers(0) Slider(slnr).value = 63 Slider(slnr).cptr = CODEPTR(Heli_SL8) ' works with callback, so also when the task is OFF SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value END IF Task(%Heli_8).tog = %True END IF Task(%Heli_8).freq = 0.5 END SUB SUB Heli_SL8 () ' slider callback for exterbal input volume slider task STATIC slnr AS DWORD slnr = TaskEX(%Heli_8).SliderNumbers(0) IF Slider(slnr).value <> Heli.ctrl(8) THEN ' send the appropriate midi controller... Heli.ctrl(8) = Slider(slnr).value ' 0-127 Controller Heli.channel, 8, Heli.Ctrl(8) END IF END SUB SUB Heli_Audio () ' controller 8 test - hub pic controlled! - this is the external input sound level ' controlled with PWM to the Optor circuit 0n the dsPIC board. ' this proc. sends a periodic up and down signal to the optor STATIC slnr AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 STATIC cnt AS LONG STATIC dir AS LONG IF ISFALSE Task(%Heli_Audio).tog THEN IF ISFALSE Task(%Heli_Audio).hParam THEN DIM TaskParamLabels(0) TaskParamLabels(0)="Speed" MakeTaskParameterDialog %Heli_Audio,1, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%Heli_Audio).SliderNumbers(0) Slider(slnr).value = 63 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value END IF cnt = 0 dir = +1 Task(%Heli_Audio).tog = %True END IF Task(%Heli_Audio).freq = MAX(4,Slider(slnr).value * 5 ) IF dir = +1 THEN IF cnt < 128 THEN Controller Heli.channel, 8, cnt Heli.ctrl(8) = cnt INCR cnt ELSE cnt = 127 dir = -1 END IF ELSE IF cnt > -1 THEN Controller Heli.channel, 8, cnt Heli.ctrl(8) = cnt DECR cnt ELSE cnt = 0 dir = +1 END IF END IF END SUB SUB Heli_1 () ' controller 1 test - dspic controlled! - not yet implemented ' should control the amount of noise in the drive signal. STATIC slnr AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 IF ISFALSE Task(%Heli_1).tog THEN IF ISFALSE Task(%Heli_1).hParam THEN DIM TaskParamLabels(0) TaskParamLabels(0)="Cont 1" MakeTaskParameterDialog %Heli_1,1, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%Heli_1).SliderNumbers(0) Slider(slnr).value = 63 Slider(slnr).cptr = CODEPTR(Heli_SL1) ' works with callback, so also when the task is OFF SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value END IF Task(%Heli_1).tog = %True END IF Task(%Heli_1).freq = 0.5 END SUB SUB Heli_SL1 () ' slider callback for noise injection STATIC slnr AS DWORD slnr = TaskEX(%Heli_1).SliderNumbers(0) IF Slider(slnr).value <> Heli.ctrl(1) THEN ' send the appropriate midi controller... Heli.ctrl(1) = Slider(slnr).value ' 0-127 Controller Heli.channel, 1, Heli.Ctrl(1) END IF END SUB SUB Heli_Tremolo () ' tremolo test met controller 7 STATIC slnr AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 STATIC cnt AS DWORD IF ISFALSE Task(%Heli_tremolo).tog THEN IF ISFALSE Task(%Heli_tremolo).hParam THEN DIM TaskParamLabels(1) TaskParamLabels(0)="Speed" TaskParamlabels(1)="Depth" ' max. level controlled with ctrl 7 task MakeTaskParameterDialog %Heli_tremolo,2, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%Heli_tremolo).SliderNumbers(0) Slider(slnr).value = 63 Task(%Heli_tremolo).freq = 64/4 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value Slider(slnr+1).value = 0 ' maximale modulatiediepte SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, Slider(Slnr+1).value END IF IF ISFALSE Task(%Heli_7).hParam THEN starttask %Heli_7 ' we need this slider here!!! END IF cnt = %False Task(%Heli_tremolo).tog = %True END IF IF slider(slnr).value THEN Task(%Heli_tremolo).freq = slider(slnr).value / 4 ' max 32Hz IF ISFALSE cnt MOD 2 THEN Controller Heli.channel, 7, Heli.ctrl(7) ELSE Controller Heli.channel, 7, MIN(Heli.ctrl(7), Slider(slnr+1).value) END IF INCR cnt ELSE Controller Heli.channel, 7, Heli.ctrl(7) stoptask %Heli_tremolo EXIT SUB END IF END SUB SUB Heli_20 () ' tuning to diapason. [quartertone up max. range] ' controller 20 ' checked o.k. gwr. 12.08.2007 (0n So) STATIC slnr AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 IF ISFALSE Task(%Heli_20).tog THEN IF ISFALSE Task(%Heli_20).hParam THEN DIM TaskParamLabels(0) TaskParamLabels(0)="tune" MakeTaskParameterDialog %Heli_20,1, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%Heli_20).SliderNumbers(0) Slider(slnr).cptr = CODEPTR(Heli_SL20) Slider(slnr).value = Heli.ctrl(20) ' 0 = 440Hz SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value END IF Task(%Heli_20).freq = 0.45 Task(%Heli_20).tog = %True END IF END SUB SUB Heli_SL20 () ' slider callback STATIC slnr AS DWORD slnr = TaskEX(%Heli_20).SliderNumbers(0) IF slider(slnr).value <> Heli.ctrl(20) THEN Heli.ctrl(20) = Slider(slnr).value Controller Heli.channel, 20, Heli.ctrl(20) END IF END SUB SUB Heli_17 () ' controller 17 test ' equivalent to what we did with ctrl 7 on . This controls the maximum amplitude of the attack STATIC slnr AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 IF ISFALSE Task(%Heli_17).tog THEN IF ISFALSE Task(%Heli_17).hParam THEN DIM TaskParamLabels(0) TaskParamLabels(0)="C17" MakeTaskParameterDialog %Heli_17,1, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%Heli_17).SliderNumbers(0) Slider(slnr).cptr = CODEPTR(Heli_SL17) Slider(slnr).value = 64 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value END IF Task(%Heli_17).freq = 10 Task(%Heli_17).tog = %TRue END IF Task(%Heli_17).freq = 0.5 END SUB SUB Heli_SL17 () ' slider callback STATIC slnr AS DWORD slnr = TaskEX(%Heli_17).SliderNumbers(0) IF slider(slnr).value <> Heli.ctrl(17) THEN Heli.ctrl(17) = Slider(slnr).value Controller Heli.channel, 17, Heli.ctrl(17) END IF END SUB SUB Heli_18 () ' controller 18 test - this sets the duration of the attack pulse ' ds pic board. STATIC slnr AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 IF ISFALSE Task(%Heli_18).tog THEN IF ISFALSE Task(%Heli_18).hParam THEN DIM TaskParamLabels(0) TaskParamLabels(0)="C18" MakeTaskParameterDialog %Heli_18,1, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%Heli_18).SliderNumbers(0) slider(slnr).cptr = CODEPTR(Heli_sl18) Slider(slnr).value = 64 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value END IF Task(%Heli_18).freq = 0.4 Task(%Heli_18).tog = %TRue END IF END SUB SUB Heli_SL18 () ' slider callback STATIC slnr AS DWORD slnr = TaskEX(%Heli_18).SliderNumbers(0) IF slider(slnr).value <> Heli.ctrl(18) THEN Heli.ctrl(18) = Slider(slnr).value Controller Heli.channel, 18, Heli.ctrl(18) END IF END SUB SUB Heli_19 () ' controller 19 test - this sets the duration of the release sound ' ds pic board. Implemented 11.11.2008 on dsPIC STATIC slnr AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 IF ISFALSE Task(%Heli_19).tog THEN IF ISFALSE Task(%Heli_19).hParam THEN DIM TaskParamLabels(0) TaskParamLabels(0)="C19" MakeTaskParameterDialog %Heli_19,1, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%Heli_19).SliderNumbers(0) slider(slnr).cptr = CODEPTR(Heli_sl19) Slider(slnr).value = 100 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value END IF Task(%Heli_19).freq = 0.4 Task(%Heli_19).tog = %TRue END IF END SUB SUB Heli_SL19 () ' slider callback STATIC slnr AS DWORD slnr = TaskEX(%Heli_19).SliderNumbers(0) IF slider(slnr).value <> Heli.ctrl(19) THEN Heli.ctrl(19) = Slider(slnr).value Controller Heli.channel, 19, Heli.ctrl(19) END IF END SUB SUB Heli_Vibrato () ' vibrato test met de pitchbend (geimplementeerd op de dspic) STATIC slnr AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 STATIC cnt AS DWORD IF ISFALSE Task(%Heli_vibrato).tog THEN IF ISFALSE Task(%Heli_vibrato).hParam THEN DIM TaskParamLabels(1) TaskParamLabels(0)="Speed" TaskParamlabels(1)="Depth" ' pitch deviation MakeTaskParameterDialog %Heli_vibrato,2, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%Heli_vibrato).SliderNumbers(0) Slider(slnr).value = 63 Task(%Heli_vibrato).freq = 64/4 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value Slider(slnr+1).value = 0 ' geen vibrato SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, Slider(Slnr+1).value END IF cnt = %False Task(%Heli_vibrato).tog = %True END IF ' not very good code yet! we should do it much more gradually IF slider(slnr).value THEN Task(%Heli_vibrato).freq = slider(slnr).value / 4 ' max 32Hz IF ISFALSE cnt MOD 2 THEN bend Heli.channel, 0, 63 + (slider(slnr+1).value/ 2) ELSE bend Heli.channel, 0, 64 - (slider(slnr+1).value /2) END IF INCR cnt ELSE Bend Heli.channel, 0, 64 ' reset stoptask %Heli_Vibrato END IF END SUB SUB Heli_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 26 (0-15) ' lsb shows value send with controller 27 (0-15) ' 3 = displays gedoofd ' implemented on midihub pic - 30.12.2008 STATIC slnr AS DWORD STATIC udnr AS DWORD STATIC cnt AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 IF ISFALSE Task(%Heli_Display).tog THEN IF ISFALSE Task(%Heli_Display).hParam THEN DIM TaskParamLabels(2) TaskParamLabels(0)="msb" TaskParamLabels(1)="lsb" TaskParamLabels(2)="mode" ' display modus u/d MakeTaskParameterDialog %Heli_Display,2, Slider(),1,UdCtrl(), TaskParamLabels() slnr = TaskEX(%Heli_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(%Heli_Display).UpDownNumbers(0) UDctrl(udnr).cptr = CODEPTR(Heli_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(%Heli_Display).freq = 2 Task(%Heli_Display).tog = %True END IF SELECT CASE UDctrl(udnr).value CASE 0 ' displays midi note played 'if Heli.ctrl(14) <> 0 then ' Controller Heli.channel, 14, %False ' Heli.ctrl(14) = %False 'end if CASE 1 ' count Controller Heli.channel, 15, cnt Heli.ctrl(15) = cnt INCR cnt IF cnt > 99 THEN cnt = %False CASE 2 IF Heli.ctrl(26) <> Slider(slnr).value THEN Controller Heli.channel, 26, slider(slnr).value MOD 16 Heli.ctrl(26) = Slider(slnr).value MOD 16 END IF IF Heli.ctrl(27) <> Slider(slnr+1).value THEN Controller Heli.channel, 27, slider(slnr+1).value MOD 16 Heli.ctrl(27) = Slider(slnr+1).value MOD 16 END IF CASE 3 ' blank displays cnt = %False END SELECT END SUB SUB Heli_Display_UD () ' callback on parameter UpDowns. : display modus controller LOCAL value AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%Heli_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(%Heli_Display).hparam, %GMT_TEXT0_ID + 16, "m=" & STR$(value) IF Heli.ctrl(14) <> value THEN Controller Heli.channel, 14, value Heli.ctrl(14) = value END IF END SUB SUB Heli_QScale () ' quartertone scale test. STATIC onoff AS DWORD STATIC TaskParamLabels() AS ASCIIZ*8 STATIC slnr AS INTEGER STATIC n AS INTEGER IF ISFALSE Task(%Heli_Qscale).tog THEN IF ISFALSE Task(%Heli_QScale).hParam THEN DIM TaskParamLabels(2) TaskParamLabels(0)="velo" TaskParamLabels(1)="speed" MakeTaskParameterDialog %Heli_QScale,2, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%Heli_QScale).SliderNumbers(0) Slider(slnr).value = 64 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value Controller Heli.channel, 17, 84 Heli.ctrl(17) = 84 Controller Heli.channel, 18, 104 Heli.ctrl(18) = 104 Slider(slnr+1).value = 30 SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, Slider(Slnr+1).value END IF MM_Heli_On 'Controller Heli.channel, 66, 127 Task(%Heli_QScale).tog = %True n = 27 'Heli.Lowtes END IF IF ISFALSE onoff THEN Bend Heli.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 Heli.channel, n, Slider(slnr).value onoff = %True ELSE mPlay Heli.channel, n, Slider(slnr).value Bend Heli.channel, 0, 127 ' or, 64 + 50 = 114 if a step corresponds to a cent. onoff = %False INCR n END IF IF n > Heli.hightes THEN n= 27 ' Heli.lowtes Task(%Heli_QScale).freq = MAX(0.25,Slider(slnr+1).value / 4) END SUB '#IF %DEF(%Bugtobesolved) 'SUB Heli_valve_sysx () ' ' x-tog warning: deze funktie stond 2x in de source... ' ' wat wordt nu de goede versie??? ' ' gwr nota 12.12.2008 - ' ' ik heb de volgende versie _bis gedoopt. ' 'according to johannes doc we can only fill in tables 2 and 3... ' STATIC header$ ' LOCAL i AS LONG ' STATIC tab2$, tab3$ ' STATIC cc AS DWORD ' MSGBOX "Not ready - don't run this yet!",,FUNCNAME$ ' StopTask %Heli_Valve_sx ' EXIT SUB ' IF ISFALSE LEN(header$) THEN 'first time we entr this function ' i = MSGBOX("Are you sure you want to send a VALVE Sysex to Heli?" + $CRLF _ ' + "Make sure no other midi is sent until you get a confirmation that the sysex was sent.." + $CRLF + _ ' "If you don't uderstand what this is about say no!", %MB_YESNO OR %MB_DEFBUTTON2, FUNCNAME$) ' IF i <> %IDYES THEN ' Stoptask %Heli_Valve_Sx ' EXIT FUNCTION ' END IF ' header$ = CHR$(&HF0, &H7d, "heva", LOBYT(heli.channel)) ' tab2$ = CHR$(header$, 2, "we wachten op info van johannes om dit in te vullen..", &HF7) ' tab3$ = CHR$(header$, 3, &HF7) ' EXIT FUNCTION 'give us some time to go watch the sysex led.. ' END IF ' INCR cc ' SELECT CASE cc ' CASE 1 ' SysEx hMidiO(HIBYT(Heli.channel)), tab2$ ' EXIT FUNCTION ' CASE 2 ' SysEx hMidiO(HIBYT(Heli.channel)), tab3$ ' CASE ELSE ' 'reset and stop ' RESET cc, header$ ' StopTask %Heli_Valve_sx ' MSGBOX "The Heli valve sysexes where sent. It's recommended to restart now.",,FUNCNAME$ ' EXIT FUNCTION ' END SELECT ' 'END SUB '#ENDIF 'specific sysexes for Heli FUNCTION Heli_Valve_Sysx AS LONG 'upon request by gwr we hardcode the data in this function.. 'according to johannes doc we can only fill in tables 2 and 3... 'deze moet nog aangepast met empirische data - er is plaats voor 127 noten, alhoewel het voor de extreme registers niet uitmaakt... 'de tabel waarop dit gebaseerd moet worden staat in heli_valves.txt STATIC headr$ LOCAL i AS LONG STATIC tab2$, tab3$ STATIC cc AS DWORD IF ISFALSE LEN(headr$) THEN 'first time we enter this function i = MSGBOX("Are you sure you want to send a VALVE Sysex to Heli?" + $CRLF _ + "Make sure no other midi is sent until you get a confirmation that the sysex was sent.." + $CRLF + _ "If you don't uderstand what this is about say no!", %MB_YESNO OR %MB_DEFBUTTON2, FUNCNAME$) IF i <> %IDYES THEN Stoptask %Heli_Valve_Sx EXIT FUNCTION END IF ' this is code !!!! headr$ = CHR$(&HF0, &H7d, "heva", Heli.channel) 'seems like note 0 was forgotten in the sysex implementation? if we give a value for it, we get ob1 for all other notes.. tab2$ = CHR$(headr$, 2, NUL$(12),1,3,4,1,5,6,6,7,5,5,4,1,4,7,4,2,5,4,6,5,6,5,4,5,1,2,5,7,6,7,3,1,2,0,4,3,1,2,0,2,1,3,0,1,5,0,1,3,1,2,1,6,0,2,1,6,5,1,2,1,6,3,2,0,1,1,4,1,0,0,0,1,4,1,1,5,4,0,0,1,NUL$(36), &HF7) tab3$ = tab2$ ' tab3$ = CHR$(header$, 3, 0, 7, 0, 6, 4, 5, 4, 3, 2, 1, 0, 2, 1, 0, 0, 4, 2, 0, 2, 3, 6, 1, 0, 6, 4, 2, 3, 0, 4, 2, 3, 3, 2, 1, 4, 6, 4, 7, 2, 1, 0, 3, 3, 5, 1, 0, 3, 1, &HF7) '48 notes??? EXIT FUNCTION 'give us some time to go watch the sysex led.. END IF INCR cc SELECT CASE cc CASE 1 SysEx hMidiO(HIBYT(Heli.channel)), tab2$ EXIT FUNCTION CASE 2 SysEx hMidiO(HIBYT(Heli.channel)), tab3$ CASE ELSE 'reset and stop RESET cc, headr$ StopTask %Heli_Valve_Sx MSGBOX "The Heli valve sysexes where sent. It's recommended to restart now.",,FUNCNAME$ EXIT FUNCTION END SELECT END FUNCTION '[EOF]