' *********************************************************************** ' * machinewall/RobotGarden * ' *********************************************************************** '020522 separated from mim.inc ' all declares are in gmt_bom.bi '020830 virtual keyboards etc moved to mw_gui.inc '%MW_DEBUGGERON = 1 '%MW_DEBUGUDP = 1 DECLARE SUB udpecho(BYVAL b AS STRING) FUNCTION Init_Machinewall () AS LONG LOCAL m AS ASCIIZ * 40 LOCAL i AS BYTE, j AS BYTE LOCAL p AS DWORD LOCAL hw AS LONG LOCAL rs AS LONG #IF %DEF(%MW_DEBUGGERON) TRACE NEW FUNCNAME$ + ".dat": TRACE ON #ELSE TRACE OFF #ENDIF 'dim globals DIM TesWeight(12) 'range[note 55 - 125] in fourths DIM mc(13) '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 mc()... cqt_init m = "": 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 DAQParams.ID THEN DIALOG NEW gh.setup, "MW Setup", , , 200, 50 TO hw CONTROL ADD LABEL, hw, -1, "Please select movement sensing technology", 3, 3, 194, 12 CONTROL ADD BUTTON, hw, %MW_MODE_SONAR, "&sonar", 3, 18, 30, 12, %BS_FLAT CONTROL ADD BUTTON, hw, %MW_MODE_RADAR, "&radar", 36, 18, 30, 12, %BS_FLAT DIALOG SHOW MODAL hw CALL CB_MWSetup TO rs MW_MODE = rs END IF #IF %DEF(%multiport) IF ISFALSE hMidiO(4) THEN MSGBOX "five midi outputs required in this compilation!!",,FUNCNAME$ #ENDIF IF ISFALSE hMidiI(0) THEN MSGBOX "one midi inport 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 (MW_MODE AND %MW_MODE_SONAR) THEN 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 IF ISFALSE i THEN: MSGBOX "Error: DAQ hardware preparation failed",, FUNCNAME$ + "@machinewall.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) END IF IF (MW_MODE AND %MW_MODE_RADAR) THEN DAQparams.mode = %DAQ_NI DIM pr(4) AS GLOBAL RadarType PTR FOR i = 0 TO 4 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 ' new in g_nih.dll, should set everything to the hardware: 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 Create_Radar_Control_Task (BYVAL pr(0), Slider(),UDCtrl()) Radar_DAQ %DAQ_DOUBLEBUFFER END IF ButnOS(1).tag = "BrdPanic": ButnOS(1).cptr = CODEPTR(Bourd_silence) '%False ButnOS(2).tag = "PipPanic": ButnOS(2).cptr = CODEPTR(Piper_silence) ButnOS(3).tag = "HumPanic": ButnOS(3).cptr = CODEPTR(Huma_silence) ButnOS(4).tag = "TWPanic": ButnOS(4).cptr = CODEPTR(TW_silence) ButnOS(5).tag = "HarmaPanic": ButnOS(5).cptr = CODEPTR(Harma_silence) ButnOs(6).tag = "PiaPanic": ButnOs(6).cptr = CODEPTR(Piano_Silence) ButnOs(7).tag = "SirenPanic": ButnOs(7).cptr = CODEPTR(Springers_Silence) ButnOs(8).tag = "SoPanic":ButnOs(8).cptr = CODEPTR(So_Silence) ButnOs(9).tag = "FlexPanic":ButnOs(9).cptr = CODEPTR(Flex_silence) ButnOs(10).tag = "TrumpPanic": ButnOs(10).cptr = CODEPTR(Trump_Silence) ButnOs(11).tag= "HurdyPanic": ButnOs(11).cptr = CODEPTR(Hurdy_Silence) MW_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 #IF %DEF(%MW_DEBUGGERON) idbg = kl_debug(%kl_dbg_new, "Machinewall 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 #IF %DEF(%MW_DEBUGUDP) g_net_setservercptr CODEPTR(UDPecho) #ENDIF END FUNCTION CALLBACK FUNCTION CB_MWSetup IF CBMSG <> %WM_COMMAND THEN EXIT FUNCTION IF CBCTLMSG <> %BN_CLICKED THEN EXIT FUNCTION FUNCTION = CBCTL DIALOG END CBHNDL, CBCTL END FUNCTION SUB MW_PrepareTasks LOCAL i AS LONG Task(0).naam = "": Task(0).cPtr = %False Task(App.WriteSeqScoreTaskNr).naam = "": Task(App.WriteSeqScoreTaskNr).cptr = %False Task(%machinewall).naam = "machwall" Task(%machinewall).freq = 3: task(%machinewall).cptr = CODEPTR(MachWall1) Task(%vibiwolk).naam = "vibiwolk" Task(%vibiwolk).freq = 5: Task(%vibiwolk).cptr = CODEPTR(MW_VibiWolk) IF (MW_MODE AND %MW_MODE_SONAR) THEN 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(%VibW_Mov).naam = "VibW_Mov" Task(%VibW_Mov).freq = 5: Task(%VibW_Mov).cptr = CODEPTR(MW_Vibiwolk_Mov) Task(%HarmW_Mov).naam = "HarmW_Mov" Task(%HarmW_Mov).freq = 5: Task(%HarmW_Mov).cptr = CODEPTR(MW_Harmawolk_Mov) Task(%PiPlay_Mov).naam = "piano_mov" Task(%PiPlay_Mov).freq = 5: Task(%PiPlay_Mov).cptr = CODEPTR(MW_PiPlay_Mov) TaskEX(%PiPlay_Mov).StopCptr = CODEPTR(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(Piper_Silence) END IF IF (MW_MODE AND %MW_MODE_RADAR) THEN 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 END IF Task(%RG_TW).naam = "RGThund" Task(%RG_TW).freq = 4: Task(%RG_TW).cptr = CODEPTR(Robotgarden_Thunderwood) TaskEx(%RG_TW).stopcptr = CODEPTR(TW_Silence) Task(%RG_Pi).naam = "RgPi Task(%RG_Pi).freq = 60: Task(%RG_Pi).cptr = CODEPTR(RobotGarden_Piano) TaskEx(%RG_Pi).stopcptr = CODEPTR(Piano_Silence) Task(%Brecht).naam = "Brecht" Task(%Brecht).freq = 60: Task(%Brecht).cptr = CODEPTR(Brecht) TaskEx(%Brecht).stopcptr = CODEPTR(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(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(%mw_tw).naam = "Wnd+Rain" Task(%mw_tw).freq = 20:Task(%mw_tw).cptr = CODEPTR(Mw_Tw_WindRain) TaskEX(%mw_tw).stopcptr = CODEPTR(TW_Silence) Task(%mw_storm).naam = "storm" Task(%mw_storm).freq = 15: Task(%mw_storm).cptr = CODEPTR(Mw_Storm) TaskEx(%mw_storm).stopcptr = CODEPTR(TW_Silence) Task(%rg_drone).naam = "drone" Task(%rg_drone).freq = 5: Task(%rg_drone).cptr = CODEPTR(RG_Drone) TaskEx(%rg_drone).stopcptr = CODEPTR(ToggleDrone): TaskEx(%rg_drone).startcptr = CODEPTR(ToggleDrone) Task(%klanklagen2).naam = "klanklagen2" Task(%klanklagen2).freq = 5: Task(%klanklagen2).cptr = CODEPTR(Klanklagen2) TaskEx(%klanklagen2).StopCptr = CODEPTR(ToggleKlanklagen2): TaskEx(%klanklagen2).StartCptr = CODEPTR(ToggleKlanklagen2) Task(%RG_Flex).naam = "RG_Flex" Task(%RG_Flex).freq = 5: Task(%RG_Flex).cptr = CODEPTR(RG_Flex): TaskEx(%RG_Flex).StopCptr = CODEPTR(Flex_Silence) Task(%RG_Direct).naam = "RG_direct" Task(%RG_Direct).freq = 20: Task(%RG_Direct).cptr = CODEPTR(RG_Direct) Task(%ES_Spri).naam = "es_Spri" Task(%ES_Spri).freq = 6: Task(%ES_Spri).cptr = CODEPTR(ES_Spri) TaskEx(%ES_Spri).stopcptr = CODEPTR(springers_silence) Task(%ES_Sax).naam = "es_Sax" Task(%ES_Sax).freq = 8: Task(%ES_Sax).cptr = CODEPTR(ES_Sax) 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(%trumpy).naam="ZTrump" Task(%trumpy).cptr = CODEPTR(ZuperTrump) Task(%trumpy).freq = 4 Task(%strispri).naam = "StriSpri" Task(%strispri).cptr = CODEPTR(StriSpri) Task(%strispri).freq = 12.6 TaskEX(%RG_Direct).StartCptr = CODEPTR(ToggleRgDirect): TaskEX(%Rg_Direct).Stopcptr = CODEPTR(ToggleRgDirect) Task(%cqtlst).naam = "CQT2_lsn" Task(%cqtlst).freq = 100: Task(%cqtlst).channel = cqt.inchannel: Task(%cqtlst).cptr = CODEPTR(Cqt_Listen) Task(%cqtlst).flags = Task(%cqtlst).flags OR %PERTIM_TASK Task(%cqtmon).naam = "CQT2-Mon" Task(%cqtmon).freq = 8: Task(%cqtmon).cptr = CODEPTR(Cqt_Mon) #IF %DEF(%MW_DEBUGGERON) Task(%wrmov).naam = "WrtMovDt" 'kl testproc Task(%wrmov).cptr = CODEPTR(Write_Movement) Task(%wrmov).freq = 30 #ENDIF #IF %DEF(%MW_DEBUGUDP) Task(%gnettest).naam = "TEST" Task(%gnettest).cptr = CODEPTR(testgnet): Task(%gnettest).freq = 1 #ENDIF Task(%PiBo_Lstn).naam = "PiBo_Lstn" Task(%PiBo_Lstn).freq = 5: Task(%PiBo_Lstn).cptr = CODEPTR(MW_PiBo_Lstn) TaskEx(%PiBo_Lstn).StartCptr = CODEPTR(Start_PiBo_Lstn): TaskEx(%PiBo_Lstn).StopCptr = CODEPTR(Stop_PiBo_Lstn) CQT.naam = "cqt" SetPitch2MidiPorts CQT, $gestroboIni, hMidiO(),hMidiI() ' reads all params from file ' 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 #IF %DEF(%MW_DEBUGUDP) SUB Testgnet STATIC chan AS WORD STATIC note AS BYTE ' g_net_setservercptr 0 IF ISFALSE(chan) THEN g_net_setservercptr CODEPTR(netintest) chan = 1 SHIFT LEFT chan, 12 chan = chan OR mc(%cHarma).channel note = 29 END IF ' g_net_send time$ + chr$(10), 1 ' mPlay chan, note, 0 g_net_send "orsendtime:" + STR$(timegettime), 1 IF note > 95 THEN note = 29 INCR note ' mPlay chan, note, 10 END SUB SUB udpecho(BYVAL b AS STRING) 'can cause feedback if wrongly used!! g_net_send "ECHO [" + b + "]", 1 END SUB SUB netintest(BYVAL b AS STRING) CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "NET: " + b END SUB #ENDIF SUB MachWall1 LOCAL mx AS INTEGER LOCAL x AS SINGLE LOCAL i AS LONG LOCAL curdir AS LONG LOCAL noot AS BYTE, vel AS BYTE LOCAL density AS SINGLE LOCAL s AS SINGLE STATIC oldmx AS INTEGER STATIC lastdir AS LONG STATIC midichan AS LONG STATIC MaxChan AS LONG STATIC ins AS LONG STATIC nexttime AS SINGLE STATIC LastNote AS BYTE STATIC this AS LONG STATIC TaskParamLabels() AS ASCIIZ * 8 IF ISFALSE this THEN DIM TaskParamLabels(1) this = %machinewall TaskParamLabels(0) = "density": TaskParamLabels(1) = "velo" MakeTaskParameterDialog BYVAL this,2,Slider(),0,UDctrl(),TaskParamLabels() task(this).tog = %true @sr.noise = 10 lastnote = 127 END IF @sr.noise = slider(0).value IF ISFALSE @sr.noise THEN @sr.noise = 10 ' default ' get density from slider 0 density = Slider(TaskEX(this).SliderNumbers(0) ).value / SLider(TaskEx(this).slidernumbers(0)).MaxVal #IF %DEF(%MW_DEBUGGERON) kl_debug idbg, "density:" + STR$(density) #ENDIF IF (oldmx > @sr.noise) AND (RND^2 > (density + .05) ) THEN EXIT SUB IF nexttime > TIMER THEN IF density < .2 THEN 'low density > only short notes IF lastnote = 0 THEN EXIT SUB delnote2har mc(ins).Har(1), lastnote InstrumPlay mc(ins) mc(ins).har(1).vel = mc(ins).har(0).vel lastnote = 0 END IF EXIT SUB END IF DIM AD(2) AS LOCAL INTEGER AD(0) = AvgStatArr(Databuf0(), s, Daqparams.scanfreq/4) 's = significance - we should check this... 'AD(0) = SR.??? ' @sr.xs = opp gezien van x, onafgezien afstand /xa = lowest level AD(1) = AvgStatArr(Databuf1(), s, Daqparams.scanfreq/4) 's = significance - we should check this... AD(2) = AvgStatArr(Databuf2(), s, Daqparams.scanfreq/4) 's = significance - we should check this... SHIFT RIGHT AD(0), 5: SHIFT RIGHT AD(1), 5: SHIFT RIGHT AD(2), 5 ' = bewegende massa mx = MAX(AD(0), AD(1), AD(2)) IF mx < @sr.noise THEN oldmx = mx: nexttime = TIMER + .1: EXIT SUB #IF %DEF(%MW_DEBUGGERON) kl_debug idbg, "max:" + STR$(mx) + " ( min: " + STR$(@sr.noise) + " )" #ENDIF IF density < .4 THEN 'low/medium density > put off every last note DelNote2Har mc(ins).Har(1), lastnote InstrumPlay mc(ins) mc(ins).har(1).vel = mc(ins).har(0).vel END IF SELECT CASE mx CASE AD(0): curdir = 0 CASE AD(1): curdir = 1 CASE AD(2): curdir = 2 END SELECT 'if movement direction changed/after long pause, change instrument IF (oldmx < @sr.noise) OR (Curdir <> lastdir) THEN 'select new instrument lastdir = curdir IF density <= .7 THEN 'unless density is high, mute previous instrument mc(ins).Har(1).vel = STRING$(127, CHR$(0)) InstrumPlay mc(ins) mc(ins).har(1).vel = mc(ins).har(0).vel END IF ins = INT (RND * MaxChan) IF MaxChan <= UBOUND(mc) THEN: INCR MaxChan: ins = MaxChan - 1 task(this).freq = MAX (.1, 1000 / mc(Ins).minduur) #IF %DEF(%MW_DEBUGGERON) kl_debug idbg, "freq" + STR$(task(this).freq) #ENDIF nexttime = nexttime + 3 * (1 - density) END IF 'select note close to last note IF BIT(mc(ins).patch, 0) THEN noot = lastnote + 20 * density - RND * 40 * density^ 1.2 'we allow it to wrap around - noot as byte ELSE noot = mc(ins).lowtes + RND * (mc(ins).hightes - mc(ins).lowTes) END IF DO WHILE noot < mc(ins).lowTes: noot = noot + 12: LOOP DO WHILE noot > mc(ins).highTes: noot = noot - 12: LOOP lastnote = noot vel = 15 + RND * MIN(SLider(TaskEX(this).SliderNumbers(0)).value, 85) IF ins = 4 THEN ModeMess mc(ins).channel, 7, vel 'volume ctrl AddNote2Har mc(Ins).Har(1), noot, vel 'slider for velo - limited(100) InstrumPlay mc(ins) mc(ins).har(1).vel = mc(ins).har(0).vel IF ISFALSE mc(ins).dur(0) THEN mc(ins).dur(0) = TIMER #IF %DEF(%MW_DEBUGGERON) kl_debug idbg, "ins, noot, vel:" + mc(ins).naam + STR$(noot) + STR$(vel) #ENDIF oldmx = mx nexttime = TIMER + .2 - density/10 IF density >= .7 THEN 'on highest densities notes are only muted after x seconds FOR i = LBOUND(mc) TO UBOUND(mc) IF mc(i).dur(0) AND (TIMER - mc(i).dur(0)) > 10 * density THEN mc(i).Har(1).vel = STRING$(127, CHR$(0)) mc(i).dur(0) = %false InstrumPlay mc(i) mc(i).har(1).vel = mc(i).har(0).vel nexttime = nexttime + 1 EXIT SUB 'avoid too much midi at at ime END IF NEXT END IF 'more overlap, less gaps later on (???slider) END SUB SUB Mw_Vibiwolk STATIC this AS LONG STATIC TaskParamLabels() AS ASCIIZ * 8 STATIC Intensity AS SINGLE STATIC CNote AS BYTE STATIC note AS BYTE, velo AS BYTE, wheel AS BYTE 'we assume velocities in range [10, 32] IF ISFALSE this THEN 'on init only this = %VibiWolk DIM TaskParamLabels(1) TaskPAramLabels(0) = "I" TaskParamLabels(1) = "Tess" MakeTaskParameterDialog BYVAL this,2,Slider(),0,UDctrl(),TaskParamLabels() Slider(TaskEx(this).Slidernumbers(0)).value = 0 Slider(TaskEx(this).Slidernumbers(1)).value = 64 SendMessage Slider(TaskEx(this).Slidernumbers(0)).h, %TBM_SETPOS,%True, Slider(TaskEx(this).Slidernumbers(0)).value SendMessage Slider(TaskEx(this).Slidernumbers(1)).h, %TBM_SETPOS,%True, Slider(TaskEx(this).Slidernumbers(1)).value END IF IF ISFALSE task(this).tog THEN 'everX time task is toggeld task(this).tog = %true velo = 5: note = mc(%cVibi).lowtes: wheel = 20 task(this).freq = 2 ModeMess mc(%cVibi).channel, 64, 1 'dampers off ModeMess mc(%cVibi).channel, 20, wheel 'vibrato controllers ModeMess mc(%cVibi).channel, 21, wheel * 1.3 END IF DelNote2Har mc(%cVibi).Har(1), note Intensity = Slider(TaskEx(this).Slidernumbers(0)).value / 127! IF Intensity < 2!/127! THEN velo = (3 * velo + 2) / 4: task(this).freq = 3: EXIT SUB CNote = INT(mc(%cVibi).lowtes + (mc(%cVibi).hightes - mc(%cVibi).lowTes) * Slider(TaskEx(this).Slidernumbers(1)).value / 127!) task(this).freq = (2 * task(this).freq + 20 * RND^2 * Intensity + .1) / 3 velo = (3 * velo + 1 + Intensity * SQR(RND) * 15)/4 ' [1, 16] note = (2 * note + CNote + SQR(Intensity + .1) * (10 - RND * 20))/3 '13, 26 > calib'd so for (I = 0), note: [CNote - 1, CNote + 1] wheel = 90 * Intensity IF note < mc(%cVibi).lowTes THEN note = note + 12 IF note > mc(%cVibi).hightes THEN note = note - 12 ModeMess mc(%cVibi).channel, 20, wheel: ModeMess mc(%cVibi).channel, 21, wheel * 1.3'vibrato controllers AddNote2Har mc(%cVibi).har(1), note, velo InstrumPlay mc(%cVibi) END SUB SUB Mw_Vibiwolk_mov STATIC this AS LONG STATIC TaskParamLabels() AS ASCIIZ * 8 STATIC Intensity AS SINGLE STATIC CNote AS BYTE STATIC velo AS BYTE, note AS BYTE, wheel AS BYTE 'we assume velocities in range [10, 32] LOCAL AD AS INTEGER LOCAL s AS SINGLE LOCAL skip AS SINGLE 'smaller = more notes skipped IF ISFALSE this THEN 'on init only this = %VibW_mov DIM TaskParamLabels(1) TaskParamLabels(0) = "Tess" TaskParamLabels(1) = "Speed" MakeTaskParameterDialog BYVAL this,2,Slider(),0,UDctrl(),TaskParamLabels() Slider(TaskEx(this).Slidernumbers(0)).value = 64 Slider(TaskEx(this).Slidernumbers(1)).value = 127 SendMessage Slider(TaskEx(this).Slidernumbers(0)).h, %TBM_SETPOS,%True, Slider(TaskEx(this).Slidernumbers(0)).value SendMessage Slider(TaskEx(this).Slidernumbers(1)).h, %TBM_SETPOS,%True, Slider(TaskEx(this).Slidernumbers(1)).value END IF IF ISFALSE task(this).tog THEN 'everX time task is toggeld task(this).tog = %true velo = 5: note = mc(%cVibi).lowtes: wheel = 20 task(this).freq = 2 ModeMess mc(%cVibi).channel, 64, 1 'dampers off ModeMess mc(%cVibi).channel, 20, wheel 'vibrato controllers ModeMess mc(%cVibi).channel, 21, wheel * 1.3 END IF DelNote2Har mc(%cVibi).Har(1),note @sr.noise = slider(0).value skip = SQR(slider(TaskEx(this).slidernumbers(1)).value/127) IF ISFALSE @sr.noise THEN @sr.noise = 10 ' default AD = AvgStatArr(Databuf7(), s, Daqparams.scanfreq/4) 's = significance - we should check this... SHIFT RIGHT AD, 5 ' = hoeveelheid beweging\ IF AD < @sr.noise THEN AD = %false Intensity = (3 * Intensity + AD/127) / 4 IF Intensity < 3!/127! THEN velo = (3 * velo + 2) / 4 task(this).freq = 3 EXIT SUB END IF CNote = INT(mc(%cVibi).lowtes + (mc(%cVibi).hightes - mc(%cVibi).lowTes) * Slider(TaskEx(this).Slidernumbers(0)).value / 127!) task(this).freq = (2 * task(this).freq + 20 * RND^2 * Intensity + .1) / 3 velo = (3 * velo + 1 + Intensity * SQR(RND) * 15)/4 ' [1, 16] note = (2 * note + CNote + SQR(Intensity + .1) * (10 - RND * 20))/3 '13, 26 > calib'd so for (I = 0), note: [CNote - 1, CNote + 1] wheel = 90 * Intensity IF note < mc(%cVibi).lowTes THEN note = note + 12 IF note > mc(%cVibi).hightes THEN note = note - 12 ModeMess mc(%cVibi).channel, 20, wheel 'vibrato controllers ModeMess mc(%cVibi).channel, 21, wheel * 1.3 IF skip > RND THEN '@speed slider. lower speed = lower skip = skip more notes AddNote2Har mc(%cVibi).har(1), note, velo InstrumPlay mc(%cVibi) END IF END SUB SUB Mw_Harmawolk_mov LOCAL i AS LONG STATIC this AS LONG STATIC TaskParamLabels() AS ASCIIZ * 8 STATIC Intensity AS SINGLE STATIC CNote AS BYTE STATIC velo AS BYTE, note AS BYTE, hvol AS BYTE 'harma volume, intensity dependant STATIC polymax AS DWORD STATIC polycurrent AS DWORD STATIC sounding() AS BYTE LOCAL AD AS INTEGER LOCAL s AS SINGLE LOCAL skip AS SINGLE 'smaller = more notes skipped IF ISFALSE this THEN 'on init only this = %HarmW_mov polymax = 3 'max voices (-1) simultaneously DIM sounding(polymax) 'note that is still sounding for each voice DIM TaskParamLabels(1) TaskParamLabels(0) = "Tess" TaskParamLabels(1) = "Speed" MakeTaskParameterDialog BYVAL this,2,Slider(),0,UDctrl(),TaskParamLabels() Slider(TaskEx(this).Slidernumbers(0)).value = 64 Slider(TaskEx(this).Slidernumbers(1)).value = 127 SendMessage Slider(TaskEx(this).Slidernumbers(0)).h, %TBM_SETPOS,%True, Slider(TaskEx(this).Slidernumbers(0)).value SendMessage Slider(TaskEx(this).Slidernumbers(1)).h, %TBM_SETPOS,%True, Slider(TaskEx(this).Slidernumbers(1)).value END IF IF ISFALSE task(this).tog THEN 'everX time task is toggeld task(this).tog = %true velo = 5: note = mc(%cVibi).lowtes: hvol = 2 task(this).freq = 2 ModeMess mc(%cHarma).channel, 7, hvol ProgChange mc(%cHarma).channel, &B1111 'all registers open END IF @sr.noise = slider(0).value skip = SQR(slider(TaskEx(this).slidernumbers(1)).value/127) IF ISFALSE @sr.noise THEN @sr.noise = 10 ' default AD = AvgStatArr(Databuf7(), s, Daqparams.scanfreq/4) 's = significance - we should check this... SHIFT RIGHT AD, 5 ' = hoeveelheid beweging\ IF AD < @sr.noise THEN AD = %false Intensity = (3 * Intensity + AD/127) / 4 #IF %DEF(%MW_DEBUGGERON) kl_debug idbg, "Harma intensity:" + STR$(intensity) #ENDIF IF Intensity < .1 THEN FOR i = 0 TO PolyMax IF Sounding(i) THEN DelNote2Har mc(%cHarma).Har(1), sounding(i) 'note sounding(i) = 0 END IF NEXT InstrumPlay mc(%cHarma) mc(%cHarma).har(1).vel = mc(%cHarma).har(0).vel IF Intensity < 5!/127! THEN hvol = (3 * hvol + 2)/4 ModeMess mc(%cHarma).channel, 7, hvol 'volume ctrl task(this).freq = 3 EXIT SUB END IF END IF CNote = INT(mc(%cHarma).lowtes + (mc(%cHarma).hightes - mc(%cHarma).lowTes) * Slider(TaskEx(this).Slidernumbers(0)).value / 127!) task(this).freq = (2 * task(this).freq + 20 * RND^2 * Intensity + .1) / 3 note = (2 * note + CNote + SQR(Intensity + .1) * (10 - RND * 20))/3 '13, 26 > calib'd so for (I = 0), note: [CNote - 1, CNote + 1] hvol = MAX(10, MIN(127, 110 * Intensity^1.2)) 'limit [10 - 110] IF note < mc(%cHarma).lowTes THEN note = note + 12 IF note > mc(%cHarma).hightes THEN note = note - 12 ModeMess mc(%cHarma).channel, 7, hvol 'volume ctrl IF skip > RND THEN '@speed slider. lower speed = lower skip = skip more notes INCR PolyCurrent PolyCurrent = PolyCurrent MOD PolyMax FOR i = 0 TO PolyMax IF Sounding(i) = note THEN Sounding(i) = 0 DelNote2Har mc(%cHarma).Har(1), note InstrumPlay mc(%cHarma) mc(%cHarma).har(1).vel = mc(%cHarma).har(0).vel EXIT SUB END IF NEXT IF sounding(Polycurrent) THEN DelNote2Har mc(%cHarma).Har(1), sounding(PolyCurrent) sounding(PolyCurrent) = 0 END IF AddNote2Har mc(%cHarma).Har(1), note, velo Sounding(PolyCurrent) = note InstrumPlay mc(%cHarma) mc(%cHarma).har(1).vel = mc(%cHarma).har(0).vel END IF END SUB SUB MW_PiPlay_Mov 'allways ad note from movement to MoveHist() 'if current moveval > MoveHist(playcnt) mPlay current & add as first in hist, otherwise movehist(count), incr count LOCAL t AS LONG LOCAL note AS BYTE STATIC velo AS BYTE LOCAL x AS LONG, y AS LONG 'values from movement vectors LOCAL s AS SINGLE 'for computations LOCAL a AS SINGLE ' " " STATIC xpeek AS LONG, ypeek AS LONG STATIC MovHistX() AS SINGLE, MovHistY() AS SINGLE '[0 - 1] STATIC PlayCountX AS LONG, PlayCountY AS LONG 'next to be played - reset on long nomov(x) (c.s.) STATIC ContCount AS SINGLE STATIC this AS LONG STATIC hdbg AS LONG STATIC lobandbound AS SINGLE, hibandbound AS SINGLE 'single for forcing calculations to single precision IF ISFALSE this THEN this = %PiPlay_Mov contcount = 2 lobandbound = mc(%cPiano).lowtes + 1 hibandbound = mc(%cPiano).hightes - 1 DIM MovHistX(100): DIM MovHistY(100) REDIM MovHistX(0): REDIM MovHistY(0) END IF @sr.noise = Slider(0).value IF ISFALSE @sr.noise THEN @sr.noise = 10 x = AvgStatArr(Databuf4(), s, Daqparams.scanfreq/task(this).freq) 's = significance - we should check this... 'low x & low s = noise; high x & low s = nervous movement... SHIFT RIGHT x, 5 'restore 5 for ii_2000 IF s < .3 THEN IF x < 20 THEN x = 0 ELSEIF x > 40 THEN 'grillige beweging' scale up x.. a = (x - 40)/ 87 a = a ^ .8 x = 40 + (127 - x) * a ELSE '20 - 40 'scale down a = (x - 20) / 20 a = a ^ 1.2 x = 20 + (40 - x) * a END IF END IF y = AvgStatArr(Databuf5(), s, Daqparams.scanfreq/task(this).freq) SHIFT RIGHT y, 5 IF s < .3 THEN IF y < 20 THEN y = 0 ELSEIF y > 40 THEN 'grillige beweging' scale up x.. a = (y - 40)/ 87 a = a ^ .8 x = 40 + (127 - y) * a ELSE a = (y - 20)/20 a = a ^ 1.2 y = 20 + (40 - x) * a END IF END IF x = MIN(x, 127): y = MIN(y, 127) IF x > xpeek THEN xpeek = x #IF %DEF(%MW_DEBUGGERON) kl_debug idbg, "xpeek:" + STR$(xpeek) #ENDIF END IF IF y > ypeek THEN ypeek = y #IF %DEF(%MW_DEBUGGERON) kl_debug idbg, "ypeek:" + STR$(ypeek) #ENDIF END IF IF x > y THEN 'laag INCR PlayCountX IF x > @sr.noise THEN ContCount = ContCount * 1.1 ContCount = MIN (ContCount, 10) IF PlayCountX > UBOUND(MovHistX) THEN REDIM PRESERVE MovHistX(PlayCountX) INCR lobandbound DECR hibandbound lobandbound = MIN(lobandbound, mc(%cPiano).hightes) hibandbound = MAX(hibandbound, mc(%cPiano).lowtes) PlayCountX = %false END IF s = x / 127! IF s > MovHistX(PlayCountX) THEN MovHistX(PlayCountX) = s 'MovHistX values ok.... note = INT(lobandbound - (MovHistX(PlayCountX) * (lobandbound - mc(%cPiano).lowtes))) IF IsNoteInHar (mc(%cPiano).Har(1), note) THEN DelNote2Har mc(%cPiano).Har(1), note InstrumPlay mc(%cPiano) task(this).freq = 10 ELSE velo = (5 * velo + MIN(70, (x + y)^.87)) / 6 AddNote2Har mc(%cPiano).Har(1), note, velo InstrumPlay mc(%cPiano) task(this).freq = ContCount END IF ELSE ContCount = ContCount * .85 ContCount = MAX(1,ContCount) task(this).freq = ContCount IF PlayCountX > UBOUND(MovHistX) THEN PlayCountX = 0 MAT MovHistX() = (.9) * MovHistX ELSE note = INT(lobandbound - (MovHistX(PlayCountX) * (lobandbound - mc(%cPiano).lowtes))) velo = (5 * velo + 12) / 6 mc(%cPiano).Har(1).vel = STRING$(128, CHR$(0)) END IF END IF ELSE 'hoog INCR PlayCountY IF y > @sr.noise THEN ContCount = ContCount * 1.1: ContCount = MIN(ContCount, 14) IF PlayCountY > UBOUND(MovHistY) THEN REDIM PRESERVE MovHistY(PlayCountY) INCR lobandbound: DECR hibandbound lobandbound = MIN(lobandbound, mc(%cPiano).hightes) hibandbound = MAX(hibandbound, mc(%cPiano).lowtes) PlayCountY = %false END IF s = y/127! IF s > MovHistY(PlayCountY) THEN MovHistY(PlayCounty) = s note = INT(hibandbound + (MovHistY(PlayCounty) * (mc(%cPiano).hightes - hibandbound))) IF IsnoteInHar (mc(%cPiano).Har(1), note) THEN DelNote2Har mc(%cPiano).Har(1), note InstrumPlay mc(%cPiano) task(this).freq = 14 ELSE velo = (5 * velo + MAX(12, MIN(70, (x + y)^.87))) / 6 AddNote2Har mc(%cPiano).Har(1), note, velo InstrumPlay mc(%cPiano) task(this).freq = ContCount END IF ELSE ContCount = ContCount * .85: ContCount = MAX(1.5, ContCount) task(this).freq = ContCount IF PlayCountY > UBOUND(MovHistY) THEN PlayCountY = 0 MAT MovHistY() = (.9) * MovHistY() ELSE note = INT(hibandbound + (MovHistY(PlayCountY) * (mc(%cPiano).hightes - hibandbound))) velo = (5 * velo + 12) / 6 mc(%cPiano).Har(1).vel = STRING$(128, CHR$(0)) END IF END IF END IF END SUB SUB MW_BourPlay_Mov 'allways ad note from movement to MoveHist() 'if current moveval > MoveHist(playcnt) mPlay current & add as first in hist, otherwise movehist(count), incr count LOCAL t AS LONG LOCAL note AS BYTE LOCAL x AS LONG, y AS LONG 'values from movement vectors LOCAL s AS SINGLE 'for computations LOCAL a AS SINGLE ' " " STATIC xpeek AS LONG, ypeek AS LONG STATIC MovHistY() AS SINGLE, MovHistX() AS SINGLE '[0 - 1] STATIC NoteHist() AS BYTE STATIC PlayCountY AS LONG, PlayCountX AS LONG 'next to be played - reset on long nomov(x) (c.s.) STATIC ContCount AS SINGLE STATIC this AS LONG STATIC hdbg AS LONG STATIC hibandbound AS SINGLE, lobandbound AS SINGLE 'single for forcing calculations to single precision STATIC lotog AS DWORD IF ISFALSE this THEN this = %Bour_Mov contcount = 2 lobandbound = mc(%cPiperola).lowtes + 5: hibandbound = mc(%cPiperola).hightes - 10 DIM MovHistX(100): DIM MovHistY(100) REDIM MovHistX(0): REDIM MovHistY(0) DIM NoteHist(8) END IF @sr.noise = Slider(0).value IF ISFALSE @sr.noise THEN @sr.noise = 10 x = AvgStatArr(Databuf4(), s, Daqparams.scanfreq/MIN(task(this).freq, 4)) 's = significance - we should check this... 'low x & low s = noise; high x & low s = nervous movement... SHIFT RIGHT x, 5 'restore 5 for ii_2000 IF s < .3 THEN IF x < 20 THEN x = 0 ELSEIF x > 40 THEN 'grillige beweging' scale up x.. a = (x - 40)/ 87: a = a ^ .8: x = 40 + (127 - x) * a ELSE '20 - 40 'scale down a = (x - 20) / 20: a = a ^ 1.2: x = 20 + (40 - x) * a END IF END IF y = AvgStatArr(Databuf5(), s, 5 * Daqparams.scanfreq/task(this).freq) SHIFT RIGHT y, 5 IF s < .3 THEN IF y < 20 THEN y = 0 ELSEIF y > 40 THEN 'grillige beweging' scale up x.. a = (y - 40)/ 87: a = a ^ .8: x = 40 + (127 - y) * a ELSE a = (y - 20)/20: a = a ^ 1.2: y = 20 + (40 - x) * a END IF END IF x = MIN(x, 127): y = MIN(y, 127) IF x > xpeek THEN xpeek = x #IF %DEF(%MW_DEBUGGERON) kl_debug idbg, "xpeek:" + STR$(xpeek) #ENDIF END IF IF y > ypeek THEN ypeek = y #IF %DEF(%MW_DEBUGGERON) kl_debug idbg, "ypeek:" + STR$(ypeek) #ENDIF END IF INCR lotog 'laag------------------------------------- IF ISFALSE lotog MOD 5 THEN 'o/d 5 tikken INCR PlayCountX IF x > @sr.noise THEN ContCount = ContCount * 1.2 ^ (1/(contcount^2)) IF PlayCountX > UBOUND(MovHistX) THEN REDIM PRESERVE MovHistX(PlayCountX) INCR lobandbound: DECR hibandbound lobandbound = MIN(lobandbound, mc(%cPiperola).lowtes + 27) hibandbound = MAX(hibandbound, mc(%cPiperola).lowtes + 27) PlayCountX = %false END IF s = x / 127! IF s > MovHistX(PlayCountX) THEN MovHistX(PlayCountX) = s 'MovHistX values ok.... note = INT(lobandbound - (MovHistX(PlayCountX) * (lobandbound - mc(%cPiperola).lowtes))) IF IsNoteInHar (mc(%cPiperola).Har(1), note) THEN DelNote2Har mc(%cPiperola).Har(1), note ELSE AddNote2Har mc(%cPiperola).Har(1), note, 64 DelNote2Har mc(%cPiperola).Har(1), BufferByte(NoteHist(), note) DelNote2Har mc(%cPiperola).Har(1), note + 1 DelNote2Har mc(%cPiperola).Har(1), note + 2 DelNote2Har mc(%cPiperola).Har(1), note - 1 DelNote2Har mc(%cPiperola).Har(1), note - 2 task(this).freq = ContCount END IF ELSE ContCount = ContCount * .98 ^ ContCount IF ISFALSE lotog MOD 5 THEN MID$(mc(%cPiperola).Har(1).vel, 1, lobandbound) = STRING$(lobandbound, CHR$(0)) IF PlayCountX > UBOUND(MovHistX) THEN PlayCountX = 0 MAT MovHistX() = (.9) * MovHistX ELSE note = INT(lobandbound - (MovHistX(PlayCountX) * (lobandbound - mc(%cPiperola).lowtes))) END IF END IF END IF 'hoog -------------------------------------------------- INCR PlayCountY IF y > @sr.noise THEN ContCount = ContCount * 1.2 ^ (1/(contcount^2)) IF PlayCountY > UBOUND(MovHistY) THEN REDIM PRESERVE MovHistY(PlayCountY) INCR lobandbound: DECR hibandbound lobandbound = MIN(lobandbound, mc(%cPiperola).lowtes + 27) hibandbound = MAX(hibandbound, mc(%cPiperola).lowtes + 27) PlayCountY = %false END IF s = y/127! IF s > MovHistY(PlayCountY) THEN MovHistY(PlayCounty) = s note = INT(hibandbound + (MovHistY(PlayCounty) * (mc(%cPiperola).hightes - hibandbound))) IF IsnoteInHar (mc(%cPiperola).Har(1), note) THEN task(this).freq = 20 ELSE AddNote2Har mc(%cPiperola).Har(1), note, 64 DelNote2Har mc(%cPiperola).Har(1), BufferByte(NoteHist(), note) DelNote2Har mc(%cPiperola).Har(1), note + 1 DelNote2Har mc(%cPiperola).Har(1), note + 2 DelNote2Har mc(%cPiperola).Har(1), note - 1 DelNote2Har mc(%cPiperola).Har(1), note - 2 END IF ELSE ContCount = ContCount * .98 ^ ContCount IF ISFALSE lotog MOD 3 THEN MID$(mc(%cPiperola).Har(1).vel, hibandbound, 128 - hibandbound) = STRING$(128 - hibandbound, CHR$(0)) IF PlayCountY > UBOUND(MovHistY) THEN PlayCountY = 0 MAT MovHistY() = (.9) * MovHistY() ELSE note = INT(hibandbound + (MovHistY(PlayCountY) * (mc(%cPiperola).hightes - hibandbound))) END IF END IF ContCount = ContCount * (.09 + ((x + y) / 255)^ (.08)) ContCount = MIN (ContCount, 17): ContCount = MAX (contcount, 2) task(this).freq = ContCount IF mc(%cPiperola).Har(1).vel <> mc(%cPiperola).Har(0).vel THEN InstrumPlay mc(%cPiperola) mc(%cPiperola).Har(1) = mc(%cPiperola).har(0) END IF END SUB SUB MW_Imit_Lstn(OPT BYVAL hw AS LONG) STATIC hWin AS LONG STATIC this AS LONG STATIC nr() AS LONG STATIC OldHarmaVel AS BYTE ' static OldTrumpVel as byte LOCAL instrum AS LONG LOCAL i AS LONG LOCAL j AS LONG LOCAL rslt AS LONG LOCAL vel AS STRING * 128 LOCAL velbyte() AS BYTE LOCAL note() AS BYTE LOCAL velo() AS BYTE LOCAL mode AS LONG LOCAL harmavel AS BYTE STATIC poly AS BYTE LOCAL hurdyset AS LONG 'flag LOCAL buf$ 'play strongest notes in input har 'interactive instrumentation IF hw THEN IF hw = -1 THEN hWin = 0 ELSE hwin = hw END IF EXIT SUB END IF IF ISFALSE this THEN ProgChange mc(%cHarma).channel, &B1111 'all registers open this = %Imit_Lstn DIM nr(11) 'enum machines nr(0) = 7: nr(1) = 0: nr(2) = 4: nr(3) = %cPiperola: nr(4) = %cHumanola: nr(5) = %cBourdon: nr(6) = 1: nr(7) = 10: nr(8) = 14: nr(9) = %cPuff: nr(10) = %cTrump: nr(11) = %cHurdy END IF IF ISFALSE hWin THEN StopTask this DIALOG DOEVENTS CONTROL GET CHECK hWin, 100 TO mode '1 = old, 0 = new FOR i = 0 TO 11 CONTROL GET CHECK hwin, i TO rslt IF rslt = 1 THEN BIT SET instrum, i NEXT CONTROL GET TEXT hwin, 50 TO buf$ IF VAL(buf$) THEN poly = VAL(buf$): poly = MIN(poly, 8) DIALOG DOEVENTS CONTROL SET TEXT hwin, 50, STR$(poly) vel = ReturnStrongestInHar(Task(%cqtLst).Har, poly) DIM velbyte(127) AT VARPTR(vel) 'DEBUGGED 040423 - improved, kept old algo as mode 1, new as 0 IF (mode = 1) THEN REDIM note(poly) FOR i = 48 TO 127 'poly IF velbyte(i) < 10 THEN ITERATE FOR IF velbyte(i) > note(1) THEN POKE$ VARPTR(note(2)), PEEK$(VARPTR(note(1)), poly - 1) note(1) = i END IF NEXT ELSE REDIM note(127) REDIM velo(127) FOR i = 48 TO 127 'poly IF velbyte(i) < 10 THEN ITERATE FOR note(i) = i: velo(i) = velbyte(i) NEXT ARRAY SORT velo(), TAGARRAY note(), DESCEND REDIM PRESERVE note(poly) 'now contains note nrs - we can get the velo from velbyte(note(i)) END IF FOR j = 0 TO 6 'this shouldn't be necessary!?? IF BIT (instrum, j) THEN mc(nr(j)).Har(1).vel = STRING$(128, CHR$(0)) NEXT ' CONTROL SET TEXT gh.cockpit, %GMT_MSG1, BIN$(instrum) FOR i = 1 TO poly FOR j = 0 TO 10 'for tubi (instrum 7) this is done later, puff (instrum 9) has its own proc IF (j = 7) OR (j = 9) THEN ITERATE FOR IF ISFALSE BIT(instrum, j) THEN ITERATE FOR IF IsnoteInHar(mc(nr(j)).Har(0), note(i)) THEN MID$(mc(nr(j)).Har(1).vel, note(i) + 1, 1) = MID$(mc(nr(j)).Har(0).vel, note(i) + 1, 1) note(i) = 0 EXIT FOR END IF NEXT NEXT FOR i = 1 TO poly IF ISFALSE note(i) THEN ITERATE FOR j = INT(RND * 11) selekt: CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 12, STR$(j) IF j = 11 AND hurdyset > 0 THEN INCR j: j = j MOD 12 IF BIT(instrum, j) THEN IF (note(i) > mc(nr(j)).lowtes) AND (note(i) < mc(nr(j)).hightes) THEN IF j = 7 THEN 'tubi - if note +/-1 vel is high also take quarter tone in between.. IF velbyte(note(i) + 1) > 10 THEN note(i) = note(i) - 36 ELSEIF velbyte(note(i) - 1)> 10 THEN note(i) = note(i) - 37 END IF IF IsnoteInHar(mc(nr(j)).Har(0), note(i)) THEN MID$(mc(nr(j)).Har(1).vel, note(i) + 1, 1) = MID$(mc(nr(j)).Har(0).vel, note(i) + 1, 1) note(i) = 0 END IF END IF IF j = 11 THEN hurdyset = 1 AddNote2Har mc(nr(j)).Har(1), note(i), velbyte(note(i))/ 1.5 ITERATE FOR END IF END IF INCR j j = j MOD 12 IF j = INT(RND(0) * 11) THEN EXIT FOR GOTO selekt NEXT IF BIT(instrum, 2) THEN 'harma harmavel = MAX(24, INT(127 * (Mw_MidiIn.Vol/127)^1/2)) IF ABS(OldHarmaVel - Harmavel) > 3 THEN OldHarmaVel = harmaVel ModeMess mc(Nr(2)).channel, 7, harmavel END IF END IF IF BIT(instrum, 3) THEN 'piperola - windsturing toevogen aan harmony FOR i = 0 TO 6 IF BIT(Mw_MidiIn.vol,i) THEN AddNote2Har mc(%cPiperola).Har(1), i,64 NEXT i END IF IF BIT(instrum, 4) THEN FOR i = 0 TO 6 IF BIT(MW_MidiIn.vol, i) THEN AddNote2Har mc(%cHumanola).Har(1), i, 64 NEXT END IF IF BIT(instrum, 9) THEN 'puff 'instruxies voor puff: veel stiltes laten!! zacht met uithalen mc(%cPuff).Har(1).vel = ReturnStrongestInHar(Task(%cqtLst).Har, poly) REDIM velbyte(127) AT VARPTR(mc(%cPuff).Har(1).vel) FOR i = 0 TO 127 IF velbyte(i) < 5 THEN velbyte(i) = 0: ITERATE FOR velbyte(i) = 10 + (velbyte(i) - 5) ^ .71 NEXT FOR i = 55 TO 96 IF velbyte(i) > 0 AND velbyte(i+1) > 0 THEN velbyte(i-48) = (velbyte(i) + velbyte(i+1)) / 2 velbyte(i) = 0: velbyte(i+1) = 0 END IF NEXT END IF IF BIT(instrum, 10) THEN 'trump IF MW_MidiIn.vol < 40 THEN ModeMess mc(%cTrump).channel, 7, 0 ELSE ModeMess mc(%cTrump).channel, 7, (MW_MidiIn.Vol - 30) END IF END IF IF BIT(instrum, 11) THEN 'hurdy Modemess mc(%cHurdy).channel, 66, 1 ModeMess mc(%cHurdy).channel, 7, 70 + MW_MidiIn.vol / 1.8 Keypress mc(%cHurdy).channel, 40, 85: Keypress mc(%cHurdy).channel, 64, 85 END IF FOR i = 0 TO 11 '5 = bourdon = same as piper IF i = 5 THEN ITERATE FOR IF BIT (instrum, i) THEN InstrumPlay mc(nr(i)) NEXT END SUB SUB ToggleImitLstn STATIC hw AS LONG STATIC x AS LONG, y AS LONG 'make/del ctrlwin > insts can be (de)selected 'check listntask IF ISFALSE hw THEN 'switching on.. IF ISFALSE BIT (Task(%CqtLst).swit, %TASK_ONOFF) THEN StartTask %CqtLst SLEEP 100 END IF DIALOG NEW gh.Cockpit, "ImiLstn Instr",x,y,50, 221 TO hw CONTROL ADD CHECKBOX, hw, 0, "&piano", 1,1, 48, 12, CALL CB_MW_IL_instroff CONTROL ADD CHECKBOX, hw, 1, "&vibi", 1,16, 48, 12 CONTROL ADD CHECKBOX, hw, 2, "&harma", 1,31, 48, 12, CALL CB_MW_IL_instroff CONTROL ADD CHECKBOX, hw, 3, "p&iper", 1,46, 48, 12, CALL CB_MW_IL_instroff CONTROL ADD CHECKBOX, hw, 4, "&huma", 1,61, 48, 12, CALL CB_MW_IL_instroff CONTROL ADD CHECKBOX, hw, 5, "&bourd", 1,76, 48, 12, CALL CB_MW_IL_instroff CONTROL ADD CHECKBOX, hw, 6, "&klung", 1,91, 48, 12 CONTROL ADD CHECKBOX, hw, 7, "&tubi", 1, 106, 48, 12 CONTROL ADD CHECKBOX, hw, 8, "&sax", 1, 121, 48, 12 CONTROL ADD CHECKBOX, hw, 9, "&puff", 1, 136, 48, 12 CONTROL ADD CHECKBOX, hw, 10, "&trump", 1, 151, 48, 12 CONTROL ADD CHECKBOX, hw, 11, "&hurdy", 1, 166, 48, 12 CONTROL ADD LABEL, hw, -1, "Poly", 1, 181, 22, 12 CONTROL ADD TEXTBOX, hw, 50, "2",23, 181, 24, 10, %ES_NUMBER CONTROL ADD CHECKBOX, hw, 100, "OldMode", 1, 196, 48, 12 DIALOG SHOW MODELESS hw MW_Imit_Lstn hw ELSE DIALOG GET LOC hw TO x, y DIALOG END hw hw = 0 MW_Imit_Lstn -1 END IF END SUB CALLBACK FUNCTION CB_MW_IL_Instroff 'put instrument off is checkbox is uncheckedd for Imit_Listn LOCAL i AS LONG IF CBCTLMSG <> %BN_CLICKED THEN EXIT FUNCTION CONTROL GET CHECK CBHNDL, CBCTL TO i IF ISFALSE i THEN SELECT CASE CBCTL CASE 0 Piano_Silence END SELECT END IF END FUNCTION SUB MW_PiBo_Lstn(OPT BYVAL hw AS LONG) STATIC hWin AS LONG STATIC this AS LONG STATIC instid AS LONG LOCAL instrum AS LONG LOCAL i AS LONG LOCAL j AS LONG LOCAL rslt AS LONG LOCAL vel AS STRING * 128 LOCAL velbyte() AS BYTE LOCAL avgvel AS BYTE LOCAL note() AS BYTE LOCAL buf$ STATIC tc AS BYTE IF hw THEN IF hw = -1 THEN hWin = 0 ELSE hwin = hw END IF EXIT SUB END IF IF ISFALSE this THEN this = %PiBo_Lstn instid = 2 'id of pi + bo END IF vel = ReturnStrongestInHar(Task(%cqtLst).Har, 3) DIM velbyte(127) AT VARPTR(vel) REDIM note(3) FOR i = 40 TO 127 'poly IF velbyte(i) < 10 THEN ITERATE FOR IF velbyte(i) > velbyte(note(1)) THEN POKE$ VARPTR(note(2)), PEEK$(VARPTR(note(1)), 2) note(1) = i END IF NEXT IF ISFALSE note(2) THEN note(2) = note(1) IF ISFALSE note(3) THEN note(3) = note(2) IF ISFALSE note(1) THEN mc(instid).Har(1).vel = SolveHar(mc(instid).Har(0), tc, 0) ELSE tc = note(1) REDIM PRESERVE note(9) 'som-en verschil note(4) = F2N(N2F(note(1) + N2F(note(2)))): note(5)= F2N(ABS(N2F(note(1) - N2F(note(2))))) note(6) = F2N(N2F(note(1) + N2F(note(3)))): note(7)= F2N(ABS(N2F(note(1) - N2F(note(3))))) note(8) = F2N(N2F(note(2) + N2F(note(3)))): note(9)= F2N(ABS(N2F(note(2) - N2F(note(3))))) ARRAY SORT note() buf$="" FOR i = 1 TO 9 buf$ = buf$ + FORMAT$(note(i), "000") + " " NEXT buf$ = buf$ + " - " FOR i = 1 TO 9 'poly buf$ = buf$ + FORMAT$(velbyte(note(i)), "000") + " " NEXT mc(instrum).Har(1).vel = STRING$(128, CHR$(0)) FOR i = 1 TO 9 IF IsnoteInHar(mc(instid).Har(0), note(i)) THEN MID$(mc(instid).Har(1).vel, note(i) + 1, 1) = CHR$(64) END IF NEXT 'add strongest 3 notes in har AddNote2Har(mc(instrum).Har(1), note(1), 64) AddNote2Har(mc(instrum).Har(1), note(2), 64) AddNote2Har(mc(instrum).Har(1), note(3), 64) ARRAY SORT note() 'allways add the highest and lowest notes that aren't in the har yet.. i = 1 DO WHILE IsNoteInHar(mc(instid).Har(1), note(i)) INCR i IF i > UBOUND(note) THEN EXIT LOOP LOOP IF i <= UBOUND(note) THEN AddNote2Har(mc(instid).Har(1), note(i), 64) i = UBOUND(note) DO WHILE IsNoteInHar(mc(instid).Har(1), note(i)) DECR i IF ISFALSE i THEN EXIT LOOP LOOP IF i THEN AddNote2Har(mc(instid).Har(1), note(i), 64) END IF InstrumPlay mc(instid) Task(this).freq = 3 * CEIL(MAX(MW_MidiIn.dens, .33)/3) END SUB SUB Start_PiBo_Lstn StartTask %CqtLst END SUB SUB Stop_Pibo_Lstn Bourd_Silence DIALOG DOEVENTS Piper_Silence END SUB SUB MW_Storm STATIC this AS LONG LOCAL i AS LONG LOCAL istorm AS SINGLE 'intensity LOCAL iwind AS SINGLE LOCAL ithunder AS SINGLE LOCAL ipekkers AS SINGLE LOCAL iratchet AS SINGLE LOCAL irain AS SINGLE LOCAL ichimes AS SINGLE STATIC cstorm AS SINGLE 'counter STATIC cwind AS SINGLE STATIC cthunder AS SINGLE STATIC cpekkers AS SINGLE STATIC cratchet AS SINGLE STATIC crain AS SINGLE STATIC cchimes AS SINGLE STATIC pstorm AS LONG 'period STATIC pwind AS LONG STATIC pthunder AS LONG STATIC ppekkers AS LONG STATIC pratchet AS LONG STATIC prain AS LONG STATIC pchimes AS LONG STATIC counter AS DWORD LOCAL TaskParamLabels() AS ASCIIZ * 8 IF ISFALSE this THEN this = %mw_storm DIM TaskParamLabels(6) TaskParamLabels(0) = "storm": TaskParamLabels(1) = "wind": TaskParamLabels(2) = "thunder" TaskParamLabels(3) = "pekkers": TaskParamLabels(4) = "ratchet": TaskParamLabels(5) = "rain" TaskParamLabels(6) = "chimes" MakeTaskParameterDialog BYVAL this,7,Slider(),0,UDctrl(),TaskParamLabels() FOR i = 0 TO UBOUND(TaskParamLabels) Slider(TaskEx(this).Slidernumbers(i)).value = 0 SendMessage Slider(TaskEx(this).Slidernumbers(i)).h, %TBM_SETPOS,%True, Slider(TaskEx(this).Slidernumbers(i)).value NEXT task(this).tog = %true pstorm = 9 + RND * 6: pwind = 8 + RND * 5: pthunder = 8 + RND * 5: ppekkers = 4 + RND * 3 pratchet = 4 + RND * 3: prain = 5 + RND * 4: pchimes = 7 + RND * 5 cstorm = RND * 15: cwind = RND * 13: cthunder = 5 + RND * 10 END IF INCR counter cstorm = cstorm + RND / task(this).freq IF cstorm > pstorm THEN ' +- 30 sec cyclus cstorm = 0 pstorm = 9 + RND * 6 END IF cwind = cwind + RND / task(this).freq IF cwind > pwind THEN cwind = 0 pwind = 8 + RND * 5 END IF cthunder = cthunder + RND / task(this).freq IF cthunder > pthunder THEN cthunder = 0 pthunder = 8 + RND * 5 END IF cpekkers = cpekkers + RND / task(this).freq IF cpekkers > ppekkers THEN cpekkers = 0 ppekkers = 4 * RND + 3 END IF cratchet = cratchet + RND / task(this).freq IF cratchet > pratchet THEN cratchet = 0 pratchet = 4 + RND * 3 END IF crain = crain + RND / task(this).freq IF crain > prain THEN crain = 0 prain = 5 + RND * 4 END IF IF cchimes > pchimes THEN cchimes = 0 pchimes = 7 + RND * 5 END IF 'storm IF ISFALSE (counter MOD 15) THEN '1 keer / sec istorm = SQR(ABS(COS(Pi * cstorm / pstorm))) istorm = istorm * Slider(TaskEx(this).Slidernumbers(0)).value '/ 127 IF istorm > 40 THEN mPlay mc(%cThunderwood).channel, 25, INT(istorm) ELSE mPlay mc(%cThunderwood).channel, 25, 0 END IF END IF 'wind IF ISFALSE (counter MOD 16) THEN iwind = ABS(COS(Pi * cwind / pwind))^ 3 iwind = iwind * Slider(TaskEx(this).SliderNumbers(1)).value IF iwind > 10 THEN mPlay mc(%cThunderwood).channel, 24, INT(iwind) ELSE mPlay mc(%cThunderwood).channel, 24, 0 END IF END IF 'thunder IF ISFALSE (counter MOD INT(RND * 10)) THEN ithunder = ABS(COS(Pi * cthunder / pthunder)) ithunder = (ithunder^4) / 2 + SQR(ithunder) / 2 ithunder = ithunder * Slider(TaskEx(this).SliderNumbers(2)).value mPlay mc(%cThunderwood).channel, 19, ithunder / 3 END IF 'pekkers ipekkers = COS(Pi * cpekkers / ppekkers) ^ 6 ipekkers = ipekkers * (91 + Slider(TaskEx(this).SliderNumbers(3)).value/4) IF ipekkers > 100 THEN mPlay mc(%cThunderwood).channel, 1 + counter MOD 14, ipekkers / 2 'ratchet iratchet = COS(Pi * cratchet / pratchet) ^ 4 iratchet = iratchet * Slider(TaskEx(this).SliderNumbers(4)).value IF iratchet * RND > 45 THEN mPlay mc(%cThunderwood).channel, 15, 64 'rain irain = ABS(COS(crain / prain)) irain = irain * Slider(TaskEx(this).SliderNumbers(5)).value IF SQR(RND) < irain/127 THEN mPlay mc(%cThunderwood).channel, 16, 64 'chimes IF ISFALSE (counter MOD INT(RND * 8)) THEN ichimes = ABS(COS(Pi * cchimes / pchimes)) ichimes = SQR(ichimes) / 2 + (ichimes^2)/2 ichimes = ichimes * Slider(TaskEx(this).SliderNumbers(6)).value mPlay mc(%cThunderwood).channel, 17, INT(ichimes) END IF END SUB SUB RobotGarden_thunderwood STATIC this AS LONG STATIC middle AS SINGLE STATIC devi AS SINGLE STATIC stat AS DWORD STATIC count AS DWORD STATIC MaxDevi AS LONG STATIC windorratchet AS SINGLE STATIC MyDens AS SINGLE STATIC LastStat AS SINGLE LOCAL i AS LONG LOCAL n AS BYTE LOCAL velo AS SINGLE '! sic - for computations IF ISFALSE this THEN this = %RG_TW middle = 60 devi = 2 MaxDevi = 12 'start not too high - increased when passed.. StartTask %Cqtlst END IF REDIM note(2) AS LOCAL BYTE REDIM vel(2) AS LOCAL BYTE 'analyse input FOR i = 1 TO 128 n = ASC(MID$(Task(%cqtlst).Har, i, 1)) IF n < 30 THEN ITERATE FOR IF n > vel(0) THEN note(2) = note(1) note(1) = note(0) note(0) = i vel(2) = vel(1) vel(1) = vel(0) vel(0) = n END IF NEXT IF note(0) > 36 THEN MyDens = MW_MidiIn.Dens IF note(1) < 36 THEN note(1) = note(0): vel(1) = vel(0) IF note(2) < 36 THEN note(2) = note(1): vel(2) = vel(1) middle = ( 21! * middle + note(0) + note(1) + note(2) ) / 24 devi = (8 * devi + ABS(note(0) - middle) + ABS(note(1) - middle) + ABS(note(2) - middle) ) / 11 IF devi > Maxdevi THEN MaxDevi = devi #IF %DEF(%MW_DEBUGGERON) kl_debug idbg, "!!!! MAXDEVI SET TO " + STR$(MaxDevi) #ENDIF ELSE Maxdevi = MAX(8, MaxDevi * .99) END IF IF ABS(note(0) - middle) > ABS (devi - middle) OR _ ABS(note(1) - middle) > ABS (devi - middle) OR _ ABS(note(2) - middle) > ABS (devi - middle) OR _ MyDens > 12 OR _ devi > 12 OR _ devi < 2 OR _ TIMER > LastStat + 30 OR _ (MyDens < 10) AND (stat = 8) THEN IF stat < 8 AND (TIMER < LastStat + 10) THEN GOTO slctdon LastStat = TIMER mPlay mc(%cThunderwood).channel, 24, 0 Slider(TaskEx(%mw_tw).Slidernumbers(3)).value = 0 IF MyDens > 16 THEN stat = 8 ELSEIF MyDens > 14 THEN SELECT CASE(note(0) MOD 12) CASE 0 : stat = 0 CASE 3 : stat = 1 CASE 6 : stat = 2 CASE 9 : stat = 3 CASE 1, 2 : stat = 4 CASE 4, 5 : stat = 5 CASE 7, 8 : stat = 6 CASE 10, 11: stat = 7 END SELECT ' stat = INT(RND * 7) ELSE SELECT CASE(note(0) MOD 12) CASE 9, 10, 11 : stat = 0 CASE 7, 8, 0 : stat = 1 CASE 1, 2, 3 : stat = 2 CASE 4, 5, 6: stat = 3 END SELECT ' stat = INT(RND * 3) END IF SELECT CASE stat #IF %DEF(%MW_DEBUGGERON) CASE 0 kl_debug idbg, "Pekker ritmes" CASE 1 kl_debug idbg, "Thunder" count = 0 CASE 2 kl_debug idbg, "Rolls" #ENDIF CASE 3 #IF %DEF(%MW_DEBUGGERON) kl_debug idbg, "Vogeltje" #ENDIF StartTask %mw_tw #IF %DEF(%MW_DEBUGGERON) CASE 4 kl_debug idbg, "Pekker + Thunder" #ENDIF CASE 5 #IF %DEF(%MW_DEBUGGERON) kl_debug idbg, "Rolls + Vogeltje" #ENDIF StartTask %mw_tw #IF %DEF(%MW_DEBUGGERON) CASE 6 kl_debug idbg, "Sheet + Rolls" #ENDIF CASE 7 #IF %DEF(%MW_DEBUGGERON) kl_debug idbg, "Pekker + Vogeltje" #ENDIF StartTask %mw_tw #IF %DEF(%MW_DEBUGGERON) CASE 8 kl_debug idbg, "TUTTI!" #ENDIF END SELECT END IF task(this).freq = (5 * task(this).freq + MyDens) / 6 ELSE IF MW_MidiIn.vol THEN task(this).freq = task(this).freq * .95 ELSE task(this).freq = task(this).freq * .90 END IF MyDens = MyDens * .95 END IF slctdon: task(this).freq = MIN(MAX(task(this).freq, .5), 24) 'play INCR count: count = count MOD 16 IF MW_MidiIn.vol < 10 OR (RND > MW_MidiIn.vol/80) THEN EXIT SUB IF (stat = 0) OR (stat = 4) OR (stat = 7) OR (stat = 8) THEN 'onregelmatiger naarmate tessituur wijder wordt 'tempo @ midi in dens velo = 0 IF (Devi > 12) AND RND > .6 THEN 'indeed. no chance at all with highest 1/3 of possible devi's velo = Devi / maxdevi ELSEIF (Devi > 8) AND ISFALSE BIT(count, 0) AND RND > .6 THEN velo = Devi / Maxdevi ELSEIF (Devi > 4) AND ISFALSE(count AND &B011) AND RND > .6 THEN velo = 1 - (Devi/MaxDevi) ELSEIF (Devi > 2) AND ISFALSE(count AND &B0111) AND RND > .6 THEN velo = 1 - (Devi/MaxDevi) ELSEIF (Devi > .5) AND ISFALSE(count AND &B01111) THEN velo = 1 END IF velo = 12 + 40 * velo n = 1 + MIN(13, 13 * (middle - 55) / 41) IF velo THEN mPlay mc(%cThunderwood).channel, n, velo END IF IF (stat = 1) OR (stat = 4) OR (stat = 6) OR (stat = 8) THEN 'sheet ritme 'eerste n keer van elke cyclus, n afhankelijk van tessituur-wijdte 'bij heel kleine tessituur: spaarzame ratchet ' IF count / 16 < Devi THEN velo = 4 + 55 * SQR(Devi/MaxDevi) * (1 - (count/16)^2) mPlay mc(%cThunderwood).channel, 19, velo IF task(this).freq < 4 THEN mPlay mc(%cThunderwood).channel, 19, velo IF (count = 1) AND (stat <> 6) THEN mPlay mc(%cThunderwood).channel, 15, 25 '2 * ratchet ELSEIF note(0) AND ISFALSE(count AND &B0111) AND(stat <> 6) THEN mPlay mc(%cThunderwood).channel, 15, 15 END IF END IF IF (stat = 2) OR (stat = 5) OR (stat = 6) OR (stat = 8) THEN 'rolls 'altijd regen, drukker volgens input dens 'ofwel (rnd) wind of ratchet IF RND < (Devi/MaxDevi) ^ 2 THEN velo = 20 + MIN(1, MyDens / 17!) * SQR(RND) * 100 mPlay mc(%cThunderwood).channel, 16, velo 'regen : drukker bij hogere midiindens END IF velo = MIN(1, MyDens/12!) windorratchet = (10 * windorratchet + RND) / 11 IF INT(windorratchet) THEN velo = velo * 127 mPlay mc(%cThunderwood).channel, 24, velo 'wind ELSE velo = 1 + (velo ^ 3) * 20 mPlay mc(%cThunderwood).channel, 15, velo END IF END IF IF(stat = 3) OR (stat = 5) OR (stat = 7) OR (stat = 8) THEN 'vogeltje 'bird: speed afhankelijk van dens and tessituur 'thunder o/d 16 ticks 'ratchet af en toe velo = SQR(SQR(MIN(1, Mw_MidiIn.dens / 12!) * (Devi/MaxDevi))) * 127 Slider(TaskEx(%mw_tw).Slidernumbers(3)).value = velo IF ISFALSE(count) THEN mPlay mc(%cThunderwood).channel, 19, 20 ELSEIF (RND < 1/16) AND (stat<>5) THEN mPlay mc(%cThunderwood).channel, 15, 20 END IF END IF ' IF stat = 8 ' '!!!! think of something !!! ' END IF 'chimes: allways.. IF ISFALSE BIT(count, 0) THEN velo = 10 + (1 - (Devi/MaxDevi)) * 20 mPlay mc(%cThunderwood).channel, 17, velo END IF note(0) = 0: note(1) = 0: note(2) = 0 END SUB SUB RobotGarden_troms STATIC this AS LONG STATIC pattern AS STRING * 32 STATIC played AS DWORD 'flags means note(BIT) has been played at leat once STATIC writecount AS LONG STATIC playcount AS LONG STATIC LastNote AS BYTE STATIC NwNote AS BYTE STATIC rawfreq AS SINGLE STATIC middle AS SINGLE STATIC devi AS SINGLE STATIC belletjes AS BYTE LOCAL TaskParamLabels() AS ASCIIZ * 8 LOCAL freqscale AS SINGLE LOCAL i AS LONG LOCAL n AS LONG DIM note(2) AS LOCAL BYTE DIM vel(2) AS LOCAL BYTE IF ISFALSE(this) THEN this = %RG_Troms rawfreq = .2 belletjes = 124 DIM TaskParamLabels(1) TaskParamLabels(0) = "frscal" 'rescale task frequency - added because task was often too fast.. TaskParamLabels(1) = "HiNoLim" 'highest note expected as input 110 voor moniek op viool, 70 voor eigen stem.. MakeTaskParameterDialog BYVAL this, 2, Slider(),0,UDctrl(),TaskParamLabels() Slider(TaskEx(this).Slidernumbers(1)).value = 110 SendMessage Slider(TaskEx(this).Slidernumbers(1)).h, %TBM_SETPOS,%True, Slider(TaskEx(this).Slidernumbers(1)).value ' MSGBOX "to be debugged!",,FUNCNAME$ END IF 'get 3 strongest notes from input FOR i = 1 TO 128 n = ASC(MID$(Task(%cqtlst).Har, i, 1)) IF n < 30 THEN ITERATE FOR IF n > vel(0) THEN note(2) = note(1) note(1) = note(0) note(0) = i vel(2) = vel(1) vel(1) = vel(0) vel(0) = n END IF NEXT FOR i = 120 TO 126 mPlay mc(%cPiperola).channel, i, 0 NEXT 'map to troms range n = MAX(12, slider(taskEX(this).Slidernumbers(1)).value - 56) 'slider = highest expected note, lowest is allways 56 FOR i = 0 TO 2 'the following should be dependant on Leaky Tess also IF note(i) THEN note(i) = MAX(23, MIN(23 + 25 * ((note(i) - 56)/n), 48)) NEXT 'middle and devi for notes AS MAPPED TO TROMS!! IF note(0) THEN middle = ( 21! * middle + note(0) ) / 22 devi = (8 * devi + ABS(note(0) - middle) + ABS(note(1) - middle) + ABS(note(2) - middle) ) / 11 END IF 'too small devi : we ge impatient and start playing other notes IF (devi < .6) AND note(0) > 0 THEN note(0) = note(0) - 2 + RND(1) * 4 ELSEIF (devi < 1) AND note(0) > 0 THEN note(0) = MIN(47, MAX(1, note(0) - 1 + RND(1) * 2)) END IF 'write notes in pattern INCR writecount: writecount = writecount MOD 32 IF (ISFALSE note(0)) THEN IF (BIT(played, writecount)>0) THEN MID$(pattern, writecount + 1) = CHR$(0) ELSE MID$(pattern, writecount + 1) = CHR$(note(0)) BIT RESET played, writecount '= 0 END IF INCR writecount IF note(1) THEN IF (BIT(played, writecount)>0) THEN MID$(pattern, writecount + 1) = CHR$(note(1)) BIT RESET played, writecount ') = 0 END IF END IF INCR writecount IF note(2) THEN IF (BIT(played, writecount)>0) THEN MID$(pattern, writecount + 1) = CHR$(note(2)) BIT RESET played, writecount ') = 0 END IF END IF 'play troms INCR playcount: playcount = playcount MOD 32 NwNote = ASC(MID$(pattern, playcount + 1)) IF NwNote = LastNote THEN IF RND > MW_MidiIn.dens / 15 THEN NwNote = 0'grotere dens > meer herhaling END IF IF NwNote THEN mPlay mc(%cTroms).channel, NwNote, 10 + MW_MidiIn.vol / 2 BIT SET played, playcount LastNote = NwNote END IF 'if small devi, mPlay springs IF Devi < 6 THEN #IF %DEF(%MW_DEBUGGERON) kl_debug idbg, "SPRINGS! (low devi:" + STR$(devi) + ")" #ENDIF mPlay mc(%cSpringers).channel, 120, 20 + MW_MidiIn.vol/3 'adapt to iedal velo mPlay mc(%cSpringers).channel, 121, 20 + MW_MidiIn.vol/3 'adapt to iedal velo mPlay mc(%cSpringers).channel, 122, 20 + MW_MidiIn.vol/3 'adapt to iedal velo mPlay mc(%cSpringers).channel, 123, 20 + MW_MidiIn.vol/3 'adapt to iedal velo END IF 'set new task freq freqscale = SQR(slider(taskEX(this).Slidernumbers(0)).value)/8 RawFreq = (5 * RawFreq + freqscale * MW_MidiIn.dens) / 6 task(this).freq = MAX(.3, INT(RawFreq * 3) / 3) 'the following can only happen when a note has been played recently IF ISFALSE note(0) THEN EXIT SUB 'if high devi, mPlay shakers IF Devi > 18 THEN #IF %DEF(%MW_DEBUGGERON) kl_debug idbg, "SHAKE! (high devi:" + STR$(devi) + ")" #ENDIF mPlay mc(%cSpringers).channel, INT(124 + 4 * RND), 15 + MW_MidiIn.vol / 2 END IF 'if rather low freq, high input, mPlay piper bells IF task(this).freq < 8 THEN IF note(0) >= 34 THEN #IF %DEF(%MW_DEBUGGERON) kl_debug idbg, "BLS (lf:" + STR$(task(this).freq) + ", hn: trns2" + STR$(note(0)) + ")" #ENDIF INCR belletjes IF belletjes > 126 THEN belletjes = 124 mPlay mc(%cPiperola).channel, belletjes, MAX(30, 30 + MW_MidiIn.vol/2) END IF END IF IF (task(this).freq < 1) OR (RND < SQR((1 / task(this).freq))) THEN mPlay mc(%cPiperola).channel, 120 + INT(RND * 3), MAX(3, 30 + MW_MidiIn.vol/2) END IF END SUB SUB RobotGarden_piano STATIC this AS LONG STATIC vel1() AS BYTE STATIC vel2() AS BYTE STATIC vel3() AS BYTE STATIC vel4() AS BYTE STATIC vel5() AS BYTE STATIC vel6() AS BYTE STATIC c1 AS DWORD 'play if recent not on '11's STATIC c2 AS DWORD '+1 ' lmid dens '9's STATIC c3 AS DWORD '-1 ' mid dens '8's STATIC c4 AS DWORD '-7 ' hmid dens '7's STATIC c5 AS DWORD '-12 ' hi dens '5's STATIC c6 AS DWORD STATIC LastNieuwTime AS DWORD LOCAL PostSilence AS INTEGER STATIC cgen AS DWORD STATIC myinvol AS SINGLE LOCAL n AS BYTE LOCAL i AS LONG LOCAL nieuw AS LONG LOCAL denst AS SINGLE LOCAL lpcnt AS LONG LOCAL lh AS harmtype IF ISFALSE this THEN this = %RG_Pi c1 = 58: c2 = 58: c3 = 58: c4 = 58: c5 = 58: c6 = 58 DIM vel1(127): DIM vel2(127): DIM vel3(127): DIM vel4(127): DIM vel5(127): DIM vel6(127) END IF lh.vel = ReturnStrongestInHar(Task(%cqtlst).Har, 4) denst = 1 + SQR(RND) * MW_MidiIn.Dens 'rnd * 5 '0 nieuw = 0 FOR i = 55 TO mc(%cPiano).hightes n = ASC(MID$(lh, i, 1)) IF n > 12 THEN INCR nieuw ' n = 127 * (n/127)^2 vel1(i) = MAX(n, INT((12! * vel1(i) + n) / 13)) vel2(i + 1) = MAX(n, INT((12! * vel2(i + 1) + n) / 13)) vel3(i - 1) = MAX(n, INT((12! * vel3(i - 1) + n) / 13)) vel4(i - 7) = MAX(n, INT((12! * vel4(i - 7) + n) / 13)) vel5(i - 12) = MAX(n,INT((12! * vel5(i - 12) + n) / 13)) 'starting from .lowtes we shouldn't get out of bounds here vel6(i + 7) = MAX(n, INT((12! * vel6(i + 7) + n) / 13)) IF vel1(i) < 12 THEN vel1(i) = 0 IF vel2(i + 1) < 12 THEN vel2(i + 1) = 0 IF vel3(i - 1) < 12 THEN vel3(i - 1) = 0 IF vel4(i - 7) < 12 THEN vel4(i - 7) = 0 IF vel5(i - 12) < 12 THEN vel5(i - 12) = 0 IF vel6(i + 7) < 12 THEN vel6(i +7) = 0 NEXT 'reset har ' mc(%cPiano).Har(1).vel = SolveHar(mc(%cPiano).Har(0), -1, 0) ' STRING$(128, CHR$(0)) mc(%cPiano).Har(1).vel = STRING$(128, CHR$(0)) IF ISFALSE(nieuw) THEN myinvol = myinvol * .9 IF (TIMER - LastNieuwTime) > 5 THEN LastNieuwTime = TIMER RESET vel1(): RESET vel2(): RESET vel3(): RESET vel4(): RESET vel5(): RESET vel6() InstrumPlay mc(%cPiano) 'aka allnotesoff END IF ' EXIT SUB ELSE myinvol = 4 * SQR(MW_MidiIn.vol) IF (TIMER - LastNieuwTime) > 1 THEN PostSilence = 1 LastNieuwTime = TIMER END IF INCR cgen: cgen = cgen MOD 27720 '11 * 9 * 8 * 7 * 5 IF ISFALSE (cgen MOD 5) THEN '------------------voice 1 IF denst > 20 THEN lpcnt = 0 DO UNTIL vel1(c1) INCR c1 IF c1 => mc(%cPiano).hightes THEN c1 = 55 'lowest note on violin INCR lpcnt IF lpcnt > 50 THEN EXIT LOOP LOOP ELSE INCR c1 IF c1 => mc(%cPiano).hightes THEN c1 = 55 'lowest note on violin END IF IF vel1(c1) THEN AddNote2Har mc(%cPiano).Har(1), c1, (vel1(c1) + myinvol) / 2 vel2(c1 + 1) = MAX(vel2(c1 + 1), vel1(c1 + 1)) vel3(c1 + 2) = MAX(vel3(c1 + 2), vel1(c1 + 2)) vel1(c1 + 1) = 0: vel1(c1 + 1) = 0 vel1(c1) = vel1(c1)* 0 '* .7 DelNote2Har Task(%CqtLst).Har, c1 c1 = c1 + 2 + RND * 3 END IF END IF IF ISFALSE (cgen MOD 7) THEN '------------------voice 2 IF denst > 19 THEN lpcnt = 0 DO UNTIL vel2(c2) INCR c2 IF c2 => mc(%cPiano).hightes THEN c2= 56 'lowest note on violin INCR lpcnt IF lpcnt > 50 THEN EXIT LOOP LOOP ELSE INCR c2 IF c2 => mc(%cPiano).highTes THEN c2 = 56 'x + 1 END IF IF vel2(c2) THEN AddNote2Har mc(%cPiano).Har(1), c2, (vel2(c2) + myinvol) / 2 vel3(c2 + 1) = MAX(vel3(c2 + 1), vel2(c2 + 1)) vel4(c2 + 2) = MAX(vel4(c2 + 2), vel2(c2 + 2)) vel2(c2 + 1) = 0: vel2(c2 + 1) = 0 vel2(c2) = vel2(c2) * 0 '.7 DelNote2Har Task(%CqtLst).Har, c2 c2 = c2 + 2 + RND * 3 END IF END IF IF ISFALSE (cgen MOD 8) THEN '-------------------voice 3 IF denst > 17 THEN lpcnt = 0 DO UNTIL vel3(c3) INCR c3 IF c3 => mc(%cPiano).hightes THEN c3 = 55 'lowest note on violin INCR lpcnt IF lpcnt > 50 THEN EXIT LOOP LOOP ELSE INCR c3 IF c3 => mc(%cPiano).highTes THEN c3 = 54 'x - 1 END IF IF vel3(c3) THEN AddNote2Har mc(%cPiano).Har(1), c3, (vel3(c3) + myinvol) / 2 vel4(c3 + 1) = MAX(vel4(c3 + 1), vel3(c3 + 1)) vel5(c3 + 2) = MAX(vel5(c3 + 2), vel3(c3 + 2)) vel3(c3 + 1) = 0: vel3(c3 + 1) = 0 vel3(c3) = vel3(c3) * 0 '.7 DelNote2Har Task(%CqtLst).Har, c3 c3 = c3 + 2 + RND * 3 END IF END IF IF ISFALSE (cgen MOD 9) THEN '-------------------voice 4 IF (denst > 16) OR PostSilence THEN lpcnt = 0 DO UNTIL vel4(c4) INCR c4 IF c4 => mc(%cPiano).hightes THEN c4 = 55 'lowest note on violin INCR lpcnt IF lpcnt > 50 THEN EXIT LOOP LOOP ELSE INCR c4 IF c4 => mc(%cPiano).highTes THEN c4 = 48 'x - 7 END IF IF vel4(c4) THEN AddNote2Har mc(%cPiano).Har(1), c4, (vel4(c4) + myinvol) / 2 vel5(c4 + 1) = MAX(vel5(c4 + 1), vel4(c4 + 1)) vel6(c4 + 2) = MAX(vel6(c4 + 2), vel4(c4 + 2)) vel4(c4 + 1) = 0: vel4(c4 + 1) = 0 vel4(c4) = vel4(c4) * 0 '.7 DelNote2Har Task(%CqtLst).Har, c4 c4 = c4 + 2 + RND * 3 END IF END IF IF ISFALSE (cgen MOD 11) THEN '-------------------voice 5 IF (denst > 15) OR PostSilence THEN lpcnt = 0 DO UNTIL vel5(c5) INCR c5 IF c5 => mc(%cPiano).hightes THEN c5 = 55 'lowest note on violin INCR lpcnt IF lpcnt > 50 THEN EXIT LOOP LOOP ELSE INCR c5 IF c5 => mc(%cPiano).highTes THEN c5 = 43 'x - 12 END IF IF vel5(c5) THEN AddNote2Har mc(%cPiano).Har(1), c5, (vel5(c5) + myinvol) / 2 AddNote2Har mc(%cPiano).Har(1), c5 - 12, (vel5(c5) + myinvol) / 2 vel6(c5 + 1) = MAX(vel6(c5 + 1), vel5(c5 + 1)) vel1(c5 + 2) = MAX(vel1(c5 + 2), vel5(c5 + 2)) vel5(c5 + 1) = 0: vel5(c5 + 1) = 0 vel5(c5) = vel5(c5) * 0 '.7 DelNote2Har Task(%CqtLst).Har, c5 c5 = c5 + 2 + RND * 3 END IF END IF IF ISFALSE (cgen MOD 13) OR PostSilence THEN '------------------voice 6 IF (denst > 12) OR PostSilence THEN lpcnt = 0 DO UNTIL vel6(c6) INCR c6 IF c6 => mc(%cPiano).hightes THEN c6 = 55 'lowest note on violin INCR lpcnt IF lpcnt > 50 THEN EXIT LOOP LOOP ELSE INCR c6 IF c6 => mc(%cPiano).highTes THEN c6 = 62 'x + 7 END IF IF vel6(c6) THEN AddNote2Har mc(%cPiano).Har(1), c6, (vel6(c6) + myinvol) / 2 vel1(c6 + 1) = MAX(vel1(c6 + 1), vel6(c6 + 1)) vel2(c6 + 2) = MAX(vel2(c6 + 2), vel6(c6 + 2)) vel6(c6 + 1) = 0: vel6(c6 + 1) = 0 vel6(c6) = vel6(c6) * 0 '.7 DelNote2Har Task(%CqtLst).Har, c6 END IF END IF InstrumPlay mc(%cPiano) END SUB SUB RobotGarden_Tubi STATIC this AS LONG STATIC vel1() AS BYTE STATIC vel2() AS BYTE STATIC vel3() AS BYTE STATIC vel4() AS BYTE STATIC vel5() AS BYTE STATIC vel6() AS BYTE STATIC c1 AS DWORD '0 'play if recent not on '11's STATIC c2 AS DWORD '+.5 ' lmid dens '9's STATIC c3 AS DWORD '-.5 ' mid dens '8's STATIC c4 AS DWORD '+11 ' hmid dens '7's STATIC c5 AS DWORD '+13 ' hi dens '5's STATIC c6 AS DWORD '+13.5 STATIC LastNieuwTime AS DWORD LOCAL PostSilence AS INTEGER STATIC cgen AS DWORD STATIC myinvol AS SINGLE LOCAL n AS BYTE LOCAL i AS LONG LOCAL nieuw AS LONG LOCAL denst AS SINGLE LOCAL lpcnt AS LONG LOCAL lh AS harmtype IF ISFALSE this THEN this = %RG_tubi c1 = 58: c2 = 58: c3 = 58: c4 = 58: c5 = 58: c6 = 58 DIM vel1(127): DIM vel2(127): DIM vel3(127): DIM vel4(127): DIM vel5(127): DIM vel6(127) ' CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "combine RG_Tubi with MW_Imi_Listn on vibi, klung and/or piano" END IF lh.vel = ReturnStrongestInHar(Task(%cqtlst).Har, 4) denst = 1 + SQR(RND) * MW_MidiIn.Dens 'rnd * 5 '0 nieuw = 0 FOR i = 60 TO (mc(%cPiano).hightes - 12) n = ASC(MID$(lh, i, 1)) IF n > 12 THEN INCR nieuw: n = 12 + SQR(n - 12) ' n = 127 * (n/127)^2 vel1(i) = MAX(n, INT((12! * vel1(i) + n) / 13)) vel2(i - 36) = MAX(n, INT((12! * vel2(i - 36) + n) / 13)) vel3(i - 37) = MAX(n, INT((12! * vel3(i - 37) + n) / 13)) vel4(i + 11) = MAX(n, INT((12! * vel4(i + 11) + n) / 13)) vel5(i - 13) = MAX(n,INT((12! * vel5(i - 13) + n) / 13)) 'starting from .lowtes we shouldn't get out of bounds here vel6(i - 23) = MAX(n, INT((12! * vel6(i - 23) + n) / 13)) IF vel1(i) < 12 THEN vel1(i) = 0 IF vel2(i - 36) < 12 THEN vel2(i - 36) = 0 IF vel3(i - 37) < 12 THEN vel3(i - 37) = 0 IF vel4(i + 11) < 12 THEN vel4(i + 11) = 0 IF vel5(i - 13) < 12 THEN vel5(i - 13) = 0 IF vel6(i - 23) < 12 THEN vel6(i - 23) = 0 NEXT 'reset har mc(%cTubi).Har(1).vel = STRING$(128, CHR$(0)) IF ISFALSE(nieuw) THEN myinvol = myinvol * .9 IF (TIMER - LastNieuwTime) > 5 THEN LastNieuwTime = TIMER RESET vel1(): RESET vel2(): RESET vel3(): RESET vel4(): RESET vel5(): RESET vel6() InstrumPlay mc(%cTubi) 'aka allnotesoff END IF ' EXIT SUB ELSE myinvol = 4 * SQR(MW_MidiIn.vol) IF (TIMER - LastNieuwTime) > 1 THEN PostSilence = 1 LastNieuwTime = TIMER END IF INCR cgen: cgen = cgen MOD 27720 '11 * 9 * 8 * 7 * 5 IF ISFALSE (cgen MOD 5) THEN '------------------voice 1 IF denst > 20 THEN lpcnt = 0 DO UNTIL vel1(c1) INCR c1 IF c1 => (mc(%cTubi).hightes) THEN c1 = 60 INCR lpcnt IF lpcnt > 50 THEN EXIT LOOP LOOP ELSE INCR c1 IF c1 => (mc(%cTubi).hightes) THEN c1 = 60 END IF IF vel1(c1) THEN AddNote2Har mc(%cTubi).Har(1), c1 + 0, (vel1(c1) + myinvol) / 2 vel2(c1 + 1) = MAX(vel2(c1 + 1), vel1(c1 + 1)) vel3(c1 + 2) = MAX(vel3(c1 + 2), vel1(c1 + 2)) vel1(c1 + 1) = 0: vel1(c1 + 1) = 0 vel1(c1) = vel1(c1)* 0 '* .7 DelNote2Har Task(%CqtLst).Har, c1 c1 = c1 + 2 + RND * 3 END IF END IF IF ISFALSE (cgen MOD 7) THEN '------------------voice 2 IF denst > 19 THEN lpcnt = 0 DO UNTIL vel2(c2) INCR c2 IF c2 => (mc(%cTubi).hightes) THEN c2= 72 INCR lpcnt IF lpcnt > 50 THEN EXIT LOOP LOOP ELSE INCR c2 IF c2 => (mc(%cTubi).highTes) THEN c2 = 72 'x + 1 END IF IF vel2(c2) THEN AddNote2Har mc(%cTubi).Har(1), c2 - 36, (vel2(c2) + myinvol) / 2 vel3(c2 + 1) = MAX(vel3(c2 + 1), vel2(c2 + 1)) vel4(c2 + 2) = MAX(vel4(c2 + 2), vel2(c2 + 2)) vel2(c2 + 1) = 0: vel2(c2 + 1) = 0 vel2(c2) = vel2(c2) * 0 '.7 DelNote2Har Task(%CqtLst).Har, c2 c2 = c2 + 2 + RND * 3 END IF END IF IF ISFALSE (cgen MOD 8) THEN '-------------------voice 3 IF denst > 17 THEN lpcnt = 0 DO UNTIL vel3(c3) INCR c3 IF c3 => 108 THEN c3 = 72 INCR lpcnt IF lpcnt > 50 THEN EXIT LOOP LOOP ELSE INCR c3 IF c3 => 108 THEN c3 = 72 'x - 1 END IF IF vel3(c3) THEN AddNote2Har mc(%cTubi).Har(1), c3 - 37, (vel3(c3) + myinvol) / 2 vel4(c3 + 1) = MAX(vel4(c3 + 1), vel3(c3 + 1)) vel5(c3 + 2) = MAX(vel5(c3 + 2), vel3(c3 + 2)) vel3(c3 + 1) = 0: vel3(c3 + 1) = 0 vel3(c3) = vel3(c3) * 0 '.7 DelNote2Har Task(%CqtLst).Har, c3 c3 = c3 + 2 + RND * 3 END IF END IF IF ISFALSE (cgen MOD 9) THEN '-------------------voice 4 IF (denst > 16) OR PostSilence THEN lpcnt = 0 DO UNTIL vel4(c4) INCR c4 IF c4 => 96 THEN c4 = 60 INCR lpcnt IF lpcnt > 50 THEN EXIT LOOP LOOP ELSE INCR c4 IF c4 => 96 THEN c4 = 60 'x - 7 END IF IF vel4(c4) THEN AddNote2Har mc(%cTubi).Har(1), c4 + 11, (vel4(c4) + myinvol) / 2 vel5(c4 + 1) = MAX(vel5(c4 + 1), vel4(c4 + 1)) vel6(c4 + 2) = MAX(vel6(c4 + 2), vel4(c4 + 2)) vel4(c4 + 1) = 0: vel4(c4 + 1) = 0 vel4(c4) = vel4(c4) * 0 '.7 DelNote2Har Task(%CqtLst).Har, c4 c4 = c4 + 2 + RND * 3 END IF END IF IF ISFALSE (cgen MOD 11) THEN '-------------------voice 5 IF (denst > 15) OR PostSilence THEN lpcnt = 0 DO UNTIL vel5(c5) INCR c5 IF c5 => mc(%cTubi).hightes - 25 THEN c5 = 55 'lowest note on violin INCR lpcnt IF lpcnt > 50 THEN EXIT LOOP LOOP ELSE INCR c5 IF c5 => mc(%cTubi).highTes - 25 THEN c5 = 43 'x - 12 END IF IF vel5(c5) THEN AddNote2Har mc(%cTubi).Har(1), c5 + 25, (vel5(c5) + myinvol) / 2 vel6(c5 + 1) = MAX(vel6(c5 + 1), vel5(c5 + 1)) vel1(c5 + 2) = MAX(vel1(c5 + 2), vel5(c5 + 2)) vel5(c5 + 1) = 0: vel5(c5 + 1) = 0 vel5(c5) = vel5(c5) * 0 '.7 DelNote2Har Task(%CqtLst).Har, c5 c5 = c5 + 2 + RND * 3 END IF END IF IF ISFALSE (cgen MOD 13) OR PostSilence THEN '------------------voice 6 IF (denst > 12) OR PostSilence THEN lpcnt = 0 DO UNTIL vel6(c6) INCR c6 IF c6 => 120 THEN c6 = 58 INCR lpcnt IF lpcnt > 50 THEN EXIT LOOP LOOP ELSE INCR c6 IF c6 => 120 THEN c6 = 58 'x + 7 END IF IF vel6(c6) THEN AddNote2Har mc(%cTubi).Har(1), c6 - 23, (vel6(c6) + myinvol) / 2 vel1(c6 + 1) = MAX(vel1(c6 + 1), vel6(c6 + 1)) vel2(c6 + 2) = MAX(vel2(c6 + 2), vel6(c6 + 2)) vel6(c6 + 1) = 0: vel6(c6 + 1) = 0 vel6(c6) = vel6(c6) * 0 '.7 DelNote2Har Task(%CqtLst).Har, c6 END IF END IF InstrumPlay mc(%cTubi) END SUB SUB Brecht STATIC this AS LONG STATIC vel1() AS BYTE STATIC vel2() AS BYTE STATIC vel3() AS BYTE STATIC vel4() AS BYTE STATIC vel5() AS BYTE STATIC vel6() AS BYTE STATIC c1 AS DWORD 'play if recent not on '11's STATIC c2 AS DWORD '+1 ' lmid dens '9's STATIC c3 AS DWORD '-1 ' mid dens '8's STATIC c4 AS DWORD '-7 ' hmid dens '7's STATIC c5 AS DWORD '-12 ' hi dens '5's STATIC c6 AS DWORD STATIC LastNieuwTime AS DWORD STATIC started AS LONG STATIC StartedTime AS DWORD LOCAL PostSilence AS INTEGER STATIC cgen AS DWORD STATIC myinvol AS SINGLE LOCAL n AS BYTE LOCAL i AS LONG LOCAL nieuw AS LONG LOCAL denst AS SINGLE LOCAL lpcnt AS LONG LOCAL lh AS harmtype IF ISFALSE this THEN this = %Brecht c1 = 58: c2 = 58: c3 = 58: c4 = 58: c5 = 58: c6 = 58 DIM vel1(127): DIM vel2(127): DIM vel3(127): DIM vel4(127): DIM vel5(127): DIM vel6(127) END IF lh.vel = Task(%cqtlst).Har.Vel 'ReturnStrongestInHar(Task(%cqtlst).Har, 12) denst = 1 + SQR(RND) * MW_MidiIn.Dens 'rnd * 5 '0 nieuw = 0 FOR i = 55 TO mc(%cPiano).hightes n = ASC(MID$(lh, i, 1)) IF n > 12 THEN INCR nieuw vel1(i) = MAX(n, INT((12! * vel1(i) + n) / 13)) vel2(i + 1) = MAX(n, INT((12! * vel2(i + 1) + n) / 13)) vel3(i - 1) = MAX(n, INT((12! * vel3(i - 1) + n) / 13)) vel4(i - 7) = MAX(n, INT((12! * vel4(i - 7) + n) / 13)) vel5(i - 12) = MAX(n,INT((12! * vel5(i - 12) + n) / 13)) 'starting from .lowtes we shouldn't get out of bounds here vel6(i + 7) = MAX(n, INT((12! * vel6(i + 7) + n) / 13)) IF vel1(i) < 12 THEN vel1(i) = 0 IF vel2(i + 1) < 12 THEN vel2(i + 1) = 0 IF vel3(i - 1) < 12 THEN vel3(i - 1) = 0 IF vel4(i - 7) < 12 THEN vel4(i - 7) = 0 IF vel5(i - 12) < 12 THEN vel5(i - 12) = 0 IF vel6(i + 7) < 12 THEN vel6(i +7) = 0 NEXT Denst = nieuw IF nieuw THEN started = 1 IF ISFALSE startedtime THEN startedtime = TIMER END IF 'reset har mc(%cPiano).Har(1).vel = SolveHar(mc(%cPiano).Har(0), -1, 0) ' STRING$(128, CHR$(0)) IF Started AND (RND < .06) AND ((TIMER - StartedTime) < 60) THEN AddNote2Har mc(%cPiano).Har(1), 55 + RND * 36, MW_MidiIn.vol IF StartedTime AND (TIMER - StartedTime) > 66 THEN StopTask %Brecht mc(%cPiano).Har(1).vel = STRING$(128, CHR$(0)) InstrumPlay mc(%cPiano) EXIT SUB END IF IF ISFALSE(nieuw) THEN IF (TIMER - LastNieuwTime) > 5 THEN LastNieuwTime = TIMER RESET vel1(): RESET vel2(): RESET vel3(): RESET vel4(): RESET vel5(): RESET vel6() InstrumPlay mc(%cPiano) 'aka allnotesoff END IF ELSE myinvol = MW_MidiIn.vol IF (TIMER - LastNieuwTime) > 1 THEN PostSilence = 1 LastNieuwTime = TIMER END IF INCR cgen: cgen = cgen MOD 27720 '11 * 9 * 8 * 7 * 5 IF ISFALSE (cgen MOD 5) THEN '------------------voice 1 IF denst > 20 THEN lpcnt = 0 DO UNTIL vel1(c1) INCR c1: IF c1 => mc(%cPiano).hightes THEN c1 = 55 'lowest note on violin INCR lpcnt: IF lpcnt > 50 THEN EXIT LOOP LOOP ELSE INCR c1: IF c1 => mc(%cPiano).hightes THEN c1 = 55 'lowest note on violin END IF IF vel1(c1) THEN AddNote2Har mc(%cPiano).Har(1), c1, (vel1(c1) + myinvol) / 2 vel2(c1 + 1) = MAX(vel2(c1 + 1), vel1(c1 + 1)): vel3(c1 + 2) = MAX(vel3(c1 + 2), vel1(c1 + 2)) vel1(c1 + 1) = 0: vel1(c1 + 1) = 0: vel1(c1) = vel1(c1)* 0 '* .7 DelNote2Har Task(%CqtLst).Har, c1 c1 = c1 + 2 + RND * 3 END IF END IF IF ISFALSE (cgen MOD 7) THEN '------------------voice 2 IF denst > 19 THEN lpcnt = 0 DO UNTIL vel2(c2) INCR c2: IF c2 => mc(%cPiano).hightes THEN c2= 56 'lowest note on violin INCR lpcnt: IF lpcnt > 50 THEN EXIT LOOP LOOP ELSE INCR c2 IF c2 => mc(%cPiano).highTes THEN c2 = 56 'x + 1 END IF IF vel2(c2) THEN AddNote2Har mc(%cPiano).Har(1), c2, (vel2(c2) + myinvol) / 2 vel3(c2 + 1) = MAX(vel3(c2 + 1), vel2(c2 + 1)): vel4(c2 + 2) = MAX(vel4(c2 + 2), vel2(c2 + 2)) vel2(c2 + 1) = 0: vel2(c2 + 1) = 0: vel2(c2) = vel2(c2) * 0 '.7 DelNote2Har Task(%CqtLst).Har, c2 c2 = c2 + 2 + RND * 3 END IF END IF IF ISFALSE (cgen MOD 8) THEN '-------------------voice 3 IF denst > 17 THEN lpcnt = 0 DO UNTIL vel3(c3) INCR c3: IF c3 => mc(%cPiano).hightes THEN c3 = 55 'lowest note on violin INCR lpcnt: IF lpcnt > 50 THEN EXIT LOOP LOOP ELSE INCR c3 IF c3 => mc(%cPiano).highTes THEN c3 = 54 'x - 1 END IF IF vel3(c3) THEN AddNote2Har mc(%cPiano).Har(1), c3, (vel3(c3) + myinvol) / 2 vel4(c3 + 1) = MAX(vel4(c3 + 1), vel3(c3 + 1)): vel5(c3 + 2) = MAX(vel5(c3 + 2), vel3(c3 + 2)) vel3(c3 + 1) = 0: vel3(c3 + 1) = 0: vel3(c3) = vel3(c3) * 0 '.7 DelNote2Har Task(%CqtLst).Har, c3 c3 = c3 + 2 + RND * 3 END IF END IF IF ISFALSE (cgen MOD 9) THEN '-------------------voice 4 IF (denst > 16) OR PostSilence THEN lpcnt = 0 DO UNTIL vel4(c4) INCR c4:IF c4 => mc(%cPiano).hightes THEN c4 = 55 'lowest note on violin INCR lpcnt: IF lpcnt > 50 THEN EXIT LOOP LOOP ELSE INCR c4 IF c4 => mc(%cPiano).highTes THEN c4 = 48 'x - 7 END IF IF vel4(c4) THEN AddNote2Har mc(%cPiano).Har(1), c4, (vel4(c4) + myinvol) / 2 vel5(c4 + 1) = MAX(vel5(c4 + 1), vel4(c4 + 1)): vel6(c4 + 2) = MAX(vel6(c4 + 2), vel4(c4 + 2)) vel4(c4 + 1) = 0: vel4(c4 + 1) = 0: vel4(c4) = vel4(c4) * 0 '.7 DelNote2Har Task(%CqtLst).Har, c4 c4 = c4 + 2 + RND * 3 END IF END IF IF ISFALSE (cgen MOD 11) THEN '-------------------voice 5 IF (denst > 15) OR PostSilence THEN lpcnt = 0 DO UNTIL vel5(c5) INCR c5: IF c5 => mc(%cPiano).hightes THEN c5 = 55 'lowest note on violin INCR lpcnt: IF lpcnt > 50 THEN EXIT LOOP LOOP ELSE INCR c5: IF c5 => mc(%cPiano).highTes THEN c5 = 43 'x - 12 END IF IF vel5(c5) THEN AddNote2Har mc(%cPiano).Har(1), c5, (vel5(c5) + myinvol) / 2 AddNote2Har mc(%cPiano).Har(1), c5 - 12, (vel5(c5) + myinvol) / 2 vel6(c5 + 1) = MAX(vel6(c5 + 1), vel5(c5 + 1)): vel1(c5 + 2) = MAX(vel1(c5 + 2), vel5(c5 + 2)) vel5(c5 + 1) = 0: vel5(c5 + 1) = 0: vel5(c5) = vel5(c5) * 0 '.7 DelNote2Har Task(%CqtLst).Har, c5 c5 = c5 + 2 + RND * 3 END IF END IF IF ISFALSE (cgen MOD 13) OR PostSilence THEN '------------------voice 6 IF (denst > 12) OR PostSilence THEN lpcnt = 0 DO UNTIL vel6(c6) INCR c6: IF c6 => mc(%cPiano).hightes THEN c6 = 55 'lowest note on violin INCR lpcnt: IF lpcnt > 50 THEN EXIT LOOP LOOP ELSE INCR c6: IF c6 => mc(%cPiano).highTes THEN c6 = 62 'x + 7 END IF IF vel6(c6) THEN AddNote2Har mc(%cPiano).Har(1), c6, (vel6(c6) + myinvol) / 2 vel1(c6 + 1) = MAX(vel1(c6 + 1), vel6(c6 + 1)): vel2(c6 + 2) = MAX(vel2(c6 + 2), vel6(c6 + 2)) vel6(c6 + 1) = 0: vel6(c6 + 1) = 0: vel6(c6) = vel6(c6) * 0 '.7 DelNote2Har Task(%CqtLst).Har, c6 END IF END IF InstrumPlay mc(%cPiano) END SUB SUB RG_Drone(OPT BYVAL hw AS LONG) 'AKA Klanklagen STATIC this AS LONG, ins() AS LONG, hwin AS LONG LOCAL instrum AS LONG, i AS LONG, j AS LONG, flag AS LONG LOCAL h AS harmtype, sum AS harmtype LOCAL hist AS STRING * 16, b AS STRING LOCAL nc AS LONG, low AS BYTE, hi AS BYTE STATIC leakyinvol AS SINGLE DIM histn(15) AS LOCAL BYTE AT VARPTR(hist) IF hw > 0 THEN hwin = hw ELSEIF hw < 0 THEN hwin = 0 END IF IF ISFALSE this THEN this = %rg_drone LeakyInvol = 20 DIM ins(3): ins(0) = 4: ins(1) = 2: ins(2) = 2: ins(3) = 6 'harma, bourdon, piper, huma END IF 'read checkboxes DIALOG DOEVENTS FOR i = 0 TO 3 CONTROL GET CHECK hwin, i TO j IF j = 1 THEN BIT SET instrum, i NEXT 'get strongest notes from in put h.vel = ReturnStrongestInHar(Task(%cqtLst).Har, 3) MID$(h.vel, 88) = STRING$(38, 0) 'added 030818 'remember which notes were played FOR i = 29 TO 88 ' was 108 @030818 IF ASC(MID$(h.vel, i)) > 24 THEN hist = CHR$(i) + hist: INCR nc hi = i: IF ISFALSE low THEN low = i END IF NEXT 'wind dependent from input velo's Modemess mc(ins(0)).channel, 7, (leakyinvol * BIT(instrum, 0)) mc(ins(2)).ctrl(7) = INT((leakyinvol * BIT(instrum, 2))) PiperolaWind mc(ins(2))', INT((leakyinvol * BIT(instrum, 2))) mc(ins(3)).ctrl(7) = INT((leakyinvol * BIT(instrum, 3))) HumanolaWind mc(ins(3))', INT((leakyinvol * BIT(instrum, 3))) ' CONTROL SET TEXT gh.cockpit, %GMT_AUTHOR, "humavol" + STR$(leakyinvol * BIT(instrum, 3)) IF ISFALSE nc THEN leakyinvol = leakyinvol * .85: EXIT SUB 'diminuendo - actual note off only @ toggle task or instrum select leakyinvol = MW_MidiIn.vol 'if no polyphony, get low and hi relative to melody IF low = hi THEN low = MIN(low, histn(nc), histn(nc + 1), histn(nc + 2)): hi = MAX(hi, histn(nc), histn(nc + 1), histn(nc + 2)) END IF 'what we mPlay depends on instrum selection 'instrum with highest nr allways imitates input 'second takes notes from hist that are closest to imitator 'third takes solvehar from overall har 'humanola doubles strongest notes from overall har SELECT CASE instrum CASE 1:mc(ins(0)).har(1).vel = h.vel 'harma solo - mPlay strongest input notes.. CASE 2 'bourdon solo - mPlay strongest input notes two octaves lower.. POKE$ VARPTR(h.vel), PEEK$(VARPTR(h.vel) + 12, 115): mc(ins(1)).har(1).vel = h.vel POKE$ VARPTR(h.vel), PEEK$(VARPTR(h.vel) + 12, 115): mc(ins(1)).har(1).vel = Sumhar(h, mc(%cKlung).har(1)) CASE 3 'harma + bourdon POKE$ VARPTR(h.vel), PEEK$(VARPTR(h.vel) + 12, 115): mc(ins(1)).har(1).vel = h.vel POKE$ VARPTR(h.vel), PEEK$(VARPTR(h.vel) + 12, 115): mc(ins(1)).har(1).vel = Sumhar(h, mc(%cKlung).har(1)) 'harma plays 2 notes from history that are closest to one of the other notes flag = 0 hb2note: FOR i = nc TO UBOUND(histn) IF INSTR(MID$(hist, 1, nc), MID$(hist, i + 1, 1)) THEN ITERATE FOR IF ISFALSE histn(i) THEN ITERATE FOR FOR j = 0 TO nc - 1 IF ABS(histn(j) - histn(i)) < ABS(histn(j) - ASC(b)) THEN b = CHR$(histn(i)) ELSEIF ABS(histn(j) - histn(i)) = ABS(histn(j) - ASC(b)) THEN IF (ASC(b) < low) OR (ASC(b) > hi) THEN b = CHR$(histn(j)) END IF NEXT NEXT IF LEN(b) THEN 'REPLACE b WITH CHR$(0) IN hist AddNote2Har mc(ins(0)).har(1), ASC(b), 64 IF ISFALSE flag THEN flag = 1: b = "": GOTO hb2note ELSE AddNote2Har mc(ins(0)).har(1), low + 2, 64 IF ISFALSE flag THEN AddNote2Har mc(ins(0)).har(1), hi - 1, 64 END IF CASE 4: mc(ins(2)).har(1).vel = h.vel 'piper solo - mPlay strongest input notes.. CASE 5 'piper + harma mc(ins(2)).har(1).vel = h.vel flag = 0 hp2note: FOR i = nc TO UBOUND(histn) IF INSTR(MID$(hist, 1, nc), MID$(hist, i + 1, 1)) THEN ITERATE FOR IF ISFALSE histn(i) THEN ITERATE FOR FOR j = 0 TO nc - 1 IF ABS(histn(j) - histn(i)) < ABS(histn(j) - ASC(b)) THEN b = CHR$(histn(i)) ELSEIF ABS(histn(j) - histn(i)) = ABS(histn(j) - ASC(b)) THEN IF (ASC(b) < low) OR (ASC(b) > hi) THEN b = CHR$(histn(j)) END IF NEXT NEXT IF LEN(b) THEN ' REPLACE b WITH CHR$(0) IN hist AddNote2Har mc(ins(0)).har(1), ASC(b), 64 IF ISFALSE flag THEN flag = 1: b = "": GOTO hp2note ELSE AddNote2Har mc(ins(0)).har(1), low + 2, 64 IF ISFALSE flag THEN AddNote2Har mc(ins(0)).har(1), hi - 1, 64 END IF CASE 6 'piper + bourdon mc(ins(2)).har(1).vel = h.vel 'remark mc(ins(1)) = mc(ins(2)) flag = 0 bp2note: FOR i = nc TO UBOUND(histn) IF INSTR(MID$(hist, 1, nc), MID$(hist, i + 1, 1)) THEN ITERATE FOR IF ISFALSE histn(i) THEN ITERATE FOR FOR j = 0 TO nc - 1 IF ABS(histn(j) - histn(i)) < ABS(histn(j) - ASC(b)) THEN b = CHR$(histn(i)) ELSEIF ABS(histn(j) - histn(i)) = ABS(histn(j) - ASC(b)) THEN IF (ASC(b) < low) OR (ASC(b) > hi) THEN b = CHR$(histn(j)) END IF NEXT NEXT IF LEN(b) THEN ' REPLACE b WITH CHR$(0) IN hist AddNote2Har mc(ins(1)).har(1), ASC(b), 64 AddNote2Har mc(ins(1)).har(1), ASC(b) - 12, 64 AddNote2Har mc(ins(1)).har(1), ASC(b) - 24, 64 IF ISFALSE flag THEN flag = 1: b = "": GOTO bp2note ELSE AddNote2Har mc(ins(1)).har(1), low + 2, 64 AddNote2Har mc(ins(1)).har(1), low -10 , 64 AddNote2Har mc(ins(1)).har(1), low - 22, 64 IF ISFALSE flag THEN AddNote2Har mc(ins(1)).har(1), hi - 1, 64 END IF CASE 7, 15 'piper, bourdon, harma , all 'piper imitates mc(ins(2)).har(1).vel = h.vel 'remark mc(ins(1)) = mc(ins(2)) flag = 0 bph2note: FOR i = nc TO UBOUND(histn) IF INSTR(MID$(hist, 1, nc), MID$(hist, i + 1, 1)) THEN ITERATE FOR IF ISFALSE histn(i) THEN ITERATE FOR FOR j = 0 TO nc - 1 IF ABS(histn(j) - histn(i)) < ABS(histn(j) - ASC(b)) THEN b = CHR$(histn(i)) ELSEIF ABS(histn(j) - histn(i)) = ABS(histn(j) - ASC(b)) THEN IF (ASC(b) < low) OR (ASC(b) > hi) THEN b = CHR$(histn(j)) END IF NEXT NEXT IF LEN(b) THEN ' REPLACE b WITH CHR$(0) IN hist !!REMMED 030720 na rep zo middag ?? orig? AddNote2Har mc(ins(1)).har(1), ASC(b), 10 AddNote2Har mc(ins(1)).har(1), ASC(b) - 12, 64 AddNote2Har mc(ins(1)).har(1), ASC(b) - 24, 64 IF ISFALSE flag THEN flag = 1: b = "": GOTO bph2note ELSE AddNote2Har mc(ins(1)).har(1), low + 2, 64 AddNote2Har mc(ins(1)).har(1), low - 10, 64 AddNote2Har mc(ins(1)).har(1), low - 22, 64 IF ISFALSE flag THEN AddNote2Har mc(ins(1)).har(1), hi - 13, 64 END IF 'harma adds solvehar to minor third above low.. h.vel = SumHar(mc(ins(2)).har(1), mc(ins(1)).har(1)) mc(ins(0)).har(1).vel = SolveHar(h, low + 3, 0) IF instrum = 15 THEN 'huma plays strongest 5 notes from har h.vel = SumHar(mc(ins(0)).har(1), mc(ins(1)).har(1)) mc(ins(3)).Har(1).vel = ReturnStrongestInHar(h, 5) END IF CASE > 7: CONTROL SET CHECK hwin, 0, 1: CONTROL SET CHECK hwin, 1, 1: CONTROL SET CHECK hwin, 2, 1: EXIT SUB END SELECT InstrumPlay mc(ins(0)) InstrumPlay mc(ins(1)) InstrumPlay mc(ins(3)) END SUB SUB ToggleDrone STATIC hw AS LONG, x AS LONG, y AS LONG 'make/del ctrlwin > insts can be (de)selected 'check listntask IF ISFALSE hw THEN 'switching on.. IF ISFALSE BIT (Task(%CqtLst).swit, %TASK_ONOFF) THEN StartTask %CqtLst SLEEP 100 END IF DIALOG DOEVENTS DIALOG NEW gh.Cockpit, "Drone Instr",x,y,50, 60 TO hw CONTROL ADD CHECKBOX, hw, 0, "&harma", 1,1, 48, 12 ', CALL CB_MW_IL_instroff CONTROL ADD CHECKBOX, hw, 1, "&bourdon", 1,16, 48, 12 CONTROL ADD CHECKBOX, hw, 2, "&piper", 1,31, 48, 12', CALL CB_MW_IL_instroff CONTROL ADD CHECKBOX, hw, 3, "h&uma", 1,46, 48, 12', CALL CB_MW_IL_instroff DIALOG SHOW MODELESS hw RG_Drone hw ProgChange mc(%cHarma).channel, &B1111 'all registers open ELSE DIALOG GET LOC hw TO x, y: DIALOG END hw hw = 0: RG_Drone -1 END IF END SUB SUB Klanklagen2(OPT BYVAL hwin AS LONG) 'bourdon, so, piperola, harma, humanola? 'hwin = handle to control window - only to be passed when it changes.. STATIC ihar AS Harmtype STATIC this AS LONG STATIC lastnote1 AS BYTE STATIC lastnote2 AS BYTE STATIC hw AS LONG STATIC LastChanged() AS DWORD 'ms STATIC lastinbuf AS STRING * 6 LOCAL i AS LONG, j AS LONG LOCAL piperstat AS LONG LOCAL tmp() AS BYTE LOCAL b$ STATIC localvelo AS BYTE IF ISFALSE this THEN this = %klanklagen2 REDIM LastChanged(4) localvelo = 10 END IF 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 IF ISFALSE hw THEN EXIT SUB 'update velo and wind controllers first.. localvelo = (4 * localvelo + INT(127 * (MW_MidiIn.vol/127) ^ 2))/5 'optimize for subtle wind.. CONTROL GET CHECK hw, 3 TO i IF i THEN Modemess mc(%cHarma).channel, 7, 5 + MAX(10, localvelo) ELSE Modemess mc(%cHarma).channel, 7, 0 CONTROL GET CHECK hw, 4 TO piperstat IF piperstat THEN mc(%cPiperola).ctrl(7) = MIN(62, MAX(10, localvelo)) ELSE mc(%cPiperola).ctrl(7) = 0 END IF Piperolawind mc(%cPiperola) CONTROL GET CHECK hw, 5 TO i IF i THEN mc(%cHumanola).ctrl(7) = MIN(62, MAX(6, localvelo)) ELSE mc(%cHumanola).ctrl(7) = 0 END IF HumanolaWind mc(%cHumanola) 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 notes from har FOR i = 48 TO 88 IF ASC(MID$(ihar.vel, i, 1)) > 12 THEN lastnote1 = i: EXIT FOR NEXT IF ISFALSE lastnote1 THEN 'wind off.. localvelo = localvelo * .5 ' control get check hw, 2 to j: if j then instrum(11).ctrl(1) = 0: SO_Wind instrum(11) CONTROL GET CHECK hw, 3 TO j: IF j THEN modemess mc(%cHarma).channel, 7, 0 IF piperstat THEN mc(%cPiperola).ctrl(7) = 0: Piperolawind mc(%cPiperola) CONTROL GET CHECK hw, 5 TO j: IF j THEN mc(%cHumanola).ctrl(7) = 0: Humanolawind mc(%cHumanola) EXIT SUB END IF FOR j = i + 1 TO 88 IF ASC(MID$(ihar.vel, j, 1)) > 12 THEN lastnote2 = j: EXIT FOR NEXT 'transpose to same octave DO WHILE lastnote2 > (lastnote1 + 12): lastnote2 = lastnote2 - 12: LOOP IF ISFALSE lastnote2 THEN lastnote2 = lastnote1 IF INSTR(lastinbuf, CHR$(Lastnote1)) AND INSTR(lastinbuf, CHR$(LastNote2)) THEN EXIT SUB 'so we don't go ababababa 'string magic to remember the last four different notes, (xcept if lastnote1 = lastnote2, but that's ok?) lastinbuf = REMOVE$(lastinbuf, ANY CHR$(LastNote1, LastNote2)) lastinbuf = CHR$(LastNote1, LastNote2) + lastinbuf 'fixed length, so oldest notes drop off ' CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "intrprtd nts:" + STR$(lastnote1) + STR$(lastnote2) + " lstnbf " + lastinbuf ' CONTROL SET TEXT gh.cockpit, %GMT_TITLE, "lclvl:" + STR$(localvelo) 'bourdon-------------------------- 'clusters filling space in between two lowest input notes.. 'max nr of note from textbox - might become dependent from other param.. CONTROL GET CHECK hw, 1 TO i IF i THEN IF timegettime - LastChanged(0) < 3000 THEN EXIT IF 'only update once per second.. CONTROL GET TEXT hw,101 TO b$ 'we better make this dependant from input.. i = VAL(b$) 'copy piperola part of old har IF piperstat THEN MID$(mc(%cBourdon).Har(1).vel, 62) = MID$(mc(%cBourdon).Har(0).vel, 62, 46) 'first note on bourdon = average of input notes - 12 AddNote2Har mc(%cBourdon).Har(1), INT((LastNote1 + LastNote2)/2) - 12, 12 IF i > 1 THEN AddNote2Har mc(%cBourdon).Har(1), LastNote1 - 12, 12 IF i > 2 THEN AddNote2Har mc(%cBourdon).Har(1), LastNote2 - 12, 12 IF i > 3 THEN AddNote2Har mc(%cBourdon).Har(1), INT((2 * LastNote1 + LastNote2)/3) - 12, 12 IF i > 4 THEN AddNote2Har mc(%cBourdon).Har(1), INT((LastNote1 + 2 * LastNote2)/3) - 12, 12 IF i > 5 THEN AddNote2Har mc(%cBourdon).Har(1), LastNote1 + 1, 12 END IF END IF END IF END IF InstrumPlay mc(%cBourdon) LastChanged(0) = timegettime EXIT SUB END IF 'SO-------------------------------- 'plays lowest note in history CONTROL GET CHECK hw, 2 TO i IF i THEN IF timegettime - LastChanged(1) < 2000 THEN EXIT IF REDIM tmp(5) AT VARPTR(lastinbuf) i = MIN(tmp(0), tmp(1), tmp(2), tmp(3), tmp(4), tmp(5)) '- 12 ' CONTROL SET TEXT gh.cockpit, %GMT_AUTHOR, STR$(i) + " "+CHR$(i) DO WHILE i > mc(%cSo).hightes: i = i - 12: LOOP ' CONTROL SET TEXT gh.cockpit, %GMT_MSG2, "play" + STR$(i) ' mc(%cSo).ctrl(1) = 127 ' SO_Wind mc(%cso) AddNote2Har mc(%cSo).Har(1), i, localvelo + 19 SO_Play mc(%cSo) LastChanged(1) = timegettime EXIT SUB END IF 'Harma----------------------------- 'sum and differance tones scaled to same octave + 8alta 'if high density required (@inputbox), also take input notes self and sum/dif of octaves.. CONTROL GET CHECK hw, 3 TO i IF i THEN IF timegettime - LastChanged(2) < 4000 THEN EXIT IF i = INT(f2nf((nf2f(lastnote1) + nf2f(lastnote2))/2)) 'sum - keep float internally for accuracy AddNote2Har mc(%cHarma).Har(1), i, 12 i = INT(f2nf(nf2f(lastnote2) - nf2f(lastnote1))) 'diff DO WHILE i < (lastnote1 - 12): i = i + 12: LOOP AddNote2Har mc(%cHarma).Har(1), i, 12 CONTROL GET TEXT hw, 103 TO b$ j = VAL(b$) IF j > 2 THEN AddNote2Har mc(%cHarma).Har(1), LastNote1, 12 AddNote2Har mc(%cHarma).Har(1), LastNote2, 12 IF j > 4 THEN i = INT(f2nf((nf2f(lastnote1 + 12) + nf2f(lastnote2))/2)) AddNote2Har mc(%cHarma).Har(1), i, 12 i = INT(f2nf(nf2f(lastnote2 + 12) - nf2f(lastnote1 + 12))) 'diff DO WHILE i < (lastnote1 - 12): i = i + 12: LOOP AddNote2Har mc(%cHarma).Har(1), i, 12 END IF END IF InstrumPlay mc(%cHarma) LastChanged(2) = timegettime EXIT SUB END IF 'piperola------------------------- 'highest in history and sum with last 2 IF piperstat THEN IF timegettime - LastChanged(3) < 3000 THEN EXIT IF 'copy bourdon part of old har.. MID$(mc(%cPiperola).Har(1).vel, 1) = MID$(mc(%cBourdon).Har(0).vel, 1, 62) REDIM tmp(5) AT VARPTR(lastinbuf) i = MAX(tmp(0), tmp(1), tmp(2), tmp(3), tmp(4), tmp(5)) AddNote2Har mc(%cPiperola).Har(1), i, 12 j = INT(f2nf((nf2f(i) + nf2f(lastnote1))/2)) AddNote2Har mc(%cPiperola).Har(1), j, 12 j = INT(f2nf((nf2f(i) + nf2f(lastnote2))/2)) AddNote2Har mc(%cPiperola).Har(1), j, 12 Instrumplay mc(%cPiperola) LastChanged(3) = timegettime EXIT SUB END IF 'humanola-------------------------- 'solvehar from sum of others CONTROL GET CHECK hw, 5 TO i IF i THEN IF timegettime - LastChanged(4) < 2500 THEN EXIT IF ihar.vel = Sumhar(mc(%cBourdon).har(0), mc(%cSo).har(0)) ihar.vel = SumHar(ihar, mc(%cHarma).har(0)) ihar.vel = ReturnStrongestInHar(ihar, 8) mc(%chumanola).har(1).vel = Solvehar(ihar, LastNote1, 0) InstrumPlay mc(%cHumanola) LastChanged(4) = timegettime END IF END SUB SUB ToggleKlanklagen2 STATIC hw AS LONG, x AS LONG, y AS LONG LOCAL comb$() LOCAL i AS LONG 'make/del ctrlwin > insts can be (de)selected 'check listntask IF ISFALSE hw THEN 'switching on.. IF ISFALSE BIT (Task(%CqtLst).swit, %TASK_ONOFF) THEN StartTask %CqtLst SLEEP 100 END IF REDIM comb$(5) FOR i = 0 TO 5: comb$(i) = TRIM$(STR$(i + 1)): NEXT DIALOG DOEVENTS DIALOG NEW gh.Cockpit, "Klanklagen2 Instr",x,y,82, 75 TO hw CONTROL ADD CHECKBOX, hw, 1, "&bourdon", 1, 1, 48, 12 CONTROL ADD COMBOBOX , hw, 101, comb$(), 50, 1, 30, 72, %CBS_DROPDOWNLIST COMBOBOX SELECT hw, 101, 1 CONTROL ADD CHECKBOX, hw, 2, "&so", 1, 16, 48, 12 CONTROL ADD CHECKBOX, hw, 3, "&harma", 1, 31, 48, 12 REDIM comb$(2): comb$(0) = "2": comb$(1) = "4": comb$(2) = "6" CONTROL ADD COMBOBOX, hw, 103, comb$(), 50, 31, 30 ,48, %CBS_DROPDOWNLIST COMBOBOX SELECT hw, 103, 1 CONTROL ADD CHECKBOX, hw, 4, "&piper", 1, 46, 48, 12 CONTROL ADD CHECKBOX, hw, 5, "h&umanola",1, 61, 48,12 DIALOG SHOW MODELESS hw Klanklagen2 hw ProgChange mc(%cHarma).channel, &B1111 'all registers open mc(%cSo).ctrl(1) = 127 SO_Wind mc(%cso) ELSE DIALOG GET LOC hw TO x, y: DIALOG END hw hw = 0: Klanklagen2 -1 END IF END SUB SUB RG_Flex 'bow positions fllow midiin.tes 'bows if energy for strongest frequency band from input is higher than value set with slider(0) 'beats " " " " " " slider(1); also dependent from input density 'bow speeds dependant from input velo and density STATIC this AS LONG LOCAL TaskParamLabels() AS ASCIIZ * 8 LOCAL i AS LONG, j AS LONG, mx AS SINGLE LOCAL b$ IF ISFALSE this THEN this = %RG_Flex DIM TaskParamLabels(1) TaskParamLabels(0) = "BowSens" 'rescale task frequency - added because task was often too fast.. TaskParamLabels(1) = "BeatSens" 'highest note expected as input 110 voor moniek op viool, 70 voor eigen stem.. MakeTaskParameterDialog BYVAL this, 2, Slider(),0,UDctrl(),TaskParamLabels() Slider(TaskEx(this).Slidernumbers(0)).value = 13 Slider(TaskEx(this).Slidernumbers(1)).value = 38 SendMessage Slider(TaskEx(this).Slidernumbers(0)).h, %TBM_SETPOS,%True, Slider(TaskEx(this).Slidernumbers(0)).value SendMessage Slider(TaskEx(this).Slidernumbers(1)).h, %TBM_SETPOS,%True, Slider(TaskEx(this).Slidernumbers(1)).value END IF FOR i = LBOUND(TesWeight) TO UBOUND(TesWeight) IF tesweight(i)> mx THEN mx = TesWeight(i) j = i END IF NEXT ' CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 11, STR$(mx) + " - " + STR$(Slider(TaskEx(this).Slidernumbers(0)).value/127) 'STR$(MW_MidiIn.Dens) + STR$(j) + STR$(mx) IF mx > (Slider(TaskEx(this).Slidernumbers(0)).value/127) THEN mPlay mc(%cFlex).channel, 60, 1 mPlay mc(%cFlex).channel, 63, 1 mPlay mc(%cFlex).channel, 48, MW_MidiIn.Dens mPlay mc(%cFlex).channel, 50, MW_MidiIn.vol ModeMess mc(%cFlex).channel, 1, MIN(100, INT(MW_MidiIn.Tes/254)) ModeMess mc(%cFlex).channel, 2, MIN(100, INT(MW_MidiIn.Tes * MW_MidiIn.dens / 38)) ELSE mPlay mc(%cFlex).channel, 48, 0 mPlay mc(%cFlex).channel, 50, 0 mPlay mc(%cFlex).channel, 66, 0 mPlay mc(%cFlex).channel, 67, 0 ModeMess mc(%cFlex).channel, 1, 0 ModeMess mc(%cFlex).channel, 2, 0 END IF IF mx > (Slider(TaskEx(this).slidernumbers(1)).value/127) THEN 'random kloppers FOR i = 72 TO 79 IF RND < (MW_MidiIn.Dens / 100) THEN mPlay mc(%cFlex).channel, BYVAL i,MW_MidiIn.vol NEXT END IF END SUB SUB RG_Direct(OPT BYVAL hw AS LONG) 'puff, tubi, piano (+others? > yes!) 'vraag moniek: onmiddelijk ophouden als zij ophoudt, en dan druk weer beginnen als zij herbegint STATIC hwin AS LONG STATIC lastplaytime AS SINGLE STATIC lastsilenttime AS SINGLE STATIC countinmyhar AS LONG STATIC localdens AS SINGLE STATIC tubinewattack AS LONG STATIC pianonewattack AS LONG STATIC ritmecount AS DWORD STATIC lasthar AS harmtype LOCAL newhar AS harmtype LOCAL myhar AS harmtype LOCAL temphar AS harmtype LOCAL i AS LONG LOCAL note AS SINGLE 'single for quartertone computations!! LOCAL vel AS BYTE LOCAL safetycount AS LONG LOCAL puffscalevel AS SINGLE STATIC playflag AS LONG STATIC centernote AS BYTE STATIC lastcenternote AS BYTE '=last one > 0 STATIC this AS LONG STATIC tubion AS LONG LOCAL b$ STATIC renewaltime AS LONG IF hw THEN hwin = hw EXIT SUB END IF IF ISFALSE this THEN this = %RG_direct lasthar.vel = ReturnStrongestInHar(task(%cqtlst).har, 5) countinmyhar = 55: renewaltime = 10 lastsilenttime = TIMER EXIT SUB END IF 'read renewaltime = secs of silence required before we look for a new centernote CONTROL GET TEXT hwin, 101 TO b$ IF (VAL(b$)<> renewaltime) THEN renewaltime = VAL(b$) INCR ritmecount 'check for new input newhar.vel = ReturnStrongestInHar(task(%cqtlst).har, 5) FOR i = 55 TO 125 IF ASC(MID$(newhar.vel,i, 1)) < .5 * MW_MidiIn.vol THEN ITERATE FOR IF ASC(MID$(newhar.vel, i, 1)) > ASC(MID$(lasthar.vel, i, 1)) THEN MID$(myhar.vel, i, 1) = MID$(newhar.vel, i, 1) IF ISFALSE centernote THEN centernote = i: lastcenternote = i IF ISFALSE playflag THEN '= after a silence piano will mPlay pianonewattack times INCR tubinewattack IF (TIMER - lastsilenttime) > renewaltime * 10 THEN tubinewattack = tubinewattack + INT((TIMER - lastsilenttime)/8) IF (TIMER - lastsilenttime) > renewaltime THEN pianonewattack = MIN(24, MAX( pianonewattack, INT((TIMER - lastsilenttime) * 2))) lastsilenttime = TIMER END IF INCR playflag lastplaytime = TIMER END IF NEXT ' CONTROL SET TEXT gh.cockpit, %GMT_MSG1, STR$(tubinewattack) 'TUBI IF tubinewattack THEN 'mag tubi meespelen - diminuties naar centernote van input har (notes < 72 = quartertone diff - that's ok) IF ISFALSE(ritmecount MOD INT(MW_MidiIn.dens)) THEN 'omgekeerd evenredig met input dens >> temp blijft +- gelijk DECR tubinewattack CONTROL GET CHECK hwin, 1 TO i IF i THEN mc(%cTubi).har(1).vel = ReturnStrongestInHar(myhar, MAX(2, INT(MW_MidiIn.Dens))) 'IF ALL zero's take old har again IF mc(%cTubi).har(1).vel = STRING$(128, 0) THEN mc(%cTubi).har(1).vel = mc(%cTubi).har(0).vel AddNote2Har mc(%cTubi).har(1), centernote, 18 AddNote2Har mc(%cTubi).har(1), centernote + 12, 18 AddNote2Har mc(%cTubi).har(1), centernote - 12, 18 mc(%cTubi).har(1).vel = ConvergeHar$(mc(%cTubi).har(1), centernote, 1.6) 'was 1.5 'DiminuteHar$(mc(%cTubi).har(1), centernote, 11, 4) InstrumPlay mc(%cTubi) END IF END IF END IF 'PIANO 'on new attack adds strongest notes from input to own history, converges and plays 'this is repeated more as the pause before has been longer 'then solves own chord 2 times and plays, then remains silnt until next attack CONTROL GET CHECK hwin, 0 TO i '?playerpiano ' CONTROL SET TEXT gh.cockpit, %GMT_TITLE, "pianonewattack:" + STR$(pianonewattack) IF i AND (PianoNewAttack > 0) THEN IF ISFALSE(ritmecount MOD 4) OR (pianonewattack = 1) THEN DECR pianonewattack temphar.vel = ReturnStrongestInHar(newhar, MIN(8, pianoNewAttack + 2)) temphar.vel = SumHar(temphar, mc(%cPiano).har(0)) DelShNo2har(temphar, centernote) mc(%cPiano).har(1).vel = ConvergeHar$(temphar, lastcenternote, .7) FOR i = 1 TO 16: REPLACE CHR$(i) WITH CHR$(17) IN mc(%cPiano).har(1).vel: NEXT 'guarantee min vel 17 InstrumPlay mc(%cPiano) IF ISFALSE pianonewattack THEN pianonewattack = -6 END IF ELSEIF PianoNewAttack < 0 THEN IF ISFALSE(ritmecount MOD 7) THEN INCR PianoNewAttack TempHar.vel = ReturnStrongestInHar(newhar, 1): temphar.vel = SumHar(mc(%cPiano).har(0), temphar) mc(%cPiano).har(1).vel = SolveHar(temphar, lastcenternote, 0.2) 'else empty for allnotesoff FOR i = 1 TO 11: REPLACE CHR$(i) WITH CHR$(12) IN mc(%cPiano).har(1).vel: NEXT 'guarantee min vel 12 InstrumPlay mc(%cPiano) END IF END IF ' CONTROL SET TEXT gh.cockpit, %GMT_MSG2, "centernote:" + STR$(centernote)+ " playflag:" + STR$(playflag) + " dens:"+STR$(MW_MidiIn.Dens) lasthar.vel = newhar.vel IF (TIMER - lastplaytime) > renewaltime THEN IF localdens < 10 THEN localdens = localdens + RND * 20 myhar.vel = STRING$(125, 0): lasthar.vel = STRING$(125, 0) playflag = 0: centernote = 0 EXIT SUB END IF IF ISFALSE playflag THEN EXIT SUB 'PUFF 'if (playflag > 1) and (rnd * 10 > MW_MidiIn.Dens) then exit sub CONTROL GET TEXT hwin, 105 TO b$ puffscalevel = VAL(b$) localdens = (5 * localdens + MW_MidiIn.Dens) / 6 task(this).freq = .3 + INT(2 * MAX(1.3, localdens * 3)) / 2 'if myhar contains something we can play. - transform it first!! safetycount = 0: countinmyhar = 89 DO DECR countinmyhar: IF countinmyhar <= 55 THEN countinmyhar = 125 INCR safetycount IF safetycount > 127 THEN ' CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "force exit loop - less notes then playflag indicates!!!!" + TIME$ playflag = 0 EXIT LOOP END IF vel = ASC(MID$(myhar.vel, countinmyhar, 1)) '/2 IF vel THEN note = countinmyhar vel = vel + 10 DECR playflag MID$(myhar.vel, countinmyhar, 1) = CHR$(0) EXIT LOOP END IF LOOP 'now we have an input note [55, 125] 'mirror around centre and diminute intervalwise note = 2 * centernote - note '[-15, 195] 'also mirror countinmyhar, and adapt it to input attention range countinmyhar = note DO WHILE countinmyhar < 55: countinmyhar = countinmyhar + 12: LOOP DO WHILE countinmyhar > 125: countinmyhar = countinmyhar - 12: LOOP 'interval diminutio around centre note = (2 * centernote + note)/3 '[31.6, 148] (extremen komen zeldzaam voor..) >> [55 - 96] DO WHILE note < 55: note = note + 12: LOOP DO WHILE note > 96: note = note - 12: LOOP SELECT CASE FRAC(note) CASE >= .5 'quartertone note = FIX(note) - 48 CASE ELSE note = FIX(note) END SELECT CONTROL GET CHECK hwin, 2 TO i 'if not checked we keep on doing the logic but just don't play vel = vel * puffscalevel IF i THEN mPlay mc(%cPuff).channel, note, vel END SUB SUB ToggleRgDirect STATIC hw AS LONG STATIC x AS LONG, y AS LONG 'make/del ctrlwin > insts can be (de)selected 'check listntask IF ISFALSE hw THEN 'switching on.. IF ISFALSE BIT (Task(%CqtLst).swit, %TASK_ONOFF) THEN StartTask %CqtLst SLEEP 100 END IF DIALOG NEW gh.Cockpit, "Mw_direct Instr",x,y,50, 95 TO hw CONTROL ADD CHECKBOX, hw, 0, "&piano", 1,1, 48, 12, CALL CB_MW_IL_instroff CONTROL ADD CHECKBOX, hw, 1, "&tubi", 1, 16, 48, 12 CONTROL ADD CHECKBOX, hw, 2, "p&uff", 1, 31, 48, 12 CONTROL ADD LABEL, hw, 100, "renew dT(1-9s)", 1, 50, 48, 12 DIM item(9) AS LOCAL STRING FOR x = 1 TO 10: item(x-1)=STR$(x): NEXT 'combobox voor verwachte pauzetijd CONTROL ADD COMBOBOX, hw, 101, item$(), 1, 65, 48, 120, %CBS_DROPDOWNLIST COMBOBOX SELECT hw, 101, 3 FOR x = 1 TO 10: item(x-1) = STR$(x/10): NEXT 'veloscaling voor puff CONTROL ADD COMBOBOX, hw, 105, item$(), 1, 80, 48, 120 COMBOBOX SELECT hw, 105, 6 DIALOG SHOW MODELESS hw CONTROL SET CHECK hw, 2, 1 RG_Direct hw ELSE DIALOG GET LOC hw TO x, y DIALOG END hw Piano_Silence DIALOG DOEVENTS hw = 0 RG_Direct -1 END IF END SUB SUB ES_Spri 'voice input STATIC this AS LONG STATIC lastsilenttime AS SINGLE STATIC progresscount AS LONG STATIC attackaccum AS LONG STATIC note AS BYTE LOCAL i AS LONG 'speelt zolang er verse input is en ietsje langer (gebruik attackaccum.) 'krijgt meer dan 1 'punt'voor eerste attacks, dan 1..) 'drukker (task freq - rnd choice tss glijdende min/max - hoge tempo's blijven even behouden..) naarmate 'timesincelastsilence groter is 'en naarmate denser / luidere input 'eerst n keer spring balkon dan n keer afw. balkon + grond 1, dan met grond 2 STATIC lasthar AS harmtype LOCAL newhar AS harmtype IF ISFALSE this THEN this = %ES_Spri lasthar.vel = ReturnStrongestInHar(task(%cqtlst).har, 5) lastsilenttime = TIMER EXIT SUB END IF 'see if we have sound input 'if so, incr attackackumn ' CONTROL SET TEXT gh.cockpit, %GMT_MSG1, STR$(progresscount) + STR$(attackaccum) + STR$(task(this).freq) '+ str$(lastsilenttime) newhar.vel = ReturnStrongestInHar(task(%cqtlst).har, 5) FOR i = 55 TO 125 IF ASC(MID$(newhar.vel,i, 1)) < .5 * MW_MidiIn.vol THEN ITERATE FOR IF ASC(MID$(newhar.vel, i, 1)) > ASC(MID$(lasthar.vel, i, 1)) THEN INCR attackaccum IF (lastsilenttime > 0.1) AND ((TIMER - lastsilenttime) >= 3) THEN 'sound after silence - extra attack points attackaccum = attackaccum + MIN(5, (TIMER - lastsilenttime)/2) INCR progresscount lastsilenttime = 0 END IF END IF NEXT lasthar = newhar IF (i >= 125) AND (ISFALSE lastsilenttime) THEN lastsilenttime = TIMER 'silence IF ISFALSE attackaccum THEN EXIT SUB DECR attackaccum 'note selexion: dependen on progress and rnd SELECT CASE progresscount CASE < 5: note = 121 'balkon = spring 2 CASE 5: note = 122 CASE < 9: note = CHOOSE(1 + INT(RND * 4), 121, 122, note, note) CASE 9: note = 123 CASE < 20: note = CHOOSE(1 + INT(RND * 5), 121, 122, 123, note, note) 'bigger chance for repeat.. CASE < 30: note = CHOOSE(1 + INT(RND * 4), 121, 122, 123, note) CASE ELSE: note = CHOOSE(1 + INT(RND * 3), 121, 122, 123) END SELECT mPlay mc(%cSpringers).channel, note, MIN(70, INT(MW_MidiIn.vol / 3 + 4 * attackaccum)) task(this).freq = 1 + MIN(20, MW_MidiIn.dens * 2) END SUB SUB ES_Sax 'sound input and radar STATIC this AS LONG LOCAL newhar AS harmtype, lasthar AS harmtype STATIC oldnoot AS BYTE LOCAL noot AS BYTE STATIC sonoot1 AS BYTE, sonoot2 AS BYTE LOCAL velo AS BYTE LOCAL nv AS INTEGER STATIC So_nexttime AS SINGLE, Sax_nexttime AS SINGLE 'for rythm control inmovement part STATIC saxspd AS SINGLE IF ISFALSE this THEN this = %es_sax saxspd = 0 lasthar.vel = ReturnStrongestInHar(task(%cqtlst).har, 3) modemess mc(%cSax).channel, 7, 127 'sax volume modemess mc(%cSax).channel, 16, 64 'sax feedback WriteDelayline 0,0 'dummy for init END IF 'write lowest of strongest 3 notes in delayline newhar.vel = ReturnStrongestInHar(task(%cqtlst).har, 3) FOR noot = 15 TO 120 '15 = laagste van so... velo = ASC(MID$(newhar.vel, noot+1, 1)) IF ASC(MID$(lasthar.vel, noot+1, 1)) > velo THEN ITERATE FOR IF velo > (MW_MidiIn.vol/2) THEN WriteDelayLine oldnoot, 0: WriteDelayLine noot, velo: oldnoot = noot: EXIT FOR NEXT lasthar = newhar velo = MIN(120, MAX(@pr(0).s, @pr(1).s, @pr(2).s, @pr(3).s, 75)/3) 'so.mov mc(%cso).ctrl(1) = velo IF So_nexttime < timegettime THEN So_Play mc(%cso) noot = 0 IF MAX(ABS(@pr(0).acf), ABS(@pr(2).acf)) > 3 THEN IF ABS(@pr(0).acf) > ABS(@pr(2).acf) THEN ' noot = mc(%cso).lowtes + 48 * SQR(SQR(ABS(@pr(0).acf)/36)) - RND * 2: sonoot1 = noot noot = mc(%cso).lowtes + 48 * SQR(ABS(@pr(0).acf)/36) - RND * 2: sonoot1 = noot ELSE ' noot = mc(%cso).lowtes + 48 * SQR(SQR(ABS(@pr(2).acf)/36)) - RND * 2: sonoot2 = noot noot = mc(%cso).lowtes + 48 * SQR(ABS(@pr(2).acf)/36) - RND * 2: sonoot2 = noot END IF DO WHILE noot > mc(%cSo).hightes: noot = noot - 12: LOOP AddNote2Har mc(%cso).har(1), noot, velo ELSEIF MAX(ABS(@pr(0).s), ABS(@pr(2).s)) > 10 THEN IF ABS(@pr(0).acf)> ABS(@pr(2).acf) THEN AddNote2Har mc(%cso).har(1), sonoot1, velo ELSE AddNote2Har mc(%cso).har(1), sonoot2, velo END IF ELSE mc(%cso).ctrl(1) = 0 END IF So_Wind mc(%cSo): So_Play mc(%cso) So_NextTime = INT((timegettime + 450 - 20 * (ABS(@pr(0).v) + ABS(@pr(2).v)))/120) * 120 END IF 'check if something left in delay line and mPlay it rdnextsax: nv = ReadDelayline 1, 5000, 1 IF nv > 0 THEN noot = HIBYT(nv): velo = LOBYT(nv) IF ISFALSE velo THEN GOTO rdnextsax 'we read until we have a note on AddNote2Har mc(%cSax).har(1), noot, velo: Instrumplay mc(%cSax) EXIT SUB END IF 'sax.mov IF Sax_nexttime < timegettime THEN instrumplay mc(%cSax) noot = 0 IF MAX(ABS(@pr(1).acf), ABS(@pr(3).acf)) > 2 THEN IF ABS(@pr(1).acf) > ABS(@pr(3).acf) THEN noot = mc(%cSax).lowtes + 60 * SQR(SQR(ABS(@pr(1).acf)/48)) - RND * 2 ELSE noot = mc(%cSax).lowtes + 60 * SQR(SQR(ABS(@pr(3).acf)/48)) - RND * 2 END IF DO WHILE noot > mc(%cSax).hightes: noot = noot - 12: LOOP Sax_NextTime = INT((timegettime + 550 - 30 * MAX(ABS(@pr(1).v), ABS(@pr(3).v)) - velo)/100) * 100 AddNote2Har mc(%cSax).har(1), noot, velo: instrumplay mc(%cSax) END IF END IF END SUB SUB ZuperTrump 'for trump and audioinput (2 violins) 'first imitates strongest note (with filter that gives last played notes a bit more weight so we don't get too much over and back jumps) '(allways plays short notes- makes rests in the beginning when there's no new notes) 'then starts circling around it if note is held, stops playing or holds last note if no new input 'gradually building up polyphonie with strongest n++ max 5 notes 'at first wind is static 20, but goes to 0 (in one min, as trump takes one min to fade out hardwarewise) 'later we start cycling between 0 and higer values dependent from mw_midiin.vol 'can be very minimalist on minimal input, especially nin the beginning.. STATIC this AS LONG STATIC oldhar AS harmtype 'keep it local to avoid interference with other trump players (?) STATIC starttime AS LONG 'ms STATIC insdbg AS LONG STATIC cumul AS LONG STATIC putoff AS LONG STATIC TaskParamLabels() AS ASCIIZ * 8 LOCAL notes() AS BYTE LOCAL tnow AS DWORD 'ms STATIC lhar AS harmtype LOCAL thar AS harmtype LOCAL note$ STATIC lastnote$ LOCAL vel$ LOCAL i AS LONG LOCAL j AS LONG LOCAL ub AS LONG LOCAL wind AS BYTE IF ISFALSE this THEN ' MSGBOX "is nog niet ok!!",,FUNCNAME$ this = %trumpy DIM TaskParamLabels(1) TaskParamLabels(0) = "densdiv" TaskParamLabels(1) = "bottom" MakeTaskParameterDialog this,2,Slider(),0,UDctrl(),TaskParamLabels() Slider(TaskEx(this).slidernumbers(0)).value = 15 Slider(TaskEx(this).slidernumbers(1)).value = 2 SendMessage Slider(TaskEx(this).Slidernumbers(0)).h, %TBM_SETPOS,%True, Slider(TaskEx(this).Slidernumbers(0)).value SendMessage Slider(TaskEx(this).Slidernumbers(1)).h, %TBM_SETPOS,%True, Slider(TaskEx(this).Slidernumbers(1)).value starttime = timegettime modemess mc(%cTrump).channel, 7, 5 #IF %DEF(%MW_DEBUGGERON) insdbg = kl_debug(0, FUNCNAME$) kl_debug %kl_dbg_logfile, STR$(insdbg) + ", zupertrump.log" #ENDIF END IF ' CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 12, STR$(MW_MidiIn.Dens / Slider(TaskEx(this).slidernumbers(0)).value) IF RND > (MAX(MW_MidiIn.dens, Slider(TaskEx(this).slidernumbers(1)).value) / Slider(TaskEx(this).slidernumbers(0)).value) THEN IF putoff THEN EXIT SUB InstrumPlay mc(%cTrump) ModeMess Trump.channel, &H7B, 0 ' should work ' kl_debug insdbg, "alloff--- " + str$(putoff) 'allnotesoff mPlay mc(%cTroms).channel, mc(%cTroms).Hightes - RND * 5, MW_MidiIn.vol IF RND < .3 THEN putoff = 1 mPlay mc(%cTroms).channel, mc(%cTroms).Lowtes + RND * 5, MW_MidiIn.vol EXIT SUB END IF END IF tnow = timegettime - starttime task(this).freq = MIN(14, MAX(1, 2 * MW_MidiIn.dens^.73)) 'was 83 SELECT CASE tnow CASE < 45000: i = 1: wind = 20 '= pressure at which trump has been tuned.. higher pressure = higher pitch CASE < 240000: i = .5 + tnow / 60000: wind = MAX(10, MIN(MW_MidiIn.vol * (SIN(6.28 * tnow/60000)^2)/1.8, 45)) CASE ELSE: i = 5: wind = MIN(45, IIF((RND^3 > .5), MW_MidiIn.vol, 10)) END SELECT modemess mc(%cTrump).channel, 7, wind FOR j = 1 TO 127 MID$ (lhar.vel, j, 1) = CHR$( ASC( MID$(lhar.vel, j, 1) ) * .6 ) 'was .5 IF ASC(MID$(lhar.vel, j, 1)) < 15 THEN MID$(lhar.vel, j, 1) = CHR$(0) NEXT thar.vel = Sumhar$(lhar, Task(%cqtLst).Har) ' ShowHar thar, 1,280,2! lhar.vel = ReturnStrongestInHar(thar, i) ' ShowHar lhar, 1,420,2! FOR j = 36 TO 127 IF ASC(MID$(lhar.vel, j, 1)) > 12 THEN note$ = note$ + CHR$(j): vel$ = vel$ + MID$(lhar.vel, j, 1) NEXT IF LEN(note$) < 1 THEN InstrumPlay mc(%cTrump) 'allnotesoff EXIT SUB END IF putoff = 0 'perc can start again if it was put off mc(%cTrump).Har(1).vel = ReturnStrongestinHar(mc(%cTrump).Har(0), 1) IF ISFALSE(VERIFY(note$, lastnote$)) THEN 'if all notes were played allready INCR cumul modemess mc(%cTrump).channel, 7, 0 IF tnow > 30000 THEN FOR i = 1 TO MAX(1, LEN(lastnote$)-1) AddNote2Har(mc(%cTrump).har(1), ASC(MID$(lastnote$, i, 1)) - tnow/40000 + cumul + RND * (2 + i), 1) NEXT END IF 'lastnote$ = "" InstrumPlay mc(%cTrump) EXIT SUB ELSE cumul = 0 END IF lastnote$ = note$ REDIM notes(LEN(note$)-1) AS LOCAL BYTE AT STRPTR(note$): REDIM vels(LEN(note$)-1) AS LOCAL BYTE AT STRPTR(vel$) #IF %DEF(%MW_DEBUGGERON) kl_debug insdbg, "tnow:"+STR$(tnow) + " - wind:" + STR$(wind) + " - freq:"+STR$(task(this).freq) + " - notes:" + STR$(UBOUND(notes)) #ENDIF ARRAY SORT vels(), TAGARRAY notes(), DESCEND FOR i = 0 TO UBOUND(notes) DO WHILE notes(i) > mc(%cTrump).hightes: notes(i) = notes(i) - 36: LOOP NEXT #IF %DEF(%MW_DEBUGGERON) 'kl_Debug insdbg, "ub notes:" + STR$(UBOUND(notes)) #ENDIF SELECT CASE tnow CASE < 60000 IF (VERIFY(note$, lastnote$)) THEN FOR i = 0 TO UBOUND(notes): AddNote2Har mc(%cTrump).har(1), notes(i), 20: NEXT END IF CASE < 180000 IF (VERIFY(note$, lastnote$)) THEN ub = UBOUND(notes) FOR i = 0 TO MIN(2, UBOUND(notes)) j = ub * RND ^ (-.0012 * (tnow/60) + 5.9) '(750, 5), (4000, 1.1) > rc(='a') = (1.1 - 5) / (4000 - 750) #IF %DEF(%MW_DEBUGGERON) ' kl_debug insdbg, "randnotesel:" + STR$(j) + "/" + STR$(ub) #ENDIF AddNote2Har mc(%cTrump).har(1), notes(j), 20 ' kl_Debug insdbg, "redim notes:" + str$(ubound(notes)) IF ub <= i THEN EXIT FOR ARRAY DELETE notes(j) j = UBOUND(notes) -1 ' REDIM PRESERVE notes(j) fails for some reason.. ubound becomes -1, whatever the value of j DECR ub #IF %DEF(%MW_DEBUGGERON) ' kl_debug insdbg, "virtual ub after arr redim:" + STR$(ub) + " was" + STR$(j) #ENDIF NEXT END IF CASE ELSE ub = UBOUND(notes) FOR i = 0 TO MIN(5,UBOUND(notes)) j = ub * SQR(RND) AddNote2Har mc(%cTrump).har(1), notes(j), 20 #IF %DEF(%MW_DEBUGGERON) ' kl_Debug insdbg, "redim notes:" + STR$(UBOUND(notes)) #ENDIF IF ub <= i THEN EXIT FOR ARRAY DELETE notes(j) j = UBOUND(notes)-1 ' REDIM PRESERVE notes(j) DECR ub #IF %DEF(%MW_DEBUGGERON) kl_debug insdbg, "virtual ub after arr redim:" + STR$(ub) + " was" + STR$(j) #ENDIF NEXT END SELECT ' task(this).freq = INT(task(this).freq*3) / 3 InstrumPlay mc(%cTrump) END SUB SUB StriSpri 'lage dens input: stille reso '"+ imitaasie" STATIC this AS LONG LOCAL h AS harmtype LOCAL i AS LONG LOCAL vel AS BYTE LOCAL nnote AS LONG STATIC TaskParamLabels() AS ASCIIZ * 8 STATIC lastnote AS BYTE IF ISFALSE this THEN this = %strispri DIM TaskParamLabels(1) TaskParamLabels(0) = "CritDens" TaskParamLabels(1) = "HiDens" MakeTaskParameterDialog this,2,Slider(),0,UDctrl(),TaskParamLabels() Slider(TaskEx(this).slidernumbers(0)).value = 3 Slider(TaskEx(this).slidernumbers(1)).value = 20 SendMessage Slider(TaskEx(this).Slidernumbers(0)).h, %TBM_SETPOS,%True, Slider(TaskEx(this).Slidernumbers(0)).value SendMessage Slider(TaskEx(this).Slidernumbers(1)).h, %TBM_SETPOS,%True, Slider(TaskEx(this).Slidernumbers(1)).value END IF h.vel = ReturnStrongestInHar(Task(%cqtLst).Har, 1) FOR i = 46 TO 120 IF ASC(MID$(h.vel, i, 1)) > 0 THEN nnote = i: EXIT FOR NEXT IF (nnote MOD 12) = (lastnote MOD 12) THEN nnote = 0 ELSE CONTROL SET TEXT gh.cockpit, %GMT_MSG1, STR$(nnote) + STR$(lastnote) END IF CONTROL SET TEXT gh.cockpit, %GMT_MSG2, STR$(mw_midiin.dens) + STR$(mw_midiin.vol) SELECT CASE MW_MidiIn.dens CASE < Slider(TaskEx(this).slidernumbers(0)).value 'do nothing CASE < Slider(TaskEx(this).slidernumbers(1)).value SELECT CASE lastnote AND &b11 CASE 0 task(this).freq = 16 mPlay mc(%cSpringers).channel, 121, 16 CASE 1 task(this).freq = 21.7 mPlay mc(%cSpringers).channel, 122, 12 CASE ELSE task(this).freq = 13.5 mPlay mc(%cSpringers).channel, 123, 10 END SELECT CASE ELSE task(this).freq = 6 IF ISFALSE nnote THEN EXIT SUB IF ABS(nnote - lastnote) > 6 THEN 'groot tessituurverschil met laatste noot: accent vel = 110 ELSE vel = MW_MidiIn.vol END IF mPlay mc(%cSpringers).channel, 121 + INT(RND*3), vel END SELECT IF nnote THEN lastnote = nnote END SUB 'code evoor eindproject barbara 'speelt sterkste input en harmonischen daarvan met ritmische patronen 'patroonkeuze ahankelijk van de densiteit van de input 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 FUNCTION toggle_bbovertones AS LONG STATIC hw AS LONG IF ISFALSE hw THEN DIALOG NEW gh.Cockpit, "Instr",0,0,42, 50 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 ELSE DIALOG END hw hw = 0 BB_overtones -1 DIALOG DOEVENTS piano_silence END IF END FUNCTION SUB MW_InitInstruments(mc() AS Musician) 'DO NOT CHANGE ENUMERATION !!! ( or better: make it changeable ) REDIM mc(16) GetInstrumentParams mc(%cVibi), %ID_VIBI BIT SET mc(%cVibi).patch, 0 '== flag: pitched mc(%cVibi).channel = 10 mc(%cVibi).minduur = 40 GetInstrumentParams mc(%cKlung), %ID_KLUNG mc(%cKlung).hightes = 68 BIT SET mc(%cKlung).patch, 0 '== flag: pitched mc(%cPiperola).naam = "piperola + bourdon" mc(%cPiperola).channel = 2 'piperola + bas mc(%cPiperola).lowTes = 36: mc(%cPiperola).HighTes = 108 mc(%cPiperola).minduur = 100 BIT SET mc(%cPiperola).patch, 0 '== flag: pitched mc(%cThunderwood).naam = "thunderwood" mc(%cThunderwood).channel = %thunderwood_channel mc(%cThunderwood).lowTes = 1: mc(%cThunderwood).HighTes = 19 mc(%cThunderwood).minduur = 20 GetInstrumentParams mc(%cHarma), %ID_HARMA BIT SET mc(%cHarma).patch, 0 '== flag: pitched mc(%cTroms).naam = "troms" mc(%cTroms).channel = %troms_Channel mc(%cTroms).lowTes = 24: mc(%cTroms).HighTes = 47 mc(%cTroms).minduur = 30 GetInstrumentParams mc(%cHumanola), %ID_HUMANOLA BIT SET mc(%cHumanola).patch, 0 '== flag: pitched GetInstrumentParams mc(%cPiano), %ID_PIANO BIT SET mc(%cPiano).patch, 0 '== flag: pitched GetInstrumentParams mc(%cBelly), %ID_BELLY BIT SET mc(%cBelly).patch, 0 GetInstrumentParams mc(%cSpringers), %ID_SPRINGERS GetInstrumentParams mc(%cTubi), %ID_TUBI GetInstrumentParams mc(%cSo), %IDM_SO GetinstrumentParams mc(%cFlex), %ID_FLEX GetInstrumentParams mc(%cPuff), %IDM_PUFF GetInstrumentParams mc(%cSax), %ID_AUTOSAX GetInstrumentParams mc(%cTrump), %IDM_TRUMP GetInstrumentParams mc(%cHurdy), %IDM_HURDY #IF %DEF(%multiport) mc(%cPiperola).channel = mc(%cPiperola).channel OR &H100 mc(%cHarma).channel = mc(%cHarma).channel OR &H300 mc(%cHumanola).channel = mc(%cHumanola).channel OR &H200 mc(%cPiano).channel = mc(%cPiano).channel OR &H300 mc(%cSpringers).channel = mc(%cSpringers).channel OR &H200 mc(%cTubi).channel = mc(%cTubi).channel OR &H100 SetRobotPort mc(%cSo), "", hMidiO() SetRobotPort mc(%cFlex), "", hMidiO() SetRobotPort mc(%cPuff), "", hMidiO() SetRobotPort mc(%cSax), "", hMidiO() SetRobotPort mc(%cTrump), "", hMidiO() SetRobotPort mc(%cHurdy),"", hMidiO() #ENDIF ModeMess mc(%cBelly).channel, &H44, 0 'match off 'evt uitbreiden: perc on organs as separete musicians... END SUB ' this could be one generalised proc now... SUB Bourd_Silence LOCAL n AS BYTE FOR n = 36 TO 64: mPlay mc(%cPiperola).channel, n, 0: SLEEP 10: NEXT END SUB SUB Piper_Silence LOCAL n AS BYTE mc(%cPiperola).ctrl(7) = 0 Piperolawind mc(%cPiperola) FOR n = 60 TO 127: mPlay mc(%cPiperola).channel, n, 0: SLEEP 10: NEXT 'dont forget percussion.. END SUB SUB Huma_Silence LOCAL n AS BYTE mc(%cHumanola).ctrl(7) = 0 Humanolawind mc(%cHumanola) FOR n = 36 TO 91: mPlay mc(%cHumanola).channel, n, 0: SLEEP 10: NEXT END SUB SUB TW_Silence LOCAL n AS BYTE mPlay mc(%cThunderwood).channel, 16, 0: mPlay mc(%cThunderwood).channel, 24, 0: mPlay mc(%cThunderwood).channel, 25, 0 'rain 'wind 'storm END SUB SUB Harma_Silence LOCAL n AS BYTE FOR n = mc(%cHarma).lowTes TO mc(%cHarma).HighTes: NoteOff mc(%cHarma).channel, n: SLEEP 10: NEXT END SUB SUB Piano_Silence LOCAL n AS BYTE FOR n = mc(%cPiano).lowTes TO mc(%cPiano).Hightes : NoteOff mc(%cPiano).channel, n: SLEEP 10: NEXT END SUB SUB SO_Silence SO_AllOff mc(%cSo): mc(%cSo).ctrl(1) = 0: SO_Wind mc(%cSo) END SUB SUB Springers_Silence NoteOff mc(%cSpringers).channel, 1: NoteOff mc(%cSpringers).channel, 2 END SUB SUB Flex_silence Modemess mc(%cFlex).channel, &H7B, 1 END SUB SUB Trump_Silence LOCAL i AS BYTE FOR i = mc(%ctrump).lowtes TO mc(%ctrump).hightes: mPlay mc(%ctrump).channel, i, 0: SLEEP 10: NEXT mc(%ctrump).ctrl(7) = %False: Modemess mc(%ctrump).channel, 7, mc(%ctrump).ctrl(7) ', 0 END SUB SUB Hurdy_Silence ModeMess mc(%cHurdy).channel, &H7B, 0 ' should work KeyPress mc(%cHurdy).channel, 40, 0: Keypress mc(%cHurdy).channel, 64, 0 mPlay mc(%cHurdy).channel, 0, 0 ' lights off mPlay mc(%cHurdy).channel, 1, 0 ' id. mc(%cHurdy).ctrl(7) = %False: Modemess mc(%cHurdy).channel, 7, %False mc(%cHurdy).ctrl(66) = %False: ModeMess mc(%cHurdy).channel, 66, 0 ' was inverted patch... %False END SUB FUNCTION BufferByte (arr() AS BYTE, first AS BYTE) AS BYTE 'shifts buffer array, adds first element and returns element that dropped out of buffer LOCAL p AS BYTE PTR LOCAL last AS BYTE ' CONTROL SET TEXT gh.cockpit, %GMT_TITLE, STR$(first) last = arr(UBOUND(arr)) ' CONTROL SET TEXT gh.cockpit, %GMT_AUTHOR, STR$(last) p = VARPTR(arr(LBOUND(arr))) POKE$ p + 1, PEEK$(p, (UBOUND(arr) - LBOUND(arr))) arr(LBOUND(arr)) = first FUNCTION = last END FUNCTION #IF %DEF(%MW_DEBUGGERON) SUB Write_Movement 'test task STATIC this AS LONG STATIC f AS LONG ' static startt as LOCAL x AS LONG, y AS LONG, z AS LONG, vx AS LONG, vy AS LONG, vz AS LONG LOCAL sx AS SINGLE, sy AS SINGLE, sz AS SINGLE, svx AS SINGLE, svy AS SINGLE, svz AS SINGLE LOCAL TaskParamLabels() AS ASCIIZ * 8 LOCAL sens AS LONG LOCAL b AS STRING LOCAL hw AS LONG IF ISFALSE this THEN this = %wrmov DIM TaskParamLabels(0) TaskParamLabels(0) = "@sr.noise" MakeTaskParameterDialog BYVAL this,1,Slider(),0,UDctrl(),TaskParamLabels() DIALOG NEW gh.cockpit, FUNCNAME$ +"_Write",,,200, 35 TO hw CONTROL ADD TEXTBOX, hw, 1, "",5, 5, 190, 12 CONTROL ADD BUTTON, hw, 2, "write", 5, 20, 190, 12, %BS_DEFAULT CALL CBWriteMov DIALOG SHOW MODELESS hw f = FREEFILE OPEN "c:\b\pb\gmt\kristof\machinewall\movmlog.txt" FOR OUTPUT ACCESS WRITE LOCK WRITE AS f IF ERRCLEAR THEN MSGBOX "err opening file" ,, FUNCNAME$ StopTask this EXIT SUB END IF ' startt = timer task(this).patch = f SELECT CASE MW_MODE CASE %MW_MODE_SONAR: PRINT #f, "[SONAR]" CASE %MW_MODE_RADAR: PRINT #f, "[RADAR]" END SELECT END IF sens = slider(taskEX(this).Slidernumbers(0)).value ' IF MAX (x,y,z,vx,vy,vz)< sens THEN EXIT SUB SELECT CASE MW_MODE CASE %MW_MODE_SONAR PRINT #f, "TIM:" + FORMAT$(@sr.timerID, "* #######") b = "AMP: " + FORMAT$(@sr.xa, "* ####\ \ ")+ FORMAT$(@sr.ya, "* ####\ \ ")+ FORMAT$(@sr.za, "* ####\ \ ")+ FORMAT$(@sr.xyza, "* ####") PRINT# f, b b = "SPD: " + FORMAT$(@sr.xf, "* ####\ \ ")+ FORMAT$(@sr.yf, "* ####\ \ ")+ FORMAT$(@sr.zf, "* ####\ \ ")+ FORMAT$(@sr.xyzf, "* ####") PRINT# f, b b = "ACC: " + FORMAT$(@sr.xac, "* ####\ \ ") + FORMAT$(@sr.yac, "* ####\ \ ") + FORMAT$(@sr.zac, "* ####\ \ ") + FORMAT$(@sr.xyzac, "* ####\ \ ") PRINT# f, b PRINT# f, "" CASE %MW_MODE_RADAR PRINT #f, "TIM:" + FORMAT$(TIMER, "* #####.##") b = "AMP: " + FORMAT$(@pr(0).amp, "* ####\ \ ")+ FORMAT$(@pr(1).amp, "* ####\ \ ")+ FORMAT$(@pr(2).amp, "* ####\ \ ")+ FORMAT$(@pr(3).amp, "* ####") PRINT# f, b b = "SPD: " + FORMAT$(@pr(0).vf, "* ####\ \ ")+ FORMAT$(@pr(1).vf, "* ####\ \ ")+ FORMAT$(@pr(2).vf, "* ####\ \ ")+ FORMAT$(@pr(3).vf, "* ####") PRINT# f, b b = "ACC: " + FORMAT$(@pr(0).acf, "* ####\ \ ") + FORMAT$(@pr(1).acf, "* ####\ \ ") + FORMAT$(@pr(2).acf, "* ####\ \ ") + FORMAT$(@pr(3).acf, "* ####\ \ ") PRINT# f, b PRINT# f, "" END SELECT END SUB 'TYPE RadarType DWORD ' pxbuf AS INTEGER PTR ' pointer to the 0 element of the databuffer (0 to 255) ' pybuf AS INTEGER PTR ' at 128S/s this buffer is 2 seconds deep ' amp AS DWORD ' running sum of squares (both phases together) of received signal amplitudes ' dta AS DWORD ' integration time for above calculation ' xal AS DWORD ' amplitude of the most recent doppler signal received x-phase ' yal AS DWORD ' amplitude of the most recent doppler signal received y-phase ' l AS SINGLE ' normalized distance based on x phase and a pair of radars , 0-1 [-1--- +2] ' s AS SINGLE ' absolute surface moving ' v AS SINGLE ' absolute slow body movement velocity ' acc AS SINGLE ' absolute slow body accelleration (bipolar) ' pc AS complex ' cartesian coordinates of absolute position ' pl AS polar ' polar coordinates of absolute position ' xt AS SINGLE ' doppler period - counted - for internal use ' yt AS SINGLE ' doppler period - counted - for internal use ' xf AS SINGLE ' doppler frequency without cosine correction! ' yf AS SINGLE ' doppler frequency without cosine correction ' vf AS SINGLE ' absolute fast body movement based on doppler shift (non vectorial) - in Hz ' acf AS SINGLE ' absolute fast accelleration (bipolar) ' phase AS SINGLE ' phase difference between both phases - for internal use ' timerId AS DWORD ' internal use (in g_nih.dll) for periodic sampling timer ' noise AS LONG ' noise floor ' sfakt AS SINGLE ' scaling factor for surface calculation. ' dt AS DWORD ' number of samples below noise floor before doppler analysis becomes invalid ' params AS DWORD ' now only %Zerocross left over. %ISOLWAVE, %DFT, %ZEROCROSS, %SIGNCHANGE ' setup AS DWORD ' %SQUARE, %TETRAHEDRON, %FREE 'END TYPE ' Type for invisible instrument sonar devices: (cfr. Bom, Songbook, Gestrobo, TechnoFaustus) 'TYPE SonarType DWORD ' pb(15) AS INTEGER PTR ' pointer array to the 0 elements of the databuffers. (each 4 seconds deep) ' timerid AS DWORD ' internal timer id ' xa AS INTEGER ' integrated amplitude received by X-transducer ' ya AS INTEGER ' integrated amplitude received by Y-transducer ' za AS INTEGER ' integrated amplitude received by Z-transducer (suspended) ' xyza AS INTEGER ' integrated amplitude sum x+y+z ' xf AS INTEGER ' integrated doppler speed received by the X-transducer ' yf AS INTEGER ' integrated doppler speed received by the Y-transducer ' zf AS INTEGER ' integrated doppler speed received by the Z-transducer ' xyzf AS INTEGER ' integrated doppler speed sum received by the X+Y+Z transducers (? or Max value) ' xe AS INTEGER ' energy xa * xf, rescaled to 12 bit ' ye AS INTEGER ' ze AS INTEGER ' xyze AS INTEGER ' energy xyza * xyzf ' xac AS INTEGER ' integrated accelleration as seen from x-transducer. Bipolar value -2048 to +2047 ' yac AS INTEGER ' rescaling is done internally based on the value for ascale. ' zac AS INTEGER ' ceiling to 12 bits is always performed internally in the DAQ task. ' xyzac AS INTEGER ' ' xy AS SINGLE ' positie -1 to +1 , 0 is center between x and y, -1 is x, +1 is y ' ' zx AS SINGLE ' ' zy AS SINGLE ' noise AS LONG ' noise floor. Set with slider in ctrl window. ' dta AS LONG ' integration time for surface calculations - set by user ' ascale AS SINGLE ' scaling factor for accelleration ' amp AS INTEGER ' sum of squares of received amplitudes ' lxy AS SINGLE ' position on the x->y vector ' lyx AS SINGLE ' position on the y-> x vector = 1 - lxy ' lxz AS SINGLE ' lzx AS SINGLE ' lyz AS SINGLE ' lzy AS SINGLE ' sx AS INTEGER ' position independent body surface as seen from x transducer ' sy AS INTEGER ' position independent body surface as seen from y transducer ' sz AS INTEGER ' position independent body surface as seen from z transducer ' s AS INTEGER ' surface, non positional, average as seen from all 3 transducers. ' ' added for statistical data analysis: ' statistic AS DWORD ' toggles statistic analysis on/off, the individual bits set the channels ' ' 2 second buffer ' Stat(15) AS STRING * 128 ' string conform harmony descriptor - resolution 7 bits. 'END TYPE SUB Write_mov_stop CLOSE task(%wrmov).patch END SUB CALLBACK FUNCTION CBWriteMov LOCAL b AS STRING CONTROL GET TEXT CBHNDL, 1 TO b CONTROL SET TEXT gh.cockpit, %GMT_TITLE, b b = TRIM$(b) IF b<> ""THEN PRINT# task(%wrmov).patch, b END FUNCTION #ENDIF SUB Cqt_Listen () LOCAL nv%, noot?, velo? LOCAL i AS BYTE LOCAL velbyte() AS BYTE STATIC Cnt() AS BYTE STATIC oldwijzer AS DWORD STATIC silenceflag AS BYTE STATIC lastontime() AS SINGLE STATIC laston() AS BYTE LOCAL wijzer AS DWORD LOCAL nrevents AS LONG IF ISFALSE Task(%cqtlst).tog THEN MW_MidiIn.vol = 4 ' midi level MW_MidiIn.tes = 25 ' in Hz MW_MidiIn.dens = 0.1 ' in events/sec (Hz) Task(%CqtLst).tog = %True Task(%CqtLst).Har.vel = STRING$(128,0) ' blank buffer DIM lastontime(128) DIM laston(128) REDIM Cnt(255) ' 1 byte for every cs. - so we integrate over 2,56 seconds END IF ' This task does not do any music generation in itself. It links the real time input from a performer ' via the cqt2 midi-in device and writes this midi input into the harmony string. REDIM velbyte(127) AT VARPTR(Task(%CqtLst).Har.Vel) 'leakymax on old input notes FOR noot? = 1 TO 127 IF lastontime(noot?) THEN velbyte(noot) = MIN(laston(noot), laston(noot) / (TIMER - lastontime(noot?) + 1)) IF ISFALSE(velbyte(noot?)) THEN laston(noot?) = 0: lastontime(noot?) = 0 END IF NEXT 'compute average input srength per band of 5 midinotes FOR noot? = 55 TO 125 STEP 5 TesWeight(FIX((noot? - 55)/5)) = 0 FOR i = 0 TO 4 TesWeight(FIX((noot? - 55)/5)) = TesWeight(FIX((noot? - 55)/5)) + velbyte(noot? + i)/127 NEXT TesWeight(FIX((noot? - 55)/5)) = TesWeight(FIX((noot? - 55)/5)) / 5 NEXT 'check for new note nv% = GetMidiNote% (Task(%cqtlst).channel, %Remove OR %Oldest) IF nv% = %NotFalse THEN EXIT SUB ' if no note came in, exit the task velo? = LOBYT (nv%): noot? = HIBYT (nv%) ' write it to the harmony-string (polyphonic) IF velo? THEN velbyte(noot?) = velbyte(noot) + velo? / 2 lastontime(noot?) = TIMER laston(noot?) = velbyte(noot?) END IF ' bereken de gemiddelde geluidsterkte van de input IF velo? THEN MW_MidiIn.Vol = MW_MidiIn.Vol + MW_MidiIn.Vol + MW_MidiIn.Vol + velo? SHIFT RIGHT Mw_MidiIn.Vol, 2 END IF ' bereken de gemiddelde tessituurligging van de input IF noot? THEN MW_MidiIn.tes = ((MW_MidiIn.tes * 3) + N2F(noot?)) / 4 ' calculate the density of the input over a timeframe of 255cs. ' The result is returned in Eary.dens wijzer = (timeGetTime / 10) 'MOD 256 wijzer = wijzer AND 255 IF wijzer <> oldwijzer THEN DO INCR oldwijzer oldwijzer = oldwijzer AND 255 Cnt(oldwijzer) = %False LOOP UNTIL oldwijzer = wijzer END IF Cnt(wijzer) = %True ' now count the number of events in the buffer: FOR wijzer = 0 TO 255: IF Cnt(wijzer) THEN INCR nrevents NEXT wijzer MW_MidiIn.dens = (nrevents/2) / 2.56! ' express result in (events/2)/second FillHarType Task(%CqtLst).har END SUB FUNCTION Quadrada_Sens_Slider () AS DWORD ' callback procedure for surface scaling factor slider. LOCAL i AS DWORD FOR i = 0 TO 4 @pr(i).sfakt = 1 + Slider(0).value ' hoe groter sfakt hoe kleiner de waarden voor @pr(i).s NEXT i END FUNCTION FUNCTION Quadrada_dt_slider () AS DWORD LOCAL i AS DWORD FOR i = 0 TO 4 @pr(i).dt = Slider(1).value + 1 ' number of samples for averaging / integration ' for zerocrossmode = 6 NEXT i END FUNCTION '[EOF]