' ************************************************** ' * midi file player for the M&M robot orchestra * ' * written by * ' * Kristof Lauwers * ' * Godfried-Willem Raes * ' ************************************************** ' 12.04.2007: creation date of code module ' 13.04.2007: several interaction tasks added. note: some of them are for specific pieces - ' maybe we can expand them for general use.. ' 21.05.2009: the player and the timerqeueutimers don't seem to like each other. either the gui freezes of the timers 'get delayed when the gui is used.. ' maybe we should try putting the player in a dedicated thread? ' not required: '#IF NOT %DEF($g_h_dll) ' #IF %DEF(%NiDAQ) ' $g_h_dll = "g_nih.dll" ' #ELSEIF %DEF(%g_NiDAQmx) ' $g_h_dll = "g_nxh.dll" ' #ELSE ' $g_h_dll = "g_noh.dll" ' #ENDIF '#ENDIF ' 07.06.2009: This compilation now works fine with NiDAQmx on \\No and the invisible instrument. '01.03.2010: on our new win 7 64-bit laptop Yo, we experience frequent crashes. when we only include the player itself and leave ot the interactive tasks, everything works fine.. ' with picra input and VU enabled and running everythings'still fine.. so does the picra interaction task.. ' after inclusion of lcqt listen task & related interaction tasks, everything still works. ' so it seems the sonar code is the culprit.. ' sonar_daq seems to cause the crash, usually some seconds after it gets started.. ' 12.04.2021: any updates required? %barebones = 1 'for debug: exclude nidaq related tasks (was: exclude everything except main player itself.) ' DECLARE FUNCTION InitPlayerMenu (BYVAL hMenu AS DWORD) AS LONG DECLARE FUNCTION Init_Player () AS LONG DECLARE SUB ButnSW_IaxPlayStart () DECLARE SUB ixp_cqt_Listen () 'adapted from machinewall.inc DECLARE SUB Ixp_cqt_Mon DECLARE SUB Ixp_StartStop DECLARE SUB Ixp_ListSpd DECLARE SUB Ixp_ListVel DECLARE SUB Ixp_NegInp DECLARE SUB Tango_PlayAlong (md() AS ParsedMidiType,MMTrack() AS musician, BYVAL EVENTS AS DWORD, BYVAL maxevents AS DWORD) DECLARE SUB Toggle_TangoPlay DECLARE SUB MidiPlayerSonarInteraction(OPT BYVAL freq AS SINGLE) DECLARE SUB MidiPlayerPicraInteraction (OPT BYVAL freq AS SINGLE) DECLARE SUB dummyplayer(OPT BYVAL rst AS LONG, OPT BYVAL pause AS LONG) DECLARE CALLBACK FUNCTION CBFileFreq DECLARE SUB Picra_VU () %Picra_VU = 3 ' bar graph monitoring #IF NOT %DEF(%Radar_Listen) %Radar_listen = 4 #ENDIF 'player task %MM_PlayerTask = 16 'tasks for interactive modules %Ixp_cqtlst = 18 %ixp_cqtMon = 19 %Ixp_stst = 20 'start/stop %Ixp_LsSp = 21 %Ixp_LsVel = 22 %Ixp_NegInp = 23 %iax = 25 'sonar interactionn %iaxpr = 26 'picra %iaxprs = 27 'simplified verison of picra interaction GLOBAL pRadPic() AS RadarPicController PTR ' in g_lib.dll - g_midi.inc GLOBAL CQT_MidiIn AS SoloPiType GLOBAL TesWeight() AS SINGLE '?necessary here? copypaste from kliax GLOBAL CQT AS Pitch2MidiType GLOBAL sr AS SonarType PTR FUNCTION InitPlayerMenu (BYVAL hMenu AS DWORD) AS LONG ' called from gmt on startup for building the appropriate setup screen. EnableMenuItem hMenu, %ID_PLAYER, %MF_ENABLED FUNCTION = %True END FUNCTION FUNCTION Init_Player () AS LONG LOCAL i AS LONG LOCAL cptr AS DWORD LOCAL p AS DWORD DIM TesWeight(19) 'voor Cqt listen task ' called from gmt after clicking the menu RemoveCockpitTask 0 RemoveCockpitTask App.WriteSeqScoreTasknr RemoveCockpitTask App.GlobalHarmonyTaskNr 'picradar inits - for interactive player DIM pRadPic(3) AS GLOBAL RadarPicController PTR FOR i = 0 TO 3 '(%MaxNr of devices...) pRadPic(i) = GetPicRadarPointer (i, %Radar_listen, 256 * 0 + i) ' dev.nr, listentasknr, port/channel word IF ISFALSE pRadPic(i) THEN Warning "Initialization failure for radpic" + STR$(i) REDIM PRESERVE pRadPic(i-1) AS GLOBAL RadarPicController PTR EXIT FOR END IF NEXT i Create_PicRadar_Control (Slider(), UDctrl()) ' create user interface for the PIC listen-task 'logfile "g_player: create PicRadar control passed" Task(%Picra_VU).naam = "PicraVU" Task(%Picra_VU).cptr = CODEPTR(Picra_VU) Task(%Picra_VU).freq = 8 Task(%Picra_VU).flags = %PERTIM_TASK Task(%iaxpr).naam = "IFPPicra" Task(%iaxpr).cptr = CODEPTR(MidiPlayerPicRaInteraction) Task(%iaxpr).freq = 24 '64 Task(%iaxpr).flags = %PERTIM_TAsk Task(%iaxprs).naam = "IFPPcSpd" Task(%iaxprs).cptr = CODEPTR(MidiPlayerPicRaInteraction_justspeed) Task(%iaxprs).freq = 24 '64 Task(%iaxprs).flags = %PERTIM_TAsk 'CQT inits cqt.naam = "cqt" SetPitch2MidiPorts cqt, "c:\b\pb\gmt\robots\iaxplay.cfg", hMidiO(),hMidiI() cqt.ctrl(41) = cqt.hightes cqt.ctrl(42) = cqt.lowtes FOR i = 33 TO 42 modemess cqt.outchannel,i,cqt.ctrl(i) ' 75 '64 NEXT SetMidiListenChannel Cqt.inchannel, 1 'logfile "g_player: cqt channel set" App.MidiPlayerTasknr = %MM_PlayerTask ' xtor?: waarom doe je dit zo, g_lib is toch statisch geladen als dll??? codeptr(MM_MidiPlayer) wil niet compileren.. 'undefined SUB/FUNCTION reference. de decaratie staat nochtans in g_lib.bi Task(App.MidiPlayerTasknr).naam = "MFilePlay" Task(App.MidiPlayerTasknr).cptr = GetProcAddress(GetModuleHandle("g_lib.dll"),"MM_MIDIPLAYER") Task(App.MidiPlayerTasknr).freq = 500 Task(App.MidiPlayerTasknr).flags = %DLL_TASK OR %PERTIM_TASK TaskEX(App.MidiPlayerTasknr).stopcptr = CODEPTR(MM_AllOff) 'this is not the general CQT listen task, but a specific version (based on the one used in machinewall/robotgarden), which has some filtering for repeated notes etc.. Task(%Ixp_cqtlst).naam = "CqtLisn" Task(%Ixp_cqtlst).freq = 101 Task(%Ixp_CqtLst).channel = Cqt.inchannel Task(%Ixp_cqtlst).cptr = CODEPTR(Ixp_Cqt_Listen) Task(%Ixp_cqtlst).flags = %PERTIM_TASK Task(%Ixp_cqtmon).naam = "cqtMon" Task(%Ixp_cqtmon).freq = 9 Task(%Ixp_cqtmon).cptr = CODEPTR(Ixp_Cqt_Mon) Task(%Ixp_cqtmon).flags = %PERTIM_TASK 'specifieke code voor stuk met Moniek Task(%IXP_Stst).naam = "startstop" 'op lage sol / open mi vd viool Task(%Ixp_Stst).freq = 24 Task(%Ixp_stst).cptr = CODEPTR(Ixp_StartStop) Task(%IXP_Stst).flags = %PERTIM_TASK Task(%Ixp_LsSp).naam = "lstSpd" Task(%Ixp_LsSp).freq = 13 Task(%Ixp_LsSp).cptr = CODEPTR(Ixp_ListSpd) Task(%Ixp_LsSp).flags = %PERTIM_TASK Task(%Ixp_LsVel).naam = "lstVel Task(%Ixp_LsVel).freq = 14 Task(%Ixp_LsVel).cptr = CODEPTR(Ixp_ListVel) Task(%Ixp_LsVel).flags = %PERTIM_TASK Task(%Ixp_NegInp).naam = "NegInp" Task(%Ixp_NegInp).freq = 14 Task(%Ixp_NegInp).cptr = CODEPTR(Ixp_NegInp) Task(%Ixp_NegInp).flags = %PERTIM_TASK #IF NOT %DEF(%barebones) IF DAQparams.id THEN ' logfile "g_player: Daqparams.id = " & STR$(DAQparams.id) ' here we get DAQparams.mode = %DAQ_NI ' p = GetSonarPointer ' werkt alleen met een statisch gelinkte library, en ' daarvoor mag %g_h_dll NIET gedefinieerd zijn in _player.inc IF gh.gnh THEN cptr = GetProcAddress(gh.gnh, "GETSONARPOINTER") ' in g_nxh.dll , $DLL ELSE logfile STR$(cptr) & " = pointer to GetSonarPointer in g_n*h.dll" ' ok END IF IF cptr THEN CALL DWORD cptr USING GetSonarPointer TO p ELSE logfile "g_player: No codepointer for GetSonarPointer " & $DLL ' ok ' Warning "No Codepointer to GetSonarpointer in " & $DLL ' msgbox "cptr ptr fault",,funcname$ END IF 'logfile "SonarPointer = " & STR$(p) ' sofar it looks o.k. sr = p warning "sonarpointer:"+ STR$(sr) ' ók 2010 cptr = GetProcAddress(gh.gnh,"SONAR_DAQ") logfile "pointer to Sonar_Daq = " & STR$(cptr) IF cptr THEN CALL DWORD cptr USING Sonar_DAQ(%DAQ_DOUBLEBUFFER) TO i ELSE logfile "No Codepointer to Sonar_DAQ in " & $DLL END IF warning "sonar daq started END IF 'rem again.. 'logfile $DLL & " dll-name " ' ok cptr = GetProcAddress(gh.gnh,"SONAR_DAQ") logfile "pointer to Sonar_Daq = " & STR$(cptr) IF cptr THEN CALL DWORD cptr USING Sonar_DAQ(%DAQ_DOUBLEBUFFER) TO i ELSE logfile "No Codepointer to Sonar_DAQ in " & $DLL END IF ' initialize values for dta and dtf: IF sr THEN ' without valid pointer we crash... @sr.noise = 0 @sr.dta = 8 ' integration depth for amplitudes returned in @sr.xys, @sr.xzs etc... @sr.ascale = 2 ' for accelleration calculation END IF Task(%Sonar_VU_Task).naam = "SonarVu" ' 1 'Task(%Sonar_VU_Task).cPtr = GetProcAddress(GetModuleHandle($dll),"SONAR_II_VU") ' wrong Task(%Sonar_VU_Task).cPtr = GetProcAddress(gh.gnh,"SONAR_II_VU") Task(%Sonar_VU_Task).freq = 8 Task(%Sonar_VU_Task).flags = %DLL_TASK OR %PERTIM_TASK Task(%Sonar_Display_Task).naam = "SonarDsply>" 'Task(%Sonar_Display_Task).cPtr = GetProcAddress(GetModuleHandle($dll),"SONAR_DISPLAY")' wrong Task(%Sonar_Display_Task).cPtr = GetProcAddress(gh.gnh,"SONAR_DISPLAY") Task(%Sonar_Display_Task).freq = 20 Task(%Sonar_Display_Task).flags = %DLL_TASK OR %PERTIM_TASK Task(%iax).naam = "IAxFileP" Task(%iax).cptr = CODEPTR(MidiPlayerSonarInteraction) Task(%iax).freq = 24 '64 Task(%iax).flags = %PERTIM_TAsk ELSE Warning "Sonar disabled" 'Logfile "Sonar disabled" END IF #ENDIF Init_MM ' in g_mm.inc MM_PanicButtonWindow '(OPT BYVAL instrum$, BYVAL hParent AS LONG, BYVAL x AS LONG, BYVAL y AS LONG) AS LONG MM_AllOff %MM_Wind #IF NOT %DEF(%barebones) ButnSW(1).tag0 = "START" ' start/stop toggle ButnSW(1).tag1 = "STOP" ButnSW(1).cPtr = CODEPTR(ButnSW_IaxPlayStart) ButnSw(2).tag0 = "IaxRythm" ButnSw(2).tag1 = "RythmOff" ButnSw(2).cptr = CODEPTR(Toggle_TangoPlay) ButnSw(7).tag0 = "MiFlt On" ButnSw(7).tag1 = "MiFlt Of" ButnSw(7).cptr = CODEPTR(togmifilt) #ENDIF FUNCTION = %True END FUNCTION SUB Picra_VU () ' STATIC resolution AS DWORD - fixed to 7 bits ' to be adapted for variable number of picra devices... STATIC h%, bw%, Sp%, H1% LOCAL il AS LONG LOCAL hBrush AS LONG LOCAL hDC AS LONG LOCAL hOldBrush AS LONG DIM zpoint(0 TO 1 + UBOUND(pRadPic)*2) AS LOCAL INTEGER IF ISFALSE Task(%Picra_VU).tog THEN 'resolution = 7 '9 'v% = 2^resolution = 128 ' in g_hgen.inc IF ISFALSE Task(%Picra_VU).hParam THEN Task(%Picra_VU).hParam = Make_ii_VU_Window (7) h% = 1 ' horizontal start position for VU-graph bw% = 14 ' 7 ' breedte van de balkjes Sp% = 5 ' spatie tussen de balkjes ' Task(%Picra_VU).freq = 8 - done on declaration Task(%Picra_VU).tog = %True END IF hDC = GetDC (Task(%Picra_VU).hParam) ' blank existing graph: PatBlt hDC, h%,0,h% + ((bw%+ Sp%)*16) ,128,%WHITENESS ' monitor procedure for Picra-devices - displays bar-graph of analysis results FOR il = 0 TO UBOUND(pRadPic) zpoint(il)= MIN(@pRadPic(il).amp,128) zpoint(il+ (UBOUND(pRadPic) + 1)/2) = MIN(@pRadPic(il).f, 128) 'point(il+4)= MIN(@pRadPic(il).f ,128) NEXT il FOR il = 0 TO UBOUND(zpoint) '7 SELECT CASE il MOD 4 CASE 0 ', 4 hBrush = CreateSolidBrush (%GREEN) CASE 1 ',5 hBrush = CreateSolidBrush (%BLUE) CASE 2 ',6 hBrush = CreateSolidBrush (%YELLOW) CASE 3 ',7 hBrush = CreateSolidBrush (%RED) END SELECT hOldBrush = SelectObject (hDC, hBrush) H1% = h% + (il * bw%) ' versize% = 128 - point(il) Rectangle hDC, H1%, 128, H1%+Sp%, 128 - zpoint(il) 'versize% SelectObject hDC, hOldBrush DeleteObject hBrush NEXT il ReleaseDC Task(%Picra_VU).hParam, hDC END SUB SUB MidiPlayerPicraInteraction (OPT BYVAL freq AS SINGLE) 'picradar interaction with fileplayer: stop on no movement, start/cont on movement, playback speed scales with movement speed 'how to use: first start MMFileplay, choose a piece ad press the 'wait for interaction' button 'then start this task 'then the PicraListenTask 'MMFileplay tasknr should be App.MidiPlayerTasknr LOCAL i AS LONG STATIC init AS LONG STATIC hwfreq AS LONG STATIC filefreq AS SINGLE LOCAL smax AS SINGLE STATIC movementfreq AS SINGLE 'moving average of estfreq LOCAL b$ logfile "ntr" IF ISFALSE init THEN 'what was this doing? can't have worked, as callback is sending value to sonar interaction function.. ' DIALOG NEW %HWND_DESKTOP, "file freq MM",,,100, 14 TO hwfreq ' CONTROL ADD TEXTBOX, hwfreq, 1, "60", 1, 1, 60, 12, %ES_NUMBER ' CONTROL ADD BUTTON, hwfreq, 2, "update", 62, 1, 36, 12, %BS_FLAT CALL CBFileFreq ' DIALOG SHOW MODELESS hwfreq filefreq=1 init = %true movementfreq = 1 logfile FUNCNAME$ + " init ok" ' starttask %mvrec_metro END IF ' CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 13, STR$(@sr.xyza) + STR$(movementfreq) ' logfile "movementfreq:" + STR$(movementfreq) IF MAX(@pRadPic(0).f, @pRadPic(1).f, @pRadPic(2).f, @pRadPic(3).f) < 1 THEN IF movementfreq > 0 THEN ' logfile "PAUZE" CALL DWORD Task(App.MidiPlayerTasknr).cptr USING dummyplayer (0, 1) CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 12, "PAUZE!" movementfreq = -movementfreq END IF CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 12, "p..." EXIT SUB ELSEIF movementfreq < 0 THEN CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 12, "CONT!" ' logfile "CONT!" movementfreq = - movementfreq ' logfile "CALL..." + str$(App.MidiPlayerTasknr) CALL DWORD Task(App.MidiPlayerTasknr).cptr USING dummyplayer (0, -1) ' logfile "survived CALLing" END IF movementfreq = .9 * movementfreq + .1 * MIN(4, MAX(.125, 2 * MAX(@pRadPic(0).f, @pRadPic(1).f, @pRadPic(2).f, @pRadPic(3).f)/35)) ' logfile "frq:" + STR$(movementfreq) CONTROL SET TEXT gh.cockpit, %GMT_MSG1, STR$(movementfreq) Task(App.MidiPlayerTasknr).rit.minduur = movementfreq '@sr.xyzf '1 +(sqr(movementfreq-.3))/filefreq ' logfile "xit" END SUB SUB MidiPlayerPicraInteraction_justspeed (OPT BYVAL freq AS SINGLE) 'simplified version of the former - just influences playback speed, doesnt' start or stop.. LOCAL i AS LONG STATIC init AS LONG STATIC hwfreq AS LONG STATIC filefreq AS SINGLE STATIC firststart AS LONG LOCAL smax AS SINGLE STATIC movementfreq AS SINGLE 'moving average of estfreq LOCAL b$ logfile "ntr" IF ISFALSE init THEN filefreq=1 init = %true movementfreq = 1 logfile FUNCNAME$ + " init ok" ' starttask %mvrec_metro END IF 'only when we're sure there has been movement, we start influencing speed, so we can start piece at normal tempo and only start interaction when the performer entrs the stage.. IF MAX(@pRadPic(0).amp, @pRadPic(1).amp, @pRadPic(2).amp, @pRadPic(3).amp) > 10 THEN firststart = 1 IF ISFALSE firststart THEN EXIT SUB movementfreq = .9 * movementfreq + .1 * MIN(4, MAX(.125, 2 * MAX(@pRadPic(0).f, @pRadPic(1).f, @pRadPic(2).f, @pRadPic(3).f)/35)) CONTROL SET TEXT gh.cockpit, %GMT_MSG1, STR$(movementfreq) Task(App.MidiPlayerTasknr).rit.minduur = movementfreq '@sr.xyzf '1 +(sqr(movementfreq-.3))/filefreq END SUB CALLBACK FUNCTION CBFileFreq LOCAL b$ IF CBCTLMSG <> %BN_CLICKED THEN EXIT FUNCTION CONTROL GET TEXT CBHNDL, 1 TO b$ '; MidiPlayerSonarInteraction VAL(b$) 'temporary disabled.. END FUNCTION SUB dummyplayer(OPT BYVAL rst AS LONG, OPT BYVAL pause AS LONG) 'we only need declaration for call dword using.. END SUB SUB ixp_cqt_Listen () 'adapted from machinewall.inc 'interpretation of polyphonic pitch to midi input 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 STATIC THIS AS LONG STATIC lasteventtime AS SINGLE LOCAL wijzer AS DWORD LOCAL nrevents AS LONG IF ISFALSE Task(%Ixp_cqtlst).tog THEN Task(%Ixp_Cqtlst).tog = 1 THIS = %ixp_cqtLst CQT_MidiIn.vol = 4 ' midi level CQT_MidiIn.tes = 25 ' in Hz CQT_MidiIn.dens = 0.1 ' in events/sec (Hz) Task(THIS).tog = %True Task(THIS).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 REDIM velbyte(127) AT VARPTR(Task(THIS).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? = 32 TO 125 STEP 5 TesWeight(FIX((noot? - 32)/5)) = 0 FOR i = 0 TO 4 TesWeight(FIX((noot? - 32)/5)) = TesWeight(FIX((noot? - 32)/5)) + velbyte(noot? + i)/127 NEXT TesWeight(FIX((noot? - 32)/5)) = TesWeight(FIX((noot? - 32)/5)) / 5 NEXT 'check for new note nv% = GetMidiNote% (cqt.Inchannel, %Remove OR %Oldest) IF nv% = %NotFalse THEN EXIT SUB ' if no note came in, exit the task ' lasteventtime = timegettime velo? = LOBYT (nv%): noot? = HIBYT (nv%) ' write it to the harmony-string (polyphonic) IF velo? THEN velbyte(noot?) = MIN(127, velbyte(noot) + velo? / 2) lastontime(noot?) = TIMER laston(noot?) = velbyte(noot?) END IF ' bereken de gemiddelde geluidsterkte van de input IF velo? THEN CQT_MidiIn.Vol = CQT_MidiIn.Vol + CQT_MidiIn.Vol + CQT_MidiIn.Vol + velo? SHIFT RIGHT CQT_MidiIn.Vol, 2 END IF ' bereken de gemiddelde tessituurligging van de input IF noot? THEN CQT_MidiIn.tes = ((CQT_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 CQT_MidiIn.dens = (nrevents/2) / 2.56! ' express result in (events/2)/second FillHarType Task(%Ixp_cqtLst).har END SUB SUB Ixp_cqt_Mon STATIC hw AS LONG STATIC rslt AS LONG STATIC arr() AS SINGLE STATIC oldvel AS STRING * 128 LOCAL i AS LONG LOCAL area AS rectl LOCAL x AS LONG, y AS LONG IF ISFALSE hw THEN DIALOG NEW 0, "Cqt_Mon",80,1,205, 150, %WS_THICKFRAME TO hw DIALOG PIXELS hw, 300, 250 TO UNITS x, y DIALOG SET SIZE hw, x, y CONTROL ADD LABEL, hw, -1, "vol[0-127]", 5, 1, 50, 12 CONTROL ADD LABEL, hw, -1, "tes[0-4000]log", x/3, 1, 50, 12 CONTROL ADD LABEL, hw, -1, "events\dsec", 2*x/3, 1, 50, 12 DIALOG SHOW MODELESS hw TO rslt DIM arr(21) END IF IF rslt THEN hw = %false StopTask %ixp_cqtMon END IF DIALOG GET SIZE hw TO x, y y = y - 30 DIALOG UNITS hw, x, y TO PIXELS Area.nRight, Area.nBottom area.ntop = 25: area.nleft = 5 ': area.nright = 230 IF Task(%Ixp_cqtLst).Har.vel <> Oldvel THEN Oldvel = Task(%Ixp_cqtLst).Har.vel ShowHar Task(%Ixp_cqtLst).Har, 1,140,2! END IF i = 0 IF CQT_MidiIn.Vol / 127 <> Arr(0) THEN Arr(0) = CQT_MidiIn.Vol / 127: i = 1 IF SQR(CQT_MidiIn.Tes / 4000) <> Arr(1) THEN Arr(1) = SQR(CQT_MidiIn.Tes / 4000): i = 1 IF CQT_MidiIn.Dens / 100 <> Arr(2)THEN Arr(2) = CQT_MidiIn.Dens / 100: i = 1 POKE$ VARPTR(arr(3)), PEEK$(VARPTR(TesWeight(0)), (UBOUND(TesWeight) + 1) * 4) IF i THEN DrawBarChart hw, area, arr() END IF END SUB SUB Ixp_StartStop () 'specific code for piece Moniek Darge - starts on a G(56), stops on E(77) (which are the violins open strings.. STATIC lh AS harmtype STATIC stat AS LONG 'note aan te passen aan midiplayer: zou gepauseerd aan een stuk moeten kunnen beginnen!! IF ISFALSE Task(%Ixp_StST).tog THEN Task(%Ixp_StSt).tog = 1 stat = 0 MidiPlayer 0, 1 'wacht op lage sol om te beginnen END IF IF ISFALSE stat THEN IF ASC(task(%Ixp_Cqtlst).har.vel, 56) > 1.15 * ASC(lh.vel, 56) THEN 'voor noot 56 (sol) dus! CONTROL SET TEXT gh.cockpit, %GMT_Msg1, "restart" stat = 1 MM_MidiPlayer 0, -1 'restart END IF ELSE IF ASC(task(%Ixp_Cqtlst).har.vel, 77) > 1.15 * ASC(lh.vel, 77) THEN CONTROL SET TEXT gh.cockpit, %GMT_Msg1, "restop" stat = 0 MM_MidiPlayer 0, 1 'pause END IF END IF lh.vel = task(%Ixp_CqtLst).har.vel END SUB SUB Ixp_ListSpd () STATIC SPEED AS SINGLE LOCAL ls AS SINGLE IF ISFALSE SPEED THEN SPEED = 1 ls = .5 * MAX(.4, 0.0791211 + 0.2434194 * CQT_MidiIn.dens - 0.00300037 * CQT_MidiIn.dens ^ 2) SPEED = (4 * SPEED + ls) / 5 CONTROL SET TEXT gh.cockpit, %GMT_MSG2, STR$(CQT_MidiIn.dens) + STR$(ls) + STR$(SPEED) Task(App.MidiPlayerTasknr).rit.minduur = SPEED END SUB SUB Ixp_ListVel () LOCAL velscale AS SINGLE velscale = MAX(0.5, CQT_MidiIn.vol/64) Task(App.MidiPlayerTaskNr).rit.maxduur = velscale END SUB SUB Ixp_NegInp () 'pause player as long as we get new midi input STATIC stat AS LONG STATIC tresh AS BYTE LOCAL playing AS LONG LOCAL i AS LONG IF stat = 0 THEN 'init stat = 1 'playing slideR(0).value = 60 tresh = 60 SendMessage Slider(0).h, %TBM_SETPOS, %true, 60 starttask %Ixp_CqtLst Warning "Cockpit Slider 0 = trigger treshold (Default 60) 'check status of player task IF ISFALSE Task(App.MidiPlayerTasknr).tog THEN StartTask App.MidiPlayerTasknr END IF EXIT SUB END IF playing = -1 IF slider(0).value <> tresh THEN tresh = slider(0).value CONTROL SET TEXT gh.cockpit, %GMT_MSG2, "tresh:" + STR$(Tresh) END IF FOR i = 0 TO 127 IF ASC(task(%Ixp_Cqtlst).har.vel, i) > tresh THEN playing = 1 EXIT FOR END IF NEXT IF stat <> playing THEN CONTROL SET TEXT gh.cockpit, %GMT_MSG1, STR$(stat) stat = playing MM_MidiPlayer 0, stat IF stat > 0 THEN MM_AllOFf %MM_Notes END IF END IF END SUB SUB ButnSW_IaxPlayStart () LOCAL ButtonNr AS LONG LOCAL i AS DWORD ButtonNr = App.butnSWparam - %GMT_BUTNSW_ID ' starts the promil counter. IF ButnSW(ButtonNr).Flag THEN App.MTstart = %True App.tstart = timeGetTime ' start the chronometerfunction SetDlgItemText gh.Cockpit, App.butnSWparam, "STOP" IF hMidiI(0) THEN ClearMiBuf 0 ' start with a blank midi input buffer BlockSysExReception hMidiI(0) 'SxThread END IF Runtime %True ' Sonar_DAQ %DAQ_DOUBLEBUFFER ELSE ' App.MTstart = %False ' SetDlgItemText gh.Cockpit, App.butnSWparam, "CONT" ' Sonar_DAQ %False END IF App.butnSWparam = %False END SUB SUB Toggle_TangoPlay () STATIC tog AS DWORD BIT TOGGLE tog, 0 Task(App.MidiPlayertasknr).hparam = CHOOSE(tog, CODEPTR(Tango_PlayAlong)) END SUB SUB Tango_PlayAlong (md() AS ParsedMidiType, MMTrack() AS musician, BYVAL mevents AS DWORD, BYVAL maxevents AS DWORD) ' should become a general proc with knowledge about the beat etc. 'for now KISS and tailored for Gottschalk tangowalz STATIC lasttime AS DWORD LOCAL app AS LONG IF ISFALSE lasttime THEN Progchange Casta2.channel, 122 ProgChange Casta.channel, 122 ' Progchange Troms.channel, 122 ' Progchange Thunderwood.channel, 122 StartTask %radar_listen lasttime = timegettime - 20 END IF LOCAL i AS DWORD logfile STR$(mevents) + STR$(maxevents) + STR$(md(mevents).time) IF (timegettime-lasttime) < 20 THEN EXIT SUB 'simultaneous event protection IF mevents > maxevents THEN EXIT SUB IF ((md(mevents).bstat AND &H090) <> &H090) OR (md(mevents).bdat2 <> 0) THEN EXIT SUB 'only play if there is more then one note at the same time (tremolo prevention..) ' app = 0 ' for i = events - 2 to events + 2 ' if i = events then iterate for ' if abs((md(i).time - md(events).time)) < 1 then incr app ' next IF @pRadPic(0).amp > 5 AND @pRadPic(0).f > 2 THEN mPlay Casta2.channel, MAX(Casta2.LowTes, Casta2.HighTes - (Casta2.Hightes - Casta2.LowTes) * @pRadPic(0).f/40), @pRadPic(0).amp- 5 IF md(mevents).bdat1 > 69 THEN lasttime = timegettime 'only when we actually played something!! END IF IF @pRadPic(3).amp > 5 AND @pRadPic(3).f > 2 THEN mPlay Casta.channel, MAX(Casta.LowTes, Casta.HighTes - (Casta.Hightes - Casta.LowTes) * @pRadPic(3).f/40), MIN(127,2 * @pRadPic(3).amp) IF md(mevents).bdat1 > 69 THEN lasttime = timegettime 'only when we actually played something!! END IF '' if app < 1 then exit sub ' if md(events).bdat1 > 69 then exit sub 'good split point for Gottschalk tangowalz ' logfile "base:" + str$(md(Events).bdat1) ' SELECT CASE MMTrack(md(events).track).channel 'eliminate pitchless percussion instruments and instruments that are lilekly to play tremolo's ' CASE Puff.channel, Klung.channel, Troms.channel, Snar.channel, Thunderwood.channel, Psch.channel, Springers.channel, vacca.channel, vitello.channel, Casta2.channel ' EXIT SUB ' END SELECT ' IF @pRadPic(2).amp > 5 AND @pRadPic(2).f > 2 THEN ' mPlay Snar.channel, MAX(Snar.LowTes, Snar.HighTes - (Snar.Hightes - Snar.LowTes) * @pRadPic(2).f/40), @pRadPic(2).amp- 5 ' lasttime = timegettime 'only when we actually played something!! ' END IF ' IF @pRadPic(1).amp > 5 AND @pRadPic(1).f > 2 THEN ' mPlay Troms.channel, MAX(Troms.LowTes, Troms.HighTes - 1 - (Troms.Hightes - Troms.LowTes) * @pRadPic(1).f/40), @pRadPic(1).amp - 5 ' lasttime = timegettime 'only when we actually played something!! ' END IF '' IF MAX(@pRadPic(0).amp, @pRadPic(1).amp, @pRadPic(2).amp, @pRadPic(3).amp) > 20 THEN '' PlayKloks md(events).bdat1, MAX(@pRadPic(0).amp, @pRadPic(1).amp, @pRadPic(2).amp, @pRadPic(3).amp) - 20, 30 '' end if ' CONTROL SET TEXT gh.cockpit, %GMT_MSG1, STR$(timegettime) END SUB #IF NOT %DEF(%barebones) SUB MidiPlayerSonarInteraction (OPT BYVAL freq AS SINGLE) 'we couldn't analyse as much buffers as in offline version here 'as a result, the peek detection is more crude 'most old code is still here but commented out.. also cfr. parsemovemntdata.bas LOCAL i AS LONG LOCAL pseek AS LONG STATIC init AS LONG STATIC buffer() AS INTEGER STATIC hwfreq AS LONG STATIC filefreq AS SINGLE LOCAL smax AS SINGLE LOCAL estfreq AS SINGLE 'estimated freq in one analysis buffer STATIC movementfreq AS SINGLE 'moving average of estfreq LOCAL divpeek AS SINGLE LOCAL b$ IF ISFALSE init THEN DIALOG NEW %HWND_DESKTOP, "file freq MM",,,100, 14 TO hwfreq CONTROL ADD TEXTBOX, hwfreq, 1, "60", 1, 1, 60, 12, %ES_NUMBER CONTROL ADD BUTTON, hwfreq, 2, "update", 62, 1, 36, 12, %BS_FLAT CALL CBFileFreq DIALOG SHOW MODELESS hwfreq filefreq=1 init = %true movementfreq = 1 DIM buffer(512) '?511?? ' starttask %mvrec_metro DIM maxpeekhist(60) AS STATIC SINGLE 'freq ofhighest peek histo END IF CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 13, STR$(@sr.xyza) + STR$(movementfreq) IF @sr.xyza < 200 THEN IF movementfreq > 0 THEN CALL DWORD Task(App.MidiPlayerTasknr).cptr USING dummyplayer(0, 1) CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 12, "PAUZE!" movementfreq = -movementfreq END IF CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 12, "p..." EXIT SUB ELSEIF movementfreq < 0 THEN CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 12, "CONT!" movementfreq = - movementfreq CALL DWORD Task(App.MidiPlayerTasknr).cptr USING dummyplayer (0, -1) END IF ' IF freq THEN filefreq = freq / 60: DO WHILE filefreq > 2.5: filefreq = filefreq / 2: LOOP ' DIM xac(255) AS LOCAL INTEGER 'AT @sr.pb(13) '' POKE$ VARPTR(buffer(0)), PEEK$(varptr(buffer(256)), 512) '=512 bytes = 256 elements '' POKE$ VARPTR(buffer(256)), PEEK$(@sr.pb(13), 512) ' DIM corval(128) AS LOCAL LONG '' for pseek = 0 to 255 step 64 'was 64, must be even nr; 512/n 'last statement still true here??? ' 'get xac from buffer ' POKE$ VARPTR(xac(0)), PEEK$(@sr.pb(13), 512) ' PEEK$(VARPTR(buffer(pseek)), 512) ' AnalyzeMovementdata xac(), corval() ' i = movement_getmax(corval()) 'returns bins of lowest peek, lowest above average, max ' MAT maxpeekhist() = (.94) * maxpeekhist() ' INCR maxpeekhist(i) '' smax = MAX(smax, maxpeekhist(5 * i)) ''' next '' smax = 1/smax ' ' ShowHistograms slowpeekhist(), avgpeekhist(), maxpeekhist() ' DIM peeks(UBOUND(maxpeekhist)) AS LOCAL SINGLE: DIM peekvals(UBOUND(maxpeekhist)) AS LOCAL SINGLE ' FOR i = 0 TO UBOUND(maxpeekhist) ' IF maxpeekhist(i) > .2 THEN peeks(i) = i/80: peekvals(i) = maxpeekhist(i) ' NEXT ' ARRAY SORT peekvals(), TAGARRAY peeks(), DESCEND ' i = 0 ' do while estfreq < .2 ' estfreq = peeks(i) '= estimated freq in this buffer - should be integrated over time... ' incr i ' if i > 10 then ' control set text gh.cockpit, %GMT_MSG2, "no freq!!!" ' exit sub ' end if ' loop '' estfreq = i ' IF estfreq < .01 THEN EXIT SUB ' IF corval(0) < .1 THEN EXIT SUB ' 'if other peeks are close, take average, taking in account strength of peek ' IF peekvals(0) / 2 < peekvals(1) THEN ' divpeek = peekvals(0) ' estfreq = estfreq * peekvals(0) ' FOR i = 1 TO UBOUND(peekvals) ' IF peekvals(0) / 2 > peekvals(i) THEN EXIT FOR ' estfreq = estfreq + peeks(i) * peekvals(i) ' divpeek = divpeek + peekvals(i) ' NEXT ' estfreq = estfreq / divpeek ' END IF ' CONTROL SET TEXT gh.cockpit, %GMT_MSG2, STR$(estfreq) ' DO WHILE estfreq < .24: estfreq = estfreq * 2: LOOP ' DO WHILE estfreq > 3: estfreq = estfreq / 2: LOOP ' IF ISFALSE movementfreq THEN ' movementfreq = estfreq ' ' ELSEIF estfreq < (movementfreq /2) THEN 'disabled octaafsprong protectie.. - should be handled by integration... ' ' movementfreq = .9 * movementfreq + .2 * estfreq 'arbitrary integration values.. to be tested for best results ' ' ELSEIF estfreq > movementfreq * 2 THEN ' ' movementfreq = .9 * movementfreq + .05 * estfreq ' ELSE ' movementfreq = .7 * movementfreq + .3 * estfreq ' END IF ' 'maybe we will need to ignore current estfreq if it's peekval() gets too low ' b$ = "current freq:" + STR$(estfreq)+ " - average:" + STR$(movementfreq) ' task(%mvrec_metro).freq = movementfreq movementfreq = .9 * movementfreq + .1 * MIN(2, MAX(.5, @sr.xyzf/1100)) CONTROL SET TEXT gh.cockpit, %GMT_MSG1, STR$(@sr.xyzf) + STR$(movementfreq) Task(App.MidiPlayerTasknr).rit.minduur = movementfreq '@sr.xyzf '1 +(sqr(movementfreq-.3))/filefreq ' CONTROL SET TEXT gh.cockpit, %GMT_MSG1, b$ END SUB 'copy from g_interfaces.. #ENDIF SUB TogMiFilt () STATIC tstat AS LONG IF ISFALSE tstat THEN tstat = 1 ELSE tstat = 0 END IF ToggleMM_Filter tstat 'in g_midi END SUB