' *************** ' * GMT_GWR.INC * ' *************** ' This code module links the GMT-engine to code modules and applications ' specific to Godfried-Willem Raes compositions and projects. ' Procedures contained herein are called from WinProc in GMT if the constant %gwr is defined. ' ******************************************************************************************* #IF %DEF(%gmt_wsb) DECLARE FUNCTION Wsb_InitServer () AS LONG #ENDIF #IF %DEF(%Bom) DECLARE FUNCTION InitBom () AS DWORD #IF %DEF(%ii_MIM) DECLARE FUNCTION Init_Mim () AS DWORD #ENDIF DECLARE FUNCTION Gestrobo_Init () AS DWORD DECLARE FUNCTION Quadradar_Init () AS DWORD #ENDIF FUNCTION WinProcGwrEx () EXPORT AS LONG ' extention of the main menu handler in GMT. ' It handles all initialisation for compositions by Godfried-Willem Raes. ' If you get to see this module, do not change or edit anything. ' Called as a function, it returns %True if conditions are fullfilled, else %False. ' Note that this function is called in StartApplication, so at this point we already have a handle ' for the cockpit! LOCAL m AS ASCIIZ * 200 LOCAL szTitelBox AS ASCIIZ * 50 LOCAL i AS LONG LOCAL conditions AS BYTE LOCAL hMenu AS LONG LOCAL CockpitLayo AS CockpitLabels FUNCTION = %False IF (App.id < %ID_GWR) OR (App.id > %ID_GWR + &H0FFF) THEN EXIT FUNCTION ' Warning "About to choose a GWR piece" & CHR$(10,13) & "tweede regel die zelf zou moeten wrappen naar volgende lijn" & CHR$(0), 10000 hMenu = GetMenu(gh.setup) szTitelBox = "G-Message for pieces by Godfried-Willem Raes" SELECT CASE App.Id CASE %ID_WSB_SERVER #IF %DEF(%gmt_wsb) FUNCTION = Wsb_InitServer () #ENDIF CASE %ID_TECHNOFAUSTUS #IF %DEF(%Faust) FUNCTION = Init_Faust #ENDIF CASE %ID_FIDELC #IF %DEF(%FidelC) FUNCTION = FidelC_Init #ENDIF CASE %ID_WOODSTOCK #IF %DEF(%Woodstock) FUNCTION = InitWoodStock #ENDIF CASE %ID_LICKSTICK #IF %DEF(%LickStick) FUNCTION = InitLickStick #ENDIF CASE %ID_CELLOPI #IF %DEF(%CelloPi) FUNCTION = CelloPiInit #ENDIF CASE %ID_WOODSTOCKJAZZ #IF %DEF(%WoodstockJazz) FUNCTION = InitWoodStockJazz #ENDIF CASE %ID_FALL95 #IF %DEF(%Fall95) IF ISFALSE hMidiO(0) THEN ErrorMidiOut ELSE ReadCockpitLabelsFromFile $Fall95INI, CockpitLayo ' also prints the labels to the cockpit! FUNCTION = InitFall95 END IF #ENDIF CASE %ID_WINTER #IF %DEF(%Winter95) FUNCTION = Init_Winter95 ' in betacom.inc #ENDIF CASE %ID_SUMMER ' , %ID_BETAPI #IF %DEF(%Summer94) FUNCTION = Init_Winter95 'Init_Summer94 ' in betacom.inc #ENDIF #IF %DEF(%Cohiba) CASE %ID_COHIBA FUNCTION = CohibaInit CASE %ID_PANATELLA FUNCTION = Init_Panatella #ENDIF CASE %ID_BAKLAVA #IF %DEF(%Baklava) ' requires the complete robot orchestra FUNCTION = Init_Baklava #ELSE FUNCTION = %False #ENDIF CASE %ID_OBOTEK #IF %DEF(%Obotek) szTitelBox = "" IF (hMidiI(0) <> %NULL) AND (hMidiO(0) <> %NULL) THEN SelectMidiEquipment $obotekini, Meq() Update_MidiEquipment Meq() ReadPatternRecognitionDataFile $obotekini ReadSynthConfigFile $Obotekini, Meq() ' ReadFaderParams $ObotekIni, Audiofader() ReadCockpitLabelsFromFile $ObotekIni, CockpitLayo OboeInit FUNCTION = %True ELSE IF ISFALSE hMidiI(0) THEN ErrorMidiIn IF ISFALSE hMidiO(0) THEN ErrorMidiOut END IF #ENDIF CASE %ID_TOVERFLUIT #IF %DEF(%Toverfluit) szTitelBox = "" IF (hMidiI(0) <> %NULL) AND (hMidiO(0) <> %NULL) THEN ReadPatternRecognitionDataFile $TOVERFLUITINI ' ReadFaderParams $TOVERFLUITINI, Audiofader() ReadCockpitLabelsFromFile $ToverfluitIni, CockpitLayo ToverInit ' insert here other piece specific initialisation code... ' this piece does not use synthe's but only automats... FUNCTION = %True ELSE IF ISFALSE hMidiI(0) THEN ErrorMidiIn IF ISFALSE hMidiO(0) THEN ErrorMidiOut END IF #ENDIF CASE %ID_BOXING #IF %DEF(%Boxing) szTitelBox = "" IF (hMidiI(0) > %NULL) OR (hMidiO(0) > %NULL) THEN BoxingInitSynth ' insert here other piece specific initialisation code... FUNCTION = %True ELSE IF ISFALSE hMidiI(0) THEN ErrorMidiIn IF ISFALSE hMidiO(0) THEN ErrorMidiOut END IF #ENDIF CASE %ID_CDF747 ' CDF747 #IF %DEF(%CDF747) szTitelBox = "" IF (hMidiI(0) > %NULL) AND (hMidiO(0) > %NULL) THEN CDFInitSynth ' insert here other piece specific initialisation code... FUNCTION = %True ELSE IF ISFALSE hMidiI(0) THEN ErrorMidiIn IF ISFALSE hMidiO(0) THEN ErrorMidiOut END IF #ELSE MissingCode "CDF747" ' in g_glib.dll #ENDIF CASE %ID_SINCS #IF %DEF(%Sincs) szTitelBox = "" IF (hMidiI(0) > %NULL) OR (hMidiO(0) > %NULL) THEN SincsInitSynth ' insert here other piece specific initialisation code... FUNCTION = %True ELSE IF ISFALSE hMidiI(0) THEN ErrorMidiIn IF ISFALSE hMidiO(0) THEN ErrorMidiOut END IF #ELSE MissingCode "Sincs" #ENDIF CASE %ID_SHIFTS_INS TO %ID_SHIFTS_DIM #IF %DEF(%Shifts) szTitelBox = "" 'conditions = %False conditions = Shifts_GetTranspositionData IF App.id = %ID_SHIFTS_JUST THEN Shifts_GetCents IF ISFALSE hMidiO(0) THEN conditions = %False ErrorMidiOut ELSE INCR conditions END IF SelectMidiEquipment $SHIFTSINI, Meq() SELECT CASE TRIM$(UCASE$(Meq(0).naam)) CASE "PROTEUS3","PROTEUS3XR","PROTEUS2","PROTEUS2XR" Shifts_ReadPatchesFromIniFile INCR conditions CASE "FB01","FB01_PROT3","FB01_SINE","FB01 SINEWAVES","FB01 + PROTEUS 3 FOR SHIFTS" Shifts_ReadPatchesFromIniFile INCR conditions CASE "PLAYPIAN", "RAES-TRIMPIN PLAYER PIANO" Shifts_ReadPatchesFromIniFile '- not required INCR conditions CASE "PROFORMANCE" Shifts_ReadPatchesFromIniFile INCR conditions CASE "PROTEUS2000", "PROTEUS 2000" Shifts_ReadPatchesFromIniFile INCR conditions CASE ELSE WrongSynth "Shifts" conditions = %False END SELECT Update_Midiequipment Meq() IF conditions = 3 THEN ' ReadFaderparams $SHIFTSINI,AudioFader() ReadCockpitLabelsFromFile $SHIFTSINI, CockpitLayo FUNCTION = Init_Shifts () ELSE m = "Wrong items selected for ..." + CHR$(13) MessageBox gh.Inst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST FUNCTION = %False END IF #ENDIF #IF %DEF(%Gorgonio) CASE %ID_GORGONIO FUNCTION = GorgelInit #ENDIF #IF %DEF(%sqe_sto) CASE %ID_SQE_STO , %ID_SQE, %ID_STO, %ID_G_TECHNO FUNCTION = Init_Sqe_Sto () ' in enseko compilation - needs radar and NiDAQ #ENDIF #IF %DEF(%primes) CASE %ID_PRIMES FUNCTION = Init_Primes () #ENDIF #IF %DEF(%JumpyVariations) CASE %ID_JUMPYVARIATIONS FUNCTION = InitJumpyVariations ' in Jumpy.bas ' Totems.bas/ Tendering.bas / Tropes.bas #ENDIF #IF %DEF(%FuzzyStuds) CASE %ID_FUZZYHARM FUNCTION = Init_FuzzyStudies #ENDIF CASE %ID_HYDROCEPHALLUS #IF %DEF(%HydroCephallus) szTitelbox = "" IF (hMidiI(0) <> %NULL) AND (hMidiO(0) <> %NULL) THEN HydroInitSynth ' insert here other piece specific initialisation code... FUNCTION = %True ELSE IF ISFALSE hMidiI(0) THEN ErrorMidiIn IF ISFALSE hMidiO(0) THEN ErrorMidiOut END IF #ENDIF #IF %DEF(%bom) CASE %ID_BOM99, %ID_SONGBOOK99 FUNCTION = InitBom CASE %ID_II_MIM #IF %DEF(%ii_mim) FUNCTION = Init_Mim #ENDIF CASE %ID_II_ROBOTS ' new section 20.03.2002 #IF %DEF(%ii_robot) FUNCTION = Gestrobo_Init #ENDIF CASE %ID_QUADRADAR ' new 08.02.2003 #IF %DEF(%ii_robot) FUNCTION = Quadradar_Init #ENDIF #ENDIF #IF %DEF(%HarmStuds) CASE %ID_CHORDCAT, %ID_HARMCAT, %ID_HARMSOLVE, %ID_FUJISAN FUNCTION = Init_HarmonyStudies CheckMenuItem hMenu, %ID_CHORDCAT, %MF_CHECKED CheckMenuItem hMenu, %ID_HARMCAT, %MF_CHECKED CheckMenuItem hMenu, %ID_HARMSOLVE, %MF_CHECKED CheckMenuItem hMenu, %ID_FUJISAN, %MF_CHECKED CASE %ID_RATMEL FUNCTION = Init_Ratmel ' in rational.inc CheckMenuItem hMenu, %ID_RATMEL, %MF_CHECKED ' 06.08.2020 #ENDIF #IF %DEF(%Spring94) CASE %ID_SPRING94 CheckMenuItem hMenu, %ID_SPRING94, %MF_CHECKED szTitelBox = "" SetDlgItemText gh.Cockpit, %GMT_TEXT0_ID+ 12, szTitelBox SetDlgItemText gh.Cockpit, %GMT_TEXT0_ID+ 13, $GWR FUNCTION = Init_Spring94 #ENDIF CASE %ID_ZERHACKER #IF %DEF(%zerhacker) szTitelBox = "" FUNCTION = Zerhacker_Init SetDlgItemText gh.Cockpit, %GMT_TEXT0_ID+ 12, szTitelBox SetDlgItemText gh.Cockpit, %GMT_TEXT0_ID+ 13, $GWR CheckMenuItem hMenu, %ID_ZERHACKER, %MF_CHECKED #ENDIF CASE %ID_NAMUDA #IF %DEF(%Namuda) 'meta kompilatie konstante in _namuda.inc szTitelBox = "" SetDlgItemText gh.Cockpit, %GMT_TEXT0_ID+ 12, szTitelBox SetDlgItemText gh.Cockpit, %GMT_TEXT0_ID+ 13, $GWR CheckMenuItem hMenu, %ID_NAMUDA, %MF_CHECKED FUNCTION = Namuda_Init #ELSE FUNCTION = %False #ENDIF END SELECT END FUNCTION SUB GetLastNote(noot?, velo?, instrument AS Musician) ' now a general usage procedure! (used by , , ) ' moved from Lickstick module 02.09.2001 STATIC tog AS BYTE STATIC Pregnancy () AS LONG LOCAL PrevVel? IF ISFALSE tog THEN tog = %True DIM Pregnancy(instrument.lowtes TO instrument.hightes) ' for pattern recognition. ' this array will contain the duration for each ' sounding note. (polyphonic) ' Note that the values are negative so that ' adding them to tnow, yields the time they are on END IF ' sets LastNotePlayed, a global variable ' and calls the pattern recognition procedure. ' This procedure is a slave of the Listen-task. ' It should be called after reception of a note on/off command. IF (noot? < instrument.lowtes) OR (noot? > instrument.hightes) THEN EXIT SUB ' this condition was allready fullfilled... IF velo? > instrument.minvel THEN ' we demand a minimum value for velo? as well of course... Pregnancy(noot?)= - timeGetTime ' set or reset time value negative. ' This array is declared as global. ' Keeps durations of notes played. (polyphonic!) ELSE IF ISFALSE velo? THEN ' on reception of a note-off... IF Pregnancy(noot?) < 0 THEN ' if a note ON time value was set... Pregnancy(noot?) = timeGetTime + Pregnancy(noot?) ' result will always be positive now. IF Pregnancy(noot?) >= instrument.minduur THEN ' duration must be larger than the criterium value LastNotePlayed = noot? ' this is a global. Here we publish its value. PrevVel? = ASC(MID$(Task(%Listen_Task).Har.vel ,noot?+1,1)) ' only if we need the velo value of the ' previous note in the pattern recognition procedure. ' now we call the pattern recognition procedure: MatchPattern noot?, PrevVel? ,Pregnancy(noot?) ' we should pass velo? from previous note! END IF Pregnancy(noot?) = %False ' reset the duration value for this note END IF ELSE ' very soft note on Pregnancy(noot?)= %False END IF END IF END SUB SUB MatchPattern (noot?, velo?, duur AS LONG) EXPORT ' this proc. is a much improved version of the old melodypatternrecognize in GMT. ' It works in a non sequential way, and is capable of recognizing a pattern out of a whole series ' of patterns read in on the beforehand, or -calculated in real time. ' It should be called on each reception of a note-off command that sets LastNotePlayed. ' It is a slave of CelloPiGetLastNote, in its turn a slave of CelloPiListen. ' Also used in Baklava... LOCAL i AS BYTE, j AS INTEGER, iij AS BYTE ' local counters LOCAL sollduur AS LONG LOCAL CaptureRange AS LONG LOCAL matched AS LONG ' ------------------------------------------------------------ ' start recognizing: ' search the patterns with the highest number of notes already recognized first: FOR j = 15 TO 0 STEP -1 ' 15 = maximum number of notes in a pattern (16-1) FOR i= 0 TO UBOUND(PatternSeq) IF PatternSeq(i).Score = j THEN GOSUB CheckNote NEXT i NEXT j EXIT SUB CheckNote: ' in the next code, we make sure we look first for notes to recognize in those ' patterns that have already a maximum number of flags set. ' Therefore we descend backwards in the patterns: ' j = PatternSeq(i).Score IF (noot? = PatternSeq(i).Noot(j)) OR (noot? = PatternSeq(i).AltNoot(j)) THEN ' recalculate the duration in function of the tempo, in ms: ' thus we we can cope with changing tempo in real time, if we want to... IF ISFALSE PatternSeq(i).Tempo THEN MSGBOX "BUG in MatchPattern " ,,FUNCNAME$ EXIT SUB END IF sollduur = (60/PatternSeq(i).Tempo) * PatternSeq(i).Duur(j) * 1000 ' adjust for tempo and convert to ms. CaptureRange = sollduur * (PatternSeq(i).Duurfout / 100!) 'IF CaptureRange < Sollduur then CaptureRange = Sollduur -1 ' added 13.01.2001 ??? IF duur >= sollduur - CaptureRange THEN IF duur <= sollduur + CaptureRange THEN INCR PatternSeq(i).Score IF j = PatternSeq(i).Lengte -1 THEN ' in this case a complete pattern was recognized... ' reset all other flags... FOR iij = 0 TO UBOUND(PatternSeq) PatternSeq(iij).Score = %False NEXT iij ' perform the required actions... recog.nr = i + 1 'LastPatternMatched CALL DWORD recog.cPtr ' Display the complete sequence marked as played ' this serves as acknowledge for the musicians: ' if then...: matched = %true END IF IF gh.MelPat THEN SELECT CASE App.id CASE %ID_CELLOPI DrawMelodyOn2Staves gh.MelPat, i, j ' since in this piece pattern recognition is no longer ' sequencial, it makes no sense to display the next pattern to be ' recognized... ' Of course we could display a suggested pattern... CASE %ID_LICKSTICK DrawAllPatterns gh.MelPat CASE %ID_WOODSTOCK DrawAllPatterns gh.MelPat CASE %ID_PANATELLA DrawAllPatterns gh.MelPat CASE %ID_BAKLAVA DrawMelodyOn2Staves gh.MelPat, i, j END SELECT END IF IF matched THEN EXIT SUB END IF END IF END IF RETURN END SUB SUB gPrint() EXPORT STATIC tog AS BYTE STATIC id& STATIC hDlg& LOCAL i AS LONG LOCAL TXT() AS STRING ' required for listbox and combobox... LOCAL hDC AS LONG ' for color experiment LOCAL LpPaint AS PaintStruct ' for color experiment IF ISFALSE tog THEN tog = %true id& = 1 DIM TXT(0 TO 20) ' 0 to nritems -1 FOR i = 0 TO UBOUND(TXT) TXT(i) = TXT(i) & STR$(i) & $CRLF ' for listbox and combobox NEXT i DIALOG NEW %HWND_DESKTOP, "GMT-G",%CW_USEDEFAULT,%CW_USEDEFAULT,_ 250,350,_ %WS_MAXIMIZEBOX OR %WS_MINIMIZEBOX OR %WS_THICKFRAME OR %WS_CAPTION,_ %WS_EX_TOOLWINDOW TO hDlg& CONTROL ADD COMBOBOX, hDlg&,id&,TXT(),0,0,250,350,%LBS_EXTENDEDSEL,%WS_EX_WINDOWEDGE ' creates a selector! 'CONTROL ADD LISTBOX, hDlg&,id&,txt(),0,0,250,350,%LBS_EXTENDEDSEL,%WS_EX_WINDOWEDGE ' hDC = BeginPaint(hDlg&, lpPaint) ' SetTextColor hDC, &H0000FFFF 'yellow ' &H0003F010 ' GREEN ' SetBkColor hDC, &H00FF0000 'Blue '&H000000FF ' RED ' 'SendDlgItemMessage hDlg&, id&,%WM_CTLCOLORSTATIC,hDc,&H000000FF ' EndPaint hDlg&, lpPaint DIALOG SHOW MODELESS hDlg& ELSE DIM TXT(0 TO 20) LOCAL TXT$ FOR i = 0 TO UBOUND(TXT) TXT(i) = TXT(i) & STR$(i)& $gwr & $CRLF TXT$= TXT$ + TXT(i) NEXT i CONTROL SET TEXT hDlg&,id&,TXT$ 'COMBOBOX ADD hDlg&,id&,txt() ' hDC = BeginPaint(hDlg&, lpPaint) ' SetTextColor hDC, &H0000FFFF 'yellow ' &H0003F010 ' GREEN ' SetBkColor hDC, &H00FF0000 'Blue '&H000000FF ' RED ' SendDlgItemMessage hDlg&, id&,%WM_CTLCOLORDLG,hDc,&H00FF00 ' DIALOG SEND hDlg&, %WM_CTLCOLORDLG, hDc, &H0003F010 ' CONTROL SEND hDlg&, id&,%WM_CTLCOLORSTATIC,hDc,&H000000FF ' EndPaint hDlg&, lpPaint InvalidateRect hDlg&, BYVAL 0, BYVAL 1 ' ??? 22.02.2000 END IF END SUB SUB gwrAudioDelay () EXPORT ' used in and in ' the required delay time should be set in Task().duur ' in ms. ' the run duration of the audiodelay should be known and passed in Task().stoptime ( expressed in seconds) STATIC Jumpval AS BYTE LOCAL retval AS LONG IF ISFALSE Task(%AudioDelay_Task).tog THEN IF (Task(%AudioDelay_Task).swit AND %TASK_BUSY) = %d1 THEN EXIT SUB CheckAudio Audio, App IF ISFALSE Audio.hWi THEN StopTask %AudioDelay_Task : EXIT SUB IF ISFALSE Audio.hWo THEN StopTask %AudioDelay_Task : EXIT SUB IF ISFALSE Task(%AudioDelay_Task).duur THEN StopTask %AudioDelay_task: EXIT SUB Task(%AudioDelay_Task).tog = %True Jumpval = %False Audio.DelayTime = Task(%AudioDelay_Task).duur SetAudio Audio END IF SELECT CASE Jumpval CASE %False retval = RecordAudioSample (Audio.Delaytime) SELECT CASE retval CASE -2 ' fatal error Stoptask %AudioDelay_Task EXIT SUB CASE -1 ' try again later... ' in this case we could not find a track... Task(%AudioDelay_Task).freq = 17 Jumpval = %False EXIT SUB CASE 0 TO 15 'Audio.ToDisk = %True ' test, using diskbuffer... [ works o.k., with glitches] Audio.ToDisk = %False ' we use memory buffers only. Audio.DelayLine = %True SetAudio Audio Task(%AudioDelay_Task).starttime = timeGetTime \ 1000 Task(%AudioDelay_Task).stoptime = Task(%AudioDelay_Task).stoptime + Task(%AudioDelay_Task).starttime Jumpval = %True END SELECT CASE %True ' in case it was stopped due to an error in the callback, we should stop the task: CheckAudio Audio, App IF ISFALSE Audio.DelayLine THEN StopTask %AudioDelay_Task END IF ' in this case the delay line was started and is running... IF (timeGetTime \ 1000) > Task(%AudioDelay_Task).stoptime THEN Audio.DelayLine = %False Audio.DelayTime = %False SetAudio Audio Jumpval = 2 ELSE Task(%AudioDelay_Task).freq = 5 EXIT SUB END IF CASE 2 ' version before 17.03.2000: ' wait until devices have stopped playing/recording before cancelling this task. ' IF TrackStatus.recordingtrack = -1 THEN ' Jumpval = %False ' StopTask %AudioDelay_Task ' ELSE ' Task(%AudioDelay_Task).freq = 10 ' END IF ' version 17.03.2000: Jumpval = %False StopTask %AudioDelay_Task END SELECT END SUB SUB gwrRecordSample () EXPORT ' real time sampling task. ' the task will wait until recording device becomes available, if it is found to be busy. ' it will cancel itself if a fatal error occurs. STATIC Jumpval AS BYTE STATIC Tracknr AS LONG IF ISFALSE Task(%AudioSample_Task).tog THEN IF (Task(%AudioSample_Task).swit AND %TASK_BUSY) = %d1 THEN EXIT SUB CheckAudio Audio, App IF ISFALSE Audio.hWi THEN StopTask %AudioSample_Task: EXIT SUB IF ISFALSE Audio.hWo THEN StopTask %AudioSample_Task: EXIT SUB IF ISFALSE Task(%AudioSample_Task).duur THEN StopTask %AudioSample_Task: EXIT SUB Task(%AudioSample_Task).tog = %True Jumpval = %False END IF ' the duration of the sample to record should be passed in Task().duur ' If the recording device is not free, we postpone the action until the moment it becomes free again: ' To this purpose we use Jumpval: SELECT CASE Jumpval CASE %False ' we should save the tracknr... TrackNr = RecordAudioSample (Task(%AudioSample_Task).duur) ' duration is in milliseconds. SELECT CASE TrackNr CASE -2 ' fatal error StopTask %AudioSample_Task CASE -1 'try again later... Jumpval = %False Task(%AudioSample_Task).freq = 10 EXIT SUB CASE 0 TO 15 Audio.ToDisk = %True ' set the flag for recording to disk SetAudio Audio ' publish to dll Task(%AudioSample_Task).freq= 1000!/Task(%AudioSample_Task).duur Jumpval = %True END SELECT CASE %True ' a recording for this task is going on. Task(%AudioSample_Task).freq = 50 ' check TrackStatus.recording(Tracknr) being true or false... IF TrackStatus.recording(Tracknr) THEN Task(%AudioSample_Task).freq = 20 EXIT SUB ELSE ' recording finished. Jumpval = %False ' as long as the task is active, it could go on recording samples... ' unless of course, we switch the task off here: Task(%AudioSample_Task).tog = %False StopTask %AudioSample_Task Recording_Available = %True ' flag to signal availibility of a recorded sample. END IF END SELECT END SUB SUB gwrPlayRecordedSample () STATIC Jumpval AS BYTE STATIC Track AS LONG STATIC duur AS DWORD LOCAL LastRecordedFileName AS ASCIIZ * 40 LOCAL retval AS LONG IF ISFALSE Task(%AudioPlayRecordedSample_Task).tog THEN IF (Task(%AudioPlayRecordedSample_Task).swit AND %TASK_BUSY) = %d1 THEN EXIT SUB IF ISFALSE Audio.hWo THEN Stoptask %AudioPlayRecordedSample_Task : EXIT SUB Jumpval = %False track = -1 CheckAudio Audio, App LastRecordedFileName = "GMT_" + HEX$(Audio.iCnt-1) + ".WAV" + CHR$(0) IF ISFALSE Existfile(UCASE$(LastRecordedFileName)) THEN StopTask %AudioPlayRecordedSample_Task EXIT SUB END IF Task(%AudioPlayRecordedSample_Task).tog = %True END IF IF ISFALSE Jumpval THEN ' get a free audio-track and fill it with the file audio data: Track = ReadWaveData (LastRecordedFileName) IF Track > -1 THEN ' bereken de duur van het te spelen sample... ' in milliseconds duur = TrackDuration (Track) IF ISFALSE duur THEN MSGBOX "[RTSamplePlayer] ZERO-error on track duration" SizeAudioTrack Track, %False StopTask %AudioPlayRecordedSample_Task EXIT SUB END IF DeglitchStart WavHdr(Track) ' dll DeglitchTail WavHdr(Track) ' dll Jumpval = %True ELSE Jumpval = %False ' we try again until a track becomes available. EXIT SUB END IF END IF SELECT CASE JumpVal CASE %False EXIT SUB CASE %True retval = PlayAudioTrack (Track, %Null) SELECT CASE retval CASE Track ' o.k. wait until done. Task(%AudioPlayRecordedSample_Task).freq = 1000 / duur Jumpval = 2 EXIT SUB CASE -1 Task(%AudioPlayRecordedSample_Task).freq = 6 Jumpval = %True ' try again ' exit and wait until device becomes available: EXIT SUB CASE ELSE Jumpval = %False ' release the track! SizeAudioTrack Track, %False Stoptask %AudioPlayRecordedSample_Task EXIT SUB END SELECT CASE 2 IF TrackStatus.playing(Track) THEN Task(%AudioPlayRecordedSample_Task).freq = 30 Jumpval = 2 EXIT SUB END IF ' now we can stop the task and free its resources: Task(%AudioPlayRecordedSample_Task).tog = %False Task(%AudioPlayRecordedSample_Task).freq = 20 Jumpval = %False StopTask %AudioPlayRecordedSample_Task END SELECT END SUB SUB gwrPlayReversed () STATIC Jumpval AS BYTE LOCAL LastRecordedFileName AS ASCIIZ * 40 LOCAL freq AS SINGLE STATIC Track AS LONG STATIC Track2 AS LONG LOCAL duur AS DWORD LOCAL retval AS LONG IF ISFALSE Task(%AudioPlayReversed_Task).tog THEN IF (Task(%AudioPlayReversed_Task).swit AND %TASK_BUSY) = %d1 THEN EXIT SUB CheckAudio Audio, App IF ISFALSE Audio.hWo THEN Stoptask %AudioPlayReversed_Task : EXIT SUB LastRecordedFileName = "GMT_" + HEX$(Audio.iCnt-1) + ".WAV" + CHR$(0) IF ISFALSE Existfile(UCASE$(LastRecordedFileName)) THEN StopTask %AudioPlayReversed_Task: EXIT SUB Task(%AudioPlayReversed_Task).tog = %True Jumpval = %False END IF SELECT CASE Jumpval CASE %False ' get a free audio-track and fill it with the file audio data: Track = ReadWaveData (LastRecordedFileName) SELECT CASE Track CASE -2 ' fatal error StopTask %AudioPlayReversed_Task EXIT SUB CASE -1 ' try again later... Jumpval = %False EXIT SUB CASE 0 TO 15 ' bereken de duur van het te spelen sample... duur = Trackduration (Track) Track2 = GetFreeAudioTrack IF Track2 > -1 THEN retval = SizeAudioTrack (Track2,duur) Reverse WavHdr(Track), WavHdr(Track2) ' o.k. DeglitchStart WavHdr(Track2) DeglitchTail WavHdr(Track2) retval = PlayAudioTrack (Track2, %Null) ' skip if failure IF retval = Track2 THEN Task(%AudioPlayReversed_Task).freq = 1000 / duur ' release the original track! SizeAudioTrack Track, %False Jumpval = %True ELSE ' stoptask... ' release tracks!! SizeAudioTrack Track, %False SizeAudioTrack Track2, %False Stoptask %AudioPlayReversed_Task EXIT SUB END IF ELSE Jumpval = %False EXIT SUB END IF END SELECT CASE %True IF TrackStatus.Playing(track2) THEN ' this means the task is still playing the sample Task(%AudioPlayReversed_Task).freq = 37 EXIT SUB ELSE ' now we can stop the task and free its resources: Task(%AudioPlayReversed_Task).tog = %False Task(%AudioPlayReversed_Task).freq = 20 StopTask %AudioPlayReversed_Task EXIT SUB END IF END SELECT END SUB SUB gwrCrossModulator () STATIC Jumpval AS BYTE STATIC effdone AS BYTE STATIC Track AS LONG STATIC duur AS DWORD LOCAL LastRecordedFileName AS ASCIIZ * 40 LOCAL retval AS LONG IF ISFALSE Task(%AudioCrossModulator_Task).tog THEN IF (Task(%AudioCrossModulator_Task).swit AND %TASK_BUSY) = %d1 THEN EXIT SUB IF ISFALSE Audio.hWo THEN Stoptask %AudioCrossModulator_Task : EXIT SUB Task(%AudioCrossModulator_Task).tog = %True ' set as soon as Audio.playing becomes false Jumpval = %False effdone = %False track = -1 CheckAudio Audio, App LastRecordedFileName = "GMT_" + HEX$(Audio.iCnt-1) + ".WAV" + CHR$(0) IF ISFALSE Existfile(UCASE$(LastRecordedFileName)) THEN StopTask %AudioCrossModulator_Task EXIT SUB END IF END IF SELECT CASE Jumpval CASE %False ' get a free audio-track and fill it with the file audio data: Track = ReadWaveData (LastRecordedFileName) IF Track > -1 THEN Jumpval = %True ' bereken de duur van het te spelen sample... ' in milliseconds duur = TrackDuration (Track) IF ISFALSE duur THEN MSGBOX "[CrossModulator] ZERO-error on track duration" SizeAudioTrack Track, %False StopTask %AudioCrossModulator_Task END IF IF ISFALSE effdone THEN CrossModulate WavHdr(Track) ' dll DeglitchStart WavHdr(Track) ' dll DeglitchTail WavHdr(Track) ' dll effdone = %True END IF ELSE Jumpval = %False EXIT SUB END IF END SELECT SELECT CASE JumpVal CASE %False EXIT SUB CASE %True retval = PlayAudioTrack (Track, %Null) SELECT CASE retval CASE Track Task(%AudioCrossModulator_Task).freq = 1000 / duur effdone = %False Jumpval = 2 EXIT SUB CASE -1 Task(%AudioCrossModulator_Task).freq = 1 Jumpval = %True ' try again effdone = %True ' exit and wait until device becomes available: EXIT SUB CASE ELSE effdone = %False Jumpval = %False ' release the track! SizeAudioTrack Track, %False Stoptask %AudioCrossModulator_Task END SELECT CASE 2 IF TrackStatus.playing(track) THEN Task(%AudioCrossModulator_Task).freq = 34 EXIT SUB END IF ' now we can stop the task and free its resources: Task(%AudioCrossModulator_Task).tog = %False Task(%AudioCrossModulator_Task).freq = 20 effdone = %False Jumpval = %False StopTask %AudioCrossModulator_Task END SELECT END SUB SUB gwrCrossTimeModulator () STATIC Jumpval AS BYTE STATIC effdone AS BYTE STATIC Track AS LONG STATIC duur AS DWORD LOCAL LastRecordedFileName AS ASCIIZ * 40 LOCAL retval AS LONG IF ISFALSE Task(%AudioCrossTimeModulator_Task).tog THEN IF (Task(%AudioCrossTimeModulator_Task).swit AND %TASK_BUSY) = %d1 THEN EXIT SUB IF ISFALSE Audio.hWo THEN Stoptask %AudioCrossTimeModulator_Task : EXIT SUB Task(%AudioCrossTimeModulator_Task).tog = %True Jumpval = %False effdone = %False track = -1 CheckAudio Audio, App LastRecordedFileName = "GMT_" + HEX$(Audio.iCnt-1) + ".WAV" + CHR$(0) IF ISFALSE Existfile(UCASE$(LastRecordedFileName)) THEN StopTask %AudioCrossTimeModulator_Task EXIT SUB END IF END IF SELECT CASE Jumpval CASE %False ' get a free audio-track and fill it with the file audio data: Track = ReadWaveData (LastRecordedFileName) IF Track > -1 THEN Jumpval = %True ' bereken de duur van het te spelen sample... duur = TrackDuration(Track) IF duur = %False THEN MSGBOX "[CrossModulator] ZERO-error on track duration" SizeAudioTrack Track, %False StopTask %AudioCrossTimeModulator_Task END IF IF ISFALSE effdone THEN CrossTimeModulate WavHdr(Track) ' dll DeglitchStart WavHdr(Track) ' dll DeglitchTail WavHdr(Track) ' dll effdone = %True END IF ELSE Jumpval = %False EXIT SUB END IF END SELECT SELECT CASE JumpVal CASE %False EXIT SUB CASE %True retval = PlayAudioTrack (Track,%Null) SELECT CASE retval CASE Track Task(%AudioCrossTimeModulator_Task).freq = 1000 / duur effdone = %False Jumpval = 2 EXIT SUB CASE -1 Task(%AudioCrossTimeModulator_Task).freq = 1 Jumpval = %True ' try again effdone = %True ' exit and wait until device becomes available: EXIT SUB CASE ELSE effdone = %False Jumpval = %False ' release the track! SizeAudioTrack Track, %False Stoptask %AudioCrossTimeModulator_Task END SELECT CASE 2 IF TrackStatus.playing(track) THEN Task(%AudioCrossTimeModulator_Task).freq = 35 EXIT SUB END IF ' now we can stop the task and free its resources: Task(%AudioCrossTimeModulator_Task).tog = %False Task(%AudioCrossTimeModulator_Task).freq = 20 effdone = %False Jumpval = %False StopTask %AudioCrossTimeModulator_Task END SELECT END SUB SUB gwrReverb () STATIC Jumpval AS BYTE STATIC effdone AS BYTE STATIC Track AS LONG STATIC duur AS DWORD LOCAL LastRecordedFileName AS ASCIIZ * 40 LOCAL retval AS LONG IF ISFALSE Task(%AudioReverb_Task).tog THEN IF (Task(%AudioReverb_Task).swit AND %TASK_BUSY) = %d1 THEN EXIT SUB IF ISFALSE Audio.hWo THEN Stoptask %AudioReverb_Task : EXIT SUB Task(%AudioReverb_Task).tog = %True Jumpval = %False effdone = %False track = -1 CheckAudio Audio, App LastRecordedFileName = "GMT_" + HEX$(Audio.iCnt-1) + ".WAV" + CHR$(0) IF ISFALSE Existfile(UCASE$(LastRecordedFileName)) THEN StopTask %AudioReverb_Task EXIT SUB END IF END IF SELECT CASE Jumpval CASE %False ' get a free audio-track and fill it with the file audio data: Track = ReadWaveData (LastRecordedFileName) IF Track > -1 THEN Jumpval = %True ' bereken de duur van het te spelen sample... duur = TrackDuration(Track) IF duur = %False THEN MSGBOX "[Reverb] ZERO-error on track duration" SizeAudioTrack Track, %False StopTask %AudioReverb_Task END IF IF ISFALSE effdone THEN ReSizeAudioTrack Track, duur + 500 ' to play safe... WaveAddReverb WavHdr(Track), 100, 0.5 ' dll call ' NulT is the time before the first reflection starts. This is proportionate to roomsize. ' factor reflects the amount of reverb. If 1 is passed, the reverb is infinite and the wave might clip... ' On entry, it is up to the user to resize the wavebuffer such as to make place for the reverb at the end of the ' wave. So you should stuff the wavebuffer with silence prior to calling the procedure. DeglitchStart WavHdr(Track) DeglitchTail WavHdr(Track) effdone = %True END IF ELSE Jumpval = %False EXIT SUB END IF END SELECT SELECT CASE JumpVal CASE %False EXIT SUB CASE %True retval = PlayAudioTrack (Track,%Null) SELECT CASE retval CASE Track Task(%AudioReverb_Task).freq = 1000 / duur effdone = %False Jumpval = 2 EXIT SUB CASE -1 Task(%AudioReverb_Task).freq = 1 Jumpval = %True ' try again effdone = %True ' exit and wait until device becomes available: EXIT SUB CASE ELSE effdone = %False Jumpval = %False ' release the track! SizeAudioTrack Track, %False Stoptask %AudioReverb_Task END SELECT CASE 2 IF TrackStatus.playing(track) THEN Task(%AudioReverb_Task).freq = 35 EXIT SUB END IF ' now we can stop the task and free its resources: Task(%AudioReverb_Task).tog = %False Task(%AudioReverb_Task).freq = 20 effdone = %False Jumpval = %False StopTask %AudioReverb_Task END SELECT END SUB SUB gwrAM () STATIC Jumpval AS BYTE STATIC effdone AS BYTE STATIC Track AS LONG STATIC duur AS DWORD LOCAL LastRecordedFileName AS ASCIIZ * 40 LOCAL retval AS LONG LOCAL freq AS SINGLE ' note: the modulation pitch is passed in Task().pan and converted to the appropriate frequency here. ' the modulation depht is passed in Task().level and normalized in this task. IF ISFALSE Task(%AudioAM_Task).tog THEN IF (Task(%AudioAM_Task).swit AND %TASK_BUSY) = %d1 THEN EXIT SUB IF ISFALSE Audio.hWo THEN Stoptask %AudioAM_Task : EXIT SUB Task(%AudioAM_Task).tog = %True Jumpval = %False effdone = %False track = -1 CheckAudio Audio, App LastRecordedFileName = "GMT_" + HEX$(Audio.iCnt-1) + ".WAV" + CHR$(0) IF ISFALSE Existfile(UCASE$(LastRecordedFileName)) THEN StopTask %AudioAM_Task EXIT SUB END IF END IF SELECT CASE Jumpval CASE %False ' get a free audio-track and fill it with the file audio data: Track = ReadWaveData (LastRecordedFileName) IF Track > -1 THEN Jumpval = %True ' bereken de duur van het te spelen sample... duur = TrackDuration(Track) IF duur = %False THEN MSGBOX "[Reverb] ZERO-error on track duration" SizeAudioTrack Track, %False StopTask %AudioAM_Task END IF IF ISFALSE effdone THEN freq = N2F(Task(%AudioAM_Task).pan) AmplitudeModulate Track, freq,_ freq * 1.5,_ Task(%AudioAM_Task).level / 127!,_ Task(%AudioAM_Task).level / 127! effdone = %True END IF ELSE Jumpval = %False EXIT SUB END IF END SELECT SELECT CASE JumpVal CASE %False EXIT SUB CASE %True retval = PlayAudioTrack (Track,%Null) SELECT CASE retval CASE Track Task(%AudioAM_Task).freq = 1000 / duur effdone = %False Jumpval = 2 EXIT SUB CASE -1 Task(%AudioAM_Task).freq = 1 Jumpval = %True ' try again effdone = %True ' exit and wait until device becomes available: EXIT SUB CASE ELSE effdone = %False Jumpval = %False ' release the track! SizeAudioTrack Track, %False Stoptask %AudioAM_Task END SELECT CASE 2 IF TrackStatus.playing(track) THEN Task(%AudioAM_Task).freq = 35 EXIT SUB END IF ' now we can stop the task and free its resources: Task(%AudioAM_Task).tog = %False Task(%AudioAM_Task).freq = 20 effdone = %False Jumpval = %False StopTask %AudioAM_Task END SELECT END SUB SUB gwrHarmSynth () ' test for our additive synthesizer procedure in the DLL STATIC Jumpval AS BYTE STATIC Track AS LONG STATIC duur AS DWORD LOCAL retval AS LONG LOCAL n AS INTEGER LOCAL v AS BYTE IF ISFALSE Task(%HarmSynth_Task).tog THEN IF (Task(%HarmSynth_Task).swit AND %TASK_BUSY) = %d1 THEN EXIT SUB IF ISFALSE Audio.hWo THEN Stoptask %HarmSynth_Task : EXIT SUB Task(%HarmSynth_Task).tog = %True Jumpval = %False track = -1 duur = 1000 END IF SELECT CASE Jumpval CASE %False ' test for FMDiad: Track = GenerateFMDiadWave (N2F(LastNotePlayed), 814, 1, 0.5, duur) ' works o.k. ' synthesize a sample conforming to globhar: ' Track = GenerateHarmWave (Task(App.GlobalHarmonyTasknr).Har,64,duur) ' FillHarType Task(App.GlobalHarmonyTasknr).Har ' n = GetStrongest(Task(App.GlobalHarmonyTasknr).Har, 1) ' v = Task(App.GlobalHarmonyTasknr).Har.C(n) * 127 'ASC(MID$(Task(App.GlobalHarmonyTasknr).Har.vel,n+1,1)) ' IF (n > 0) AND (v > 0) THEN ' Track = GenerateSineWave (72 + n, v, 64, duur) ' ELSE ' Jumpval = %False ' EXIT SUB ' END IF ' 'Track = GenerateSineWave (64,120, 48, duur) ' works o.k. IF Track > -1 THEN Jumpval = %True ELSE Jumpval = %False EXIT SUB END IF ' test Wave2Enveloppe: - for Kristof Lauwers... ' IF Track > -1 THEN ' DIM Env(0 TO 0) AS LOCAL SINGLE ' DIM f AS STRING * 5 ' f = "12210" ' DIM k AS STRING * 1 ' k = "2" ' DIM ln AS STRING * 3 ' ln = "LIN" ' Wave2Enveloppe Wavhdr(Track), Env(),f,k,ln ' LOCAL s AS STRING ' LOCAL i AS LONG ' FOR i = 1 TO UBOUND(Env) ' s = s + STR$(Env(i)) + " " ' NEXT i ' warning s, 10000 ' END IF END SELECT SELECT CASE JumpVal CASE %False EXIT SUB CASE %True retval = PlayAudioTrack (Track,%Null) SELECT CASE retval CASE Track Task(%HarmSynth_Task).freq = 1000 / duur Jumpval = 2 EXIT SUB CASE -1 Task(%HarmSynth_Task).freq = 1 Jumpval = %True ' try again ' exit and wait until device becomes available: EXIT SUB CASE ELSE Jumpval = %False ' release the track! SizeAudioTrack Track, %False Stoptask %HarmSynth_Task END SELECT CASE 2 IF TrackStatus.playing(track) THEN Task(%HarmSynth_Task).freq = 35 EXIT SUB END IF ' now we can stop the task and free its resources: Task(%HarmSynth_Task).tog = %False Task(%HarmSynth_Task).freq = 20 Jumpval = %False StopTask %HarmSynth_Task END SELECT END SUB SUB ReadPatternRecognitionDataFile (PatternFileName$) EXPORT ' we limit the acceptable size of sequences for pattern recognition to 16 events. ' This is practically well above what the software can handle. ' If users want to experiment with longer sequences, they are advised to split the ' pattern to be matched into smaller components or chunks. ' There is no practical limit to the number of patterns in the file. ReadFlagDataFromFile PatternFileName$ ' g_file.dll function ReadAppDataFromFile PatternFileName$ ', App ' this will overwrite the settings in ' .INI file, as they are more piece specific. REDIM SampleList (0 TO 0) AS GLOBAL ASCIIZ * 50 ' 13.03.2000 ' dll 13.03.2000 - now uses complete paths 03.10.2006 ReadWaveFileListFromFile PatternFileName$, Samplelist () REDIM PatternSeq(0 TO 0) AS GLOBAL PatternSequenceType ReadPatternSequencesFromFile PatternFileName$, PatternSeq() ' dll 13.03.2000 END SUB SUB MelodyPatternRecognize (noot?, velo?, duur AS LONG) EXPORT ' new code 15.01.2001 based on non-sequential matchpattern procedure ' tested with Cohiba. LOCAL i AS BYTE, j AS INTEGER, iij AS BYTE ' local counters LOCAL sollduur AS LONG LOCAL CaptureRange AS LONG STATIC SeqCounter AS BYTE STATIC tog AS BYTE IF ISFALSE tog THEN Seqcounter = 0 tog = %True IF gh.Melpat THEN DrawMelody gh.Melpat, 0, 0 END IF ' ------------------------------------------------------------ ' start recognizing: ' search the patterns with the highest number of notes already recognized first: FOR j = 15 TO 0 STEP -1 ' 15 = maximum number of notes in a pattern (16-1) IF PatternSeq(SeqCounter).Score = j THEN GOSUB CheckNote NEXT j EXIT SUB CheckNote: ' in the next code, we make sure we look first for notes to recognize in those ' patterns that have already a maximum number of flags set. ' Therefore we descend backwards in the patterns: ' j = PatternSeq(i).Score IF noot? = PatternSeq(SeqCounter).Noot(j) THEN ' recalculate the duration in function of the tempo, in ms: ' thus we we can cope with changing tempo in real time, if we want to... IF ISFALSE PatternSeq(SeqCounter).Tempo THEN MSGBOX "BUG in PatternRecognize - Module [gmt_gwr] !!!" EXIT SUB END IF sollduur = (60/PatternSeq(SeqCounter).Tempo) * PatternSeq(SeqCounter).Duur(j) * 1000 ' adjust for tempo and convert to ms. CaptureRange = sollduur * (PatternSeq(SeqCounter).Duurfout / 100!) 'IF CaptureRange < Sollduur then CaptureRange = Sollduur -1 ' added 13.01.2001 ??? IF duur >= sollduur - CaptureRange THEN IF duur <= sollduur + CaptureRange THEN INCR PatternSeq(SeqCounter).Score IF j = PatternSeq(SeqCounter).Lengte -1 THEN ' in this case a complete pattern was recognized... ' reset all other flags... ' FOR iij = 0 TO UBOUND(PatternSeq) ' PatternSeq(iij).Score = %False ' NEXT iij ' perform the required actions... recog.nr = SeqCounter '+ 1 'LastPatternMatched CALL DWORD recog.cPtr ' Display the complete sequence marked as played ' this serves as acknowledge for the musicians: IF gh.MelPat THEN 'SELECT CASE App.id ' CASE %ID_COHIBA, %ID_OBOTEK, %ID_TOVERFLUIT DrawMelody gh.Melpat, SeqCounter, j 'END SELECT END IF INCR SeqCounter SetDlgItemText gh.Cockpit, %GMT_TEXT0_ID+10, "Sequence " + STR$(SeqCounter) IF SeqCounter > UBOUND(PatternSeq,1) THEN SetDlgItemText gh.Cockpit, %GMT_TEXT0_ID + 10, "All sequences recognized... CONGRATULATIONS" SetDlgItemText gh.Cockpit, %GMT_TEXT0_ID + 11, "Done." IF gh.Melpat THEN destroywindow gh.Melpat EXIT SUB ELSE SetDlgItemText gh.Cockpit, %GMT_TEXT0_ID + 11, "Awaiting next pattern, nr" + STR$(SeqCounter + 1) END IF ' -------------------- EXIT SUB END IF END IF END IF END IF RETURN END SUB SUB DrawMelody (BYVAL hWnd AS LONG, BYVAL SeqNr AS BYTE, BYVAL NoteNr AS BYTE) EXPORT ' SeqNr counts 0,1,2,3..., NoteNr also counts from 0 ! ' proportional time notation 'duur = (60/PatternSeq(SeqNr).Tempo) * PatternSeq(SeqNr).Duur(NoteNr) LOCAL i AS DWORD LOCAL timescale AS SINGLE LOCAL hDC AS LONG LOCAL horpos AS WORD LOCAL newpos AS WORD LOCAL hBrush AS LONG LOCAL hPen AS LONG LOCAL hOldPen AS LONG LOCAL hOldBrush AS LONG ' bereken de tijdschaal: FOR i = 0 TO PatternSeq(SeqNr).Lengte -1 timescale = timescale + PatternSeq(SeqNr).Duur(i) ' totale duur van het patroon in s NEXT i timescale = CEIL(timescale) ' afronding naar boven hDC = GetDC(hWnd) hPen = CreatePen (%PS_SOLID,1, 0 ) 'BLACK hBrush = CreateSolidBrush(&HFFFFFF)'WHITE hOldPen = SelectObject(hDC, hPen) hOldBrush = SelectObject(hDC, hBrush) DrawBlankBar staff, hDC,(staff.hor), staff.hor + staff.length 'akkoordraster DrawClef staff, hDC, staff.hor horpos = staff.hor + staff.akkoordraster ' maxscale = staff.lenght - staff.akkoordraster corresponds to timescale FOR i = 0 TO PatternSeq(SeqNr).Lengte -1 IF i < PatternSeq(SeqNr).Score THEN ' was voor 15.01.2001 = NoteNr THEN ' change color SelectObject hDC, hOldBrush DeleteObject hBrush hBrush = CreateSolidBrush (&H00FE0000) ' blue hOldBrush = SelectObject(hDC, hBrush) horpos = ShowNote (staff, hDC, (PatternSeq(SeqNr).Noot(i)), horpos) SelectObject hDC, hOldBrush DeleteObject hBrush ' lijkt niet te werken, maar effekt is goed... hBrush = CreateSolidBrush(&HFFFFFF)'WHITE hOldBrush = SelectObject(hDC, hBrush) ELSE horpos = ShowNote (staff, hDC, (PatternSeq(SeqNr).Noot(i)), horpos) END IF ' tempoafhankelijk: 'newpos =((60/PatternSeq(SeqNr).Tempo)*PatternSeq(SeqNr).Duur(NoteNr-1)) *(staff.length - staff.akkoordraster)/ 8 newpos =(PatternSeq(SeqNr).Duur(i)) *(staff.length - staff.akkoordraster)/ timescale newpos = horpos + newpos IF newpos > horpos THEN horpos = newpos NEXT i DrawBarline staff, hDC, staff.length + (staff.nb * 2) SelectObject hDC, hOldBrush DeleteObject hBrush SelectObject hDC, hOldPen DeleteObject hPen ReleaseDC hWnd, hDC END SUB SUB DrawMelodyOn2Staves (BYVAL hWnd AS LONG, BYVAL SeqNr AS BYTE, BYVAL NoteNr AS BYTE) EXPORT ' Required for ' proportional time notation on G-clef/F-clef system 'duur = (60/PatternSeq(SeqNr).Tempo) * PatternSeq(SeqNr).Duur(NoteNr) LOCAL timescale AS SINGLE LOCAL hDC AS LONG LOCAL i AS BYTE LOCAL horpos AS WORD, newpos AS WORD LOCAL hBrush AS LONG LOCAL hPen AS LONG LOCAL hOldBrush AS LONG LOCAL hOldPen AS LONG STATIC tog AS BYTE STATIC systeem() AS StaffType IF ISFALSE tog THEN DIM systeem(0 TO 1) systeem(0).hor = staff.hor systeem(1).hor = staff.hor systeem(0).ver = staff.ver systeem(1).ver = staff.ver + 90 systeem(0).length = staff.length systeem(1).length = staff.length systeem(0).clef = "G2" systeem(1).clef = "F4" systeem(0).lijnafstand = staff.lijnafstand systeem(1).lijnafstand = staff.lijnafstand systeem(0).akkoordraster = staff.akkoordraster systeem(1).akkoordraster = staff.akkoordraster systeem(0).nh = staff.nh systeem(1).nh = staff.nh systeem(0).nb = staff.nb systeem(1).nb = staff.nb tog = %True END IF ' bereken de tijdschaal: FOR i = 0 TO PatternSeq(SeqNr).Lengte -1 timescale = timescale + PatternSeq(SeqNr).Duur(i) ' totale duur van het patroon in s NEXT i timescale = CEIL(timescale) ' afronding naar boven hDC = GetDC(hWnd) hPen = CreatePen (%PS_SOLID,1, 0 ) 'BLACK hBrush = CreateSolidBrush(&HFFFFFF)'WHITE hOldPen = SelectObject(hDC, hPen) hOldBrush = SelectObject(hDC, hBrush) DrawBlankBar systeem(0), hDC,(systeem(0).hor), systeem(0).hor + systeem(0).length DrawBlankBar systeem(1), hDC,(systeem(1).hor), systeem(1).hor + systeem(1).length DrawClef systeem(0), hDC, systeem(0).hor DrawClef systeem(1), hDC, systeem(1).hor horpos = systeem(0).hor + systeem(0).akkoordraster FOR i = 0 TO PatternSeq(SeqNr).Lengte -1 IF i = NoteNr THEN ' change color SelectObject hDC, hOldBrush DeleteObject hBrush hBrush = CreateSolidBrush (&H00FE0000) ' blue hOldBrush = SelectObject(hDC, hBrush) IF PatternSeq(SeqNr).Noot(i) > 59 THEN horpos = ShowNote (systeem(0), hDC, (PatternSeq(SeqNr).Noot(i)), horpos) ELSE horpos = ShowNote (systeem(1), hDC, (PatternSeq(SeqNr).Noot(i)+24), horpos) END IF SelectObject hDC, hOldBrush DeleteObject hBrush ' lijkt niet te werken, maar effekt is goed... ' zou met selectobj oldbrush ok moeten zijn... hBrush = CreateSolidBrush(&HFFFFFF)'WHITE hOldBrush = SelectObject(hDC, hBrush) ELSE IF PatternSeq(SeqNr).Noot(i) > 59 THEN horpos = ShowNote (systeem(0), hDC, (PatternSeq(SeqNr).Noot(i)), horpos) ELSE horpos = ShowNote (systeem(1), hDC, (PatternSeq(SeqNr).Noot(i)+24), horpos) END IF END IF ' tempoafhankelijk: 'newpos =((60/PatternSeq(SeqNr).Tempo)*PatternSeq(SeqNr).Duur(NoteNr-1)) *(staff.length - staff.akkoordraster)/ 8 newpos =(PatternSeq(SeqNr).Duur(i)) *(systeem(0).length - systeem(0).akkoordraster)/ timescale newpos = horpos + newpos IF newpos > horpos THEN horpos = newpos NEXT i DrawBarline systeem(0), hDC, systeem(0).length + (systeem(0).nb * 2) DrawBarline systeem(1), hDC, systeem(1).length + (systeem(1).nb * 2) SelectObject hDC, hOldBrush SelectObject hDC, hOldPen DeleteObject hBrush DeleteObject hPen ReleaseDC hWnd, hDC ' InvalidateRect hWnd, BYVAL 0, BYVAL 1 ' wrong!!! END SUB SUB DrawAllPatterns (BYVAL hWnd AS LONG) ' required for ' proportional time notation on G-clef (was transposed octave down, now normal for tenor recorder) 'duur = (60/PatternSeq(SeqNr).Tempo) * PatternSeq(SeqNr).Duur(NoteNr) LOCAL timescale AS SINGLE LOCAL hDC AS LONG LOCAL i AS BYTE LOCAL j AS BYTE LOCAL maxtim AS SINGLE LOCAL horpos AS WORD, newpos AS WORD LOCAL hBrush AS LONG LOCAL hPen AS LONG LOCAL hOldBrush AS LONG LOCAL hOldPen AS LONG LOCAL WndRect AS FOURLONGS LOCAL x AS INTEGER LOCAL y AS INTEGER STATIC tog AS BYTE STATIC systeem() AS StaffType IF ISFALSE tog THEN GetWindowRect hWnd, WndRect x = (GetSystemMetrics(%SM_CXSCREEN)) ' horizontale resolutie in pixels (bvb. 1024) y = (GetSystemMetrics(%SM_CYSCREEN)) ' vertikale resolutie in pixels (bvb. 768) SetWindowPos hWnd, %NULL, 1, 1, (x-10)/2,y-40, %SWP_NOACTIVATE ' set the staff-parameters to suitable default values staff.hor = 8 staff.ver = 45 staff.lijnafstand = 6 ' afstand tussen de lijnen van de notenbalk staff.akkoordraster = 30 ' afstand tussen de akkoorden op de notenbalk / maatstrepen staff.nb=staff.lijnafstand + 1 ' nootbreedte staff.nh= staff.lijnafstand -1 ' noothoogte staff.length = (x/2) - 60 ' for melodypatterns in prop. notation... 900 staff.clef = "G2" DIM systeem(0 TO UBOUND(PatternSeq)) AS STATIC StaffType FOR i = 0 TO UBOUND(PatternSeq) systeem(i).hor = staff.hor systeem(i).ver = staff.ver + (i * 80) systeem(i).length = staff.length systeem(i).clef = "G2" systeem(i).lijnafstand = staff.lijnafstand systeem(i).akkoordraster = staff.akkoordraster systeem(i).nh = staff.nh systeem(i).nb = staff.nb NEXT i tog = %True END IF ' bereken de maximale tijdschaal: (telkens opnieuw, want de patronen kunnen wisselen...) maxtim = 0 FOR j = 0 TO UBOUND(PatternSeq) timescale = 0 FOR i = 0 TO PatternSeq(j).Lengte -1 timescale = timescale + PatternSeq(j).Duur(i) ' totale duur van het patroon in s NEXT i IF timescale > maxtim THEN maxtim = timescale NEXT j timescale = maxtim timescale = CEIL(timescale) ' afronding naar boven hDC = GetDC(hWnd) 'note: allways select a brush before drawing. probably we should do the same for pens... hPen = CreatePen (%PS_SOLID,1, 0 ) 'BLACK hBrush = CreateSolidBrush(&HFFFFFF)'WHITE hOldBrush = SelectObject(hDC, hBrush) hOldPen = SelectObject(hDC, hPen) FOR j = 0 TO UBOUND(PatternSeq) ' j is the patterncounter DrawBlankBar systeem(j), hDC,(systeem(j).hor), systeem(j).hor + systeem(j).length DrawClef systeem(j), hDC, systeem(j).hor horpos = systeem(j).hor + systeem(j).akkoordraster FOR i = 0 TO PatternSeq(j).Lengte -1 ' notecounter IF i < PatternSeq(j).Score THEN ' change color SelectObject hDC, hOldBrush DeleteObject hBrush hBrush = CreateSolidBrush (&H00FE0000) ' blue hOldBrush = SelectObject(hDC, hBrush) ' draw one octave lower!!! 'horpos = ShowNote (systeem(j), hDC, PatternSeq(j).Noot(i)-12, horpos) ' changed: now score should be on tenor recorder, so we do not need the ' octave transposition anymore. horpos = ShowNote (systeem(j), hDC, PatternSeq(j).Noot(i)*1, horpos) SelectObject hDC, hOldBrush DeleteObject hBrush ' lijkt niet te werken, maar effekt is goed... hBrush = CreateSolidBrush(&HFFFFFF) 'BLACK '??pen? hOldBrush = SelectObject(hDC, hBrush) ELSE 'horpos = ShowNote (systeem(j), hDC, (PatternSeq(j).Noot(i)-12), horpos) horpos = ShowNote (systeem(j), hDC, PatternSeq(j).Noot(i)*1, horpos) END IF ' tempoafhankelijk: 'newpos =((60/PatternSeq(j).Tempo)*PatternSeq(j).Duur(i-1)) *(staff.length - staff.akkoordraster)/ 8 newpos =(PatternSeq(j).Duur(i)) *(systeem(j).length - systeem(j).akkoordraster)/ timescale newpos = horpos + newpos IF newpos > horpos THEN horpos = newpos NEXT i DrawBarline systeem(j), hDC, systeem(j).length + (systeem(j).nb * 2) NEXT j SelectObject hDC, hOldBrush DeleteObject hBrush SelectObject hDC, hOldPen DeleteObject hPen ReleaseDC hWnd, hDC END SUB SUB InitGWRMenu () EXPORT LOCAL hMenu AS LONG hMenu = GetMenu(gh.setup) ' initialises the setup menu according to the compilation and presence of ini files. #IF %DEF (%gmt_wsb) EXIT SUB #ENDIF #IF %DEF(%Fall95) IF ExistFile ($Fall95INI) THEN EnableMenuItem hMenu, %ID_FALL95, %MF_ENABLED ELSE EnableMenuItem hMenu, %ID_Fall95, %MF_GRAYED END IF #ENDIF #IF %DEF(%Shifts) IF ExistFile ($SHIFTSINI) THEN EnableMenuItem hMenu, %ID_POP_SHIFTS, %MF_ENABLED EnableMenuItem hMenu, %ID_SHIFTS_INS, %MF_ENABLED EnableMenuItem hMenu, %ID_SHIFTS_PP, %MF_ENABLED EnableMenuItem hMenu, %ID_SHIFTS_DIM, %MF_ENABLED EnableMenuItem hMenu, %ID_SHIFTS_JUST, %MF_ENABLED ELSE 'MENU DELETE hMenu, BYCMD %ID_POP_SHIFTS EnableMenuItem hMenu, %ID_POP_SHIFTS, %MF_GRAYED END IF #ELSE EnableMenuItem hMenu, %ID_POP_SHIFTS, %MF_GRAYED #ENDIF #IF %DEF(%spring94) IF ExistFile ($Spring94) THEN EnableMenuItem hMenu, %ID_SPRING94, %MF_ENABLED '20.06.2002 ELSE 'MENU DELETE hMenu, BYCMD %ID_SPRING94 EnableMenuItem hMenu, %ID_SPRING94, %MF_GRAYED END IF #ELSE 'MENU DELETE hMenu, BYCMD %ID_SPRING94 EnableMenuItem hMenu, %ID_SPRING94, %MF_GRAYED #ENDIF #IF %DEF(%Bom) IF ExistFile ($BOMINI) THEN EnableMenuItem hMenu, %ID_BOM99, %MF_ENABLED EnableMenuItem hMenu, %ID_SONGBOOK99, %MF_ENABLED #IF %DEF(%ii_robot) EnableMenuItem hMenu, %ID_II_ROBOTS, %MF_ENABLED ' 20.03.2002 #ELSE EnableMenuItem hMenu, %ID_II_ROBOTS, %MF_GRAYED #ENDIF ELSE EnableMenuItem hMenu, %ID_BOM99, %MF_GRAYED EnableMenuItem hMenu, %ID_SONGBOOK99, %MF_GRAYED END IF IF ExistFile ($MIMINI) THEN EnableMenuItem hMenu, %ID_II_MIM, %MF_ENABLED ELSE EnableMenuItem hMenu, %ID_II_MIM, %MF_GRAYED END IF #ENDIF #IF %DEF(%Sincs) EnableMenuItem hMenu, %ID_SINCS, %MF_ENABLED #ENDIF #IF %DEF(%Hydrocephallus) EnableMenuItem hMenu, %ID_HYDROCEPHALLUS, %MF_ENABLED #ENDIF #IF %DEF(%Cohiba) IF CheckInstalled ("COHIBA", App) THEN EnableMenuItem hMenu, %ID_COHIBA, %MF_ENABLED END IF IF CheckInstalled ("PANATELLA", App) THEN EnableMenuItem hMenu, %ID_PANATELLA, %MF_ENABLED END IF #ENDIF #IF %DEF(%OboTek) IF CheckInstalled ("OBOTEK", App) THEN EnableMenuItem hMenu, %ID_OBOTEK, %MF_ENABLED END IF #ENDIF #IF %DEF(%Toverfluit) IF ExistFile ($TOVERFLUITINI) THEN EnableMenuItem hMenu, %ID_TOVERFLUIT, %MF_ENABLED END IF #ENDIF #IF %DEF(%Gorgonio) EnableMenuItem hMenu, %ID_GORGONIO, %MF_ENABLED #ENDIF #IF %DEF(%Cellopi) IF CheckInstalled ("CELLOPI", App) THEN EnableMenuItem hMenu, %ID_CELLOPI, %MF_ENABLED END IF #ENDIF #IF %DEF(%Baklava) IF CheckInstalled ("BAKLAVA",App) THEN ' only checks existance of ini file EnableMenuItem hMenu, %ID_BAKLAVA, %MF_ENABLED END IF #ENDIF #IF %DEF(%LickStick) IF CheckInstalled ("LICKSTICK", App) THEN EnableMenuItem hMenu, %ID_LICKSTICK, %MF_ENABLED END IF #ENDIF #IF %DEF(%Woodstock) IF CheckInstalled ("WOODSTOCK", App) THEN EnableMenuItem hMenu, %ID_WOODSTOCK, %MF_ENABLED END IF #ENDIF #IF %DEF(%Panatella) IF CheckInstalled ("PANATELLA", App) THEN EnableMenuItem hMenu, %ID_PANATELLA, %MF_ENABLED END IF #ENDIF #IF %DEF(%Jumpyvariations) EnableMenuItem hMenu, %ID_Jumpyvariations, %MF_ENABLED #ELSE 'MENU DELETE hMenu, BYCMD %ID_Jumpyvariations EnableMenuItem hMenu, %ID_Jumpyvariations, %MF_GRAYED #ENDIF #IF %DEF(%Boxing) EnableMenuItem hMenu, %ID_BOXING, %MF_ENABLED #ELSE 'MENU DELETE hMenu, BYCMD %ID_BOXING EnableMenuItem hMenu, %ID_BOXING, %MF_GRAYED #ENDIF #IF %DEF(%CDF747) EnableMenuItem hMenu, %ID_CDF747, %MF_ENABLED #ELSE 'MENU DELETE hMenu, BYCMD %ID_CDF747 EnableMenuItem hMenu, %ID_CDF747, %MF_GRAYED #ENDIF #IF %DEF(%Faust) EnableMenuItem hMenu, %ID_TECHNOFAUSTUS, %MF_ENABLED #ELSE 'MENU DELETE hMenu, BYCMD %ID_TECHNOFAUSTUS EnableMenuItem hMenu, %ID_TECHNOFAUSTUS, %MF_GRAYED #ENDIF #IF %DEF(%FidelC) EnableMenuItem hMenu, %ID_FIDELC, %MF_ENABLED #ELSE EnableMenuItem hMenu, %ID_FIDELC, %MF_GRAYED #ENDIF #IF %DEF(%zerhacker) EnableMenuItem hMenu, %ID_ZERHACKER, %MF_ENABLED #ELSE EnableMenuItem hMenu, %ID_ZERHACKER, %MF_GRAYED #ENDIF #IF %DEF(%harmstuds) EnableMenuItem hMenu, %ID_POP_HARMSTUD, %MF_ENABLED EnableMenuItem hMenu, %ID_HARMCAT, %MF_ENABLED EnableMenuItem hMenu, %ID_HARMSOLVE, %MF_ENABLED EnableMenuItem hMenu, %ID_CHORDCAT, %MF_ENABLED EnableMenuItem hMenu, %ID_FUJISAN, %MF_ENABLED EnableMenuItem hMenu, %ID_FUZZYHARM, %MF_ENABLED ' 22.06.2003 #ELSE EnableMenuItem hMenu, %ID_POP_HARMSTUD, %MF_GRAYED #ENDIF #IF %DEF(%SQE_STO) EnableMenuItem hMenu, %ID_SQE_STO, %MF_ENABLED EnableMenuItem hMenu, %ID_STO, %MF_ENABLED EnableMenuItem hMenu, %ID_G_TECHNO, %MF_ENABLED '23.11.2006 #ELSE EnableMenuItem hMenu, %ID_SQE_STO, %MF_GRAYED EnableMenuItem hMenu, %ID_STO, %MF_GRAYED EnableMenuItem hMenu, %ID_G_TECHNO, %MF_GRAYED #ENDIF #IF %DEF(%Winter95) ' 03.02.2009 EnableMenuItem hMenu, %ID_WINTER, %MF_ENABLED #ELSE EnableMenuItem hMenu, %ID_WINTER, %MF_GRAYED #ENDIF #IF %DEF(%Summer94) ' 03.02.2009 EnableMenuItem hMenu, %ID_SUMMER, %MF_ENABLED #ELSE EnableMenuItem hMenu, %ID_SUMMER, %MF_GRAYED #ENDIF END SUB ' [EOF]