' ****************************** ' * demo-code for GMT * ' * prototypes for applications* ' *and demonstrations for tasks* ' ****************************** ' since tasknumbers will be used throughout your code a lot ' it's a smart idea to use declared constants for the task ' numbers in your own applications. ' Each tasknumber corresponds to a single checkbox in the cockpit. (numbered from 0 to 63) '------------------------------------------------------- #INCLUDE "c:\b\pb\gmt\g_mm.bi" #INCLUDE "c:\b\pb\gmt\g_mm.inc" ' the 'Piano Phase' piece demonstrates timing independence %Demo_Reich1 = 16 %Demo_Reich2 = 17 %Demo_UDP = 19 %Demo_readfuga = 21 'plays back files in old format of gwr fuga's '------------------------------------------------------- ' these demonstrate simple scale playing using midi: %Demo_ScaleUP = 51 %Demo_ScaleDOWN = 52 %Demo_gliss = 53 '------------------------------------------------------- ' this demonstrates listening to midi-input: %Demo_listen = 63 ' these demonstrate coding midi delaylines: ' the listen task must be on for these to work. %Demo_delayFast = 57 %Demo_delaySlow = 58 %Demo_delayNormal = 59 %Demo_delayBackwards = 60 ' demonstrates simple imitation of midi input with modified duration. %Demo_imit = 61 ' demonstrates recording and playing .seq files %Demo_recordSeq = 40 %testkloks = 32 %testtimer = 24 %testplaydur = 25 %testqip = 26 GLOBAL pSeq AS SequencerType PTR GLOBAL Melody () AS DWORD ' for Steve Reich 'Piano Phase' DECLARE FUNCTION InitDemo () AS DWORD DECLARE SUB DemoButnSWHandler () ' rerouting of the default buttonswitch handler in GMT-main DECLARE SUB Listen2Player () ' test task 63 - example code for use of midi input DECLARE SUB DelayPlayerF () ' task 57 - example code for delay lines DECLARE SUB DelayPlayerS () ' task 58 DECLARE SUB DelayPlayerN () ' task 59 DECLARE SUB DelayPlayerBackN () ' task 60 DECLARE SUB ImitateVarDuur () ' 61 - conservatory class demo DECLARE SUB ScaleUP () ' test task 51 - example upwards scale DECLARE SUB ScaleDOWN () ' test task 52 - example downwards scale DECLARE SUB Reich1 () ' demonstrates the slider control in the Cockpit window DECLARE SUB Reich2 () ' id. DECLARE SUB Demo_UDP_Send () ' task 19 DECLARE FUNCTION WinMix_Record_Select_Cd () AS LONG DECLARE SUB PlayDurTest() FUNCTION InitDemo () AS DWORD LOCAL i AS DWORD LOCAL h AS LONG LOCAL pg_net AS g_net_type PTR DIM Flute AS GLOBAL Musician DIM Piccolo AS GLOBAL Musician DIM Piperola AS GLOBAL Musician ' DIM Puff AS GLOBAL musician ' DIM Troms AS GLOBAL musician RANDOMIZE TIMER 'basic M&M initialisation Init_MM 'show window with allnoteoff button for each instrument MM_PanicButtonWindow "", 0, 10, 1 GetInstrumentParams Piperola, %IDM_PIPEROLA ' i = SetRobotPort (Piperola, Inifilename, hMidiO()) GetInstrumentParams Flute, %ID_FLUTE GetInstrumentParams Piccolo, %ID_PICCOLO #IF %DEF(%demo_faders) Init_Demo_Wavefaders () #ENDIF pg_net = g_net_ptr () ' get pointer to networkconfiguration structure in g_net.dll FOR i = 1 TO 15 ' we will use the first connected PC in the list for this demo: IF @pg_net.ip(i) THEN Task(%Demo_UDP).naam = "UDPsnd" Task(%Demo_UDP).cptr = CODEPTR(Demo_UDP_Send) Task(%Demo_UDP).flags = %False Task(%Demo_UDP).freq = 1 Task(%Demo_UDP).channel = i ' has to go into the highest nibble of channel SHIFT LEFT Task(%Demo_UDP).channel,12 Task(%Demo_UDP).channel = Task(%Demo_UDP).channel OR %Harma_Channel ' set midi channel EXIT FOR END IF NEXT i IF hMidiO(0) THEN ' create the task only if we have an output device... Task(%Demo_ScaleUP).naam = "ScaleUP" ' demo for upwards scale - task 51 Task(%Demo_ScaleUP).freq = 100 Task(%Demo_ScaleUP).level = 127 Task(%Demo_ScaleUP).channel = 1 Task(%Demo_ScaleUP).cptr = CODEPTR(ScaleUP) Task(%Demo_ScaleUP).flags = %MIDI_TASK Task(%Demo_ScaleDOWN).naam = "ScaleDN" ' demo for downwards scale Task(%Demo_ScaleDOWN).freq = 100 Task(%Demo_ScaleDOWN).level = 127 Task(%Demo_ScaleDOWN).channel = 2 Task(%Demo_ScaleDOWN).cptr = CODEPTR(ScaleDOWN) Task(%Demo_ScaleDOWN).flags = %MIDI_TASK Task(%Demo_Readfuga).naam="PlayFuga" Task(%demo_readfuga).freq = 9 Task(%Demo_Readfuga).cptr = CODEPTR(PlayOldFugaFormat) Task(%Demo_gliss).naam = "gliss" Task(%demo_gliss).freq = .5 Task(%demo_gliss).cptr = CODEPTR(TestGliss) TaskEx(%demo_gliss).stopcptr = CODEPTR(MM_AllOff) Task(%testtimer).naam="TestTime" Task(%testtimer).freq = 1 Task(%testtimer).cptr = CODEPTR(TestTimer) TaskEx(%testtimer).stopcptr = CODEPTR(TestTimer_Stop) Task(%testplaydur).naam="tstPlayDur" Task(%testplaydur).freq = 4 Task(%testplaydur).cptr = CODEPTR(PlaydurTest) IF UBOUND(Slider) > -1 THEN Task(%Demo_Reich1).naam = "Reich 1" Task(%Demo_Reich1).freq = roundfreq(1000.0 / 52.0) '19.23 '1.9 '19.00 Task(%Demo_Reich1).level = Slider(0).resetval Task(%Demo_Reich1).pan = Slider(1).resetval IF @pg_net.ip(1) THEN Task(%Demo_Reich1).channel = &H1000 ' for network test - to first PC connected ELSE Task(%Demo_Reich1).channel = %False END IF Task(%Demo_Reich1).cptr = CODEPTR(Reich1) Task(%Demo_Reich1).flags = %MIDI_TASK OR %HARM_TASK Task(%Demo_Reich2).naam = "Reich 2" Task(%Demo_Reich2).level = Slider(0).resetval Task(%Demo_Reich2).pan = Slider(1).resetval IF @pg_net.ip(2) THEN Task(%Demo_Reich2).channel = &H2000 ' for networksupport - to second PC connected ELSE Task(%Demo_Reich2).channel = 1 END IF Task(%Demo_Reich2).cptr = CODEPTR(Reich2) Task(%Demo_Reich2).flags = %MIDI_TASK OR %HARM_TASK ' now we try to find the smallest frequency difference we can generate ' in order to obtain phasing, taking into account the 1ms timing resolution ' inherent to Windows. LOCAL f AS SINGLE f = Task(%Demo_Reich1).freq DO Task(%Demo_Reich2).freq = roundfreq (f) IF roundfreq(Task(%Demo_Reich2).freq) <> roundfreq(Task(%Demo_Reich1).freq) THEN EXIT LOOP f = f + 0.001 LOOP 'msgbox "f1= " & STR$(Task(%Demo_Reich1).freq) & " f2= " & STR$(Task(%Demo_Reich2).freq) DIM Melody (11) AS GLOBAL DWORD Melody(0)= 64 : Melody(1)= 66: Melody(2)= 71: Melody(3)=73 Melody(4)= 74 : Melody(5)= 66: Melody(6)= 64: Melody(7)=73 Melody(8)= 71 : Melody(9)= 66: Melody(10)= 74: Melody(11)=73 END IF END IF IF hMidiI(0) AND hMidiO(0) THEN Task(%Demo_delayFast).naam = "FastPlay" ' demo for delayed player input - double speed Task(%Demo_delayFast).freq = 60 Task(%Demo_delayFast).channel = Piccolo.channel Task(%Demo_delayFast).level = 127 Task(%Demo_delayFast).cptr = CODEPTR(DelayPlayerF) Task(%Demo_delayFast).flags = %MIDI_TASK OR %HARM_TASK Task(%Demo_delaySlow).naam ="SlowPlay" ' demo for delayed player input at half speed Task(%Demo_delaySlow).freq = 16 Task(%Demo_delaySlow).channel = Flute.channel + 1 Task(%Demo_delaySlow).level = 127 Task(%Demo_delaySlow).cptr = CODEPTR(DelayPlayerS) Task(%Demo_delaySlow).flags = %MIDI_TASK OR %HARM_TASK Task(%Demo_delayNormal).naam ="DelyPlay" ' demo for delayed player input at normal speed Task(%Demo_delayNormal).freq = 28 Task(%Demo_delayNormal).channel = Piccolo.channel + 1 Task(%Demo_delayNormal).level = 127 Task(%Demo_delayNormal).cptr = CODEPTR(DelayPlayerN) Task(%Demo_delayNormal).flags = %MIDI_TASK OR %HARM_TASK Task(%Demo_delayBackwards).naam ="BackPlay" ' demo for backwards delay line at normal speed Task(%Demo_delayBackwards).freq = 29 Task(%Demo_delayBackwards).channel = Piccolo.channel + 2 Task(%Demo_delayBackwards).level = 127 Task(%Demo_delayBackwards).cptr = CODEPTR(DelayPlayerBackN) Task(%Demo_delayBackwards).flags = %MIDI_TASK OR %HARM_TASK Task(%Demo_imit).naam = "ImiVaDur" Task(%Demo_imit).freq = 31 Task(%Demo_imit).tempo = Task(%Demo_imit).freq * 60 Task(%Demo_imit).channel = 0 Task(%Demo_imit).cptr = CODEPTR(ImitateVarDuur) Task(%Demo_imit).flags = %MIDI_TASK Task(%Demo_listen).naam = "Listen" Task(%Demo_listen).freq = 30 Task(%Demo_listen).cptr = CODEPTR(Listen2Player) END IF IF hMidiI(0) THEN 'for recording / playing .seq files Task(%demo_recordseq).naam = "Rec_Seq" Task(%Demo_Recordseq).freq = 101 Task(%Demo_RecordSeq).cptr = CODEPTR(recordseqfile) Task(%Demo_recordSeq).flags = Task(%Demo_recordSeq).flags OR %SCORE_TASK END IF Task(%testqip).naam="tstQIP" Task(%testqip).freq = 2 Task(%testqip).cptr = CODEPTR(TestqInstrumPlay) TaskEx(%testqip).stopcptr = CODEPTR(MM_AllOff) ' generally we read configuration data from a config.file. However, you can also code the ' cockpit layout for the buttons in-line, as done here: ' Note that we create the buttons only if they can be functional, i.e. if the required ' devices have been selected by the user: IF ISFALSE hMidiI(0) OR ISFALSE hMidiO(0) THEN ' midi I/O devices should have been selected ButnSW(0).tag0 = "" ButnSW(0).cPtr = %False END IF ButnSW(1).tag0 = "START" ' start/stop toggle ButnSW(1).tag1 = "STOP" ButnSW(1).cptr = %False ' use the code in this module. IF hMidiO(0) THEN ButnSW(2).tag0 = "Reich" ' start/stop piano phase toggle ButnSW(2).tag1 = "Reich Off" ButnSW(2).cptr = %False ' use code in this module, not the default handler in the library. END IF ButnSw(3).tag0 = "" ButnSW(7).tag0 = "" ' tags we do not delete remain with their default handling. ButnSW(8).tag0 = "" ButnSW(9).tag0 = "" IF ISFALSE Audio.hwO OR ISFALSE Audio.hWI THEN ' show this button only if wave out & wave in devices were selected. ButnSW(11).tag0 = "" ' note that I/O audio streaming will only work if your hardware allows for ButnSw(11).cPtr = %False ' simultaneous bidirection wave I/O ! END IF ' ONE SHOT FUNCTIONS: IF ISFALSE hMidiO(0) THEN ButnOS(0).tag = "" ButnOS(0).cPtr = %False END IF IF hMidiO(0) THEN ButnOS(1).tag = "PlaySeq" ButnOS(1).cptr = CODEPTR(PlaySeqFile) ELSE ButnOS(1).tag = "" END IF ButnOS(2).tag = "" ButnOS(3).tag = "" ButnOS(4).tag = "" ButnOS(5).tag = "" ButnOS(6).tag = "" ButnOS(7).tag = "" ButnOS(8).tag = "" ButnOS(9).tag = "" ButnOS(10).tag = "" App.butnSWCptr = CODEPTR(DemoButnSWHandler) ' rerouting of the default button switch handler SetDlgItemText gh.Cockpit,%GMT_TEXT_SLIDER0, "Level" & CHR$(0) ' used for midi level in Steve Reich SetDlgItemText gh.Cockpit,%GMT_TEXT_SLIDER1, "Pan" & CHR$(0) ' panning in demos FUNCTION = %True END FUNCTION SUB DemoButnSWHandler () LOCAL ButtonNr AS LONG LOCAL i AS DWORD ' this procedure, called by its pointer in App.ButnSWCptr, handles button clicks in the ' cockpit window. (handle= hCockpit) ' The parameter is passed in App.butnSWparam. ButtonNr = App.butnSWparam - %GMT_BUTNSW_ID SELECT CASE ButtonNr CASE 1 ' starts the promil counter. IF ButnSW(Buttonnr).flag THEN App.MTstart = %True App.tstart = timeGetTime ' start the chronometerfunction SetDlgItemText gh.Cockpit, %GMT_BUTNSW_ID + ButtonNr, "STOP" ClearMiBuf 0 ' start with a blank midi input buffer IF hMidiI(0) THEN BlockSysExReception hMidiI(0) ' SxThread dll proc END IF RunTime %True Promil %True StartTask App.GlobalHarmonyTaskNr ELSE App.MTstart = %False SetDlgItemText gh.Cockpit, %GMT_BUTNSW_ID + ButtonNr, "CONT" Promil %False StopTask App.GlobalHarmonyTasknr END IF CASE 2 IF ButnSW(Buttonnr).flag THEN ' we use a button here in order StartTask %Demo_Reich1 ' to be able to start two tasks StartTask %Demo_Reich2 ' simultaneously. This is inherently ELSE ' impossible by using a silly mouse. StopTask %Demo_Reich1 StopTask %Demo_Reich2 END IF END SELECT App.ButnSWparam = %False ' reset the passed buttonnumber. END SUB SUB ScaleUP () ' test for midi output & real-time controll STATIC i% STATIC toets% STATIC slnr AS BYTE LOCAL velo AS BYTE IF ISFALSE Task(%Demo_ScaleUP).tog THEN LOCAL testid%, testhandle AS LONG Task(%Demo_ScaleUP).tog = %True toets% = %NotFalse ' create a parameter window automatically: ' The handle for this window will be returned in Task(Tasknr).hParam DIM TaskParamLabels(1) AS ASCIIZ * 8 TaskParamLabels(0) = "Tempo" TaskParamLabels(1) = "Level" IF ISFALSE Task(%Demo_ScaleUP).hParam THEN MakeTaskParameterDialog %Demo_ScaleUP,2,Slider(),0,UDctrl(),TaskParamLabels() ' retrieve the slider values in Slider().value ??? ' the slider handles are in: Slider().h, defined as type slidercontroller. END IF i% = 35 END IF IF slnr = %False THEN slnr = TaskEX(%Demo_ScaleUP).SliderNumbers(1) END IF IF ISTRUE toets% THEN velo = Slider(slnr).value mPlay Task(%Demo_ScaleUP).channel, Gray (i%), velo 'PlayDur Task(%Demo_ScaleUP).channel, Gray(i%), velo, 100 - still has a bug!!! toets% = %False AddNote2Har Task(%Demo_ScaleUP).Har, Gray (i%), velo ELSE NoteOff Task(%Demo_ScaleUP).channel, Gray (i%) toets% = %NotFalse Task(%Demo_ScaleUP).Har.vel = STRING$(128, 0) INCR i% IF i% > 96 THEN i% = 36 END IF Task(%Demo_ScaleUP).freq = 32! * (Slider(slnr-1).value) / 128! IF Task(%Demo_ScaleUP).freq < 0.5 THEN Task(%Demo_ScaleUP).freq = 0.5 END SUB SUB ScaleDOWN () STATIC i% STATIC toets% STATIC slnr AS BYTE IF ISFALSE Task(%Demo_ScaleDOWN).tog THEN LOCAL testid%, testhandle AS LONG Task(%Demo_ScaleDOWN).tog = %True toets% = %NotFalse DIM TaskParamLabels(0 TO 1) AS ASCIIZ * 8 TaskParamLabels(0) = "Tempo" TaskParamLabels(1) = "Level" IF ISFALSE Task(%Demo_ScaleDOWN).hParam THEN MakeTaskParameterDialog %Demo_ScaleDOWN,2,Slider(),0,UDctrl(),TaskParamLabels() END IF i% = 96 END IF IF slnr = %False THEN slnr = TaskEX(%Demo_ScaleDOWN).SliderNumbers(1) END IF IF ISTRUE toets% THEN mPlay Task(%Demo_ScaleDOWN).channel, i%, Slider(slnr).value toets% = %False AddNote2Har Task(%Demo_ScaleDOWN).Har, i%,Slider(slnr).value ELSE NoteOff Task(%Demo_ScaleDown).channel, i% Task(%Demo_ScaleDOWN).Har.vel = STRING$(128, 0) toets% = %NotFalse DECR i% IF i% < 36 THEN i% = 96 END IF Task(%Demo_ScaleDOWN).freq = 32! * Slider(slnr-1).value / 128! IF Task(%Demo_ScaleDOWN).freq < 0.5 THEN Task(%Demo_ScaleDOWN).freq = 0.5 END SUB SUB Reich1 () EXPORT ' Steve Reich piano phase - piano 1 part STATIC i AS DWORD STATIC toets AS DWORD IF ISFALSE Task(%Demo_Reich1).tog THEN i = %False Task(%Demo_Reich1).tog= %True toets = %True ' steve reich: piano phase notes are in the global array Melody() END IF ' in de volgende kode, wordt de variabele toets% bij elke oproep van de taak ' omgeschakeld tussen de waarden %False (0) en %NotFalse (-1). Daardoor wordt ' de melodie met gelijke notenwaarden gespeeld. ' Om ongelijke notenwaarden te verkrijgen kunnen we bvb. bij elke oproep van de taak ' de oproepfrekwentie van die taak wijzigen. ' bvb.: Task(%Demo_Reich1).freq = Task(%Demo_Reich1).freq / 2 alternerend met ' Task(%Demo_Reich1).freq = Task(%Demo_Reich1).freq * 2 IF toets THEN mPlay Task(%Demo_Reich1).channel, Melody(i), Slider(0).value toets = %False AddNote2Har Task(%Demo_Reich1).Har,Melody(i), Slider(0).value ELSE NoteOff Task(%Demo_Reich1).channel, Melody(i) toets = %True Task(%Demo_Reich1).Har.vel = STRING$(128, 0) INCR i IF i > UBOUND(Melody) THEN i = %False END IF END SUB SUB Reich2 () EXPORT ' Steve Reich piano phase - piano 2 part STATIC i AS DWORD STATIC toets AS DWORD IF ISFALSE Task(%Demo_Reich2).tog THEN i = %False Task(%Demo_Reich2).tog= %True toets = %True END IF IF toets THEN mPlay Task(%Demo_Reich2).channel, Melody(i), Slider(0).value toets = %False AddNote2Har Task(%Demo_Reich2).Har,Melody(i), Slider(0).value ELSE NoteOff Task(%Demo_Reich2).channel, Melody(i) toets = %True Task(%Demo_Reich2).Har.vel = STRING$(128, 0) INCR i IF i > UBOUND(Melody) THEN i = %False END IF END SUB SUB Listen2Player () EXPORT LOCAL nv%, noot?, velo? , tasknr% ' This task does not do any music generation in itself. It links the real time input from a performer ' via midi-in and writes this midi input into the delayline. ' code for real time midi input - this reads and removes the notes from the midi-input buffer: nv% = GetMidiNote% (Flute.channel, %Remove OR %Oldest) IF nv% = %NotFalse THEN EXIT SUB ' if no note came in, exit the task ELSE velo? = LOBYT (nv%) noot? = HIBYT (nv%) ' write it into the delayline: (dll-procedure) WriteDelayLine noot?, velo? END IF ' for testing: ' mPlay Flute.channel, noot?, velo? END SUB SUB DelayPlayerF () EXPORT ' this taskprocedure demonstrates how to build a delay-line for ' midi input. This task plays at twice original speed. LOCAL nv%, noot?, velo? IF ISFALSE Task(%Demo_delayFast).tog THEN Task(%Demo_delayFast).tog = %True END IF nv% = ReadDelayLine%(%Demo_delayFast, 10000, 1.5!) ' instance 1 of a delaylinereader ' 10 second delay = 10000 milliseconds ' > 1 speed-up ' < 1 slow down - debugged o.k. SELECT CASE nv% CASE %False, %NotFalse: EXIT SUB ' if no note came in, exit the task CASE -2 ' read past present. ' This can only happen if speed! > 1! Task(%Demo_delayFast).Har.vel = STRING$(128,0) PlayHar Task(%Demo_delayFast).Har, Task(%Demo_delayFast).channel nv% = ReadDelayLine%(%Demo_delayFast, 0, 0) :' force a reset StopTask %Demo_delayFast EXIT SUB END SELECT velo? = LOBYT (nv%) noot? = HIBYT (nv%) ' lets implement full polyphonic playing: IF noot? >= Piperola.lowtes THEN IF velo? = %False THEN DelNote2Har Task(%Demo_delayFast).Har, (noot?) PlayHar Task(%Demo_delayFast).Har, Task(%Demo_delayFast).channel ELSE DelNote2Har Task(%Demo_DelayFast).Har, (noot?) PlayHar Task(%Demo_delayFast).Har, Task(%Demo_delayFast).channel AddNote2Har Task(%Demo_delayFast).Har, (noot?), (velo?) PlayHar Task(%Demo_delayFast).Har , Task(%Demo_delayFast).channel END IF END IF END SUB SUB DelayPlayerN () ' this taskprocedure demonstrates how to build a delay-line for ' midi input. This one outputs at normal speed. LOCAL nv%, noot?, velo? IF (Task(%Demo_delayNormal).swit AND %TASK_BUSY) = %d1 THEN EXIT SUB nv% = ReadDelayLine%(%Demo_delayNormal, 3000, 1!) ' instance 2 of a delaylinereader ' 3 second delay ' > 1 speed-up ' < 1 slow down SELECT CASE nv% CASE %False: EXIT SUB CASE %NotFalse : EXIT SUB ' if no note came in, exit the task CASE -2 ' read past present. ' This can only happen if speed! > 1! nv% = ReadDelayLine%(%Demo_delayNormal, 0, 0) ' force a reset StopTask %Demo_delayNormal ' switch task off on error. EXIT SUB END SELECT velo? = LOBYT (nv%) noot? = HIBYT (nv%) ' lets implement full polyphonic playing: IF noot? >= Piperola.lowtes THEN IF velo? = %False THEN DelNote2Har Task(%Demo_delayNormal).Har, (noot?) PlayHar Task(%Demo_delayNormal).Har, Task(%Demo_delayNormal).channel ELSE DelNote2Har Task(%Demo_delayNormal).Har, (noot) PlayHar Task(%Demo_delayNormal).Har, Task(%Demo_delayNormal).channel AddNote2Har Task(%Demo_delayNormal).Har, (noot?), (velo?) PlayHar Task(%Demo_delayNormal).Har , Task(%Demo_delayNormal).channel END IF END IF END SUB SUB DelayPlayerS () ' this taskprocedure demonstrates how to build a delay-line for ' midi input. This code plays back at half speed, so it never ends. LOCAL nv%, noot?, velo? IF (Task(%Demo_delaySlow).swit AND %TASK_BUSY) = %d1 THEN EXIT SUB nv% = ReadDelayLine%(%Demo_delayslow, 250, 0.5!) ' instance 3 of a delaylinereader ' 0.25 second delay ' < 1 slow down - debugged o.k. IF nv% <= %False THEN EXIT SUB velo? = LOBYT (nv%) noot? = HIBYT (nv%) IF noot? >= Piperola.lowtes THEN IF velo? = %False THEN DelNote2Har Task(%Demo_delayslow).Har, (noot?) PlayHar Task(%Demo_delayslow).Har, Task(%Demo_delayslow).channel ELSE DelNote2Har Task(%Demo_delayslow).Har, (noot?) PlayHar Task(%Demo_delayslow).Har, Task(%Demo_delayslow).channel AddNote2Har Task(%Demo_delaySlow).Har, (noot?), (velo?) PlayHar Task(%Demo_delaySlow).Har , Task(%Demo_delaySlow).channel END IF END IF END SUB SUB DelayPlayerBackN () ' this taskprocedure demonstrates how to build a delay-line for ' midi input. This code plays back, backwards. LOCAL nv%, noot?, velo? nv% = ReadDelayLine%(%Demo_delayBackWards, 6000, -1!) ' instance 4 of a delaylinereader ' 6 second delay ' > 1 speed-up ' < 1 slow down ' negative = backwards playing SELECT CASE nv% CASE %False,%NotFalse, -2: EXIT SUB CASE -3 ' read past delay in backwardsmode ' we can force a reset: nv% = ReadDelayLine%(%Demo_delayBackWards,0,0) Task(%Demo_delayBackWards).Har.vel= STRING$(128,0) PlayHar Task(%Demo_delayBackWards).Har, Task(%Demo_delayBackWards).channel ' we could of course also switch the task off... StopTask %Demo_delayBackWards END SELECT velo? = LOBYT (nv%) noot? = HIBYT (nv%) IF noot? >=Piperola.lowtes THEN IF velo? = %False THEN DelNote2Har Task(%Demo_delayBackWards).Har, (noot?) PlayHar Task(%Demo_delayBackWards).Har, Task(%Demo_delayBackWards).channel ELSE DelNote2Har Task(%Demo_delayBackWards).Har, (noot?) PlayHar Task(%Demo_delayBackWards).Har, Task(%Demo_delayBackWards).channel AddNote2Har Task(%Demo_delayBackWards).Har, (noot?), (velo?) PlayHar Task(%Demo_delayBackWards).Har , Task(%Demo_delayBackWards).channel END IF END IF END SUB SUB ImitateVarDuur () ' bedoeling: de door de speler gespeelde noot staccato naspelen. ' needs a handle for nv% and for the duration of the notes played. ' duration is now fixed as 50ms STATIC nootisaan?, oldnote?, starttijd& LOCAL nv%, velo?, noot? ' code for real time midi input - this removes the notes from the buffer nv% = GetMidiNote% (Flute.channel, %Remove OR %Oldest) IF nv% = %NotFalse THEN IF nootisaan?= %False THEN EXIT SUB ' if no note came in, exit the task ELSE ' indien de gespeelde noot reeds 50ms aan was, schakel ze dan uit. IF timeGetTime - starttijd& > 50 THEN mPlay Task(%Demo_imit).channel, oldnote?, %False nootisaan? = %False EXIT SUB END IF END IF END IF velo? = LOBYT(nv%) noot? = HIBYT(nv%) IF nootisaan? = %False THEN IF velo? > 0 THEN mPlay Task(%Demo_imit).channel, noot?, 127 nootisaan? = %True oldnote? = noot? starttijd& = timeGetTime ' Call Win32Api END IF ELSE IF timeGetTime - starttijd& > 50 THEN mPlay Task(%Demo_imit).channel, noot?, %False nootisaan? = %False END IF END IF END SUB FUNCTION RecordSeqFile () AS LONG 'this task reads midi note input for its channel and updates its task().har accordingly 'as we set the task().flag to %SCORETASK, the dll task WriteSeqScore (App.WriteSeqScoreTaskNr) 'will record changes in the task().har field to a seq file 'if we want to record on different channels simultaneously, we need several similar tasks LOCAL nv AS INTEGER LOCAL noot? LOCAL velo? STATIC init AS LONG IF ISFALSE init THEN init = %true App.SeqFileOut = "foo.seq" 'set the name of the seqfile to write. note that we should not set App.SeqeOutFileNr manually! StartTask App.WriteSeqScoreTaskNr 'start dll task END IF nv = getMidiNote(task(%DEMO_RECORDSEQ).channel, %Remove OR %Oldest) velo? = LOBYT (nv) noot? = HIBYT (nv) IF nv > %NOTfalse THEN CONTROL SET TEXT gh.Cockpit, %GMT_TEXT0_ID + 10, STR$(noot) + " " + STR$(velo) IF velo? THEN AddNote2Har task(%DEMO_RECORDSEQ).Har, noot?, velo? ELSE DelNote2Har task(%DEMO_RECORDSEQ).Har, noot? END IF END IF END FUNCTION FUNCTION PlaySeqFile () AS LONG 'button callback function STATIC pSeq AS SequencerType PTR IF ISFALSE (task(App.ReadSeqScoreTaskNr).swit AND %TASK_BUSY) THEN 'start the task App.SeqFileIn = "foo.seq" IF ISFALSE pSeq THEN pSeq = ExportSeqPtr 'get the pointer from the seq.type from the dll @pSeq.flags = &H0001 'we read only first track. every bit in the flags represents a track, 'so for two tracks flags would be &H0003, for three &H0007 etc. @pSeq.map(0) = 0 'info on this track will be mapped to channel 1 @pSeq.speedfactor = 1 'mPlay at normal speed. < 1 would be slower, > 1 faster StartTask App.ReadSeqScoreTaskNr ELSE 'stop the task StopTask App.readSeqScoreTaskNr END IF END FUNCTION SUB Demo_UDP_Send () ' test for midi output via UDP/ID STATIC i AS DWORD STATIC toets AS DWORD STATIC slnr AS BYTE LOCAL velo AS BYTE IF ISFALSE Task(%Demo_UDP).tog THEN Task(%Demo_UDP).tog = %True toets = %True DIM TaskParamLabels(0 TO 1) AS ASCIIZ * 8 TaskParamLabels(0) = "Tempo" TaskParamLabels(1) = "Level" IF ISFALSE Task(%Demo_UDP).hParam THEN MakeTaskParameterDialog %Demo_UDP,2,Slider(),0,UDctrl(),TaskParamLabels() END IF i = 35 END IF IF slnr = %False THEN slnr = TaskEX(%Demo_UDP).SliderNumbers(1) END IF IF toets THEN velo = Slider(slnr).value mPlay Task(%Demo_UDP).channel, Gray (i), velo toets = %False ELSE mPlay Task(%Demo_UDP).channel, Gray (i), %False toets = %True INCR i IF i > 96 THEN i = 36 END IF Task(%Demo_UDP).freq = 8! * (Slider(slnr-1).value) / 128! IF Task(%Demo_UDP).freq < 0.05 THEN Task(%Demo_UDP).freq = 0.05 END SUB SUB Testtimer(OPT BYVAL stopflag AS DWORD) 'oneshot 'results: with repeats 500 en 450, the callback is often 1 to 2 ms too late, but the two timers get in sync - when the notes are supposed together, they are on the same ms (According to timegettime) 'same for other ratio's on first sight.. 'sometimes there's no jitter at all (500ms) 'but when we combine a period of 500 ms with one of 50, the 500 has the right amout of delay to sink with the 50 'also with multiple timers in simple ratio's they kkeep in sync 'multiple timers with unrelated periods have more jitter. also here the slowest ones have the biggest delays STATIC ev() AS timedevent STATIC hQueue AS DWORD LOCAL i AS DWORD LOCAL retval AS DWORD IF stopflag THEN DeleteTimerQueueEx (ev(0).hQueue, 0) 'this way we don't have to bother about killing individual timers.. Progchange 1, 0 EXIT SUB END IF IF ISFALSE task(%testtimer).tog THEN 'launch timer. the task itself only monitors.. DIM ev(4) FOR i = LBOUND(ev) TO UBOUND(ev) ev(i).time = 1000 ev(i).repeat = (i + 1) * 20 + 7 ev(i).param1 = i * 2 ev(i).cptr = CODEPTR(testtimercb) QScheduleEvent ev(i) NEXT ' ev(0).time = 1000 ' ev(0).repeat = 533 ' ev(0).param1 = 1 ' ev(0).cptr = CODEPTR(testtimercb) ' ev(1).time = 1000 ' ev(1).repeat = 533 ' ev(1).param1 = 7 ' ev(1).cptr = CODEPTR(testtimercb) ' QScheduleEvent ev(0) ' QScheduleEvent ev(1) task(%testtimer).tog = 1 END IF END SUB SUB TestTimer_Stop TestTimer 1 END SUB SUB testtimercb(BYVAL evnt AS DWORD) '-> here we get the codepointer of this function in stead of the varptr of the event.. maybe because this cptr is the first field in the timedevent type? LOCAL ev AS timedevent PTR ' logfile FUNCNAME$ + STR$(evnt) ev = evnt logfile "t::" + STR$(timegettime) +STR$(@ev.param1) ' mPlay Vibi.channel, Vibi.LowTes + @ev.param1, 60 ' mPlay 1, 84 + @ev.param1, 60 END SUB SUB PlayDurTest 'normal playdur works well now 'playhardur works, but we gget a crash when we have fast repeat and long chords.. although the task keeps working while the error mesage appears and only stops when gmt gets closed after clicking ok -> so it's not a matter of lack of timers.. LOCAL lh AS HarmType LOCAL i AS LONG IF ISFALSE Task(%testplaydur).tog THEN Task(%testplaydur).tog = %True DIM TaskParamLabels(0 TO 1) AS ASCIIZ * 8 TaskParamLabels(0) = "Tempo" TaskParamLabels(1) = "NoteDur" IF ISFALSE Task(%testplaydur).hParam THEN MakeTaskParameterDialog %testplaydur,2,Slider(),0,UDctrl(),TaskParamLabels() END IF SendMessage Slider(TaskEX(%testplaydur).SliderNumbers(0)).h, %TBM_SETPOS, %true, 20 Slider(TaskEX(%testplaydur).SliderNumbers(0)).value = 20 END IF ' PlayDur(0, 60 + RND * 24, 100, 20 + 5 * Slider(TaskEX(%testplaydur).SliderNumbers(1)).value ) FOR i = 0 TO 3 AddNote2Har lh,60 + RND * 36, 100 NEXT PlayHarDur 0, lh, 20 + 5 * Slider(TaskEX(%testplaydur).SliderNumbers(1)).value Task(%testplaydur).freq = 1 + SQR(Slider(TaskEX(%testplaydur).SliderNumbers(0)).value ) END SUB SUB TestGliss 'om de 4'' STATIC cc AS DWORD LOCAL van AS CURRENCY, tot AS CURRENCY, duur AS LONG INCR cc IF ISFALSE task(%demo_gliss).tog THEN MM_AutoSax_On Controller So.channel, 7, 30 Controller So.channel, 13, 4 Controller Heli.channel, 17, 60 Controller ob.channel, 17, 40 Controller korn.channel, 17, 40 Controller Korn.channel, 25, 0 'solenoid force to minimum.. 'with 1 or 0 the solenoids still work.. Controller Autosax.channel, 17, 60 Controller Bono.channel, 17, 50 Controller Fa.channel, 17, 100 Controller Autosax.channel, 65, 0 'moet de solenoids afzetten.. Bono.lowtes = 24 MM_QT_ON %MM_Wind OR %MM_Motor END IF ' cc = 0 SELECT CASE cc MOD 10 CASE 0 van = Ob.Lowtes + RND * 36: tot = Ob.LowTes + RND * 36: duur = 1000 + RND * 10900 Gliss VARPTR(Ob), van, tot, duur, 127,0,1 CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "ob" + STR$(van) + STR$(tot) + STR$(duur) CASE 1 van = So.Lowtes + RND * 24: tot = So.LowTes + RND * 24: duur = 1000 + RND * 10900 Gliss VARPTR(So), van, tot, duur, 127,0,1 CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "so" + STR$(van) + STR$(tot) + STR$(duur) CASE 2 van = heli.Lowtes + RND * 36: tot = heli.LowTes + RND * 36: duur = 1000 + RND * 10900 Gliss VARPTR(Heli), van, tot, duur, 127 ,0,1 CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "heli" + STR$(van) + STR$(tot) + STR$(duur) CASE 3 van = korn.Lowtes + RND * 36: tot = korn.LowTes + RND * 36: duur = 1000 + RND * 10900 Gliss VARPTR(korn), van, tot, duur, 127,0,1 CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "korn" + STR$(van) + STR$(tot) + STR$(duur) CASE 4 van = autosax.lowtes + RND * 36: tot = autosax.lowtes + RND * 36: duur = 1000 + RND * 10900 Gliss VARPTR(autosax), van, tot, duur, 127,0,1 CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "autosax" + STR$(van) + STR$(tot) + STR$(duur) CASE 5 van = bono.lowtes + RND * 36: tot = bono.lowtes + RND * 36: duur = 1000 + RND * 10900 Gliss VARPTR(bono), van, tot, duur, 127,0,1 CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "bono" + STR$(van) + STR$(tot) + STR$(duur) CASE 6 van = fa.lowtes + RND * 36: tot = fa.lowtes + RND * 36: duur = 1000 + RND * 10900 Gliss VARPTR(fa), van, tot, duur, 127 ,0,1 CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "fa" + STR$(van) + STR$(tot) + STR$(duur) CASE 7 van = qt.lowtes + RND * 36: tot = qt.lowtes + RND * 60: duur = 1000 + RND * 10900 Gliss VARPTR(qt), van, tot, duur, 127 ,0,1 CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "qt" + STR$(van) + STR$(tot) + STR$(duur) CASE 8 van = piano.lowtes + RND * 36: tot = piano.lowtes + RND * 60: duur = 1000 + RND * 10900 Gliss VARPTR(piano), van, tot, duur, 127 ,0,1 CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "piano" + STR$(van) + STR$(tot) + STR$(duur) CASE 9 van = 72 + RND * 36: tot = 72 + RND * 60: duur = 1000 + RND * 10900 Gliss VARPTR(tubi), van, tot, duur, 127 ,0,1 CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "tubi" + STR$(van) + STR$(tot) + STR$(duur) END SELECT END SUB SUB testqInstrumPlay 'test for the newly added monophonic windinstruments (13.01.2012) STATIC cc AS DWORD STATIC m AS musician STATIC note AS BYTE IF ISFALSE note THEN note = 48 m = so END IF note = note + .5 IF note > 84 THEN note = 48 QInstrumPlay m 'note off SELECT CASE cc MOD 7 CASE 0: m = so CASE 1: m = heli CASE 2: m = bono CASE 3: m = fa CASE 4: m = autosax CASE 5: m = korn CASE 6: m = ob END SELECT AddNote2QHar m.Qhar(1), note, 40 QInstrumPlay M END SUB SUB PlayOldFugaFormat 'ín the works 'based on fuga3.mid: only two type of lines, one a midi message (as coma separated integers), one just a single integer for nr of ticks till the next command 'seems to work taking everyting literealy - expecting monophonic voices.. we better add some more advanced voice management for non-monophonic instruments STATIC busy AS DWORD STATIC fn AS STRING STATIC f AS DWORD STATIC waitcount AS DWORD STATIC lastnote() AS BYTE LOCAL b$ LOCAL c AS BYTE,n AS BYTE, v AS BYTE IF waitcount THEN ' logfile "waiting "+ str$(waitcount) DECR waitcount EXIT SUB END IF ' logfile "ënter" IF busy THEN ' logfile "busy!" EXIT SUB END IF busy = 1 IF ISFALSE LEN(fn) THEN ' logfile "init lastnote array" DIM lastnote(15) 'limited to 16 channels - should be fine for old fuga files fn = MidiPlayer_Fileopenname 'here the fact that they wrongly have a .mid extension comes in handy.. ' warning "Playing "+ fn f = FREEFILE OPEN fn FOR INPUT ACCESS READ LOCK WRITE AS f IF ERR THEN MSGBOX "Error opening file:" + STR$(ERRCLEAR),, FUNCNAME$ busy = 0 Stoptask %Demo_readfuga EXIT SUB END IF END IF ' logfile STR$(lastnote(0)) + STR$(lastnote(1)) + STR$(lastnote(2)) + STR$(lastnote(3)) + STR$(lastnote(4)) 'now read and play.. Readchunk: IF EOF(f) THEN MSGBOX "Finished:" ,,FUNCNAME$ StopTask %Demo_readfuga busy = 0 EXIT SUB END IF LINE INPUT #f, b$ ' warning "parse " + b$ SELECT CASE PARSECOUNT(b$, ",") CASE 0 'shouldn't happen.. GOTO Readchunk CASE 1 Waitcount = VAL(b$) - 1 ' logfile "wait "+ STR$(waitcount) CASE 3 c = VAL(PARSE$(b$, ",", 1)) - 144 n = VAL(PARSE$(b$, ",", 2)) v = VAL(PARSE$(B$, ",", 3)) IF (v > 0) THEN IF (lastnote(c) > 0) THEN mPlay c, lastnote(c), 0 ' logfile STR$(c) + STR$(n) + "0" END IF lastnote(c) = n ELSE lastnote(c) = 0 END IF ' logfile STR$(c) + STR$(n) + STR$(v) mPlay c, n, v ' logfile "ďmmediate next" GOTO ReadChunk 'ánother note may be following,innediately read next line" CASE ELSE MSGBOX "Unexpected string:" + b$ StopTask %Demo_readfuga busy = 0 EXIT SUB END SELECT busy = 0 END SUB '[EOF]