' ****************************************** ' * * ' * Godfried-Willem Raes * ' * 2006 * ' * automated bass accordion * ' * test and evaluation code * ' ****************************************** ' 15.10.2006: module added to GMT ' 10.11.2006: Main structure for Bako welded together. ' 11.11.2006: Further coding of test module. ' 15.12.2006: First tests note PIC's ' controllers implemented in gmt code. ' ctrl windows and handler to be finished by X-tof. ' 17.12.2006: Bako konstruktief afgewerkt. ' 30.12.2006: eerste echte speel-tests. ' kontroller 1 toegevoegd. ' 31.12.2006: codeptr bug removed... ' 04.01.2007: 007-Marsch further developed. ' 07.01.2007: Intro added to 007-Marsch ' 09.01.2007: Bako improved. ' 13.01.2007: controller 66 added. - not true. Checked with Johannes ' 13.03.2007: controller 70 (bellow position) implemented ' ---------- section for "007 Marsch" --------------------------------------- %March_007 = 1 ' metakompilation constant ' performance note: first the dancers come up in a very slow and sad marsch. Absolutely non militant. ' The into task is started. ' As the performers turn slow failing-to-coordinate turns around bako and enter the areas where the ' radars are set up (one controls snar, the other the wind in the bellows of Bako), both instruments ' start playing. (work out...) ' When the intro task is stopped, the Marsch task (Bako_Mel in the coding) starts automatically. ' When the performers make clear they can no longer influence the playing of the Bako-Snar duo, they ' slowly leave the stage in centrifugal circles. When the players are out of sight, the task can be stopped. #IF %DEF(%March_007) %March_Intro = 32 %Bako_Mel = %March_intro + 1 %March_007_1 = %Bako_Mel + 1 ' for RadarPic: %Radar_listen = 17 ' 9.45GHz system Picra - tasknr. transferred to dll (g_lib.dll - g_midi.inc) GLOBAL pRadPic() AS RadarPicController PTR ' in g_lib.dll - g_midi.inc #ENDIF ' ---------- end section "007 Marsch" --------------------------------------- %Bako_test = 48 %Bako_Motor = 49 %Bako_Prepres = 50 ' 30.12.2006 '%Bako_Blowsuck = 50 ' not longer needed: replaced with one shot switches %Bako_BellowsPos = 51 '--------------------------- %Bako_Lights = 55 ' midi 10 = halogeen spot frontaal ' midi 11 = basis licht blauw, LED's ' midi 12 - 13 = frontale LED spots - blue ' midi 14 - 15 = achter LED spots - white ' midi 16 - 19 = not mounted yet (note board 1) ' midi 20 - 23 = keyboard bulbs %Bako_FrontSpot = %Bako_Lights + 1 %Bako_DownLite = %Bako_Lights + 2 %Bako_FrontLites = %Bako_Lights + 3 %Bako_BackLites = %Bako_Lights + 4 %Bako_TopLites = %Bako_Lights + 5 DECLARE FUNCTION InitBako () AS LONG DECLARE SUB Bako_Test () ' tests all notes DECLARE SUB Bako_LowLim_UD1 () DECLARE SUB Bako_HighLim_UD2 () DECLARE SUB Bako_Motor () ' test motor PIC DECLARE SUB Bako_Motorslider() ' callback motor task, motor speed slider DECLARE SUB Bako_OnOff_UD () ' controller 66 DECLARE SUB Bako_Prepres () ' test prepressure setting, midi ctrl 1. DECLARE SUB Bako_Prepresslider () ' dito callback DECLARE SUB Bako_Lights () ' test lites DECLARE SUB Bako_Lights_Off () DECLARE SUB Bako_FrontSpot () DECLARE SUB Bako_DownLite () DECLARE SUB Bako_Frontlites () DECLARE SUB Bako_Backlites () DECLARE SUB Bako_TopLites () DECLARE SUB Bako_BellowsPos () ' ctrl 70 (Bako_BellowsPos) DECLARE SUB Bako_Blow () ' one shot DECLARE SUB Bako_Suck () ' one shot #IF %DEF(%March_007) ' "Marsch 007" - jan. 2007, gwr. ' met koreografie. DECLARE SUB March_Intro () DECLARE SUB March_Intro_off () DECLARE SUB Bako_Mel () DECLARE SUB Bako_Mel_Stop () DECLARE SUB Snar_Roffel () DECLARE SUB snar_Roffel_Off () '------------------------------- #ENDIF DECLARE SUB Bako_controlroom DECLARE CALLBACK FUNCTION CB_Bako_Controlroom GLOBAL hwCtrlBako AS LONG GLOBAL hBakoWindTrackBar AS LONG 'renamed by kl, so it is possible to have controlrooms for several instruments in one cockpit.. GLOBAL hBakoPrePressTrackBar AS LONG GLOBAL hBakoVeloTrackBar AS LONG FUNCTION InitBako () AS LONG LOCAL i AS DWORD LOCAL pmask AS QUAD PTR #IF %DEF(%March_007) pmask = SetMidiListenChannel (15, %False) ' returns pointer FOR i = 0 TO 255 BIT RESET @pmask, i 'reset 4 quads!! NEXT i ' we can have 8 PicRad devices, each connected to a midi-in port, here we use only 4. DIM pRadPic(1) AS GLOBAL RadarPicController PTR 'Init four picradars: FOR i = 0 TO 3 '(%MaxNr of devices...) pRadPic(i) = GetPicRadarPointer (i, %Radar_listen, 256 * i + i) ' dev.nr, listentasknr, port/channel word IF ISFALSE pRadPic(i) THEN Warning "Initialization failure radpic" + STR$(i) REDIM PRESERVE pRadPic(i-1) AS GLOBAL RadarPicController PTR EXIT FOR END IF NEXT i Create_PicRadar_Control (Slider(), UDctrl()) ' create user interface for the PIC listen-task ' 007-marsch Task(%March_Intro).naam = "Intro" Task(%March_Intro).cptr = CODEPTR(March_Intro) Task(%March_Intro).freq = 8 Task(%March_Intro).flags = %False TaskEX(%March_Intro).stopCptr = CODEPTR(March_Intro_Off) Task(%Bako_mel).naam = "BakoMel" Task(%Bako_mel).cptr = CODEPTR(Bako_Mel) Task(%Bako_mel).freq = 2 Task(%Bako_mel).flags = %False TaskEX(%Bako_mel).stopCptr = CODEPTR(Bako_Mel_Stop) Task(%March_007_1).naam = "Snar007" Task(%March_007_1).cptr = CODEPTR(Snar_Roffel) Task(%March_007_1).freq = 24 Task(%March_007_1).flags = %False TaskEX(%March_007_1).stopCptr = CODEPTR(Snar_Roffel_Off) '---------------------------- #ENDIF Task(%Bako_test).naam = "Bakotest" Task(%Bako_test).cptr = CODEPTR(Bako_test) Task(%Bako_test).freq = 2 Task(%Bako_test).flags = %False TaskEX(%Bako_test).stopCptr = CODEPTR(MM_Bako_Off) Task(%Bako_motor).naam = "BakoMotor" Task(%Bako_motor).cptr = CODEPTR(Bako_Motor) Task(%Bako_motor).freq = 10 Task(%Bako_motor).flags = %False Task(%Bako_prepres).naam = "PrePres" Task(%Bako_prepres).cptr = CODEPTR(Bako_Prepres) Task(%Bako_prepres).freq = 6 Task(%Bako_prepres).flags = %False Task(%Bako_bellowspos).naam = "BelPos" Task(%Bako_bellowspos).cptr = CODEPTR(Bako_BellowsPos) Task(%Bako_bellowspos).freq = 10 Task(%Bako_bellowspos).flags = %False Task(%Bako_Lights).naam = "Lites" Task(%Bako_Lights).cptr = CODEPTR(Bako_Lights) Task(%Bako_Lights).freq = 10 Task(%Bako_Lights).flags = %False TaskEX(%Bako_Lights).stopcptr = CODEPTR(Bako_Lights_Off) Task(%Bako_Frontspot).naam = "F-Spot" Task(%Bako_FrontSpot).cptr = CODEPTR(Bako_FrontSpot) Task(%Bako_FrontSpot).freq = 1 Task(%Bako_FrontSpot).flags = %False TaskEX(%Bako_FrontSpot).stopcptr = CODEPTR(Bako_Lights_Off) Task(%Bako_DownLite).naam = "DownBlue" Task(%Bako_DownLite).cptr = CODEPTR(Bako_DownLite) Task(%Bako_DownLite).freq = 2 Task(%Bako_Downlite).flags = %False TaskEX(%Bako_DownLite).stopcptr = CODEPTR(Bako_Lights_Off) Task(%Bako_FrontLites).naam = "FrontLit" Task(%Bako_FrontLites).cptr = CODEPTR(Bako_FrontLites) Task(%Bako_FrontLites).freq = 1.33 Task(%Bako_FrontLites).flags = %False TaskEX(%Bako_FrontLites).stopcptr = CODEPTR(Bako_Lights_Off) Task(%Bako_BackLites).naam = "BackLits" Task(%Bako_BackLites).cptr = CODEPTR(Bako_BackLites) Task(%Bako_BackLites).freq = 1.66 Task(%Bako_Backlites).flags = %False TaskEX(%Bako_Backlites).stopcptr = CODEPTR(Bako_Lights_Off) Task(%Bako_TopLites).naam = "TopLites" Task(%Bako_TopLites).cptr = CODEPTR(Bako_TopLites) Task(%Bako_TopLites).freq = 2.2 Task(%Bako_Toplites).flags = %False TaskEX(%Bako_Toplites).stopcptr = CODEPTR(Bako_Lights_Off) Task(%MM_SysxTask).naam = "SendSysx" Task(%MM_SysxTask).freq = .33 Task(%MM_SysxTask).cptr = CODEPTR(MM_Sysx) 'in m_robots.inc ButnSW(6).tag0 = "BakoCtrl tog" ButnSW(6).tag1 = "BakoCtrl tog" ButnSW(6).cptr = CODEPTR(Bako_Controlroom) ButnOS(8).tag = "Suck" ButnOS(9).tag = "Blow" ButnOS(8).cptr = CODEPTR(Bako_Suck) ButnOS(9).cptr = CODEPTR(Bako_Blow) SetDlgItemText gh.Cockpit, %GMT_TITLE, "" ' doesnt seem to work... FUNCTION = %True END FUNCTION SUB Bako_Test () STATIC i AS DWORD STATIC j AS DWORD STATIC slnr AS DWORD STATIC oldnote AS INTEGER LOCAL onoff AS SINGLE LOCAL period AS SINGLE IF ISFALSE Task(%Bako_Test).tog THEN DIM TaskParamLabels(4) AS STATIC ASCIIZ * 8 TaskParamLabels(0) = "Tempo" ' slider TaskParamLabels(1) = "Velo" TaskParamlabels(2) = "0/1" ' puls-pauze TaskParamLabels(3) = "low" ' lowestnote UD TaskParamLabels(4) = "high" ' highest note UD IF ISFALSE Task(%Bako_Test).hParam THEN slnr = %False MakeTaskParameterDialog %Bako_Test,3,Slider(),2,UDctrl(),TaskParamLabels() END IF IF slnr = %False THEN slnr = TaskEX(%Bako_Test).SliderNumbers(0) Task(%Bako_Test).freq = 2 Slider(slnr).value = Task(%Bako_Test).freq Slider(slnr+1).value = 6 ' voorlopig. SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value Sendmessage Slider(slnr+1).h, %TBM_SETPOS, %True, Slider(slnr+1).value Slider(slnr+2).value = 64 SendMessage Slider(Slnr+2).h, %TBM_SETPOS,%True, 64 ' mid position UDctrl(TaskEX(%Bako_test).UpdownNumbers(0)).cptr = CODEPTR(Bako_LowLim_UD1) ' note UDctrl(TaskEX(%Bako_Test).UpDownNumbers(1)).cptr = CODEPTR(Bako_HighLim_UD2) ' note UDctrl(TaskEX(%Bako_Test).UpDownNumbers(0)).value = Bako.lowtes UDctrl(TaskEX(%Bako_Test).UpDownNumbers(1)).value = Bako.Hightes END IF i = UDctrl(TaskEX(%Bako_Test).UpDownNumbers(0)).value ' =Bako.lowtes Task(%Bako_Test).tog = %True END IF ' IF oldnote THEN ' 'Play Bako.channel, oldnote, 0 ' werkt niet 30.12.2006 - Bako Pic-bug? ' NoteOff Bako.channel, oldnote ' oldnote = %False ' END IF OnOff = Slider(slnr+2).value / 128 ' 0- 0.99218 IF OnOff < 0.0078 THEN OnOff = 0.0078125 period = 1! / (32! * ((Slider(slnr).value+1) / 128!)) ' tempo - duur in sekonden. IF ISFALSE j THEN Play Bako.channel, i, Slider(slnr+1).value period = period * OnOff ELSE NoteOff Bako.channel, i INCR i IF i > UDctrl(TaskEX(%Bako_Test).UpDownNumbers(1)).value THEN i = UDctrl(TaskEX(%Bako_Test).UpDownNumbers(0)).value period = period * (1! - OnOff) END IF Task(%Bako_Test).freq = MAX(MIN(1! / period, 1000),0.25) INCR j j = j MOD 2 END SUB SUB Bako_LowLim_UD1 () ' controls the low limit of the note scale to be played. LOCAL noot AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%Bako_Test).UpDownNumbers(0) noot = UDCtrl(udnr).value IF noot < Bako.lowtes THEN UDctrl(udnr).value = Bako.lowtes : noot = Bako.lowtes IF noot > UDctrl(udnr+1).value THEN UDctrl(udnr).value = UDctrl(udnr+1).value : noot = UDctrl(udnr).value SetDlgItemText Task(%Bako_Test).hparam, %GMT_TEXT0_ID + 16, "Lo=" & STR$(noot) END SUB SUB Bako_HighLim_UD2 () ' controls the high limit of the note scale to be played. LOCAL noot AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%Bako_Test).UpDownNumbers(1) noot = UDCtrl(udnr).value IF noot < UDctrl(udnr-1).value THEN UDctrl(udnr).value = UDctrl(udnr-1).value : noot = UDctrl(udnr).value IF noot > bako.hightes THEN UDctrl(udnr).value = bako.hightes : noot = bako.hightes SetDlgItemText Task(%Bako_test).hparam, %GMT_TEXT0_ID + 17, "Hi=" & STR$(noot) END SUB SUB Bako_Motor () ' test pressure sensor mechanism - controller 7 = wind pressure STATIC slnr AS DWORD IF ISFALSE Task(%Bako_Motor).tog THEN DIM TaskParamLabels(1) AS ASCIIZ * 8 TaskParamLabels(0) = "Wind" TaskParamLabels(1) = "on/off" IF ISFALSE Task(%Bako_Motor).hParam THEN slnr = %False MakeTaskParameterDialog %Bako_Motor,1,Slider(),1,UDctrl(),TaskParamLabels() UDctrl(TaskEX(%Bako_motor).UpdownNumbers(0)).cptr = CODEPTR(Bako_OnOff_UD) UDctrl(TaskEX(%Bako_motor).UpDownNumbers(0)).value = 0 END IF IF slnr = %False THEN slnr = TaskEX(%Bako_Motor).SliderNumbers(0) Slider(slnr).cptr = CODEPTR(Bako_Motorslider) Task(%Bako_Motor).freq = 10 Slider(slnr).value = 0 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value END IF Task(%Bako_Motor).tog = %True END IF ' make sure motor does not run idle... ' if no note is playing, the PIC's should guarantee the motor to be switched off. IF Bako.ctrl(7) <> Slider(slnr).value THEN Controller Bako.channel, 7, Slider(slnr).value Bako.ctrl(7) = Slider(slnr).value END IF END SUB SUB Bako_OnOff_UD () ' controller 66 - motor servo enable callback ' not yet implemented - 13.03.2007 ' all notes off should also stop the motor. LOCAL udnr AS DWORD udnr = TaskEX(%Bako_Motor).UpDownNumbers(0) IF UDCtrl(udnr).value THEN UDCtrl(udnr).value = %True ' limit to 1 Controller Bako.channel, 66, %True SetDlgItemText Task(%Bako_motor).hparam, %GMT_TEXT0_ID + 16, "On" ELSE Controller Bako.channel, 66, %False SetDlgItemText Task(%Bako_motor).hparam, %GMT_TEXT0_ID + 16, "Off" END IF Bako.ctrl(66) = UDctrl(udnr).value END SUB SUB Bako_Prepres () ' test prepressure - controller 1 STATIC slnr AS DWORD IF ISFALSE Task(%Bako_Prepres).tog THEN DIM TaskParamLabels(0) AS ASCIIZ * 8 TaskParamLabels(0) = "PPres" IF ISFALSE Task(%Bako_Prepres).hParam THEN slnr = %False MakeTaskParameterDialog %Bako_Prepres,1,Slider(),0,UDctrl(),TaskParamLabels() END IF IF slnr = %False THEN slnr = TaskEX(%Bako_Prepres).SliderNumbers(0) Slider(slnr).cptr = CODEPTR(Bako_Prepresslider) Task(%Bako_Prepres).freq = 6 Slider(slnr).value = 0 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value Controller Bako.channel, 1, %False Bako.ctrl(1) = %False END IF Task(%Bako_Prepres).tog = %True END IF IF Bako.ctrl(1) <> Slider(slnr).value THEN Controller Bako.channel, 1, Slider(slnr).value Bako.ctrl(1) = Slider(slnr).value END IF END SUB SUB Bako_Blow () ' one shot switch call back ' controller 20: if 1: blowing, if 2: suction, else: automatic controlled by PIC's ' if an end position is reached, the controller will be reset by the PIC. Controller Bako.channel, 20, 1 END SUB SUB Bako_Suck () ' one shot switch call back Controller Bako.channel, 20,2 END SUB SUB Bako_BellowsPos () ' controller 70, 64 command to place bellows in central position ' controller 70, 0 : close bellows completely (shut down) ' controller 70, 127: open bellows completely STATIC slnr AS DWORD STATIC i AS INTEGER IF ISFALSE Task(%Bako_BellowsPos).tog THEN DIM TaskParamLabels(0) AS ASCIIZ * 8 TaskParamLabels(0) = "Position" IF ISFALSE Task(%Bako_Bellowspos).hParam THEN slnr = %False MakeTaskParameterDialog %Bako_BellowsPos,1,Slider(),0,UDctrl(),TaskParamLabels() END IF IF slnr = %False THEN slnr = TaskEX(%Bako_BellowsPos).SliderNumbers(0) Task(%Bako_BellowsPos).freq = 4 Slider(slnr).value = 64 i = 64 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value END IF Task(%Bako_BellowsPos).tog = %True END IF IF i <> Slider(slnr).value THEN Controller Bako.Channel, 70, Slider(slnr).value i = Slider(slnr).value Bako.ctrl(70) = i END IF END SUB SUB Bako_Motorslider() ' motor speed or better, wind pressure in bellows ' slider callback LOCAL slnr AS DWORD slnr = TaskEX(%Bako_Motor).SliderNumbers(0) Controller Bako.channel, 7, Slider(slnr).value Bako.ctrl(7) = Slider(slnr).value END SUB SUB Bako_Prepresslider() ' wind pre-pressure in bellows ' slider callback LOCAL slnr AS DWORD slnr = TaskEX(%Bako_Prepres).SliderNumbers(0) Controller Bako.channel, 1, Slider(slnr).value Bako.ctrl(1) = Slider(slnr).value END SUB SUB Bako_Lights () ' test code for Bako lites STATIC slnr AS DWORD STATIC i AS INTEGER IF ISFALSE Task(%Bako_Lights).tog THEN DIM TaskParamLabels(0) AS ASCIIZ * 8 TaskParamLabels(0) = "Tempo" IF ISFALSE Task(%Bako_Lights).hParam THEN slnr = %False MakeTaskParameterDialog %Bako_Lights,1,Slider(),0,UDctrl(),TaskParamLabels() END IF IF slnr = %False THEN slnr = TaskEX(%Bako_Lights).SliderNumbers(0) Task(%Bako_Lights).freq = 4 Slider(slnr).value = 16 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value END IF i = 10 Task(%Bako_Lights).tog = %True END IF NoteOff Bako.Channel, i INCR i IF i > 23 THEN i = 10 Play Bako.Channel, i, 127 Task(%Bako_Lights).freq = MAX(Slider(slnr).value / 4, 0.25) END SUB SUB Bako_Lights_Off () MM_Bako_Off %MM_Lights END SUB SUB Bako_FrontSpot () STATIC cnt AS DWORD IF ISFALSE Task(%Bako_FrontSpot).tog THEN cnt = %False Task(%Bako_FrontSpot).tog = %TRue END IF IF ISFALSE cnt THEN Play Bako.channel, 10, 127 ELSE Noteoff Bako.channel, 10 END IF INCR cnt IF cnt > 1 THEN cnt = %False END SUB SUB Bako_DownLite () STATIC cnt AS DWORD IF ISFALSE Task(%Bako_DownLite).tog THEN cnt = %False Task(%Bako_DownLite).tog = %True END IF IF ISFALSE cnt THEN Play Bako.channel, 11, 127 ELSE Noteoff Bako.channel, 11 END IF INCR cnt IF cnt > 1 THEN cnt = %False END SUB SUB Bako_Frontlites () STATIC cnt AS DWORD IF ISFALSE Task(%Bako_FrontLites).tog THEN cnt = %False Task(%Bako_FrontLites).tog = %True END IF IF ISFALSE cnt THEN NoteOff Bako.channel, 12 NoteOff Bako.channel, 13 ELSE Play Bako.channel, 11 + cnt, 127 END IF INCR cnt IF cnt > 2 THEN cnt = %False END SUB SUB Bako_Backlites () STATIC cnt AS DWORD IF ISFALSE Task(%Bako_BackLites).tog THEN cnt = %False Task(%Bako_BackLites).tog = %True END IF IF ISFALSE cnt THEN NoteOff Bako.channel, 14 NoteOff Bako.channel, 15 ELSE Play Bako.channel, 13 + cnt , 127 END IF INCR cnt IF cnt > 2 THEN cnt = %False END SUB SUB Bako_TopLites () STATIC cnt AS DWORD IF ISFALSE Task(%Bako_TopLites).tog THEN cnt = %False Task(%Bako_TopLites).tog = %True END IF IF ISFALSE cnt THEN NoteOff Bako.channel, 20 NoteOff Bako.channel, 21 NoteOff Bako.channel, 22 NoteOff Bako.channel, 23 ELSE Play Bako.channel, 19 + cnt, 127 END IF INCR cnt IF cnt > 4 THEN cnt = %False END SUB SUB Bako_controlroom () ' by kl LOCAL i AS LONG LOCAL x AS LONG LOCAL b$ IF ISFALSE hwCtrlBako THEN DIALOG NEW 0, "Bako Control",1,40 ,420, 100, %WS_CAPTION OR %WS_POPUP OR %WS_SYSMENU TO hwCtrlBako x = 5 FOR i = bako.lowtes TO bako.hightes SELECT CASE (i MOD 12) CASE 0 CONTROL ADD CHECKBOX, hwCtrlBako, i, "C", x, 24, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 1 CONTROL ADD CHECKBOX, hwCtrlBako, i, "C#", x, 12, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 2 CONTROL ADD CHECKBOX, hwCtrlBako, i, "D", x, 24, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 3 CONTROL ADD CHECKBOX, hwCtrlBako, i, "D#", x, 12, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 4 CONTROL ADD CHECKBOX, hwCtrlBako, i, "E", x, 24, 18, 12, %BS_PUSHLIKE x = x + 20 CASE 5 CONTROL ADD CHECKBOX, hwCtrlBako, i, "F", x, 24, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 6 CONTROL ADD CHECKBOX, hwCtrlBako, i, "F#", x, 12, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 7 CONTROL ADD CHECKBOX, hwCtrlBako, i, "G", x, 24, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 8 CONTROL ADD CHECKBOX, hwCtrlBako, i, "G#", x, 12, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 9 CONTROL ADD CHECKBOX, hwCtrlBako, i, "A", x, 24, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 10 CONTROL ADD CHECKBOX, hwCtrlBako, i, "Bb", x, 12, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 11 CONTROL ADD CHECKBOX, hwCtrlBako, i, "B", x, 24, 18, 12, %BS_PUSHLIKE x = x + 20 END SELECT NEXT ' x = 5 ' FOR i = 19 TO 30 'cp van Ake - heeft hier geen zin(?) ' CONTROL GET TEXT hwCtrlBako, i TO b$ ' b$ = "_" + b$ + "_" ' CONTROL SET TEXT hwCtrlBako, i, b$ ' NEXT CONTROL ADD LABEL, hwCtrlBako, 500, "Use dedicated task for windpressure:", 5, 44, 200, 12 ' CONTROL ADD "msctls_trackbar32", hwCtrlBako, 501, _ ' "WindPress", 36, 76, 135, 12, %WS_CHILD OR %WS_VISIBLE OR _ ' %TBS_HORZ OR %TBS_BOTTOM ' CONTROL ADD LABEL, hwCtrlBako, 503, "?", 174, 76, 30, 12 ' hBakoWindTrackBar = GetDlgItem(hwCtrlBako,501) CONTROL ADD LABEL, hwCtrlBako, 560, "Valve:", 5, 67, 30, 12 CONTROL ADD "msctls_trackbar32", hwCtrlBako, 561, _ "Valve", 36, 67, 135, 12, %WS_CHILD OR %WS_VISIBLE OR _ %TBS_HORZ OR %TBS_BOTTOM CONTROL ADD LABEL, hwCtrlBako, 563, "?", 174, 67, 30, 12 'in uiteindelijke implementatie kunnen we dit opvragen en goed zetten! hBakoPrePressTrackBar = GetDlgItem(hwCtrlBako,561) SendMessage hBakoPrePressTrackBar, %TBM_SETPOS,%True, 51 CONTROL ADD LABEL, hwCtrlBako, 570, "Velo", 5, 80, 30, 12 CONTROL ADD "msctls_trackbar32", hwCtrlBako, 571, _ "velo", 36, 80, 135, 12, %WS_CHILD OR %WS_VISIBLE OR _ %TBS_HORZ OR %TBS_BOTTOM CONTROL ADD LABEL, hwCtrlBako, 573, "1", 174, 80, 30, 12 hBakoVeloTrackBar = GetDlgItem(hwCtrlBako, 571) SendMessage hBakoVeloTrackbar, %TBM_SETPOS, %true, 1 CONTROL ADD BUTTON, hwCtrlBako, 600, "All Off", 247, 76, 30, 12 DIALOG SHOW MODELESS hwCtrlBako CALL CB_Bako_Controlroom ELSE DIALOG END hwCtrlBako hwCtrlBako = 0 END IF END SUB CALLBACK FUNCTION CB_Bako_Controlroom LOCAL wind AS BYTE LOCAL pp AS SINGLE LOCAL i AS LONG LOCAL note AS BYTE STATIC velo AS BYTE IF ISFALSE velo THEN velo = 1 SELECT CASE CBMSG CASE %WM_COMMAND SELECT CASE CBCTL CASE Bako.Lowtes TO Bako.hightes 'note checkboxes CONTROL GET CHECK CBHNDL, CBCTL TO i note = CBCTL Play Bako.channel, note, BYVAL i * velo ' where do we get i (velo) from here ??? - code copied from instrumetn without velocity -> 0/1 according to buton state.. 'nu i * velo... CASE 600 'all off FOR i = Bako.lowtes TO Bako.hightes Play Bako.channel, i, 0 CONTROL SET CHECK CBHNDL, i, 0 SLEEP 10 DIALOG DOEVENTS NEXT i Controller Bako.channel, 123, %False ' SendMessage hBakoWindTrackBar, %TBM_SETPOS, %true, 0 Bako.ctrl(7) = %False Controller Bako.channel, 7, Bako.ctrl(7) CONTROL SET TEXT CBHNDL, 503, "0"' END SELECT CASE %WM_HSCROLL, %WM_VSCROLL 'note: id doesn't correspond at all with the one given at creation SELECT CASE CBLPARAM ' CASE hBakoWindTrackBar 'wind pressure ' IF (LOWRD(CBWPARAM) = %TB_THUMBPOSITION) OR (LOWRD(CBWPARAM) = %TB_THUMBTRACK) THEN ' wind = HIWRD(CBWPARAM) ' ELSE ' wind = SendMessage (CBLPARAM, %TBM_GETPOS,%Null, %Null) ' END IF ' wind = wind * 1.27 ' CONTROL SET TEXT CBHNDL, 503, STR$(wind) ' Bako.ctrl(7) = wind ' Controller Bako.channel, 7, Bako.ctrl(1) CASE hBakoPrePressTrackBar ' voor volume sturing kan beter ctrl 7 gebruikt worden. ' deze slider moet veeleer de velocity aansturen IF (LOWRD(CBWPARAM) = %TB_THUMBPOSITION) OR (LOWRD(CBWPARAM) = %TB_THUMBTRACK) THEN pp = HIWRD(CBWPARAM) ELSE pp = SendMessage (CBLPARAM, %TBM_GETPOS,%Null, %Null) END IF pp = pp * 1.27 IF INT(pp) <> Bako.ctrl(1) THEN Bako.ctrl(1) = INT(pp) Controller Bako.channel, 1, INT(pp) END IF CONTROL SET TEXT CBHNDL, 563, STR$(INT(pp)) CASE hBakoVeloTrackBar IF (LOWRD(CBWPARAM) = %TB_THUMBPOSITION) OR (LOWRD(CBWPARAM) = %TB_THUMBTRACK) THEN velo = HIWRD(CBWPARAM) ELSE velo = SendMessage (CBLPARAM, %TBM_GETPOS,%Null, %Null) END IF velo = velo * 1.27 CONTROL SET TEXT CBHNDL, 573, STR$(velo) END SELECT CASE %WM_CLOSE, %WM_QUIT hwCtrlBako = 0 MM_Bako_Off ' Controller Bako.channel, 123, %False ' Bako.ctrl(7) = %False ' Controller Bako.channel, 7, Bako.ctrl(7) ' moet overbodig zijn. END SELECT END FUNCTION SUB Bako_Mel () ' demo piece. - running melodic bass ' "007-march" for -01.01.2007 ' to do: make it interactive on movement. (March...) 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 tiks AS SINGLE STATIC ritmeteller AS DWORD STATIC sop AS INTEGER IF ISFALSE Task(%Bako_Mel).tog THEN IF ISFALSE Task(%Bako_Mel).hParam THEN DIM TaskParamLabels(1) TaskParamLabels(0)="wind" TaskParamLabels(1)="tempo" MakeTaskParameterDialog %Bako_Mel,2, Slider(),0,UdCtrl(), TaskParamLabels() slnr = TaskEX(%Bako_Mel).SliderNumbers(0) Slider(slnr).value = 40 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 MM_Bako_On REDIM mel(32) Task(%Bako_Mel).tempo = 2 * SQR(Slider(slnr+1).value + 1) cnt = %False ritmeteller = 0 Task(%Bako_Mel).tog = %True d = Dismel (60,64) tiks = GetRitme (Task(%Bako_Mel).rit ,%March, 0.8) ' get ritme EXIT SUB END IF IF rest THEN InstrumPlay Bako Task(%Bako_Mel).freq = (0.1 + (RND(1) * 0.9)) * (Slider(slnr+1).value/ 32) StartTask %March_007_1 ' roffel ritmeteller = 0 rest = %False tiks = GetRitme (Task(%Bako_Mel).rit ,%March, 0.8) ' get new ritme EXIT SUB ELSE IF Task(%March_007_1).swit THEN stoptask %March_007_1 END IF IF Task(%Bako_Mel).Rit.pattern(Ritmeteller) = 0 THEN ' tempo changes are always bar by bar, discontinuous, never accel nor ritenuto Task(%Bako_Mel).tempo = 2 * SQR(Slider(slnr+1).value + 1) Ritmeteller = 0 ' tiks = GetRitme (Task(%Bako_Mel).ritm ,%March, 0.8) ' do not get new ritme END IF Task(%Bako_Mel).freq = (tiks * Task(%Bako_Mel).tempo ) / (60 * ABS(Task(%Bako_Mel).Rit.pattern(Ritmeteller))) IF Task(%Bako_Mel).Rit.pattern(Ritmeteller) < 0 THEN ' we spelen een rust InstrumPlay Bako INCR ritmeteller EXIT SUB ELSE IF ritmeteller = 0 THEN Play Troms.channel, 25, 120 ' this is the bass drum MM_Bako_On %MM_White END IF END IF SELECT CASE cnt CASE 0 IF mel(length) THEN InstrumPlay Bako ' noteoff END IF Task(%Bako_Mel).tempo = 2 * SQR(Slider(slnr+1).value + 1) tiks = GetRitme (Task(%Bako_Mel).rit ,%March, 0.9) ' get new ritme Ritmeteller = 0 mel(0) = Bako.lowtes + ((RND(1)^2) * (Bako.Hightes- Bako.Lowtes)) length = 3 + (RND(1) * 33) REDIM mel(length) crit = 0.9 '0.7 '8 'Task(%Bako_Mel).freq = (1 + (RND(1) * 4)) * (Slider(slnr+1).value/ 32) CASE ELSE DO i = 0 DO mel(cnt) = Bako.Lowtes + ((RND(1)^2) * (Bako.Hightes - Bako.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 > 500 THEN ' Warning "no mel found..." EXIT LOOP END IF LOOP IF d >= crit THEN EXIT LOOP IF i > 500 THEN crit = crit - 0.1 SetDlgItemText gh.cockpit, %GMT_MSG1, "Cr= " & STR$(crit) 'IF crit < 0 THEN Warning "Crit=0..." : crit = 0 END IF LOOP AddNote2Har Bako.Har(1), mel(cnt), 5 SELECT CASE mel(cnt) - mel(cnt-1) CASE 0 IF (24 + (mel(cnt) MOD 12)) <> mel(cnt) THEN AddNote2Har Bako.har(1), 24 + (mel(cnt) MOD 12),6 ELSE AddNote2Har Bako.har(1), 36 + (mel(cnt) MOD 12),6 END IF CASE 1, 13 AddNote2Har Bako.Har(1), 24 + ((mel(cnt)+7) MOD 12),6 CASE 2, 14 AddNote2Har Bako.Har(1), 24 + ((mel(cnt) -5) MOD 12), 6 CASE 3, 15 AddNote2Har Bako.Har(1), 24 + ((mel(cnt-1) - 4) MOD 12), 6 CASE 4, 16 AddNote2Har Bako.Har(1), 24 + ((mel(cnt-1) -3) MOD 12), 6 CASE 5, 17 AddNote2Har Bako.Har(1), 24 + ((mel(cnt) + 3) MOD 12),6 CASE 6, 18 AddNote2Har Bako.Har(1), 24 + ((mel(cnt-1) -1) MOD 12), 6 CASE 7, 19 AddNote2Har Bako.Har(1), 24 + ((mel(cnt-1) + 4) MOD 12), 6 CASE 8, 20 AddNote2Har Bako.Har(1), 24 + ((mel(cnt) + 5) MOD 12), 6 CASE 12, 24 IF (36 + (mel(cnt) MOD 12)) <> mel(cnt) THEN AddNote2Har Bako.har(1), 36 + (mel(cnt) MOD 12),6 ELSE IF 48 + (mel(cnt) MOD 12) < Bako.hightes THEN AddNote2Har Bako.har(1), 48 + (mel(cnt) MOD 12),6 ELSE AddNote2Har Bako.har(1), 24 + (mel(cnt) MOD 12),6 END IF END IF CASE ELSE ' try adding melody line: IF sop <= mel(cnt) THEN sop = Bako.hightes IF sop <= mel(cnt-1) THEN sop = Bako.hightes DO SELECT CASE cnt MOD 2 CASE 0 IF (sop MOD 12) = (mel(cnt)+ 7) MOD 12 THEN ' kwint AddNote2Har Bako.har(1), sop, 6 EXIT DO END IF CASE 1 IF (sop MOD 12) = (mel(cnt)+ 5) MOD 12 THEN ' kwart AddNote2Har Bako.har(1), sop, 6 EXIT DO END IF CASE 2 IF (sop MOD 12) = (mel(cnt)+ 4) MOD 12 THEN ' gr 3 AddNote2Har Bako.har(1), sop, 6 EXIT DO END IF CASE 3 IF (sop MOD 12) = (mel(cnt)+ 3) MOD 12 THEN ' kl 3 AddNote2Har Bako.har(1), sop, 6 EXIT DO END IF CASE ELSE IF (sop MOD 12) = (mel(cnt)+ 2) MOD 12 THEN ' sek. AddNote2Har Bako.har(1), sop, 6 EXIT DO END IF END SELECT DECR sop LOOP END SELECT Controller Bako.channel, 7, (127 - (cnt * 2)) * (Slider(slnr).value /128) ' decrescendo InstrumPlay Bako END SELECT INCR cnt IF cnt > length THEN cnt = %False rest = %True END IF INCR ritmeteller END SUB SUB Bako_Mel_Stop () MM_Bako_Off 'Controller Bako.channel, 7, %False 'Bako.ctrl(7) = %False MM_Troms_Off ' release snare magnet END SUB SUB Snar_Roffel () STATIC vel AS INTEGER STATIC beater AS INTEGER IF ISFALSE Task(%March_007_1).tog THEN MM_Bako_Off %MM_White MM_Bako_On %MM_Blue Controller snar.channel,11, 100 vel = 1 beater = 60 Task(%March_007_1).freq = (Task(%Bako_Mel).tempo / 60) * 128 Task(%March_007_1).tog = %True END IF Play snar.channel, beater, vel INCR vel vel = MIN(127,vel) INCR beater IF beater > 72 THEN beater = 60 END SUB SUB Snar_Roffel_Off () STATIC stick AS INTEGER IF ISFALSE stick THEN stick = 73 END IF MM_Bako_Off %MM_Blue Play Snar.channel, stick,127 INCR stick IF stick > 74 THEN stick = 73 Play Snar.channel, 75, 127 ' flash lite END SUB SUB March_Intro () ' uses PicRad 0 or A and 1 or B. STATIC tiks AS LONG STATIC noot AS WORD STATIC velo AS WORD STATIC snares AS WORD STATIC ritmeteller AS LONG STATIC cnt AS LONG STATIC interval AS LONG IF ISFALSE Task(%March_Intro).tog THEN IF ISFALSE Task(%Radar_Listen).swit THEN starttask %Radar_Listen tiks = GetRitme (Task(%March_Intro).rit ,%March, 0.5) ' get ritme MM_Bako_On Task(%March_Intro).tempo = 36 ritmeteller = 0 cnt = 0 interval =7 Task(%March_Intro).tog = %True Bako.ctrl(7) = 10 END IF IF Task(%March_Intro).Rit.pattern(Ritmeteller) = 0 THEN ' tempo changes are always bar by bar, discontinuous, never accel nor ritenuto Task(%March_Intro).tempo = 24 ' in bako: * SQR(Slider(slnr+1).value + 1) = 12 Ritmeteller = 0 tiks = GetRitme (Task(%March_Intro).rit ,%March, 0.5) ' get new ritme END IF Task(%March_Intro).freq = (tiks * Task(%March_Intro).tempo ) / (60 * ABS(Task(%March_Intro).Rit.pattern(Ritmeteller))) IF Task(%March_Intro).Rit.pattern(Ritmeteller) < 0 THEN ' rust ' we spelen verkleinende intervallen akkoorden op bako: Bako.ctrl(7) = ((Bako.ctrl(7) * 7) + MAX(12,MIN(@pRadPic(1).amp, 127))) / 8 Controller Bako.channel, 7, Bako.ctrl(7) AddNote2Har Task(%March_Intro).Har, Bako.lowtes + cnt, 4 IF bako.ctrl(7) > 20 THEN Bako.Har(1) = Task(%March_Intro).Har END IF InstrumPlay Bako MM_Bako_On %MM_White cnt = (cnt + interval) MOD 34 DECR interval IF GetNrNotesInHar(Task(%March_Intro).Har) > 5 THEN Task(%March_Intro).Har.vel = NUL$(128) ' =STRING$(128, 0) interval = 7 END IF INCR ritmeteller EXIT SUB ELSE IF bako.ctrl(7) > 20 THEN Bako.har(1).vel = SolveHar$(Task(%March_Intro).Har, -1,0) END IF InstrumPlay Bako MM_Bako_Off %MM_White END IF IF @pRadPic(0).f > 1.02 THEN noot = MIN(snar.lowtes + @pRadPic(0).f/ 3, 74) ' range to be tested - 75,76,77 = lights ELSE noot = %False END IF velo = MIN(@pRadPic(0).amp, 127) IF noot THEN IF noot <= snar.Hightes THEN IF velo THEN Play snar.channel, noot, velo END IF END IF Play snar.channel,75 + (noot/10),velo ' lites ELSE ' licht uit MM_Troms_Off %MM_Lights END IF ' snares: snares = SQR(@pRadPic(0).f * @pRadPic(0).amp) IF snares <> snar.ctrl(11) THEN Controller Snar.channel, 11, MIN(snares, 127) snar.ctrl(11) = MIN(snares, 127) END IF INCR ritmeteller END SUB SUB March_Intro_Off () MM_Bako_Off MM_Troms_Off StartTask %Bako_Mel END SUB 'EOF