'code voor eindproject Barbara 'we use a lot of procs from machiewall.inc here 'also needs machinewall.bi DECLARE FUNCTION Init_BB () AS LONG 'DECLARE SUB BB_overtones(OPT BYVAL hwin AS LONG) > nu in machinewall.inc DECLARE SUB BB_glisss(OPT BYVAL hwin AS LONG) 'DECLARE FUNCTION Init_bbovertones AS LONG DECLARE FUNCTION init_bbglisss AS LONG DECLARE SUB end_bbglisss '(hw AS LONG) DECLARE SUB BB_PrepareTasks #IF NOT %DEF(%bb) %bb = 32 #ENDIF %bb_g = 33 FUNCTION Init_BB () AS LONG LOCAL m AS ASCIIZ * 40 LOCAL i AS BYTE, j AS BYTE LOCAL p AS DWORD LOCAL hw AS LONG 'dim globals DIM TesWeight(12) 'range[note 55 - 125] in fourths DIM Mc(12) 'overdone in initinstruments but seems to need 2 b dimmed here also.. DIM hWKey(UBOUND(mc)) 'el(5) = bourdon!!!, 3 = tw + troms, otherwise same nrs as machine()... m = "eindprojekt Barbara": SendMessage gh.Cockpit, %WM_SETTEXT,0, VARPTR(m) MW_Initinstruments BYREF mc() ' switch off the flag for auto-patching BIT RESET App.AutoFlags, 0 ' RESETs bit 0 (%AUTOPATCH) ' this suppresses automatic sending of program-change msg's to ' the synth on StartTask commands. IF ISFALSE hMidiO(4) THEN MSGBOX "five midi outputs required!!",,FUNCNAME$ ' ' new: ' p = GetSonarPointer: sr = p ' ' ' DIM DataBuf0(255) AS GLOBAL INTEGER AT @sr.pb(0): DIM DataBuf1(255) AS GLOBAL INTEGER AT @sr.pb(1): DIM DataBuf2(255) AS GLOBAL INTEGER AT @sr.pb(2) ' DIM DataBuf3(255) AS GLOBAL INTEGER AT @sr.pb(3): DIM DataBuf4(255) AS GLOBAL INTEGER AT @sr.pb(4): DIM DataBuf5(255) AS GLOBAL INTEGER AT @sr.pb(5) ' DIM DataBuf6(255) AS GLOBAL INTEGER AT @sr.pb(6): DIM DataBuf7(255) AS GLOBAL INTEGER AT @sr.pb(7) '' ' ' IF ISFALSE DAQparams.mode THEN MSGBOX "Daqparams mode not set!",,FUNCNAME$ ' i = Sonar_DAQ (%DAQ_DOUBLEBUFFER) ' i = Prepare_DAQ_Hardware ("c:\b\pb\gmt\kristof\machinewall\mw.cfg") ' in g_Nih.dll - we use machinewall init for now.. ' IF ISFALSE i THEN: MSGBOX "Error: DAQ hardware preparation failed",, FUNCNAME$ + "@bb.inc" ' ' add labels to the sliders in the cockpit: ' SetDlgItemText gh.Cockpit,%GMT_TEXT_SLIDER0, "Sens" & CHR$(0) ' SetDlgItemText gh.CockPit,%GMT_TEXT_SLIDER1, "dT" & CHR$(0) DAQparams.mode = %DAQ_NI DIM pr(3) AS GLOBAL RadarType PTR FOR i = 0 TO 3 p = GetRadarPointer (i): pr(i) = p @pr(i).noise = 3 @pr(i).dt = 4 @pr(i).sfakt = 2 ' divisor for surface value in dll. @pr(i).dta = 15 ' integration time for slow amplitudes used for position determination with %Zerocross algo @pr(i).params = %ZEROCROSS ' new version 28.03.2003 @pr(i).setup = %SQUARE NEXT i Daqparams.channel = %DAQ_RADAR Radar_DAQ %False ' SetDlgItemText gh.Cockpit,%GMT_TEXT_SLIDER0, "Sfak" & CHR$(0) ' sets scaling factor for surface ' SetDlgItemText gh.CockPit,%GMT_TEXT_SLIDER1, "dT" & CHR$(0) ' sets dT in @pr(i).dt ' Slider(0).cPtr = CODEPTR(Quadrada_Sens_Slider) ' Slider(1).cPtr = CODEPTR(Quadrada_dt_Slider) ' SendMessage Slider(0).h, %TBM_SETPOS,%True,2 ' adjust slider position to setting for scaling ' SendMessage Slider(1).h, %TBM_SETPOS,%True, @pr(0).dT ' adjust slider position 'silence procs reside in machinewall code ButnOS(1).tag = "BrdPanic": ButnOS(1).cptr = CODEPTR(MM_Bourdonola_Off) 'Bourd_silence) '%False ButnOS(2).tag = "PipPanic": ButnOS(2).cptr = CODEPTR(MM_Piperola_Off) 'Piper_silence) ButnOS(3).tag = "HumPanic": ButnOS(3).cptr = CODEPTR(MM_Humanola_Off) 'Huma_silence) ButnOS(4).tag = "TWPanic": ButnOS(4).cptr = CODEPTR(MM_Thunderwood_Off) 'TW_silence) ButnOS(5).tag = "HarmaPanic": ButnOS(5).cptr = CODEPTR(MM_Harma_Off) 'Harma_silence) ButnOs(6).tag = "PiaPanic": ButnOs(6).cptr = CODEPTR(MM_Piano_Off) 'Piano_Silence) ButnOs(7).tag = "SirenPanic": ButnOs(7).cptr = CODEPTR(MM_Springers_Off) 'Springers_Silence) ButnOs(8).tag = "SoPanic":ButnOs(8).cptr = CODEPTR(MM_So_Off) 'So_Silence) ButnOs(9).tag = "FlexPanic":ButnOs(9).cptr = CODEPTR(MM_Flex_Off) 'Flex_silence) BB_PrepareTasks LOCAL hwvkc AS LONG DIALOG NEW gh.Cockpit, "Tog Windows", 1, 1, 62, (UBOUND(mc) + 1) * 15 TO hwvkc FOR i = 0 TO UBOUND(mc) CONTROL ADD BUTTON, hwvkc, i, "&"+mc(i).naam, 1, 1 + i * 15, 60, 12, %BS_FLAT OR %WS_TABSTOP CALL ProcManageWindows NEXT DIALOG SHOW MODELESS hwvkc ' Create_Sonar_Control_Task BYVAL sr, Slider(),UDctrl() ' task 10 (pseudotask) 20.09.2003 Create_Radar_Control_Task (BYVAL pr(0), Slider(),UDCtrl()) Radar_DAQ %DAQ_DOUBLEBUFFER #IF %DEF(%BB_DEBUGGERON) idbg = kl_debug(%kl_dbg_new, "BB Main Debug") kl_debug %kl_dbg_size, STR$(idbg)+", 50, 50, 150, 300" kl_debug %kl_dbg_setcolor, STR$(idbg) + ", &H00AAAA, &H666666" kl_debug %kl_dbg_logfile, STR$(idbg) + ", c:\b\pb\gmt\kristof\machinewall\machwal.log" #ENDIF END FUNCTION SUB BB_PrepareTasks LOCAL i AS LONG Task(0).naam = "": Task(0).cPtr = %False Task(App.WriteSeqScoreTaskNr).naam = "": Task(App.WriteSeqScoreTaskNr).cptr = %False ' Task(%Sonar_VU_Task).naam = "" ' 1 ' Task(%Sonar_VU_Task).cPtr = GetProcAddress(GetModuleHandle("g_nih.dll"),"SONAR_II_VU") ' Task(%Sonar_VU_Task).freq = 3 ' Task(%Sonar_Display_Task).naam = "" ' Task(%Sonar_Display_Task).cPtr = GetProcAddress(GetModuleHandle("g_nih.dll"),"SONAR_DISPLAY") ' Task(%Sonar_Display_Task).freq = 20 Task(%QuadRadar_screen).naam = "Display" Task(%QuadRadar_screen).cPtr = CODEPTR(MW_Radar_Screen): Task(%QuadRadar_screen).freq = 16 ' good video speed. Task(%Sonar_VU_Task).naam = "" ' 1 Task(%Sonar_VU_Task).cPtr = CODEPTR(MW_radar_ii_VU): Task(%Sonar_VU_Task).freq = 16 Task(%Sonar_Display_Task).naam ="BarMon" Task(%Sonar_Display_Task).cPtr = CODEPTR(MW_radar_Mon): Task(%Sonar_Display_Task).freq = 16 Task(%bb).naam = "harmonics" Task(%bb).freq = 8 Task(%bb).cptr = CODEPTR(BB_overtones) TaskEx(%bb).startcptr = CODEPTR(toggle_bbovertones) TaskEx(%bb).stopcptr = CODEPTR(toggle_bbovertones) Task(%bb_g).naam = "glisss" Task(%bb_g).freq =8 Task(%bb_g).cptr = CODEPTR(BB_Glisss) TaskEx(%bb_g).startcptr = CODEPTR(init_bbglisss) TaskEx(%bb_g).stopcptr = CODEPTR(end_bbglisss) Task(%PiPlay_Mov).naam = "piano_mov" Task(%PiPlay_Mov).freq = 5: Task(%PiPlay_Mov).cptr = CODEPTR(MW_PiPlay_Mov) TaskEX(%PiPlay_Mov).StopCptr = CODEPTR(MM_Piano_Off) 'Piano_Silence) Task(%Bour_Mov).naam = "Bour_Mov" Task(%Bour_Mov).freq = 5: Task(%Bour_Mov).cptr = CODEPTR(MW_BourPlay_Mov) TaskEX(%Bour_Mov).StopCptr = CODEPTR(MM_Piperola_Off) 'Piper_Silence) Task(%RG_Pi).naam = "RgPi Task(%RG_Pi).freq = 60: Task(%RG_Pi).cptr = CODEPTR(RobotGarden_Piano) TaskEx(%RG_Pi).stopcptr = CODEPTR(MM_Piano_Off) 'Piano_Silence) Task(%RG_Tubi).naam="rgTubi" Task(%Rg_Tubi).freq = 40: Task(%RG_Tubi).cptr = CODEPTR(RobotGarden_Tubi) Task(%RG_troms).naam = "RGTroms" Task(%RG_troms).freq = 4: Task(%RG_troms).cptr = CODEPTR(Robotgarden_Troms) TaskEX(%RG_troms).stopcptr = CODEPTR(MM_Piperola_Off) 'Piper_silence) Task(%imit_Lstn).naam="Imi_Lstn" Task(%Imit_Lstn).freq = 8: Task(%Imit_Lstn).cptr = CODEPTR(MW_Imit_Lstn) TaskEX(%Imit_Lstn).startcptr = CODEPTR(ToggleImitLstn): TaskEX(%Imit_Lstn).StopCptr = CODEPTR(ToggleImitLstn) Task(%RG_Direct).naam = "RG_direct" Task(%RG_Direct).freq = 20: Task(%RG_Direct).cptr = CODEPTR(RG_Direct) TaskEX(%RG_Direct).StartCptr = CODEPTR(ToggleRgDirect): TaskEX(%Rg_Direct).Stopcptr = CODEPTR(ToggleRgDirect) Task(%cqtlst).naam = "CQT2_lsn" Task(%cqtlst).freq = 100: Task(%cqtlst).channel = 0: Task(%cqtlst).cptr = CODEPTR(MW_Cqt_Listen) ' Task(%cqtctrl).naam = "CQT2-In" ' Task(%cqtctrl).cptr = CODEPTR(Cqt2_Ctrl): task(%cqtctrl).channel = &H0400: Task(%cqtctrl).freq = 4 Task(%cqtmon).naam = "CQT2-Mon" Task(%cqtmon).freq = 8: Task(%cqtmon).cptr = CODEPTR(Cqt_Mon) ' override settings from InitGlobalVariables in main module: App.GlobalHarmonyTaskNr = 15 FOR i = 0 TO UBOUND(Task) IF ISFALSE Task(i).flags AND %DLL_TASK THEN IF i > 15 THEN Task(i).flags = Task(i).flags OR %MIDI_TASK OR %SCORE_TASK IF i > App.GlobalHarmonyTaskNr THEN Task(i).flags = Task(i).flags OR %HARM_TASK END IF NEXT i END SUB '< moved to machinewall.inc> 'SUB BB_overtones(OPT BYVAL hwin AS LONG) ' 'task freq = 8 ' STATIC ihar AS Harmtype ' STATIC this AS LONG ' STATIC lastnote1 AS BYTE ' STATIC lastnote2 AS BYTE ' STATIC countsincenew1 AS LONG ' STATIC countsincenew2 AS LONG ' STATIC countsincenew3 AS LONG ' STATIC localcount AS LONG ' STATIC hw AS LONG ' STATIC pattern AS DWORD ' LOCAL i AS LONG ' LOCAL nf AS SINGLE ' IF ISFALSE this THEN this = %bb ' IF hwin THEN ' IF hwin = -1 THEN ' hw=0 ' EXIT SUB ' ELSE ' hw = hwin ' END IF ' END IF ' IF ISFALSE hw THEN StopTask this: EXIT SUB ' ' 'vaste freq, ritmisch patroon afhankelijk van input dens ' INCR localcount: localcount = localcount MOD 32 ' SELECT CASE MW_MidiIn.dens ' CASE < .5 '.2 ' pattern = 1 ' CASE < 1 '.5 ' pattern = &B100000001 ' CASE < 2 '1 ' pattern = &B10000010000000100000001 ' CASE < 3 '2 ' pattern = &B10001000001010001000010010001000 ' CASE < 5 '4 ' pattern = &B10101001001010101001010010101010 ' CASE < 8 '6 ' pattern = &B10101101001101101001010011101010 ' CASE < 13 ' pattern = &B10101101011101101101011011101110 ' CASE > 17 ' pattern = NOT 0 ' CASE ELSE ' pattern = &B11101101011101101110111011101110 ' END SELECT ' IF ISFALSE BIT(pattern, localcount) THEN EXIT SUB ' CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "dens:" + STR$(MW_MidiIn.dens) ' CONTROL SET TEXT gh.cockpit, %GMT_MSG2, "grounds:" + STR$(lastnote1) + STR$(lastnote2) ' ' ihar.vel = ReturnStrongestInHar(Task(%cqtLst).Har, 8) 'we ask for a lot of notes, as sometimes harmonics tend to ' 'display stronger than their ground tone... ' 'We allwayst take the two lowest 2 notes from har ' FOR i = 48 TO 88 ' IF i = lastnote2 THEN ITERATE FOR ' IF ASC(MID$(ihar.vel, i, 1)) > 12 THEN ' IF i<> lastnote1 THEN countsincenew1 = 0: countsincenew3 = 0 ' lastnote1 = i ' MID$(ihar.vel, i, 21) = CHR$(0, 0) ' EXIT FOR ' END IF ' NEXT ' FOR i = 48 TO 88 ' IF i = lastnote1 THEN ITERATE FOR ' IF ASC(MID$(ihar.vel, i, 1)) > 12 THEN ' IF i<> lastnote2 THEN countsincenew2 = 0 ' lastnote2 = i: EXIT FOR ' END IF ' NEXT ' CONTROL GET CHECK hw, 1 TO i 'piano ' IF i THEN ' SELECT CASE (localcount AND 1) ' CASE 0 ' INCR countsincenew1: IF countsincenew1 > 14 THEN countsincenew1 = 1 ' i = F2N(countsincenew1 * NF2F(lastnote1)) ' CASE 1 ' INCR countsincenew2: IF countsincenew2 > 14 THEN countsincenew2 = 1 ' i = F2N(countsincenew2 * NF2F(lastnote2)) ' END SELECT ' DO WHILE i > mc(7).HighTes: i = i - 12: LOOP ' AddNote2Har mc(7).Har(1), i, MW_MidiIn.vol * .5 ' InstrumPlay mc(7) ' END IF ' CONTROL GET CHECK hw, 2 TO i 'vibi ' IF i THEN ' SELECT CASE (localcount AND 1) ' CASE 0 ' INCR countsincenew1: IF countsincenew1 > 14 THEN countsincenew1 = 1 ' i = F2N(countsincenew2 * NF2F(lastnote2)) ' CASE 1 ' INCR countsincenew2: IF countsincenew2 > 14 THEN countsincenew2 = 1 ' i = F2N(countsincenew1 * NF2F(lastnote1)) ' END SELECT ' DO WHILE i > mc(0).HighTes: i = i - 12: LOOP ' DO WHILE i < mc(0).LowTes: i = i + 12: LOOP ' AddNote2Har mc(0).Har(1), i, MW_MidiIn.vol '* .7 ' InstrumPlay mc(0) ' END IF ' CONTROL GET CHECK hw, 3 TO i 'tubi ' IF i THEN ' SELECT CASE (localcount AND 1) ' CASE 0 ' INCR countsincenew3: IF countsincenew3 > 24 THEN countsincenew3 = 1 ' nf = F2NF(countsincenew3 * NF2F(lastnote2)) ' CASE 1 ' INCR countsincenew3: IF countsincenew3 > 24 THEN countsincenew3 = 1 ' nf = F2NF(countsincenew3 * NF2F(lastnote1)) ' END SELECT ' DO WHILE nf > mc(10).HighTes: nf = nf - 12: LOOP ' DO WHILE nf < 72: nf = nf + 12: LOOP ' IF FRAC(nf) >= .5 THEN nf = INT(nf) - 36 ' AddNote2Har mc(10).Har(1), nf, MW_MidiIn.vol * .4 ' InstrumPlay mc(10) ' END IF 'END SUB ' SUB BB_glisss(OPT BYVAL hwin AS LONG) STATIC hw AS LONG STATIC this AS LONG STATIC note() AS BYTE STATIC SCALE() AS BYTE STATIC velo AS BYTE STATIC timout AS SINGLE LOCAL selins AS LONG LOCAL x AS LONG LOCAL i AS LONG, j AS LONG, b$ IF ISFALSE this THEN progchange mc(4).channel, 15 this = %bb_g DIM note(4): DIM SCALE(4) note(0) = mc(7).lowtes: note(1) = mc(0).lowtes: note(2) = mc(10).lowtes: note(3) = mc(4).lowtes: note(4) = mc(2).lowtes END IF IF hwin THEN IF hwin = -1 THEN DIALOG END hw: hw=0: EXIT SUB hw = hwin END IF IF ISFALSE hw THEN StopTask this: EXIT SUB ' @sr.noise = Slider(0).value ' IF ISFALSE @sr.noise THEN @sr.noise = 10 x =INT(MAX(@pr(0).acf, @pr(1).acf, @pr(2).acf, @pr(3).acf) * 4) ' @sr.xyzac ' shift right x, 5 modemess mc(4).channel, 7, 100 'MIN(x, 100) IF (timout < TIMER) AND (x > @pr(0).noise * 4) THEN i = 0: selins = INT(RND * 4) DO INCR selins: IF selins > 4 THEN selins = 0 INCR i: IF i > 5 THEN GOTO selok ' FOR i = 0 TO 4 CONTROL GET CHECK hw, (selins + 1) TO j IF ISFALSE j THEN ITERATE LOOP IF SCALE(selins) THEN ITERATE LOOP task(this).freq = MIN(5, MAX(.5, x / 5)) timout = TIMER + 4 / task(this).freq velo = MIN(60, MAX(20, INT(x))) SELECT CASE x CASE < 15: SCALE(selins) = 3 'fibonacci + 1 as 1 means note off CASE < 30: SCALE(selins) = 4 CASE < 45: SCALE(selins) = 6 CASE < 60: SCALE(selins) = 9 CASE < 90: SCALE(selins) = 14 CASE ELSE: SCALE(selins) = 22 END SELECT GOTO selok 'NEXT LOOP END IF selok: CONTROL GET TEXT hw, 100 TO b$: j = VAL(b$) SELECT CASE SCALE(0) 'piano CASE > 1 mPlay mc(7).channel, note(0), 0 note(0) = note(0) + j IF note(0) >= mc(7).hightes THEN note(0) = mc(7).lowtes SCALE(0) = 0 EXIT SELECT END IF mPlay mc(7).channel, note(0), velo * .5 DECR SCALE(0) CASE 1 mPlay mc(7).channel, note(0), 0 note(0) = mc(7).lowtes + RND * (mc(7).hightes - mc(7).lowtes) / 2 DECR SCALE(0) END SELECT SELECT CASE SCALE(1) 'vibi CASE > 1 mPlay mc(0).channel, note(1), 0 note(1) = note(1) + j IF note(1) >= mc(0).hightes THEN note(1) = mc(0).lowtes SCALE(1) = 0 EXIT SELECT END IF mPlay mc(0).channel, note(1), velo DECR SCALE(1) CASE 1 mPlay mc(0).channel, note(1), 0 note(1) = mc(0).lowtes + RND * (mc(0).hightes - mc(0).lowtes) / 2 DECR SCALE(1) END SELECT SELECT CASE SCALE(2) 'tubi CASE > 1 mPlay mc(10).channel, note(2), 0 note(2) = note(2) + j IF note(2) < 72 THEN note(2) = note(2) + 36 ELSE note(2) = note(2) - 36 END IF IF note(2) >= mc(10).hightes THEN note(2) = mc(10).lowtes SCALE(2) = 0 EXIT SELECT END IF mPlay mc(10).channel, note(2), velo * .4 DECR SCALE(2) CASE 1 mPlay mc(10).channel, note(2), 0 note(2) = 72 + RND * 18 DECR SCALE(2) END SELECT SELECT CASE SCALE(3) 'harma CASE > 1 mPlay mc(4).channel, note(3), 0 note(3) = note(3) + j IF note(3) >= mc(4).hightes THEN note(3) = mc(4).lowtes SCALE(3) = 0 EXIT SELECT END IF mPlay mc(4).channel, note(3), velo DECR SCALE(3) CASE 1 mPlay mc(4).channel, note(3), 0 note(3) = mc(4).lowtes + RND * (mc(4).hightes - mc(4).lowtes) / 2 DECR SCALE(3) END SELECT SELECT CASE SCALE(4) 'bourdon CASE > 1 mPlay mc(2).channel, note(4), 0 note(4) = note(4) + j IF note(4) > 60 THEN note(4) = mc(2).lowtes SCALE(4) = 0 EXIT SELECT END IF mPlay mc(2).channel, note(4), 40 DECR SCALE(4) CASE 1 mPlay mc(2).channel, note(4), 0 note(4) = mc(2).lowtes + RND * (60 - mc(2).lowtes) / 2 DECR SCALE(4) END SELECT END SUB FUNCTION init_bbglisss AS LONG LOCAL hw AS LONG DIM item(4) AS LOCAL STRING ' FOR hw = 0 TO 3: item(hw) = STR$(hw + 2): NEXT item(0)="2": item(1)="3":item(2)="5": item(3)="6": item(4)="7" DIALOG NEW gh.Cockpit, "Instr",0,0,82, 119 TO hw CONTROL ADD CHECKBOX, hw, 1, "piano", 1, 1, 48, 12 CONTROL ADD CHECKBOX, hw, 2, "vibi", 1, 14, 48, 12 CONTROL ADD CHECKBOX, hw, 3, "tubi", 1, 28, 48, 12 CONTROL ADD CHECKBOX, hw, 4, "harma", 1, 42, 48, 12 CONTROL ADD CHECKBOX, hw, 5, "bourdonola", 1, 56, 48, 12 CONTROL ADD COMBOBOX, hw, 100, item(), 1, 70, 48, 60, %CBS_DROPDOWNLIST COMBOBOX SELECT hw, 100, 1 DIALOG SHOW MODELESS hw FUNCTION = hw BB_glisss hw END FUNCTION SUB end_bbglisss '(hw as long) ' dialog end hw BB_Glisss -1 MM_Piano_Off 'Piano_silence MM_Bourdonola_Off 'bourd_silence MM_Harma_Off 'harma_silence MM_Piperola_Off 'piper_silence END SUB ' 'FUNCTION Init_bbovertones AS LONG ' LOCAL hw AS LONG ' DIALOG NEW gh.Cockpit, "Instr",0,0,82, 119 TO hw ' CONTROL ADD CHECKBOX, hw, 1, "piano", 1, 1, 48, 12 ' CONTROL ADD CHECKBOX, hw, 2, "vibi", 1, 14, 48, 12 ' CONTROL ADD CHECKBOX, hw, 3, "tubi", 1, 28, 48, 12 ' DIALOG SHOW MODELESS hw ' FUNCTION = hw ' BB_overtones hw 'END FUNCTION '