"Shifts": GMT-software cut and paste following block in the PB editor.

' ************************************************* ' * * ' * commissioned by Muzikon as an ensemble piece * ' * for variable instrumentation * ' * composed in 1987 by * ' * Godfried-Willem RAES * ' * adapted to run under , august 1999 * ' ************************************************* ' user interface: slider 0 for dynamics of channels 0-7 (not levels!) ' slider 1 for dynamics of channels 8-F ' up/downs for tempo controll: 0 , 3, 6 ' functional buttons: - Tunings (only for Proteus) ' 2 x 8 sliders controll channel volumes via midi. (Use callback code) ' last update: 05.05.2000 : to be done: add global harmony support... ' 11.09.2000 : recompile crashes on label Bind: ' 24.07.2001 : recompiled as gmt_alg.exe under GMT V5.4 ' constants for SHIFTS: %Shifts_Algo = 16 ' task number for the main algorithm %Shifts_Vols07 = 18 ' task number for the volume controls - just creates the sliders and starts the callbacks. %Shifts_Vols8F = 19 ' task number for the upper 8 channels volume controls. %Shifts_p2 = 32 ' tasks for real time versions with live players.[note display for each part] %Shifts_p3 = 33 %Shifts_p4 = 34 %Shifts_p5 = 35 %Shifts_p6 = 36 %Shifts_p7 = 37 %Shifts_p8 = 38 %Shifts_p9 = 39 %Shifts_RTScore = 47 ' rootnumber constants: %Ra = 2 %Rb = 3 %Rc = 4 %Rd = 5 %Re = 6 %Rf = 7 %Rg = 8 %Rh = 9 %NotenTotaal = 2520 '(%Ra ^ %Rb) * (%Rb ^ %Ra) * %Rd * %Rf '2520 $SHL = " real time performers score" ' Procedures for Shifts: DECLARE FUNCTION Init_Shifts () AS LONG DECLARE FUNCTION Shifts_GetTranspositiondata () AS BYTE ' uses app.id as parameter, but this is global. so we do not have to pass it. DECLARE SUB Shifts_ReadNotesFromIniFile (version$) DECLARE SUB Shifts_ReadPatchesFromIniFile () '(a$, FB01$) DECLARE SUB Shifts_GetCents () ' no longer in data file. hard coded now. DECLARE SUB Shifts_Algo () ' task 16 DECLARE SUB Shifts_GlobHar () ' rerouting of global harmony task. DECLARE SUB Shifts_WriteSeqScore () ' now task 12 DECLARE SUB FB01Bendon () ' gmt ok DECLARE SUB LfoPan () DECLARE SUB AllesUit () DECLARE SUB Shifts_Volume07 () ' pseudo task. - activates slider window and starts callback DECLARE SUB Shifts_Volume8F () ' pseudo task. - id. DECLARE SUB VoicesFB01 () DECLARE SUB Shifts_RemapSliders () DECLARE SUB Shifts_RemapUpDowns () DECLARE SUB Shifts_ReMapCockpitButtons () DECLARE SUB Shifts_InitMidi () DECLARE SUB Shifts_UpDown0_Handler () DECLARE SUB Shifts_UpDown3_Handler () DECLARE SUB Shifts_UpDown6_Handler () DECLARE SUB Shifts_ButnSWHandler () DECLARE SUB Shifts_ButnOSHandler () DECLARE SUB Shifts_Vol0 () ' callbacks for midi volume controlls DECLARE SUB Shifts_Vol1 () DECLARE SUB Shifts_Vol2 () DECLARE SUB Shifts_Vol3 () DECLARE SUB Shifts_Vol4 () DECLARE SUB Shifts_Vol5 () DECLARE SUB Shifts_Vol6 () DECLARE SUB Shifts_Vol7 () DECLARE SUB Shifts_Vol8 () DECLARE SUB Shifts_Vol9 () DECLARE SUB Shifts_VolA () DECLARE SUB Shifts_VolB () DECLARE SUB Shifts_VolC () DECLARE SUB Shifts_VolD () DECLARE SUB Shifts_VolE () DECLARE SUB Shifts_VolF () DECLARE SUB Shifts_p2 () ' real time score tasks DECLARE SUB Shifts_p3 () DECLARE SUB Shifts_p4 () DECLARE SUB Shifts_p5 () DECLARE SUB Shifts_p6 () DECLARE SUB Shifts_p7 () DECLARE SUB Shifts_p8 () DECLARE SUB Shifts_p9 () DECLARE SUB Shifts_Tuning () DECLARE SUB ShiftsRealTimeScore () ' real time score task DECLARE SUB ShiftsDrawMelody (BYVAL hWnd AS LONG) '************************************** PROCEDURES ****************************************** FUNCTION Init_Shifts () AS LONG DIM PlayerPiano AS GLOBAL Musician GetInstrumentParams PlayerPiano, %ID_PLAYERPIANO REDIM Toets(PlayerPiano.lowtes TO PlayerPiano.hightes) AS GLOBAL SINGLE ' global - for player piano support LOCAL i AS LONG LOCAL j AS LONG LOCAL m AS ASCIIZ * 40 Task(0).naam = "" Task(0).cptr = %False Task(%Shifts_Algo).cPtr = CODEPTR(Shifts_Algo) Task(%Shifts_Algo).level = 64 Task(%Shifts_Algo).channel = 0 Task(%Shifts_Algo).naam = "" Task(%Shifts_Vols07).cPtr = CODEPTR(Shifts_Volume07) Task(%Shifts_Vols07).naam = "Levels07" Task(%Shifts_Vols8F).cPtr = CODEPTR(Shifts_Volume8F) Task(%Shifts_Vols8F).naam = "Levels8F" Task(%Shifts_p2).naam = "Twos" Task(%Shifts_p3).naam = "Threes" Task(%Shifts_p4).naam = "Fours" Task(%Shifts_p5).naam = "Fives" Task(%Shifts_p6).naam = "Sixes" Task(%Shifts_p7).naam = "Sevens" Task(%Shifts_p8).naam = "Eighths" Task(%Shifts_p9).naam = "Nines" Task(%Shifts_p2).cPtr = CODEPTR(Shifts_p2) Task(%Shifts_p3).cPtr = CODEPTR(Shifts_p3) Task(%Shifts_p4).cPtr = CODEPTR(Shifts_p4) Task(%Shifts_p5).cPtr = CODEPTR(Shifts_p5) Task(%Shifts_p6).cPtr = CODEPTR(Shifts_p6) Task(%Shifts_p7).cPtr = CODEPTR(Shifts_p7) Task(%Shifts_p8).cPtr = CODEPTR(Shifts_p8) Task(%Shifts_p9).cPtr = CODEPTR(Shifts_p9) Task(%Shifts_RTScore).naam = "SCORE" Task(%Shifts_RTScore).cPtr = CODEPTR(ShiftsRealTimeScore) ' delete the default score writing task: IF App.WriteSeqScoreTasknr THEN Task(App.WriteSeqScoreTaskNr).cptr = %False Task(App.WriteSeqScoreTaskNr).naam = "" Task(App.WriteSeqScoreTaskNr).freq = %False END IF ' replace with the specific one for shifts: App.WriteSeqScoreTasknr = 12 ' this task writes a seq score to disk. IF App.SeqOutFilenr THEN CLOSE App.SeqOutFileNr App.SeqFileOut = "shifts.seq" Task(App.WriteSeqScoreTaskNr).naam = "SeqScore" ' for score writing Task(App.WriteSeqScoreTaskNr).freq = 100 ' on init only Task(App.WriteSeqScoreTaskNr).cptr = CODEPTR(Shifts_WriteSeqScore) App.GlobalHarmonyTaskNr = 15 ' should have been read from ini-file... App.NrSliders = 2 ' for cockpit App.NrUpDowns = 7 App.komposduur = 600 BIT RESET App.Autoflags, 0 ' %False ' synth configuration should have been selected in the main GMT menu. SELECT CASE TRIM$(UCASE$(Meq(0).naam)) 'App.Synthname CASE "CASIO" Shifts.miparam = 1 CASE "PLAYPIAN" Shifts.miparam = 4 CASE "PROFORMANCE" Shifts.miparam = 2 ' CASE "TX81Z" Shifts.miparam = 2 CASE "DX21" Shifts.miparam = 2 CASE "FB01","FB01_SINE" shifts.miparam = 2 ' 8 channels CASE ELSE Shifts.miparam = 5 ' 16 channels as default. END SELECT Shifts_InitMidi FOR i = 0 TO 7 Task(%SHIFTS_ALGO + i).flags = Task(%SHIFTS_ALGO + i).flags OR %SCORE_TASK OR %HARM_TASK NEXT Task(%SHIFTS_ALGO).flags = Task(%SHIFTS_ALGO).flags OR %MIDI_TASK ' override taskinitialisation: Task(App.ReadSeqScoreTaskNr).naam = "" ' remove this one from the cockpit. Task(App.ReadSeqScoreTaskNr).cPtr = %False Task(App.GlobalHarmonyTaskNr).naam = "Harmony" ' keeps track of global harmony for all music tasks Task(App.GlobalHarmonyTaskNr).freq = 20 Task(App.GlobalHarmonyTaskNr).cptr = CODEPTR(Shifts_GlobHar) ' specify the updown controls: App.tempo = 240 Shifts_RemapUpDowns Shifts_ReMapCockpitButtons ' for live musicians: [ now hardcoded for flute, but can be changed to accomodate other instruments...] GLOBAL PatternSeq AS PatternSequenceType DIM ShiftsInstrum AS GLOBAL Musician GetInstrumentParams ShiftsInstrum, %ID_FLUTE 'ShiftsInstrum.LowTes = Flute.LowTes 'ShiftsInstrum.HighTes = Flute.HighTes IF ShiftsInstrum.Hightes > 89 THEN ShiftsInstrum.Hightes = 89 FUNCTION = %True END FUNCTION SUB Shifts_Algo () STATIC tCnt% ' pulscounter STATIC Att AS INTEGER, Bt AS INTEGER,Ct AS INTEGER,Dt AS INTEGER,Et AS INTEGER,Ft AS INTEGER,Gt AS INTEGER,Ht AS INTEGER STATIC Ac AS INTEGER,Bc AS INTEGER,Cc AS INTEGER,Dc AS INTEGER,Ec AS INTEGER,Fc AS INTEGER,Gc AS INTEGER,Hc AS INTEGER STATIC AChk AS INTEGER, BChK AS INTEGER, EChk AS INTEGER, FChk AS INTEGER, GChk AS INTEGER STATIC Som AS BYTE ' INTEGER STATIC Aflag%,Bflag%,Cflag%,Dflag%,Eflag%,Fflag%,Gflag%,Hflag% STATIC Transpose AS BYTE STATIC no() AS BYTE ' only used for score generation... LOCAL D0 AS BYTE LOCAL D1 AS BYTE LOCAL D2 AS BYTE LOCAL D3 AS BYTE LOCAL D4 AS BYTE LOCAL D5 AS BYTE LOCAL D6 AS BYTE LOCAL D7 AS BYTE LOCAL i? LOCAL j? LOCAL k AS BYTE LOCAL Q AS BYTE LOCAL pp% ' copy of Task(%SHIFTS_ALGO).level LOCAL noot AS BYTE LOCAL velo AS BYTE IF ISFALSE Task(%Shifts_Algo).tog THEN App.tempo = 240 tCnt% = %False App.komposduur = (%NotenTotaal * 60! / App.tempo) Transpose = %False DIM no(0 TO 7) FOR i = 0 TO 7 FOR j = 0 TO 15 Shifts.midi(i, j) = Shifts.mid(i, j) + Shifts.Trans(transpose) ' maar dit is 0 on init. NEXT j NEXT i Ac = -1 Bc = -1 Cc = -1 Dc = -1 Ec = -1 Fc = -1 Gc = -1 Hc = -1 Task(%Shifts_Algo).tog = %True Task(%Shifts_Algo).freq = App.tempo / 60! LOCAL m AS ASCIIZ * 30 m = $SHL SendMessage gh.MelPat, %WM_SETTEXT,0, VARPTR(m) ' write to caption bar END IF IF tCnt% > %NotenTotaal THEN StopTask %Shifts_Algo ' final stop after fermata. FOR k = 0 TO 15 AllNotesOff k NEXT k IF App.SeqOutFileNr THEN FLUSH #App.SeqOutFileNr App.SeqOutFileNr = %False IF BIT(Task(App.WriteSeqScoreTaskNr).swit,%TASK_ONOFF) THEN StopTask App.WriteSeqScoreTaskNr EXIT SUB END IF ' A-partij uitsluitend voor slagwerk/piano - ad libitum **************************** IF tCnt% MOD %Ra = %False THEN INCR Ac AChk = %Rh * %Rg * %Rf IF tCnt% < AChk THEN IF (Ht < 1) THEN Att = %False IF Ht > 0 THEN Att = Ac MOD ((Ht \ 2) + 1) END IF ELSE IF tCnt% > AChk - 1 THEN Att = Ac MOD (Bt + 1) IF tCnt% > (%NotenTotaal \ (%Rh * %Ra)) THEN Att = Ac MOD 7 IF tCnt% > (%NotenTotaal \ %Rh) THEN Att = RND(1) * (Ac MOD 6) IF tCnt% > (%NotenTotaal \ %Rg) THEN Att = 7 - (RND(1) * (Ac MOD 7)) IF tCnt% > (%NotenTotaal \ %Re) THEN Att = 2 + (7 - (RND(1) * (Ac MOD 5))) IF tCnt% > (%NotenTotaal \ %Rb) THEN Att = 3 + (6 - (RND(1) * (Ac MOD 4))) IF tCnt% > (%NotenTotaal \ %Ra) THEN Att = 4 + (5 - (RND(1) * (Ac MOD 3))) IF tCnt% > ((%NotenTotaal \ %Rb) * %Ra) THEN Att = 8 - Som END IF D0 = %True ELSE D0 = %False END IF ' B-partij deelfaktor 3 ************************************************************* IF tCnt% MOD %Rb = %False THEN INCR Bc BChk = %NotenTotaal \ %Re IF tCnt% < BChk THEN IF Ht < 1 THEN Bt = %False ELSE IF Ht > 0 THEN Bt = (Bc MOD Ht) END IF ELSE IF (tCnt% = BChk) AND (Ht > 0) THEN Bt = Bc MOD Ht IF tCnt% > BChk THEN Bt = Bc MOD %Rf IF tCnt% > %NotenTotaal \ %Rd THEN Bt = 1 + (Bc MOD %Re) IF tCnt% > %NotenTotaal \ %Rb THEN Bt = 2 + (Bc MOD %Rd) IF tCnt% > (%NotenTotaal \ %Rf) * %Rb THEN Bt = 3 + (Bc MOD %Rc) IF tCnt% > %NotenTotaal \ %Ra THEN Bt = (RND(1) * 4) + (Bc MOD %Rb) IF tCnt% > (%NotenTotaal \ %Rd) * %Rb THEN Bt = (RND(1) * 5) + (Bc MOD %Ra) IF tCnt% > (%NotenTotaal \ %Rf) * %Rd THEN Bt = 2 + (RND(1) * 3) + (Bc MOD %Ra) IF tCnt% > (%NotenTotaal \ %Rf) * %Rg THEN Bt = 4 + (RND(1) * 2) + (Bc MOD %Ra) IF Som > 6 AND tCnt% > (%Rh * %Rh) THEN Bt = 9 - Som END IF D1 = %True ELSE D1 = %False END IF ' C-partij deelfaktor 4 ************************************************************************ IF tCnt% MOD %Rc = %False THEN INCR Cc IF tCnt% < %NotenTotaal \ %Rd THEN IF Ht = 0 OR Ht < 0 THEN Ct = %False IF ((Ht > 0) AND (Ht < 10)) THEN Ct = (Cc MOD (Ht + 1)) IF Ht > 9 THEN Ct = Cc MOD (Ht - 7) ELSE IF (Cc MOD %Rc = 0) AND (Ct > 0) AND (Ct < 13) AND (tCnt% < (%NotenTotaal * 4) \ 5) THEN Ct = Ct + (RND(1) * 2) - 1 GOTO CKLAR END IF IF tCnt% > %NotenTotaal \ %Rd THEN Ct = Cc MOD 9 IF tCnt% > (%NotenTotaal \ %Rd) * %Ra THEN Ct = 10 - (Cc MOD %Rh) + ((RND(1) * 2) - 1) IF tCnt% > (%NotenTotaal \ %Rd) * %Rb THEN Ct = 10 - (Cc MOD %Rf) IF tCnt% > (%NotenTotaal \ %Rd) * %Rc THEN Ct = 1 + (2 * RND(1)) + (7 - (Cc MOD %Re)) IF tCnt% > ((%NotenTotaal \ %Rh) * %Re) + %Rh THEN Ct = 14 - (Cc MOD 13) IF Som > 4 THEN Ct = (Cc MOD Som) + 1 CKLAR: END IF D2 = %True ELSE D2 = %False END IF ' D-partij deelfaktor 5 *********************************************************************** IF tCnt% MOD %Rd = %False THEN INCR Dc Dflag% = %False IF tCnt% < %Rg * %Rf * %Re * %Ra THEN IF Ht < 1 THEN Dt = 0 ELSE Dt = Dc MOD Ht ELSE IF (Dc MOD %Rd) = 0 AND (Dt > 0) AND (Dt < 12) THEN Dt = Dt + (RND(1) * 2) - 1 Dflag% = %NotFalse 'GOTO DKLAR END IF IF Dflag% = %NotFalse THEN GOTO DKLAR IF Ht < 1 THEN i = 3 ELSE i = Ht IF Hc > 15 THEN Dt = Dc MOD i IF Ht < 2 THEN i = %Rd ELSE i = Ht IF Hc > 25 THEN Dt = 1 + (Dc MOD (i - 1)) IF Ht < 3 THEN i = %Rd ELSE i = Ht IF Hc > 50 THEN Dt = 2 + (Dc MOD (i - 2)) IF Ht < 4 THEN i = %Rd ELSE i = Ht IF Hc > 75 THEN Dt = 3 + (Dc MOD (i - 3)) IF Ht < 5 THEN i = %Rd ELSE i = Ht IF Hc > 100 THEN Dt = 4 + (Dc MOD (i - 4)) IF Hc > 125 THEN Dt = (RND(1) * 5) + (Dc MOD 11) IF Hc > 150 THEN Dt = (RND(1) * 6) + (Dc MOD 10) IF Hc > 175 THEN Dt = (RND(1) * 7) + (Dc MOD 9) IF Hc > 200 THEN Dt = 4 + (RND(1) * 4) + (Dc MOD 8) IF Hc > 225 THEN Dt = 5 + (RND(1) * 3) + (Dc MOD 7) IF Hc > 250 THEN Dt = 10 + (RND(1) * 2) + (Dc MOD 3) IF tCnt% > (%NotenTotaal \ %Rg) * %Rf THEN Dt = 15 - (Dc MOD 14) IF Som > 5 AND tCnt% > (%Rh* %Rh) THEN Dt = Dc MOD (2 * Som) DKLAR: END IF IF Dt > 13 THEN Dt = 13 D3 = %True ELSE D3 = %False END IF ' E-partij deelfaktor 6 ********************************************************************** IF tCnt% MOD %Re = %False THEN INCR Ec EChk = %Re * %Rd * %Rc * %Rb * %Ra Eflag% = %False IF tCnt% < EChk THEN IF Ht < 1 THEN Et = 0 ELSE Et = Ec MOD Ht IF tCnt% > EChk \ 2 THEN Et = (Ec MOD Ht) + ((RND(1) * 2) - 2) IF tCnt% < EChk THEN IF Som = 8 AND tCnt% > 1 THEN Et = %Re END IF ELSE IF (Ec MOD %Re) = 0 AND Et > 0 AND Et < 14 THEN Et = Et + (RND(1) * 2) - 1 Eflag%= %NotFalse ELSE Eflag% = %False END IF IF Eflag% = %NotFalse THEN GOTO EKLAR IF tCnt% > ((%NotenTotaal \ (%Rh* %Ra)) - 1) THEN Et = Ec MOD 15 IF tCnt% > (%NotenTotaal \ (%Re * %Ra)) THEN Et = 1 + (RND(1) * (Ec MOD 14)) IF tCnt% > %NotenTotaal \ %Rf THEN Et = 15 - (RND(1) * (Ec MOD 14)) IF tCnt% > %NotenTotaal \ %Rb THEN Et = 2 + (13 - (RND(1) * (Ec MOD 12))) IF tCnt% > %NotenTotaal \ %Ra THEN Et = 4 + (11 - (RND(1) * (Ec MOD 10))) IF tCnt% > (%NotenTotaal \ %Rd) * %Rb THEN Et = 6 + (9 - (RND(1) * (Ec MOD 8))) IF tCnt% > (%NotenTotaal \ %Rd) * %Rc THEN Et = 8 + (7 - (RND(1) * (Ec MOD 6))) IF tCnt% > (%NotenTotaal \ %Rf) * %Re THEN Et = 15 - (Ec MOD 15) IF Som > 4 AND tCnt% > (%Rh* %Rg * %Rf) THEN Et = 7 + (Ec MOD Som) EKLAR: IF Som = 8 AND tCnt% > 1 THEN Et = %Re END IF IF Et < 0 THEN Et = 0 IF Et > 15 THEN Et = 15 D4 = %True ELSE D4 = %False END IF ' F-partij deelfaktor 7 ****************************************************************** IF tCnt% MOD %Rf = %False THEN INCR Fc 'Fc = Fc + 1 FChk = %NotenTotaal \ %Rb IF tCnt% < FChk THEN IF Ht < 2 THEN Ft = 0 ELSEIF (Ht > 1) THEN IF (Hc < 36) THEN Ft = Fc MOD Ht ELSEIF (Ft > 12) THEN Ft = Ft - 6 ELSEIF (Hc > 35) THEN Ft = Fc MOD 12 ELSEIF (Hc > 70) THEN Ft = 3 + (Fc MOD %Rh) ELSEIF (Hc > 105) THEN Ft = (RND(1) * 5) + (Fc MOD 6) END IF END IF ELSE IF tCnt% > (%NotenTotaal \ %Rb) THEN Ft = 12 - (Fc MOD 9) IF tCnt% > (%NotenTotaal \ %Rd) * %Rc THEN Ft = 8 + (RND(1) * (Fc MOD 4)) IF tCnt% > (%NotenTotaal \ %Rf) * %Re THEN Ft = 12 - (%Rf * (RND(1))) IF tCnt% > (%NotenTotaal \ %Rh) * %Rg THEN Ft = 12 - (Fc MOD 10) IF Som > 4 THEN Ft = 6 + (Fc MOD Som) IF Som = 8 AND tCnt% > 1 THEN Ft = %Rf END IF IF Ft > 15 THEN Ft = 15 D5 = %True ELSE D5 = %False END IF ' G-partij deelfaktor 8 **********************************************************88 IF tCnt% MOD %Rg = %False THEN INCR Gc GChk = %NotenTotaal \ %Rb IF tCnt% < GChk THEN IF Ht < 3 THEN Gt = %False ELSEIF (Ht > 2) THEN IF (Hc < 48) THEN Gt = Gc MOD Ht ELSEIF Gt > 14 THEN Gt = Gt - 8 ELSEIF Hc > 47 THEN Gt = Gc MOD 14 ELSEIF Hc > 71 THEN Gt = 7 + (Gc MOD (Som + 1)) END IF END IF ELSE IF tCnt% > (%NotenTotaal \ %Rb) THEN Gt = 2 + (Gc MOD 13) IF tCnt% > (%NotenTotaal \ %Rb) * %Ra THEN Gt = Som + (Gc MOD 15) IF tCnt% > (%NotenTotaal \ %Rf) * %Rd THEN Gt = Som + 7 - (Gc MOD 7) IF tCnt% > (%NotenTotaal \ %Rh) * %Rg THEN Gt = 15 - (Gc MOD 15) IF (tCnt% > 0 AND Som > 5) THEN Gt = (Gc MOD Som + 1) + 5 IF Som = 8 AND tCnt% > 1 THEN Gt = %Rg END IF IF Gt > 14 THEN Gt = 14 - (RND(1) * Som) D6 = %True ELSE D6 = %False END IF ' H-partij deelfaktor 9 IF tCnt% MOD %Rh = %False THEN INCR Hc IF Hc < 71 THEN IF Hc = 1 THEN Ht = 0 IF Hc = 2 THEN Ht = 1 IF Hc = 3 THEN Ht = 0 IF Hc = 4 THEN Ht = 1 IF Hc = 5 THEN Ht = 2 IF Hc = 6 THEN Ht = 1 IF Hc = 7 THEN Ht = 0 IF Hc > 7 AND Hc < 11 THEN Ht = Ht + 1 IF Hc > 10 AND Hc < 13 THEN Ht = Ht - 1 IF Hc > 12 AND Hc < 16 THEN Ht = Ht + 1 IF Hc > 15 AND Hc < 18 THEN Ht = Ht - 1 IF Hc > 17 AND Hc < 21 THEN Ht = Ht + 1 IF Hc > 20 AND Hc < 23 THEN Ht = Ht - 1 IF Hc > 22 AND Hc < 26 THEN Ht = Ht + 1 IF Hc > 25 AND Hc < 28 THEN Ht = Ht - 1 IF Hc > 27 AND Hc < 31 THEN Ht = Ht + 1 IF Hc > 30 AND Hc < 33 THEN Ht = Ht - 1 IF Hc > 32 AND Hc < 36 THEN Ht = Ht + 1 IF Hc > 35 AND Hc < 38 THEN Ht = Ht - 1 IF Hc > 37 AND Hc < 41 THEN Ht = Ht + 1 IF Hc > 40 AND Hc < 43 THEN Ht = Ht - 1 IF Hc > 42 AND Hc < 46 THEN Ht = Ht + 1 IF Hc > 45 AND Hc < 48 THEN Ht = Ht - 1 IF Hc > 47 AND Hc < 51 THEN Ht = Ht + 1 IF Hc > 50 AND Hc < 53 THEN Ht = Ht - 1 IF Hc > 52 AND Hc < 56 THEN Ht = Ht + 1 IF Hc > 55 AND Hc < 58 THEN Ht = Ht - 1 IF Hc > 57 AND Hc < 61 THEN Ht = Ht + 1 IF Hc > 60 AND Hc < 63 THEN Ht = Ht - 1 IF Hc > 62 AND Hc < 66 THEN Ht = Ht + 1 IF Hc > 65 AND Hc < 68 THEN Ht = Ht - 1 IF Hc > 67 AND Hc < 71 THEN Ht = Ht + 1 ELSE IF Hc = 71 THEN Ht = 15 IF (Hc > 71 AND Hc < 87) THEN Ht = Ht - 1 IF (Hc > 86 AND Hc < 120) THEN Ht = Hc MOD 14 + (RND(1) * 2) IF (Hc > 119 AND Hc < 152) THEN Ht = RND(1) * (Hc MOD 16) IF (Hc > 151 AND Hc < 218) THEN Ht = 16 - (RND(1) * (Hc MOD 16)) IF Hc > 217 THEN Ht = (16 - (Hc MOD 15 + RND(1) * 1)) IF Som = 8 AND tCnt% > 1 THEN Ht = %Rh END IF IF Ht > 15 THEN Ht = 15 D7 = %True ELSE D7 = %False END IF Som = D0 + D1 + D2 + D3 + D4 + D5 + D6 + D7 Slotkorrektie: IF (Bt <> 0) AND (Ct <> 0) AND (Dt <> 0) AND (Ft <> 0) AND (Gt <> 0) AND (Ht <> 0) AND (Som > 4) THEN Att = 1 Et = 0 INCR Q IF Q > 4 THEN Q = %False END IF IF tCnt% = %NotenTotaal THEN Att = %Ra Bt = %Rb Dt = %Rd Ft = %Rf IF (Ct = Et) OR (Ct = Gt) OR (Ct = Ht) THEN Ct = 1 IF (Et = Gt) OR (Et = Ht) THEN Et = 6 IF Gt = Ht THEN Gt = 8 END IF Shifts_Bind: Shifts.Nte(0) = Att ' these are the pointers to the notes in the look up table! Shifts.Nte(1) = Bt ' not the notes themselves!!! Shifts.Nte(2) = Ct Shifts.Nte(3) = Dt Shifts.Nte(4) = Et Shifts.Nte(5) = Ft Shifts.Nte(6) = Gt Shifts.Nte(7) = Ht Shifts.Nte(8) = Att Shifts.Nte(9) = Bt Shifts.Nte(10) = Ct Shifts.Nte(11) = Dt Shifts.Nte(12) = Et Shifts.Nte(13) = Ft Shifts.Nte(14) = Gt Shifts.Nte(15) = Ht Transposities: IF Som > 6 AND tCnt% > 1 THEN INCR Transpose SetDlgItemText gh.Cockpit, %GMT_MSG1, "Transposition= " + STR$(Shifts.trans(Transpose)) IF Transpose > 0 THEN FOR i? = 0 TO 15 ' kanaalteller FOR j? = 0 TO 15 ' notenwijzerteller Shifts.midi(i?, j?) = Shifts.mid(i?, j?) + Shifts.trans(Transpose) NEXT j? NEXT i? END IF END IF IF BIT(Task(App.WriteSeqScoreTaskNr).swit,%TASK_ONOFF) THEN ' indien de partituur wegschrijf task aktief is... ' score generation: makes 8 seq structures. IF App.SeqOutFileNr THEN FOR k= 0 TO 7 Shifts.vel(k) = 63 + (Som * 8) noot = Shifts.midi(k,Shifts.Nte(k)) SELECT CASE k CASE 0 IF D0 THEN IF no(0) THEN DelNote2Har Task(%SHIFTS_ALGO + k).Har,(no(0)) AddNote2Har Task(%SHIFTS_ALGO).Har,(noot), (Shifts.vel(k)) no(0) = noot 'WriteHar2File Task(%SHIFTS_ALGO).Har,0,(App.SeqOutFileNr) PRINT# App.SeqOutFileNr, 0; tCnt%*10; "H"; Task(%Shifts_Algo).Har.vel END IF CASE 1 IF D1 THEN IF no(1) THEN DelNote2Har Task(%SHIFTS_ALGO + 1).Har,(no(1)) AddNote2Har Task(%SHIFTS_ALGO + 1).Har,(noot), (Shifts.vel(1)) no(1) = noot 'WriteHar2File Task(%SHIFTS_ALGO + 1).Har,1,(App.SeqOutFileNr) PRINT# App.SeqOutFileNr, 1; tCnt%*10; "H"; Task(%Shifts_Algo+1).Har.vel END IF CASE 2 IF D2 THEN IF no(2) THEN DelNote2Har Task(%SHIFTS_ALGO + 2).Har,(no(2)) AddNote2Har Task(%SHIFTS_ALGO + 2).Har,(noot), (Shifts.vel(2)) no(2) = noot 'WriteHar2File Task(%SHIFTS_ALGO + 2).Har,2,(App.SeqOutFileNr) PRINT# App.SeqOutFileNr, 2; tCnt%*10; "H"; Task(%Shifts_Algo+2).Har.vel END IF CASE 3 IF D3 THEN IF no(3) THEN DelNote2Har Task(%SHIFTS_ALGO + 3).Har,(no(3)) AddNote2Har Task(%SHIFTS_ALGO + 3).Har,(noot), (Shifts.vel(3)) no(3) = noot 'WriteHar2File Task(%SHIFTS_ALGO + 3).Har,3,(App.SeqOutFileNr) PRINT# App.SeqOutFileNr, 3; tCnt%*10; "H"; Task(%Shifts_Algo+3).Har.vel END IF CASE 4 IF D4 THEN IF no(4) THEN DelNote2Har Task(%SHIFTS_ALGO + 4).Har,(no(4)) AddNote2Har Task(%SHIFTS_ALGO + 4).Har,(noot), (Shifts.vel(4)) no(4) = noot 'WriteHar2File Task(%SHIFTS_ALGO + 4).Har,4,(App.SeqOutFileNr) PRINT# App.SeqOutFileNr, 4; tCnt%*10; "H"; Task(%Shifts_Algo+4).Har.vel END IF CASE 5 IF D5 THEN IF no(5) THEN DelNote2Har Task(%SHIFTS_ALGO + 5).Har,(no(5)) AddNote2Har Task(%SHIFTS_ALGO + 5).Har,(noot), (Shifts.vel(5)) no(5) = noot 'WriteHar2File Task(%SHIFTS_ALGO+5).Har,5,(App.SeqOutFileNr) PRINT# App.SeqOutFileNr, 5; tCnt%*10; "H"; Task(%Shifts_Algo+5).Har.vel END IF CASE 6 IF D6 THEN IF no(6) THEN DelNote2Har Task(%SHIFTS_ALGO + 6).Har,(no(6)) AddNote2Har Task(%SHIFTS_ALGO + 6).Har,(noot), (Shifts.vel(6)) no(6) = noot 'WriteHar2File Task(%SHIFTS_ALGO+ 6).Har,6,(App.SeqOutFileNr) PRINT# App.SeqOutFileNr, 6; tCnt%*10; "H"; Task(%Shifts_Algo+6).Har.vel END IF CASE 7 IF D7 THEN IF no(7) THEN DelNote2Har Task(%SHIFTS_ALGO + 7).Har,(no(7)) AddNote2Har Task(%SHIFTS_ALGO + 7).Har,(noot), (Shifts.vel(7)) no(7) = noot 'WriteHar2File Task(%SHIFTS_ALGO+ 7).Har,7,(App.SeqOutFileNr) PRINT# App.SeqOutFileNr, 7; tCnt%*10; "H"; Task(%Shifts_Algo+7).Har.vel END IF END SELECT NEXT k ELSE MSGBOX "Cannot write score - no filehandle..." StopTask App.WriteSeqScoreTaskNr END IF ELSE END IF midilabel: SELECT CASE Shifts.Miparam CASE 1 ' single channel polyphonic version - do we still need this ??? pp% = Slider(0).value \2 IF pp% > Task(%Shifts_algo).level THEN pp% = Task(%Shifts_algo).level k = Task(%Shifts_algo).channel velo = pp% + (Som * (1 + (pp%/8))) ' [0-64] + {[1-8] * [1-9]} IF velo > 127 THEN velo = 127 IF D0 THEN noot = Shifts.midi(0,Shifts.Nte(0)) IF noot <> Shifts.OldNot(0) THEN IF Shifts.OldNot(0) THEN NoteOff k,Shifts.OldNot(0) : Shifts.Oldnot(0)= %False Play k, noot, velo Shifts.OldNot(0) = noot ELSE ' niks - we binden gelijke noten - als de toggle aan staat. IF ISFALSE Shifts.tog THEN Play k, noot, velo Shifts.OldNot(0) = noot END IF END IF END IF IF D1 THEN noot = Shifts.midi(1,Shifts.Nte(1)) IF noot <> Shifts.OldNot(1) THEN IF Shifts.OldNot(1) THEN NoteOff k,Shifts.OldNot(1) : Shifts.Oldnot(1)= %False Play k, noot, velo Shifts.OldNot(1) = noot ELSE ' niks - we binden gelijke noten - als de toggle aan staat. IF ISFALSE Shifts.tog THEN Play k, noot, velo Shifts.OldNot(1) = noot END IF END IF END IF IF D2 THEN noot = Shifts.midi(2,Shifts.Nte(2)) IF noot <> Shifts.OldNot(2) THEN IF Shifts.OldNot(2) THEN NoteOff k,Shifts.OldNot(2) : Shifts.Oldnot(2)= %False Play k, noot, velo Shifts.OldNot(2) = noot ELSE ' niks - we binden gelijke noten - als de toggle aan staat. IF ISFALSE Shifts.tog THEN Play k, noot, velo Shifts.OldNot(2) = noot END IF END IF END IF IF D3 THEN noot = Shifts.midi(3,Shifts.Nte(3)) IF noot <> Shifts.OldNot(3) THEN IF Shifts.OldNot(3) THEN NoteOff k,Shifts.OldNot(3) : Shifts.Oldnot(3)= %False Play k, noot, velo Shifts.OldNot(3) = noot ELSE ' niks - we binden gelijke noten - als de toggle aan staat. IF ISFALSE Shifts.tog THEN Play k, noot, velo Shifts.OldNot(3) = noot END IF END IF END IF IF D4 THEN noot = Shifts.midi(4,Shifts.Nte(4)) IF noot <> Shifts.OldNot(4) THEN IF Shifts.OldNot(4) THEN NoteOff k,Shifts.OldNot(4) : Shifts.Oldnot(4)= %False Play k, noot, velo Shifts.OldNot(4) = noot ELSE ' niks - we binden gelijke noten - als de toggle aan staat. IF ISFALSE Shifts.tog THEN Play k, noot, velo Shifts.OldNot(4) = noot END IF END IF END IF IF D5 THEN noot = Shifts.midi(5,Shifts.Nte(5)) IF noot <> Shifts.OldNot(5) THEN IF Shifts.OldNot(5) THEN NoteOff k,Shifts.OldNot(5) : Shifts.Oldnot(5)= %False Play k, noot, velo Shifts.OldNot(5) = noot ELSE ' niks - we binden gelijke noten - als de toggle aan staat. IF ISFALSE Shifts.tog THEN Play k, noot, velo Shifts.OldNot(5) = noot END IF END IF END IF IF D6 THEN noot = Shifts.midi(6,Shifts.Nte(6)) IF noot <> Shifts.OldNot(6) THEN IF Shifts.OldNot(6) THEN NoteOff k,Shifts.OldNot(6) : Shifts.Oldnot(6)= %False Play k, noot, velo Shifts.OldNot(6) = noot ELSE ' niks - we binden gelijke noten - als de toggle aan staat. IF ISFALSE Shifts.tog THEN Play k, noot, velo Shifts.OldNot(6) = noot END IF END IF END IF IF D7 THEN noot = Shifts.midi(7,Shifts.Nte(7)) IF noot <> Shifts.OldNot(7) THEN IF Shifts.OldNot(7) THEN NoteOff k,Shifts.OldNot(7) : Shifts.Oldnot(7)= %False Play k, noot, velo Shifts.OldNot(7) = noot ELSE ' niks - we binden gelijke noten - als de toggle aan staat. IF ISFALSE Shifts.tog THEN Play k, noot, velo Shifts.OldNot(7) = noot END IF END IF END IF CASE 2 ' here we use 8 channels only. - each voice is played on its own channel ' pp% = Slider(0).value \ 2 ' IF pp% > Task(%Shifts_algo).level THEN pp% = Task(%Shifts_algo).level IF D0 THEN k = 0: GOSUB MISEND END IF IF D1 THEN k = 1: GOSUB MISEND END IF IF D2 THEN k = 2: GOSUB MISEND END IF IF D3 THEN k = 3: GOSUB MISEND END IF IF D4 THEN k = 4: GOSUB MISEND END IF IF D5 THEN k = 5: GOSUB MISEND END IF IF D6 THEN k = 6: GOSUB MISEND END IF IF D7 THEN k = 7: GOSUB MISEND END IF CASE 3 'pp% = Task(%Shifts_algo).level pp% = Slider(0).value \ 2 IF pp% > Task(%Shifts_algo).level THEN pp% = Task(%Shifts_algo).level ' microtonal version - using pitch bend. ' On proteus, better set the tuning to Just Intonation directly... ' FOR k = 0 TO 7 ' IF App.SynthName = "FB01" THEN ' 'Uit (&HF0): Uit (&H43): Uit (&H75): Uit (&H70): Uit (16 + k): Uit (Shifts.midi(k, Shifts.Nte(k))): Uit (Shifts.Cent(k, Shifts.Nte(k))): Uit ((64 + (Som * 3)) + (32 - (2 * (Hy(tCnt%, k))))): Uit (&HF7) ' SysEx CHR$(&HF0,&H43,&H75,&H70,16+k,Shifts.midi(k, Shifts.Nte(k)),Shifts.Cent(k, Shifts.Nte(k)),(64 + (Som * 3)) + (32 - (2 * (Hy(tCnt%, k)))),&HF7) ' ELSE ' IF Shifts.Notesoff THEN ' ' switch previous note/channel off if new note different: ' IF Shifts.midi(k, Shifts.Nte(k)) <> Shifts.OldNot(k) THEN ' NoteOff k,Shifts.Oldnot(k) 'Uit (128 + k): Uit (Oldnot(k)): Uit (0) 'pitch bend code comes first! ' Uit (&HE0 + k): 'lsbmsb = 8192 + ((8192 / 100) * Shifts.Cent(k, Shifts.Nte(k))) ' lsbmsb = 8191 + (82 * Shifts.Cent(k, Shifts.Nte(k))) ' Uit (lsbmsb MOD 128): Uit (lsbmsb \ 128) ' Shifts.OldNot(k) = (Shifts.midi(k, Shifts.Nte(k))) ' Uit (144 + k): Uit (Shifts.midi(k, Shifts.Nte(k))) ' Uit ((pp% + (Som * 3)) + (32 - (2 * (Hy(tCnt%, k))))) ' END IF ' ELSE ' 'pitch bend code comes first! ' Uit (&HE0 + k): lsbmsb = 8191 + (82 * Cent(k, Shifts.Nte(k))) ' Uit (lsbmsb MOD 128): Uit (lsbmsb \ 128) ' Shifts.OldNot(k) = (Shifts.midi(k, Shifts.Nte(k))) ' Uit (144 + k): Uit (Oldnot(k)): '(Shifts.midi(k, Shifts.Nte(k))) ' Uit ((pp% + (Som * 3)) + (32 - (2 * (Hy(tCnt%, k))))) ' END IF ' END IF CASE 4 ' specific player piano code... ' here the cockpit buttons have no effect. pp% = Slider(0).value \ 4 IF pp% > Task(%Shifts_algo).level THEN pp% = Task(%Shifts_algo).level ' we would better use play har here... FOR k = 0 TO 7 noot = Shifts.midi(k, Shifts.Nte(k)) Shifts.vel(k) = pp% + (Som * (1+(pp%/8))) ' control dynamic range. IF Shifts.vel(k) > 127 THEN Shifts.vel(k) = 127 IF noot < PlayerPiano.lowtes THEN noot = %False : Shifts.vel(k) = %False IF noot > PlayerPiano.hightes THEN noot = %False : Shifts.vel(k) = %False IF Toets!(noot) <> Shifts.vel(k) THEN IF Toets!(noot)> %False THEN NoteOff Task(%SHIFTS_ALGO).channel, noot :Toets!(noot) = %False IF noot THEN IF Shifts.vel(k) THEN Play Task(%SHIFTS_ALGO).channel,noot, Shifts.vel(k) Toets!(noot) = Shifts.vel(k) ELSE Toets!(noot) = %False END IF END IF ELSE ' in dit geval laten we de noot liggen END IF NEXT k CASE 5 ' 16 channels 1 voice per channel , voices doubled IF D0 THEN k = 0: GOSUB MISEND k = 8: GOSUB MISEND END IF IF D1 THEN k = 1: GOSUB MISEND k = 9: GOSUB MISEND END IF IF D2 THEN k = 2: GOSUB MISEND k = 10: GOSUB MISEND END IF IF D3 THEN k = 3: GOSUB MISEND k = 11: GOSUB MISEND END IF IF D4 THEN k = 4: GOSUB MISEND k=12: GOSUB MISEND END IF IF D5 THEN k = 5: GOSUB MISEND k = 13: GOSUB MISEND END IF IF D6 THEN k = 6: GOSUB MISEND k = 14: GOSUB MISEND END IF IF D7 THEN k = 7: GOSUB MISEND k = 15: GOSUB MISEND END IF END SELECT INCR tCnt% Task(%Shifts_Algo).freq = App.tempo / 60! SetDlgItemText gh.Cockpit, %GMT_MSG2, STR$(tCnt%) IF tCnt% > %NotenTotaal THEN Task(%Shifts_Algo).freq = 0.2 ' fermata END IF EXIT SUB MISEND: noot = Shifts.midi(k,Shifts.Nte(k)) IF k < 8 THEN Shifts.Vel(k) = (Slider(0).value\2) + (Som * (1+(Slider(0).value\16))) ELSE Shifts.Vel(k) = (Slider(1).value\2) + (Som * (1+(Slider(1).value\16))) END IF IF Shifts.Vel(k) > 127 THEN Shifts.Vel(k) = 127 IF noot <> Shifts.OldNot(k) THEN IF Shifts.Notesoff THEN IF Shifts.OldNot(k) THEN NoteOff k, Shifts.OldNot(k) : Shifts.OldNot(k)= %False END IF IF Shifts.Vel(k) THEN Play k, noot, Shifts.Vel(k) Shifts.Oldnot(k) = noot END IF ELSE IF ISFALSE Shifts.tog THEN IF Shifts.Notesoff THEN IF Shifts.OldNot(k) THEN NoteOff k, Shifts.OldNot(k) : Shifts.OldNot(k)= %False END IF IF Shifts.Vel(k) THEN Play k, noot, Shifts.Vel(k) Shifts.Oldnot(k) = noot END IF ELSE ' in geval we noten binden, gebeurt er niks. END IF END IF RETURN END SUB SUB Allesuit LOCAL k? SLEEP 5 '??? FOR k? = 0 TO 15 AllNotesOff k? NEXT k? END SUB SUB FB01Bendon ' gmt-ready LOCAL i AS BYTE FOR i = 0 TO 7 SysEx hMidiO(0), CHR$(&HF0,&H43,16+i,&H15,&HC,1,&HF7) 'set bend-range to 1 semitone 'sys-ex for FB01 NEXT i END SUB SUB Lfopan LOCAL i? LOCAL pan AS BYTE 'IF LEFT$(App.SynthName,4) = "FB01" THEN IF LEFT$(UCASE$(Meq(0).naam),4) = "FB01" THEN FOR i? = 0 TO 7 ' set panning - works on all synths ( FB01 takes only 0 -64 - 127 for left, center or right... IF i? MOD 3? = 0 THEN pan= 0 IF i? MOD 4? = 0 THEN pan= 64 IF i? MOD 3? > 0 AND i? MOD 4? > 0 THEN pan= 127 ModeMess i?,&HA, pan ModeMess i? + 8,&HA, pan NEXT i? ELSE FOR i? = 0 TO 7 pan = ((i?+1) * 16)-1 ' new since version Shifts '99 ModeMess i?, &HA, pan ModeMess 15 -i?, &HA, pan NEXT i? END IF END SUB SUB Shifts_Volume () LOCAL k? ' works on all synths - sets all channels! FOR k? = 0 TO 7 Modemess k?, 7,(90 + (k? * 2)) ModeMess k? + 8, 7,(90 + (k? * 2)) NEXT k? END SUB '*************************************************************************** SUB VoicesFB01 () LOCAL i? LOCAL m AS STRING FOR i? = 0 TO 7 m = CHR$(&HF0,&H43,&H75,&H70,112 + i?,&HD,0,112 + i?) m = m + CHR$(0,1,(112? + i?),&H4,Shifts.Bank(i?),(112? + i?),&H5,Shifts.Ins(i?)) m = m + CHR$(112 + i?,&H10,0,112 + i?,&HA,0,112 + i?,&HE) m = m + CHR$(&H2,(112 + i?),&HC,&H1,&HF7) SysEx hMidiO(0), m ' programm-change controll codes via system-exclusives ' &HD - parameter = poly/mono mode ' 0 set poly-mode on ' 0 parameter=number of notes per channel ' 1 set to 1 note per channel ' &H4 parameter=voice bank: BANK(I) ' &H5 parameter= voice-select: INS(I) ' &H10 parameter= LFO speed - set to 0 ' &HA parameter = LFO switch - set to OFF ' &HE parameter= select input controller ' &H2 select modulation wheel ' &HC parameter=pitch-bend range ' &H1 set to 1 semitone up or down NEXT i? END SUB SUB Shifts_ReadNotesFromIniFile (version$) EXPORT ' version$ can only be: JUST, INSTRUMENTAL, DIM, PLAYER_PIANO LOCAL f AS LONG LOCAL dummy$ LOCAL kanaal AS INTEGER LOCAL j AS INTEGER LOCAL buffer AS OFSTRUCT f = OpenFile ($SHIFTSINI, buffer, %OF_PROMPT OR %OF_EXIST) ' creates a message box if file was not found. IF f = -1 THEN ' %HFILE_ERROR - not found in declarations for Win32Api ' The -1 value is returned if 'cancel' is checked in the messagebox. ' MTStop = %True EXIT SUB END IF f = FREEFILE OPEN $SHIFTSINI FOR INPUT AS f DO UNTIL EOF(f) INPUT #f, dummy$ SELECT CASE dummy$ CASE "[VOICE_NOTES]" DO UNTIL EOF(f) INPUT #f, dummy$ SELECT CASE dummy$ CASE version$ DO INPUT #f, dummy$ IF dummy$ <> "VOICE" THEN #IF %DEF(%PB_CC32) PRINT "Error 1 in shifts.cfg - voice not found " #ELSE MSGBOX "Error 1 in Shifts datafile" #ENDIF CLOSE #f EXIT SUB END IF INPUT #f, kanaal INPUT #f, dummy$ IF dummy$ <> "NOTES" THEN #IF %DEF(%PB_CC32) PRINT "Error 2 in shifts.cfg - Notes not found " #ELSE MSGBOX "Error 2 in Shifts datafile" #ENDIF CLOSE #f EXIT SUB END IF FOR j = 0 TO 15 INPUT #f, Shifts.mid(kanaal,j) NEXT j LOOP UNTIL kanaal = 15 IF version$ <> "JUST" THEN CLOSE #f EXIT SUB END IF CASE "[EOF]" CLOSE #f EXIT SUB END SELECT LOOP CASE "[EOF]" CLOSE #f EXIT SUB END SELECT LOOP CLOSE #f END SUB SUB Shifts_GetCents () EXPORT LOCAL kanaal AS LONG FOR kanaal = 0 TO 15 Shifts.Cent(kanaal,0) = 0 Shifts.Cent(kanaal,1) = 0 Shifts.Cent(kanaal,2) = 2 Shifts.Cent(kanaal,3) = 0 Shifts.Cent(kanaal,4) = 86 Shifts.Cent(kanaal,5) = 2 Shifts.Cent(kanaal,6) = 68 Shifts.Cent(kanaal,7) = 0 Shifts.Cent(kanaal,8) = 4 Shifts.Cent(kanaal,9) = 86 Shifts.Cent(kanaal,10) = 90 Shifts.Cent(kanaal,11) = 2 Shifts.Cent(kanaal,12) = 84 Shifts.Cent(kanaal,13) = 68 Shifts.Cent(kanaal,14) = 88 Shifts.Cent(kanaal,15) = 0 NEXT kanaal END SUB SUB Shifts_ReadPatchesFromIniFile () EXPORT ' we do not have to check for the existence of the file anymore, since we first checked for that condition ' in reading the note lookup. LOCAL f AS LONG LOCAL dummy$ LOCAL kanaal AS INTEGER LOCAL j AS INTEGER f = FREEFILE OPEN $SHIFTSINI FOR INPUT AS f DO UNTIL EOF(f) INPUT #f, dummy$ SELECT CASE dummy$ CASE "[SYNTH]" DO INPUT #f, dummy$ dummy$= TRIM$(UCASE$(dummy$)) IF dummy$ = TRIM$(UCASE$(Meq(0).naam)) THEN EXIT LOOP 'App.SynthName THEN EXIT LOOP LOOP UNTIL EOF(f) IF EOF(f) THEN MSGBOX "Error 5 in Shifts.cfg file!!! " CLOSE #f EXIT SUB ' error END IF FOR kanaal = 0 TO 15 INPUT #f, Shifts.Ins(kanaal) NEXT kanaal IF LEFT$(UCASE$(Meq(0).naam),4) = "FB01" THEN 'LEFT$(App.SynthName,4) = "FB01" THEN INPUT #f, dummy$ IF dummy$ <> "BANK" THEN #IF %DEF(%PB_CC32) PRINT "BANK not found in Shifts.cfg file. Error 6" #ELSE MSGBOX "Error 6 in Shifts.cfg file !!!" #ENDIF END IF FOR kanaal = 0 TO 7 INPUT #f, Shifts.Bank(kanaal) NEXT kanaal ELSE CLOSE #f EXIT SUB END IF CASE "[EOF]" CLOSE #f EXIT SUB END SELECT LOOP CLOSE #f END SUB SUB Shifts_InitMidi () EXPORT '************* M I D I - I N I T I A L I S A T I E ************** ' the parameter only applies to FB01, if that synth is not used, the string may be empty. ' The synth initialised is passed in App.Synthname LOCAL i AS INTEGER SELECT CASE TRIM$(UCASE$(Meq(0).naam)) 'App.SynthName CASE "FB01", "FB01_SINE" , "FB01 Sinewaves" FB01Bendon VoicesFB01 Lfopan Shifts_Volume Task(%Shifts_Algo).level = 64 CASE "PROFORMANCE" ' PROFBendon FOR i = 0 TO 15 ProgChange i, Shifts.Ins(i) NEXT i Task(%Shifts_Algo).level = 64 CASE "PROTEUS3","PROTEUS3XR" ' PROTBendon FOR i = 0 TO 15 ProgChange i, Shifts.Ins(i) NEXT i Lfopan Shifts_Volume Task(%Shifts_Algo).level = 64 CASE "PROTEUS2","PROTEUS2XR" ' PROTBendon FOR i = 0 TO 15 ProgChange i, Shifts.Ins(i) NEXT i Lfopan Shifts_Volume Task(%Shifts_Algo).level = 64 CASE "PROTEUS2000" FOR i = 0 TO 15 ProgChange i, Shifts.Ins(i) NEXT i Lfopan Shifts_Volume Task(%Shifts_Algo).level = 64 CASE "PLAYER" ,"PLAYPIAN", "PLAYER_PIANO", "RAES-TRIMPIN PLAYER PIANO" Task(%Shifts_Algo).level = 12 CASE "FB01_PROT3", "FB01 + PROTEUS 3 FOR SHIFTS" ' channels 0-7 via FB01 VoicesFB01 ' channels 8-15 via Proteus ' PROTBendon FOR i = 8 TO 15 ProgChange i, Shifts.Ins(i) NEXT i Lfopan Shifts_Volume Task(%Shifts_Algo).level = 64 END SELECT ' einde midi-installatie procedure END SUB FUNCTION Shifts_GetTranspositiondata () EXPORT AS BYTE LOCAL i AS LONG LOCAL kanaal AS BYTE LOCAL noot AS BYTE LOCAL dm AS ASCIIZ * 1000 LOCAL szTitelBox AS ASCIIZ * 10 szTitelBox = "" SELECT CASE App.id CASE %ID_SHIFTS_INS '=%ID_GWR + 18 'App.title = " INSTR, 1987" SetDlgItemText gh.Cockpit, %GMT_TITLE, " INSTR,1987" & CHR$(0) Shifts.Trans(0) = 0 Shifts.Trans(1) = 7 Shifts.Trans(2) = 5 Shifts.Trans(3) = 9 Shifts.Trans(4) = 3 Shifts.Trans(5) = 2 Shifts.Trans(6) = 6 Shifts.Trans(7) = 7 Shifts.Trans(8) = 2 Shifts.Trans(9) = 8 Shifts.Trans(10) = 4 Shifts.Trans(11) = 7 Shifts.Trans(12) = 10 Shifts.Trans(13) = 12 Shifts.Trans(14) = 0 Shifts.Trans(15) = 0 Shifts_ReadNotesFromIniFile "INSTRUMENTAL" ' for debug: FOR kanaal = 0 TO 15 dm = dm + "Kanaal " + STR$(kanaal) + "|" FOR noot = 0 TO 15 dm = dm + STR$(Shifts.Mid(kanaal,noot)) NEXT noot dm = dm + CHR$(13) NEXT kanaal MessageBox gh.Inst,dm, szTitelbox,%MB_OK OR %MB_TASKMODAL OR %MB_TOPMOST FUNCTION = %True ' end debug CASE %ID_SHIFTS_PP ' = %ID_GWR + 19 'App.title = " PlayerPiano" SetDlgItemText gh.Cockpit, %GMT_TITLE, " PlayerPiano" & CHR$(0) Shifts.Trans(0) = 0 Shifts.Trans(1) = 7 Shifts.Trans(2) = 5 Shifts.Trans(3) = 9 Shifts.Trans(4) = 3 Shifts.Trans(5) = 2 Shifts.Trans(6) = 10 Shifts.Trans(7) = 11 Shifts.Trans(8) = 6 Shifts.Trans(9) = 12 Shifts.Trans(10) = 8 Shifts.Trans(11) = 13 Shifts.Trans(12) = 15 Shifts.Trans(13) = 12 Shifts.Trans(14) = 0 Shifts.Trans(15) = 0 Shifts_ReadNotesFromIniFile "PLAYPIAN" FUNCTION = %True CASE %ID_SHIFTS_JUST '= %ID_GWR + 20 'App.title = ", 1987" SetDlgItemText gh.Cockpit, %GMT_TITLE, " ,1987" & CHR$(0) Shifts.Trans(0) = 0 Shifts.Trans(1) = 7 Shifts.Trans(2) = 10 Shifts.Trans(3) = 5 Shifts.Trans(4) = 9 Shifts.Trans(5) = 4 Shifts.Trans(6) = 3 Shifts.Trans(7) = 7 Shifts.Trans(8) = 10 Shifts.Trans(9) = 2 Shifts.Trans(10) = 5 Shifts.Trans(11) = 7 Shifts.Trans(12) = 10 Shifts.Trans(13) = 12 Shifts.Trans(14) = 0 Shifts.Trans(15) = 0 Shifts_ReadNotesFromIniFile "JUST" FUNCTION = %True CASE %ID_SHIFTS_DIM '= %ID_GWR + 21 'App.title = ", 1987" SetDlgItemText gh.Cockpit, %GMT_TITLE, ",1987" & CHR$(0) FOR i = 1 TO 15 Shifts.Trans(i) = Shifts.Trans(i-1) + 3 NEXT i Shifts_ReadNotesFromIniFile "DIM" FUNCTION = %True CASE ELSE FUNCTION = %False END SELECT END FUNCTION SUB Shifts_RemapSliders () EXPORT LOCAL i AS LONG LOCAL iSelMin AS INTEGER LOCAL iSelMax AS INTEGER ' The upper slider in the cockpit will be used to controll channel 0-7 dynamics. ' The lower slider, channel 8-15 dynamics ' These real time controlls could be updated on software interrupt base. ' To achieve this we can place the procedure codepointer in the slider structure: IF Slider(0).h THEN Slider(0).maxval = 64 ' maximum value IN trackbar range Slider(0).minval = 0 ' minimum value IN trackbar range Slider(0).resetval = Task(%SHIFTS_ALGO).level Slider(0).value = Task(%SHIFTS_ALGO).level Slider(0).stap = 1 SendMessage Slider(0).h, %TBM_SETRANGE,%True, MakeLong(Slider(0).minval, Slider(0).maxval) SendMessage Slider(0).h, %TBM_SETPAGESIZE,0,Slider(0).stap iSelMin = Slider(0).minval iSelMax = Slider(0).maxval SendMessage Slider(0).h, %TBM_SETSEL, %False, MakeLong(iSelMin, iSelMax) SendMessage Slider(0).h, %TBM_SETPOS,%True, Slider(0).minval ELSE MSGBOX " needs a slider to control channel 0-7 dynamics..." END IF IF Slider(1).h THEN Slider(1).maxval = 64 'maximum value IN trackbar range Slider(1).minval = 0 'minimum value in trackbar range Slider(1).resetval =Task(%SHIFTS_ALGO).level Slider(1).value = Task(%SHIFTS_ALGO).level Slider(1).stap = 1 SendMessage Slider(1).h, %TBM_SETRANGE,%True, MakeLong(Slider(1).minval, Slider(1).maxval) SendMessage Slider(1).h, %TBM_SETPAGESIZE,0,Slider(1).stap iSelMin = Slider(1).minval iSelMax = Slider(1).maxval SendMessage Slider(1).h, %TBM_SETSEL, %False, MakeLong(iSelMin, iSelMax) SendMessage Slider(1).h, %TBM_SETPOS,%True, Slider(1).minval ELSE MSGBOX " needs a slider to control channel 8-F dynamics..." END IF END SUB SUB Shifts_UpDown0_Handler () EXPORT ' this U/D controller increments/decrements the tempo variable with 5% STATIC oldval AS LONG STATIC tog AS BYTE IF ISFALSE tog THEN tog = %True oldval = UDCtrl(0).resetval END IF IF UDCtrl(0).value > oldval THEN App.Tempo = App.Tempo + (App.Tempo / 20) ELSE App.Tempo = App.Tempo - (App.Tempo / 20) END IF oldval = UDCtrl(0).value SetDlgItemText gh.Cockpit,%GMT_TEXT_TEMPO, STR$(App.Tempo) & CHR$(0) END SUB SUB Shifts_UpDown3_Handler () EXPORT ' this U/D controller increments/decrements the tempo variable with 50% STATIC oldval AS LONG STATIC tog AS BYTE IF ISFALSE tog THEN tog = %True oldval = UDCtrl(3).resetval END IF IF UDCtrl(3).value > oldval THEN App.Tempo = App.Tempo + (App.Tempo / 2) ELSE App.Tempo = App.Tempo - (App.Tempo / 4) END IF oldval = UDCtrl(3).value SetDlgItemText gh.Cockpit,%GMT_TEXT_TEMPO, STR$(App.Tempo) & CHR$(0) END SUB SUB Shifts_UpDown6_Handler () EXPORT ' this U/D controller doubles/halves the tempo STATIC oldval AS LONG STATIC tog AS BYTE IF ISFALSE tog THEN tog = %True oldval = UDCtrl(6).resetval END IF IF UDCtrl(6).value > oldval THEN App.Tempo = App.Tempo + App.Tempo ELSE App.Tempo = App.Tempo / 2 END IF oldval = UDCtrl(6).value SetDlgItemText gh.Cockpit,%GMT_TEXT_TEMPO, STR$(App.Tempo) & CHR$(0) END SUB SUB Shifts_RemapUpDowns () EXPORT LOCAL i AS LONG LOCAL iSelMin AS INTEGER LOCAL iSelMax AS INTEGER ' if we already have some U/D controlls in the cockpit, we first delete them... ' MakeUpDownControls gh.Cockpit, %False , UDCtrl() ' now we make new ones. - first create them, than reset their properties! (otherwize we get defaults) ' MakeUpDownControls gh.Cockpit, App.NrUpdowns, UDCtrl() ' 7, so that we have 3 in the first column. IF UDCtrl(0).h THEN UDCtrl(0).maxval = 4095 UDCtrl(0).minval = 0 UDCtrl(0).resetval = 2048 UDCtrl(0).value = 2048 UDCtrl(0).stap = 1 UDCtrl(0).hParent = gh.Cockpit UDCtrl(0).id = %GMT_UPDOWN_ID ' now we have to send the messages... iSelMin = UDCtrl(0).minval iSelMax = UDCtrl(0).maxval SendMessage UDCtrl(0).h, %UDM_SETRANGE, %False, MakeLong(iSelMax, iSelMin) SendMessage UDCtrl(0).h, %UDM_SETPOS, %False, UDctrl(0).value UDCtrl(0).Cptr = CODEPTR(Shifts_UpDown0_Handler) ELSE MSGBOX " needs U/D controller 0 for tempo adjustment..." END IF IF UDCtrl(3).h THEN UDCtrl(3).maxval = 4095 UDCtrl(3).minval = 0 UDCtrl(3).resetval = 2048 UDCtrl(3).value = 2048 UDCtrl(3).stap = 1 UDCtrl(3).hParent = gh.Cockpit UDCtrl(3).id = %GMT_UPDOWN_ID + 3 ' now we have to send the messages... iSelMin = UDCtrl(3).minval iSelMax = UDCtrl(3).maxval SendMessage UDCtrl(3).h, %UDM_SETRANGE, %False, MakeLong(iSelMax, iSelMin) SendMessage UDCtrl(3).h, %UDM_SETPOS, %False, UDctrl(3).value UDCtrl(3).Cptr = CODEPTR(Shifts_UpDown3_Handler) ELSE MSGBOX " needs U/D controller 3 for tempo adjustment..." END IF IF UDCtrl(6).h THEN UDCtrl(6).maxval = 4095 UDCtrl(6).minval = 0 UDCtrl(6).resetval = 2048 UDCtrl(6).value = 2048 UDCtrl(6).stap = 1 UDCtrl(6).hParent = gh.Cockpit UDCtrl(6).id = %GMT_UPDOWN_ID + 6 ' now we have to send the messages... iSelMin = UDCtrl(6).minval iSelMax = UDCtrl(6).maxval SendMessage UDCtrl(6).h, %UDM_SETRANGE, %False, MakeLong(iSelMax, iSelMin) SendMessage UDCtrl(6).h, %UDM_SETPOS, %False, UDctrl(6).resetval UDCtrl(6).Cptr = CODEPTR(Shifts_UpDown6_Handler) ELSE MSGBOX " needs U/D controller 6 for tempo adjustment..." END IF ' to clean up the cockpit, we conclude with deleting all up-down controllers that we do not need: ' Note that we have to do this indirectly, since performing the actual delete happens only after the ' final call to UpdateCockpit. FOR i = 0 TO UBOUND(UDCtrl) SELECT CASE i CASE 0, 3, 6 ' these are the ones we need for tempo-controll. CASE ELSE UDCtrl(i).Cptr = %False ' this criterium will delete them... UDCtrl(i).hParent = %False ' we can also just hide them... 'ShowWindow UDCtrl(i).h, %SW_HIDE ??? END SELECT NEXT i END SUB SUB Shifts_ButnSWHandler () LOCAL ButtonNr AS LONG LOCAL i AS DWORD LOCAL retval AS LONG STATIC prepcock AS DWORD LOCAL m AS ASCIIZ * 30 ' LOCAL lpwp AS WINDOWPLACEMENT ' replaces the default buttonhandler for the Cockpit window in GMT. ' This proc is called through its codepointer only! ButtonNr = App.butnSWparam - %GMT_BUTNSW_ID SELECT CASE ButtonNr CASE 1 IF ISFALSE prepcock THEN m = " Cockpit for " SendMessage gh.Cockpit, %WM_SETTEXT,0,VARPTR(m) ' write to caption bar ' rescale cockpitsliders... Shifts_RemapSliders SetDlgItemText gh.Cockpit,%GMT_TEXT_TEMPO, STR$(App.Tempo) & CHR$(0) prepcock = %True END IF ' starts the promil counter. IF ButnSW(ButtonNr).Flag THEN App.MTstart = %True App.tstart = timeGetTime ' start the chronometerfunction SetDlgItemText gh.Cockpit, App.butnSWparam, "STOP" ClearMiBuf 0 ' start with a blank midi input buffer BlockSysExReception hMidiI(0) 'StartTask App.RunTimeTaskNr 'StartTask App.MTSpeedTaskNr Runtime %True 'StartTask App.PromilTaskNr Promil %True StartTask App.GlobalHarmonyTasknr StartTask %SHIFTS_ALGO ELSE App.MTstart = %False SetDlgItemText gh.Cockpit, App.butnSWparam, "CONT" StopTask %SHIFTS_ALGO 'StopTask App.PromilTasknr Promil %False StopTask App.GlobalHarmonyTasknr END IF CASE 2 Shifts.tog = ButnSW(ButtonNr).flag ' action done in task code... CASE 3 Shifts.sustain = ButnSW(ButtonNr).flag IF Shifts.sustain THEN Shifts.NotesOff = %False ELSE Shifts.NotesOff = %True END IF CASE 5 ' needed for creation of melody window! IF ButnSW(Buttonnr).flag THEN MakeMelodyPatternWindow DrawStaff staff, gh.MelPat ' we should also change the size of this window 'LOCAL Rechthoek AS Rect LOCAL breedte AS LONG LOCAL r AS Fourlongs GetWindowRect gh.MelPat, r breedte = (r.b) - (r.x) MoveWindow gh.MelPat, r.x, r.y,breedte /2 ,200 , %True ' lpwp.length = SIZEOF (lpwp) ' lpwp.flags = %Null ' Getwindowplacement hMelPatWnd, lpwp ' LOCAL breedte AS LONG ' Rechthoek = lpwp.rcNormalposition ' breedte = Rechthoek.right - Rechthoek.left ' Rechthoek.left = lpwp.rcNormalposition.left ' refused by PBDLL... BUG in PB!!! ' following does not work neither...: ' LOCAL pRechthoek AS RECTL PTR ' pRechthoek = lpwp.rcNormalposition ' ' breedte = @pRechthoek.right - @pRechthoek.left ' MoveWindow hMelPatWnd, @pRechthoek.left, @pRechthoek.top, breedte / 2, @pRechthoek.bottom, %True ELSE DestroyWindow gh.MelPat END IF END SELECT App.butnSWparam = %False ' reset END SUB SUB Shifts_ButnOSHandler () LOCAL ButtonNr AS LONG LOCAL i AS DWORD LOCAL retval AS LONG ButtonNr = App.butnSWparam - %GMT_BUTNOS_ID SELECT CASE ButtonNr ' one shots: CASE 1 Play 4, 52, 127 ' gong in Rec-play CASE 2 Shifts.tuning = 0 ' EQual temperament Shifts_Tuning 'VARPTR(Shifts.Ins(0), (Shifts.tuning) CASE 3 Shifts.tuning = 1 ' Just C Shifts_Tuning 'Shifts.Ins(),Shifts.tuning CASE 4 Shifts.tuning = 2 ' Valotti Shifts_Tuning 'Shifts.Ins(),Shifts.tuning CASE 5 Shifts.tuning = 3 ' 19-tone Shifts_Tuning 'Shifts.Ins(),Shifts.tuning CASE 6 Shifts.tuning = 4 ' gamelan Shifts_Tuning 'Shifts.Ins(), Shifts.tuning CASE 7 Shifts.tuning = 5 ' user tuning Shifts_Tuning 'Shifts.Ins(), Shifts.tuning END SELECT App.butnOSparam = %False ' reset END SUB SUB Shifts_Tuning () LOCAL ch AS INTEGER LOCAL msb AS BYTE LOCAL lsb AS BYTE ' this sub puts Proteus modules in different tunings ' b%: lsb=0 for equal ' lsb=1 for Just C, ' lsb=2 for Valotti ' lsb=3 for 19-tone equal (Fokker) ' lsb=4 for gamelan ' lsb=5 for user-tuning ' it has to be done channel-by-channel! FOR ch = 15 TO 0 STEP -1 ' set basic basic channel: ' parameter = 256 of lsb=0 & msb=2 lsb msb lsb msb SysEx hMidiO(0), CHR$(&HF0,&H18,4,0,3,0,2,ch,0,&HF7) 'Wacht 1 ' parameter = 259 = current preset = lsb=3 msb=2 ' value = gesplitst als: msb = Shifts.Ins(ch)\ 128 lsb = Shifts.Ins(ch) MOD 128 SysEx hMidiO(0), CHR$(&HF0,&H18,4,0,3,3,2,lsb,msb,&HF7) 'Wacht 1 ' set tuning in this preset: ' parameter (127) + value sysex for proteus SysEx hMidiO(0), CHR$(&HF0,&H18,4,0,3,&H7F,0,Shifts.tuning,0,&HF7) NEXT ch END SUB SUB Shifts_ReMapCockpitButtons () LOCAL i AS LONG IF ISFALSE hMidiI(0) THEN ButnSW(0).tag0 = "" END IF ButnSW(1).tag0 = "START" ' start/stop toggle - only used for chrono and general watch... ButnSW(1).tag1 = "STOP" ButnSW(1).cPtr = %False ButnSW(2).tag0 = "Bind " ' Shifts.tog ButnSW(2).tag1 = "BindOff" ButnSW(2).cPtr = %False ButnSW(3).tag0 = "Sost " ' Shifts.sustain ButnSW(3).tag1 = "Sost Off" ButnSW(3).cptr = %False ButnSW(4).tag0 = "Harm On" ButnSW(4).tag1 = "Harm Off" ButnSW(5).tag0 = "Score" ' display staff for score to play along... ButnSW(5).tag1 = "ScoreOff" ButnSW(5).cptr = %False ButnSW(6).tag0 = "Psy" ' use default handler ButnSW(6).tag1 = "Psy Off" ButnSW(7).tag0 = "" ButnSW(8).tag0 = "" ButnSW(9).tag0 = "" ButnSW(10).tag0 = "" ButnSW(11).tag0 = "" ' ONE SHOT FUNCTIONS: ButnOS(1).tag = "" ' sound gong in recplay... ButnOS(1).cptr = %False ButnOS(2).tag = "Equal" ' changes tuning on Proteus 3. ButnOS(2).cptr = %False ButnOS(3).tag = "JustC" ButnOS(3).cptr = %False ButnOS(4).tag = "Valotti" ButnOS(4).cptr = %False ButnOS(5).tag = "19-tone" ButnOS(5).cptr = %False ButnOS(6).tag = "gamelan" ButnOS(6).cptr = %False ButnOS(7).tag = "UserTun" ButnOS(7).cptr = %False ButnOS(8).tag = "" ButnOS(9).tag = "" ButnOS(10).tag = "" ButnOS(11).tag = "" App.butnSWCptr = CODEPTR(Shifts_ButnSWHandler) ' all button events must be handled here!!! App.butnOsCptr = CODEPTR(Shifts_ButnOsHandler) END SUB SUB Shifts_Volume07 () STATIC lowestslidernumber AS BYTE LOCAL i AS LONG IF ISFALSE Task(%SHIFTS_VOLS07).tog THEN IF ISFALSE Task(%SHIFTS_VOLS07).hParam THEN ' prepare a parameter window for real time controll of channel volumes: DIM TaskParamLabels(0 TO 7) AS ASCIIZ * 8 TaskParamLabels(0) = "Vol 2" ' display the rootnumbers TaskParamLabels(1) = "Vol 3" TaskParamLabels(2) = "Vol 4" TaskParamLabels(3) = "Vol 5" TaskParamLabels(4) = "Vol 6" TaskParamLabels(5) = "Vol 7" TaskParamLabels(6) = "Vol 8" TaskParamLabels(7) = "Vol 9" MakeTaskParameterDialog %SHIFTS_VOLS07, 8,Slider(),0, UDctrl(),TaskParamLabels() Task(%SHIFTS_VOLS07).tog = %True IF lowestslidernumber = %False THEN lowestslidernumber = TaskEX(%SHIFTS_VOLS07).SliderNumbers(0) END IF ' now we fill in the codepointers for the callbacks. Slider(lowestslidernumber+0).cPtr = CODEPTR(Shifts_Vol0) Slider(lowestslidernumber+1).cPtr = CODEPTR(Shifts_Vol1) Slider(lowestslidernumber+2).cPtr = CODEPTR(Shifts_Vol2) Slider(lowestslidernumber+3).cPtr = CODEPTR(Shifts_Vol3) Slider(lowestslidernumber+4).cPtr = CODEPTR(Shifts_Vol4) Slider(lowestslidernumber+5).cPtr = CODEPTR(Shifts_Vol5) Slider(lowestslidernumber+6).cPtr = CODEPTR(Shifts_Vol6) Slider(lowestslidernumber+7).cPtr = CODEPTR(Shifts_Vol7) ' set initial slider positions: FOR i = 0 TO 7 SendMessage Slider(lowestslidernumber+i).h, %TBM_SETPOS,%True, 90 + (i *2) NEXT i ELSE ShowWindow Task(%SHIFTS_VOLS07).hParam, %SW_SHOW END IF END IF END SUB SUB Shifts_Vol0 STATIC nr AS BYTE STATIC tog AS BYTE IF ISFALSE Tog THEN tog = %True nr = TaskEX(%SHIFTS_VOLS07).SliderNumbers(0) END IF Modemess 0,7,Slider(nr).value END SUB SUB Shifts_Vol1 STATIC nr AS BYTE STATIC tog AS BYTE IF ISFALSE Tog THEN tog = %True nr = TaskEX(%SHIFTS_VOLS07).SliderNumbers(1) END IF Modemess 1,7,Slider(nr).value END SUB SUB Shifts_Vol2 STATIC nr AS BYTE STATIC tog AS BYTE IF ISFALSE Tog THEN tog = %True nr = TaskEX(%SHIFTS_VOLS07).SliderNumbers(2) END IF Modemess 2,7,Slider(nr).value END SUB SUB Shifts_Vol3 STATIC nr AS BYTE STATIC tog AS BYTE IF ISFALSE Tog THEN tog = %True nr = TaskEX(%SHIFTS_VOLS07).SliderNumbers(3) END IF Modemess 3,7,Slider(nr).value END SUB SUB Shifts_Vol4 STATIC nr AS BYTE STATIC tog AS BYTE IF ISFALSE Tog THEN tog = %True nr = TaskEX(%SHIFTS_VOLS07).SliderNumbers(4) END IF Modemess 4,7,Slider(nr).value END SUB SUB Shifts_Vol5 STATIC nr AS BYTE STATIC tog AS BYTE IF ISFALSE Tog THEN tog = %True nr = TaskEX(%SHIFTS_VOLS07).SliderNumbers(5) END IF Modemess 5,7,Slider(nr).value END SUB SUB Shifts_Vol6 STATIC nr AS BYTE STATIC tog AS BYTE IF ISFALSE Tog THEN tog = %True nr = TaskEX(%SHIFTS_VOLS07).SliderNumbers(6) END IF Modemess 6,7,Slider(nr).value END SUB SUB Shifts_Vol7 STATIC nr AS BYTE STATIC tog AS BYTE IF ISFALSE Tog THEN tog = %True nr = TaskEX(%SHIFTS_VOLS07).SliderNumbers(7) END IF Modemess 7,7,Slider(nr).value END SUB SUB Shifts_Volume8F () STATIC lowestslidernumber AS BYTE LOCAL i AS LONG IF ISFALSE Task(%SHIFTS_VOLS8F).tog THEN IF ISFALSE Task(%SHIFTS_VOLS8F).hParam THEN ' prepare a parameter window for real time controll of channel volumes: DIM TaskParamLabels(0 TO 7) AS ASCIIZ * 8 TaskParamLabels(0) = "Vol+2" ' display the rootnumbers TaskParamLabels(1) = "Vol+3" TaskParamLabels(2) = "Vol+4" TaskParamLabels(3) = "Vol+5" TaskParamLabels(4) = "Vol+6" TaskParamLabels(5) = "Vol+7" TaskParamLabels(6) = "Vol+8" TaskParamLabels(7) = "Vol+9" MakeTaskParameterDialog %SHIFTS_VOLS8F, 8,Slider(),0,UDctrl(), TaskParamLabels() Task(%SHIFTS_VOLS8F).tog = %True IF lowestslidernumber = %False THEN lowestslidernumber = TaskEX(%SHIFTS_VOLS8F).SliderNumbers(0) END IF ' now we fill in the codepointers for the callbacks. Slider(lowestslidernumber+0).cPtr = CODEPTR(Shifts_Vol8) Slider(lowestslidernumber+1).cPtr = CODEPTR(Shifts_Vol9) Slider(lowestslidernumber+2).cPtr = CODEPTR(Shifts_VolA) Slider(lowestslidernumber+3).cPtr = CODEPTR(Shifts_VolB) Slider(lowestslidernumber+4).cPtr = CODEPTR(Shifts_VolC) Slider(lowestslidernumber+5).cPtr = CODEPTR(Shifts_VolD) Slider(lowestslidernumber+6).cPtr = CODEPTR(Shifts_VolE) Slider(lowestslidernumber+7).cPtr = CODEPTR(Shifts_VolF) ' initialize the value for the sliders: FOR i = 0 TO 7 SendMessage Slider(lowestslidernumber+i).h, %TBM_SETPOS,%True, 90 + (i *2) NEXT i ' now we just have to write code for resizing / repositioning the window automatically... ELSE ShowWindow Task(%SHIFTS_VOLS8F).hParam, %SW_SHOW END IF END IF END SUB SUB Shifts_Vol8 STATIC nr AS BYTE STATIC tog AS BYTE IF ISFALSE Tog THEN tog = %True nr = TaskEX(%SHIFTS_VOLS8F).SliderNumbers(0) END IF Modemess 8,7,Slider(nr).value END SUB SUB Shifts_Vol9 STATIC nr AS BYTE STATIC tog AS BYTE IF ISFALSE Tog THEN tog = %True nr = TaskEX(%SHIFTS_VOLS8F).SliderNumbers(1) END IF Modemess 9,7,Slider(nr).value END SUB SUB Shifts_VolA STATIC nr AS BYTE STATIC tog AS BYTE IF ISFALSE Tog THEN tog = %True nr = TaskEX(%SHIFTS_VOLS8F).SliderNumbers(2) END IF Modemess 10,7,Slider(nr).value END SUB SUB Shifts_VolB STATIC nr AS BYTE STATIC tog AS BYTE IF ISFALSE Tog THEN tog = %True nr = TaskEX(%SHIFTS_VOLS8F).SliderNumbers(3) END IF Modemess 11,7,Slider(nr).value END SUB SUB Shifts_VolC STATIC nr AS BYTE STATIC tog AS BYTE IF ISFALSE Tog THEN tog = %True nr = TaskEX(%SHIFTS_VOLS8F).SliderNumbers(4) END IF Modemess 12,7,Slider(nr).value END SUB SUB Shifts_VolD STATIC nr AS BYTE STATIC tog AS BYTE IF ISFALSE Tog THEN tog = %True nr = TaskEX(%SHIFTS_VOLS8F).SliderNumbers(5) END IF Modemess 13,7,Slider(nr).value END SUB SUB Shifts_VolE STATIC nr AS BYTE STATIC tog AS BYTE IF ISFALSE Tog THEN tog = %True nr = TaskEX(%SHIFTS_VOLS8F).SliderNumbers(6) END IF Modemess 14,7,Slider(nr).value END SUB SUB Shifts_VolF STATIC nr AS BYTE STATIC tog AS BYTE IF ISFALSE Tog THEN tog = %True nr = TaskEX(%SHIFTS_VOLS8F).SliderNumbers(7) END IF Modemess 15,7,Slider(nr).value END SUB SUB Shifts_p2 () 'LOCAL i AS LONG 'STATIC tog AS BYTE STATIC oldnote AS BYTE STATIC noot AS BYTE IF ISFALSE Task(%Shifts_p2).tog THEN IF ISFALSE gh.MelPat THEN StopTask %Shifts_p2 END IF Task(%Shifts_p2).tog = %True Task(%Shifts_p2).freq = App.tempo / 60! END IF ' look up the note in the lookup table: noot = (Shifts.midi(0,Shifts.Nte(0))) IF noot <> oldnote THEN oldnote = noot IF noot < ShiftsInstrum.LowTes THEN DO noot = noot + 12 LOOP UNTIL noot > ShiftsInstrum.LowTes END IF IF noot > ShiftsInstrum.HighTes THEN DO noot = noot -12 LOOP UNTIL noot < ShiftsInstrum.HighTes END IF PatternSeq.Noot(0) = noot ELSE EXIT SUB END IF END SUB SUB Shifts_p3 () 'LOCAL i AS LONG 'STATIC tog AS BYTE STATIC oldnote AS BYTE STATIC noot AS BYTE IF ISFALSE Task(%Shifts_p3).tog THEN IF ISFALSE gh.MelPat THEN StopTask %Shifts_p3 END IF Task(%Shifts_p3).tog = %True Task(%Shifts_p3).freq = App.tempo / 60! END IF ' look up the note in the lookup table: noot = (Shifts.midi(1,Shifts.Nte(1))) IF noot <> oldnote THEN oldnote = noot IF noot < ShiftsInstrum.LowTes THEN DO noot = noot + 12 LOOP UNTIL noot > ShiftsInstrum.LowTes END IF IF noot > ShiftsInstrum.HighTes THEN DO noot = noot -12 LOOP UNTIL noot < ShiftsInstrum.HighTes END IF PatternSeq.noot(1) = noot ELSE EXIT SUB END IF END SUB SUB Shifts_p4 () 'LOCAL i AS LONG 'STATIC tog AS BYTE STATIC oldnote AS BYTE STATIC noot AS BYTE IF ISFALSE Task(%Shifts_p4).tog THEN IF ISFALSE gh.MelPat THEN StopTask %Shifts_p4 END IF Task(%Shifts_p4).tog = %True Task(%Shifts_p4).freq = App.tempo / 60! END IF ' look up the note in the lookup table: noot = (Shifts.midi(2,Shifts.Nte(2))) IF noot <> oldnote THEN oldnote = noot IF noot < ShiftsInstrum.LowTes THEN DO noot = noot + 12 LOOP UNTIL noot > ShiftsInstrum.LowTes END IF IF noot > ShiftsInstrum.HighTes THEN DO noot = noot -12 LOOP UNTIL noot < ShiftsInstrum.HighTes END IF PatternSeq.noot(2) = noot ELSE EXIT SUB END IF END SUB SUB Shifts_p5 () 'LOCAL i AS LONG 'STATIC tog AS BYTE STATIC oldnote AS BYTE STATIC noot AS BYTE IF ISFALSE Task(%Shifts_p5).tog THEN IF ISFALSE gh.MelPat THEN StopTask %Shifts_p5 END IF Task(%Shifts_p5).tog = %True Task(%Shifts_p5).freq = App.tempo / 60! END IF ' look up the note in the lookup table: noot = (Shifts.midi(3,Shifts.Nte(3))) IF noot <> oldnote THEN oldnote = noot IF noot < ShiftsInstrum.LowTes THEN DO noot = noot + 12 LOOP UNTIL noot > ShiftsInstrum.LowTes END IF IF noot > ShiftsInstrum.HighTes THEN DO noot = noot -12 LOOP UNTIL noot < ShiftsInstrum.HighTes END IF PatternSeq.noot(3) = noot ELSE EXIT SUB END IF END SUB SUB Shifts_p6 () ' LOCAL i AS LONG ' STATIC tog AS BYTE STATIC oldnote AS BYTE STATIC noot AS BYTE IF ISFALSE Task(%Shifts_p6).tog THEN IF ISFALSE gh.MelPat THEN StopTask %Shifts_p6 END IF Task(%Shifts_p6).tog = %True Task(%Shifts_p6).freq = App.tempo / 60! END IF ' look up the note in the lookup table: noot = (Shifts.midi(4,Shifts.Nte(4))) IF noot <> oldnote THEN oldnote = noot IF noot < ShiftsInstrum.LowTes THEN DO noot = noot + 12 LOOP UNTIL noot > ShiftsInstrum.LowTes END IF IF noot > ShiftsInstrum.HighTes THEN DO noot = noot -12 LOOP UNTIL noot < ShiftsInstrum.HighTes END IF PatternSeq.noot(4) = noot ELSE EXIT SUB END IF END SUB SUB Shifts_p7 () 'LOCAL i AS LONG 'STATIC tog AS BYTE STATIC oldnote AS BYTE STATIC noot AS BYTE IF ISFALSE Task(%Shifts_p7).tog THEN IF ISFALSE gh.MelPat THEN StopTask %Shifts_p7 END IF Task(%Shifts_p7).tog = %True Task(%Shifts_p7).freq = App.tempo / 60! END IF ' look up the note in the lookup table: noot = (Shifts.midi(5,Shifts.Nte(5))) IF noot <> oldnote THEN oldnote = noot IF noot < ShiftsInstrum.LowTes THEN DO noot = noot + 12 LOOP UNTIL noot > ShiftsInstrum.LowTes END IF IF noot > ShiftsInstrum.HighTes THEN DO noot = noot -12 LOOP UNTIL noot < ShiftsInstrum.HighTes END IF PatternSeq.noot(5) = noot ELSE EXIT SUB END IF END SUB SUB Shifts_p8 () 'LOCAL i AS LONG ' STATIC tog AS BYTE STATIC oldnote AS BYTE STATIC noot AS BYTE IF ISFALSE Task(%Shifts_p8).tog THEN IF ISFALSE gh.MelPat THEN StopTask %Shifts_p8 END IF Task(%Shifts_p8).tog = %True Task(%Shifts_p8).freq = App.tempo / 60! END IF ' look up the note in the lookup table: noot = (Shifts.midi(6,Shifts.Nte(6))) IF noot <> oldnote THEN oldnote = noot IF noot < ShiftsInstrum.LowTes THEN DO noot = noot + 12 LOOP UNTIL noot > ShiftsInstrum.LowTes END IF IF noot > ShiftsInstrum.HighTes THEN DO noot = noot -12 LOOP UNTIL noot < ShiftsInstrum.HighTes END IF PatternSeq.noot(6) = noot ELSE EXIT SUB END IF END SUB SUB Shifts_p9 () ' LOCAL i AS LONG ' STATIC tog AS BYTE STATIC oldnote AS BYTE STATIC noot AS BYTE IF ISFALSE Task(%Shifts_p9).tog THEN IF ISFALSE gh.MelPat THEN StopTask %Shifts_p9 END IF Task(%Shifts_p9).tog = %True Task(%Shifts_p9).freq = App.tempo / 60! END IF ' look up the note in the lookup table: noot = (Shifts.midi(7,Shifts.Nte(7))) IF noot <> oldnote THEN oldnote = noot IF noot < ShiftsInstrum.LowTes THEN DO noot = noot + 12 LOOP UNTIL noot > ShiftsInstrum.LowTes END IF IF noot > ShiftsInstrum.HighTes THEN DO noot = noot -12 LOOP UNTIL noot < ShiftsInstrum.HighTes END IF PatternSeq.noot(7) = noot ELSE EXIT SUB END IF END SUB SUB ShiftsRealTimeScore () EXPORT LOCAL flag AS BYTE LOCAL i AS LONG LOCAL title AS ASCIIZ * 10 STATIC oldnotes() AS BYTE IF ISFALSE Task(%Shifts_RTScore).tog THEN IF ISFALSE gh.MelPat THEN StopTask %Shifts_RTScore EXIT SUB END IF title = "Shifts" SendMessage gh.MelPat, %WM_SETTEXT,0,VARPTR(title) ' write to caption bar Task(%Shifts_RTScore).tog = %True Task(%Shifts_RTScore).freq = App.tempo * 2 / 60! DIM oldnotes(0 TO 7) AS STATIC BYTE FOR i= 0 TO 7 oldnotes(i)= %False NEXT i END IF Task(%Shifts_RTScore).freq = App.tempo * 2 / 60! ' check whether note array has changed... (and score needs update...) Flag = %False FOR i = 0 TO 7 IF PatternSeq.Noot(i) <> oldnotes(i) THEN Flag = %True END IF oldnotes(i) = PatternSeq.Noot(i) NEXT i IF Flag THEN ShiftsDrawMelody gh.MelPat END SUB SUB ShiftsDrawMelody (BYVAL hWnd AS LONG) EXPORT LOCAL hDC AS LONG LOCAL i AS BYTE LOCAL horpos AS WORD LOCAL newpos AS WORD LOCAL hBrush AS LONG LOCAL hOldBrush AS LONG hBrush = CreateSolidBrush (&H00FE0000) ' blue hDC = GetDC(hWnd) DrawBlankBar staff, hDC,(staff.hor), staff.hor + staff.length 'akkoordraster DrawClef staff, hDC, staff.hor horpos = staff.hor + staff.akkoordraster hOldBrush = SelectObject(hDC, hBrush) FOR i = 0 TO 7 ' we color the active notes, depending on the beat patterns selected. IF BIT(Task(%SHIFTS_p2 + i).swit,%TASK_ONOFF) THEN newpos = ShowNote (staff, hDC, (PatternSeq.noot(i)), horpos) END IF horpos = horpos + staff.akkoordraster NEXT i DrawBarline staff, hDC, horpos + (staff.nb * 2) SelectObject hDC, hOldBrush ReleaseDC hWnd, hDC IF hBrush THEN DeleteObject hBrush END SUB SUB Shifts_GlobHar () EXPORT LOCAL i AS DWORD Task(App.GlobalHarmonyTaskNr).Har.vel = STRING$(128, 0) FOR i = 0 TO 7 Task(App.GlobalHarmonyTasknr).Har.vel = SumHar$(Task(App.GlobalHarmonyTaskNr).Har, Task(%Shifts_Algo +i).Har) NEXT i FillHarType Task(App.GlobalHarmonyTaskNr).Har END SUB SUB Shifts_WriteSeqScore () EXPORT LOCAL i AS LONG IF ISFALSE Task(App.WriteSeqScoreTaskNr).tog THEN IF ISFALSE App.SeqOutFileNr THEN IF App.SeqFileOut <> "" THEN App.SeqOutFileNr = FREEFILE OPEN App.SeqFileOut FOR OUTPUT AS #App.SeqOutFileNr ' has to be opened for sequencial output END IF ELSE CLOSE #App.SeqOutFileNr App.SeqOutFileNr = FREEFILE OPEN "shifts.seq" FOR OUTPUT AS #App.SeqOutFileNr App.SeqFileOut = "shifts.seq" END IF Task(App.WriteSeqScoreTaskNr).tog = %True Task(App.WriteSeqScoreTaskNr).freq = 0.01 ' its a pseudo task! FOR i = 0 TO 7 Task(%Shifts_Algo+i).Har.vel = STRING$(128,0) NEXT i END IF ' the actual writing is done in Shifts_Algo END SUB '[EOF] _ _

Een vroegere versie van deze kode voor de PowerBasic PB3.2 kompiler is voorhanden in de klas.

Filedate:02/09/10

Naar inhoudstafel kursus

Naar homepage dr.Godfried-Willem RAES