' *************************************************************************** ' * * ' * an automated reed organ by dr.Godfried-Willem Raes * ' a improved version of the earlier robot. * ' * Operational since december 2009 * ' *************************************************************************** '19.11.2009: start work on implementation of an alternative robot for Harma: Harmo. Should be compatible. ' for now, just a modified copy of Harma coding. '20.11.2009: xof made harmo specific changes.. ' added swell, tremulant etc ' separate window for register buttons now, as there where too much for the cockpit ' wind and volume slider in 1 task '05.12.2009: first tests in interactive applications. '06.12.2009: test code debug. '15.12.2009: firmware programming session 2. Some bugs repaired. '16.12.1009: lite testcode adapted. '22.12.2009: tremulant test & white light debugged and tested. '02.01.2010: swell motor code implemented. '24.01.2010: windvalve implemented. %MM_HarmO_Valve, ctrl1. '22.05.2010: debug session on PIC midihub board. Ctrl.66 should now work flawless... GLOBAL hwCtrlharmO AS LONG GLOBAL hwRegharmO AS LONG GLOBAL hharmOWindTrackBar AS LONG DECLARE FUNCTION Harmo_Init () AS DWORD DECLARE SUB Harmo_ButnSWHandler () DECLARE SUB Harmo_ButnOSHandler () DECLARE SUB Harmo_test () ' scale test for harmonium ' 48 DECLARE SUB harmO_Rood () ' led spots DECLARE SUB harmO_Blue () DECLARE SUB harmO_white () DECLARE SUB harmo_orange () DECLARE SUB harmO_lampjes () DECLARE SUB harmO_Lights_Off () DECLARE SUB harmOMot () ' motor control task DECLARE SUB harmO_Wind_Handler () DECLARE SUB harmOSwell () DECLARE SUB harmO_Swell_Handler () DECLARE SUB harmOTrem () DECLARE SUB harmO_Trem_Handler () DECLARE SUB harmO_controlroom () DECLARE CALLBACK FUNCTION CB_harmO_Controlroom () DECLARE SUB HarmO_registers () DECLARE CALLBACK FUNCTION CB_HarmoReg DECLARE SUB HOReg0 DECLARE SUB HOReg1 DECLARE SUB HOReg2 DECLARE SUB HOReg3 DECLARE SUB HOReg4 DECLARE SUB HOReg5 DECLARE SUB HOReg6 DECLARE SUB HOReg7 DECLARE SUB HOReg8 DECLARE SUB harmo_repeat () DECLARE SUB HarmO_AM () ' windvalve check GLOBAL pRadPic() AS RadarPicController PTR ' in g_lib.dll - g_midi.inc '#INCLUDE "c:\b\pb\gmt\robots\harma\harma_pics.inc" 'must be preceeded by the declaration for pRadPic %h_all = 51 %h_orange = 52 %h_white = 53 %h_red = 54 %h_yellow = 55 %h_blue = 56 %harmorep = 59 %h_Swell = 60 %h_Trem = 61 %h_AM = 62 %regs = 18 FUNCTION harmO_Init () EXPORT AS DWORD LOCAL CockpitLayo AS CockpitLabels LOCAL i AS DWORD LOCAL m AS ASCIIZ * 40 LOCAL zText AS ASCIIZ * 25 LOCAL retval AS LONG GetInstrumentParams Harmo, %IDM_HARMO retval = SetRobotport (Harmo, Inifilename, hMidiO()) Task(App.ReadSeqScoreTaskNr).cPtr = %False ' remove from cockpit. App.butnSWCptr = CODEPTR(Harmo_ButnSWHandler) App.butnOSCptr = CODEPTR(Harmo_ButnOSHandler) ' delete buttons that are not required or functional: ButnSW(2).tag0 = "Mot On" ButnSW(2).tag1 = "Mot Off" ButnSW(2).cptr = %False ButnSW(5).tag0 = "" ButnSW(5).tag1 = "" ButnSW(5).cptr = %False ButnSW(7).tag0 = "harmOCtrl tog" ButnSW(7).tag1 = "harmOCtrl tog" ButnSW(7).cptr = CODEPTR(harmO_Controlroom) ButnSW(8).tag0 = "RegisterCtrl tog" ButnSW(8).tag1 = "RegisterCtrl tog" ButnSW(8).cptr = CODEPTR(harmO_Registers) '%False ButnOS(3).tag = "" ButnOS(4).tag = "" ButnOS(5).tag = "" ButnOS(6).tag = "" ButnOS(7).tag = "H_Off" ButnOS(8).tag = "Clear" IF ISFALSE hMidiI(0) THEN Task(16).naam = "" Task(16).cptr = %False END IF ' harmO test code Task(%h_tst).cPtr = CODEPTR(harmO_Test) ' scale with velo Task(%h_tst).freq = 2 Task(%h_tst).naam = "harmO" Task(%h_tst).flags = %False Task(%h_all).cptr = CODEPTR(harmO_lampjes) Task(%h_all).freq = 1 Task(%h_all).naam = "Licht" Task(%h_all).flags = %False TaskEX(%h_all).stopcptr = CODEPTR(harmO_Lights_Off) Task(%h_red).cptr = CODEPTR(harmO_rood) Task(%h_red).freq = 4 Task(%h_red).naam = "Rood" Task(%h_red).flags = %False TaskEX(%h_red).stopcptr = CODEPTR(harmO_Lights_Off) Task(%h_blue).cptr = CODEPTR(harmO_blue) Task(%h_blue).freq = 4 Task(%h_blue).naam = "Blue" Task(%h_blue).flags = %False TaskEX(%h_blue).stopcptr = CODEPTR(harmO_Lights_Off) Task(%h_white).cptr = CODEPTR(harmO_white) Task(%h_white).freq = 4 Task(%h_white).naam = "White" Task(%h_white).flags = %False TaskEX(%h_white).stopcptr = CODEPTR(harmO_Lights_Off) Task(%h_orange).cptr = CODEPTR(harmo_Orange) Task(%h_orange).freq = 2 Task(%h_orange).naam="orange" taskEx(%h_orange).stopcptr = CODEPTR(harmo_lights_off) Task(%h_yellow).cptr = CODEPTR(harmO_yellow) Task(%h_yellow).freq = 4 Task(%h_yellow).naam = "YelKB" Task(%h_yellow).flags = %False TaskEX(%h_yellow).stopcptr = CODEPTR(harmO_Lights_Off) Task(%h_mot).cPtr = CODEPTR(harmOMot) Task(%h_mot).freq = 3 Task(%h_mot).naam = "Wind" Task(%h_mot).flags = %False Task(%h_Swell).cPtr = CODEPTR(harmOSwell) Task(%h_Swell).freq = 3 Task(%h_Swell).naam = "Swells" Task(%h_Swell).flags = %False Task(%h_Trem).cPtr = CODEPTR(harmOTrem) Task(%h_Trem).freq = 3 Task(%h_Trem).naam = "Tremulants" Task(%h_Trem).flags = %False Task(%harmorep).cPtr = CODEPTR(harmO_repeat) Task(%harmorep).freq = 3 Task(%harmorep).naam = "Repeats" Task(%harmorep).flags = %False task(%regs).cptr = CODEPTR(horeg0) task(%regs + 1).cptr = CODEPTR(horeg1) task(%regs + 2).cptr = CODEPTR(horeg2) task(%regs + 3).cptr = CODEPTR(horeg3) task(%regs + 4).cptr = CODEPTR(horeg4) ' subbass task(%regs + 5).cptr = CODEPTR(horeg5) task(%regs + 6).cptr = CODEPTR(horeg6) task(%regs + 7).cptr = CODEPTR(horeg7) task(%regs + 8).cptr = CODEPTR(horeg8) FOR i = 0 TO 8 Task(%regs + i).freq = .3 + (i/30) Task(%regs + i).naam = CHOOSE$(i+1, "cor2'", "dia8'", "bour16'", "princ4'","sub32'","vl 4'", "forte8'", "clar16'", "oboe8'") Task(%regs + i).flags = %false NEXT Task(%h_am).cPtr = CODEPTR(harmO_AM) Task(%h_am).freq = 3 Task(%h_am).naam = "AM-Valve" Task(%h_am).flags = %False App.id = %IDM_HARMO m = "" SendMessage gh.Cockpit, %WM_SETTEXT,0, VARPTR(m) FUNCTION = %True END FUNCTION SUB Harmo_ButnSWHandler () LOCAL ButtonNr AS LONG ButtonNr = App.butnSWparam - %GMT_BUTNSW_ID SELECT CASE ButtonNr 'case 0 = Midi Thru CASE 1 ' starts the promil counter. The MT should already be running! ' Starting the cockpit will at the same time block reception of sysex messages, by ' setting the blocking flags in SxThread.flags. IF ButnSW(Buttonnr).flag THEN App.MTstart = %True App.tstart = timeGetTime ' start the chronometerfunction SetDlgItemText gh.Cockpit, %GMT_BUTNSW_ID + ButtonNr, "STOP" ClearMiBuf 0 ' start with a blank midi input buffer BlockSysExReception hMidiI(0) ' dll procedure ELSE App.MTstart = %False SetDlgItemText gh.Cockpit, %GMT_BUTNSW_ID + ButtonNr, "CONT" END IF CASE 2 ' motor on off switch IF ButnSW(Buttonnr).flag THEN Controller harmO.channel, 66, %True harmO.ctrl(66) = 127 ELSE Controller harmO.channel, 66, %False harmO.ctrl(66) = %False END IF CASE 4 IF ButnSW(Buttonnr).flag THEN MakeHarVelWindow ' displays Har.vel structure ELSE DestroyWindow gh.HarVel END IF CASE 6 IF ButnSW(Buttonnr).flag THEN MakeHarPsyWindow ' small har.psy window ELSE DestroyWindow gh.HarPsy END IF CASE 7 IF ButnSW(Buttonnr).flag THEN MakeSpectrumWindow ELSE DestroyWindow gh.Spec END IF 'REMARK: buttons 8 -> 11 are handled by individual functions END SELECT App.butnSWparam = %False END SUB SUB Harmo_ButnOSHandler () LOCAL ButtonNr AS LONG ButtonNr = App.butnOSparam - %GMT_BUTNOS_ID SELECT CASE ButtonNr CASE 7 Controller harmO.channel, 123, %False CASE 8 ClearDelayArrays ClearMiBuf 0 END SELECT App.butnOSparam = %False END SUB SUB harmO_test () STATIC noot AS BYTE STATIC oldnote AS INTEGER STATIC slnr AS BYTE LOCAL velo AS BYTE IF ISFALSE Task(%h_tst).tog THEN Task(%h_tst).tog = %True ' create a parameter window ' The handle for this window will be returned in Task(Tasknr).hParam DIM TaskParamLabels(0 TO 3) AS ASCIIZ * 8 TaskParamLabels(0) = "Tempo" TaskParamLabels(1) = "Level" TaskParamLabels(2) = "High " TaskParamLabels(3) = "Low " IF Task(%h_tst).hParam = %Null THEN MakeTaskParameterDialog BYVAL %h_tst,4,Slider(),0,UDctrl(),TaskParamLabels() END IF Controller harmO.channel, 123, 0 EXIT SUB END IF IF ISFALSE slnr THEN slnr = TaskEX(%h_tst).SliderNumbers(0) END IF IF oldnote THEN NoteOff harmO.channel, oldnote noot = oldnote + 1 oldnote = %False END IF velo = Slider(slnr+1).value IF noot > harmO.lowtes + ((Slider(slnr+2).value/127!)*73) THEN noot = harmO.lowtes + ((Slider(slnr+3).value/127!)*73) IF noot < harmO.lowtes THEN noot = harmO.lowtes IF noot > harmO.hightes THEN noot = harmO.hightes Play harmO.channel, noot, velo oldnote = noot Task(%h_tst).freq = 16! * ((Slider(slnr).value) / 128!) IF Task(%h_tst).freq < 1 THEN Task(%h_tst).freq = 1 ' speed limit in function of velocity: [applicable for repeated notes!] ' max_period = v in ms. ( velo time = v/2 ms, but we need recovery time, thus we take v = v) ' --> fmax = 1000/v 'IF velo THEN ' IF Task(%h_tst).freq > 1000/velo THEN Task(%h_tst).freq = 1000/velo 'END IF END SUB SUB harmOMot () ' we can control the motor speed in software from here... STATIC slnr AS DWORD IF ISFALSE Task(%h_mot).tog THEN Task(%h_mot).tog = %True ' create a parameter window automatically: ' The handle for this window will be returned in Task(Tasknr).hParam DIM TaskParamLabels(0 TO 1) AS ASCIIZ * 8 ARRAY ASSIGN TaskParamLabels() = "Wind", "Volume" IF ISFALSE Task(%h_mot).hParam THEN MakeTaskParameterDialog %h_mot,2,Slider(),0,UDctrl(),TaskParamLabels() END IF slnr = TaskEX(%h_mot).SliderNumbers(0) Slider(slnr).cptr = CODEPTR(harmO_Wind_Handler) Slider(slnr+1).cptr = CODEPTR(harmO_Wind_Handler) SendMessage Slider(Slnr ).h, %TBM_SETPOS,%True, harmO.ctrl(1) SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, harmO.ctrl(7) CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "wind:" + STR$(harmo.ctrl(1)) + "vol:" + STR$(harmo.ctrl(7)) Controller harmO.channel, 1, harmO.ctrl(1) Controller harmO.channel, 7, harmO.ctrl(7) EXIT SUB END IF Task(%h_mot).freq = 3 Stoptask %h_mot END SUB SUB harmO_Wind_Handler () ' called on reception of slider changes in the parameter window of the Motor-task. STATIC slnr AS DWORD LOCAL value AS DWORD IF ISFALSE slnr THEN slnr = TaskEX(%h_mot).SliderNumbers(0) END IF value = Slider(slnr).value IF value <> harmo.ctrl(1) THEN harmo.ctrl(1) = value ' fast windslide Controller harmO.channel, 1,value END IF value = Slider(slnr + 1).value IF value <> harmo.ctrl(7) THEN harmo.ctrl(7) = value ' motor controller Controller harmO.channel, 7,value END IF CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "wind:" + STR$(harmo.ctrl(1)) + "vol:" + STR$(harmo.ctrl(7)) END SUB SUB harmOSwell () ' we assume the swells on a cold start of harmO to be fully closed. ' the swell motors should not reset on a ctrl.66 off command. STATIC slnr AS DWORD IF ISFALSE Task(%h_swell).tog THEN Task(%h_swell).tog = %True ' create a parameter window automatically: ' The handle for this window will be returned in Task(Tasknr).hParam DIM TaskParamLabels(0 TO 1) AS ASCIIZ * 8 ARRAY ASSIGN TaskParamLabels() = "frontal swell", "back swell" IF ISFALSE Task(%h_swell).hParam THEN MakeTaskParameterDialog %h_swell,2,Slider(),0,UDctrl(),TaskParamLabels() END IF slnr = TaskEX(%h_swell).SliderNumbers(0) SendMessage Slider(Slnr ).h, %TBM_SETPOS,%True, harmO.ctrl(79) SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, harmO.ctrl(80) Slider(slnr).cptr = CODEPTR(harmO_Swell_Handler) Slider(slnr+1).cptr = CODEPTR(harmO_Swell_Handler) EXIT SUB END IF Task(%h_swell).freq = 3 Stoptask %h_swell END SUB SUB harmO_Swell_Handler () ' called on reception of slider changes in the parameter window of the swell motors task. STATIC slnr AS DWORD LOCAL value AS DWORD IF ISFALSE slnr THEN slnr = TaskEX(%h_swell).SliderNumbers(0) END IF value = Slider(slnr).value IF value <> harmo.ctrl(79) THEN harmo.ctrl(79) = value Controller harmO.channel, 79,value END IF value = Slider(slnr + 1).value IF value <> harmo.ctrl(80) THEN harmo.ctrl(80) = value Controller harmO.channel, 80,value END IF END SUB SUB harmOTrem () ' using ctrl 82 steering a DC motor driving the doppler tremulant STATIC slnr AS DWORD IF ISFALSE Task(%h_Trem).tog THEN Task(%h_Trem).tog = %True ' create a parameter window automatically: ' The handle for this window will be returned in Task(Tasknr).hParam DIM TaskParamLabels(0 TO 1) AS ASCIIZ * 8 ARRAY ASSIGN TaskParamLabels() = "option", "speed" IF ISFALSE Task(%h_Trem).hParam THEN MakeTaskParameterDialog %h_trem,2,Slider(),0,UDctrl(),TaskParamLabels() END IF slnr = TaskEX(%h_Trem).SliderNumbers(0) SendMessage Slider(Slnr ).h, %TBM_SETPOS,%True, harmO.ctrl(81) 'not implmented yet? SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, harmO.ctrl(82) Slider(slnr).cptr = CODEPTR(harmO_Trem_Handler) Slider(slnr+1).cptr = CODEPTR(harmO_Trem_Handler) EXIT SUB END IF Task(%h_Trem).freq = 3 Stoptask %h_Trem END SUB SUB harmO_Trem_Handler () ' called on reception of slider changes in the parameter window of the tremulant motor-task. STATIC slnr AS DWORD LOCAL value AS DWORD IF ISFALSE slnr THEN slnr = TaskEX(%h_Trem).SliderNumbers(0) END IF value = Slider(slnr).value IF value <> harmo.ctrl(81) THEN harmo.ctrl(81) = value Controller harmO.channel, 81,value END IF value = Slider(slnr + 1).value ' tremulant speed IF value <> harmo.ctrl(82) THEN harmo.ctrl(82) = value Controller harmO.channel, 82, value CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "CC82=" + STR$(value) END IF END SUB SUB harmO_Lampjes () STATIC CNT AS LONG Task(%h_all).freq = 2 Play Harmo.channel, 119 + (cnt MOD 9), 0 INCR CNT Play Harmo.channel, 119 + (cnt MOD 9), 127 CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "note:" + STR$(119 + (cnt MOD 9)) END SUB SUB harmO_Orange () 'frontale LED spotjes STATIC CNT AS LONG Task(%h_orange).freq = 2 Play Harmo.channel, 122 + (cnt MOD 5), 0 INCR CNT Play Harmo.channel, 122 + (cnt MOD 5), 127 CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "note:" + STR$(122 + (cnt MOD 5)) END SUB SUB harmO_Rood () STATIC CNT AS LONG Task(%h_red).freq = 1.5 INCR CNT Play harmo.channel, 121, cnt MOD 2 END SUB SUB harmO_Yellow () 'led strip under vorsetzer STATIC CNT AS LONG Task(%h_yellow).freq = 1 INCR CNT Play harmo.channel, 127, cnt MOD 2 END SUB SUB harmO_Lights_Off () MM_harmO_Off %MM_Lights END SUB SUB harmO_Blue () STATIC CNT AS LONG Task(%h_blue).freq = 3 INCR CNT Play harmo.channel, 119, cnt MOD 2 END SUB SUB harmO_White () STATIC CNT AS LONG Task(%h_white).freq = 1 INCR CNT Play harmo.channel, 120, cnt MOD 2 END SUB SUB HarmO_controlroom () ' to be adapted to wide range of harmO LOCAL i AS LONG LOCAL x AS LONG LOCAL b$ IF ISFALSE hwCtrlharmO THEN DIALOG NEW 0, "harmO Control",1,150 ,450, 104, %WS_CAPTION OR %WS_POPUP OR %WS_SYSMENU TO hwCtrlharmO x = 5 FOR i = harmO.lowtes TO harmO.LowTes + (harmO.HighTes - harmO.LowTes)/2 '((harmO.LowTes + harmO.HighTes)/2) - 1 SELECT CASE (i MOD 12) CASE 0 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "C", x, 55, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 1 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "C#", x, 43, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 2 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "D", x, 55, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 3 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "D#", x, 43, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 4 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "E", x, 55, 18, 12, %BS_PUSHLIKE x = x + 20 CASE 5 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "F", x, 55, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 6 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "F#", x, 43, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 7 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "G", x, 55, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 8 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "G#", x, 43, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 9 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "A", x, 55, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 10 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "Bb", x, 43, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 11 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "B", x, 55, 18, 12, %BS_PUSHLIKE x = x + 20 END SELECT NEXT x = 5 FOR i = harmO.LowTes + (harmO.HighTes - harmO.LowTes)/2 TO harmO.Hightes SELECT CASE (i MOD 12) CASE 0 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "C", x, 24, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 1 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "C#", x, 12, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 2 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "D", x, 24, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 3 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "D#", x, 12, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 4 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "E", x, 24, 18, 12, %BS_PUSHLIKE x = x + 20 CASE 5 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "F", x, 24, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 6 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "F#", x, 12, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 7 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "G", x, 24, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 8 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "G#", x, 12, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 9 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "A", x, 24, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 10 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "Bb", x, 12, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 11 CONTROL ADD CHECKBOX, hwCtrlharmO, i, "B", x, 24, 18, 12, %BS_PUSHLIKE x = x + 20 END SELECT NEXT ' CONTROL ADD LABEL, hwCtrlharmO, 500, "WindPress:", 5, 76, 30, 12 'separate task ' CONTROL ADD "msctls_trackbar32", hwCtrlharmO, 501, _ ' "WindPress", 36, 76, 135, 12, %WS_CHILD OR %WS_VISIBLE OR _ ' %TBS_HORZ OR %TBS_BOTTOM ' CONTROL ADD LABEL, hwCtrlharmO, 503, "?", 174, 76, 30, 12 ' hharmOWindTrackBar = GetDlgItem(hwCtrlharmO,501) CONTROL ADD BUTTON, hwCtrlharmO, 600, "All Off", 247, 76, 30, 12 DIALOG SHOW MODELESS hwCtrlharmO CALL CB_harmO_Controlroom ELSE DIALOG END hwCtrlharmO hwCtrlharmO = 0 END IF END SUB CALLBACK FUNCTION CB_harmO_Controlroom () LOCAL wind AS BYTE LOCAL valve AS SINGLE LOCAL i AS LONG LOCAL note AS BYTE SELECT CASE CBMSG CASE %WM_COMMAND SELECT CASE CBCTL CASE harmO.Lowtes TO harmO.hightes 'note checkboxes CONTROL GET CHECK CBHNDL, CBCTL TO i note = CBCTL Play harmO.channel, note, BYVAL i CASE 600 'all off Controller harmO.channel, 123, %False FOR i = harmO.lowtes TO harmO.hightes CONTROL SET CHECK CBHNDL, i, 0 SLEEP 10 DIALOG DOEVENTS NEXT harmO.ctrl(7) = %False Controller harmO.channel, 7, harmO.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 hharmOWindTrackBar '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) harmO.ctrl(7) = wind Controller harmO.channel, 7, harmO.ctrl(7) END SELECT CASE %WM_CLOSE, %WM_QUIT hwCtrlharmO = 0 Controller harmO.channel, 123, %False harmO.ctrl(7) = %False Controller harmO.channel, 7, harmO.ctrl(7) END SELECT END FUNCTION SUB HarmO_registers () ' adapted to harmO by KL. 20.11.2009 LOCAL i AS LONG LOCAL x AS LONG LOCAL label$() LOCAL b$ IF ISFALSE hwRegharmO THEN DIM label$(8) ARRAY ASSIGN label$() = "cor2'", "dia8'", "bour16'", "prin4'","sub32'","vl 4'", "forte8'", "clar16'", "oboe8'" DIALOG NEW 0, "HarmO Registers",1,150 ,400, 20, %WS_CAPTION OR %WS_POPUP OR %WS_SYSMENU TO hwRegharmO FOR i = 0 TO 8 CONTROL ADD CHECKBOX, hwRegHarmo, i+1, label$(i), 1 + 42 * i, 1, 40, 12, %BS_PUSHLIKE NEXT DIALOG SHOW MODELESS hwRegharmO CALL CB_harmOReg ELSE DIALOG END hwCtrlharmO hwCtrlharmO = 0 END IF END SUB CALLBACK FUNCTION CB_HarmoReg LOCAL i AS LONG SELECT CASE CBMSG CASE %WM_COMMAND SELECT CASE CBCTL CASE 1 TO 9 CONTROL GET CHECK CBHNDL, CBCTL TO i controller HarmO.channel, 69 + CBCTL, i END SELECT END SELECT END FUNCTION MACRO regprot(pr1) 'register task prototype LOCAL labels() AS ASCIIZ * 8 LOCAL i AS LONG STATIC slnr AS DWORD STATIC flip AS BYTE IF ISFALSE Task(%regs + pr1).tog THEN DIM labels(0) labels(0)="speed" IF ISFALSE(Task(%regs+pr1).hParam) THEN MakeTaskParameterDialog %regs+pr1,1,Slider(),0,UDctrl(),Labels() slnr = TaskEX(%regs+pr1).SliderNumbers(0) Slider(slnr).value = 20 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, 20 Task(%regs+pr1).freq = .3 Task(%regs + pr1).tog = 1 END IF BIT TOGGLE flip, 0 HarmO.ctrl(70+pr1) = flip Controller Harmo.channel, 70+pr1, flip Task(%regs+pr1).freq = .2 + Slider(slnr).value / 20 END MACRO SUB horeg0 regprot(0) END SUB SUB horeg1 regprot(1) END SUB SUB horeg2 regprot(2) END SUB SUB horeg3 regprot(3) END SUB SUB horeg4 regprot(4) END SUB SUB horeg5 regprot(5) END SUB SUB horeg6 regprot(6) END SUB SUB horeg7 regprot(7) END SUB SUB horeg8 regprot(8) END SUB SUB harmo_repeat () ' task %pprep - tests repeated notes. ' parameters: repetition rate ' push-time ' release-time ' velocity ' note STATIC slnr AS DWORD STATIC j AS DWORD STATIC i AS INTEGER LOCAL onoff AS SINGLE LOCAL period AS SINGLE IF ISFALSE Task(%harmorep).tog THEN DIM TaskParamLabels(0 TO 4) AS ASCIIZ * 8 ARRAY ASSIGN TaskParamLabels() = "Tempo", "Level", "On/Off", "Note", "Prog" IF ISFALSE Task(%harmorep).hParam THEN slnr = %False MakeTaskParameterDialog %harmorep,3,Slider(),2,UDctrl(),TaskParamLabels() END IF IF ISFALSE slnr THEN slnr = TaskEX(%harmorep).SliderNumbers(0) UDctrl(TaskEX(%harmorep).UpdownNumbers(0)).cptr = CODEPTR(Harmo_Note_UD1) ' note i = 60 UDctrl(TaskEX(%harmorep).UpDownNumbers(0)).value = i UDCtrl(TaskEX(%harmorep).UpdownNumbers(1)).cptr = CODEPTR(Harmo_Prog_UD2) UDctrl(TaskEX(%harmorep).UpDownNumbers(1)).value =1 j = 0 Task(%harmorep).freq = 2 Slider(slnr).value = Task(%harmorep).freq SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value Slider(slnr+1).value = 4 SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, 4 ' low level on init. Slider(slnr+2).value = 64 SendMessage Slider(Slnr+2).h, %TBM_SETPOS,%True, 64 ' mid position END IF j = %False Task(%harmorep).tog = %True EXIT SUB 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 Harmo.channel, i, Slider(slnr+1).value period = period * OnOff ELSE NoteOff Harmo.channel, i i = UDctrl(TaskEX(%harmorep).UpDownNumbers(0)).value period = period * (1! - OnOff) END IF Task(%harmorep).freq = MAX(MIN(1! / period, 1000),1) INCR j j = j MOD 2 END SUB SUB Harmo_Note_UD1 () ' controls the note to be played. LOCAL noot AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%harmorep).UpDownNumbers(0) noot = UDCtrl(udnr).value IF noot < Harmo.lowtes THEN UDctrl(udnr).value = Harmo.lowtes : noot = Harmo.lowtes IF noot > Harmo.hightes THEN UDctrl(udnr).value = Harmo.hightes : noot = Harmo.hightes SetDlgItemText Task(%harmorep).hparam, %GMT_TEXT0_ID + 16, "n=" & STR$(noot) END SUB SUB Harmo_Prog_UD2 LOCAL udnr AS LONG LOCAL vl AS LONG udnr = TaskEX(%harmorep).UpDownNumbers(1) vl = UDCtrl(udnr).value IF vl = 2 THEN vl = 122 IF vl > 127 THEN vl = 1 IF vl = 121 THEN vl = 1 UDCtrl(udnr).value = vl ProgChange Harmo.channel, vl SetDlgItemText Task(%harmorep).hparam, %GMT_TEXT0_ID + 17, "p=" & STR$(vl) END SUB SUB HarmO_AM () ' controller 1 test task STATIC slnr AS DWORD STATIC cnt AS LONG IF ISFALSE Task(%h_am).tog THEN Task(%h_am).tog = %True ' create a parameter window automatically: ' The handle for this window will be returned in Task(Tasknr).hParam DIM TaskParamLabels(0 TO 2) AS ASCIIZ * 8 ARRAY ASSIGN TaskParamLabels() = "Min", "Max", "Freq" IF ISFALSE Task(%h_am).hParam THEN MakeTaskParameterDialog %h_am,3,Slider(),0,UDctrl(),TaskParamLabels() END IF slnr = TaskEX(%h_am).SliderNumbers(0) SendMessage Slider(Slnr ).h, %TBM_SETPOS,%True, 24 SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, 100 SendMessage Slider(slnr+2).h, %TBM_SETPOS,%True, 64 EXIT SUB END IF SELECT CASE cnt MOD 3 CASE 0 Controller HarmO.channel, 1, Slider(slnr).value CASE 1 ' midposition. Controller HarmO.channel, 1, (Slider(slnr).value + slider(slnr+1).value) / 2 CASE 2 Controller HarmO.channel, 1, Slider(slnr+1).value END SELECT INCR cnt Task(%h_am).freq = MAX(Slider(slnr+2).value / 32, 0.05) END SUB '[eof]