'************************************************** '* g_file.bas * '* compiles to library g_file.dll * '* Version 11.11 * '************************************************** ' 22.11.2001: split off from g_hgen: procedures for file I/O ' We compile this to a separate dll ' Should contain only time uncritical file I/O procedures used in ' 12.02.2002: WriteDaqParams procedure added (from g_nih.dll) ' 14.08.2002: file selection procs. added by kl. ' 20.11.2002: support for pitch to midi devices added. gwr ' 23.11.2002: support for networking added. ' 14.12.2002: ports for UDP added. ' 29.09.2003: Getrobotports rechecked. ' 10.10.2003: read functions adapted to removal of MTspeed and Time tasks. ' 18.02.2004: entries voor Trump en Puff checked. ' 12.04.2004: adapted to hardware midification of Troms ' 11.07.2004: entries for Hurdy checked. ' 17.07.2004: trump rechecked. Ake added. ' 04.11.2004: tema file reader added. ' 12.12.2004: Llor added. ' 21.01.2005: config R/W procs. added. ' 23.01.2005: Tubi implementation changed. ' 31.01.2005: Dripper added. ' 10.02.2005: Piperola support updated. ' 05.03.2005: upgraded to PBWIN 8.00 ' 17.04.2005: Vacca added. Sire checked. ' 24.04.2005: %IDM_CASTA en %IDM_VITELLO added - support added in GetInstrum... ' 12.07.2005: Harma unnder reconstruction. Conditional compilation for old/new versions. ' 18.12.2005: Harma conditionals removed. ' 09.01.2006: Krum added. ' 10.02.2006: Psch added ' 10.04.2006: Snar added ' 15.04.2006: Vitello added ' 02.05.2006: new autosax added. ' 08.08.2006: Qt added and checked. ' 31.08.2006: Klung, Springers, Belly now also midi-robots ' 07.09.2006: Thunderwood extended with new features ' 03.10.2006: path info added to app structure ' 01.01.2007: Bako added ' 19.03.2007: Xy added, qt quartertones added, aeio added. ' 10.07.2007: Simba added ' 19.08.2007: Bono added ' 09.10.2007: HY1 support cfg added. ' 27.10.2007: AXE3 support cfg added. ' 17.11.2007: PIR2 support cfg added. ' 10.06.2008 ReadVoiceFromMidifile added ' 08.08.2008: Toypi added. ' 31.08.2008: adapted to PB compiler 9.0 " variable names com$ and events had to be adapted. (gwr) ' 08.10.2008: Ob added. ' 03.02.2009: ReadPijFile added. ' 11.07.2010: Bomi added ' 30.03.2011: PB10 upgrade ' 16.01.2012: Synchrochord added ' 02.09.2012: Klar added ' 09.09.2012: updated for Klar ' 18.02.2013: updated for temblo ' 29.03.2013: updated for Horny and Asa ' 01.07.2013: Horny range changed. ' 12.01.2014: Rodo added ' 01.07.2014: Rumo added ' 07.07.2014: Zi added ' 08.02.2015: HybrHi added ' 28.08.2015: Tinti added ' 16.03.2016: Chi added ' 04.04.2016: Frequency lookup function added for Chi ' 05.04.2016: Frequency functions also added for Tinti ' 01.09.2016: HybrLo support added. ' 30.11.2016: Bug robot support added. ' 04.02.2017: Melauton added. ' 20.02.2017: Pi added. ' 27.04.2018: Pos added ' 06.09.2018: 2Pi added ' 08.12.2018: Balsi added ' 20.09.2019: Tubo added ' 17.01.2020: Flut added ' 14.02.2020: So parameters changed for version 3 ' 30.12.2020: Rumo - added ' 03.02.2021: added ' 17.06.2021: added ' 12.07.2021: instrum.params changed in tune with PIC changes. ' 01.01.2022: added #COMPILER PBWIN 10 #COMPILE DLL "g_file.dll" #OPTION VERSION5 ' 4 '5 ' compile not for W98 & Me , but Windows2000 and/or NT5 #DEBUG ERROR ON #DEBUG DISPLAY ON 'ON #TOOLS ON #REGISTER ALL #DIM ALL #INCLUDE ONCE "..\winapi\g_win.inc" ' reduced version - compiles o.k. with 8.00 #INCLUDE ONCE "g_kons.bi" ' integer and string constants #INCLUDE ONCE "g_type.bi" ' structures, user defined types #INCLUDE ONCE "g_mm.bi" ' MM robot constants. #INCLUDE ONCE "g_indep.bi" %g_file_inc = %True #INCLUDE ONCE "g_file.bi" ' declarations GLOBAL hInst AS LONG ' instance handle of this dll GLOBAL pgh AS GMT_HANDLES PTR ' handles to gmt windows created in GMT GLOBAL pTask() AS Taak PTR ' pointers to the global Task() structures in GMT. ' 21.03.2000 GLOBAL pTaskEX() AS ExtraInfo PTR ' pointers to TaskEX() structures ' 24.04.2000 GLOBAL pApp AS ApplicationType PTR ' pointer to App structure in GMT ' 20.04.2000 GLOBAL listboxchoice AS LONG ' 14.08.2002 GLOBAL midifilename AS STRING ' for filenames from window callback to MidiPlayer_Getfilename (pointers failed for this purpose) ' procedure and function declarations for not exported procs and functions only : DECLARE FUNCTION MidiEquipSelector (BYREF Meq() AS MidiEquipment) AS DWORD ' 12.06.2002 DECLARE CALLBACK FUNCTION MGDlgCallback () AS LONG ' 12.06.2002 DECLARE CALLBACK FUNCTION MEDlgCallback () AS LONG ' 12.06.2002 'helper procs for MidiPlayerFileopenname, FindMMFiles etc- not exported DECLARE CALLBACK FUNCTION CBFindMMFiles DECLARE FUNCTION CloseFindMMFiles AS LONG DECLARE CALLBACK FUNCTION CBMidiPlayer_GetFilename '---------------------------------------------------------------------------------------- FUNCTION LIBMAIN(BYVAL h AS LONG, _ BYVAL fwdReason AS LONG, _ BYVAL lpvReserved AS LONG) AS LONG LIBMAIN = %True SELECT CASE fwdReason CASE %DLL_PROCESS_ATTACH DIM pTask(%NumberOfTasks -1) AS GLOBAL Taak PTR DIM pTaskEX(%NumberOfTasks -1) AS GLOBAL ExtraInfo PTR hInst = h CASE %DLL_PROCESS_DETACH,%DLL_THREAD_ATTACH, %DLL_THREAD_DETACH EXIT FUNCTION CASE ELSE LIBMAIN = %False END SELECT END FUNCTION FUNCTION InitFileIOdll (BYREF T() AS Taak, BYREF Tex()AS ExtraInfo, BYREF g AS GMT_HANDLES, BYREF A AS ApplicationType) EXPORT AS DWORD ' publishes pointers from gmt to g_file.dll ' called in GMT: GMT_Initialize LOCAL i AS DWORD pApp = VARPTR(A) pgh = VARPTR(g) FOR i = 0 TO UBOUND(pTask) pTask(i) = VARPTR(T(i)) pTaskEX(i) = VARPTR(Tex(i)) T(i).pX = VARPTR(Tex(i)) NEXT i ' now we have access to the complete Task() structure residing in GMT memory! '@pgh.file = hInst ' pass the instance handle to GMT - not needed, done on initialisation of gmt.exe. ' using GetmoduleHandle ("g_file.dll") FUNCTION = %True END FUNCTION FUNCTION ReadKeyFromFile (f AS STRING, keyword AS STRING) EXPORT AS WORD ' returns the numeric value after a passed keyword. ' The file should use comma delimited fields. (csv) LOCAL nr AS LONG LOCAL retval AS WORD LOCAL dum$ FUNCTION = %False IF ISFALSE Existfile (f) THEN EXIT FUNCTION nr = FREEFILE keyword = TRIM$(UCASE$(keyword)) OPEN f FOR INPUT LOCK SHARED AS #nr WHILE NOT EOF(nr) INPUT #nr, dum$ dum$ = TRIM$(UCASE$(dum$)) SELECT CASE dum$ CASE keyword INPUT #nr, retval FUNCTION = retval CLOSE #nr EXIT FUNCTION END SELECT WEND CLOSE #nr END FUNCTION FUNCTION ReadHurdyTuningFromFile (f AS STRING, Hurdy AS musician) EXPORT AS WORD 'updated kl 20070403 'reads values from infile and puts them in the according hurdy.ctrl() fields, but does not send out midi 'if we don't find valid data in the file or the file does not exist, we fall back to the defaults 'called from the Init_MM function ' MSGBOX f,,FUNCNAME$ 'msgbox during startup results in crash on win7! ' exit function LOCAL nr AS LONG LOCAL retval AS WORD LOCAL dum$ LOCAL keyword AS STRING FUNCTION = %False RESET Hurdy.ctrl(20) RESET Hurdy.ctrl(21) ' IF Existfile (f) THEN nr = FREEFILE keyword = "[HURDY_TUNING]" 'TRIM$(UCASE$(keyword)) OPEN f FOR INPUT ACCESS READ LOCK SHARED AS #nr IF ERRCLEAR THEN MSGBOX "Couldn't open "+ f,,FUNCNAME$ 'with debug display on we get an error here, but errclear doesnt show one.. weird EXIT FUNCTION END IF ' ' close nr ' exit function ' WHILE NOT EOF(nr) INPUT #nr, dum$ dum$ = TRIM$(UCASE$(dum$)) SELECT CASE dum$ CASE keyword INPUT #nr, Hurdy.ctrl(20) ' lowstring - bug : was 120 - killed gwr.30.10.2007 INPUT #nr, Hurdy.ctrl(21) ' highstring - bug: was 121 ' check valitity of data: IF (Hurdy.ctrl(20) < 14) OR (Hurdy.ctrl(20) > 60) THEN FUNCTION = %False IF (Hurdy.ctrl(21) < 14) OR (Hurdy.ctrl(21) > 96) THEN FUNCTION = %False FUNCTION = %True CLOSE #nr EXIT FUNCTION 'this one's crucial!! (at least on win7) END SELECT WEND CLOSE #nr ' END IF IF ISFALSE (Hurdy.ctrl(20) OR Hurdy.ctrl(21)) THEN Warning "No valid data found for Hurdy in " + TRIM$(f) Warning "Falling back to default values" Hurdy.ctrl(20) = 40 ' no transposition value Hurdy.ctrl(21) = 64 ' no transposition value END IF END FUNCTION FUNCTION ReadHY1ConfigFromFile (f AS STRING) EXPORT AS WORD 'added gwr 09.10.2007 'reads values from inifile LOCAL nr AS LONG LOCAL retval AS WORD LOCAL dum$ LOCAL keyword AS STRING LOCAL p$ LOCAL midiport AS WORD LOCAL inputchannel AS WORD FUNCTION = %False IF Existfile (f) THEN nr = FREEFILE keyword = "[HY1]" OPEN f FOR INPUT LOCK SHARED AS #nr WHILE NOT EOF(nr) INPUT #nr, dum$ dum$ = TRIM$(UCASE$(dum$)) SELECT CASE dum$ CASE keyword INPUT #nr, p$, midiport p$= TRIM$(UCASE$(p$)) IF p$ <> "[INPUT_PORT]" THEN Warning "HY1 key [INPUT_PORT] wrong in ini file" END IF p$ = TRIM$(UCASE$(p$)) INPUT #nr, p$, inputchannel IF p$ <> "[INPUT_CHANNEL]" THEN Warning "HY1 key [INPUT_CHANNEL] wrong in ini file" END IF FUNCTION = (midiport * 256) + inputchannel ' word CLOSE #nr EXIT 'this one was missing, causing a (harmless) error message when compiling with debugging tools on.. hanged by xof @ 20.05.2010 END SELECT WEND CLOSE #nr END IF END FUNCTION FUNCTION ReadAX3ConfigFromFile (f AS STRING) EXPORT AS WORD 'added gwr 27.10.2007 'reads values from inifile LOCAL nr AS LONG LOCAL retval AS WORD LOCAL dum$ LOCAL keyword AS STRING LOCAL p$ LOCAL midiport AS WORD LOCAL inputchannel AS WORD FUNCTION = %False IF Existfile (f) THEN nr = FREEFILE keyword = "[AXE3]" OPEN f FOR INPUT LOCK SHARED AS #nr WHILE NOT EOF(nr) INPUT #nr, dum$ dum$ = TRIM$(UCASE$(dum$)) SELECT CASE dum$ CASE keyword INPUT #nr, p$, midiport p$= TRIM$(UCASE$(p$)) IF p$ <> "[INPUT_PORT]" THEN Warning "AXE3 key [INPUT_PORT] wrong in ini file" END IF p$ = TRIM$(UCASE$(p$)) INPUT #nr, p$, inputchannel IF p$ <> "[INPUT_CHANNEL]" THEN Warning "AXE3 key [INPUT_CHANNEL] wrong in ini file" END IF FUNCTION = (midiport * 256) + inputchannel ' word CLOSE #nr END SELECT WEND CLOSE #nr END IF END FUNCTION FUNCTION ReadPIR2ConfigFromFile (f AS STRING) EXPORT AS WORD 'added gwr 17.11.2007 'reads values from inifile LOCAL nr AS LONG LOCAL retval AS WORD LOCAL dum$ LOCAL keyword AS STRING LOCAL p$ LOCAL midiport AS WORD LOCAL inputchannel AS WORD FUNCTION = %False IF Existfile (f) THEN nr = FREEFILE keyword = "[PIR2]" OPEN f FOR INPUT LOCK SHARED AS #nr WHILE NOT EOF(nr) INPUT #nr, dum$ dum$ = TRIM$(UCASE$(dum$)) SELECT CASE dum$ CASE keyword INPUT #nr, p$, midiport p$= TRIM$(UCASE$(p$)) IF p$ <> "[INPUT_PORT]" THEN Warning "PIR2 key [INPUT_PORT] wrong in ini file" END IF p$ = TRIM$(UCASE$(p$)) INPUT #nr, p$, inputchannel IF p$ <> "[INPUT_CHANNEL]" THEN Warning "PIR2 key [INPUT_CHANNEL] wrong in ini file" END IF FUNCTION = (midiport * 256) + inputchannel ' word CLOSE #nr END SELECT WEND CLOSE #nr END IF END FUNCTION FUNCTION ReadHandyConfigFromFile (f AS STRING) EXPORT AS WORD 'added gwr 30.12.2007 'reads values from inifile LOCAL nr AS LONG LOCAL retval AS WORD LOCAL dum$ LOCAL keyword AS STRING LOCAL p$ LOCAL midiport AS WORD LOCAL inputchannel AS WORD MSGBOX f,,FUNCNAME$ FUNCTION = %False IF Existfile (f) THEN nr = FREEFILE keyword = "[HANDY]" OPEN f FOR INPUT LOCK SHARED AS #nr WHILE NOT EOF(nr) INPUT #nr, dum$ dum$ = TRIM$(UCASE$(dum$)) SELECT CASE dum$ CASE keyword INPUT #nr, p$, midiport p$= TRIM$(UCASE$(p$)) IF p$ <> "[INPUT_PORT]" THEN Warning "Handy key [INPUT_PORT] wrong in ini file" END IF p$ = TRIM$(UCASE$(p$)) INPUT #nr, p$, inputchannel IF p$ <> "[INPUT_CHANNEL]" THEN Warning "Handy key [INPUT_CHANNEL] wrong in ini file" END IF FUNCTION = (midiport * 256) + inputchannel ' word CLOSE #nr END SELECT WEND CLOSE #nr END IF END FUNCTION FUNCTION ReadKompilfileFromFile (f AS STRING) EXPORT AS STRING LOCAL nr AS LONG LOCAL dum$ LOCAL keyword AS STRING LOCAL fnam AS STRING FUNCTION = "" IF ISFALSE Existfile (f) THEN EXIT FUNCTION nr = FREEFILE keyword = "[EXE_NAME]" OPEN f FOR INPUT LOCK SHARED AS #nr WHILE NOT EOF(nr) INPUT #nr, dum$ dum$ = TRIM$(UCASE$(dum$)) SELECT CASE dum$ CASE keyword INPUT #nr, fnam FUNCTION = TRIM$(fnam) CLOSE #nr EXIT FUNCTION END SELECT WEND CLOSE #nr END FUNCTION SUB SelectMidiEquipment (f AS STRING, BYREF Meq() AS MidiEquipment) EXPORT ' new 12.06.2002 - to be called after selection of a piece or application. LOCAL nr AS LONG LOCAL retval AS WORD LOCAL dum$ LOCAL dum2$ LOCAL keyword AS STRING LOCAL aantal AS WORD LOCAL MidiGearGroups() AS ASCIIZ * 15 LOCAL j AS WORD LOCAL i AS WORD LOCAL counter AS WORD LOCAL groupcount AS WORD IF ISFALSE Existfile (f) THEN EXIT SUB listboxchoice = %False nr = FREEFILE OPEN f FOR INPUT LOCK SHARED AS #nr DO INPUT #nr, dum$ dum$ = TRIM$(UCASE$(dum$)) SELECT CASE dum$ CASE $Midi_Start ' [MIDI] section found. keyword = "nrgroups" DO INPUT #nr, dum$ dum$= TRIM$(LCASE$(dum$)) dum$= LEFT$(dum$,8) IF dum$ = keyword THEN ' nrgroups found INPUT #nr, aantal ' value DIM MidiGearGroups (aantal -1) AS LOCAL ASCIIZ * 15 aantal = %False DO INPUT #nr, retval, dum$ MidiGearGroups(retval) = dum$ INCR aantal LOOP UNTIL aantal > UBOUND(MidiGearGroups) EXIT LOOP ' jump to groups_found END IF LOOP EXIT LOOP CASE $Midi_End Warning "Data file error in section [MIDI] in ", 10000 CLOSE #nr EXIT SUB CASE ELSE ITERATE DO ' niks - iterate loop END SELECT LOOP UNTIL EOF(nr) groups_found: groupcount = %False counter = %False keyword = "GROUP " + TRIM$(STR$(groupcount)) DIM Mq(0) AS LOCAL MidiEquipment ' local array - redim preserve the passed one does not work DO IF EOF(nr) THEN Warning "EOF reached before start - [SelectMidiEquipment] in ", 10000 EXIT SUB END IF LINE INPUT #nr, dum$ dum$ = TRIM$(UCASE$(dum$)) IF dum$ = UCASE$(keyword) THEN INPUT #nr, dum2$, aantal ' dum2$ must be nrdevs REDIM PRESERVE Mq(counter+ aantal-1) AS Midiequipment FOR i = 0 TO aantal -1 INPUT #nr, j, Mq(counter).naam, Mq(counter).inport, Mq(counter).outport, Mq(counter).ID IF j <> i THEN Warning "midi equipment count error in file", 10000 Mq(counter).group = MidiGearGroups(groupcount) INCR counter NEXT i INCR groupcount keyword = "GROUP " + TRIM$(STR$(groupcount)) IF groupcount > UBOUND(MidiGearGroups) THEN CLOSE #nr GOTO pass_array END IF ELSEIF dum$ = "[MIDI_END]" THEN Warning "Data file error in section [MIDI] in ", 10000 CLOSE #nr EXIT SUB END IF IF groupcount > UBOUND(MidiGearGroups) THEN EXIT LOOP LOOP UNTIL EOF(nr) CLOSE #nr pass_array: ' preserve selections that have already been made: i = %False DO IF ISFALSE Meq(i).reserved THEN nr = i EXIT LOOP END IF INCR i IF i > UBOUND(Meq) THEN REDIM PRESERVE Meq(i) AS MidiEquipment END IF LOOP UNTIL i > counter - 1 ' note that we can select the same device many times!!! i = MidiEquipSelector (Mq()) IF ISFALSE nr THEN Meq(nr).reserved = 1 ' selection order ELSE Meq(nr).reserved = Meq(nr-1).reserved + 1 ' should be = nr + 1 END IF Meq(nr).group = Mq(i-1).group Meq(nr).naam = Mq(i-1).naam Meq(nr).inport = Mq(i-1).inport Meq(nr).outport = Mq(i-1).outport Meq(nr).ID = Mq(i-1).ID ' MSGBOX "keuze= " & STR$(i) & " " & Mq(i -1).group & " " & Mq(i-1).naam,,"" ' now we should update the pointer to Meq in g_lib.dll !!! ' if pgh.InstDll > %False then ' local p as dword ptr ' p = GetProcAddress(@pgh.InstDll,"UPDATE_MIDIEQUIPMENT") ' call dword p using Update_MidiEquipment (Meq()) ' i = Update_MidiEquipment(Meq()) ' end if END SUB SUB ReadMidiEquipmentChoices (f AS STRING, BYREF Meq() AS MidiEquipment) 'EXPORT ' used for preparation of dynamic menus in the setup. LOCAL nr AS LONG LOCAL retval AS WORD LOCAL dum$ LOCAL dum2$ LOCAL keyword AS STRING LOCAL aantal AS WORD LOCAL MidiGearGroups() AS ASCIIZ * 15 LOCAL j AS WORD LOCAL i AS WORD LOCAL counter AS WORD LOCAL groupcount AS WORD IF ISFALSE Existfile (f) THEN EXIT SUB nr = FREEFILE OPEN f FOR INPUT LOCK SHARED AS #nr DO INPUT #nr, dum$ dum$ = TRIM$(UCASE$(dum$)) SELECT CASE dum$ CASE $Midi_Start ' [MIDI] section found. keyword = "nrgroups" DO INPUT #nr, dum$ dum$= TRIM$(LCASE$(dum$)) dum$= LEFT$(dum$,8) IF dum$ = keyword THEN ' nrgroups found INPUT #nr, aantal ' value DIM MidiGearGroups (aantal -1) AS LOCAL ASCIIZ * 15 aantal = %False DO INPUT #nr, retval, dum$ MidiGearGroups(retval) = dum$ INCR aantal LOOP UNTIL aantal > UBOUND(MidiGearGroups) EXIT LOOP ' jump to groups_found END IF LOOP EXIT LOOP CASE $Midi_End Warning "Data file error in section [MIDI] @" + FUNCNAME$, 10000 CLOSE #nr EXIT SUB CASE ELSE ITERATE DO ' niks - iterate loop END SELECT LOOP UNTIL EOF(nr) groups_found: groupcount = %False counter = %False keyword = "GROUP " + TRIM$(STR$(groupcount)) DIM Mq(0) AS LOCAL MidiEquipment ' local array - redim preserve the passed one does not work DO IF EOF(nr) THEN Warning "EOF reached before start @" + FUNCNAME$, 10000 : EXIT SUB LINE INPUT #nr, dum$ dum$ = TRIM$(UCASE$(dum$)) IF dum$ = UCASE$(keyword) THEN INPUT #nr, dum2$, aantal ' dum2$ must be nrdevs 'MSGBOX dum2$ + STR$(aantal) REDIM PRESERVE Mq(counter+ aantal-1) AS Midiequipment ' not working with meq!!! FOR i = 0 TO aantal -1 INPUT #nr, j, Mq(counter).naam, Mq(counter).inport, Mq(counter).outport, Mq(counter).ID IF j <> i THEN Warning "File count error in " + FUNCNAME$, 10000 Mq(counter).msgid = %ID_MIDI_START + counter + 1 ' not required. Mq(counter).group = MidiGearGroups(groupcount) INCR counter NEXT i INCR groupcount keyword = "GROUP " + TRIM$(STR$(groupcount)) IF groupcount > UBOUND(MidiGearGroups) THEN CLOSE #nr GOTO pass_array END IF ELSEIF dum$ = "[MIDI_END]" THEN Warning "Data file error in section [MIDI] in " + FUNCNAME$, 10000 CLOSE #nr EXIT SUB END IF IF groupcount > UBOUND(MidiGearGroups) THEN EXIT LOOP LOOP UNTIL EOF(nr) CLOSE #nr pass_array: REDIM PRESERVE Meq(counter -1) AS Midiequipment FOR i = 0 TO UBOUND(Meq) Meq(i) = Mq(i) ' copies the whole structure! NEXT i ' note that in versions prior to 5.81 the pMeq() pointer structure gets set only in the display menuchoices procedure! ' (g_lib.dll) ' for test: 'i = MidiEquipSelector (Meq()) 'msgbox "keuze= " & STR$(i) & " " & Meq(i -1).group & " " & Meq(i-1).naam,,"g_file" END SUB SUB ReadMidiGroups (f AS STRING, BYREF MidiGearGroups() AS ASCIIZ * 15) 'EXPORT ' works o.k. tested 28.12.1999 - used for building menu ' changed 06.2002 - now uses listboxes and no longer the main setup menu LOCAL nr AS LONG LOCAL retval AS WORD LOCAL dum$ LOCAL keyword AS STRING LOCAL aantal AS WORD IF ISFALSE Existfile (f) THEN EXIT SUB nr = FREEFILE OPEN f FOR INPUT LOCK SHARED AS #nr WHILE NOT EOF(nr) INPUT #nr, dum$ dum$ = TRIM$(UCASE$(dum$)) SELECT CASE dum$ CASE $Midi_Start keyword = "nrgroups" DO INPUT #nr, dum$ dum$= TRIM$(LCASE$(dum$)) dum$= LEFT$(dum$,8) IF dum$ = keyword THEN INPUT #nr, aantal REDIM MidiGearGroups (aantal -1) AS ASCIIZ * 15 aantal = %False DO INPUT #nr, retval, dum$ MidiGearGroups(retval) = dum$ INCR aantal LOOP UNTIL aantal > UBOUND(MidiGearGroups) CLOSE #nr ' for test: 'aantal = MidiGroupSelector (Midigeargroups()) 'msgbox "keuze= " & STR$(aantal) & " " & Midigeargroups(aantal -1),,"g_file" EXIT SUB END IF LOOP CASE $Midi_End Warning "File error in ReadMidiGroups in " + FUNCNAME$, 10000 CLOSE #nr EXIT SUB END SELECT WEND CLOSE #nr END SUB FUNCTION MidiGroupSelector (BYREF items() AS ASCIIZ * 15) AS DWORD ' no longer required ' 12.06.2002 ' creates a listbox to let the user make a selection of a midigear category LOCAL i AS DWORD LOCAL grp () AS STRING LOCAL ID_MGDlg AS DWORD LOCAL hMGdlg AS LONG LOCAL cnt AS LONG Id_MGDlg= 100 DIM grp(UBOUND(items)) AS LOCAL STRING FOR i = 0 TO UBOUND(items) grp(i) = STR$(i+1) & " .- " & TRIM$(items(i)) NEXT i DIALOG NEW @pgh.setup, "midigear group selector",,,120,100,,TO hMGdlg CONTROL ADD LISTBOX, hMGDlg, id_MGDlg,grp(), 0, 0, 100, 40,,, CALL MGDlgCallback ' modal: cnt = %False DIALOG SHOW MODAL hMGdlg TO cnt ' note cnt cannot be a register variable DIALOG END hMGdlg FUNCTION = listboxchoice listboxchoice = %False END FUNCTION CALLBACK FUNCTION MGDlgCallback () AS LONG ' no export ' LOCAL lParam AS LONG ' LOCAL wParam AS LONG LOCAL TXT$ ' lParam = CBLPARAM ' wParam = CBWPARAM IF CBCTLMSG = %LBN_SELCHANGE THEN LISTBOX GET TEXT CBHNDL, 100 TO TXT$ DIALOG END CBHNDL listboxchoice = VAL(TXT$) FUNCTION = %True END IF END FUNCTION FUNCTION MidiEquipSelector (BYREF Meq() AS MidiEquipment) AS DWORD ' not needed ' 12.06.2002 ' creates a listbox to let the user make a selection of a midigear category LOCAL i AS DWORD LOCAL equip () AS STRING LOCAL ID_MEDlg AS DWORD LOCAL hMEdlg AS LONG LOCAL cnt AS LONG Id_MEDlg= 100 DIM equip(UBOUND(Meq)) AS LOCAL STRING FOR i = 0 TO UBOUND(Meq) equip(i) = STR$(i+1) & ".- " & TRIM$(Meq(i).group) & " " & TRIM$(Meq(i).naam) NEXT i DIALOG NEW @pgh.setup, "Choose Midi Equipment...",,,150,100,,TO hMEdlg CONTROL ADD LISTBOX, hMEDlg, id_MEDlg,equip(), 0, 0, 140, 90,,, CALL MEDlgCallback ' sorts idiotically... ' modal: cnt = %False DIALOG SHOW MODAL hMEdlg TO cnt ' note cnt cannot be a register variable DIALOG END hMEdlg FUNCTION = listboxchoice END FUNCTION CALLBACK FUNCTION MEDlgCallback () AS LONG ' no export LOCAL TXT$ IF CBCTLMSG = %LBN_SELCHANGE THEN LISTBOX GET TEXT CBHNDL, 100 TO TXT$ DIALOG END CBHNDL listboxchoice = VAL(TXT$) FUNCTION = %True END IF END FUNCTION FUNCTION ReadTaskDataFromFile (f AS STRING) EXPORT AS LONG ' audiofadertasks are enumerated in the Audio section. LOCAL nr AS LONG LOCAL aantal AS LONG LOCAL dum$ FUNCTION = %False IF ISFALSE Existfile (f)THEN EXIT FUNCTION nr = FREEFILE OPEN f FOR INPUT LOCK SHARED AS #nr ' first locate the start of the Task data block: DO INPUT #nr, dum$ dum$ = UCASE$(TRIM$(dum$)) IF dum$ = UCASE$($TSK_START) THEN EXIT LOOP IF EOF(nr) THEN CLOSE #nr Warning "No Task data block found in file " & f, 10000 EXIT FUNCTION END IF LOOP WHILE NOT EOF(nr) INPUT #nr, dum$ dum$ = UCASE$(TRIM$(dum$)) SELECT CASE dum$ CASE UCASE$($TSK_WRISEQ) '"WRITE_SEQUENCE_TASK_NUMBER" INPUT #nr, @pApp.WriteSeqScoreTaskNr CASE UCASE$($TSK_RDSEQ) '"READ_SEQUENCE_TASK_NUMBER" INPUT #nr, @pApp.ReadSeqScoreTaskNr CASE UCASE$($TSK_GLOBHAR) '"GLOBAL_HARMONY_TASK_NUMBER" INPUT #nr, @pApp.GlobalHarmonyTaskNr CASE UCASE$($TSK_SHOWHAR) '"SHOW_GLOBAL_HARMONY_TASK_NUMBER" INPUT #nr, @pApp.ShowGlobalHarmonyTaskNr ' CASE UCASE$($TSK_PROMIL) '"PROMIL_TASK_NUMBER" ' INPUT #nr, @pApp.PromilTaskNr ' CASE UCASE$($TSK_KRONO) '"RUNTIME_TASK_NUMBER" ' INPUT #nr, @pApp.MTSpeedTaskNr ' CASE UCASE$($TSK_MTSPEED) '"MT_SPEED_TASK_NUMBER" ' INPUT #nr, @pApp.RunTimeTaskNr ' CASE UCASE$($TSK_WAVPLY) '"WAVE_PLAY_TASK_NUMBER" ' INPUT# nr, @pApp.WavePlayTaskNr CASE UCASE$($TSK_DEBUG) '"DEBUG_TASK_NUMBER" INPUT #nr, @pApp.DebugTaskNr CASE UCASE$($TSK_END) CLOSE #nr FUNCTION = %True EXIT FUNCTION END SELECT WEND CLOSE #nr EXIT FUNCTION END FUNCTION FUNCTION ReadAppDataFromFile (f AS STRING) EXPORT AS LONG LOCAL nr AS LONG LOCAL aantal AS LONG LOCAL dum$ FUNCTION = %False IF ISFALSE existfile (f) THEN EXIT FUNCTION IF ISFALSE pApp THEN MSGBOX "No App pointer in g_file",%MB_ICONERROR,FUNCNAME$ EXIT FUNCTION END IF ReadTaskDataFromFile f ', App ReadCockpitControlDataFromFile f ', App nr = FREEFILE OPEN f FOR INPUT LOCK SHARED AS #nr ' first locate the start of the application data block: DO LINE INPUT #nr, dum$ dum$ = UCASE$(TRIM$(dum$)) IF dum$ = UCASE$($ApplicationData) THEN 'MSGBOX "Applicationdata found" EXIT LOOP END IF IF EOF(nr) THEN CLOSE #nr Warning "No Application data block found in file " & f,10000 EXIT FUNCTION END IF LOOP WHILE NOT EOF(nr) INPUT #nr, dum$ dum$ = UCASE$(TRIM$(dum$)) ' after each keyword we should have a comma in the file ' all variables used here, unless specified in the header, are and have to be global. SELECT CASE dum$ CASE UCASE$($ApDur) INPUT #nr, @pApp.komposduur ' may also appear in the patternrecognition file ' this is the default value. CASE UCASE$($ApTempo) INPUT #nr, @pApp.tempo ' may also appear in the patternrecognition file CASE UCASE$($ApGT) '"TONAL_CENTER","TOONCENTRUM" INPUT #nr, @pApp.globton ' may also appear in the patternrecognition file CASE UCASE$($ApSEQin) INPUT #nr, @pApp.SEQfileIn CASE UCASE$($ApSEQout) INPUT #nr, @pApp.SEQfileOut ' this belongs in a specific function: [ReadFlagDataFromFile... ?? CASE UCASE$($ApFlga) INPUT #nr, aantal IF aantal THEN @pApp.autoflags = @pApp.Autoflags OR %Autopatch CASE UCASE$($ApAudiofilePath) ' added 03.10.2006 INPUT #nr, @pApp.audiofilepath @pApp.audiofilepath = TRIM$( @pApp.audiofilepath) CASE UCASE$($ApMidifilePath) INPUT #nr, @pApp.midifilepath @pApp.midifilepath = TRIM$( @pApp.midifilepath) CASE UCASE$($ApDatafilePath) INPUT #nr, @pApp.datafilepath @pApp.datafilepath = TRIM$( @pApp.datafilepath) END SELECT WEND CLOSE #nr FUNCTION = %True END FUNCTION SUB ReadWaveFileListFromFile (f AS STRING, BYREF SampleList() AS ASCIIZ * 50) EXPORT ' if an application/composition makes use of prerecorded wav sounds on disk, the list of those files, ' if it appears in the configuration data file for the application, can be retrieved using this ' procedure. LOCAL aantal AS DWORD LOCAL i AS LONG LOCAL dum$ LOCAL nr AS LONG REDIM SampleList (0) RESET SampleList () SampleList(0) = "" f = TRIM$(f) nr = FREEFILE OPEN f FOR INPUT LOCK SHARED AS #nr WHILE NOT EOF(nr) INPUT #nr, dum$ dum$ = UCASE$(TRIM$(dum$)) ' after each keyword we should have a comma in the file SELECT CASE dum$ ' list of prerecorded wav files used in the program: CASE "NROFSAMPLEFILES","NR_OF_SAMPLEFILES","NROFSAMPLES" ' token INPUT #nr, aantal IF aantal > %False THEN REDIM SampleList (aantal -1) AS ASCIIZ * 50 ' global array FOR i = 0 TO aantal -1 INPUT #nr, dum$ 'SampleList(i) dum$= LTRIM$(RTRIM$(dum$)) dum$ = TRIM$(@pApp.Audiofilepath) & dum$ ' new 03.10.2006 IF UCASE$(RIGHT$(dum$,4)) <> ".WAV" THEN dum$ = dum$ & ".WAV" END IF ' here we also check for the actual existence of these files... IF ISFALSE ExistFile (dum$) THEN Warning dum$ & " file not found in specified directory... in " + FUNCNAME$, 10000 ELSE SampleList(i) = dum$ END IF NEXT i END IF END SELECT WEND CLOSE #nr END SUB SUB ReadPatternSequencesFromFile (f AS STRING, BYREF PatternSeq() AS PatternSequenceType) EXPORT '13.03.2000 LOCAL NrOfSequences AS LONG LOCAL Duurfout AS BYTE LOCAL Nootfout AS BYTE LOCAL Velofout AS BYTE LOCAL InputTempo AS INTEGER LOCAL SeqNr AS LONG LOCAL i AS LONG LOCAL dum$ LOCAL nr AS LONG f = TRIM$(f) nr = FREEFILE OPEN f FOR INPUT LOCK SHARED AS #nr WHILE NOT EOF(nr) INPUT #nr, dum$ dum$ = UCASE$(TRIM$(dum$)) ' after each keyword we should have a comma in the file SELECT CASE dum$ ' following items only appear in the recognition files: CASE "NROFSEQUENCES" INPUT #nr, NrOfSequences IF NrOfSequences > %False THEN REDIM PatternSeq(NrOfSequences - 1) AS PatternSequenceType ' cfr. gmt_type.bi file END IF CASE "INPUTTEMPO" INPUT #nr, InputTempo ' sets the default IF InputTempo = %False THEN InputTempo = 60 IF NrOfSequences > %False THEN FOR i = 0 TO NrOfSequences - 1 PatternSeq(i).Tempo = InputTempo NEXT i END IF CASE "DUURTOLERANCE" INPUT #nr, Duurfout IF NrOfSequences > %False THEN FOR i = 0 TO NrOfSequences - 1 PatternSeq(i).Duurfout = Duurfout NEXT i END IF CASE "NOOTTOLERANCE" INPUT #nr, Nootfout IF NrOfSequences > %False THEN FOR i = 0 TO NrOfSequences - 1 PatternSeq(i).Nootfout = Nootfout NEXT i END IF CASE "VELOTOLERANCE" INPUT #nr, Velofout IF NrOfSequences > %False THEN FOR i = 0 TO (NrOfSequences - 1) PatternSeq(i).Velofout = Velofout NEXT i END IF CASE "SEQNR" INPUT #nr, SeqNr ' must come before next entries! CASE "NRNOTES" INPUT #nr, PatternSeq(SeqNr-1).Lengte CASE "SEQTEMPO" INPUT #nr, PatternSeq(Seqnr-1).Tempo ' this overrides the global tempo CASE "SEQNOOTDATA" FOR i = 1 TO PatternSeq(SeqNr-1).Lengte INPUT #nr, PatternSeq(SeqNr-1).Noot(i-1) NEXT i CASE "SEQALTNOOTDATA" FOR i = 1 TO PatternSeq(SeqNr-1).Lengte INPUT #nr, PatternSeq(SeqNr-1).AltNoot(i-1) NEXT i CASE "SEQDUURDATA" FOR i = 1 TO PatternSeq(SeqNr-1).Lengte INPUT #nr, PatternSeq(SeqNr-1).Duur(i-1) NEXT i CASE "SEQVELODATA" FOR i = 1 TO PatternSeq(SeqNr-1).Lengte INPUT #nr, PatternSeq(SeqNr-1).Velo(i-1) NEXT i END SELECT WEND CLOSE #nr END SUB FUNCTION ReadAudioDataFromFile (f AS STRING, AudioFader() AS AudioFaderType) EXPORT AS LONG FUNCTION = %False IF ISFALSE ExistFile (f) THEN EXIT FUNCTION IF UBOUND(AudioFader) < 1 THEN EXIT FUNCTION FUNCTION = %False LOCAL nr AS LONG LOCAL dum$ nr = FREEFILE OPEN f FOR INPUT LOCK SHARED AS #nr ' locate the start of the data block: DO INPUT #nr, dum$ dum$ = TRIM$(UCASE$(dum$)) IF dum$ = UCASE$($Audio_Start) THEN EXIT LOOP IF EOF(nr) THEN CLOSE #nr Warning "No Audio data block found in file " & f & " in " + FUNCNAME$, 10000 EXIT FUNCTION END IF LOOP WHILE NOT EOF(nr) INPUT #nr, dum$ dum$ = TRIM$(UCASE$(dum$)) SELECT CASE dum$ CASE UCASE$($TSK_CD_FADER) '"AUDIO_PLAY_FADER_TASK_NUMBER" INPUT #nr, AudioFader(0).TaskNr CASE UCASE$($TSK_AX_FADER) '"AUDIO_AUX_FADER_TASK_NUMBER" INPUT #nr, AudioFader(1).TaskNr CASE UCASE$($CD_VOL_L) INPUT #nr, AudioFader(0).leftvolume CASE UCASE$($CD_VOL_R) INPUT #nr, AudioFader(0).rightvolume CASE UCASE$($AX_VOL_L) INPUT #nr, AudioFader(1).leftvolume CASE UCASE$($AX_VOL_R) INPUT #nr, AudioFader(1).rightvolume CASE UCASE$($Audio_End) EXIT LOOP END SELECT WEND CLOSE #nr FUNCTION = %True END FUNCTION FUNCTION ReadFlagDataFromFile (f AS STRING) EXPORT AS LONG ' since version 5.00 we have a global pointer to Task() in this DLL, so we do not have to pass the pointer. ' these pointers are in pTask() FUNCTION = %False IF ISFALSE ExistFile (f) THEN EXIT FUNCTION LOCAL nr AS LONG LOCAL aantal AS LONG LOCAL i AS LONG LOCAL j AS LONG LOCAL dum$ LOCAL keyword AS ASCIIZ * 40 nr = FREEFILE OPEN f FOR INPUT LOCK SHARED AS #nr ' locate the start of the data block: DO LINE INPUT #nr, keyword keyword = TRIM$(UCASE$(keyword)) IF LEFT$(keyword,1) = "[" THEN 'MSGBOX keyword IF keyword = TRIM$(UCASE$($Flags_Start)) THEN 'MSGBOX "O.K. Flag data block found " EXIT LOOP END IF END IF IF EOF(nr) THEN CLOSE #nr Warning "Flags data block not found in file " & f & " in " + FUNCNAME$, 10000 EXIT FUNCTION END IF LOOP DO IF EOF(nr) THEN EXIT LOOP INPUT #nr, dum$ dum$= TRIM$(UCASE$(dum$)) SELECT CASE dum$ 'CASE $ApFlga - cfr. read app. data - This is a double and may lead to bugs... CASE UCASE$($FlagAuto) 'MSGBOX "Autopatch flag found" CASE UCASE$($FlagScore) INPUT #nr, aantal ' NrOfScoreTasks IF aantal > %False THEN FOR i = 1 TO aantal INPUT #nr, j @pTask(j).flags = @pTask(j).flags OR %SCORE_TASK NEXT i END IF CASE UCASE$($FlagMidi) '"MIDI_OUT_TASKS" INPUT #nr, aantal 'NrOfMidiOutTasks IF aantal > %False THEN FOR i = 1 TO aantal INPUT #nr,j @pTask(j).flags = @pTask(j).flags OR %MIDI_TASK NEXT i END IF CASE UCASE$($FlagHarm) '"GLOBAL_HARMONY_TASKS" INPUT #nr, aantal IF aantal > %False THEN FOR i = 1 TO aantal INPUT #nr, j @pTask(j).flags = @pTask(j).flags OR %HARM_TASK NEXT i END IF CASE UCASE$($Flags_End) CLOSE #nr FUNCTION = %True EXIT FUNCTION END SELECT LOOP CLOSE #nr FUNCTION = %False END FUNCTION FUNCTION ReadCockpitControlDataFromFile (f AS STRING) EXPORT AS LONG FUNCTION = %False IF ISFALSE ExistFile (f) THEN EXIT FUNCTION LOCAL nr AS LONG LOCAL dum$ LOCAL keyword AS ASCIIZ * 40 LOCAL aantal AS INTEGER nr = FREEFILE OPEN f FOR INPUT LOCK SHARED AS #nr ' locate the start of the Cockpit block: DO LINE INPUT #nr, keyword IF LEFT$(keyword,1) = "[" THEN 'MSGBOX keyword keyword = TRIM$(UCASE$(keyword)) + CHR$(0) 'IF dum$ = TRIM$(UCASE$($COCKPIT)) THEN EXIT LOOP werkt niet !!! 'IF LEFT$(dum$,LEN($COCKPIT))+ CHR$(0) = UCASE$($COCKPIT) THEN EXIT LOOP IF keyword = UCASE$($COCKPIT) THEN EXIT LOOP END IF IF EOF(nr) THEN CLOSE #nr Warning "Cockpit data block not found in file " & f & " in " + FUNCNAME$, 10000 EXIT FUNCTION END IF LOOP DO IF EOF(nr) THEN EXIT DO INPUT #nr, dum$ dum$ = TRIM$(UCASE$(dum$)) SELECT CASE dum$ CASE UCASE$($NrUD) INPUT #nr, aantal IF aantal > -1 THEN @pApp.NrUpDowns= aantal 'MSGBOX "aantal up downs gevonden" CASE UCASE$($NrSL) INPUT #nr, aantal IF aantal > -1 THEN @pApp.NrSliders = aantal CASE UCASE$($COCKPIT_LABELS), UCASE$($COCKPIT_END) CLOSE #nr FUNCTION = %True EXIT FUNCTION END SELECT LOOP CLOSE #nr END FUNCTION FUNCTION ReadDiapasonFromFile (f AS STRING) EXPORT AS SINGLE LOCAL nr AS LONG LOCAL retval AS SINGLE LOCAL dum$ IF ISFALSE Existfile (f) THEN FUNCTION = 440! EXIT FUNCTION END IF nr = FREEFILE OPEN f FOR INPUT LOCK SHARED AS #nr WHILE NOT EOF(nr) INPUT #nr, dum$ dum$ = TRIM$(UCASE$(dum$)) SELECT CASE dum$ CASE "DIAPASON", "PITCH", "[DIAPASON]", "[PITCH]", UCASE$($PITCH) INPUT #nr, retval FUNCTION = retval CLOSE #nr EXIT FUNCTION END SELECT WEND CLOSE #nr END FUNCTION ' procedures from former instrument library: SUB GetInstrumentParams (Ins AS Musician, BYVAL konstant AS DWORD) EXPORT LOCAL i AS INTEGER Ins.Har(0).vel = NUL$(128) Ins.Har(1).vel = NUL$(128) Ins.QHar(1).vel = NUL$(256) ' added gwr 04.09.2007 Ins.Qhar(0).vel = NUL$(256) 'Ins.minvel = 0 Ins.maxvel = 127 ' added gwr 18.04.2009 ' konstants in the range 0-127 correspond to midi patches for traditional instruments IF konstant < 128 THEN GetTradInstrumentParams (Ins,konstant) EXIT SUB END IF SELECT CASE konstant '[ start M&M robot section] 'note: this procedure sets the default controller settings for the robots, but doesn't send them out CASE %IDM_PLAYERPIANO ' - robot Ins.naam ="PlayPian" Ins.lowtes = 21 Ins.hightes= 108 Ins.centr = 60 Ins.minvel = 6 Ins.minduur = 5 Ins.maxduur = 10000 Ins.polyphony = 88 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %PlayerPiano_Channel Ins.patch = 0 Ins.ctrl(66) = 127 ' CASE %IDM_PLAYOLA ' gewijzigd in g_kons! ' Ins.naam ="Playola" ' Ins.lowtes = 21 ' Ins.hightes= 108 ' Ins.centr = 60 ' Ins.minvel = 2 ' Ins.minduur = 20 ' Ins.maxduur = 30000 ' Ins.polyphony = 88 ' Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting ' Ins.channel = Ins.channel OR %PlayerPiano_Channel ' Ins.patch =0 CASE %IDM_HUMANOLA, %IDM_VOXHUMANOLA 'kl 040907 should allways be %IDM_VOXHUMANOLA now, 'we preserve %ID_HUMANOLA for backwards compatability ' used in GWR's , ' NOTE: The castagnets can be supported as a separate instrument. [24.06.2005] Ins.naam ="Humanola" ' = Ins.lowtes = 36 ' horn is note 31 Ins.hightes = 91 ' without castanets Ins.centr = 60 Ins.minvel = 64 Ins.minduur = 40 Ins.maxduur = 100000 Ins.polyphony = 56 ' not quite true... Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Humanola_Channel Ins.patch = 70 Ins.ctrl(10) = %False ' no sfz low Ins.ctrl(11) = %False ' no sfz high Ins.ctrl(12) = 80 ' tremulant low Ins.ctrl(13) = 80 ' tremulant high Ins.ctrl(7) = %MM_Humanola_Motor Ins.ctrl(66) = %False ' motor off - not implemented in PIC CASE %IDM_PIPEROLA Ins.naam ="Piperola" Ins.lowtes = 60 Ins.hightes = 108 ' percussion on 120-127 , lights: 118, 119 Ins.centr = 84 Ins.minvel = 64 Ins.minduur = 40 Ins.maxduur = 100000 Ins.polyphony = 48 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Piperola_Channel 'Ins.patch = 82 ' not required (only for midi simulation) Ins.ctrl(10) = %False ' no sfz activated Ins.ctrl(11) = 40 ' default tremulant frequency Ins.ctrl(7) = %MM_Piperola_Motor ' default value for wind controller Ins.ctrl(65) = 1 CASE %IDM_BOURDONOLA 'kl 040907 should allways be %IDM_BOURDONOLA now, 'we preserve %ID_BOURDONOLA for backwards compatability 'now has all notes off implemented! Ins.naam = "Bourdonola" ' used in GWR's , , ... Ins.lowtes = 36 ' lights mapped op notes 32,33,34,35 Ins.hightes = 62 Ins.centr = 50 Ins.minvel = 64 Ins.minduur = 40 Ins.maxduur = 100000 Ins.polyphony = 27 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Bourdonola_Channel ' same as piperola Ins.ctrl(1) = %MM_Bourdonola_Motor ' default value for wind controller Ins.ctrl(66) = 1 CASE %IDM_KRUM Ins.naam ="Krum" ' cromorno Ins.lowtes = 36 Ins.hightes = 91 Ins.centr = 60 Ins.minvel = 64 Ins.maxvel = 64 Ins.minduur = 5 Ins.maxduur = 100000 Ins.polyphony = 56 ' true... Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Krum_Channel ' Ins.patch = 70 ' Ins.ctrl(10) = %False ' no sfz low ' Ins.ctrl(12) = 80 ' tremulant low Ins.ctrl(1) = 0 Ins.ctrl(7) = %MM_Krum_Motor Ins.ctrl(66) = 1 ' motor on - implemented in PIC CASE %IDM_KLUNG Ins.naam = "Klung" Ins.lowtes = 49 ' really 49-69, 68 missing Ins.HighTes = 69 ' 92 corrected 12.01.2005, although with the octaves 92 is musically correct. Ins.centr = 57 Ins.minduur = 50 Ins.maxduur = 100000 Ins.polyphony = 20 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Klung_Channel Ins.ctrl(66) = 0 ' power off Ins.ctrl(67) = 0 ' video off - not mounted yet (25.08.2006) ' lites mapped on 120,121,122,123 'Ins.patch = CASE %IDM_TROMS ' this does not include Snar. Ins.naam = "Troms" Ins.lowtes = 21 ' was 18, changed 20070615 for consistency ' 24-47: aprox. real notes: 27,43,49,56,61,70,72 ' 18, 19, 20 = lights ' 21,22 = damper ' 23 = bass drum soft mallet ' 48 = cymbal Ins.hightes = 49 Ins.centr = 35 Ins.minvel = 4 Ins.minduur = 1 Ins.maxduur = 60 Ins.polyphony = 7 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Troms_Channel Ins.patch = 122 CASE %IDM_THUNDERWOOD Ins.naam = "ThunderWood" Ins.lowtes = 0 ' note 0 = strobo Ins.hightes = 26 ' cricket added Ins.centr = 12 Ins.minvel = 1 Ins.minduur = 1 Ins.maxduur = 100000 Ins.polyphony = 9 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %ThunderWood_Channel Ins.ctrl(70) = 0 ' orange rotating light Ins.ctrl(1) = 0 ' wind machine Ins.ctrl(66) = %True ' stroom aan CASE %IDM_SPRINGERS Ins.naam = "Springers" Ins.lowtes = 24 '20080211 was still 120!! -> caused actual notes to be filtered out by the midiplayer until now.. Ins.hightes = 127 Ins.centr = 123 Ins.minvel = 12 Ins.minduur = 50 Ins.maxduur = 100000 Ins.polyphony = 10 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Springers_Channel Ins.ctrl(70) = 0 ' police light CASE %IDM_ROTOMOTON Ins.naam = "Rotomoton" Ins.lowtes = 41 Ins.hightes = 59 Ins.centr = 50 Ins.minvel = 12 Ins.minduur = 1 Ins.maxduur = 100000 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Rotomoton_Channel Ins.polyphony = 5 Ins.ctrl(66) = %True ' stroom aan CASE %IDM_HARMA Ins.naam = "Harma" Ins.lowtes = 29 Ins.HighTes = 90 ' lights are 91-98 , 90=bel Ins.centr = 64 Ins.minduur = 50 ' in ms. Ins.maxduur = 100000 Ins.polyphony = 61 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Harma_Channel Ins.patch = 15 ' dulcimer = &B00001111: all registers ON Ins.ctrl(7) = %MM_Harma_Motor ' motor (60) Ins.ctrl(66) = %TRue ' motor on off switch ' 3.12.2005 CASE %IDM_VIBI Ins.naam = "Vibi" Ins.lowtes = 60 Ins.Hightes = 96 Ins.centr = 78 Ins.minduur = 1 Ins.maxduur = 10000 Ins.polyphony = 37 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Vibi_Channel Ins.ctrl(66) = %True ' stroom aan Ins.ctrl(7) = 127 'valves open Ins.ctrl(20) = 0 'new implementation starts with valves open without rotating Ins.ctrl(21) = 0 Ins.ctrl(24) = 1 'VOORLOPIG! - foute implementatie op vibi zelf.. Ins.Ctrl(23) = 60 Ins.ctrl(64) = %False ' sustain off 'Ins.patch = CASE %IDM_BELLY Ins.naam = "Belly" ' uses same midi channel and port as Ins.lowtes = 68 ' not real pitches but hardware mapping - ok Ins.Hightes = 101 '102 Ins.centr = 80 Ins.minduur = 1 Ins.maxduur = 5000 Ins.polyphony = 34 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Belly_Channel Ins.ctrl(66) = %true '%False ' on/off Ins.ctrl(67) = %False ' video on/off ' has controller for mapping mode CASE %IDM_AUTOSAX Ins.naam = "AutoSax" ' version 5.0 - 2020 Ins.polyphony = 1 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Autosax_Channel Ins.lowtes = 24 Ins.Hightes = 90 'lights are mapped extreme high Ins.centr = 58 Ins.minduur = 10 Ins.maxduur = 30000 'Ins.ctrl(1) = %MM_Autosax_Motor Ins.ctrl(7) = 100 Ins.ctrl(17) =120 'Ins.ctrl(18) = 123 'does not work... 'Ins.ctrl(19) = 110 'Ins.ctrl(65) = 127 'kleppen AAN ! 'Ins.ctrl(10) = 64 'Ins.ctrl(11) = 0 CASE %IDM_FLEX ' midi robot since 2016 Ins.naam = "Flex" Ins.polyphony = 2 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.Channel OR %Flex_Channel Ins.lowtes = 36 ' no real notes here! Ins.Hightes = 127 Ins.minduur = 500 Ins.maxduur = 32000 CASE %IDM_TUBI ' quartertone instrument 2003 since 23.01.2005 midi controlled! ' quartertones mapped 4 octaves down (new 01.2005!!!) Ins.naam = "Tubi" Ins.polyphony = 74 Ins.channel = Ins.Channel AND &H0F00 Ins.Channel = Ins.channel OR %Tubi_Channel Ins.lowtes = 24 ' 24- 60 is quartertones . was: 36 to 71 is quartertones for range 72 - 108 Ins.hightes = 108 ' 72 - 108 are the normal pitches Ins.centr = 90 Ins.minduur = 4 ' Ins.maxduur = 3000 'irrelevant Ins.ctrl(66) = 1 ' stroom aan Ins.ctrl(127) = %Tubi_Channel ' channel can be set with a controller CASE %IDM_TRUMP ' midi controlled automats! watch the %IDM_ Ins.naam = "Trump" Ins.lowtes = 32 ' hardware mapping starts here G# Ins.hightes = 68 ' 68 is highest pitch ' hardware loopt tot noot 79. Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Trump_Channel Ins.ctrl(7) = %MM_Trump_Motor ' wind pressure - uses midi volume controller. ' this is the value at which Trump is tuned. (32Hz motor frequency) CASE %IDM_SO ' Automated Sousaphone, v1:2003, V2:2005, V3:2020 Ins.naam = "So" Ins.lowtes = 15 ' 0 = lowest possible midi frequency. (was 12 in earlier implementation) ' set back to 12 18.04.2009 ' set to 15 for version 3. 11.02.2020. This is the lowest possible pedal tone on a sousaphone. Ins.hightes = 69 ' depending on carefull adjustment of artificial head. ' for Version 3, we go up to note 69 ' foot is mapped on midi note 84 Ins.centr = 34 Ins.channel = Ins.Channel AND &H0F00 Ins.channel = Ins.Channel OR %So_Channel Ins.minduur = 50 Ins.maxduur = 5000 Ins.polyphony = 1 'Ins.ctrl(1) = %MM_So_Motor ' was motor, nu noise. Default is 8 'Ins.ctrl(7) = 80 ' default is 104 'Ins.ctrl(15) = 50 ' adsr period 'Ins.ctrl(16) = 45 ' attack time 'Ins.ctrl(17) = 100 ' attack level 'Ins.ctrl(18) = 61 ' decay time 'Ins.ctrl(19) = 90 ' release time 'Ins.ctrl(20) = 64 ' tuning Ins.ctrl(66) = 1 'was missing, which caused the 'bug' in the player 'Ins.patch = 0 CASE %IDM_PUFF Ins.naam = "Puff" ' new 11.11.2003 - quartertone instrument Ins.lowtes = 7 ' 7 - 48 quartertones for range 55-96 Ins.hightes = 105 ' 55 - 96 normal tones ' 49,50,51,52 = stepping motor ' 53,54 = lights Ins.minvel = 1 Ins.maxvel = 60 ' added 18.04.2009 Ins.centr = 75 ' real pitch Ins.channel = Ins.Channel AND &H0F00 Ins.channel = Ins.channel OR %Puff_Channel Ins.minduur = 1 Ins.maxduur = 40 Ins.polyphony = 84 CASE %IDM_HURDY ' new 06.2004 - transposing instrument, dependent on strings used. ' the real tuning is read from the inifile and placed in ctrl 20 and ctrl 21. ' 2007: now the tuning is mostly 33, 50 Ins.naam = "Hurdy" Ins.lowtes = 40 ' lights mapped on notes 0 and 1 Ins.Hightes = 88 ' 40-63 and 64-88 Ins.centr = 59 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Hurdy_Channel Ins.minduur = 10 Ins.maxduur = 30000 Ins.polyphony = 2 Ins.ctrl(1) = 1 ' duration of prepulse on tangents (controller) Ins.ctrl(7) = 12 ' bow motor speed Ins.ctrl(66) = 1 ' motor ON/OFF Ins.ctrl(67) = 0 ' controller for bow direction Ins.ctrl(68) = 0 ' controller for error reset ' controller for manu sinistra ' controller for legato CASE %IDM_AKE Ins.naam = "Ake" Ins.lowtes = 19 ' 19-42 en 49-94 Ins.hightes = 94 ' 95-96 = lights Ins.centr = 60 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Ake_Channel Ins.ctrl(1) = %MM_Ake_Motor Ins.ctrl(7) = 64 ' no wind (mixing valve at center) , 0= sucking, 127 = blowing CASE %IDM_LLOR ' now (15.10.2017) has controller 66 implemented Ins.naam = "Llor" ' lights mapped on notes 1 to 5 Ins.lowtes = 36 ' hard beaters 36 - 47, soft beaters 48 - 59 Ins.Hightes = Ins.lowtes + 23 Ins.centr = 42 Ins.Channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Llor_Channel ' uses same channel as belly (belly starts at 68) Ins.ctrl(30) = 0 ' repeat rate Ins.ctrl(31) = 0 ' return velo for bidirectional solenoids Ins.ctrl(66) = 127 ' lights mapped on notes 1,2,3,4,5 CASE %IDM_DRIPPER Ins.naam = "Dripper" Ins.lowtes = 0 Ins.Hightes = 15 ' expanded to 15, for technofaustus. Ins.centr = 6 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Dripper_Channel 'Ins.ctrl(66) = %False ' power off - not required. CASE %IDM_SIRE Ins.naam = "Sire" Ins.lowtes = 48 ' pitch MSB controlled with velo byte Ins.hightes = 71 ' pitch LSB: controllers 48-71 Ins.polyphony = 24 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Sire_Channel CASE %IDM_VACCA Ins.naam = "Vacca" Ins.lowtes = 48 Ins.hightes = 95 Ins.ctrl(66) = 127 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Vacca_Channel CASE %IDM_CASTA ' NOTE: The castagnets can be supported as a separate instrument. [24.06.2005] ' now has prog. changes and sysex for velocity scaling (12.07.2005) Ins.naam ="Casta" ' = Ins.lowtes = 113 Ins.hightes = 127 ' castagnets are now 113-127, was: 120-127 Ins.centr = 119 Ins.minvel = 1 Ins.minduur = 1 Ins.maxduur = 10 ' irrelevant Ins.polyphony = 15 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Humanola_Channel Ins.patch = 0 ' 0= default scaling. 122, 123,124,125,126,127 are user programmable. CASE %IDM_CASTA2 ' NOTE: this is Casta Due, with two wings. ' has prog. changes and sysex for velocity scaling ' Casta Due is connected to a different midi port than Casta! Ins.naam ="Casta2" Ins.lowtes = 112 ' lite is 111 Ins.hightes = 127 Ins.centr = 120 Ins.minvel = 1 Ins.minduur = 1 Ins.maxduur = 10 ' irrelevant Ins.polyphony = 16 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Humanola_Channel Ins.patch = 0 ' 0= default scaling. 122, 123,124,125,126,127 are user programmable. CASE %IDM_VITELLO Ins.naam = "Vitello" Ins.lowtes = 96 Ins.hightes = 127 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Vitello_Channel Ins.ctrl(66) = %False ' off on init CASE %IDM_QT Ins.naam = "Qt" Ins.lowtes = 36 Ins.hightes = 108 Ins.centr = 72 Ins.channel = Ins.channel AND &H0F00 ' requires 2 channels Ins.channel = Ins.channel OR %Qt_Channel Ins.ctrl(8) = %False ' dim lites off Ins.ctrl(7) = %MM_QT_MOTOR ' constant in g_kons Ins.ctrl(66) = %False ' off on init CASE %IDM_QT_Q 'quartertone part of QT - added to be able to implement QT in the MidiPlayer Ins.naam = "Qtq" Ins.lowtes = 36 Ins.hightes = 107 Ins.centr = 72 Ins.channel = Ins.channel AND &H0F00 ' requires 2 channels Ins.channel = Ins.channel OR (%Qt_Channel + 1) ' was bug: Ins.channel OR %Qt_Channel + 1 gives krum channel Ins.ctrl(8) = %False ' dim lites off Ins.ctrl(7) = %MM_QT_MOTOR ' constant in g_kons Ins.ctrl(66) = %False ' off on init CASE %IDM_PSCH Ins.naam = "Psch" Ins.lowtes = 72 Ins.hightes = 83 ' lites on 84-97 Ins.polyphony = 12 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Psch_Channel CASE %IDM_SNAR Ins.naam = "Snar" Ins.lowtes = 60 ' 60-72, beaters, 73,74: rimshots Ins.hightes = 74 '20070515: was 77 - changed by xof for consistency: in other instruments lights are not included in range' 75,76,77 = lites Ins.centr = 66 Ins.minvel = 5 Ins.minduur = 1 Ins.maxduur = 100 Ins.polyphony = 15 Ins.ctrl(11) = %False ' snares off Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Snar_Channel CASE %IDM_BAKO Ins.naam = "Bako" ' params checked and changed gwr 07.12.2007 Ins.lowtes = 24 Ins.hightes = 57 Ins.centr = 36 Ins.minvel = 1 Ins.minduur = 20 Ins.maxduur = 100000 Ins.polyphony = 20 ' limited by the power supply. Mandatory!!! Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Bako_Channel Ins.ctrl(1) = %False ' prepressure Ins.ctrl(7) = %MM_Bako_Motor ' pressure, volume 'xof 20070712: magic number replaced by constant CASE %IDM_XY Ins.naam = "Xy" ' 24.02.2007 Ins.lowtes = 65 Ins.hightes = 108 Ins.centr = 84 Ins.minvel = 1 Ins.minduur = 1 Ins.maxduur = 10 Ins.polyphony = 35 ' limited by the power supply. Mandatory!!! Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Xy_Channel CASE %IDM_XY_Q Ins.naam = "Xyq" ' 19.03.2007 Ins.lowtes = 65 Ins.hightes = 108 Ins.centr = 84 Ins.minvel = 1 Ins.minduur = 1 Ins.maxduur = 10 Ins.polyphony = 35 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Xy_Channel + 1 Ins.ctrl(66) = %True ' on/off switch solenoids. CASE %IDM_AEIO Ins.naam = "Aeio" ' 24.02.2007 - 26.07.2010 Ins.lowtes = 36 Ins.hightes = 127 Ins.centr = 48 Ins.minvel = 1 Ins.minduur = 10 Ins.maxduur = 10000 Ins.polyphony = 12 ' limited by number of strings Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Aeio_Channel 'now set to 0 CASE %IDM_SIMBA Ins.naam = "Simba" ' 26.06.2007 Ins.lowtes = 58 Ins.hightes = 114 '81 Ins.centr = 68 Ins.minvel = 1 Ins.minduur = 10 Ins.maxduur = 100000 Ins.polyphony = 22 Ins.patch = 0 ' 122-127 to be implemented. Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Simba_Channel ins.ctrl(66) = 1 ' was missing - added 16.01.08 CASE %IDM_BONO Ins.naam = "Bono" Ins.lowtes = 24 '0 ' tmp - 0 up to 08.01.2012, this was very dangerous however! Ins.hightes = 88 ' tmp Ins.centr = 48 Ins.polyphony = 1 Ins.patch = 0 '122 - during research we leave it here at zero Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Bono_Channel Ins.ctrl(66) = %True ' Ins.ctrl(1) = %MM_Bono_Motor doesn't do anyything anymore Ins.ctrl(17) = 127 Ins.ctrl(18) = 104 Ins.ctrl(7) = 120 Ins.ctrl(13) = 0 ' default lookup's for valves CASE %IDM_KORN Ins.naam="Korn" Ins.LowTes = 52 Ins.HighTes = 96 ' 87 is highest realistic note Ins.polyphony = 1 Ins.patch = 0 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Korn_Channel ' Ins.ctrl(7) = 64 '? Ins.ctrl(13) = 0 Ins.ctrl(17) = 100 Ins.ctrl(18) = 104 Ins.ctrl(20) = 0 ' tuning Ins.ctrl(25) = 48 ' valve velo CASE %IDM_TOYPI Ins.naam = "Toypi" Ins.Lowtes = 72 ' lites not included here. Ins.HighTes = 107 Ins.polyphony = 8 Ins.patch = 122 ' velo lookup Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Toypi_channel ' Ins.ctrl(66) = %true - not implemented. CASE %IDM_OB Ins.naam = "Ob" Ins.lowtes = 58 Ins.Hightes = 96 Ins.Polyphony = 1 Ins.patch = 0 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Ob_Channel Ins.ctrl(66) = %True Ins.ctrl(17) = 127 Ins.ctrl(18) = 104 Ins.ctrl(19) = 100 Ins.ctrl(20) = 0 ' tuning CASE %IDM_HELI Ins.naam = "Heli" Ins.lowtes = 27 Ins.Hightes = 75 Ins.Polyphony = 1 Ins.patch = 0 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Heli_Channel Ins.ctrl(66) = %True Ins.ctrl(7) = 127 ' optor's zoals in bono Ins.ctrl(8) = 0 Ins.ctrl(17) = 100 Ins.ctrl(18) = 105 Ins.ctrl(19) = 96 Ins.ctrl(20) = 0 ' tuning CASE %IDM_BOMI Ins.naam ="Bomi" Ins.lowtes = 55 Ins.hightes = 91 Ins.polyphony = 37 'not enough wind to do that though... Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Bomi_Channel Ins.ctrl(1) = %False 'windvalve open Ins.ctrl(7) = %MM_Bomi_Motor '(72) Ins.ctrl(66) = %True '%False 'off on startup CASE %IDM_HAT 'sold to Aphex Twin - returned to Logos in 2020. Ins.naam = "Hat" Ins.lowtes = 36 Ins.hightes = 99 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Hat_Channel CASE %IDM_HARMO Ins.naam = "HarmO" Ins.lowtes = 29 Ins.hightes = 101 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Harmo_Channel Ins.ctrl(66) = %True ins.ctrl(7) = %MM_HarmO_Motor Ins.ctrl(1) = 110 ' windklep (moet open staan om te spelen!) Ins.ctrl(82) = 0 ' tremulant Ins.ctrl(70) = 127 ' bas reg1 Ins.ctrl(71) = 127 ' reg 2 Ins.ctrl(72) = 127 ' reg 3 Ins.ctrl(73) = 127 ' reg 4 Ins.ctrl(74) = 0 ' 127 ' subbass Ins.ctrl(75) = 127 ' treb. reg 1 Ins.ctrl(76) = 127 ' reg 2 Ins.ctrl(77) = 127 ' 3 Ins.ctrl(78) = 127 ' reg 4 Ins.ctrl(79) = 0 ' frontal swell Ins.ctrl(80) = 0 ' back swell ' Ins.ctrl(81) = 0 ' as yet uncommisioned. CASE %IDM_FA Ins.naam = "Fa" Ins.lowtes = 34 Ins.hightes = 91 'op de ARM tot 91, normaal slechts tot 79 ' op de dsPIC geimplementeerd tot en met 91 Ins.centr = 52 Ins.minvel = 1 Ins.minduur = 125 Ins.maxduur = 60000 Ins.polyphony = 1 ' there is no need to send all these, as is happens on power down automatically ' Ins.ctrl(1) = 1 ' noise ' Ins.ctrl(2) = 2 ' filter lfo speed ' Ins.ctrl(3) = 0 ' vibrato depth ' Ins.ctrl(4) = 8 ' vibrato speed ' Ins.ctrl(7) = 74 ' volume ' Ins.ctrl(16) = 100 ' Ins.ctrl(17) = 127 ' attack level ' Ins.ctrl(18) = 90 ' sustain level ' Ins.ctrl(19) = 64 ' release after note off ' Ins.ctrl(20) = 64 ' tuning Ins.ctrl(22) = 0 ' reclined position ' Ins.ctrl(26) = 90 ' Ins.ctrl(29) = 20 ' Ins.ctrl(30) = 120 ' Ins.ctrl(41) = 64 ' duodecime detune ' Ins.ctrl(42) = 0 ' duodecime amplitude ' Ins.ctrl(43) = 100 ' vibrato start delay Ins.ctrl(66) = %True Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Fa_Channel CASE %IDM_SPIRO ' 11.04.2011/04.09.2011 Ins.naam = "Spiro" Ins.lowtes = 33 Ins.Hightes = 88 Ins.centr = 60 'Ins.ctrl(66) = %True Ins.ctrl(28) = %False Ins.ctrl(29) = %False Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Spiro_Channel ' 16.07.2011 Ins.patch = 122 CASE %IDM_SYNCHROCHORD Ins.naam = "Synchro" Ins.lowtes = 39 Ins.Hightes = 87 Ins.centr = 48 Ins.ctrl(66) = %True Ins.ctrl(32) = 10 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Synchro_Channel ' 16.01.2012 'Ins.patch = 122 CASE %IDM_KLAR ' 02.08.2012 Ins.naam = "Klar" Ins.lowtes = 43 Ins.hightes = 106 ' op de ARM geimplementeerd tot en met 106 Ins.centr = 63 Ins.minvel = 1 Ins.minduur = 50 Ins.maxduur = 60000 Ins.polyphony = 1 ' there is no need to send all these, as it happens on power down automatically ' Ins.ctrl(1) = 1 ' noise ' Ins.ctrl(2) = 2 ' filter lfo speed ' Ins.ctrl(3) = 0 ' vibrato depth ' Ins.ctrl(4) = 8 ' vibrato speed ' Ins.ctrl(7) = 74 ' volume ' Ins.ctrl(16) = 100 ' Ins.ctrl(17) = 127 ' attack level ' Ins.ctrl(18) = 90 ' sustain level ' Ins.ctrl(19) = 64 ' release after note off ' Ins.ctrl(20) = 64 ' tuning ' Ins.ctrl(22) = 64 ' position (motor) ' Ins.ctrl(25) = 62 ' Ins.ctrl(26) = 90 ' Ins.ctrl(29) = 20 ' Ins.ctrl(30) = 120 ' Ins.ctrl(41) = 62 ' duodecime detune ' Ins.ctrl(42) = 120 ' duodecime amplitude ' Ins.ctrl(43) = 100 ' vibrato start delay Ins.ctrl(66) = %True ' sending this with param 0 resets all controllers to cold boot values! Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Klar_Channel CASE %IDM_TEMBLO ' 18.02.2013, gwr Ins.naam = "Temblo" Ins.lowtes = 60 Ins.hightes = 77 ' Ins.centr = 72 ' arbitrary Ins.minvel = 1 Ins.minduur = 1 ' irrelevant Ins.maxduur = 10 ' irrelevant Ins.polyphony = 12 ' no limits Ins.ctrl(66) = %True Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Temblo_Channel CASE %IDM_HORNY Ins.naam = "Horny" Ins.lowtes = 23 ' pedal on F-horn 34 Ins.hightes = 101 '91 ' op de ARM geimplementeerd tot en met 101 Ins.centr = 48 Ins.minvel = 1 Ins.minduur = 50 Ins.maxduur = 60000 Ins.polyphony = 1 ' there is no need to send all these, as it happens on power down automatically Ins.ctrl(1) = 20 ' noise Ins.ctrl(2) = 2 ' filter lfo speed Ins.ctrl(3) = 20 ' vibrato depth Ins.ctrl(4) = 5 ' vibrato speed Ins.ctrl(7) = 127 ' volume Ins.ctrl(16) = 25 Ins.ctrl(17) = 0 '127 ' attack level Ins.ctrl(18) = 50 ' sustain level Ins.ctrl(19) = 65 ' release after note off ' Ins.ctrl(20) = 64 ' tuning Ins.ctrl(22) = 64 ' position (motor) ' Ins.ctrl(25) = 62 ' Ins.ctrl(26) = 90 ' Ins.ctrl(29) = 20 ' Ins.ctrl(30) = 120 Ins.ctrl(43) = 8 ' vibrato start delay Ins.ctrl(66) = %True ' sending this with param 0 resets all controllers to cold boot values! Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Horny_Channel CASE %IDM_ASA Ins.naam = "Asa" Ins.lowtes = 49 Ins.hightes = 102 ' op de ARM geimplementeerd tot en met 106 Ins.centr = 65 Ins.minvel = 1 Ins.minduur = 50 Ins.maxduur = 60000 Ins.polyphony = 1 ' there is no need to send all these, as it happens on power down automatically Ins.ctrl(1) = 6 ' noise ' Ins.ctrl(2) = 2 ' filter lfo speed ' Ins.ctrl(3) = 0 ' vibrato depth ' Ins.ctrl(4) = 8 ' vibrato speed Ins.ctrl(7) = 127 ' volume Ins.ctrl(16) = 20 Ins.ctrl(17) = 120 ' attack level Ins.ctrl(18) = 85 ' sustain level Ins.ctrl(19) = 89 ' release after note off ' Ins.ctrl(20) = 64 ' tuning Ins.ctrl(22) = 64 ' position F/B Ins.ctrl(23) = 64 ' position L/R ' Ins.ctrl(25) = 62 ' Ins.ctrl(26) = 90 ' Ins.ctrl(29) = 20 ' Ins.ctrl(30) = 120 ' Ins.ctrl(43) = 100 ' vibrato start delay Ins.ctrl(66) = %True ' sending this with param 0 resets all controllers to cold boot values! Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Asa_Channel CASE %IDM_WHISPER ' controller 66 required now!!! Ins.naam = "Whisper" Ins.lowtes = 72 Ins.hightes = 86 Ins.centr = 76 Ins.minvel = 1 Ins.minduur = 50 Ins.maxduur = 60000 Ins.polyphony = 15 Ins.ctrl(66) = %True Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Whisper_Channel CASE %IDM_RODO ' 12.01.2014 ' rev. 2017 - check with new specs! Ins.naam = "Rodo" Ins.lowtes = 48 Ins.hightes = 78 Ins.centr = 60 Ins.minvel = 1 Ins.minduur = 1 Ins.maxduur = 60000 Ins.polyphony = 31 Ins.ctrl(64) = %False ' sustain off Ins.ctrl(66) = %True Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Rodo_Channel CASE %IDM_SNAR2 ' sold to Aphex Twin, 2014 Ins.naam = "Snar2" Ins.lowtes = 60 ' 60-72, beaters, 73,74: rimshots Ins.hightes = 74 Ins.centr = 66 Ins.minvel = 1 Ins.minduur = 1 Ins.maxduur = 100 Ins.polyphony = 15 Ins.ctrl(11) = %False ' snares off Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Snar2_Channel CASE %IDM_RUMO ' 11.2020 = %IDM_HUNT Ins.naam = "Rumo" Ins.lowtes = 1 ' voorlopig Ins.hightes = 127 ' voorlopig Ins.centr = 60 Ins.minvel = 1 Ins.minduur = 1 Ins.maxduur = 10000 Ins.polyphony = 15 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Rumo_Channel CASE %IDM_ZI Ins.naam = "Zi" Ins.lowtes = 50 '25.10.2015 Ins.hightes = 87 Ins.centr = 67 Ins.minvel = 1 Ins.minduur = 1 Ins.maxduur = 10000 Ins.polyphony = 38 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Zi_Channel CASE %IDM_HYBR ' problem: should we take hybr and hybrhi as a single instrument? ' as it is now, we consider it a single instrument. ' %IDM_HYBRHI is also defined but has the same value Ins.naam = "Hybr" Ins.lowtes = 33 ' 33 is lowest note on Hybr Ins.hightes = 108 '72 ' HybrHi extends to 108 Ins.centr = 72 ' 55 ' 72 is the highest note on Hybr Ins.minvel = 1 Ins.minduur = 1 Ins.maxduur = 10000 Ins.polyphony = 88 ' 40 for Hybr, 76 with hybrhi, 88 with HybrLo Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Hybr_Channel CASE %IDM_HYBRLO 'HybrLo definitely needs to be a separate instrument! 'controllers are different and there are many note overlaps. 'in 2020 we split off also the test code module for HybrLo. Ins.naam = "HybrLo" Ins.lowtes = 22 Ins.hightes = 69 Ins.centr = 34 Ins.minvel = 1 Ins.minduur = 1 Ins.maxduur = 10000 Ins.polyphony = 12 ' no par. octaves! Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %HybrLo_Channel CASE %IDM_BALMEC ' = %IDM_BELLO Ins.naam = "BalMec" Ins.lowtes = 51 ' was 24. The propellers are mapped on note 36, 38, 40 Ins.hightes = 96 ' the range is discontinous from 51 to 93 (08.04.2015) Ins.centr = 72 Ins.minvel = 1 Ins.minduur = 1 Ins.maxduur = 10000 Ins.polyphony = 33 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Balmec_Channel CASE %IDM_TINTI Ins.naam = "Tinti" Ins.lowtes = 89 Ins.hightes = 127 Ins.centr = 108 Ins.minvel = 1 Ins.minduur = 1 Ins.maxduur = 10000 Ins.polyphony = 38 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Tinti_Channel CASE %IDM_CHI Ins.naam = "Chi" Ins.lowtes = 0 ' for debugging only Ins.hightes = 127 Ins.centr = 64 Ins.minvel = 1 Ins.minduur = 1 Ins.maxduur = 10000 Ins.polyphony = 4 Ins.channel = Ins.channel AND &H0F00 ' preserve eventual port setting Ins.channel = Ins.channel OR %Chi_Channel CASE %IDM_BUG ' finished 02.01.2017 - firmware revision 12.2020 Ins.naam="Bug" ' resets controllers on ctrl66. Ins.LowTes = 52 Ins.HighTes = 94 ' 87 is highest realistic note Ins.polyphony = 1 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Bug_Channel CASE %IDM_MELAUTON ' 2017 Ins.naam = "Melauton" ' resets controllers on ctrl66. Ins.LowTes = 60 Ins.HighTes = 84 Ins.polyphony = 25 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Melauton_Channel CASE %IDM_PI ' 03.2017 Ins.naam = "Pi" ' resets controllers on ctrl66. Ins.LowTes = 84 ' ! Pi_ AS MUSICIAN, as Pi is a macro in g_kons. Ins.HighTes = 127 ' lite mapped on note 0 Ins.polyphony = 127 - 84 FOR i = Ins.Lowtes TO Ins.hightes Ins.ctrl(i - 12) = 64 ' reset microtuning controllers NEXT i Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Pi_Channel CASE %IDM_POS ' 27.04.2018 Ins.naam = "Pos" ' resets controllers on ctrl66. Ins.LowTes = 36 ' ! Pos_ AS MUSICIAN, as Pos is a keyword Ins.HighTes = 100 ' lite mapped on note 120 Ins.polyphony = 100 - 36 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Pos_Channel CASE %IDM_PER ' 29.07.2018 Ins.naam = "Per" ' resets controllers on ctrl66. Ins.LowTes = 21 Ins.HighTes = 77 ' lites mapped on note 120-127 Ins.polyphony = 15 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Per_Channel CASE %IDM_2PI ' 06.09.2018 Ins.naam = "2Pi" ' resets controllers on ctrl66. Ins.LowTes = 72 ' Pi2_ AS MUSICIAN Ins.HighTes = 101 ' lites mapped on notes 1 and 2 Ins.polyphony = 30 FOR i = Ins.Lowtes TO Ins.hightes Ins.ctrl(i) = 64 ' reset microtuning controllers NEXT i Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Pi2_Channel CASE %IDM_Balsi ' 08.12.2018 Ins.naam = "Balsi" ' resets controllers on ctrl66. Ins.LowTes = 24 ' voorlopig Ins.HighTes = 124 ' voorlopig Ins.polyphony = 6 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Balsi_Channel CASE %IDM_TUBO ' 20.09.2019 - 04.2020 Ins.naam = "Tubo" ' resets controllers on ctrl66. Ins.LowTes = 48 Ins.HighTes = 91 Ins.polyphony = 4 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Tubo_Channel CASE %IDM_FLUT ' finished 17.01.2020 - firmware updated 12.2020 Ins.naam="Flut" ' resets controllers and tuning on ctrl66. Ins.LowTes = 48 Ins.HighTes = 105 Ins.polyphony = 1 Ins.ctrl(20) = 64 ' tuning to 440Hz Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Flut_Channel Ins.patch = 0 CASE %IDM_Roro ' 04.05.2021 Ins.naam = "Roro" ' resets controllers on ctrl66. Ins.LowTes = 36 Ins.HighTes = 115 Ins.polyphony = 115 - 36 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Roro_Channel Ins.patch = 7 ' 03.05.2021 Ins.ctrl(7) = %MM_Roro_Motor CASE %IDM_Trumpeter Ins.naam="Trumpeter" ' resets controllers on ctrl66. Ins.LowTes = 40 Ins.HighTes = 94 ' 87 is highest realistic note Ins.polyphony = 1 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Trumpeter_Channel CASE %IDM_Cornalto Ins.naam="Cornalto" ' resets controllers on ctrl66. Ins.LowTes = 39 Ins.HighTes = 91 ' 87 is highest realistic note Ins.polyphony = 1 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Cornalto_Channel CASE %IDM_Pianet Ins.naam ="Pianet" Ins.lowtes = 36 Ins.hightes = 96 Ins.centr = 60 Ins.minvel = 1 Ins.minduur = 10 Ins.maxduur = 100000 Ins.polyphony = 60 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Pianet_Channel CASE %IDM_Spinet ' = %IDM_Sperrhak Ins.naam = "SperrHak" Ins.lowtes = 36 Ins.Hightes = 84 Ins.centr = 60 Ins.ctrl(66) = %True Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Sperrhak_Channel ' 16.07.2021 'Ins.patch = 122 CASE %IDM_STEELY Ins.naam = "Steely" Ins.lowtes = 65 Ins.Hightes = 81 Ins.centr = 69 Ins.ctrl(66) = %True Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Steely_Channel ' 01.01.2022 CASE %IDM_3PI ' 02.03.2022 Ins.naam = "3Pi" ' resets controllers on ctrl66. Ins.LowTes = 60 ' Pi3 AS MUSICIAN Ins.HighTes = 89 ' lites mapped on notes 1 and 2 Ins.centr = 74 Ins.polyphony = 30 FOR i = Ins.Lowtes + 12 TO Ins.hightes + 12 Ins.ctrl(i) = 64 ' reset microtuning controllers NEXT i Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Pi3_Channel CASE %IDM_4PI ' 29.04.2022 Ins.naam = "4Pi" ' resets controllers on ctrl66. Ins.LowTes = 43 ' Pi4 AS MUSICIAN Ins.HighTes = 108 ' lites mapped on notes 12,13, and 14 Ins.centr = 67 Ins.polyphony = 18 * 3 FOR i = Ins.Lowtes + 24 TO Ins.hightes + 12 ' 67 to 120 Ins.ctrl(i) = 64 ' reset microtuning controllers NEXT i Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %Pi4_Channel Ins.patch = %False CASE %IDM_4D_MIDIDISPLAY_A ' added 05.05.2014 - also defined as robot musician (global) Ins.naam = "mDisp_A" Ins.lowtes = 1 Ins.hightes = 4 Ins.polyphony = 4 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %mDisplay_Channel Ins.patch = 0 CASE %IDM_4D_MIDIDISPLAY_B ' added 30.07.2014 - also defined as robot musician (global) Ins.naam = "mDisp_B" Ins.lowtes = 1 Ins.hightes = 4 Ins.polyphony = 4 Ins.channel = Ins.channel AND &H0F00 Ins.channel = Ins.channel OR %mDisplay_Channel Ins.patch = 0 CASE ELSE ' returns default values: Ins.naam ="Default" Ins.lowtes = 1 Ins.hightes = 127 Ins.centr = 60 Ins.minvel = 1 Ins.minduur = 10 Ins.maxduur = 100000 Ins.polyphony = 127 Ins.channel = Ins.channel AND &H0F00 Ins.patch = 0 Warning "ID not found:" + LTrimZero(HEX$(konstant)) + " in " + FUNCNAME$, 10000 END SELECT END SUB SUB GetTradInstrumentParams (Ins AS musician, BYVAL konstant AS DWORD) SELECT CASE konstant CASE %ID_PIANO Ins.naam ="Piano" Ins.lowtes = 21 Ins.hightes= 108 Ins.centr = 60 Ins.minvel = 1 Ins.minduur = 5 ' in ms Ins.maxduur = 10000 Ins.polyphony = 88 Ins.channel = 0 Ins.patch =0 CASE %ID_CEMBALO Ins.naam ="Cembalo" Ins.lowtes = 29 Ins.hightes= 89 Ins.centr = 60 Ins.minvel = 1 Ins.minduur = 10 Ins.maxduur = 5000 Ins.polyphony = 61 Ins.channel = 0 Ins.patch =6 CASE %ID_CLAVICHORD Ins.naam ="Klavichord" Ins.lowtes = 29 ' heeft verkort oktaaf! Ins.hightes= 89 Ins.centr = 60 Ins.minvel = 1 Ins.minduur = 5 Ins.maxduur = 1000 Ins.polyphony = 61 Ins.channel = 0 Ins.patch =7 CASE %ID_ORGAN Ins.naam ="Organ" Ins.lowtes = 17 Ins.hightes= 101 Ins.centr = 60 Ins.minvel = 30 Ins.minduur = 10 Ins.maxduur = 100000 Ins.polyphony = 61 Ins.channel = 0 Ins.patch = 19 CASE %ID_VIOLIN Ins.naam ="Violin" Ins.lowtes = 55 Ins.hightes= 120 Ins.centr = 74 Ins.minvel = 5 Ins.minduur = 10 Ins.maxduur = 10000 Ins.polyphony = 2 Ins.channel = 0 Ins.patch = 40 CASE %ID_VIOLA Ins.naam ="Viola" Ins.lowtes = 48 Ins.hightes= 96 Ins.centr = 62 Ins.minvel = 5 Ins.minduur = 10 Ins.maxduur = 10000 Ins.polyphony = 2 Ins.channel = 0 Ins.patch = 41 CASE %ID_CELLO ' used in GWR's Ins.naam = "Cello " Ins.lowtes = 36 Ins.hightes= 88 Ins.centr = 52 Ins.minvel = 18 ' was 24 %Lowest_Cello_Velocity = 24 Ins.minduur = 100 ' replaces %CelloPiCriteriumValue = 100 Ins.maxduur = 50000 Ins.polyphony = 2 Ins.channel = 0 Ins.patch = 42 ' = gm check with your synth! CASE %ID_BASS Ins.naam ="Bass" Ins.lowtes = 24 Ins.hightes= 67 Ins.centr = 44 Ins.minvel = 8 Ins.minduur = 50 Ins.maxduur = 10000 Ins.polyphony = 2 Ins.channel = 0 Ins.patch = 43 CASE %ID_FLUTE ' used in GWR's , , Ins.naam ="Flute " Ins.lowtes = 59 Ins.hightes = 108 Ins.centr = 76 Ins.minvel = 24 ' checked in cohiba code. Ins.minduur = 400 ' used in Cohiba Ins.maxduur = 10000 Ins.polyphony = 1 Ins.channel = 0 Ins.patch = 24 :' ' proteus 2 patch = 24 . depends on synth used ' gm-patch=74 CASE %ID_PICCOLO Ins.naam ="Piccolo" Ins.lowtes = 74 Ins.hightes = 120 Ins.centr = 86 Ins.minvel = 24 Ins.minduur = 100 Ins.maxduur = 6000 Ins.polyphony = 1 Ins.channel = 2 Ins.patch = 25 :' ' proteus 2 patch = 25 in gm: 72 CASE %ID_OBOE ' used in GWR's Ins.naam ="Oboe " Ins.lowtes = 58 Ins.hightes = 96 Ins.centr = 77 Ins.minvel = 20 Ins.minduur = 125 Ins.maxduur = 60000 Ins.polyphony = 1 Ins.channel = 0 Ins.patch = 68 'gm - 26 on Proteus 2 CASE %ID_ENGLISH_HORN ' althobo Ins.naam ="Cor_Ang" Ins.lowtes = 52 Ins.hightes = 81 Ins.centr = 73 Ins.minvel = 20 Ins.minduur = 125 Ins.maxduur = 60000 Ins.polyphony = 1 Ins.channel = 0 Ins.patch = 69 'gm CASE %ID_CLARINET Ins.naam ="Bb Clar" Ins.lowtes = 50 Ins.Hightes = 96 Ins.centr = 67 Ins.minvel = 5 Ins.minduur = 80 Ins.maxduur = 30000 Ins.polyphony = 1 Ins.channel = 0 Ins.patch = 71 'gm 'ClarinetEb.naam ="Eb Clar" 'ClarinetA.naam ="A Clar" CASE %ID_BASS_CLARINET Ins.naam ="BassClar" Ins.lowtes = 34 Ins.Hightes = 84 ' slechts 77 volgens Willemze Ins.centr = 54 Ins.minvel = 5 Ins.minduur = 80 Ins.maxduur = 30000 Ins.polyphony = 1 Ins.channel = 0 Ins.patch = 71 ' gm CASE %ID_BASSOON Ins.naam = "bassoon" Ins.lowtes = 34 Ins.hightes = 75 Ins.centr = 52 Ins.minvel = 20 Ins.minduur = 125 Ins.maxduur = 60000 Ins.polyphony = 1 Ins.channel = 0 Ins.patch = 70 'gm CASE %ID_HORN Ins.naam = "horn" Ins.lowtes = 34 Ins.hightes = 77 Ins.centr = 50 Ins.minvel = 30 Ins.minduur = 150 Ins.maxduur = 5000 Ins.polyphony = 1 Ins.channel = 0 Ins.patch = 60 CASE %ID_TRUMPET Ins.naam = "trumpet" Ins.lowtes = 54 Ins.hightes = 84 Ins.centr = 67 Ins.minvel = 40 Ins.minduur = 200 Ins.maxduur = 6000 Ins.polyphony = 1 Ins.channel = 0 Ins.patch = 56 CASE %ID_CORNET Ins.naam = "Cornet" Ins.lowtes = 64 Ins.hightes = 91 CASE %ID_TROMBONE Ins.naam = "Trombone" Ins.patch = 57 CASE %ID_EUPHONIUM Ins.naam = "Euphonium" Ins.lowtes = 34 Ins.hightes = 69 CASE %ID_TUBA Ins.naam = "Tuba" Ins.lowtes = 24 ' 22 kan ook voor een Bes instrument Ins.hightes = 60 ' tot 65 Ins.centr = 42 ' 48 Ins.minvel = 32 Ins.minduur = 160 Ins.maxduur = 15000 Ins.polyphony = 1 Ins.patch = 58 CASE %ID_SOP_SAX Ins.naam ="Sopr-Sax" Ins.patch = 64 Ins.lowtes = 56 Ins.hightes = 89 CASE %ID_ALT_SAX Ins.naam ="Alto-Sax" Ins.patch = 65 Ins.lowtes = 49 Ins.hightes = 80 CASE %ID_TEN_SAX Ins.naam ="TenorSax" Ins.patch = 66 Ins.lowtes = 44 Ins.hightes = 75 CASE %ID_BAR_SAX Ins.naam ="Bary-Sax" Ins.patch = 67 Ins.lowtes = 37 Ins.hightes = 68 'CASE %ID_BAS_SAX 'Ins.naam ="BassSax " CASE %ID_PIZZ Ins.naam = "Pizz" CASE %ID_HARP Ins.naam = "Harp" Ins.lowtes = 23 Ins.hightes = 103 CASE %ID_GUITAR Ins.naam = "Guitar" Ins.lowtes = 52 Ins.hightes = 95 Ins.centr = 67 Ins.minvel = 1 Ins.minduur = 120 Ins.maxduur = 1000 Ins.polyphony = 6 Ins.channel = 0 'Ins.patch = CASE %ID_CELESTA Ins.naam = "Celesta" Ins.lowtes = 48 Ins.hightes = 96 CASE %ID_VIBRAPHONE Ins.naam = "Vibes" Ins.lowtes = 53 Ins.hightes = 89 Ins.centr = 72 Ins.polyphony = 4 CASE %ID_MARIMBA Ins.naam = "Marimba" Ins.lowtes = 36 Ins.Hightes = 96 CASE %ID_XYLOPHONE Ins.naam = "Xylo" Ins.lowtes = 60 Ins.hightes = 108 CASE %ID_GONGS Ins.naam = "Gongs" Ins.lowtes = 24 Ins.hightes = 72 CASE %ID_TUBULAR_BELLS Ins.naam = "Bells" Ins.lowtes = 48 Ins.hightes = 74 CASE %ID_CHIMES Ins.naam = "Chimes" Ins.lowtes = 84 Ins.hightes = 120 CASE %ID_TIMPANI Ins.naam = "Timpani" Ins.lowtes = 36 Ins.hightes = 65 CASE %ID_DULCIMER Ins.naam = "Dulcimer" Ins.patch = 15 CASE %ID_RECORDER_SOP ' used in GWR's Ins.naam ="Sop_Rec" Ins.lowtes = 72 Ins.hightes = 100 Ins.centr = 84 Ins.minvel = 24 Ins.minduur = 100 Ins.maxduur = 10000 Ins.polyphony = 1 Ins.channel = 0 Ins.patch = 25 ' proteus 2 patch = 25 - piccolo... , 131 = recorder CASE %ID_RECORDER_ALT Ins.naam ="Alt_Rec" Ins.lowtes = 65 Ins.hightes = 93 Ins.centr = 77 Ins.minvel = 20 Ins.minduur = 120 Ins.maxduur = 10000 Ins.polyphony = 1 Ins.channel = 0 Ins.patch = 25 ' proteus 2 patch = 25 - piccolo... CASE %ID_RECORDER_TEN Ins.naam ="Ten_Rec" Ins.lowtes = 60 Ins.hightes = 88 Ins.centr = 72 Ins.minvel = 18 Ins.minduur = 150 Ins.maxduur = 8000 Ins.polyphony = 1 Ins.channel = 0 Ins.patch = 25 ' proteus 2 patch = 25 - piccolo... CASE %ID_RECORDER_BAS Ins.naam ="Bas_Rec" Ins.lowtes = 53 Ins.hightes = 80 Ins.centr = 65 Ins.minvel = 16 Ins.minduur = 180 Ins.maxduur = 6000 Ins.polyphony = 1 Ins.channel = 0 Ins.patch = 25 :' ' proteus 2 patch = 25 - piccolo... CASE %ID_MUSIC_BOX Ins.naam = "MusicBox" Ins.lowtes = 60 Ins.hightes = 96 CASE %ID_BANDONEON Ins.naam = "Bandoneon" Ins.lowtes = 48 ' nagaan Ins.hightes = 84 CASE %ID_HARMONICA Ins.naam = "Harmonica" Ins.lowtes = 48 Ins.hightes = 96 CASE %ID_ACCORDEON Ins.naam = "Accordeon" Ins.lowtes = 29 Ins.hightes = 108 CASE %ID_BASS_GUITAR Ins.naam = "E-Bass" Ins.lowtes = 28 Ins.lowtes = 64 CASE %ID_OCARINA Ins.naam = "Ocarina" CASE %ID_WHISTLE Ins.naam = "Whistle" CASE %ID_PANFLUTE Ins.naam= "Panflute" Ins.lowtes = 67 Ins.hightes = 84 CASE ELSE ' returns default values: Ins.naam ="Default" Ins.lowtes = 1 Ins.hightes = 127 Ins.centr = 60 Ins.minvel = 1 Ins.minduur = 10 Ins.maxduur = 100000 Ins.polyphony = 127 Ins.channel = Ins.channel AND &H0F00 Ins.patch = 0 Warning "ID not found:" + LTrimZero(HEX$(konstant)) + " in " + FUNCNAME$, 10000 END SELECT END SUB FUNCTION SetRobotPort (robot AS musician, inf AS STRING, hMidiO() AS DWORD) EXPORT AS DWORD ' reads the default port for the robot passed (as instrument)and sets it in the channel. ' this function should be called after getInstrumentparams. ' The ini-file must contain the data for the ports the robots are connected to. LOCAL robby AS STRING LOCAL nr AS LONG LOCAL retval AS DWORD LOCAL keyword AS STRING FUNCTION = %False IF ISFALSE hMidiO(0) THEN Warning "Cannot set robotport without midi handle(s) in " + FUNCNAME$, 10000 EXIT FUNCTION END IF IF inf = "" THEN inf = IniFileName IF ISFALSE existfile (inf) THEN Warning inf & " not found in " + FUNCNAME$, 10000 EXIT FUNCTION END IF nr = FREEFILE IF ISFALSE nr THEN Warning "No file handle in " + FUNCNAME$, 10000 EXIT FUNCTION END IF keyword = TRIM$(UCASE$(robot.naam)) IF keyword = "" THEN Warning "Fill robot.naam field before calling" + FUNCNAME$, 10000 EXIT FUNCTION END IF keyword = "[<" & keyword & ">]" OPEN inf FOR INPUT LOCK WRITE AS #nr IF ERR THEN Warning "error"+STR$(ERRCLEAR) + "happened while trying to open " + inf + " in " + FUNCNAME$, 10000 EXIT FUNCTION END IF DO LINE INPUT #nr, robby IF TRIM$(robby) = $MMports THEN EXIT LOOP robby = "" LOOP UNTIL EOF(nr) IF robby = "" THEN Warning $MMports & " section not found in ini file @" + FUNCNAME$, 10000 CLOSE #nr EXIT FUNCTION END IF WHILE NOT EOF(nr) INPUT #nr, robby robby = TRIM$(UCASE$(robby)) SELECT CASE robby CASE keyword INPUT #nr, retval ' portnumber 0-15 IF retval > 15 THEN Warning "Error in M&M_ROBOT section in Ini-file @" + FUNCNAME$, 10000 CLOSE #nr EXIT FUNCTION END IF IF retval > UBOUND(hMidiO) THEN DO DECR retval LOOP UNTIL retval = UBOUND(hMidiO) ' auto adapt to closest match... END IF ' now check whether we have a valid handle... IF hMidiO(retval) THEN SHIFT LEFT retval,8 robot.channel = robot.channel OR retval CLOSE #nr FUNCTION = %True EXIT FUNCTION ELSE Warning "No midi handle for the requested port in " + FUNCNAME$, 10000 CLOSE #nr FUNCTION = %False EXIT FUNCTION END IF END SELECT WEND CLOSE #nr END FUNCTION FUNCTION SetPitch2MidiPorts (pm AS Pitch2MidiType, inf AS STRING, hMidiO() AS DWORD,hMidiI() AS DWORD) EXPORT AS DWORD ' reads the default port and channel for the pitch2midi device passed. ' pm.naam ' pm.inchannel ' pm.outchannel ' pm.lowtes ' pm.hightes ' pm.ctrl(127) ' for the CQT device, we also read the settings for the controllers : new since 09.10.2003 ' these settings will be passed to the device on creation of the control window. LOCAL nr AS LONG LOCAL retval AS DWORD LOCAL keyword AS STRING LOCAL dummy AS STRING ' error checking section: FUNCTION = %False IF ISFALSE hMidiO(0) THEN Warning "Cannot set deviceport without midi output handle(s) in " + FUNCNAME$, 10000 EXIT FUNCTION END IF IF ISFALSE hMidiI(0) THEN Warning "Cannot set deviceport without midi input handle(s) in " + FUNCNAME$, 10000 EXIT FUNCTION END IF IF inf = "" THEN inf = IniFileName IF ISFALSE existfile (inf) THEN Warning inf & " not found in " + FUNCNAME$, 10000 EXIT FUNCTION END IF nr = FREEFILE IF ISFALSE nr THEN Warning "No file handle in " + FUNCNAME$, 10000 EXIT FUNCTION END IF keyword = TRIM$(UCASE$(pm.naam)) IF keyword = "" THEN Warning "Fill device.naam field before calling " + FUNCNAME$, 10000 EXIT FUNCTION END IF ' end error checking preliminaries... keyword = "[" & keyword & "]" OPEN inf FOR INPUT LOCK SHARED AS #nr DO LINE INPUT #nr, dummy IF TRIM$(dummy) = keyword THEN EXIT LOOP dummy = "" LOOP UNTIL EOF(nr) IF dummy = "" THEN Warning keyword & " section not found in ini file in " + FUNCNAME$, 10000 CLOSE #nr EXIT FUNCTION END IF WHILE NOT EOF(nr) INPUT #nr, dummy dummy = TRIM$(UCASE$(dummy)) SELECT CASE dummy CASE "[INPUT_PORT]" INPUT #nr, retval IF retval > 15 THEN Warning "Inport error in Pitch2Midi section in Ini-file in " + FUNCNAME$, 10000 CLOSE #nr EXIT FUNCTION END IF IF retval > UBOUND(hMidiI) THEN DO DECR retval LOOP UNTIL retval = UBOUND(hMidiI) ' auto adapt to closest match... END IF ' now check whether we have a valid handle... IF hMidiI(retval) THEN SHIFT LEFT retval,8 pm.inchannel = pm.inchannel OR retval ELSE Warning "No midi input handle for the requested port in " + FUNCNAME$, 10000 END IF CASE "[OUTPUT_PORT]" INPUT #nr, retval IF retval > 15 THEN Warning "Outport error in Pitch2Midi section in Ini-file in " + FUNCNAME$, 10000 CLOSE #nr EXIT FUNCTION END IF IF retval > UBOUND(hMidiO) THEN DO DECR retval LOOP UNTIL retval = UBOUND(hMidiO) ' auto adapt to closest match... END IF ' now check whether we have a valid handle... IF hMidiO(retval) THEN SHIFT LEFT retval,8 pm.outchannel = pm.outchannel OR retval ELSE Warning "No midi output handle for the requested port in " + FUNCNAME$, 10000 END IF CASE "[INPUT_CHANNEL]" INPUT #nr, retval IF retval > 15 THEN Warning "Input channel error in Pitch2Midi section in Ini-file in " + FUNCNAME$, 10000 ELSE pm.inchannel = pm.inchannel OR retval END IF CASE "[OUTPUT_CHANNEL]" INPUT #nr, retval IF retval > 15 THEN Warning "Output channel error in Pitch2Midi section in Ini-file in " + FUNCNAME$, 10000 ELSE pm.outchannel = pm.outchannel OR retval END IF CASE "[HIGHTES]" , "[CC41_HIGHTES]" INPUT #nr, retval pm.hightes = retval AND &H07F IF pm.hightes < pm.lowtes THEN SWAP pm.hightes, pm.lowtes ' autocorrect pm.ctrl(41)= pm.hightes ' for cqt only CASE "[LOWTES]" , "[CC42_LOWTES]" INPUT #nr, retval pm.lowtes = retval AND &H07F IF pm.lowtes > pm.hightes THEN SWAP pm.lowtes, pm.hightes ' autocorrect pm.ctrl(42) = pm.lowtes ' for cqt only CASE "[CC33_ONSET]" INPUT #nr, retval pm.ctrl(33) = retval AND &H07F CASE "[CC34_OFFSET]" INPUT #nr, retval pm.ctrl(34) = retval AND &H07F CASE "[CC35_META_Q_C1_SENS]" ' default, 64 INPUT #nr, retval pm.ctrl(35) = retval AND &H07F CASE "[CC36_META_Q_C2_SENS]" ', 64 INPUT #nr, retval pm.ctrl(36) = retval AND &H07F CASE "[CC37_META_S_C5]" ', 64 INPUT #nr, retval pm.ctrl(37) = retval AND &H07F CASE "[CC38_META_S_C7]" ', 64 INPUT #nr, retval pm.ctrl(38) = retval AND &H07F CASE "[CC39_META_S_C9]" ', 64 INPUT #nr, retval pm.ctrl(39) = retval AND &H07F CASE "[CC40_TRANS]" INPUT #nr, retval pm.ctrl(40) = retval AND &H07F IF pm.ctrl(40) <> 64 THEN Warning "CQT set to transpoze... WARNING in " + FUNCNAME$, 10000 END IF CASE "[" & TRIM$(UCASE$(pm.naam)) & "_END]" CLOSE #nr FUNCTION = %True EXIT FUNCTION END SELECT WEND CLOSE #nr END FUNCTION SUB WriteDaqParams2file (f AS STRING, BYREF DAQparams AS DataAcquisitionParameters) EXPORT LOCAL i AS DWORD STATIC cnt AS DWORD LOCAL nr AS LONG nr = FREEFILE IF ISFALSE cnt THEN ' for debugging OPEN f FOR OUTPUT AS #nr INCR cnt ELSE OPEN f FOR APPEND AS #nr END IF PRINT# nr, "//DAQparams structure parameters as set on "; DATE$ ;" "; TIME$ PRINT# nr, "//File generated by " & FUNCNAME$ & " [g_file.dll]" PRINT# nr, " " PRINT# nr, $DAQ PRINT# nr, $DAQparms; ", ", DAQparams.device PRINT# nr, "//calculated by NiDAQ:" PRINT# nr, "ChannelVector" FOR i = 0 TO 15 PRINT# nr, STR$(i) & ", ", STR$(DAQparams.ChannelVector(i)) NEXT i PRINT# nr, "GainVector" FOR i = 0 TO 15 PRINT# nr, STR$(i) & ", ", STR$(DAQparams.GainVector(i)) NEXT i PRINT# nr, "SamplingRate" FOR i = 0 TO 15 PRINT# nr, STR$(i) & ", ", STR$(DAQparams.samplingrate(i)) NEXT i PRINT# nr, "scanratedivisorvector" FOR i = 0 TO 15 PRINT# nr, STR$(i) & ", ", STR$(DAQparams.scanratedivisorvector(i)) NEXT i PRINT# nr, "voltagerange" FOR i = 0 TO 15 PRINT# nr, STR$(i) & ", ", STR$(DAQparams.voltagerange(i)) NEXT i PRINT# nr, "polarity" FOR i = 0 TO 15 PRINT# nr, STR$(i) & ", ", STR$(DAQparams.polarity(i)) NEXT i PRINT# nr, "DEVICE, " ; DAQparams.device PRINT# nr, "ADRES, " ; DAQparams.adr ' PRINT# nr, "IRQ, " ; DAQparams.irq PRINT# nr, "NrChannels, "; DAQparams.nrchannels PRINT# nr, "Inputconfig, "; DAQparams.inputconfig PRINT# nr, "Rate, "; DAQparams.rate PRINT# nr, "ScanFreq, " ;DAQparams.scanfreq PRINT# nr, "pADCBuffer, " ; DAQparams.pADCBuffer PRINT# nr, "pDAQbuffer, " ; DAQparams.pDAQBuffer PRINT# nr, "Buffersize, " ; DAQparams.Buffersize PRINT# nr, "resolution, " ; DAQparams.bBitsPerSample PRINT# nr, "datarefreshrate, " ;DAQparams.datarefreshrate PRINT# nr, "datatimeframe, " ; DAQparams.datatimeframe PRINT# nr, "mode, ", "&H" & LTrimZero(HEX$(DAQparams.mode)) PRINT# nr, "id, " ;DAQparams.id ' PRINT# nr, "db, " ;DAQparams.db PRINT# nr, "DAQstopped, " ;DAQparams.daqstopped ' PRINT# nr, "sizeoffstruct, ";DAQparams.sizeoffstruct PRINT# nr, $DAQ_END PRINT# nr, $DAQ_END CLOSE #nr END SUB SUB ReadFaderParams (filenaam$, BYREF AudioFader() AS AudioFaderType) EXPORT LOCAL retval AS LONG LOCAL f$ LOCAL n AS ASCIIZ * 40 LOCAL hLib AS DWORD ' read settings for wave in and out fader procedures. ' set default for cases where there is no entry in the ini file: IF AudioFader(0).TaskNr > %False THEN @pTask(AudioFader(0).TaskNr).cPtr = %False @pTask(AudioFader(0).TaskNr).freq = %False @pTask(AudioFader(0).TaskNr).naam = "" AudioFader(0).TaskNr = %False END IF IF AudioFader(1).TaskNr > %False THEN @pTask(AudioFader(1).TaskNr).cPtr = %False @pTask(AudioFader(1).TaskNr).freq = %False @pTask(AudioFader(1).TaskNr).naam = "" AudioFader(1).TaskNr = %False END IF f$ = TRIM$(filenaam$) retval = ReadAudioDataFromFile (f$,AudioFader()) ' dll function n = "g_lib.dll" hLib = GetModuleHandle(n) ' = gh.InstDLL IF ISFALSE hLib THEN MSGBOX "Error getting handle for library g_lib.dll",,FUNCNAME$ EXIT SUB END IF IF AudioFader(0).Tasknr > 0 THEN @pTask(AudioFader(0).Tasknr).freq = 12 @pTask(AudioFader(0).Tasknr).cPtr = GetProcAddress(hLib,"FADER0") 'CODEPTR(Fader0) ' does CD volume!!! ???? @pTask(AudioFader(0).Tasknr).naam = "Fader 0" END IF IF AudioFader(1).Tasknr > 0 THEN @pTask(AudioFader(1).Tasknr).freq = 12 @pTask(AudioFader(1).Tasknr).cPtr = GetProcAddress(hLib,"FADER1") 'CODEPTR(Fader1) @pTask(AudioFader(1).Tasknr).naam = "Fader 1" END IF END SUB SUB ReadSynthConfigFile (filenaam$, BYREF Meq() AS midiequipment) EXPORT ' until 25.05.1999 this procedure was part of the code module ' for and only used there. ' We needed the proc. again for CelloPi,LickStick... so we placed it here. LOCAL f$, dum$ LOCAL i AS LONG LOCAL taaknummer AS BYTE LOCAL ID AS BYTE ' proteus id. not used yet. LOCAL nrmiditasks AS BYTE LOCAL j AS BYTE LOCAL nr AS DWORD f$ = LTRIM$(filenaam$) f$ = RTRIM$(f$) nr = FREEFILE OPEN f$ FOR INPUT LOCK SHARED AS #nr WHILE NOT EOF(nr) INPUT #nr, dum$ dum$ = LTRIM$(dum$) dum$ = RTRIM$(dum$) dum$ = UCASE$(dum$) ' after each keyword we should have a comma in the file SELECT CASE dum$ CASE "MIDI_OUT_TASKS" INPUT #nr, nrmiditasks CASE "MIDI_SYNTHESIZER" INPUT #nr, f$ INPUT #nr, ID IF UCASE$(LTRIM$(f$)) = TRIM$(UCASE$(Meq(0).naam)) THEN Meq(0).ID = ID ' if the selected synth was found in the file, read the data... else refuse! ' the number of entries must match the number of midi tasks!!! IF ISFALSE nrmiditasks THEN ' try counting them from the task flag settings: FOR j = 0 TO UBOUND(@pTask) IF (@pTask(j).flags AND %MIDI_TASK) = %MIDI_TASK THEN INCR nrmiditasks NEXT j IF ISFALSE nrmiditasks THEN Warning "Nr. of midi tasks not defined in ini file in " + f$ + " @" + FUNCNAME$, 10000 EXIT SUB END IF END IF j = %False DO INCR j INPUT #nr, taaknummer INPUT #nr, @pTask(taaknummer).channel INPUT #nr, @pTask(taaknummer).patch INPUT #nr, @pTask(taaknummer).level INPUT #nr, @pTask(taaknummer).pan @pTask(taaknummer).flags = @pTask(taaknummer).flags OR %MIDI_TASK ' should be redundant. LOOP UNTIL j = nrmiditasks CLOSE #nr EXIT SUB END IF END SELECT WEND CLOSE #nr END SUB FUNCTION CheckForNetworkSupport (f AS STRING) EXPORT AS DWORD ' this function checks for the existence of a [G_NETWORK] data block in the inifile ' If no network support in the ini file, the network item will not appear in the main ' setup menu. LOCAL nr AS LONG LOCAL dum$ FUNCTION = %False IF ISFALSE Existfile(f) THEN EXIT FUNCTION nr = FREEFILE OPEN f FOR INPUT LOCK SHARED AS #nr ' locate start of a network data block: DO INPUT #nr, dum$ dum$ = UCASE$(TRIM$(dum$)) IF dum$ = UCASE$($G_NET) THEN FUNCTION = %True EXIT LOOP END IF LOOP UNTIL EOF(nr) CLOSE #nr END FUNCTION FUNCTION ReadNetworkConfigsFromFile (f AS STRING, BYREF netcfg() AS STRING) EXPORT AS DWORD LOCAL nr AS LONG LOCAL i AS DWORD LOCAL dum$ LOCAL cf AS STRING FUNCTION = %False IF ISFALSE Existfile(f) THEN EXIT FUNCTION nr = FREEFILE 'IF ISFALSE nr THEN MSGBOX "No I/O handle" : EXIT FUNCTION OPEN f FOR INPUT LOCK SHARED AS #nr ' first locate the start of the network data block: DO INPUT #nr, dum$ dum$ = UCASE$(TRIM$(dum$)) IF dum$ = UCASE$($G_NET) THEN EXIT LOOP IF EOF(nr) THEN CLOSE #nr Warning "No network data block found in file " & f & " in " + FUNCNAME$, 10000 EXIT FUNCTION END IF LOOP i = %False DO INPUT #nr, dum$ dum$ = UCASE$(TRIM$(dum$)) IF LEFT$(dum$,7) = LEFT$($G_DEV,7) THEN ' "[G_SEG_" IF RIGHT$(dum$,4) <> "END]" THEN INCR i REDIM PRESERVE netcfg(i) AS STRING netcfg(i)= TRIM$(STR$(i)) & "- " & dum$ END IF END IF IF EOF(nr) THEN EXIT LOOP LOOP UNTIL dum$ = UCASE$($G_NET_END) CLOSE #nr FUNCTION = i END FUNCTION FUNCTION ReadNetworkDataFromFile (f AS STRING, BYREF g_net AS g_net_type, BYVAL cfg AS STRING) EXPORT AS DWORD ' 23.11.2002 ' note constant section in g_kons: ' $G_NET = "[G_NETWORK]" ' $G_NET_END = "[G_NETWORK_END]" ' $G_DEV = "[G_SEG_DEV]" ' $G_DEV_END = "[G_SEG_DEV_END]" ' $G_MM = "[G_SEG_M&M]" ' $G_MM_END = "[G_SEG_M&M_END]" LOCAL nr AS LONG LOCAL i AS DWORD LOCAL dum$ LOCAL cfg_end AS STRING LOCAL mpName AS ASCIIZ * %MAX_COMPUTERNAME_LENGTH + 1 FUNCTION = %False IF ISFALSE Existfile(f) THEN EXIT FUNCTION IF cfg = "" THEN EXIT FUNCTION nr = FREEFILE IF ISFALSE nr THEN warning "No I/O handle in " + FUNCNAME$, 10000 : EXIT FUNCTION OPEN f FOR INPUT LOCK SHARED AS #nr ' first locate the start of the network data block: DO INPUT #nr, dum$ dum$ = UCASE$(TRIM$(dum$)) IF dum$ = UCASE$($G_NET) THEN EXIT LOOP IF EOF(nr) THEN CLOSE #nr warning "No network data block found in file " & f & " in " + FUNCNAME$, 10000 EXIT FUNCTION END IF LOOP ' MSGBOX cfg ' [G_SEG_DEV] ' if cfg = "" then MSGBOX "bad cfg" cfg = UCASE$(TRIM$(cfg)) DO INPUT #nr, dum$ IF dum$ <> "" THEN dum$ = UCASE$(TRIM$(dum$)) IF dum$ = cfg THEN EXIT LOOP IF EOF(nr) THEN CLOSE #nr Warning "No network data for requested configuration found in file " & f & " in " + FUNCNAME$, 10000 EXIT FUNCTION END IF END IF LOOP 'MSGBOX "hello!" ' here we must be at the start of a data section cfg_end = LEFT$(cfg,LEN(cfg)-1) & "_END]" GetComputerName mpName,SIZEOF(mpName) mpname = UCASE$(TRIM$(mpname)) 'msgbox cfg_end i = %False DO INPUT #nr, dum$ IF dum$ <> "" THEN dum$ = UCASE$(TRIM$(dum$)) IF LEFT$(dum$,1) = "[" THEN EXIT LOOP SELECT CASE dum$ CASE UCASE$(cfg_end) EXIT LOOP CASE UCASE$($G_NET_END) EXIT LOOP CASE ELSE ' IF dum$ = "SERVERPORT" THEN INPUT #nr, g_net.portin ' msgbox dum$ + str$(g_net.portin) ITERATE DO END IF '<'/KL> INCR i g_net.names(i) = MCASE$(dum$) ' IF dum$ <> mpname THEN ' INPUT #nr,g_net.dotip(i) IF LEN(TRIM$(g_net.dotip(i))) < 7 THEN g_net.dotip(i)= $NUL '"" g_net.ip(i) = %False ELSE ' convert dot-ip to dword format g_net.ip(i) = IpString2nr(TRIM$(g_net.dotip(i))) END IF ' ELSE INPUT #nr, dum$ END IF ' INPUT #nr,dum$ g_net.ports(i) = VAL(dum$) ' new 14.12.2002 - dword INPUT #nr,g_net.usage(i) ' string 'msgbox g_net.names(i) & g_net.usage(i) END SELECT LOOP UNTIL EOF(nr) CLOSE #nr FUNCTION = i EXIT FUNCTION END FUNCTION SUB GetDefaultCockpitLabels (CockpitLayo AS CockpitLabels) EXPORT ' We no longer allow users to change essential labels such as %%, jit and runtime 'DIM CockpitLayo AS CockpitLabels ' TYPE CockpitLabels ' .id(0 TO %NrCockpitlabels) AS DWORD ' .txt(0 TO %NrCockpitLabels) AS STRING * 40 ' END TYPE ' IF ISFALSE CockpitLayo.id(0) THEN GetCockpitLabelIDs CockpitLayo ' text banner upper-right 'CockpitLayo.txt(0) = $GWR - no longer removable. - set in the resource. 'CockpitLayo.txt(0) = "S/s" CockpitLayo.id(1) = %GMT_TEXT_GROUP1 CockpitLayo.id(2) = %GMT_TEXT_GROUP2 CockpitLayo.id(3) = %GMT_TEXT_GROUP3 CockpitLayo.id(4) = %GMT_TEXT_GROUP4 CockpitLayo.txt(1) = "A" ' %GMT_TEXT_GROUP1 text label below taskgroups 1,2,3,4 CockpitLayo.txt(2) = "B" ' %GMT_TEXT_GROUP2 CockpitLayo.txt(3) = "C" ' %GMT_TEXT_GROUP3 CockpitLayo.txt(4) = "D" ' %GMT_TEXT_GROUP4 ' text labels for small display boxes 3,4,5 CockpitLayo.txt(5) = "S/s" '$NUL CockpitLayo.id(5) = %GMT_LABEL_SR CockpitLayo.txt(6) = "MM" CockpitLayo.id(6) = %GMT_LABEL_TEMPO CockpitLayo.txt(7)= "Freq" CockpitLayo.id(7) = %GMT_LABEL_TES CockpitLayo.txt(8)= "Message 1" CockpitLayo.id(8) = %GMT_LABEL_MSG1 CockpitLayo.txt(9)= "-" CockpitLayo.id(9) = %GMT_MSG1 CockpitLayo.txt(10)= "Message 2" CockpitLayo.id(10) = %GMT_LABEL_MSG2 CockpitLayo.txt(11)= $NUL CockpitLayo.id(11) = %GMT_MSG2 CockpitLayo.id(12) = %GMT_LABEL_TITLE CockpitLayo.txt(12)= "Title" CockpitLayo.id(13) = %GMT_TITLE CockpitLayo.txt(13) = $NUL 'App.Title CockpitLayo.id(14) = %GMT_LABEL_AUTHOR CockpitLayo.txt(14)= "Author" CockpitLayo.id(15) = %GMT_AUTHOR CockpitLayo.txt(15)= $NUL 'App.Author ' slider labels: CockpitLayo.id(16) = %GMT_TEXT_SLIDER0 CockpitLayo.txt(16)= $NUL CockpitLayo.id(17) = %GMT_TEXT_SLIDER1 CockPitLayo.txt(17)= $NUL END SUB SUB ReadCockpitLabelsFromFile (Filenaam AS STRING, CockpitLayo AS CockpitLabels) EXPORT ' reads the cockpit labels for your application from the file you specify. ' sets the required ID's ' writes the labels to the cockpit LOCAL nr AS LONG LOCAL dummy AS STRING LOCAL value AS BYTE LOCAL done AS BYTE GetDefaultCockpitLabels CockpitLayo IF ISFALSE ExistFile(Filenaam) THEN 'IF %Wordy > 1 THEN Warning filenaam + "not found in " + FUNCNAME$, 10000 'END IF EXIT SUB END IF nr = FREEFILE OPEN Filenaam FOR INPUT LOCK SHARED AS #nr DO LINE INPUT# nr, dummy IF UCASE$(LEFT$(dummy,LEN($COCKPIT_LABELS))) = $COCKPIT_LABELS THEN DO INPUT# nr, dummy dummy = LTRIM$(dummy) IF LEFT$(dummy,1)> "0" AND LEFT$(dummy,1) <= "9" THEN value = VAL(dummy) dummy = "" INPUT# nr, dummy dummy = LTRIM$(dummy) dummy = dummy & $NUL IF value =< %NrOfCockpitLabels THEN IF value > %False THEN CockpitLayo.txt(value)= dummy IF dummy = """" & $NUL THEN CockpitLayo.txt(value)= $NUL IF dummy = "-" & $NUL THEN CockpitLayo.txt(value)= $NUL END IF END IF END IF IF UCASE$(LEFT$(dummy,LEN($COCKPIT_END))) = $COCKPIT_END THEN done = %True EXIT LOOP END IF IF EOF(nr) THEN done = %True : EXIT LOOP LOOP ELSEIF UCASE$(LEFT$(dummy,LEN($COCKPIT_END))) =$COCKPIT_END THEN done = %True EXIT LOOP END IF IF done THEN EXIT LOOP LOOP UNTIL EOF(nr) CLOSE #nr END SUB FUNCTION Read_Duration_From_File (f AS STRING, title AS STRING) EXPORT AS DWORD ' added 15.10.2003 ' the duration is normally expressed in seconds. ' its value can be used to fill App.Komposduur LOCAL nr AS LONG LOCAL retval AS SINGLE LOCAL dum$ IF ISFALSE Existfile (f) THEN Warning "File " & TRIM$(f)& " not found to read durations from. in " + FUNCNAME$, 10000 EXIT FUNCTION END IF nr = FREEFILE OPEN f FOR INPUT LOCK SHARED AS #nr SELECT CASE UCASE$(TRIM$(f)) CASE UCASE$(TRIM$($Faustini)) DO INPUT #nr, dum$ IF TRIM$(UCASE$(dum$)) = "[FAUST_ACTS]" THEN EXIT LOOP LOOP UNTIL EOF(nr) CASE ELSE ' niks END SELECT WHILE NOT EOF(nr) INPUT #nr, dum$ dum$ = TRIM$(UCASE$(dum$)) SELECT CASE dum$ CASE TRIM$(UCASE$(title)) INPUT #nr, retval FUNCTION = retval CLOSE #nr EXIT FUNCTION END SELECT WEND CLOSE #nr END FUNCTION FUNCTION Read_Theme_File (f AS STRING, BYREF Stem() AS TemaType) EXPORT AS DWORD ' added nov. 2004. ' still to do: adapt to bar-changes and weird timesignatures, including reals! ' used in Fuzzy Harmony study #12: 'Fuzzy 2 Tango' LOCAL nr AS LONG LOCAL retval AS WORD LOCAL dum$ LOCAL p AS DWORD FUNCTION = %False IF ISFALSE Existfile (f) THEN Warning f + " not found in " + FUNCNAME$, 10000 EXIT FUNCTION END IF nr = FREEFILE OPEN f FOR INPUT LOCK SHARED AS #nr WHILE NOT EOF(nr) INPUT #nr, dum$ dum$ = TRIM$(UCASE$(dum$)) SELECT CASE dum$ CASE "/", "", "'", "*" ' niks ... iterate wend CASE "[MAAT]", "[BAR]" INPUT #nr, Stem(p).maatlengte CASE "[TIJD]", "[BEAT]" INPUT #nr, Stem(p).tijdlengte CASE "[TEMPO]", "[MM]" INPUT #nr, Stem(p).tempo CASE "[TOONAARD]" , "[TC]", "[TONIC]" INPUT #nr, Stem(p).tc CASE "[VELO]" INPUT #nr, Stem(p).velo CASE "[START]" DO INPUT #nr, dum$ dum$=TRIM$(UCASE$(dum$)) SELECT CASE LEFT$(dum$,1) CASE "0","1","2","3","4","5","6","7","8","9","-" Stem(p).noot = VAL(dum$) INPUT #nr, Stem(p).duur IF ISFALSE Stem(p).noot AND ISFALSE Stem(p).duur THEN EXIT DO IF p THEN Stem(p).velo = Stem(p-1).velo Stem(p).maatlengte = Stem(p-1).maatlengte Stem(p).tijdlengte = Stem(p-1).tijdlengte Stem(p).tc = Stem(p-1).tc Stem(p).tempo = Stem(p-1).tempo END IF Stem(p).maatnr = 1 + (stem(p).cnt \ Stem(p).maatlengte) Stem(p).tijdnr = 1 + ((stem(p).cnt \ Stem(p).tijdlengte) MOD (stem(p).maatlengte \ Stem(p).tijdlengte)) Stem(p).tiknr = stem(p).cnt MOD Stem(p).tijdlengte ' ? +1 voor kompat. met CakePro ' Stem(p).cnt = Stem(p).cnt + Stem(p).duur INCR p REDIM PRESERVE Stem(p) AS STATIC TemaType Stem(p).cnt = Stem(p-1).cnt + Stem(p-1).duur CASE ELSE SELECT CASE dum$ CASE "[MAAT]", "[BAR]" INPUT #nr, Stem(p).maatlengte CASE "[TIJD]" , "[BEAT]" INPUT #nr, Stem(p).tijdlengte CASE "[TEMPO]" , "[MM]" INPUT #nr, Stem(p).tempo CASE "[TOONAARD]" , "[TC]", "[TONIC]" INPUT #nr, Stem(p).tc CASE "[VELO]" INPUT #nr, Stem(p).velo CASE ELSE ' niks END SELECT END SELECT LOOP UNTIL EOF(nr) END SELECT WEND CLOSE #nr FUNCTION = UBOUND(Stem) END FUNCTION FUNCTION WriteSetup () EXPORT AS LONG 'save current menu setup 'currently includes only NiDaq, midi- and wave in- and output devices ' 21.01.2005 LOCAL i AS LONG LOCAL f AS LONG LOCAL RES AS LONG LOCAL hMenu AS LONG LOCAL b$ LOCAL ofn AS OPENFILENAME LOCAL shortfiln AS STRING * 28 LOCAL filnnopath AS STRING * 80 LOCAL filn AS STRING * 300 LOCAL titl AS STRING * 80 LOCAL filtr AS STRING * 200 LOCAL exts AS STRING * 3 LOCAL inidir AS STRING * 256 LOCAL origdir AS STRING * 256 hMenu = GetMenu(@pgh.Setup) 'get save filename... ofn.lStructSize = SIZEOF(ofn): ofn.hwndOwner = 0: ofn.hInstance = @pgh.Inst MID$(filn,1) = CHR$(0) ofn.lpStrFile = VARPTR(filn) ofn.nMaxfile = 300 origdir = CURDIR$ inidir = TRIM$(origdir) & TRIM$($ConfigDir) ' gwr. 21.01.2005 'inidir = "C:\b\pb\gmt\config": 'warning TRIM$(inidir), 5000 CHDIR TRIM$(inidir) ofn.lpStrInitialDir = VARPTR(inidir) filtr = ".cfg" + CHR$(0) + "*.cfg" + CHR$(0) +"all files" + CHR$(0) + "*.*" + CHR$(0,0,0,0) ofn.lpStrFilter = VARPTR(filtr) ofn.nFilterIndex=1 titl = "Open Config File" 'title$ ofn.lpStrTitle= VARPTR(titl) ofn.flags = %OFN_LONGNAMES OR %OFN_HIDEREADONLY OR %OFN_NOCHANGEDIR OR %OFN_ENABLESIZING GetSaveFileName ofn ' winapi function CHDIR origdir ' reset original directory IF TRIM$(ofn.@lpStrFile) = "" THEN EXIT FUNCTION f = FREEFILE OPEN ofn.@lpStrFile FOR OUTPUT ACCESS WRITE LOCK WRITE AS f PRINT# f, "[GMT Config File]" PRINT# f, PRINT# f, "[MIDI-OUT PORTS]" FOR i = %IDM_MIDI_OUTPUT_PORTS TO %IDM_MIDI_OUTPUT_PORTS + 15 MENU GET STATE hMenu, BYCMD i TO RES MENU GET TEXT hMenu, BYCMD i TO b$ IF (RES AND %MF_CHECKED) = %MF_CHECKED THEN b$ = $DQ + UCASE$(TRIM$(PARSE$(b$, "=", 2))) + $DQ PRINT# f, b$ END IF NEXT PRINT# f, "[\]" PRINT# f, PRINT# f, "[MIDI-IN PORTS]" FOR i = %IDM_MIDI_INPUT_PORTS TO %IDM_MIDI_INPUT_PORTS + 15 MENU GET STATE hMenu, BYCMD i TO RES MENU GET TEXT hMenu, BYCMD i TO b$ IF (RES AND %MF_CHECKED) = %MF_CHECKED THEN b$ = $DQ + UCASE$(TRIM$(PARSE$(b$, "=", 2))) + $DQ PRINT# f, b$ END IF NEXT PRINT# f, "[\]" PRINT# f, PRINT# f, "[WAVE-OUT PORTS]" FOR i = %IDM_WAVE_OUTPUT_PORTS TO %IDM_WAVE_OUTPUT_PORTS + 15 MENU GET STATE hMenu, BYCMD i TO RES MENU GET TEXT hMenu, BYCMD i TO b$ IF (RES AND %MF_CHECKED) = %MF_CHECKED THEN b$ = $DQ + UCASE$(TRIM$(PARSE$(b$, "=", 2))) + $DQ PRINT# f, b$ END IF NEXT PRINT# f, "[\]" PRINT# f, PRINT# f, "[WAVE-IN PORTS]" FOR i = %IDM_WAVE_INPUT_PORTS TO %IDM_WAVE_INPUT_PORTS + 15 MENU GET STATE hMenu, BYCMD i TO RES MENU GET TEXT hMenu, BYCMD i TO b$ IF (RES AND %MF_CHECKED) = %MF_CHECKED THEN b$ = $DQ + UCASE$(TRIM$(PARSE$(b$, "=", 2))) + $DQ PRINT# f, b$ END IF NEXT PRINT# f, "[\]" PRINT# f, PRINT# f, "[Data Acquisition Hardware]" FOR i = %IDM_DAQ_PORTS TO %IDM_DAQ_PORTS_LAST MENU GET STATE hMenu, BYCMD i TO RES MENU GET TEXT hMenu, BYCMD i TO b$ IF (RES AND %MF_CHECKED) = %MF_CHECKED THEN b$ = $DQ + UCASE$(TRIM$(b$)) + $DQ PRINT# f, b$ END IF NEXT PRINT# f, "[\]" PRINT# f, PRINT# f, "[EOF]" CLOSE# f FUNCTION = %true END FUNCTION FUNCTION ReadSetup (OPT BYVAL fn AS STRING) EXPORT AS LONG 'load a device setup, from a config file LOCAL i AS LONG LOCAL f AS LONG LOCAL RES AS LONG LOCAL start AS LONG LOCAL length AS LONG LOCAL hMenu AS LONG LOCAL b$ LOCAL c$ LOCAL ofn AS OPENFILENAME LOCAL shortfiln AS STRING * 28 LOCAL filnnopath AS STRING * 80 LOCAL filn AS STRING * 300 LOCAL titl AS STRING * 80 LOCAL filtr AS STRING * 200 LOCAL exts AS STRING * 3 LOCAL inidir AS STRING * 256 LOCAL origdir AS STRING * 256 hMenu = GetMenu(@pgh.Setup) IF ISFALSE LEN(fn) THEN 'get save filename... ofn.lStructSize = SIZEOF(ofn): ofn.hwndOwner = 0: ofn.hInstance = @pgh.Inst MID$(filn,1) = CHR$(0) ofn.lpStrFile = VARPTR(filn) ofn.nMaxfile = 300 origdir = CURDIR$ inidir = TRIM$(origdir) & TRIM$($ConfigDir) ' gwr. 21.01.2005 'inidir = "C:\b\pb\gmt\config" 'warning TRIM$(inidir), 5000 CHDIR inidir ofn.lpStrInitialDir = VARPTR(inidir) filtr = ".cfg" + CHR$(0) + "*.cfg" + CHR$(0) +"all files" + CHR$(0) + "*.*" + CHR$(0,0,0,0) ofn.lpStrFilter = VARPTR(filtr) ofn.nFilterIndex=1 titl = "Open Config File" 'title$ ofn.lpStrTitle= VARPTR(titl) ofn.flags = %OFN_LONGNAMES OR %OFN_HIDEREADONLY OR %OFN_NOCHANGEDIR OR %OFN_ENABLESIZING GetOpenFileName ofn ' winapi function CHDIR TRIM$(origdir) IF TRIM$(ofn.@lpStrFile) = "" THEN EXIT FUNCTION fn = ofn.@lpStrFile END IF f = FREEFILE 'parse file. OPEN fn FOR INPUT ACCESS READ LOCK WRITE AS f IF ERRCLEAR THEN MSGBOX "could not open configuration file",,FUNCNAME$ EXIT FUNCTION END IF LINE INPUT# f, b$ DO WHILE INSTR(LEFT$(TRIM$(b$), 1), ANY "'\/#") LINE INPUT# f, b$ IF EOF(f) THEN b$ = "[EOF]": EXIT LOOP LOOP UNTIL EOF(f) IF TRIM$(b$) <> "[GMT Config File]" THEN CLOSE #f EXIT FUNCTION ' returning false END IF DO UNTIL EOF(f) LINE INPUT# f, b$ IF INSTR(LEFT$(TRIM$(b$), 1), ANY "'\/#") THEN ITERATE LOOP b$ = UCASE$(TRIM$(b$)) REGEXPR "(\[)([A-Z0-9\-,. ]+)(\])" IN b$ TO start, length ' msgbox "cat " + MID$(b$, start, length),,b$ SELECT CASE MID$(b$, start, length) CASE "[MIDI-OUT PORTS]" DO UNTIL EOF(f) LINE INPUT# f, b$ b$ = UCASE$(TRIM$(b$)) IF LEFT$(b$, 2) = "[\" THEN EXIT LOOP REGEXPR "(\q)([A-Z0-9-,. :]+)(\q)" IN b$ TO start, length IF ISFALSE length THEN ITERATE DO b$ = MID$(b$, start + 1, length - 2) FOR i = %IDM_MIDI_OUTPUT_PORTS TO %IDM_MIDI_OUTPUT_PORTS + 15 MENU GET TEXT hMenu, BYCMD i TO c$ IF INSTR(UCASE$(c$), b$) THEN SendMessage @pgh.Setup, %WM_COMMAND,i, 0 ITERATE LOOP END IF NEXT warning "Device " + b$ + " seems not connected!", 10000 LOOP CASE "[MIDI-IN PORTS]" DO UNTIL EOF(f) LINE INPUT# f, b$ b$ = UCASE$(TRIM$(b$)) IF LEFT$(b$, 2) = "[\" THEN EXIT LOOP REGEXPR "(\q)([A-Z0-9-,. :]+)(\q)" IN b$ TO start, length IF ISFALSE length THEN ITERATE DO b$ = MID$(b$, start + 1, length - 2) FOR i = %IDM_MIDI_INPUT_PORTS TO %IDM_MIDI_INPUT_PORTS + 15 MENU GET TEXT hMenu, BYCMD i TO c$ IF INSTR(UCASE$(c$), b$) THEN SendMessage @pgh.Setup, %WM_COMMAND,i, 0 ITERATE LOOP END IF NEXT warning "Device " + b$ + " seems not connected!", 10000 LOOP CASE "[WAVE-OUT PORTS]" DO UNTIL EOF(f) LINE INPUT# f, b$ b$ = UCASE$(TRIM$(b$)) IF LEFT$(b$, 2) = "[\" THEN EXIT LOOP REGEXPR "(\q)([A-Z0-9-,. :\(\)]+)(\q)" IN b$ TO start, length IF ISFALSE length THEN ITERATE DO b$ = MID$(b$, start + 1, length - 2) FOR i = %IDM_WAVE_OUTPUT_PORTS TO %IDM_WAVE_OUTPUT_PORTS + 15 MENU GET TEXT hMenu, BYCMD i TO c$ IF INSTR(UCASE$(c$), b$) THEN SendMessage @pgh.Setup, %WM_COMMAND,i, 0 ITERATE LOOP END IF NEXT warning "Device " + b$ + " seems not connected!", 10000 LOOP CASE "[WAVE-IN PORTS]" DO UNTIL EOF(f) LINE INPUT# f, b$ b$ = UCASE$(TRIM$(b$)) IF LEFT$(b$, 2) = "[\" THEN EXIT LOOP REGEXPR "(\q)([A-Z0-9-,. :\(\)]+)(\q)" IN b$ TO start, length IF ISFALSE length THEN ITERATE DO b$ = MID$(b$, start + 1, length - 2) FOR i = %IDM_WAVE_INPUT_PORTS TO %IDM_WAVE_INPUT_PORTS + 15 MENU GET TEXT hMenu, BYCMD i TO c$ IF INSTR(UCASE$(c$), b$) THEN SendMessage @pgh.Setup, %WM_COMMAND,i, 0 ITERATE LOOP END IF NEXT warning "Device " + b$ + " seems not connected!", 10000 LOOP CASE "[DATA ACQUISITION HARDWARE]" 'note, we're comparing with trim$(ucase$()), so the allcaps are right.. DO UNTIL EOF(f) LINE INPUT# f, b$ b$ = UCASE$(TRIM$(b$)) IF LEFT$(b$, 2) = "[\" THEN EXIT LOOP REGEXPR "(\q)([A-Z0-9-,. :]+)(\q)" IN b$ TO start, length IF ISFALSE length THEN ITERATE DO b$ = MID$(b$, start + 1, length - 2) FOR i = %IDM_DAQ_PORTS TO %IDM_DAQ_PORTS_LAST MENU GET TEXT hMenu, BYCMD i TO c$ IF INSTR(UCASE$(c$), b$) THEN SendMessage @pgh.Setup, %WM_COMMAND,i, 0 ITERATE LOOP END IF NEXT warning "Device " + b$ + " seems not connected!", 10000 LOOP CASE "[EOF]" FUNCTION = %True EXIT LOOP END SELECT LOOP CLOSE# f END FUNCTION '%midiplayerdebug=1 FUNCTION ReadVoiceFromMidiFile(BYVAL fn AS STRING, BYVAL tracknr AS WORD, BYREF tema() AS TemaType) EXPORT AS LONG 'parses one track of a midi file into gwr's theme type 'intended to deal with monophonic tracks! does handle polyphonic tracks, but for those you're probably better of with ReadTrackFromMidiFile 'only works on midi format 1 files 'note that track 1 only conatains a tempo map and meta events, so it is rejected here '080515 6: in the works LOCAL f AS LONG 'input file LOCAL b$, t$, chunk$, ev$, tim$ LOCAL ticks AS DWORD LOCAL MODE AS WORD 'midi mode, 0/1/2 LOCAL nrtracks AS WORD LOCAL mdd AS INTEGER 'midi delta time ticks per quarter note LOCAL chunksize AS DWORD 'in bytes, 1 chunk = 1 track LOCAL currenttimetiks AS DWORD 'ms LOCAL temptiks AS DWORD LOCAL bytecount AS DWORD 'within chunk LOCAL cevents AS DWORD 'counter for all events in file LOCAL currentstatusbyte AS BYTE 'we must remember this for running status LOCAL trackcount AS WORD LOCAL evnt AS DWORD LOCAL mevnt AS DWORD 'meta event -> time sgnature map LOCAL x AS BYTE LOCAL sq() AS parsedmiditype 'only to hold time sigs LOCAL tempomap() AS DOUBLE 'in type 1 files: read from track 0, apply to other tracks LOCAL tempotimestamp() AS DOUBLE 'time at which tempo changes LOCAL tempocount AS DWORD 'counter within tempo related arrays (c.s.) LOCAL teller AS WORD LOCAL noemer AS WORD LOCAL TemaCount AS DWORD LOCAL CountBack AS LONG 'sic long! LOCAL SqCount AS DWORD LOCAL bts AS LONG REDIM tempomap(10) REDIM tempotimestamp(10) logfile FUNCNAME$ + " " + fn + STR$(tracknr) + " *" + STR$(VARPTR(tema(0))) f = FREEFILE OPEN fn FOR BINARY ACCESS READ LOCK WRITE AS f IF ISFALSE tracknr THEN MSGBOX "Tracknr can not be 0!",,FUNCNAME$: EXIT FUNCTION IF tracknr = 1 THEN MSGBOX "Track 1 only contains a tempo map and meta events, no notes",,FUNCNAME$: EXIT FUNCTION IF ERRCLEAR THEN MSGBOX "midi file " + fn + " not found",,FUNCNAME$ EXIT FUNCTION END IF '===READ HEADER======================================================= GET$ #f, 8, b$ IF b$ <> "MThd" + CHR$(0, 0, 0, 6) THEN MSGBOX fn + " does not have a valid midi file header!",,FUNCNAME$ EXIT FUNCTION END IF ' get #f, , mode GETS THE BYTES SWAPPED!! GET$ #f, 2, b$ 'mode '1 = single track, 2 = multiple tracks, synchronous, 3 = multiple tracks, asynchronous MODE = ASC(b$, 1) * 256 + ASC(b$, 2) IF MODE <> 1 THEN MSGBOX "Midi mode" + STR$(MODE) + " is not supported in" + FUNCNAME$,,FUNCNAME$: EXIT FUNCTION GET$ #f, 2, b$ 'nrtracks nrtracks = ASC(b$, 1) * 256 + ASC(b$, 2) IF tracknr > nrtracks THEN MSGBOX "There are only" + STR$(nrtracks) + " tracks in file " + fn + $CRLF + "You requested to read track " + STR$(tracknr),,FUNCNAME$: EXIT FUNCTION GET$ #f, 2,b$ '!!!we first should check dd: if it is negative, we have SMTP format.. (never encountered it yet..) mdd = ASC(b$, 1) * 255 + ASC(b$, 2) 'tiks/quaver logfile "tiks/quaver:" + STR$(mdd) IF mdd < 0 THEN MSGBOX "SMTP time format not supported yet in ",, FUNCNAME$: EXIT FUNCTION '===READ TRACKS ===================================================== 'we should read the time sig from track 0 here INCR trackcount 'track 1 evnt = 0 GET$ #f, 4, b$ IF b$ <> "MTrk" THEN MSGBOX "Track header expected in " + fn + $CRLF + LTrimZero(HEX$(ASC(b$, 1), 2))+ LtrimZero(HEX$(ASC(b$, 2), 2))+ LTrimZero(HEX$(ASC(b$, 3), 2))+ LTrimZero(HEX$(ASC(b$, 4), 2)) + b$,, FUNCNAME$ EXIT FUNCTION END IF GET$ #f, 4, b$ chunksize = &H01000000 * ASC(b$, 1) + &H010000 * ASC(b$, 2) + &H0100 * ASC(b$, 3) + ASC(b$, 4) 'copied from ParseMidiFule - can't we just Peek-Poke it? ' logfile "chunksize:" +STR$(chunksize) GET$ #f, chunksize, chunk$ ' ' logfile "chunk: " + chunk$ '-> chunk should be filled with time and tempo events.. ut insq() REDIM sq(LEN(chunk$)/2) '= zeker groter dan nodig, zodat we verder geen bounds checking meer moeten doen 'TODO SQ invullen met time events readtrack0time: INCR bytecount ' logfile "bytecount:" + STR$(bytecount) IF bytecount > LEN(chunk$) THEN MSGBOX "chunk length error in " + fn$,,FUNCNAME$ logfile "chunk length error - last valid byte= " + STR$(ASC(chunk$, bytecount-1)) EXIT FUNCTION END IF ev$ = MID$(chunk$, bytecount, 1) ' logfile "time byte" + ev$ tim$ = tim$ + CHR$(ASC(ev$) AND &H7F) x = ASC(ev$) IF BIT(x, 7) THEN GOTO readtrack0time FOR x = 1 TO LEN(tim$) currenttimetiks = currenttimetiks + ASC(tim$, x) * 2 ^ (7 * (LEN(tim$) - x)) 'this time we are not interested in absolute time but in measures and beats.. NEXT ' logfile "T:" + STR$(currenttimetiks) ' logfile "time: " + STR$(currenttimetiks) tim$ = "" 'next the event - can be a time sig or tempo in format 1 INCR bytecount ev$ = MID$(chunk$, bytecount,1) IF ev$ <> CHR$(&HFF) THEN MSGBOX "Error: non-meta event in track 0 in " + fn$,,FUNCNAME$: EXIT FUNCTION INCR bytecount ev$ = MID$(chunk$, bytecount,1) '&H58 voor time sig, &H51 vor tempo, &H5g key sig en andere meta events ' logfile "time:" + STR$(currenttimetiks) ' logfile "ev:" + STR$(ASC(Ev$)) +"-" + HEX$(ASC(ev$)) SELECT CASE ev$ CASE CHR$(&H2F): INCR bytecount REDIM PRESERVE sq(evnt-1) REDIM PRESERVE tempomap(tempocount - 1) REDIM PRESERVE tempotimestamp(tempocount - 1) ' logfile "this should be 0:" + STR$(ASC(chunk$, bytecount)) ' logfile "endoftrack" + STR$(bytecount) + STR$(LEN(chunk$)): GOTO endoftrack0 CASE CHR$(&H58) 'time sig - FF 58 04 nn dd cc bb ' logfile "time sig" INCR bytecount IF ASC(chunk$, bytecount) <> 04 THEN MSGBOX "File " + fn$ + " is corrupted! Invalid time sig",,FUNCNAME$: EXIT FUNCTION INCR bytecount sq(evnt).time = currenttimetiks ' logfile "tt" + STR$(sq(evnt).time) + " - " + STR$(currenttimetiks) sq(evnt).bstat = &H58 sq(evnt).bdat1 = ASC(chunk$, bytecount) 'nn INCR bytecount sq(evnt).bdat2 = ASC(chunk$, bytecount) 'dd INCR bytecount sq(evnt).extra = ASC(chunk$, bytecount) * &H100 + ASC(chunk$, bytecount + 1) 'cc + bb !!!!!!HIER KLOP NOG ETS NIET ' logfile "extra:" + STR$(sq(evnt).extra) ' logfile "tt" + STR$(sq(evnt).time) + " - " + STR$(currenttimetiks) INCR bytecount 'dit was de bug - hier stonden 2 INCR's iv 1 ' logfile "time sig:" + STR$(evnt) + STR$(sq(evnt).bstat) + STR$(sq(evnt).bdat1) + STR$(sq(evnt).bdat2) + " " + HEX$(sq(evnt).extra) INCR evnt CASE CHR$(&H051) 'tempo ' ! GET$ #f, 1, b$: INCR bytecount 'allways = 3 data bytes ' ! GET$ #f, 3, b$: INCR bytecount: INCR bytecount: INCR bytecount INCR bytecount 'allways 3 databytes INCR bytecount b$ = MID$(chunk$, bytecount, 3) INCR bytecount: INCR bytecount tempomap(tempocount) = 60000000 / (&H010000 * ASC(b$, 1) + &H0100 * ASC(b$, 2) + ASC(b$, 3)) '/ 1000 ' milliseconds/quarternote tempotimestamp(tempocount) = currenttimetiks ' logfile "tempo" + STR$(tempo) + " in track" + STR$(track) + "bytecount:" + STR$(bytecount) INCR tempocount IF tempocount > UBOUND(tempomap) THEN REDIM PRESERVE tempomap(tempocount + 10) REDIM PRESERVE tempotimestamp(tempocount + 10) END IF CASE CHR$(3) 'track name INCR bytecount x = ASC(chunk$, bytecount) ' logfile "trackname: '" + MID$(chunk$, bytecount + 1, x) + "'" bytecount = bytecount + x CASE ELSE 'we're not interested in otherevents ' logfile "other event" + STR$ (ASC(ev$)) INCR bytecount bytecount= bytecount + ASC(chunk$,bytecount) END SELECT IF bytecount > LEN(chunk$) THEN MSGBOX "chunk length error in " +fn$,,FUNCNAME$: EXIT FUNCTION GOTO readtrack0time endoftrack0: logfile "-----" logfile "sq type:" FOR x = LBOUND(sq) TO UBOUND(sq) logfile STR$(x) + STR$(sq(x).time) + STR$(sq(x).bdat1) + STR$(sq(x).bdat2) + " " + HEX$(sq(x).extra) NEXT logfile "-----" logfile "tempomap:" FOR x = LBOUND(tempomap) TO UBOUND(tempomap) logfile STR$(x) + STR$(tempotimestamp(x)) + STR$(tempomap(x)) NEXT logfile "" logfile "seek for desired track " + b$ DO INCR trackcount 'start counting @ 1 ' logfile " pass" + STR$(trackcount) GET$ #f, 4, b$ logfile b$ IF b$ <> "MTrk" THEN MSGBOX "Track header expected in " + fn + $CRLF + LTrimZero(HEX$(ASC(b$, 1), 2))+ LtrimZero(HEX$(ASC(b$, 2), 2))+ LTrimZero(HEX$(ASC(b$, 3), 2))+ LTrimZero(HEX$(ASC(b$, 4), 2)) + b$,, FUNCNAME$ logfile "this is not a trackheader!" ' logfile "next 5000 bytes:" GET$ #f, 5000, b$ logfile b$ EXIT FUNCTION END IF GET$ #f, 4, b$ chunksize = &H01000000 * ASC(b$, 1) + &H010000 * ASC(b$, 2) + &H0100 * ASC(b$, 3) + ASC(b$, 4) 'copied from ParseMidiFule - can't we just Peek-Poke it? ' logfile "chunksize:" + STR$(chunksize) GET$ #f, chunksize, chunk$ ' IF EOF(f) THEN MSGBOX "Track not found! Something's wrong with " + fn,,FUNCNAME$ EXIT FUNCTION END IF LOOP WHILE trackcount < tracknr CLOSE #f teller = sq(0).bdat1 noemer = sq(0).bdat1 REDIM tema(LEN(chunk$)/2) '= zeker groter dan nodig, zodat we verder geen bounds checking meer moeten doen Tema(0).maatnr = 1 Tema(0).tijdnr = 1 Tema(0).tiknr = 1 Tema(0).maatnn = sq(0).bDat1 Tema(0).maatdd = 2 ^ sq(0).bdat2 'here we convert from midi's power of 2 representation of the denominator Tema(0).maatlengte = mdd * 4 * Tema(0).maatnn / Tema(temacount).maatdd 'dd = ticks/quaver, read from Mthd headers Tema(0).tijdlengte = Tema(0).maatlengte / Tema(temacount).maatnn ' logfile "init tijdlengte:" + STR$(Tema(0).tijdlengte) '-------> Now we have our track in b$ 'we want to fill the following type: ' TYPE TemaType DWORD ' new 04.11.2004 ' noot AS INTEGER ' positive 0-127 = note, negative = rest(note implemented yet!) ' velo AS BYTE ' 0 - 127 ' duur AS DWORD ' duur in tiks voor die noot of rust ' tc AS INTEGER ' optioneel tonaal centrum (not implemented yet) -> midi file bevat alleen key sig - als de al ingevuld is.. dit invullen vereist dus analyse van de inhoud ' maatnn AS BYTE ' nominator ' maatdd AS BYTE ' denominator ' maatlengte AS DWORD ' aantal tiks per maat ' tijdlengte AS DWORD ' aantal tiks per tijd ' tempo AS DWORD ' MM getal voor tijdlengte ' cnt AS DWORD ' calculated on reading file data. current time in ticks ' maatnr AS DWORD ' normaal maatnummer: 1,2,3,4... berekend bij inlezen file ' tijdnr AS DWORD ' normaal tijdnummer: 1,2,3,4 berekend bij inlezen file ' tiknr AS DWORD ' tik binnen een tijd: 0,1,..... tijdlengte-1 berekend bij inlezen file ' END TYPE 'first get time bytecount = 0: evnt = 0: SqCount = 0: TempoCount = 0 currenttimetiks = 0 tim$ = "" readtime: ' logfile "*" INCR bytecount ' logfile "reading time @ byte" + STR$(bytecount) + " - " + hex$(asc(chunk$, bytecount)) IF bytecount > LEN(chunk$) THEN MSGBOX "chunk length error in " + fn$,,FUNCNAME$ EXIT FUNCTION END IF ev$ = MID$(chunk$, bytecount, 1) tim$ = tim$ + CHR$(ASC(ev$) AND &H7F) x = ASC(ev$) IF BIT(x, 7) THEN GOTO readtime FOR x = 1 TO LEN(tim$) currenttimetiks = currenttimetiks + ASC(tim$, x) * 2 ^ (7 * (LEN(tim$) - x)) 'this time we are not interested in absolute time but in measures and beats.. NEXT ' logfile "time:" + STR$(currenttimetiks) tim$ = "" ' IF (SqCount < UBOUND(sq)) AND (currentTimeTiks >= sq(SqCount + 1).time) THEN INCR sqcount IF (SqCount < UBOUND(sq)) THEN ' logfile " temptiks:" + STR$(temptiks) + " - next sq time:" + STR$(sq(sqcount + 1).time) IF (temptiks >= sq(SqCount + 1).time) THEN INCR sqcount ':logfile " next!" + STR$(sqcount) 'ook hier opletten voor obi1! END IF IF (TempoCount < UBOUND(tempoTimeStamp)) AND currenttimetiks >= TempoTimeStamp(TempoCount + 1) THEN INCR tempocount '-----get status and data byte..----------------------------------- INCR bytecount ' logfile "reading status? byte" + STR$(bytecount) + " " + hex$(asc(chunk$, bytecount)) IF ASC(chunk$, bytecount) > 127 THEN currentstatusbyte = ASC(chunk$, bytecount) ' logfile " status:" + HEX$(currentstatusbyte) ELSE ' logfile " no status - stays " + hex$(currentstatusbyte) DECR bytecount ' INCR bytecount deze stond hier teveel.. ' ELSE ' GOTO ReadData ?? END IF SELECT CASE currentstatusbyte CASE 255 'meatevent -> throw them away (xcept end of track) INCR bytecount IF ASC(chunk$, bytecount) = &H02F THEN INCR bytecount: GOTO endOfTrack 'end of track ' logfile "metaevent.." + HEX$(ASC(chunk, bytecount)) 'gt length: variable length quantity! b$ = "" ev$ ="" DO INCR bytecount b$ = b$ + CHR$(ASC(chunk$, bytecount) AND &H7F) ' logfile " '" + b$ + "'" LOOP WHILE ASC(chunk$, bytecount) > 127 ' logfile " length bytes:" + b$ bts = 0 FOR x = 1 TO LEN(b$) bts =bts + ASC(b$, x) * 2 ^ (7 * (LEN(b$) - x)) 'this time we are not interested in absolute time but in measures and beats.. NEXT ' logfile " size:" + STR$(bts) ' logfile " " + MID$(chunk$, bytecount, bts) bytecount = bytecount + bts GOTO readtime CASE &H0F0 'sysex ' logfile "sysx" DO INCR bytecount IF ASC(b$) = &H0F7 THEN GOTO Readtime LOOP WHILE ASC(chunk$, bytecount) <> &H0F7 GOTO readtime CASE &H0F2, &H0A0 TO &H0BF, &H0E0 TO &H0EF 'spp, att, cc, bend ' logfile "normal event, 2 dbytes" INCR bytecount: INCR bytecount GOTO readtime CASE &H0F3, &H0C0 TO &H0DF 'song select, progchange, channel pressure ' logfile "normal event, 1 dbbyte" INCR bytecount GOTO readtime CASE &H090 TO &H09F 'note on - this one we have to read ' logfile "note" IF ASC(chunk$, bytecount + 2) THEN '= if velo > 0 ' logfile " on" IF temacount THEN tema(temacount) = tema(temacount - 1) 'first we set it equal to the last one INCR bytecount Tema(temacount).noot = ASC(chunk$, bytecount) INCR bytecount Tema(temacount).velo = ASC(chunk$, bytecount) Tema(temacount).cnt = currenttimetiks 'barnr and time within bar 'first get difference in ticks from last event ticks = IIF(temacount, Tema(Temacount).cnt - Tema(Temacount-1).cnt, Tema(Temacount).cnt) 'now the tricky thing is that the time signature might have changed between the last note and this one. 'we presume it doesn't change before a bar is finnished (although in principle the midi fle format allows it! temptiks = CurrentTimeTiks ' logfile "enter loop" DO WHILE ticks 'TO DO!! HIER KLOPT NOG IETS NIET!! (@080605) ' logfile " ticks:" + str$(ticks) + " = " + str$(ticks/tema(temacount).maatlengte) + " maten = " + str$(ticks/tema(temacount).tijdlengte) + " beats" IF ticks > Tema(temacount).tijdlengte - Tema(temacount).tiknr THEN 'check this for obione errors!! ' logfile " tijdlengte:" + str$(Tema(temacount).tijdlengte) ' logfile " ticknr:" + str$(Tema(temacount).tiknr) ticks = ticks - ((Tema(temacount).tijdlengte - Tema(temacount).tiknr) + 1) '+ 1 omat tiknr vanaf 0 telt, niet vanaf 1 -> doublechck this temptiks = temptiks + (Tema(temacount).tijdlengte - Tema(temacount).tiknr + 1) ' logfile " new tiks - temptiks" + str$(ticks) + str$(temptiks) Tema(temacount).tiknr = 1 INCR Tema(temacount).tijdnr ' logfile "nxt beat:" + str$(Tema(temacount).tijdnr) IF Tema(temacount).tijdnr > Tema(temacount).maatnn THEN Tema(temacount).tijdnr = 1 INCR Tema(Temacount).maatnr ' logfile "nxt measure:" + str$(Tema(temacount).maatnr) 'check if timesig is changing in between the bars IF (SqCount < UBOUND(sq)) THEN ' logfile " temptiks:" + STR$(temptiks) + " - next sq time:" + STR$(sq(sqcount + 1).time) IF (temptiks >= sq(SqCount + 1).time) THEN INCR sqcount ':logfile " next!" + STR$(sqcount) 'ook hier opletten voor obi1! END IF END IF ELSE Tema(temacount).tiknr = Tema(temacount).tiknr + ticks ticks = 0 END IF LOOP ' logfile "xit loop" ' logfile "---" Tema(temacount).tempo = TempoMap(TempoCount) Tema(temacount).maatnn = sq(sqCount).bDat1 Tema(temacount).maatdd = 2 ^ sq(sqCount).bdat2 'here we convert from midi's power of 2 representation of the denominator Tema(temacount).maatlengte = mdd * 4 * Tema(temacount).maatnn / Tema(temacount).maatdd 'dd = ticks/quaver, read from Mthd headers Tema(temacount).tijdlengte = Tema(temacount).maatlengte / Tema(temacount).maatnn ' logfile "event:" + STR$(temacount) + ", time:" + STR$(currenttimetiks) + "tempo:" + STR$(Tema(temacount).tempo) ' logfile "n/v:" + STR$(Tema(temacount).noot) + STR$(tema(temacount).velo) ' logfile "maat:" + STR$(Tema(temacount).maatnn) + "/" + STR$(tema(temacount).maatdd) ' logfile "m:b:t" + STR$(Tema(temacount).maatnr) + ":" + STR$(tema(temacount).tijdnr) + ":" + STR$(tema(temacount).tiknr) ' logfile "---" INCR temacount ELSE INCR bytecount CountBack = Temacount DO IF Tema(CountBack).noot = ASC(chunk$, bytecount) THEN Tema(Countback).duur = CurrenttimeTiks - Tema(CountBack).cnt EXIT LOOP END IF DECR CountBack IF Countback < 0 THEN MSGBOX "No note on found for note off" + STR$(ASC(chunk$, bytecount)) EXIT FUNCTION END IF LOOP INCR bytecount '0 ' logfile " off" '!!!!! TO DO: noteoff -> fill in duration END IF ' logfile "to readtime" GOTO readtime CASE &H080 TO &H08F'note off ' logfile "noteoff &H080" INCR bytecount CountBack = Temacount DO IF Tema(CountBack).noot = ASC(chunk$, bytecount) THEN Tema(Countback).duur = CurrenttimeTiks - Tema(CountBack).cnt EXIT LOOP END IF DECR CountBack IF Countback < 0 THEN MSGBOX "No note on found for note off" + STR$(ASC(chunk$, bytecount)) EXIT FUNCTION END IF LOOP INCR bytecount 'velo, which we disregard here. 'fill in tema.duur GOTO readtime CASE ELSE MSGBOX "error: unexpected statusbyte: " + HEX$(currentstatusbyte) + $CRLF + "Fileparsing aborted",,FUNCNAME$ EXIT FUNCTION END SELECT '&H080 note off, &H090 on ' logfile "whatarewedoinghere?" readdata: 'databytes endOfTrack: REDIM PRESERVE Tema(temacount-1) logfile "---summary---" FOR temacount = LBOUND(tema) TO UBOUND(tema) logfile "event:" + STR$(temacount) + ", time:" + STR$(tema(temacount).cnt) + "tempo:" + STR$(Tema(temacount).tempo) logfile "n/v:" + STR$(Tema(temacount).noot) + STR$(tema(temacount).velo) logfile "maat:" + STR$(Tema(temacount).maatnn) + "/" + STR$(tema(temacount).maatdd) logfile "duur:" + STR$(Tema(temacount).duur) logfile "m:b:t" + STR$(Tema(temacount).maatnr) + ":" + STR$(tema(temacount).tijdnr) + ":" + STR$(tema(temacount).tiknr) logfile "---" NEXT FUNCTION = UBOUND(tema) END FUNCTION '#if %def(%hieraanzijnwebezigenhetzuniecompilerenznderdezemetaif) FUNCTION ReadTrackFromMidiFile(BYVAL fn AS STRING,BYVAL tracknr AS WORD, BYREF Ht() AS HarTimeType) EXPORT AS LONG 'parses one track of a midi file into a HarTime type (which is the harmonic version of gwr's theme type) 'noteon/offs hapening simultaneously are merged into one event 'only works on type 1 midifiles! 'note: track 1 in a type 1 midifile only contains a tempo map and meta events, so this function will not accept it 'returns 0 on failure, otherwise the nr of events LOCAL f AS LONG 'input file LOCAL b$, t$, chunk$, ev$, tim$ LOCAL ticks AS DWORD LOCAL MODE AS WORD 'midi mode, 0/1/2 LOCAL nrtracks AS WORD LOCAL mdd AS INTEGER 'midi delta time ticks per quarter note LOCAL chunksize AS DWORD 'in bytes, 1 chunk = 1 track LOCAL currenttimetiks AS DWORD 'ms LOCAL temptiks AS DWORD LOCAL bytecount AS DWORD 'within chunk LOCAL cevents AS DWORD 'counter for all events in file LOCAL currentstatusbyte AS BYTE 'we must remember this for running status LOCAL trackcount AS WORD LOCAL evnt AS DWORD LOCAL mevnt AS DWORD 'meta event -> time sgnature map LOCAL x AS BYTE LOCAL sq() AS parsedmiditype 'only to hold time sigs LOCAL tempomap() AS DOUBLE 'in type 1 files: read from track 0, apply to other tracks LOCAL tempotimestamp() AS DOUBLE 'time at which tempo changes LOCAL tempocount AS DWORD 'counter within tempo related arrays (c.s.) LOCAL teller AS WORD LOCAL noemer AS WORD LOCAL TemaCount AS DWORD LOCAL CountBack AS LONG 'sic long! LOCAL SqCount AS DWORD LOCAL bts AS LONG LOCAL noot AS BYTE LOCAL velo AS BYTE REDIM tempomap(10) REDIM tempotimestamp(10) f = FREEFILE OPEN fn FOR BINARY ACCESS READ LOCK WRITE AS f IF ISFALSE tracknr THEN MSGBOX "tracknr can not be 0!",,FUNCNAME$: EXIT FUNCTION IF ERRCLEAR THEN MSGBOX "midi file " + fn + " not found",,FUNCNAME$ EXIT FUNCTION END IF '===READ HEADER======================================================= GET$ #f, 8, b$ IF b$ <> "MThd" + CHR$(0, 0, 0, 6) THEN MSGBOX fn + " does not have a valid midi file header!",,FUNCNAME$ EXIT FUNCTION END IF ' get #f, , mode GETS THE BYTES SWAPPED!! GET$ #f, 2, b$ 'mode '1 = single track, 2 = multiple tracks, synchronous, 3 = multiple tracks, asynchronous MODE = ASC(b$, 1) * 256 + ASC(b$, 2) IF MODE <> 1 THEN MSGBOX "Midi mode" + STR$(MODE) + " is not supported in" + FUNCNAME$,,FUNCNAME$: EXIT FUNCTION IF tracknr = 1 THEN MSGBOX "Track 1 just contains the tempo map and meta information in midi format 1, no notes",,FUNCNAME$: EXIT FUNCTION GET$ #f, 2, b$ 'nrtracks nrtracks = ASC(b$, 1) * 256 + ASC(b$, 2) IF tracknr > nrtracks THEN MSGBOX "There are only" + STR$(nrtracks) + " tracks in file " + fn + $CRLF + "You requested to read track " + STR$(tracknr),,FUNCNAME$: EXIT FUNCTION GET$ #f, 2,b$ '!!!we first should check dd: if it is negative, we have SMTP format.. (never encountered it yet..) mdd = ASC(b$, 1) * 255 + ASC(b$, 2) 'tiks/quaver logfile "tiks/quaver:" + STR$(mdd) IF mdd < 0 THEN MSGBOX "SMTP time format not supported yet in ",, FUNCNAME$: EXIT FUNCTION '===READ TRACKS ===================================================== 'weshould read the time sig from track 0 here INCR trackcount 'track 1 evnt = 0 GET$ #f, 4, b$ IF b$ <> "MTrk" THEN MSGBOX "Track header expected in " + fn + $CRLF + LTrimZero(HEX$(ASC(b$, 1), 2))+ LtrimZero(HEX$(ASC(b$, 2), 2))+ LTrimZero(HEX$(ASC(b$, 3), 2))+ LTrimZero(HEX$(ASC(b$, 4), 2)) + b$,, FUNCNAME$ EXIT FUNCTION END IF GET$ #f, 4, b$ chunksize = &H01000000 * ASC(b$, 1) + &H010000 * ASC(b$, 2) + &H0100 * ASC(b$, 3) + ASC(b$, 4) 'copied from ParseMidiFule - can't we just Peek-Poke it? ' logfile "chunksize:" +STR$(chunksize) GET$ #f, chunksize, chunk$ ' ' logfile "chunk: " + chunk$ '-> chunk should be filled with time and tempo events.. ut insq() REDIM sq(LEN(chunk$)/2) '= zeker groter dan nodig, zodat we verder geen bounds checking meer moeten doen 'TODO SQ invullen met time events readtrack0time: INCR bytecount ' logfile "bytecount:" + STR$(bytecount) IF bytecount > LEN(chunk$) THEN MSGBOX "chunk length error in " + fn$,,FUNCNAME$ logfile "chunk length error - last valid byte= " + STR$(ASC(chunk$, bytecount-1)) EXIT FUNCTION END IF ev$ = MID$(chunk$, bytecount, 1) ' logfile "time byte" + ev$ tim$ = tim$ + CHR$(ASC(ev$) AND &H7F) x = ASC(ev$) IF BIT(x, 7) THEN GOTO readtrack0time FOR x = 1 TO LEN(tim$) currenttimetiks = currenttimetiks + ASC(tim$, x) * 2 ^ (7 * (LEN(tim$) - x)) 'this time we are not interested in absolute time but in measures and beats.. NEXT ' logfile "T:" + STR$(currenttimetiks) ' logfile "time: " + STR$(currenttimetiks) tim$ = "" 'next the event - can be a time sig or tempo in format 1 INCR bytecount ev$ = MID$(chunk$, bytecount,1) IF ev$ <> CHR$(&HFF) THEN MSGBOX "Error: non-meta event in track 0 in " + fn$,,FUNCNAME$: EXIT FUNCTION INCR bytecount ev$ = MID$(chunk$, bytecount,1) '&H58 voor time sig, &H51 vor tempo, &H5g key sig en andere meta events ' logfile "time:" + STR$(currenttimetiks) ' logfile "ev:" + STR$(ASC(Ev$)) +"-" + HEX$(ASC(ev$)) SELECT CASE ev$ CASE CHR$(&H2F): INCR bytecount REDIM PRESERVE sq(evnt-1) REDIM PRESERVE tempomap(tempocount - 1) REDIM PRESERVE tempotimestamp(tempocount - 1) ' logfile "this should be 0:" + STR$(ASC(chunk$, bytecount)) ' logfile "endoftrack" + STR$(bytecount) + STR$(LEN(chunk$)): GOTO endoftrack0 CASE CHR$(&H58) 'time sig - FF 58 04 nn dd cc bb ' logfile "time sig" INCR bytecount IF ASC(chunk$, bytecount) <> 04 THEN MSGBOX "File " + fn$ + " is corrupted! Invalid time sig",,FUNCNAME$: EXIT FUNCTION INCR bytecount sq(evnt).time = currenttimetiks ' logfile "tt" + STR$(sq(evnt).time) + " - " + STR$(currenttimetiks) sq(evnt).bstat = &H58 sq(evnt).bdat1 = ASC(chunk$, bytecount) 'nn INCR bytecount sq(evnt).bdat2 = ASC(chunk$, bytecount) 'dd INCR bytecount sq(evnt).extra = ASC(chunk$, bytecount) * &H100 + ASC(chunk$, bytecount + 1) 'cc + bb !!!!!!HIER KLOP NOG ETS NIET ' logfile "extra:" + STR$(sq(evnt).extra) ' logfile "tt" + STR$(sq(evnt).time) + " - " + STR$(currenttimetiks) INCR bytecount 'dit was de bug - hier stonden 2 INCR's iv 1 ' logfile "time sig:" + STR$(evnt) + STR$(sq(evnt).bstat) + STR$(sq(evnt).bdat1) + STR$(sq(evnt).bdat2) + " " + HEX$(sq(evnt).extra) INCR evnt CASE CHR$(&H051) 'tempo ' ! GET$ #f, 1, b$: INCR bytecount 'allways = 3 data bytes ' ! GET$ #f, 3, b$: INCR bytecount: INCR bytecount: INCR bytecount INCR bytecount 'allways 3 databytes INCR bytecount b$ = MID$(chunk$, bytecount, 3) INCR bytecount: INCR bytecount tempomap(tempocount) = 60000000 / (&H010000 * ASC(b$, 1) + &H0100 * ASC(b$, 2) + ASC(b$, 3)) '/ 1000 ' milliseconds/quarternote tempotimestamp(tempocount) = currenttimetiks ' logfile "tempo" + STR$(tempo) + " in track" + STR$(track) + "bytecount:" + STR$(bytecount) INCR tempocount IF tempocount > UBOUND(tempomap) THEN REDIM PRESERVE tempomap(tempocount + 10) REDIM PRESERVE tempotimestamp(tempocount + 10) END IF CASE CHR$(3) 'track name INCR bytecount x = ASC(chunk$, bytecount) ' logfile "trackname: '" + MID$(chunk$, bytecount + 1, x) + "'" bytecount = bytecount + x CASE ELSE 'we're not interested in otherevents ' logfile "other event" + STR$ (ASC(ev$)) INCR bytecount bytecount= bytecount + ASC(chunk$,bytecount) END SELECT IF bytecount > LEN(chunk$) THEN MSGBOX "chunk length error in " +fn$,,FUNCNAME$: EXIT FUNCTION GOTO readtrack0time endoftrack0: logfile "-----" logfile "sq type:" FOR x = LBOUND(sq) TO UBOUND(sq) logfile STR$(x) + STR$(sq(x).time) + STR$(sq(x).bdat1) + STR$(sq(x).bdat2) + " " + HEX$(sq(x).extra) NEXT logfile "-----" logfile "tempomap:" FOR x = LBOUND(tempomap) TO UBOUND(tempomap) logfile STR$(x) + STR$(tempotimestamp(x)) + STR$(tempomap(x)) NEXT logfile "" logfile "seek for desired track " + STR$(tracknr) '!!!!!!!!!! in de loop hieronder gaat iets mis!!!!!!!!!!!!!!!!!!!!!!! DO INCR trackcount 'start counting @ 1 ' logfile " pass" + STR$(trackcount) GET$ #f, 4, b$ logfile b$ IF b$ <> "MTrk" THEN MSGBOX "Track header expected in " + fn + $CRLF + LTrimZero(HEX$(ASC(b$, 1), 2))+ LtrimZero(HEX$(ASC(b$, 2), 2))+ LTrimZero(HEX$(ASC(b$, 3), 2))+ LTrimZero(HEX$(ASC(b$, 4), 2)) + b$,, FUNCNAME$ logfile "this is not a trackheader!" ' logfile "next 5000 bytes:" GET$ #f, 5000, b$ logfile b$ EXIT FUNCTION END IF GET$ #f, 4, b$ chunksize = &H01000000 * ASC(b$, 1) + &H010000 * ASC(b$, 2) + &H0100 * ASC(b$, 3) + ASC(b$, 4) 'copied from ParseMidiFule - can't we just Peek-Poke it? logfile "chunksize:" + STR$(chunksize) GET$ #f, chunksize, chunk$ logfile "chunk: " + chunk$ ' IF EOF(f) THEN MSGBOX "Track not found! Something's wrong with " + fn,,FUNCNAME$ EXIT FUNCTION END IF LOOP WHILE trackcount < tracknr logfile "out of loop" CLOSE #f teller = sq(0).bdat1 noemer = sq(0).bdat1 REDIM HT(LEN(chunk$)/2) '= zeker groter dan nodig, zodat we verder geen bounds checking meer moeten doen HT(0).maatnr = 1 HT(0).tijdnr = 1 HT(0).tiknr = 1 HT(0).maatnn = sq(0).bDat1 HT(0).maatdd = 2 ^ sq(0).bdat2 'here we convert from midi's power of 2 representation of the denominator HT(0).maatlengte = mdd * 4 * HT(0).maatnn / HT(temacount).maatdd 'dd = ticks/quaver, read from Mthd headers HT(0).tijdlengte = HT(0).maatlengte / HT(temacount).maatnn ' logfile "init tijdlengte:" + STR$(Tema(0).tijdlengte) '-------> Now we have our track in b$ 'we want to fill the following type: ' TYPE TemaType DWORD ' new 04.11.2004 ' noot AS INTEGER ' positive 0-127 = note, negative = rest(note implemented yet!) ' velo AS BYTE ' 0 - 127 ' duur AS DWORD ' duur in tiks voor die noot of rust ' tc AS INTEGER ' optioneel tonaal centrum (not implemented yet) -> midi file bevat alleen key sig - als de al ingevuld is.. dit invullen vereist dus analyse van de inhoud ' maatnn AS BYTE ' nominator ' maatdd AS BYTE ' denominator ' maatlengte AS DWORD ' aantal tiks per maat ' tijdlengte AS DWORD ' aantal tiks per tijd ' tempo AS DWORD ' MM getal voor tijdlengte ' cnt AS DWORD ' calculated on reading file data. current time in ticks ' maatnr AS DWORD ' normaal maatnummer: 1,2,3,4... berekend bij inlezen file ' tijdnr AS DWORD ' normaal tijdnummer: 1,2,3,4 berekend bij inlezen file ' tiknr AS DWORD ' tik binnen een tijd: 0,1,..... tijdlengte-1 berekend bij inlezen file ' END TYPE 'first get time bytecount = 0: evnt = 0: SqCount = 0: TempoCount = 0 currenttimetiks = 0 tim$ = "" readtime: ' logfile "*" INCR bytecount logfile "reading time @ byte" + STR$(bytecount) + " - " + HEX$(ASC(chunk$, bytecount)) IF bytecount > LEN(chunk$) THEN MSGBOX "chunk length error in " + fn$,,FUNCNAME$ EXIT FUNCTION END IF ev$ = MID$(chunk$, bytecount, 1) tim$ = tim$ + CHR$(ASC(ev$) AND &H7F) x = ASC(ev$) IF BIT(x, 7) THEN GOTO readtime FOR x = 1 TO LEN(tim$) currenttimetiks = currenttimetiks + ASC(tim$, x) * 2 ^ (7 * (LEN(tim$) - x)) 'this time we are not interested in absolute time but in measures and beats.. NEXT logfile "time:" + STR$(currenttimetiks) tim$ = "" ' IF (SqCount < UBOUND(sq)) AND (currentTimeTiks >= sq(SqCount + 1).time) THEN INCR sqcount IF (SqCount < UBOUND(sq)) THEN logfile " temptiks:" + STR$(temptiks) + " - next sq time:" + STR$(sq(sqcount + 1).time) IF (temptiks >= sq(SqCount + 1).time) THEN INCR sqcount :logfile " next!" + STR$(sqcount) 'ook hier opletten voor obi1! END IF IF (TempoCount < UBOUND(tempoTimeStamp)) AND currenttimetiks >= TempoTimeStamp(TempoCount + 1) THEN INCR tempocount '-----get status and data byte..----------------------------------- INCR bytecount logfile "reading status? byte" + STR$(bytecount) + " " + HEX$(ASC(chunk$, bytecount)) IF ASC(chunk$, bytecount) > 127 THEN currentstatusbyte = ASC(chunk$, bytecount) logfile " status:" + HEX$(currentstatusbyte) ELSE logfile " no status - stays " + HEX$(currentstatusbyte) DECR bytecount ' INCR bytecount deze stond hier teveel.. ' ELSE ' GOTO ReadData ?? END IF SELECT CASE currentstatusbyte CASE 255 'meatevent -> throw them away (xcept end of track) INCR bytecount IF ASC(chunk$, bytecount) = &H02F THEN INCR bytecount: GOTO endOfTrack 'end of track ' logfile "metaevent.." + HEX$(ASC(chunk, bytecount)) 'gt length: variable length quantity! b$ = "" ev$ ="" DO INCR bytecount b$ = b$ + CHR$(ASC(chunk$, bytecount) AND &H7F) ' logfile " '" + b$ + "'" LOOP WHILE ASC(chunk$, bytecount) > 127 logfile " length bytes:" + b$ bts = 0 FOR x = 1 TO LEN(b$) bts =bts + ASC(b$, x) * 2 ^ (7 * (LEN(b$) - x)) 'this time we are not interested in absolute time but in measures and beats.. NEXT ' logfile " size:" + STR$(bts) ' logfile " " + MID$(chunk$, bytecount, bts) bytecount = bytecount + bts GOTO readtime CASE &H0F0 'sysex ' logfile "sysx" DO INCR bytecount IF ASC(b$) = &H0F7 THEN GOTO Readtime LOOP WHILE ASC(chunk$, bytecount) <> &H0F7 GOTO readtime CASE &H0F2, &H0A0 TO &H0BF, &H0E0 TO &H0EF 'spp, att, cc, bend ' logfile "normal event, 2 dbytes" INCR bytecount: INCR bytecount GOTO readtime CASE &H0F3, &H0C0 TO &H0DF 'song select, progchange, channel pressure ' logfile "normal event, 1 dbbyte" INCR bytecount GOTO readtime CASE &H090 TO &H09F 'note on - this one we have to read logfile "note" IF ASC(chunk$, bytecount + 2) THEN '= if velo > 0 IF temacount THEN HT(temacount) = HT(temacount - 1) 'first we set it equal to the last one INCR bytecount noot = ASC(chunk$, bytecount) INCR bytecount velo = ASC(chunk$, bytecount) logfile " on" + STR$(noot) + STR$(velo) ' AddNote2Har HT(temacount).h, noot, velo MID$(HT(temacount).h.vel, noot+1) = CHR$(Velo) HT(temacount).cnt = currenttimetiks 'barnr and time within bar 'first get difference in ticks from last event ticks = IIF(temacount, HT(Temacount).cnt - HT(Temacount-1).cnt, HT(Temacount).cnt) 'now the tricky thing is that the time signature might have changed between the last note and this one. 'we presume it doesn't change before a bar is finnished (although in principle the midi file format allows it! temptiks = CurrentTimeTiks logfile "enter loop" DO WHILE ticks 'TO DO!! HIER KLOPT NOG IETS NIET!! (@080605) logfile " ticks:" + STR$(ticks) + " = " + STR$(ticks/HT(temacount).maatlengte) + " maten = " + STR$(ticks/HT(temacount).tijdlengte) + " beats" IF ticks > HT(temacount).tijdlengte - HT(temacount).tiknr THEN 'check this for obione errors!! ' logfile " tijdlengte:" + str$(Tema(temacount).tijdlengte) ' logfile " ticknr:" + str$(Tema(temacount).tiknr) ticks = ticks - ((HT(temacount).tijdlengte - HT(temacount).tiknr) + 1) '+ 1 omat tiknr vanaf 0 telt, niet vanaf 1 -> doublechck this temptiks = temptiks + (HT(temacount).tijdlengte - HT(temacount).tiknr + 1) ' logfile " new tiks - temptiks" + str$(ticks) + str$(temptiks) HT(temacount).tiknr = 1 INCR HT(temacount).tijdnr ' logfile "nxt beat:" + str$(Tema(temacount).tijdnr) IF HT(temacount).tijdnr > HT(temacount).maatnn THEN HT(temacount).tijdnr = 1 INCR HT(Temacount).maatnr ' logfile "nxt measure:" + str$(Tema(temacount).maatnr) 'check if timesig is changing in between the bars IF (SqCount < UBOUND(sq)) THEN ' logfile " temptiks:" + STR$(temptiks) + " - next sq time:" + STR$(sq(sqcount + 1).time) IF (temptiks >= sq(SqCount + 1).time) THEN INCR sqcount ':logfile " next!" + STR$(sqcount) 'ook hier opletten voor obi1! END IF END IF ELSE HT(temacount).tiknr = HT(temacount).tiknr + ticks ticks = 0 END IF LOOP logfile "xit loop" ' logfile "---" HT(temacount).tempo = TempoMap(TempoCount) HT(temacount).maatnn = sq(sqCount).bDat1 HT(temacount).maatdd = 2 ^ sq(sqCount).bdat2 'here we convert from midi's power of 2 representation of the denominator HT(temacount).maatlengte = mdd * 4 * HT(temacount).maatnn / HT(temacount).maatdd 'dd = ticks/quaver, read from Mthd headers HT(temacount).tijdlengte = HT(temacount).maatlengte / HT(temacount).maatnn ' logfile "event:" + STR$(temacount) + ", time:" + STR$(currenttimetiks) + "tempo:" + STR$(Tema(temacount).tempo) ' logfile "n/v:" + STR$(Tema(temacount).noot) + STR$(tema(temacount).velo) ' logfile "maat:" + STR$(Tema(temacount).maatnn) + "/" + STR$(tema(temacount).maatdd) ' logfile "m:b:t" + STR$(Tema(temacount).maatnr) + ":" + STR$(tema(temacount).tijdnr) + ":" + STR$(tema(temacount).tiknr) ' logfile "---" IF (temacount > 0) AND (HT(temacount).cnt = HT(Temacount-1).cnt) THEN ARRAY DELETE HT(temacount-1) 'aangevuld met een nieuwe noot(off) in HT(temacount) ... ELSE INCR temacount END IF ELSE logfile "off" +STR$(ASC(chunk$, bytecount + 1)) logfile "current bytecount:" + STR$(bytecount) IF temacount THEN HT(temacount) = HT(temacount - 1) 'del note from har - we rem the counting back, although we could do it for each note in the har.. 'DelNote2Har HT(temacount).har, asc(chunk$, bytecount) HT(temacount).cnt = currenttimetiks INCR bytecount MID$(HT(temacount).h.vel, ASC(chunk$, bytecount) + 1) = CHR$(0) IF temacount THEN HT(temacount) = HT(temacount - 1) INCR bytecount '0 ticks = IIF(temacount, HT(Temacount).cnt - HT(Temacount-1).cnt, HT(Temacount).cnt) 'now the tricky thing is that the time signature might have changed between the last note and this one. 'we presume it doesn't change before a bar is finnished (although in principle the midi file format allows it! temptiks = CurrentTimeTiks logfile "enter loop" DO WHILE ticks 'TO DO!! HIER KLOPT NOG IETS NIET!! (@080605) logfile "tiks:" + STR$(ticks) IF ticks > HT(temacount).tijdlengte - HT(temacount).tiknr THEN 'check this for obione errors!! logfile "recompute ticks with" + STR$(HT(temacount).tijdlengte) + STR$(HT(temacount).tiknr) ticks = ticks - ((HT(temacount).tijdlengte - HT(temacount).tiknr) + 1) '+ 1 omat tiknr vanaf 0 telt, niet vanaf 1 -> doublechck this IF ticks < 0 THEN Warning "ERR: ticks became " + STR$(ticks): EXIT FUNCTION temptiks = temptiks + (HT(temacount).tijdlengte - HT(temacount).tiknr + 1) HT(temacount).tiknr = 1 INCR HT(temacount).tijdnr IF HT(temacount).tijdnr > HT(temacount).maatnn THEN HT(temacount).tijdnr = 1 INCR HT(Temacount).maatnr 'check if timesig is changing in between the bars IF (SqCount < UBOUND(sq)) THEN IF (temptiks >= sq(SqCount + 1).time) THEN INCR sqcount ':logfile " next!" + STR$(sqcount) 'ook hier opletten voor obi1! END IF END IF ELSE logfile "ticks used up" HT(temacount).tiknr = HT(temacount).tiknr + ticks ticks = 0 END IF LOOP logfile "xit loop" logfile "---" HT(temacount).tempo = TempoMap(TempoCount) HT(temacount).maatnn = sq(sqCount).bDat1 HT(temacount).maatdd = 2 ^ sq(sqCount).bdat2 'here we convert from midi's power of 2 representation of the denominator HT(temacount).maatlengte = mdd * 4 * HT(temacount).maatnn / HT(temacount).maatdd 'dd = ticks/quaver, read from Mthd headers HT(temacount).tijdlengte = HT(temacount).maatlengte / HT(temacount).maatnn IF (temacount > 0) AND (HT(temacount).cnt = HT(Temacount-1).cnt) THEN ARRAY DELETE HT(temacount-1) 'aangevuld met een nieuwe noot(off) in HT(temacount) ... ELSE INCR temacount END IF '!!!!! TO DO: noteoff -> fill in duration END IF logfile "*****res" + STR$(temacount-1) + ".har: " + HT(temacount-1).h.vel ' logfile "to readtime" GOTO readtime CASE &H080 TO &H08F'note off logfile "noteoff &H080" ' '***was this the missing part??? IF temacount THEN HT(temacount) = HT(temacount - 1) HT(temacount).cnt = currenttimetiks '*** INCR bytecount 'DelNote2Har HT(temacount).har, asc(chunk$, bytecount) MID$(HT(temacount).h.vel, ASC(chunk$, bytecount) + 1) = CHR$(0) logfile " -> note" + STR$(ASC(chunk$, bytecount) + 1) INCR bytecount ' INCR bytecount 'was deze er teveel aan? ticks = IIF(temacount, HT(Temacount).cnt - HT(Temacount-1).cnt, HT(Temacount).cnt) logfile "compu:" + STR$(temacount) + STR$(HT(Temacount).cnt) + STR$(HT(Temacount-1).cnt) 'now the tricky thing is that the time signature might have changed between the last note and this one. 'we presume it doesn't change before a bar is finnished (although in principle the midi file format allows it! temptiks = CurrentTimeTiks DO WHILE ticks 'TO DO!! HIER KLOPT NOG IETS NIET!! (@080605) logfile "ticks" + STR$(ticks) IF ticks > HT(temacount).tijdlengte - HT(temacount).tiknr THEN 'check this for obione errors!! logfile "recompute ticks with" + STR$(HT(temacount).tijdlengte) + STR$(HT(temacount).tiknr) ticks = ticks - ((HT(temacount).tijdlengte - HT(temacount).tiknr) + 1) '+ 1 omat tiknr vanaf 0 telt, niet vanaf 1 -> doublechck this IF ticks < 0 THEN Warning "ERR: ticks became " + STR$(ticks): EXIT FUNCTION temptiks = temptiks + (HT(temacount).tijdlengte - HT(temacount).tiknr + 1) HT(temacount).tiknr = 1 INCR HT(temacount).tijdnr IF HT(temacount).tijdnr > HT(temacount).maatnn THEN HT(temacount).tijdnr = 1 INCR HT(Temacount).maatnr 'check if timesig is changing in between the bars IF (SqCount < UBOUND(sq)) THEN IF (temptiks >= sq(SqCount + 1).time) THEN INCR sqcount ':logfile " next!" + STR$(sqcount) 'ook hier opletten voor obi1! END IF END IF ELSE logfile "ticks used up" HT(temacount).tiknr = HT(temacount).tiknr + ticks ticks = 0 END IF 'DEBUG ONLY ' exit loop 'END DEBUG ONLY LOOP logfile "---" HT(temacount).tempo = TempoMap(TempoCount) HT(temacount).maatnn = sq(sqCount).bDat1 HT(temacount).maatdd = 2 ^ sq(sqCount).bdat2 'here we convert from midi's power of 2 representation of the denominator HT(temacount).maatlengte = mdd * 4 * HT(temacount).maatnn / HT(temacount).maatdd 'dd = ticks/quaver, read from Mthd headers HT(temacount).tijdlengte = HT(temacount).maatlengte / HT(temacount).maatnn IF (temacount > 0) AND (HT(temacount).cnt = HT(Temacount-1).cnt) THEN ARRAY DELETE HT(temacount-1) 'aangevuld met een nieuwe noot(off) in HT(temacount) ... ELSE INCR temacount END IF ' CountBack = Temacount ' DO ' IF Tema(CountBack).noot = ASC(chunk$, bytecount) THEN ' Tema(Countback).duur = CurrenttimeTiks - Tema(CountBack).cnt ' EXIT LOOP ' END IF ' DECR CountBack ' IF Countback < 0 THEN ' MSGBOX "No note on found for note off" + STR$(ASC(chunk$, bytecount)) ' EXIT FUNCTION ' END IF ' LOOP ' ' INCR bytecount 'velo, which we disregard here. logfile "****** res" + STR$(temacount-1) + ".har: " + HT(temacount-1).h.vel logfile "current bytecount:" + STR$(bytecount) logfile "next bytes:" + HEX$(ASC(chunk$, bytecount)) + HEX$(ASC(chunk$, bytecount+1))+ HEX$(ASC(chunk$, bytecount+2)) logfile "----" 'fill in tema.duur GOTO readtime CASE ELSE MSGBOX "error: unexpected statusbyte: " + HEX$(currentstatusbyte) + $CRLF + "Fileparsing aborted",,FUNCNAME$ EXIT FUNCTION END SELECT '&H080 note off, &H090 on ' logfile "whatarewedoinghere?" readdata: 'databytes endOfTrack: REDIM PRESERVE HT(temacount-1) logfile "---summary---" FOR temacount = LBOUND(Ht) TO UBOUND(Ht) logfile "event:" + STR$(temacount) + ", time:" + STR$(HT(temacount).cnt) + "tempo:" + STR$(HT(temacount).tempo) logfile "h:" + HT(temacount).h logfile "maat:" + STR$(HT(temacount).maatnn) + "/" + STR$(HT(temacount).maatdd) ' logfile "duur:" + STR$(HT(temacount).duur) logfile "m:b:t" + STR$(HT(temacount).maatnr) + ":" + STR$(HT(temacount).tijdnr) + ":" + STR$(HT(temacount).tiknr) logfile "---" NEXT FUNCTION = UBOUND(HT) END FUNCTION '#endif FUNCTION ParseMidifile(BYVAL fn AS STRING, BYREF sq() AS ParsedMidiType, BYREF info AS STRING, BYREF trackinfo AS STRING) EXPORT AS LONG 'parses midifile fn and translates to parsedmiditype 'returns nr of events on success, otherwise 0 '030709 seems to work ok now - still need some more debugging? 'hangs on at least one of sebastians's files cakepro doesn't want to read (after reading it correctly half the way..) 'info wordt ingevuld met de inhoud van verschillende tekst events, gescheiden door chr$(1) 'trackinfo : tracknr + chr$(1) + trackname [+ chr$(1) + tracknr etc...] '050901: adding support for markers - deleted again - caused big overload, and they where unuseable because they where timed inprecisely in sonar '080603 !!!!!!!!!!!!!!!!!! while writing ReadVoiceFromMidifile, we discovered a potential bug in the meta event handling: 'length of meta events is not handled like a variable length quantity, while it should ' this may create errors in files with big text bits etc. - TO BE DEBUGGED '080610: meta event bug solved but to be checked LOCAL f AS LONG 'input file LOCAL f2 AS LONG 'debug log file LOCAL b$, t$ LOCAL x AS BYTE LOCAL i AS LONG LOCAL MODE AS WORD 'midi mode, 0/1/2 LOCAL nrtracks AS WORD LOCAL mdd AS INTEGER 'midi delta time ticks per quarter note LOCAL chunksize AS DWORD 'in bytes, 1 chunk = 1 track LOCAL currenttimetiks AS DWORD 'ms LOCAL bytecount AS DWORD 'within chunk LOCAL cevents AS DWORD 'counter for all events in file LOCAL tempo AS DOUBLE 'read as microseconds / quaver!! > internally convert to ms/quaver LOCAL tempomap() AS DOUBLE 'in type 1 files: read from track 0, apply to other tracks LOCAL tempotimestamp() AS DOUBLE 'time at which tempo changes LOCAL tempocount AS DWORD 'counter within tempo related arrays (c.s.) LOCAL track AS BYTE LOCAL currentstatusbyte AS BYTE 'we must remember this for running status LOCAL resettime AS WORD 'flag for when we're reading a new track LOCAL times() AS SINGLE 'copy of sq().time for sorting purposes.. LOCAL bts AS LONG ' STATIC markers AS STRING REDIM sq(1000) REDIM times(1000) REDIM tempomap(10) REDIM tempotimestamp(10) DIALOG DOEVENTS ON ERROR GOTO failed tempo = 500 f = FREEFILE OPEN fn FOR BINARY ACCESS READ LOCK WRITE AS f IF ERRCLEAR THEN MSGBOX "midi file " + fn + " not found",,FUNCNAME$ EXIT FUNCTION END IF '===READ HEADER======================================================= GET$ #f, 8, b$ IF b$ <> "MThd" + CHR$(0, 0, 0, 6) THEN Warning fn + " does not have a valid midi file header!", 10000 midilogfile fn + " does not have a valid midi file header!" EXIT FUNCTION END IF ' get #f, , mode GETS THE BYTES SWAPPED!! GET$ #f, 2, b$ 'mode '1 = single track, 2 = multiple tracks, synchronous, 3 = multiple tracks, asynchronous MODE = ASC(b$, 1) * 256 + ASC(b$, 2) IF MODE > 2 THEN midilogfile "Midi mode" + STR$(MODE) + " is not supported in" + FUNCNAME$: EXIT FUNCTION GET$ #f, 2, b$ 'nrtracks nrtracks = ASC(b$, 1) * 256 + ASC(b$, 2) GET$ #f, 2,b$ '!!!we first should check dd: if it is negative, we have SMTP format.. (never encountered it yet..) mdd = ASC(b$, 1) * 255 + ASC(b$, 2) 'tiks/quaver IF mdd < 0 THEN midilogfile "SMTP time format not supported yet in " + FUNCNAME$: EXIT FUNCTION NextChunk: ' midilogfile "---next chunk---" GET$ #f, 4, b$ IF b$ <> "MTrk" THEN Warning "Track header expected in " + fn + $CRLF + LTrimZero(HEX$(ASC(b$, 1), 2))+ LtrimZero(HEX$(ASC(b$, 2), 2))+ LTrimZero(HEX$(ASC(b$, 3), 2))+ LTrimZero(HEX$(ASC(b$, 4), 2)) + b$ + " in " + FUNCNAME$, 10000 midiLogfile "Track header expected in " + fn + $CRLF + LTrimZero(HEX$(ASC(b$, 1), 2))+ LtrimZero(HEX$(ASC(b$, 2), 2))+ LTrimZero(HEX$(ASC(b$, 3), 2))+ LTrimZero(HEX$(ASC(b$, 4), 2)) + b$ + " in " + FUNCNAME$ EXIT FUNCTION END IF GET$ #f, 4, b$ ' midilogfile "chunksize: " + b$ + " -" + STR$(ASC(b$, 1)) + STR$(ASC(b$, 2)) + STR$(ASC(b$, 3)) + STR$(ASC(b$, 4)) chunksize = &H01000000 * ASC(b$, 1) + &H010000 * ASC(b$, 2) + &H0100 * ASC(b$, 3) + ASC(b$, 4) ' midilogfile " chunksize:" + STR$(chunksize) resettime = 1 tempocount = 0 tempo = tempomap(0) IF ISFALSE tempo THEN tempo = 500 ': PRINT #f2, "force tempo 500" '===READ CHUNK======================================================== ReadChunk: bytecount = 1 DO '-----read time------------------------------------------ t$ = "" readingtime: ' logfile "T$: '" + t$ + "'" IF bytecount >= chunksize THEN Warning "chunksize in file " + fn + " is wrong! - trying to ignore it.. check logfile for more info", 10000 midiLogfile "chunksize in file " + fn + " is wrong! - trying to ignore it.." midiLogfile " track:" + STR$(track) midilogfile " expected chunk size:" + STR$(chunksize) midilogfile " current bytecount:" + STR$(bytecount) midilogfile " checkpoint A" RESET bytecount ' END IF GET$ #f, 1, b$ INCR bytecount rdngtmcont: t$ = t$ + CHR$(ASC(b$) AND &H7F) x = ASC(b$) IF BIT(x, 7) THEN GOTO readingtime FOR x = 1 TO LEN(t$) currenttimetiks = currenttimetiks + ASC(t$, x) * 2 ^ (7 * (LEN(t$) - x)) NEXT t$ = "" ' midilogfile "last event:" + STR$(cEvents) + STR$(sq(cEVENTS).time) + " - " + HEX$(sq(cEvents).bstat) + STR$(sq(cEvents).bdat1) + STR$(Sq(cEVENTS).bdat2) + " - " + sq(cEvents).marker INCR cevents IF cevents > UBOUND(sq) THEN REDIM PRESERVE sq(UBOUND(sq) + 1000) REDIM PRESERVE times(UBOUND(sq)) END IF sq(cevents).time = sq(cevents - 1).time + (tempo * currenttimetiks / mdd) '((ms/quaver) * tiks) / (tiks/quaver) = ms IF resettime THEN resettime = 0 sq(cevents).time = tempo * currenttimetiks / mdd END IF ' midilogfile "times:" + STR$(currenttimetiks) + STR$(sq(cevents).time) 'if necessary adapt tempo to map IF (track > 0) AND (tempocount < UBOUND(tempotimestamp)) THEN DO WHILE (tempotimestamp(tempocount + 1) < sq(cevents).time) IF ISFALSE tempotimestamp(tempocount + 1) THEN EXIT LOOP '030818 happened in sailing-forlogospiano.mid LOCAL tt AS SINGLE INCR tempocount 'we can have accumulated large timing errors if tempochange was big/a long time ago 'so here we compensate.. tt = sq(cevents).time - tempotimestamp(tempocount) 'delta time 2 ticks in old tempo.. tt = tt * mdd / tempo 'now to time in new tempo tempo = tempomap(tempocount) tt = tempo * tt / mdd sq(cevents).time = tempotimestamp(tempocount) + tt ' PRINT #f2, "CORRECTED TIME: ";sq(cevents).time ' PRINT #f2, "CHANGE TEMPO: map("; tempocount;")@";tempotimestamp(tempocount) LOOP END IF sq(cevents).tempo = tempo sq(cevents).track = track sq(cevents).bStat = currentstatusbyte times(cevents) = sq(cevents).time currenttimetiks = 0 'forward to next time.. '-----get status byte..----------------------------------- GET$ #f, 1, b$ INCR bytecount IF ASC(b$) < &H080 THEN SEEK #f, SEEK(#f) - 1 DECR bytecount GOTO readdata 'runningstatus.. END IF currentstatusbyte = ASC(b$) sq(cevents).bStat = currentstatusbyte 'addition kl.030818 interprstat: IF bytecount >= chunksize THEN Warning "chunksize in file " + fn + " is wrong! - trying to ignore it.. check logfile for more info", 10000 midiLogfile "chunksize in file " + fn + " is wrong! - trying to ignore it.." midiLogfile " track:" + STR$(track) midilogfile " expected chunk size:" + STR$(chunksize) midilogfile " current bytecount:" + STR$(bytecount) midilogfile " checkpoint B" ' RESET bytecount 'EXIT LOOP END IF 'logfile "stat: " + HEX$(ASC(b$)) '---------in case we havew a meta event.. '080610: we think we found some bugs here, but wnder why they never caused any trouble.. ' even when we do nothing with the events, we should read them in and incr bytecount. or not..? IF b$ = CHR$(255) THEN ' midilogfile "metaevent" + "@" + STR$(cevents) sq(cevents).bDat1 = &H0FF 'this means: erase later (overwritten again for marker!) SQ(cevents).bDat2 = &H0FF GET$ #f, 1, b$ 'type of metaevent ' midilogfile "type:" + STR$(ASC(B$)) INCR bytecount ' logfile "meta event" + HEX$(ASC(b$)) SELECT CASE ASC(b$) CASE 0 '080611 midilogfile "Event 0" GET$ #f, 3, b$ bytecount = bytecount + 3 CASE 1, 2 'text, copyright ' midilogfile "copyright:" ' GET$ #f, 1, b$: INCR bytecount ' x = ASC(b$) '080611 b$ = "" DO INCR bytecount GET$ #f, 1, t$ b$ = b$ + CHR$(ASC(t$) AND &H7F) 'CHR$(ASC(chunk$, bytecount) AND &H7F) ' logfile " '" + b$ + "'" LOOP WHILE ASC(t$) > 127 ' logfile " length bytes:" + b$ bts = 0 FOR x = 1 TO LEN(b$) bts =bts + ASC(b$, x) * 2 ^ (7 * (LEN(b$) - x)) 'this time we are not interested in absolute time but in measures and beats.. NEXT x = bts GET$ #f, x, b$: bytecount = bytecount + x midilogfile "copyright " + b$ IF LEN(info) THEN info = info + CHR$(1) 'character 1 delimiter for parsing info = info + b$ t$ = "" GOTO Readingtime CASE 3 'track name ' midilogfile "track name:" ' GET$ #f, 1, b$: INCR bytecount ' x = ASC(b$) b$ = "" ' logfile "chunklength.." DO INCR bytecount GET$ #f, 1, t$ ' logfile HEX$(ASC(t$)) + STR$(ASC(t$)) b$ = b$ + CHR$(ASC(t$) AND &H7F) 'CHR$(ASC(chunk$, bytecount) AND &H7F) ' logfile " '" + b$ + "'" LOOP WHILE ASC(t$) > 127 ' logfile " .." + b$ ' logfile " length bytes:" + b$ bts = 0 FOR x = 1 TO LEN(b$) bts =bts + ASC(b$, x) * 2 ^ (7 * (LEN(b$) - x)) 'this time we are not interested in absolute time but in measures and beats.. NEXT x = bts ' logfile " bytes:" + STR$(x) GET$ #f, x, b$: bytecount = bytecount + x ' logfile " " + b$ midilogfile "track" + STR$(track) + " name:" + TRIM$(b$) IF LEN(trackinfo) THEN trackinfo = trackinfo + CHR$(1) t$ = "" 'important - was cause of time shifting bug!! trackinfo = trackinfo + TRIM$(STR$(track)) + CHR$(1) + b$ t$ = "" GOTO Readingtime CASE 4 'instrument name ' midilogfile "instr name" ' GET$ #f, 1, b$: INCR bytecount ' x = ASC(b$) b$ = "" DO INCR bytecount GET$ #f, 1, t$ b$ = b$ + CHR$(ASC(t$) AND &H7F) 'CHR$(ASC(chunk$, bytecount) AND &H7F) logfile " '" + b$ + "'" LOOP WHILE ASC(t$) > 127 ' logfile " length bytes:" + b$ bts = 0 FOR x = 1 TO LEN(b$) bts =bts + ASC(b$, x) * 2 ^ (7 * (LEN(b$) - x)) 'this time we are not interested in absolute time but in measures and beats.. NEXT x = bts GET$ #f, x, b$: bytecount = bytecount + x midilogfile "instrument: " + b$ t$ = "" GOTO Readingtime CASE 5 'lyrics midilogfile "**lyrics" ' GET$ #f, 1, b$: INCR bytecount ' x = ASC(b$) b$ = "" DO INCR bytecount GET$ #f, 1, t$ b$ = b$ + CHR$(ASC(t$) AND &H7F) 'CHR$(ASC(chunk$, bytecount) AND &H7F) ' logfile " '" + b$ + "'" LOOP WHILE ASC(t$) > 127 ' logfile " length bytes:" + b$ bts = 0 FOR x = 1 TO LEN(b$) bts =bts + ASC(b$, x) * 2 ^ (7 * (LEN(b$) - x)) 'this time we are not interested in absolute time but in measures and beats.. NEXT x = bts GET$ #f, x, b$:bytecount = bytecount + x t$ = "" GOTO Readingtime CASE 6 '--- marker: throw them away (was: we put the first twenty characters in the marker field) ' midilogfile "marker" sq(cevents).bDat1 = &H0 'FF 'overwrite the erase flag.. SQ(cevents).bDat2 = &H0 'FF ' GET$ #f, 1, b$ ' x = ASC(b$) b$ = "" DO INCR bytecount GET$ #f, 1, t$ b$ = b$ + CHR$(ASC(t$) AND &H7F) 'CHR$(ASC(chunk$, bytecount) AND &H7F) ' logfile " ]-'" + b$ + "'" LOOP WHILE ASC(t$) > 127 ' logfile " length bytes:" + b$ bts = 0 FOR x = 1 TO LEN(b$) bts =bts + ASC(b$, x) * 2 ^ (7 * (LEN(b$) - x)) 'this time we are not interested in absolute time but in measures and beats.. NEXT x = bts bytecount = bytecount + x ' IF x > 20 THEN x = 20 'this was a bug causing wrong chunk sizes!! solved 20070921 GET$ #f, x, b$ 'sq(cevents).marker midilogfile "marker :"+ b$ b$ = LEFT$(b$, 20) t$ = "" GOTO readingtime CASE 7, 8, 9, &H7F 'cue point, program name, port name, proprietary event midilogfile "prop:" + STR$(ASC(b$)) b$ = "" DO INCR bytecount GET$ #f, 1, t$ b$ = b$ + CHR$(ASC(t$) AND &H7F) 'CHR$(ASC(chunk$, bytecount) AND &H7F) ' logfile " ]-'" + b$ + "'" LOOP WHILE ASC(t$) > 127 ' logfile " length bytes:" + b$ bts = 0 FOR x = 1 TO LEN(b$) bts =bts + ASC(b$, x) * 2 ^ (7 * (LEN(b$) - x)) 'this time we are not interested in absolute time but in measures and beats.. NEXT x = bts bytecount = bytecount + x GET$ #f, x, b$ 'we don't use them, just to keep the pointer in the file right.. was missing @ 20090914 t$ = "" GOTO readingtime ' CASE 9 'port name ' GET$ #f, 1, b$: INCR bytecount ' x = ASC(b$) ' GET$ #f, x, b$: bytecount = bytecount + x ' GOTO Readingtime CASE &H02F 'end of track logfile "end of track" GET$ #f, 1, b$ ': INCR bytecount ' logfile "end of track chunk @ bytecount" + STR$(bytecount) +", chunksize=" + STR$(chunksize) ' !1 tever.. is dit de schuldige? -> checke in player.. ' logfile "END OF TRACK BYTE" ' logfile "bytecount:" + STR$(bytecount) + "/" + STR$(chunksize) 'NO DATA!! GOTO EndOfTrack EXIT LOOP CASE &H051 'tempo 'logfile "tempo" GET$ #f, 1, b$: INCR bytecount 'allways = 3 data bytes GET$ #f, 3, b$: INCR bytecount: INCR bytecount: INCR bytecount tempo = (&H010000 * ASC(b$, 1) + &H0100 * ASC(b$, 2) + ASC(b$, 3)) / 1000 'ms/quarternote tempomap(tempocount) = tempo tempotimestamp(tempocount) = sq(cevents).time ' logfile "tempo" + STR$(tempocount) + STR$(tempomap(tempocount)) + "@" + STR$(tempotimestamp(tempocount)) midilogfile "tempo" + STR$(tempo) + " in track" + STR$(track) + "bytecount:" + STR$(bytecount) + " @ " + STR$(sq(cevents).time) + " - bpm" + STR$(60000/tempo) INCR tempocount IF tempocount > UBOUND(tempomap) THEN REDIM PRESERVE tempomap(tempocount + 10) REDIM PRESERVE tempotimestamp(tempocount + 10) END IF GOTO ReadingTime CASE &H058 'time signature ' midilogfile "time sig" sq(cevents).bDat1 = &H058 'overwrite erase flag with type of special event sq(cevents).bDat2 = 0 sq(cevents).bstat = 255 GET$ #f, 1, b$: INCR bytecount x = ASC(b$) 'nrbytes: allways 4 GET$ #f, x, b$: bytecount = bytecount + x sq(cevents).extra = &H01000000 * ASC(b$, 1) + &H010000 * ASC(b$, 2) + &H0100 * ASC(b$, 3) + ASC(b$, 4) midilogfile "Time sig @ event" + STR$(cevents) + ":" + HEX$(sq(cevents).extra) midilogfile STR$(ASC(b$, 1)) + "/" + STR$(2 ^ ASC(b$, 2)) + " - midi clocks/metronome tick:" + STR$(ASC(b$, 3)) + " - 32rds/quarternote:" + STR$(ASC(b$, 4)) GOTO readingtime CASE &H059 'key signature ' CASE &H07F 'sequencer specific CASE &H020 'channel for meta-event CASE ELSE 'other metaevent END SELECT IF bytecount >= chunksize THEN Warning "chunksize in file " + fn + " is wrong! - trying to ignore it.. check logfile for more info", 10000 midiLogfile "chunksize in file " + fn + " is wrong! - trying to ignore it.." midiLogfile " track:" + STR$(track) midilogfile " expected chunk size:" + STR$(chunksize) midilogfile " current bytecount:" + STR$(bytecount) midilogfile " checkpoint C" RESET bytecount 'EXIT LOOP END IF GET$ #f, 1, b$ 'sizeinbytes of data section INCR bytecount x = ASC(b$) GET$ #f, x, b$ bytecount = bytecount + x GOTO readingtime END IF SELECT CASE ASC(b$) CASE < &H080 Warning "CASE &H080 shouldnt happen in" + FUNCNAME$, 10000 midilogfile "CASE &H080 shouldnt happen in" + FUNCNAME$ '----------sysex.. CASE &H0F0 midilogfile "sysx - ignored" DECR cevents DO GET$ #f, 1, b$ INCR bytecount IF ASC(b$) = &H0F7 THEN GOTO Readingtime LOOP GOTO readingtime '----------song position pointer CASE &H0F2 midilogfile "song position pointer - ignored" DECR cevents GET$ #f, 1, b$ INCR bytecount GET$ #f, 1, b$ INCR bytecount GOTO Readingtime '----------song select CASE &H0F3 midilogfile "song select - ignored" DECR cevents GET$ #f, 1, b$ INCR bytecount GOTO Readingtime '----------one byte system common or realtime message.. '20080603 which should never be in a file we guess.. CASE >= &H0F0 midilogfile "System common or realtime message spotted in file!" DECR cevents GOTO readingtime '----------normal event with one databyte CASE &H0C0 TO &H0DF '1 data byte ' logfile "normal event 1db" GET$ #f, 1, b$ INCR bytecount sq(cevents).bDat1 = ASC(b$) GOTO readingtime '----------normal event with two databytes CASE < &H0F0 ' logfile "normal event 2 db" GET$ #f, 1, b$ INCR bytecount sq(cevents).bDat1 = ASC(b$) GET$ #f, 1, b$ INCR bytecount sq(cevents).bDat2 = ASC(b$) GOTO readingtime END SELECT readdata: 'parsing for running status data and for data we don't do anything with.. DO GET$ #f, 1, b$: INCR bytecount x = ASC(b$) IF x = 255 THEN GOTO interprstat IF BIT (x, 7) THEN t$ = b$ GOTO rdngtmcont END IF SELECT CASE currentstatusbyte CASE &H0C0 TO &H0DF sq(cevents).bdat1 = ASC(b$) GOTO readingtime CASE < &H0F0 sq(cevents).bdat1 = ASC(b$) GET$ #f, 1, b$ INCR bytecount sq(cevents).bdat2 = ASC(b$) GOTO readingtime END SELECT IF bytecount >= chunksize THEN Warning "chunksize in file " + fn + " is wrong! - trying to ignore it.. check logfile for more info", 10000 midiLogfile "chunksize in file " + fn + " is wrong! - trying to ignore it.." midiLogfile " track:" + STR$(track) midilogfile " expected chunk size:" + STR$(chunksize) midilogfile " current bytecount:" + STR$(bytecount) midilogfile " checkpoint D" RESET bytecount ' EXIT LOOP END IF LOOP IF bytecount >= chunksize THEN Warning "chunksize in file " + fn + " is wrong! - trying to ignore it.. check logfile for more info", 10000 midiLogfile "chunksize in file " + fn + " is wrong! - trying to ignore it.." midiLogfile " track:" + STR$(track) midilogfile " expected chunk size:" + STR$(chunksize) midilogfile " current bytecount:" + STR$(bytecount) midilogfile " checkpoint E" RESET bytecount 'EXIT LOOP END IF LOOP EndOfTrack: 'read next chunk ' midilogfile "---end of track---" ' logfile "next track:" + STR$(track) INCR track IF track < nrtracks THEN GOTO NextChunk CLOSE #f REDIM PRESERVE sq(cevents) REDIM PRESERVE times(cevents) 'now erase metaevents (flagged by: both data bytes &HFF) 'sort according to time i = 0 cevents = 0 DO IF (sq(cevents).bdat1 = &H0FF) AND (sq(cevents).bdat2 = &H0FF) THEN ARRAY DELETE sq(cevents) ARRAY DELETE times(cevents) ' DECR cevents INCR i ELSE ' logfile "last event:" + STR$(cEvents) + STR$(sq(cEvents).time) + " - " + HEX$(sq(cEvents).bstat) + STR$(sq(cEvents).bdat1) + STR$(Sq(cEvents).bdat2) + " - " + sq(cEvents).marker INCR cevents END IF LOOP WHILE cevents < UBOUND(sq) REDIM PRESERVE sq(cevents) REDIM PRESERVE times(UBOUND(sq)) ARRAY SORT times(), TAGARRAY sq() ' FOR i = LBOUND(sq) TO UBOUND(sq) ' IF (sq(i).bstat > 0) THEN ' logfile STR$(i) + STR$(sq(i).time) + " - " + HEX$(sq(i).bstat) + STR$(sq(i).bdat1) + STR$(Sq(i).bdat2) + " - " + STR$(sq(i).tempo) + " - " + sq(i).marker ' END IF ' NEXT FUNCTION = cevents '%true EXIT FUNCTION failed: warning "Error " + STR$(ERRCLEAR) + " occured while reading midi file " + fn +$CRLF + "Aborted reading", 15000 midilogfile "Error " + STR$(ERRCLEAR) + " occured while reading midi file " + fn +$CRLF + "Aborted reading" ' function = cevents CLOSE f END FUNCTION '!! This function was moved to g_midi.inc, because for further development we needed some M&M specific functions that reside in g_midi.inc ' otherwise we would have to make g_file.dll dependent on g_lib.dll.. 'FUNCTION Midi2seq(BYVAL sourcefile AS STRING, OPT BYVAL destfile AS STRING) EXPORT AS LONG ' 'TO DO: portt/channel (E); maat (M) - timesignature meta-event nog te implementeren in parsemidifile funxie!! ??tempo from midi file?? ' 'note on/offs that are closer to each other then 10 ms are put together (the seq file format is counting in centiseconds ' ' ' 'the SEQ file format ' ' spaces are used as separator, CRLF separates events (except some special cases -see further) ' ' principally, xactly one space should be used as separator, but parsing software should be forgiving if there are several spaces ' ' eah normal line begins with: ' ' WORD tracknr LONG tick(cs) ' ' after the tick a space follows, followed by a letter designating the kind of event and appropriate data ' ' H(STRING * 128): a Harmstring to be played. the string corresponds to Harmtype.veland follows the 'H' immediately, without space ' ' C BYTE nr BYTE value ->controller ' ' A(STRING * 128) ->key presssure ' ' P WORD pitchbendvalue ->pitch bend ' ' I BYTE progranchange ->program change ' ' Z(STRING * 128) ' 'special cases ' ' Comments start with a ' ' ' Sysex: starts with X, ends with &H7F. -> ?? timestamp make sno sense here - allow this anywhere else then in the beginning of the file?? ' ' (dit is voorzien voor de toekomst maar voorlopig niet geimplementeerd) ' ' M maat tempo -> check how this is in midi format.. , without tracknr of ticks, in the beginning of the file ' ' E dword channel dword because it can contain a port, without tracknr of ticks, in the beginning of the file ' 'unknown commands should be ignored ' ' ' '20070124: seems to work, bu thorough debugging is stil needed!! ' LOCAL f AS LONG ' LOCAL b$, t$ ' LOCAL x AS BYTE ' LOCAL i AS LONG, j AS LONG ' LOCAL spr AS WORD ' LOCAL sq() AS ParsedMidiType ' LOCAL h() AS HarmType ' LOCAL hkey() AS HarmType ' LOCAL hoff AS Harmtype ' LOCAL cc AS BYTE ' LOCAL info$ ' LOCAL trackinfo$ ' LOCAL events AS LONG ' DIM h(255) 'nr of tracks limited to 256.. (midi format actualy allows 65535 ' DIM hkey(255) ' DIM sq(1000) ' events = ParseMidifile(sourcefile, sq(), info, trackinfo) ' logfile "total events:" + STR$(events) + STR$(UBOUND(sq())) ' IF events <= 0 THEN ' MSGBOX "Couldn't read midi file " + sourcefile,, FUNCNAME$ ' EXIT FUNCTION ' END IF ' ERRCLEAR ' IF ISFALSE(LEN(TRIM$(destfile))) THEN ' destfile = sourcefile ' REPLACE ".mid" WITH ".seq" IN destfile ' MSGBOX "destination: " + destfile,,FUNCNAME$ ' END IF ' f = FREEFILE ' OPEN destfile FOR OUTPUT ACCESS WRITE LOCK WRITE AS f ' IF ERR THEN ' MSGBOX "Failed opening destination file " + destfile + $CRLF + "Err:" + STR$(ERRCLEAR),,FUNCNAME$ ' EXIT FUNCTION ' END IF ' FOR i = 0 TO events ' logfile "event:" + STR$(i) ' IF i > UBOUND(sq) THEN EXIT FOR 'kan gebeuren omdat we in bepaalde omstandigheden elementen uit het array deleten ' SELECT CASE sq(i).bstat AND &HF0 ' CASE &H090, &H080 'note on / off ' logfile "note on/off @" + STR$(sq(j).time/10) ' 'hier moeten we direct doorzoeken naar alle note on/offs voor dezelfde timestamp, track en channel, deze hier verwerken en uit het array gooien ' j = i ' DO WHILE ((sq(j).time / 10) - sq(i).time/10) < 1 ' logfile " check" + STR$(j) + " @" + STR$(sq(j).time / 10) ' logfile " track:" + STR$(sq(j).track) ' IF sq(i).track <> sq(j).track THEN ' logfile " different track - incr j" ' INCR j ' IF j > UBOUND(sq) THEN EXIT LOOP ' ITERATE LOOP ' END IF ' IF sq(j).bstat = &H090 THEN 'note on ' logfile " note on" +STR$(sq(j).bdat1) + STR$(sq(j).bdat2) ' MID$(h(sq(j).track).vel, sq(j).bdat1 + 1, 1) = CHR$(sq(j).bdat2) 'DON'T use addnote2har here: double notes should be ignored, not played louder.. ' IF ISFALSE sq(j).bdat2 THEN MID$(hkey(sq(j).track).vel, sq(j).bdat1 + 1) = CHR$(0) 'reset keypressure on note off ' IF i<> j THEN ' logfile "clear from array ' ARRAY DELETE sq(j) ' ITERATE LOOP ' ELSE ' logfile "incr j" ' INCR j ' IF j > UBOUND(sq) THEN EXIT LOOP ' ITERATE LOOP ' END IF ' ELSEIF sq(j).bstat = &H080 THEN 'note off with velocity - untested because we don't have any midi file using this.. ' logfile " note off" +STR$(sq(j).bdat1) + STR$(sq(j).bdat2) ' MID$(h(sq(j).track).vel, sq(j).bdat1 + 1) = CHR$(0) ' MID$(hoff.vel, sq(j).bdat1 + 1) = CHR$(sq(j).bdat2) ' MID$(hkey(sq(j).track).vel, sq(j).bdat1 + 1) = CHR$(0) ' IF i<> j THEN ' logfile "clear from array ' ARRAY DELETE sq(j) ' ITERATE LOOP ' ELSE ' logfile"incr j" ' INCR j ' IF j > UBOUND(sq) THEN EXIT LOOP ' ITERATE LOOP ' END IF ' ELSE ' logfile " no note - incr j" ' INCR j ' IF j > UBOUND(sq) THEN EXIT LOOP ' END IF ' LOOP ' logfile " out of loop - dump " + h(sq(i).track).vel ' PRINT# f, STR$(sq(i).track) + " " + STR$(INT(sq(i).time / 10)) + " H" + h(sq(i).track).vel ' 'if there are not offs with velocity.. ' b$ = REMOVE$(hoff.vel, CHR$(0)) ' IF LEN(b$) THEN ' PRINT# f, STR$(sq(i).track) + " " + STR$(INT(sq(i).time / 10)) + " Z" + hoff.vel ' RESET hoff ' END IF ' CASE &H0B0 'controller ' logfile "ctrl" ' 'uitdunnen tot 1/10 ms ' j = i ' DO WHILE ((sq(j).time/10) - sq(i).time/10) < 1 ' IF (sq(i).track <> sq(j).track) THEN ' INCR j ' IF j > UBOUND(sq) THEN EXIT LOOP ' ITERATE LOOP ' END IF ' IF (sq(j).bstat = &H0B0) AND (sq(i).bdat1 = sq(j).bdat1) THEN ' sq(i).bdat2 = sq(j).bdat2 ' IF i<> j THEN ' ARRAY DELETE sq(j) ' ELSE ' INCR j ' IF j > UBOUND(sq) THEN EXIT LOOP ' ITERATE LOOP ' END IF ' ELSE ' INCR j ' IF j > UBOUND(sq) THEN EXIT LOOP ' END IF ' LOOP ' PRINT# f, STR$(sq(i).track) + STR$(INT(sq(i).time / 10)) + " C" + STR$(sq(i).bdat1) + STR$(sq(i).bdat2) ' CASE &H0C0 'progchange ' logfile "prgch" ' j = i ' DO WHILE ((sq(j).time/10 - sq(i).time/10) < 1) ' IF (sq(i).track <> sq(j).track) THEN ' INCR j ' IF j > UBOUND(sq) THEN EXIT LOOP ' ITERATE LOOP ' END IF ' IF sq(j).bstat = &H0C0 THEN ' sq(i).bdat1 = sq(j).bdat1 ' IF i<> j THEN ' ARRAY DELETE sq(j) ' ELSE ' INCR j ' IF j > UBOUND(sq) THEN EXIT LOOP ' ITERATE LOOP ' END IF ' ELSE ' INCR j ' IF j > UBOUND(sq) THEN EXIT LOOP ' END IF ' LOOP ' PRINT# f, STR$(sq(i).track) + STR$(INT(sq(i).time / 10)) + " I" + STR$(sq(i).bdat1) ' CASE &H0A0 'keypress ' logfile "key" ' j = i ' DO WHILE ((sq(j).time/10 - sq(i).time/10)) < 1 ' IF (sq(i).track <> sq(j).track) THEN ' INCR j ' IF j > UBOUND(sq) THEN EXIT LOOP ' ITERATE LOOP ' END IF ' IF sq(j).bstat = &H0A0 THEN ' MID$(hkey(sq(j).track).vel, sq(j).bdat1 + 1) = CHR$(sq(j).bdat2) ' IF i<> j THEN ' ARRAY DELETE sq(j) ' ELSE ' INCR j ' IF j > UBOUND(sq) THEN EXIT LOOP ' ITERATE LOOP ' END IF ' ELSE ' INCR j ' IF j > UBOUND(sq) THEN EXIT LOOP ' END IF ' LOOP ' PRINT# f, STR$(sq(i).track) + STR$(INT(sq(i).time/10)) + " A" + hkey(sq(i).track).vel ' CASE &H0D0 'aftertouch ' warning "channel aftertouch not implemented in " + FUNCNAME$ ' CASE &H0E0 'pitchbend ' logfile "bend" ' j = i ' DO WHILE ((sq(j).time/10 - sq(i).time) < 1) ' IF j > UBOUND(sq) THEN EXIT LOOP ' IF (sq(i).track <> sq(j).track) THEN ' INCR j ' IF j > UBOUND(sq) THEN EXIT LOOP ' ITERATE LOOP ' END IF ' IF sq(j).bstat = &H0C0 THEN ' sq(i).bdat1 = sq(j).bdat1 ' sq(i).bdat2 = sq(j).bdat2 ' IF i<> j THEN ' ARRAY DELETE sq(j) ' ELSE ' INCR j ' IF j > UBOUND(sq) THEN EXIT LOOP ' ITERATE LOOP ' END IF ' ELSE ' INCR j ' IF j > UBOUND(sq) THEN EXIT LOOP ' END IF ' LOOP ' PRINT# f, sq(i).track + STR$(INT(sq(i).time \ 10)) + " P" + STR$(128 * sq(i).bdat1 + sq(i).bdat2) 'doublecheck this ' CASE ELSE ' logfile "other " + HEX$(sq(i).bstat) + STR$(sq(i).bdat1) + STR$(sq(i).bdat2) ' END SELECT ' NEXT 'END FUNCTION FUNCTION FindMMFiles(OPT BYVAL basepath$, OPT BYVAL instrumfilter$, OPT BYVAL minnrinstruments AS LONG, OPT BYVAL maxnrinstruments AS LONG, OPT BYVAL ccom$) EXPORT AS STRING 'kl 02/2005 'finds all midi files that are suitable for in basepath and it's subdirectories - presumes 'c:\midifiles\' if no path given 'instrumfilter is a comma separated list of strings that should occur in the trackinfo (e.g. instrument names) 'com$ is for internal purposes only and should never be filled in by the user 'returns filename selected by the user 'possible improvement: keep up a db of scanned files and only scale the ones that are changed.. 'tried speeding up with an inventory fail, but this was even slower as the filedate function opens the file.. 'one option could be to use a dos dir function instead.. LOCAL a$, b$, file$, directory$, mmfile$, dialogtext$, dat$, datum$ LOCAL pc AS LONG LOCAL f AS LONG LOCAL fres AS LONG LOCAL fdb AS LONG LOCAL sq() AS ParsedMidiType LOCAL info AS STRING LOCAL trackinfo AS STRING LOCAL flog AS LONG LOCAL fileok AS LONG STATIC hw AS LONG LOCAL hlist AS LONG LOCAL ITEM$() LOCAL ins$ LOCAL mPOS AS LONG, length AS LONG LOCAL fdat AS LONG STATIC interrupt AS LONG STATIC retval$ ' LOCAL storeddata$() DIM ITEM$(0) LOCAL i AS LONG, j AS LONG interrupt = 0 MidiLogFile "check","midilog.txt" IF LEN(ccom$) THEN SELECT CASE PARSE$(ccom$, "|", 1) CASE "interrupt" interrupt = 1 '1: stop scanning, don't kill dialog, stay in waiting loop CASE "closing" 'closed by ourself or by user interrupt = 2 'stop scanning, don't kill dialog as it's happening allready, but exit waiting loop hw = 0 retval$ = "" CASE "return" retval$ = PARSE$(ccom$, "|", 2) interrupt = 3 'stop scanning, kill dialog and exit waiting loop 'set a timed event for closing this? END SELECT EXIT FUNCTION END IF IF hw THEN Warning "Running two instances of the < M&M > file finder is not allowed!", 10000 EXIT FUNCTION END IF instrumfilter$ = REMOVE$(LCASE$(instrumfilter$), " ") basepath$ = TRIM$(basepath$) IF basepath$ = "" THEN basepath$ = "C:\Midifiles\" IF RIGHT$(basepath$, 1) <> "\" THEN basepath$ = basepath$ + "\" 'file met laatste gegevens over instrumentatie e.d. 'format: 'path+filename|filedate|instrumentatie ' fdb = FREEFILE ' OPEN "c:\b\pb\gmt\midiInventory.dat" FOR BINARY ACCESS READ LOCK WRITE AS fdb ' GET$ #fdb, LOF(fdb), b$ ' CLOSE# fdb ' DIM storeddata$(PARSECOUNT(b$, CHR$(13, 10))) ' FOR i = 1 TO UBOUND(storeddata$) ' storeddata$(i) = PARSE$(b$, CHR$(13,10), i) ' NEXT '20060330 we write results to file also fres = FREEFILE OPEN "FindMMFiles_results.txt" FOR OUTPUT ACCESS WRITE LOCK WRITE AS fres PRINT# fres, "Date:" + DATE$ + " - " TIME$ PRINT# fres, "Searched files containing '" + instrumfilter$ "', min. nr of instruments:" + STR$(minnrinstruments) + ", max:" + STR$(maxnrinstruments) + " in path: " + basepath$ PRINT# fres, "---" 'make a dialog to display results DIALOG FONT "Lucida Console", 8 'fixed witdh font for easier reading dialogtext$ = "Find < M&M > files" IF LEN(instrumfilter$) THEN dialogtext$ = dialogtext$ + " containing '" + instrumfilter$ + "'" IF minnrinstruments THEN dialogtext$ = dialogtext$ + " min nr of instruments:" + STR$(minnrinstruments) IF maxnrinstruments THEN dialogtext$ = dialogtext$ + " max nr of instruments:" + STR$(maxnrinstruments) dialogtext$ = dialogtext$ + " in " + basepath$ + " - this may take a while" dialogtext$ = dialogtext$ + $CRLF + "If you see the file you where looking for you can doubleclick it to select it and stop scanning" + $CRLF DIALOG NEW 0, "Find < M&M > Files ",, , 500, 300, %WS_CAPTION OR%WS_SYSMENU TO hw DIALOG SET COLOR hw, &HFFFFFF, 0 CONTROL ADD LABEL, hw, 1, dialogtext$, 1, 1, 438, 48 CONTROL ADD BUTTON, hw, 10, "stop scan", 439, 2, 59, 46 CONTROL SET COLOR hw, 1, &HFFFFFF, 0 CONTROL ADD LISTBOX, hw, 100, ITEM$(), 1, 50, 498, 248, %LBS_NOTIFY OR %LBS_USETABSTOPS OR %WS_HSCROLL OR %WS_VSCROLL OR %WS_TABSTOP 'no callback yet CONTROL SEND hw,100,%LB_SETHORIZONTALEXTENT,1280,0 DIALOG SHOW MODELESS hw CALL cbFindMMFiles CONTROL HANDLE hw, 100 TO hlist LOCAL tbs() AS LONG: REDIM tbs(2) AS LONG tbs(0) = 130: tbs(1) = 300 : tbs(2) = 600 CALL SendMessage(hlist, %LB_SETTABSTOPS, 3, VARPTR(tbs(0))) 'make a list of all directories in basepath directory$ = basepath$ + "|" pc = 1 DO IF pc > PARSECOUNT(directory$, "|") THEN EXIT LOOP b$ = PARSE$(directory$, "|", pc) IF TRIM$(b$) = "" THEN INCR pc: ITERATE LOOP a$ = DIR$(b$, 16) WHILE LEN(a$) a$ = DIR$ IF a$ = "" THEN EXIT LOOP IF GETATTR(b$ + a$) = 16 THEN 'means this is a subdir directory$ = directory$ + b$ + a$ + "\|" 'we add this to the string we are looping to right now, so we get subdirs of subdirs as deep as we can go END IF WEND INCR pc LOOP 'now make a list of all midifiles FOR pc = 1 TO PARSECOUNT(directory$, "|") basepath$ = PARSE$(directory$, "|", pc) a$ = DIR$(basepath$ + "*.mid") WHILE LEN(a$) file$ = file$ + basepath$ + a$ + "|" a$ = DIR$ WEND NEXT ' flog = freefile ' open funcname$ + ".log" for output access write lock write as flog 'now see which ones have the tag.. ' msgbox str$(parsecount(file$, "|")) i = PARSECOUNT(file$, "|") dialogtext$ = dialogtext$ + FORMAT$(i) + " files to scan.." ' redim filelist$(i) ' redim datelist$(i) ' redim instrum$(i) CONTROL SET TEXT hw, 1, dialogtext$ FOR pc = 1 TO PARSECOUNT(file$, "|") - 1 IF interrupt THEN EXIT FOR REDIM sq(0) fileok = 0 info="" trackinfo="" ins$ ="" a$="" b$ = PARSE$(file$, "|", pc) ' FOR i = LBOUND(storeddata$) TO UBOUND(storeddata$) ' IF ISFALSE LEN(TRIM$(storeddata$(i))) THEN ITERATE FOR ' DIALOG DOEVENTS: DIALOG DOEVENTS ' IF INSTR(storeddata$(i), b$) THEN ' datum$ = filedateandtime(b$) ' IF datum$ = PARSE$(storeddata$(i), "|", 2) THEN ' ins$ = PARSE$(Storeddata$(i), "|", 3) ' fileok = 1 ' ELSE ' ARRAY DELETE storeddata$(i) ' REDIM PRESERVE storeddata$(UBOUND(Storeddata$) - 1) ' END IF ' END IF ' NEXT ' IF ISFALSE fileok THEN ParseMidifile b$, BYREF sq(), BYREF info, BYREF trackinfo dat$ = FileDateandTime(b$) trackinfo = LCASE$(trackinfo) ' ELSE ' warning "no need to parse " + b$, 20000 ' END IF ' IF fileok OR INSTR(UCASE$(REMOVE$(info, " ")), "") THEN '' mmfile$ = mmfile$ + b$ + "|" ' 'check against trackinfo filter ' IF fileok THEN ' FOR i = 1 TO PARSECOUNT(instrumfilter$, ",") ' a$ = LEFT$(MCASE$(PARSE$(instrumfilter$, ",", i)), 4) ' ' warning " look for " + a$ + "in " + ins$, 20000 ' IF ISFALSE INSTR(ins$, a$) THEN GOTO nextfile ' ' warning " ok", 20000 ' NEXT ' ELSE FOR i = 1 TO PARSECOUNT(instrumfilter$, ",") a$ = PARSE$(instrumfilter$, ",", i) IF ISFALSE INSTR(trackinfo, a$) THEN GOTO nextfile NEXT ' END IF ' IF ISFALSE fileok THEN FOR i = 1 TO PARSECOUNT (trackinfo, CHR$(1)) STEP 2 '1 was 3, as cakepro creates a dummy track, but not allways, so it's changed again.. a$ = PARSE$(trackinfo$, CHR$(1), i + 1) REGEXPR "<([a-zA-Z0-9_ ]+)>" IN a$ TO mPOS, length a$ = UCASE$(REMOVE$(MID$(a$, mPOS, length), ANY "<> ")) IF LEN(a$) AND (ISFALSE LEN(ins$) OR ISFALSE INSTR(ins$, LEFT$(MCASE$(a$), 4))) THEN ins$ = ins$ + LEFT$(MCASE$(a$), 4) + ", " NEXT ins$ = LEFT$(ins$, LEN(ins$) - 2) datum$ = filedate$(b$) ' REDIM PRESERVE storeddata$(UBOUND(storeddata$) + 1) ' storeddata$(UBOUND(Storeddata$)) = b$ +"|" + datum$ + "|" + ins$ ' END IF IF (minNrInstruments > 0) AND (PARSECOUNT(ins$, ",") < minNrInstruments) THEN GOTO nextfile IF (maxnrInstruments > 0) AND (PARSECOUNT(ins$, ",") > maxNrInstruments) THEN GOTO nextfile DIALOG DOEVENTS IF PARSECOUNT(ins$, ",") > 7 THEN ins$ = " orkest -" + STR$(PARSECOUNT(ins$, ",")) + " instruments" a$ = PARSE$(b$, "\", PARSECOUNT(b$, "\")) IF LEN(a$) > 28 THEN a$ = LEFT$(a$, 21) + ".. .mid" 'bescherming tegen te lange namen LISTBOX ADD hw, 100, a$ + CHR$(9) + ins$ + CHR$(9) + b$ + CHR$(9) + dat$ PRINT# fres, a$, ins$, b$, dat$ DIALOG DOEVENTS: DIALOG DOEVENTS 'END IF nextfile: NEXT DIALOG DOEVENTS ' b$ = "" ' FOR i = LBOUND(Storeddata$) TO UBOUND(storeddata$) ' b$ = b$ + storeddata$(i) + CHR$(13, 10) ' NEXT ' KILL "c:\b\pb\gmt\midiInventory.dat" ' OPEN "c:\b\pb\gmt\midiInventory.dat" FOR BINARY ACCESS WRITE LOCK WRITE AS fdb ' PUT$ fdb, b$ ' CLOSE fdb CONTROL SET TEXT hw, 1, "Scanning done." DO UNTIL (interrupt > 1) DIALOG DOEVENTS LOOP FUNCTION = retval$ IF (interrupt > 2) AND (hw > 0) THEN DIALOG END hw hw = 0 CLOSE fres ' msgbox mmfile$ END FUNCTION CALLBACK FUNCTION CBFindMMFiles LOCAL b$ SELECT CASE CBCTL CASE 10 'stop button IF CBMSG = %WM_COMMAND AND CBCTLMSG = %BN_CLICKED THEN FindMMFiles "", "", 0, 0, "interrupt" CASE 100 'list view IF CBMSG = %WM_COMMAND AND CBCTLMSG = %LBN_DBLCLK THEN LISTBOX GET TEXT CBHNDL, CBCTL TO b$ b$ = PARSE$(b$, CHR$(9), 3) FindMMFiles "", "", 0, 0, "return|" + b$ 'we use | as separation character because it's not allowed in filenames FUNCTION = %true END IF END SELECT SELECT CASE CBMSG CASE %WM_CLOSE FindMMFiles "","", 0, 0, "closing" FUNCTION = %true END SELECT END FUNCTION FUNCTION MidiPlayer_GetFilename (OPT BYVAL rpath$) EXPORT AS STRING 'gives user choice between MidiPlayer_FileOpenName and findmmfiles logfile FUNCNAME$ + "create dialog" LOCAL hw AS LONG LOCAL RES AS LONG DIALOG FONT "Lucida Console", 8 DIALOG NEW @pgh.cockpit, FUNCNAME$, , , 300, 107, %WS_POPUP OR %WS_CAPTION TO hw CONTROL ADD LABEL, hw, 100, "You can either browse for a file manually or search for a certain < M&M > adapted file (slow!)",1, 1, 288, 24, %SS_NOPREFIX CONTROL ADD LINE , hw, 200, "", 1, 26, 298, 17, %SS_BLACKFRAME CONTROL ADD BUTTON, hw, 201, "&Browse Manually", 4, 29, 292, 12, %BS_DEFAULT OR %BS_VCENTER OR %WS_TABSTOP CONTROL ADD LINE, hw, 300, "", 1, 45, 298, 60, %SS_BLACKFRAME CONTROL ADD LABEL, hw, 310, "Instruments (comma separated):", 4, 49, 145, 12, %SS_RIGHT CONTROL ADD TEXTBOX, hw, 311, "", 151, 48, 145, 11, %WS_TABSTOP CONTROL ADD LABEL, hw, 315, "Path:", 4, 63, 145, 12, %SS_RIGHT CONTROL ADD TEXTBOX, hw, 316, "C:\Midifiles\", 151, 62, 145, 11, %WS_TABSTOP CONTROL ADD LABEL, hw, 320, "Min nr.instruments:", 4, 77, 100, 12, %SS_RIGHT CONTROL ADD TEXTBOX, hw, 321, "", 106, 76 ,43, 11, %WS_TABSTOP CONTROL ADD LABEL, hw, 330, "Max nr.instruments:", 150, 77, 100, 12, %SS_RIGHT CONTROL ADD TEXTBOX, hw, 331, "", 252, 76 ,44, 11, %WS_TABSTOP CONTROL ADD BUTTON, hw, 350, "&Find files", 4, 90, 292, 12 DIALOG SHOW MODAL hw CALL CBMidiPlayer_GetFilename TO RES logfile "dialog shown" IF RES THEN FUNCTION = midifilename END FUNCTION CALLBACK FUNCTION CBMidiPlayer_GetFilename LOCAL ins$, pad$, b$ LOCAL mn, mx AS LONG ' logfile FUNCNAME$ + HEX$(CBMSG) + HEX$(CBCTL) + HEX$(CBCTLMSG) IF CBMSG <> %WM_COMMAND OR CBCTLMSG <>%BN_CLICKED THEN EXIT FUNCTION SELECT CASE CBCTL CASE 201 'browse button DIALOG END CBHNDL, 1 ' MSGBOX "about to show fileopen dialog..." + $CRLF + "last error:" + STR$(ERRCLEAR) midifilename = MidiPlayer_FileOpenName CASE 350 CONTROL GET TEXT CBHNDL, 311 TO ins$ CONTROL GET TEXT CBHNDL, 316 TO pad$ CONTROL GET TEXT CBHNDL, 321 TO b$: mn = VAL(b$) CONTROL GET TEXT CBHNDL, 331 TO b$: mx = VAL(b$) DIALOG END CBHNDL, 1 midifilename=FindMMFiles(pad$, ins$, mn, mx) END SELECT END FUNCTION FUNCTION MidiPlayer_FileOpenName (OPT BYVAL rpath$) EXPORT AS STRING 'basically calls winapi getopenfilename '20160328 adapted by request by gwr so that, within 1 gmt session, we come back in the last directory used 'when opening a next file. start directory for 1 gmt session stays c:\midifiles LOCAL ofn AS OPENFILENAME LOCAL shortfiln AS STRING * 28 LOCAL filnnopath AS STRING * 80 LOCAL filn AS STRING * 300 LOCAL titl AS STRING * 80 LOCAL filtr AS STRING * 200 LOCAL exts AS STRING * 3 LOCAL inidir AS STRING * 256 LOCAL origdir AS STRING * 256 STATIC seldir AS STRING * 256 STATIC inuse AS LONG STATIC beenhere AS LONG IF inuse THEN EXIT FUNCTION inuse = 1 ofn.lStructSize = SIZEOF(ofn) ofn.hwndOwner = 0 ofn.hInstance = @pgh.Inst MID$(filn,1) = CHR$(0) ofn.lpStrFile = VARPTR(filn) ofn.nMaxfile = 300 origdir = CURDIR$ IF ISFALSE (beenhere) THEN inidir = "C:\midifiles" CHDIR "C:\midifiles" beenhere = 1 ' msgbox curdir$ ELSE warning "dir: "+ seldir inidir = seldir CHDIR seldir END IF ofn.lpStrInitialDir = VARPTR(inidir) filtr = ".mid" + CHR$(0) + "*.mid" + CHR$(0) +"all files" + CHR$(0) + "*.*" + CHR$(0,0,0,0) ofn.lpStrFilter = VARPTR(filtr) ofn.nFilterIndex=1 titl = "Open Midi File" 'title$ ofn.lpStrTitle= VARPTR(titl) ofn.flags = %OFN_FILEMUSTEXIST OR %OFN_LONGNAMES OR %OFN_HIDEREADONLY 'OR %OFN_NOCHANGEDIR GetOpenFileName ofn seldir = CURDIR$ 'hier geselecteerde dir opslaan! CHDIR origdir FUNCTION = ofn.@lpStrFile inuse = 0 beenhere = 1 END FUNCTION FUNCTION FileDate(iFile AS STRING) EXPORT AS STRING ' returns filedate in format yyyy-mm-dd-hh-mm-ss ' mogelijkheden om dit te versnellen: ' - winapi findfirstfile/findnextfile functie -> zou vlugger moeten gaan - CHECKEN!! (http://www.powerbasic.com/support/forums/Forum4/HTML/003541.html) ' - dir shellen > maar moeilijk te parsen wegens spaties in namen en clumsy om veel directories te doen ' - winapi getfileattributesex 'Note: sets date if task <> 0 ' returns date when task = 0 LOCAL lpCreationTime AS FILETIME LOCAL lpLastAccessTime AS FILETIME LOCAL lpLastWriteTime AS FILETIME ' TRY THIS: local wfd as WIN32_FILE_ATTRIBUTE_DATA LOCAL sysT AS SYSTEMTIME LOCAL locT AS FILETIME LOCAL lpFileName AS ASCIIZ * 260 LOCAL lpReOpenBuff AS OFSTRUCT LOCAL lpFatDate AS WORD LOCAL lpFatTime AS WORD LOCAL b$ LOCAL hFile AS LONG IF LEN(iFile) = 0 THEN EXIT FUNCTION lpFileName = iFile hFile = OPENFILE(lpFileName, lpReOpenBuff, %OF_READWRITE) CALL GetFileTime(hFile, lpCreationTime, lpLastAccessTime, lpLastWriteTime) CALL FileTimeToLocalFileTime(lpLastWriteTime, locT) CALL FileTimeToSystemTime(locT, sysT) b$ = FORMAT$(sysT.wYear, "0000") + "-" + FORMAT$(sysT.wMonth, "00") + "-" + FORMAT$(sysT.wDay, "00") + "-" + FORMAT$(sysT.wHour, "00") + "-" + FORMAT$(sysT.wMinute, "00") + "-" + FORMAT$(sysT.wSecond, "00") CALL CloseHandle(hFile) DIALOG DOEVENTS FUNCTION = b$ END FUNCTION FUNCTION FileDateandTime(FileSpec AS STRING)EXPORT AS STRING DIM fd AS WIN32_FIND_DATA LOCAL hFile AS LONG LOCAL tDay AS ASCIIZ * 60 LOCAL tTime AS ASCIIZ * 60 LOCAL syst AS SYSTEMTIME LOCAL b$ hFile = FindFirstFile(BYVAL STRPTR(FileSpec),fd) IF ISFALSE hFile THEN EXIT FUNCTION FileTimeToLocalFileTime fd.ftLastWriteTime, fd.ftLastWriteTime FileTimeToSystemTime fd.fTLastWriteTime, sysT b$ = FORMAT$(sysT.wYear, "0000") + "-" + FORMAT$(sysT.wMonth, "00") + "-" + FORMAT$(sysT.wDay, "00") + "-" + FORMAT$(sysT.wHour, "00") + "-" + FORMAT$(sysT.wMinute, "00") + "-" + FORMAT$(sysT.wSecond, "00") FUNCTION = b$ 'tDay & " " & tTime END FUNCTION FUNCTION GetVaccaMapping (BYREF VaccaNotes() AS kloktype) EXPORT AS LONG 'kl 0510610 ' toe te voegen: dynamisch bereik per bel (velomin en velomax) ' 16.07.2005: no longer required since we can sysex programm the scalings. ' 12.06.2006 TO DO: compare and include results from dft ' ?? merge vacca en vitello ini files?? LOCAL f AS LONG LOCAL i AS LONG f = FREEFILE LOCAL b$ OPEN ".\robots\vacca\vacca.dat" FOR INPUT ACCESS READ LOCK WRITE AS f 'warning "getvaccamapping check" + STR$(LBOUND(Vaccanotes)) + STR$(UBOUND(vaccanotes)) DO LINE INPUT #f, b$ IF EOF(f) THEN CLOSE f: EXIT FUNCTION IF LEFT$(TRIM$(UCASE$(b$)),15 ) = "[VACCA_MAPPING]" THEN EXIT LOOP LOOP DO LINE INPUT #f, b$ IF LEFT$(TRIM$(UCASE$(b$)), 19) = "[VACCA_MAPPING_END]" THEN EXIT LOOP IF EOF(f) THEN EXIT FUNCTION i = VAL(PARSE$(b$, ",", 1)) IF ISFALSE i THEN ITERATE LOOP 'comment line IF i < LBOUND(VaccaNotes) OR i > UBOUND(VaccaNotes) THEN Warning "Invalid data in vacca.dat! i=" + STR$(i) warning "Did you forget to intialize the MM orchestra? (function Init_MM) EXIT FUNCTION END IF 'VaccaNotes(i).pitch = VAL(PARSE$(b$, ",", 2)) ' wrong, this must be frequency. Use nf instead: VaccaNotes(i).nf = VAL(PARSE$(b$, ",", 2)) ' AddNote2Har VaccaNotes(i).har, VaccaNotes(i).nf, 64 MID$(VaccaNotes(i).har, INT(VaccaNotes(i).nf) + 1, 1)= CHR$(64) VaccaNotes(i).pitch = 8.175795 * (2 ^ (VaccaNotes(i).nf / 12!)) 'NF2F(VaccaNotes(i).nf) 'IF VAL(PARSE$(b$, ",", 3)) > 0 THEN AddNote2Har VaccaNotes(i).har, VAL(PARSE$(b$, ",", 3)), 32 IF VAL(PARSE$(b$, ",", 3)) > 0 THEN MID$(VaccaNotes(i).har, INT(VaccaNotes(i).nf) + 1, 1)= CHR$(64) LOOP ' read also the minvel and maxvel datafields: - gwr. 11.06.2005 ' DO ' LINE INPUT #f, b$ ' IF LEFT$(TRIM$(UCASE$(b$)), 22) = "[VACCA_VELOCITIES_END]" THEN EXIT LOOP ' IF EOF(f) THEN EXIT FUNCTION ' i = VAL(PARSE$(b$, ",", 1)) ' IF ISFALSE i THEN ITERATE LOOP 'comment line ' IF i < LBOUND(VaccaNotes) OR i > UBOUND(VaccaNotes) THEN warning "Invalid data in vacca.dat! i=" + STR$(i): EXIT FUNCTION ' VaccaNotes(i).minvel = VAL(PARSE$(b$, ",", 2)) ' VaccaNotes(i).maxvel = VAL(PARSE$(b$, ",",3)) ' LOOP ' overwrite it, since no longer required: (unless we need it for prog. change 0) FOR i = LBOUND(Vaccanotes) TO UBOUND(Vaccanotes) VaccaNotes(i).minvel = 1 VaccaNotes(i).maxvel = 127 NEXT i FUNCTION = %true END FUNCTION FUNCTION GetVitelloMapping (BYREF VitelloNotes() AS kloktype) EXPORT AS LONG 'clone of GetVaccaMapping 'TO DO: read harmstrings from data file LOCAL f AS LONG LOCAL i AS LONG f = FREEFILE LOCAL b$ OPEN ".\robots\vacca\vitello.dat" FOR INPUT ACCESS READ LOCK WRITE AS f 'warning "getvaccamapping check" + STR$(LBOUND(Vaccanotes)) + STR$(UBOUND(vaccanotes)) DO LINE INPUT #f, b$ IF EOF(f) THEN CLOSE f: warning "could not find mapping section in vitello.dat!": EXIT FUNCTION IF LEFT$(TRIM$(UCASE$(b$)),17 ) = "[VITELLO_MAPPING]" THEN EXIT LOOP LOOP DO LINE INPUT #f, b$ IF LEFT$(TRIM$(UCASE$(b$)), 21) = "[VITELLO_MAPPING_END]" THEN EXIT LOOP IF EOF(f) THEN EXIT FUNCTION i = VAL(PARSE$(b$, ",", 1)) IF ISFALSE i THEN ITERATE LOOP 'comment line IF i < LBOUND(VitelloNotes) OR i > UBOUND(VitelloNotes) THEN Warning "Invalid data in vitello.dat! i=" + STR$(i) warning "Did you forget to intialize the MM orchestra? (function Init_MM) EXIT FUNCTION END IF 'VaccaNotes(i).pitch = VAL(PARSE$(b$, ",", 2)) ' wrong, this must be frequency. Use nf instead: VitelloNotes(i).nf = VAL(PARSE$(b$, ",", 2)) ' AddNote2Har VaccaNotes(i).har, VaccaNotes(i).nf, 64 MID$(VitelloNotes(i).har, INT(VitelloNotes(i).nf) + 1, 1)= CHR$(64) VitelloNotes(i).pitch = 8.175795 * (2 ^ (VitelloNotes(i).nf / 12!)) 'NF2F(VaccaNotes(i).nf) 'IF VAL(PARSE$(b$, ",", 3)) > 0 THEN AddNote2Har VaccaNotes(i).har, VAL(PARSE$(b$, ",", 3)), 32 IF VAL(PARSE$(b$, ",", 3)) > 0 THEN MID$(VitelloNotes(i).har, INT(VitelloNotes(i).nf) + 1, 1)= CHR$(64) LOOP ' ' read also the minvel and maxvel datafields: - gwr. 11.06.2005 ' DO ' LINE INPUT #f, b$ ' IF LEFT$(TRIM$(UCASE$(b$)), 22) = "[VACCA_VELOCITIES_END]" THEN EXIT LOOP ' IF EOF(f) THEN EXIT FUNCTION ' i = VAL(PARSE$(b$, ",", 1)) ' IF ISFALSE i THEN ITERATE LOOP 'comment line ' IF i < LBOUND(VaccaNotes) OR i > UBOUND(VaccaNotes) THEN warning "Invalid data in vacca.dat! i=" + STR$(i): EXIT FUNCTION ' VaccaNotes(i).minvel = VAL(PARSE$(b$, ",", 2)) ' VaccaNotes(i).maxvel = VAL(PARSE$(b$, ",",3)) ' LOOP ' overwrite it, since no longer required: (unless we need it for prog. change 0) FOR i = LBOUND(Vitellonotes) TO UBOUND(Vitellonotes) VitelloNotes(i).minvel = 1 VitelloNotes(i).maxvel = 127 NEXT i FUNCTION = %true END FUNCTION FUNCTION GetLlorMapping(BYREF LlorNotes() AS kloktype) EXPORT AS LONG 'not based on an ini file, but on th data from PlayLlor in g_midi.inc 'added 2006.08.16 to be able to include llor it he PlayKloks function in g_mm 'LlorNotes should be dimmed Llor.LowTes to Llor.HighTes before calling this function! LOCAL i AS LONG GetInstrumentParams Llor, %IDM_Llor 'was bug until 2061129 - Llor was not initialised in this dll! -> cause of errors in playkloks i = Llor.LowTes LlorNotes(i).nf = 64.43 INCR i LlorNotes(i).nf = 53.72 INCR i LlorNotes(i).nf = 59.96 INCR i LlorNotes(i).nf = 64.99 INCR i LlorNotes(i).nf = 44.68 ' 40 INCR i LlorNotes(i).nf = 68.80 ' 41 INCR i LlorNotes(i).nf = 52.84 ' 42 INCR i LlorNotes(i).nf = 58.22 ' 43 INCR i LlorNotes(i).nf = 64.02 ' 44 INCR i LlorNotes(i).nf = 70.07 ' 45 INCR i LlorNotes(i).nf = 72.86 ' 46 INCR i LlorNotes(i).nf = 79.11 ' 47 FOR i = Llor.Lowtes TO Llor.LowTes + 11 LlorNotes(i).pitch = 8.175795 * (2 ^ (LlorNotes(i).nf / 12!)) LlorNotes(i + 12).nf = LlorNotes(i).nf LlorNotes(i + 12).pitch = LlorNotes(i).pitch NEXT ' i = VARPTR(LlorNotes(Llor.LowTes + 12)) '? FUNCTION = %true END FUNCTION FUNCTION GetBellyMapping(BYREF BellyNotes() AS KlokType) EXPORT AS LONG 'based on InitKlokPArams function that used to be in g_robo.inc - name and use now similar to the corresponding functions for vitello and vacca 'see also Init_MM (g_mm.inc, dimensionering en init), PlayBelly (g_mm.inc) LOCAL f AS LONG LOCAL i AS LONG, j AS LONG LOCAL readok AS BYTE LOCAL b$ f = FREEFILE OPEN $BellyIni FOR INPUT ACCESS READ LOCK WRITE AS f readfile: DO LINE INPUT #f, b$ ' warning b$ IF UCASE$(LEFT$(TRIM$(b$), 14)) = "[BELLY_PARAMS]" THEN EXIT LOOP IF UCASE$(LEFT$(TRIM$(b$), 19)) = "[BELLY_HARMSTRINGS]" THEN GOTO ReadHarms IF EOF(f) THEN IF readok = &B011 THEN FUNCTION = %true ELSE Warning "Data missing in belly.dat! - Belly is not properly intialised! (" + FUNCNAME$ + ")" FUNCTION = %false END IF EXIT FUNCTION END IF LOOP DO LINE INPUT# f, b$ IF UCASE$(LEFT$(TRIM$(b$), 18)) = "[BELLY_PARAMS_END]" THEN EXIT LOOP IF EOF(f) THEN Warning "End of file reached to early in belly.dat! - Belly is not properly intialised! (" + FUNCNAME$ + ")" CLOSE f FUNCTION = %false EXIT FUNCTION END IF i = VAL(PARSE$(b$, ",", 1)) IF ISFALSE(i) AND MID$(TRIM$(PARSE$(b$, ",", 1)), 1, 1) <> "0" THEN ITERATE LOOP ' i = i + LBOUND(BellyNotes) IF (i < LBOUND(BellyNotes)) OR (i > UBOUND(BellyNotes)) THEN Warning "Invalid data in belly.dat! i=" + STR$(i) warning "Did you forget to intialize the MM orchestra? (function Init_MM) CLOSE f FUNCTION = %false EXIT FUNCTION END IF BellyNotes(i).pitch = VAL(PARSE$(b$, ",", 3)) BellyNotes(i).nf = (12! * (LOG(BellyNotes(i).pitch) - LOG(8.175795)) / (LOG(2))) BellyNotes(i).dbmin = VAL(PARSE$(b$, ",", 6)) BellyNotes(i).dbmax = VAL(PARSE$(b$, ",", 7)) BellyNotes(i).maxfreq = VAL(PARSE$(b$, ",", 8)) ' MID$(BellyNotes(i).har, INT(BellyNotes(i).nf) + 1, 1) = CHR$(64) LOOP 'min/maxvel handled by belly's own computer (?) FOR i = LBOUND(Bellynotes) TO UBOUND(Bellynotes) BellyNotes(i).minvel = 1 BellyNotes(i).maxvel = 127 NEXT i BIT SET readok, 0 IF readok = &B011 THEN FUNCTION = %true: EXIT FUNCTION GOTO readfile readharms: 'har.vel strings in between " " expected! 'note: the data in dftresults_hires.dat are much more precise than these harmstrings.. FOR i = 0 TO 33 IF EOF(f) THEN Warning "harmstring " + STR$(i) + " not found" CLOSE f : FUNCTION = %false: EXIT FUNCTION END IF INPUT# f, j, b$ IF j <> i THEN Warning "harmony string " + STR$(i) + "invalid" warning "note that there should be NO comments in between the harmony strings!" CLOSE f : FUNCTION = %false: EXIT FUNCTION END IF IF LEN(b$) <> 128 THEN warning "harmstring " + STR$(i) + " invalid" CLOSE f : FUNCTION = %false: EXIT FUNCTION END IF BellyNotes(LBOUND(BellyNotes) + i).har.vel = b$ NEXT BIT SET readok, 1 IF readok = &B011 THEN FUNCTION = %true: EXIT FUNCTION GOTO readfile END FUNCTION FUNCTION ReadPijFile (f AS STRING, BYREF P() AS BYTE) EXPORT AS LONG ' procedure to read our old P(i,j) format files ' the function returns de value of i (endcount) ' added and debugged, gwr 03.02.3009 LOCAL i AS INTEGER LOCAL j AS INTEGER LOCAL cnt AS LONG LOCAL n AS LONG LOCAL s AS LONG LOCAL c$ i = 0 j = 0 cnt = 0 n = FREEFILE OPEN f FOR BINARY AS #n s = LOF(#n) ' aantal bytes in file ' REDIM P((s \ 16)+1,15) AS BYTE ' eigenlijk (s\16),15, er is echter een extra 255 byte... IF (s \ 16) > UBOUND(P,1) THEN REDIM P((s \ 16)+1,15) AS BYTE WHILE ISFALSE EOF(#n) GET$ #n, 1, c$ P(i,j) = ASC(c$) ' op j=0 staat hooguit tc IF j= 0 THEN P(i,j) = P(i,j) MOD 12 ' IF j MOD 2 THEN ' ' P(i,j) is een midi noot ' ELSE ' ' P(i,j) is een velocity byte ' END IF INCR cnt j = cnt MOD 16 i = cnt \ 16 ' timetick counter WEND CLOSE #n FUNCTION = i END FUNCTION FUNCTION Chi_SetFreq (BYVAL frequency AS DWORD, BYREF msb AS BYTE, BYREF lsb AS BYTE) EXPORT AS BYTE ' Specific function for the robot ' this function returns the value for CC31 in its result ' the pitchbend settings are in msb and lsb ' It does not send the values to the robot, it just returns the values of ' the required parameters. ' 04.04.2016: debugged o.k. gwr STATIC ChiFreqs(), tog AS INTEGER LOCAL i, pb AS DWORD RESET msb, lsb IF ISFALSE tog THEN DIM ChiFreqs(39 TO 76) AS STATIC INTEGER ' lookup as implemented in the PIC firmware. ' this is a chromatic scale ChiFreqs(39) = 2489 ' midi noot 99 = Mib ChiFreqs(40) = 2637 ChiFreqs(41) = 2793 ChiFreqs(42) = 2910 ChiFreqs(43) = 3136 ChiFreqs(44) = 3322 ChiFreqs(45) = 3620 ChiFreqs(46) = 3729 ChiFreqs(47) = 3901 ChiFreqs(48) = 4186 ChiFreqs(49) = 4435 ChiFreqs(50) = 4698 ChiFreqs(51) = 4978 ChiFreqs(52) = 5274 ChiFreqs(53) = 5587 ChiFreqs(54) = 5820 ChiFreqs(55) = 6272 ChiFreqs(56) = 6644 ChiFreqs(57) = 7040 ChiFreqs(58) = 7458 ChiFreqs(59) = 7802 ' end extended range for Chi ChiFreqs(60) = 8372 ' here we started for ChiFreqs(61) = 8870 ChiFreqs(62) = 9397 ChiFreqs(63) = 9956 ChiFreqs(64) = 10548 ChiFreqs(65) = 11175 ChiFreqs(66) = 11840 ChiFreqs(67) = 12544 ' highest possible midi note ChiFreqs(68) = 13289 ChiFreqs(69) = 14080 ChiFreqs(70) = 14917 ChiFreqs(71) = 15804 ChiFreqs(72) = 16744 ChiFreqs(73) = 17739 ChiFreqs(74) = 18794 ChiFreqs(75) = 19912 ChiFreqs(76) = 21096 tog = %True END IF FUNCTION = %False i = 39 DO IF (frequency > ChiFreqs(i)) AND (frequency < (ChiFreqs(i) + 16383)) THEN pb = frequency - chifreqs(i) msb = pb \ 128 lsb = pb MOD 128 FUNCTION = i EXIT FUNCTION ELSE INCR i END IF LOOP UNTIL i = 77 END FUNCTION FUNCTION Chi_GetFreq (BYVAL cc31 AS BYTE, BYVAL msb AS BYTE, BYVAL lsb AS BYTE) EXPORT AS WORD ' returns the generated frequency for the demodulator in STATIC tog, i, Chifreqs() AS INTEGER 'beveiliging en begrenzing: cc31 = MIN(127,cc31) cc31 = MAX(0, cc31) msb = MIN(127,msb) msb = MAX(0, msb) lsb = MIN(127,lsb) lsb = MAX(0, lsb) IF ISFALSE tog THEN DIM ChiFreqs(0 TO 127) AS STATIC INTEGER FOR i = 0 TO 38 Chifreqs(i) = 21096 NEXT i ' lookup as implemented in the PIC firmware. ' this is a chromatic scale ChiFreqs(39) = 2489 ' midi noot 99 = Mib ChiFreqs(40) = 2637 ChiFreqs(41) = 2793 ChiFreqs(42) = 2910 ChiFreqs(43) = 3136 ChiFreqs(44) = 3322 ChiFreqs(45) = 3620 ChiFreqs(46) = 3729 ChiFreqs(47) = 3901 ChiFreqs(48) = 4186 ChiFreqs(49) = 4435 ChiFreqs(50) = 4698 ChiFreqs(51) = 4978 ChiFreqs(52) = 5274 ChiFreqs(53) = 5587 ChiFreqs(54) = 5820 ChiFreqs(55) = 6272 ChiFreqs(56) = 6644 ChiFreqs(57) = 7040 ChiFreqs(58) = 7458 ChiFreqs(59) = 7802 ' end extended range for Chi ChiFreqs(60) = 8372 ' here we started for ChiFreqs(61) = 8870 ChiFreqs(62) = 9397 ChiFreqs(63) = 9956 ChiFreqs(64) = 10548 ChiFreqs(65) = 11175 ChiFreqs(66) = 11840 ChiFreqs(67) = 12544 ' highest possible midi note ChiFreqs(68) = 13289 ChiFreqs(69) = 14080 ChiFreqs(70) = 14917 ChiFreqs(71) = 15804 ChiFreqs(72) = 16744 ChiFreqs(73) = 17739 ChiFreqs(74) = 18794 ChiFreqs(75) = 19912 ChiFreqs(76) = 21096 FOR i = 77 TO 127 Chifreqs(i) = 21096 NEXT i tog = %True END IF FUNCTION = Chifreqs(cc31) + (msb * 128) + lsb END FUNCTION FUNCTION Tinti_GetFreq (BYVAL cc31 AS BYTE, BYVAL msb AS BYTE, BYVAL lsb AS BYTE) EXPORT AS WORD ' returns the generated frequency for the demodulator in STATIC tog, i, freqs() AS INTEGER 'beveiliging en begrenzing: cc31 = MIN(127,cc31) cc31 = MAX(0, cc31) msb = MIN(127,msb) msb = MAX(0, msb) lsb = MIN(127,lsb) lsb = MAX(0, lsb) IF ISFALSE tog THEN DIM freqs(0 TO 127) AS STATIC INTEGER FOR i = 0 TO 11 freqs(i) = 21096 NEXT i ' lookup as implemented in the PIC firmware. ' this is a chromatic scale freqs(12) = 8372 ' here we start for freqs(13) = 8870 freqs(14) = 9397 freqs(15) = 9956 freqs(16) = 10548 freqs(17) = 11175 freqs(18) = 11840 freqs(19) = 12544 ' highest possible midi note freqs(20) = 13289 freqs(21) = 14080 freqs(22) = 14917 freqs(23) = 15804 freqs(24) = 16744 freqs(25) = 17739 freqs(26) = 18794 freqs(27) = 19912 freqs(28) = 21096 FOR i = 29 TO 127 freqs(i) = 21096 NEXT i tog = %True END IF FUNCTION = freqs(cc31) + (msb * 128) + lsb END FUNCTION FUNCTION Tinti_SetFreq (BYVAL frequency AS DWORD, BYREF msb AS BYTE, BYREF lsb AS BYTE) EXPORT AS BYTE ' Specific function for the robot ' this function returns the value for CC31 in its result ' the pitchbend settings are in msb and lsb ' It does not send the values to the robot, it just returns the values of ' the required parameters. ' 05.04.2016: debugged o.k. gwr STATIC Freqs(), tog AS INTEGER LOCAL i, pb AS DWORD RESET msb, lsb IF ISFALSE tog THEN DIM Freqs(12 TO 28) AS STATIC INTEGER ' lookup as implemented in the PIC firmware. ' this is a chromatic scale freqs(12) = 8372 ' here we start for freqs(13) = 8870 freqs(14) = 9397 freqs(15) = 9956 freqs(16) = 10548 freqs(17) = 11175 freqs(18) = 11840 freqs(19) = 12544 ' highest possible midi note freqs(20) = 13289 freqs(21) = 14080 freqs(22) = 14917 freqs(23) = 15804 freqs(24) = 16744 freqs(25) = 17739 freqs(26) = 18794 freqs(27) = 19912 freqs(28) = 21096 tog = %True END IF FUNCTION = %False i = 12 DO IF (frequency > Freqs(i)) AND (frequency < (Freqs(i) + 16383)) THEN pb = frequency - freqs(i) msb = pb \ 128 lsb = pb MOD 128 FUNCTION = i EXIT FUNCTION ELSE INCR i END IF LOOP UNTIL i = 29 END FUNCTION FUNCTION MidiLogFile(text$, OPT BYVAL filenam$) EXPORT AS LONG 'if called with filenam$ is passed, we open a new file 'date- and timestamp added, extension is allways .log STATIC flog AS LONG STATIC fileopen AS LONG 'init flag - we can't use flog as 0 is a valid filenr IF ISFALSE fileopen THEN fileopen = 1 IF ISFALSE LEN(filenam$) THEN EXIT FUNCTION END IF IF LEN(filenam$) THEN IF fileopen THEN CLOSE flog filenam$ = PARSE$(filenam$, ".", 1) 'strip extensions ' REPLACE " " WITH "_" IN filenam$ 'filenam$ = filenam$ + PARSE$(DATE$, "-", 3) + PARSE$(DATE$, "-", 1) + PARSE$(DATE$, "-", 2) + REMOVE$(TIME$, ANY ":") + ".log" 'adds yyyymmddhhmmss.log filenam$ = filenam$ + ".log" flog = FREEFILE OPEN filenam$ FOR OUTPUT ACCESS WRITE LOCK WRITE AS flog END IF PRINT# flog, text$ FUNCTION = flog 'so we can write to it from other places also - good for e.g. dumping an array END FUNCTION '[EOF]