'**************************************************************************** '* PRIMES * '* Dr.Godfried-Willem RAES * '* 1989 * '**************************************************************************** ' Primes - partituurgenerator - versie 7 ' 16.12.1988: Start original composition program ' 02.07.1989: score for musicians finished. ' 29.02.1992: aangepast voor Toshiba T1000 - internal midi-versie ' 03.06.1992: aangepast voor Notebook 80386 03/06/92 & extern midi-interface ' midi-userfunction added ' 16.04.1993: adapted for use with MPU401 or Musiquest interfaces ' het array TES%(5,2) omvat de tessituurgegevens voor het ensemble ' het array NC(5) bevat de centrum-tessituurnoot van elk instrument ' het array NM$(128) bevat de nootnaam-equivalenten van de midi-getallen ' 20.05.1995: recovered after system crash on 04.05.1995 ' Midi-routines updated. ' 31.07.1995: Adapted for use with player-piano ' MiPlay moved to sub ' 10.08.1995: Concert performance on player-piano + Proteus 3. ' 11.02.1996: Code adapted for proteus3 + player-piano conbination ' Now uses commandstring option. (PP for player piano) ' 14.02.1996: Week van de Hedendaagse Muziek - versie met player-piano ' 08.01.2009: start konversie naar gmt kontekst ' 09.01.2009: we now play the unmodified piece from 1989. (Ob, Qt, Heli, pp en snar) ' expression control added for Heli and Ob ' 10.01.2008: expression control refined. ' to do: implement version for pp and percussion (pp done, percussion to be done) %Play_Primes = 48 %Primes_ObMod = 49 %Primes_ObVol = 50 %Primes_HeliMod = 51 %Play_Primes_pp = 56 GLOBAL N%() '2310,5) TYPE Primes_Type Nrv AS DWORD nc(0 TO 5) AS DWORD END TYPE DECLARE SUB Read_Primes_File () DECLARE FUNCTION Init_Primes () AS LONG DECLARE SUB Play_Primes () ' original version flute, oboe, double bass and piano DECLARE SUB Play_Primes_Stop () DECLARE SUB Play_Primes_pp () ' player-piano and percussion version DECLARE SUB Primes_ObMod () ' modulator for Ob sound - FM DECLARE SUB Primes_ObMod_Stop () DECLARE SUB Primes_ObVol () ' AM DECLARE SUB Primes_ObVol_Stop () DECLARE SUB Primes_HeliMod () ' amplitude modulator for Heli sound DECLARE SUB Primes_HeliMod_Stop () FUNCTION Init_Primes () AS LONG LOCAL m AS ASCIZ * 20 Init_MM MM_PanicButtonWindow ' prep. cockpit Read_Primes_File () Task(%Play_Primes).naam = "Primes_M" Task(%Play_Primes).cptr = CODEPTR(Play_Primes) Task(%Play_Primes).freq = 1 Task(%Play_Primes).flags = %False TaskEX(%Play_Primes).stopcptr = CODEPTR(Play_Primes_Stop) Task(%Primes_ObMod).naam = "Ob_Modul" Task(%Primes_ObMod).cptr = CODEPTR(Primes_ObMod) Task(%Primes_ObMod).freq = 2 Task(%Primes_ObMod).flags = %False TaskEX(%Primes_ObMod).stopcptr = CODEPTR(Primes_ObMod_Stop) ' we use the cockpit sliders for Ob modulation control: Slider(0).value = 112 ' multiplied by two in the procedure SendMessage Slider(0).h, %TBM_SETPOS,%True, Slider(0).value ' vibrato speed SetDlgItemText gh.Cockpit, %GMT_TEXT_SLIDER0, "Ob-speed" Slider(1).value = 28 ' divided by two in the procedure SendMessage Slider(1).h, %TBM_SETPOS,%True, Slider(1).value ' vibrato depth SetDlgItemText gh.Cockpit, %GMT_TEXT_SLIDER1, "Ob-depth" Task(%Primes_ObVol).naam = "Ob_Vol" Task(%Primes_ObVol).cptr = CODEPTR(Primes_ObVol) Task(%Primes_ObVol).freq = 10 Task(%Primes_ObVol).flags = %False TaskEX(%Primes_ObVol).stopcptr = CODEPTR(Primes_ObVol_Stop) Task(%Primes_HeliMod).naam = "Heli_Mod" Task(%Primes_HeliMod).cptr = CODEPTR(Primes_HeliMod) Task(%Primes_HeliMod).freq = 12 Task(%Primes_HeliMod).flags = %False TaskEX(%Primes_HeliMod).stopcptr = CODEPTR(Primes_HeliMod_Stop) Task(%Play_Primes_pp).naam = "Primes_P" Task(%Play_Primes_pp).cptr = CODEPTR(Play_Primes_pp) Task(%Play_Primes_pp).freq = 1 Task(%Play_Primes_pp).flags = %False logfile "Primes" & DATE$ m = "'Primes'" SendMessage gh.Cockpit, %WM_SETTEXT,0, VARPTR(m) FUNCTION = %True END FUNCTION SUB Read_Primes_File () ' reads the data file from the 1989 version coded in BC7 LOCAL fnr AS LONG fnr = FREEFILE LOCAL i% LOCAL t% LOCAL q AS INTEGER LOCAL xp$ DIM N%(2310,5) 'GLOBAL ' read score from file XP$ = "gw_enseko\primes\primes.xpt" ' XPL$ = "primes.lop" ' OPEN XPL$ FOR INPUT AS fnr ' IF NOT EOF(fnr) THEN INPUT #fnr, t% ' aantal noten = 2310 ' IF NOT EOF(fnr) THEN INPUT #fnr, LOP ' = 2 ' CLOSE #fnr 'step 2 : dimensioneer array en lees er de file in ' NotTot% = 2310 't% ' DIM N%(NotTot%, 5) ' i% = 0: t% = 0: q = 0 ' fnr = FREEFILE OPEN XP$ FOR INPUT AS fnr WHILE NOT EOF(fnr) IF (i% = 0) AND (q > 0) THEN INCR t% 't% = t% + 1 INPUT #fnr, N%(t%, i%): q = q + 1: i% = i% + 1 i% = i% MOD 6 WEND CLOSE #fnr ' logfile " number of notes in file = " & STR$( NotTot%) ' logfile " Expert-system loop number=" & STR$( LOP) END SUB SUB Play_Primes () STATIC ritmod AS INTEGER STATIC mm%,maat% STATIC t% LOCAL Samtot%, Nultot%, i% STATIC Vn%() LOCAL Taskparamlabels() AS ASCIIZ * 8 STATIC slnr AS LONG STATIC udnr AS LONG ' plays the N%() array on the M&M orchestra IF ISFALSE Task(%Play_Primes).tog THEN IF ISFALSE Task(%Play_Primes).hParam THEN DIM TaskParamLabels(2) TaskParamLabels(0)="heli7" TaskParamLabels(1)="heli17" TaskParamLabels(2)="speed" ' tempo 3 - 6 MakeTaskParameterDialog %Play_Primes,2, Slider(),1,UdCtrl(), TaskParamLabels() slnr = TaskEX(%Play_Primes).SliderNumbers(0) Slider(slnr).value = 12 '24 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value slider(slnr+1).value = 40 '64 SendMessage Slider(Slnr+1).h, %TBM_SETPOS,%True, Slider(Slnr+1).value Heli.ctrl(7) = slider(slnr).value Heli.ctrl(17) = slider(slnr+1).value IF udnr = %False THEN udnr = TaskEX(%Play_Primes).UpDownNumbers(0) UDctrl(udnr).cptr = CODEPTR(Primes_UD0) ' tempo UDctrl(udnr).value = 3 UDctrl(udnr).minval = 3 UDctrl(udnr).maxval = 6 UDctrl(udnr).stap = 1 END IF END IF Ritmod = -1 mm% = UDctrl(udnr).value '3 DIM Vn%(5) ' vorige noot t% = 0 ' reset counter MM_Qt_On MM_Ob_On MM_Heli_On MM_Heli_On %MM_Yellow MM_Ob_On %MM_Yellow MM_Qt_On %MM_Blue ' controllers: Controller Heli.channel, 7, Heli.ctrl(7) Controller Heli.channel, 17, Heli.ctrl(17) Heli.ctrl(18) = 100 Controller Heli.channel, 18, Heli.ctrl(18) Heli.ctrl(19) = 110 Controller Heli.channel, 19, Heli.ctrl(19) Ob.ctrl(17) = 127 Controller Ob.channel, 17, Ob.ctrl(17) Ob.ctrl(18) = 90 Controller Ob.channel, 18, Ob.ctrl(18) Ob.ctrl(19) = 115 Controller Ob.channel, 19, Ob.ctrl(19) ' tuning is send with MM_Ob_On Progchange Piano.channel, %False ' no lookups in use here!!! Task(%Play_Primes).tog = %True EXIT SUB ' make sure we have wind for Qt... END IF IF Slider(slnr).value <> Heli.ctrl(7) THEN Heli.ctrl(7) = slider(slnr).value Controller Heli.channel, 7, Heli.ctrl(7) END IF IF Slider(slnr+1).value <> Heli.ctrl(17) THEN Heli.ctrl(17)= slider(slnr+1).value Controller Heli.channel, 17, Heli.ctrl(17) END IF SamTot% = 0 NulTot% = 0 FOR i% = 1 TO 5 IF N%(t%, i%) > 0 THEN SamTot% = SamTot% + 1: ' aantal te spelen noten op t% IF N%(t%, i%) < 0 THEN SamTot% = SamTot% - 1 IF N%(t%, i%) = -1 THEN NulTot% = NulTot% + 1: ' aantal uit te schakelen noten NEXT i% IF NulTot% > 2 THEN ' snaredrum or shakers! Controller Snar.channel, 11, 127 ' snares on Snar.ctrl(11) = 127 Play Snar.channel, 60+ Nultot%, 36 +(Nultot% * 6) ELSE IF Snar.ctrl(11) THEN Controller Snar.channel, 11, %False ' snares off Snar.ctrl(11) = %False END IF END IF FOR i% = 1 TO 5 IF N%(t%, i%) > 0 THEN SELECT CASE i% CASE 1 ' fluit IF Vn%(1) THEN Play Qt.channel, Vn%(1), %False Vn%(1) = %False END IF Play Qt.channel, N%(t%,1), 24 + (Samtot% * 4) Vn%(1) = N%(t%,1) CASE 2 ' hobo IF Vn%(2) THEN stoptask %Primes_ObVol stoptask %Primes_ObMod ' te testen. evt. mag vibrato doorlopen in ' gebonden noten. In dat geval moet deze taak niet gestopt worden. END IF Play Ob.channel, N%(t%,2), MIN(100 + (Samtot% * 3), 127) Vn%(2) = N%(t%,2) IF ISFALSE Task(%Primes_ObMod).swit THEN starttask %Primes_ObMod END IF IF ISFALSE Task(%Primes_ObVol).swit THEN starttask %Primes_ObVol END IF CASE 3 ' kontrabas IF N%(t%,3) >=60 THEN Play Heli.channel, N%(t%,3), 24 + (Samtot% * 3) ELSE Play Heli.channel, N%(t%,3), MIN(36 + (Samtot% * 4), 127) END IF IF ISFALSE Task(%Primes_HeliMod).swit THEN starttask %Primes_HeliMod END IF Vn%(3) = N%(t%,3) CASE 4,5 ' piano IF Vn%(i%) THEN Play Piano.channel, Vn%(i%), %False Vn%(i%) = %False END IF Play Piano.channel, N%(t%,i%), MIN(56 + (Samtot% *4), 127) Vn%(i%) = N%(t%,i%) END SELECT ELSE IF N%(t%, i%) = -1 THEN SELECT CASE i% CASE 1 NoteOff Qt.channel, Vn%(1) Vn%(1) = %False CASE 2 IF Task(%Primes_ObMod).swit THEN stoptask %Primes_ObMod END IF IF Task(%Primes_ObVol).swit THEN stoptask %Primes_ObVol END IF NoteOff Ob.channel, Vn%(2) Vn%(2) = %False CASE 3 IF Task(%Primes_HeliMod).swit THEN stoptask %Primes_HeliMod END IF NoteOff Heli.channel, Vn%(3) Vn%(3) = %False CASE 4,5 NoteOff Piano.channel, Vn%(i%) Vn%(i%) = %False END SELECT END IF END IF NEXT i% IF SamTot% = 5 THEN RitMod = RitMod + 1: RitMod = RitMod MOD 4 mm% = UDctrl(udnr).value SELECT CASE RitMod CASE 0, 2 Maat% = mm% CASE 1 Maat% = (mm% * 2) \ 3 CASE 3 Maat% = (mm% * 3) \ 2 END SELECT SetDlgItemText gh.Cockpit, %GMT_MSG1, "Counter=" & STR$(t%) 'SOUND 20000, Maat% ' in 54ms increments translates as: Task(%Play_Primes).freq = 1!/ (Maat% * 0.0549) IF t% >= UBOUND(N%(1)) - 1 THEN Task(%Play_Primes).freq = 0.20 ' slotnoot INCR t% IF t% > UBOUND(N%(1)) THEN stoptask %PLay_Primes END SUB SUB Play_Primes_Stop () MM_Ob_Off MM_Heli_Off MM_Troms_Off ' dekt ook snar MM_Qt_Off MM_Piano_Off 'einde END SUB SUB Primes_UD0 () ' callback on parameter UpDowns tempo LOCAL value AS BYTE LOCAL udnr AS DWORD udnr = TaskEX(%Play_Primes).UpdownNumbers(0) value = UDCtrl(udnr).value IF value > 6 THEN UDctrl(udnr).value = 6 : value = 6 IF value < 3 THEN UDCTRL(udnr).value = 3 : value = 3 SetDlgItemText Task(%Play_Primes).hparam, %GMT_TEXT0_ID + 16, "M=" & STR$(value) END SUB SUB Primes_ObMod () 'vibrato modulator voor STATIC cnt AS LONG STATIC b AS LONG STATIC s AS INTEGER STATIC md AS INTEGER ' modulatie diepte IF ISFALSE Task(%Primes_ObMod).tog THEN cnt = %False b = 64 ' reset waarde voor de pitchbend s = 1 ' sign voor op en neer 'md = 16 ' modulatie diepte in 0.7 cents units md = Slider(1).value / 2 ' we delen om 7bit overflows te vermijden Bend Ob.channel, 0, 64 ' reset bij elke start ' we use the cockpit sliders for parameter control: speed & depth ' initialisation is in the primes init code. Task(%Primes_ObMod).tog = %TRue END IF IF ISFALSE cnt THEN Task(%Primes_ObMod).freq = 2 ' het vibrato start pas na 500ms INCR cnt EXIT SUB ELSE Task(%Primes_ObMod).freq = Slider(0).value * 2 ' vibrato snelheid END IF INCR cnt IF s > 0 THEN INCR b IF b > 64 + md THEN s = -1 ELSE DECR b IF b < 64 - md THEN s = +1 END IF Bend Ob.channel, 0, b END SUB SUB Primes_ObMod_Stop () Bend Ob.channel, 0, 64 ' reset pitchbend aan het eind van het vibrato. END SUB SUB Primes_ObVol () ' decrescendo after note on, using ctrl.17 STATIC cnt AS LONG STATIC minval AS DWORD IF ISFALSE Task(%Primes_ObVol).tog THEN minval = 64 cnt = Ob.ctrl(17) Task(%Primes_ObVol).tog = %TRue ' taskfrequency fixed to 10Hz END IF DECR cnt DECR cnt IF cnt > minval THEN Controller Ob.channel, 17, cnt ELSE EXIT SUB END IF END SUB SUB Primes_ObVol_Stop () Controller Ob.channel, 17, Ob.ctrl(17) ' 127 END SUB SUB Primes_HeliMod () STATIC b AS LONG IF ISFALSE Task(%Primes_HeliMod).tog THEN b = Heli.ctrl(7) ' beginwaarde controller Task(%Primes_HeliMod).tog = %TRue END IF Task(%Primes_HeliMod).freq = 24 INCR b IF b <= 127 THEN Controller Heli.channel, 7, b ELSE EXIT SUB END IF END SUB SUB Primes_HeliMod_Stop () Controller Heli.channel, 7, Heli.ctrl(7) ' reset controller to slider value END SUB ' ----------------------------------------------------------------------------------------- SUB Play_Primes_PP () LOCAL i%, samtot%, nultot%, aanslag% STATIC ritmod AS LONG STATIC mm%, maat%, mF% , t% STATIC Vn%() STATIC Toets%() ' speelroutine voor Player-Piano: IF ISFALSE task(%Play_Primes_pp).tog THEN REDIM Toets%(Piano.lowtes TO Piano.hightes)' STATIC: ' for future improvement REDIM Vn%(0 TO 5) 'static RitMod = -1 ' default parameters: 'Mikan% = 0 'Drum% = 1 'Perc% = 2 mm% = 3 Maat% = mm% mF% = 24 t% = 0 Task(%Play_Primes_pp).tog = %True END IF 'LOCATE 15, 10 'PRINT "Interactivity keys: + - x / for tempo"; 'LOCATE 16, 10 'PRINT " < > for dynamics"; 'LOCATE 18, 10: PRINT "Klaar om te starten ? (Y/N)"; 'DO: k$ = INKEY$: LOOP UNTIL UCASE$(k$) = "Y" 'LOCATE 20, 25: PRINT "Teller="; 'LOCATE 18, 10: PRINT "Performing for Player-Piano..."; 'Begintijd! = TIMER '********************set proteus 3 to snaredrum sounds: 'Uit 192 + Perc%: Uit 58: ' preset 58 - pitching perc. 'Uit 192 + Drum%: Uit 18: ' preset 18 - noot 57 ' ' of: preset 8, noot 38 'Snare% = 57: ' otherwize use Mcn% '******************************************************* 'FOR t% = 0 TO NotTot% SamTot% = 0 NulTot% = 0 FOR i% = 1 TO 5 IF N%(t%, i%) > 0 THEN SamTot% = SamTot% + 1: ' aantal te spelen noten op t% IF N%(t%, i%) < 0 THEN SamTot% = SamTot% - 1 IF N%(t%, i%) = -1 THEN NulTot% = NulTot% + 1: ' aantal uit te schakelen noten NEXT i% IF NulTot% > 2 THEN ' snaredrum or shakers! Controller Snar.channel, 11, 127 ' snares on Snar.ctrl(11) = 127 Play Snar.channel, 60+ Nultot%, 48 +(Nultot% * 6) ELSE IF Snar.ctrl(11) THEN Controller Snar.channel, 11, %False Snar.ctrl(11) = %False END IF END IF ' partituurspeellus: FOR i% = 1 TO 5 IF N%(t%, i%) > 0 THEN IF Vn%(i%) > 0 THEN IF Toets%(Vn%(i%)) THEN Play Piano.channel, Vn%(i%), %False Toets%(Vn%(i%)) = 0 END IF 'Uit 144 + Perc%: Uit Vn%(i%): Uit 0 END IF Aanslag% = mF% + (SamTot% * 4) IF Aanslag% > 127 THEN Aanslag% = 127 'Uit 144 + Perc%: Uit N%(t%, i%): Uit Aanslag% ' te vertalen.... ' PlayKloks ... else: IF N%(t%,i%) >= 55 THEN Play Puff.channel, N%(t%,i%), MIN(aanslag%, 48) ELSE Play Troms.channel, 24 + (N%(t%,i%) MOD 24), Aanslag% END IF IF Aanslag% < 8 THEN Aanslag% = 8 IF Toets%(N%(t%, i%)) = 0 THEN Play Piano.channel, N%(t%,i%), Aanslag% Toets%(N%(t%, i%)) = Aanslag% Vn%(i%) = N%(t%, i%) ELSE ' wanneer de toets reeds ingedrukt was, ' laat ze dan gewoon ingedrukt zijn. END IF ELSE ' -1 wordt hier gebruikt voor uit te ' schakelen noten: IF N%(t%, i%) = -1 THEN 'Uit 144 + Perc%: Uit Vn%(i%): Uit 0 ' notes-off for player-piano: IF Toets%(Vn%(i%)) THEN Play Piano.channel, Vn%(i%), %False Toets%(Vn%(i%)) = 0 END IF END IF END IF NEXT i% IF SamTot% = 5 THEN RitMod = (RitMod + 1) MOD 4 SELECT CASE RitMod CASE 0, 2 Maat% = mm% CASE 1 Maat% = (mm% * 2) \ 3 CASE 3 Maat% = (mm% * 3) \ 2 END SELECT END IF 'SOUND 20000, Maat% 'SELECT CASE INKEY$ ' CASE "" ' LOCATE 20, 35: PRINT t%; ' CASE "<" ' mF% = mF% + 1: IF mF% > 90 THEN mF% = 90 ' LOCATE 24, 20: PRINT "Dyna="; mF%; " Pulsduur= "; Maat%; " "; ' CASE ">" ' mF% = mF% - 1: IF mF% < 1 THEN mF% = 1 ' LOCATE 24, 20: PRINT "Dyna="; mF%; " Pulsduur= "; Maat%; " "; ' CASE "+" ' Maat% = Maat% - 1: IF Maat% < 1 THEN Maat% = 1 ' LOCATE 24, 20: PRINT "Dyna="; mF%; " Pulsduur= "; Maat%; " "; ' CASE "-" ' Maat% = Maat% + 1: IF Maat% > 18 THEN Maat% = 18 ' LOCATE 24, 20: PRINT "Dyna="; mF%; " Pulsduur= "; Maat%; " "; ' CASE "X", "x" ' Maat% = Maat% / 2: IF Maat% < 1 THEN Maat% = 1 ' LOCATE 24, 20: PRINT "Dyna="; mF%; " Pulsduur= "; Maat%; " "; ' CASE "/" ' Maat% = Maat% * 2: IF Maat% > 18 THEN Maat% = 18 ' LOCATE 24, 20: PRINT "Dyna="; mF%; " Pulsduur= "; Maat%; " "; ' CASE " " ' SLEEP 1 ' CASE "*" ' MM_AllOff %MM_Notes 'AllNotesOff ' END 'END SELECT 'NEXT t% Task(%Play_Primes_pp).freq = 1!/ (Maat% * 0.0549) INCR t% IF t% > UBOUND(N%(1)) THEN stoptask %Play_Primes_pp END SUB #IF %DEF(%OldPrimesCode) 'oude kompositiekode (partituurgenerator): REM $DYNAMIC 'DEFINT A-W 'CONST Lpptes% = 21: ' tessituur player-piano 'CONST Hpptes% = 108: ' id. GLOBAL Tes%(), Nc%(), p%(), Nrp%, Hcn%, Lcn%, Mcn%, Nm$(), Rt%() GLOBAL NotTot% GLOBAL Dp% GLOBAL Bevel$ ' P%() bevat priemgetallen van 0 tot 127 - ' PL%() bevat EEN PRIEMTOONLADDER DECLARE SUB INSTRUMENTATIE (Tes%(), Nc%(), Hcn%, Lcn%, Mcn%) DECLARE SUB PRIEM (p%, Range%) DECLARE SUB NOOTNAAM (Nm$()) DECLARE SUB RITME (Rt%(), NotTot%) DECLARE SUB FB01 () DECLARE SUB Uit (byte%) DECLARE SUB Miplay () DECLARE SUB Playpian () GLOBAL Nm$(128) 'DIM SHARED Nm$(128) GLOBAL Rt%(5) 'DIM SHARED Rt%(5) ' het array RT%(5) bevat de ritmische gegevens voor de noten CALL RITME(Rt%(), NotTot%) Bevel$ = COMMAND$ INITIALIZE: CALL NOOTNAAM(Nm$()) DIM SHARED N%(NotTot%, 5) DIM SHARED Tes%(5, 2) DIM SHARED Nc%(4) DIM SHARED Nv%(5) CALL INSTRUMENTATIE(Tes%(), Nc%(), Hcn%, Lcn%, Mcn%) Tes%(5, 1) = Tes%(4, 1): Tes%(5, 2) = Tes%(4, 2): ' piano=2-stemmig Nc% = Mcn% DIM SHARED Pl%(127) GOSUB PRIMLAD RESTORE MENU2: IF Bevel$ = "PP" THEN k = 3: GOTO SkipMenu2 CLS LOCATE 10, 10: PRINT "PRIMES - MENU Nr.2 : " LOCATE 12, 25: PRINT "1.- Calculate new score " LOCATE 13, 25: PRINT " start from scratch " LOCATE 14, 25: PRINT "2.- Use existing score-file" LOCATE 15, 25: PRINT " expert-system mode " LOCATE 16, 25: PRINT " This file should be :" LOCATE 17, 25: PRINT " PRIMES.XPT" LOCATE 18, 25: PRINT "3.- playback existing score-file" LOCATE 19, 25: PRINT " without reprocessing [***] " LOCATE 20, 25: PRINT "9.- Quit " LOCATE 21, 40: INPUT "KEUZE ? "; k SkipMenu2: IF k < 1 OR k > 9 THEN GOTO MENU2: IF k = 9 THEN END IF (k = 1) OR (k = 3) THEN EXPERT = 0 IF k = 2 THEN EXPERT = -1 IF k > 3 THEN GOTO MENU2 IF k = 1 AND EXPERT = 0 THEN GOTO SCORE ELSE ' read score from file ERASE N% XP$ = "primes.xpt" XPL$ = "primes.lop" OPEN XPL$ FOR INPUT AS #2 IF NOT EOF(2) THEN INPUT #2, t% IF NOT EOF(2) THEN INPUT #2, LOP CLOSE #2 'step 2 : dimensioneer array en lees er de file in NotTot% = t% DIM N%(NotTot%, 5) i% = 0: t% = 0: q = 0 OPEN XP$ FOR INPUT AS #1 WHILE NOT EOF(1) IF i% = 0 AND q > 0 THEN t% = t% + 1 INPUT #1, N%(t%, i%): q = q + 1: i% = i% + 1: i% = i% MOD 6 WEND CLOSE #1 LOCATE 22, 10: PRINT " number of notes in file = "; NotTot% LOCATE 23, 10: PRINT " Expert-system loop number="; LOP q = 0 IF EXPERT = -1 THEN GOTO FILTER3 ELSE GOTO MENU3 END IF '***********************************************************fill score-array SCORE: CLS LOCATE 10, 10: PRINT " Calculating new score... " LOCATE 12, 10: PRINT " please wait ! " FOR i% = 1 TO 5: N%(0, i%) = Mcn%: NEXT i%: ' beginnoot t% = 0 CALL RITME(Rt%(), NotTot%) FOR i% = 1 TO 5: GOSUB PARTIJ: NEXT i% 'nu werden de partijen horizontaal beschreven op gefilterd op speelbaarheid FILTER3: PRINT " F I L T E R 3 " 'hier wordt de eerste partituurversie aan estetische kriteria onderworpen 'filter 3 vertikale kriteria (harmoniereeks op de gemeenschappelijk inge- 'zette noten door minstens drie instrumenten) ' stap 1 : kopieer partituur in akkoordreeks CH%(t%,i%) IF EXPERT = -1 THEN DIM Ch%(NotTot% + 1, 5) ELSE DIM Ch%(NotTot * 2, 5) LUS = 0: CHANGE = 0 STRT3: ' geen veranderingen in het eerste vijfde v/h stuk FOR t% = 0 TO NotTot% \ 5 FOR i% = 1 TO 5 IF N%(t%, i%) > 0 THEN Ch%(t%, i%) = N%(t%, i%) IF N%(t%, i%) = 0 THEN Ch%(t%, i%) = N%(t% - 1, i%) IF N%(t%, i%) = -1 THEN Ch%(t%, i%) = 0 NEXT i% NEXT t% FOR t% = NotTot% \ 5 TO NotTot% SamTot% = 0: NulTot% = 0 FOR i% = 1 TO 5 IF N%(t%, i%) > 0 THEN Ch%(t%, i%) = N%(t%, i%) SamTot% = SamTot% + 1 END IF IF N%(t%, i%) = 0 THEN Ch%(t%, i%) = Ch%(t% - 1, i%) IF N%(t%, i%) = -1 THEN Ch%(t%, i%) = 0 NulTot% = NulTot% + 1 END IF NEXT i% IF SamTot% < 3 THEN GOTO EFF3: IF SamTot% >= 3 AND t% > NotTot% \ 5 THEN GOSUB CHORD Ja = 0 IF ((B AND Cis) AND G) THEN Ja = -1 IF ((B AND Cis) AND F) THEN Ja = -1 IF ((B AND E) AND Gis) THEN Ja = -1 IF ((B AND F) AND (Dis OR G)) THEN Ja = -1 IF ((A AND Dis) AND Fis) THEN Ja = -1 IF ((Cis AND (F OR Fis)) AND A) THEN Ja = -1 IF ((Gis AND Cis) AND E) THEN Ja = -1 IF ((G AND B) AND (F OR G)) THEN Ja = -1 IF ((Cis AND E) AND (G OR Gis)) THEN Ja = -1 IF ((Cis AND F) AND (G OR Gis)) THEN Ja = -1 IF ((E AND (G OR Gis)) AND B) THEN Ja = -1 IF ((Dis AND F) AND (A OR B)) THEN Ja = -1 IF ((Dis AND G) AND (A OR B)) THEN Ja = -1 IF ((Dis AND Gis) AND B) THEN Ja = -1 IF ((E AND G) AND A) THEN Ja = -1 IF Ja = -1 THEN GOTO EFF3 IF Ja = 0 AND CHANGE MOD 9 = 0 THEN IF N%(t%, 1) > 0 THEN N%(t%, 1) = Mcn% + 3 IF N%(t%, 2) > 0 THEN N%(t%, 2) = Mcn% IF N%(t%, 3) > 0 THEN N%(t%, 3) = Mcn% - 3 IF N%(t%, 4) > 0 THEN N%(t%, 4) = Mcn% + 3 IF N%(t%, 5) > 0 THEN N%(t%, 4) = Mcn% - 3 CHANGE = CHANGE + 1: PRINT "CHANGE"; CHANGE GOTO EFF3: ELSEIF Ja = 0 AND CHANGE MOD 9 = 1 THEN IF N%(t%, 1) > 0 THEN N%(t%, 1) = Mcn% + 13 IF N%(t%, 2) > 0 THEN N%(t%, 2) = Mcn% + 7 IF N%(t%, 3) > 0 THEN N%(t%, 3) = Mcn% - 7 IF N%(t%, 4) > 0 THEN N%(t%, 4) = Mcn% - 19 IF N%(t%, 5) > 0 THEN N%(t%, 5) = Mcn% + 1 CHANGE = CHANGE + 1: PRINT "CHANGE"; CHANGE GOTO EFF3: ELSEIF Ja = 0 AND CHANGE MOD 9 = 2 THEN IF N%(t%, 1) > 0 THEN N%(t%, 1) = Mcn% + 3 IF N%(t%, 2) > 0 THEN N%(t%, 2) = Mcn% - 3 IF N%(t%, 3) > 0 THEN N%(t%, 3) = Mcn% - 19 IF N%(t%, 4) > 0 THEN N%(t%, 4) = Mcn% - 1 IF N%(t%, 5) > 0 THEN N%(t%, 5) = Mcn% - 13 CHANGE = CHANGE + 1: PRINT "CHANGE"; CHANGE GOTO EFF3: ELSEIF Ja = 0 AND CHANGE MOD 9 = 3 THEN IF N%(t%, 1) > 0 THEN N%(t%, 1) = Mcn% + 19 IF N%(t%, 2) > 0 THEN N%(t%, 2) = Mcn% + 2 IF N%(t%, 3) > 0 THEN N%(t%, 3) = Mcn% - 17 IF N%(t%, 4) > 0 THEN N%(t%, 4) = Mcn% - 2 IF N%(t%, 5) > 0 THEN N%(t%, 5) = Mcn% - 5 CHANGE = CHANGE + 1: PRINT "change"; CHANGE GOTO EFF3: ELSEIF Ja = 0 AND CHANGE MOD 9 = 4 THEN IF N%(t%, 1) > 0 THEN N%(t%, 1) = Mcn% + 3 IF N%(t%, 2) > 0 THEN N%(t%, 2) = Mcn% IF N%(t%, 3) > 0 THEN N%(t%, 3) = Mcn% - 17 IF N%(t%, 4) > 0 THEN N%(t%, 4) = Mcn% + 19 IF N%(t%, 5) > 0 THEN N%(t%, 5) = Mcn% + 3 CHANGE = CHANGE + 1: PRINT "CHANGE"; CHANGE GOTO EFF3: ELSEIF Ja = 0 AND CHANGE MOD 9 = 5 THEN IF N%(t%, 1) > 0 THEN N%(t%, 1) = Mcn% + 11 IF N%(t%, 2) > 0 THEN N%(t%, 2) = Mcn% - 1 IF N%(t%, 3) > 0 THEN N%(t%, 3) = Mcn% - 11 IF N%(t%, 4) > 0 THEN N%(t%, 4) = Mcn% + 5 IF N%(t%, 5) > 0 THEN N%(t%, 5) = Mcn% - 23 CHANGE = CHANGE + 1: PRINT "CHANGE"; CHANGE GOTO EFF3: ELSEIF Ja = 0 AND CHANGE MOD 9 = 6 THEN IF N%(t%, 1) > 0 THEN N%(t%, 1) = Mcn% + 7 IF N%(t%, 2) > 0 THEN N%(t%, 2) = Mcn% IF N%(t%, 3) > 0 THEN N%(t%, 3) = Mcn% - 17 IF N%(t%, 4) > 0 THEN N%(t%, 4) = Mcn% - 5 IF N%(t%, 5) > 0 THEN N%(t%, 5) = Mcn% - 19 CHANGE = CHANGE + 1: PRINT "CHANGE"; CHANGE GOTO EFF3: ELSEIF Ja = 0 AND CHANGE MOD 9 = 7 THEN IF N%(t%, 1) > 0 THEN N%(t%, 1) = Mcn% + 5 IF N%(t%, 2) > 0 THEN N%(t%, 2) = Mcn% + 2 IF N%(t%, 3) > 0 THEN N%(t%, 3) = Mcn% - 19 IF N%(t%, 4) > 0 THEN N%(t%, 4) = Mcn% + 2 IF N%(t%, 5) > 0 THEN N%(t%, 5) = Mcn% - 3 CHANGE = CHANGE + 1: PRINT "CHANGE"; CHANGE GOTO EFF3: ELSEIF Ja = 0 AND CHANGE MOD 9 = 8 THEN IF N%(t%, 1) > 0 THEN N%(t%, 1) = Mcn% + 7 IF N%(t%, 2) > 0 THEN N%(t%, 2) = Mcn% + 2 IF N%(t%, 3) > 0 THEN N%(t%, 3) = Mcn% - 13 IF N%(t%, 4) > 0 THEN N%(t%, 4) = Mcn% + 2 IF N%(t%, 5) > 0 THEN N%(t%, 5) = Mcn% - 19 CHANGE = CHANGE + 1: PRINT "CHANGE"; CHANGE END IF EFF3: END IF NEXT t% LUS = LUS + 1 PRINT " Lus filter 3 = "; LUS: ' for debug IF LUS < 2 THEN CHANGE = 0: GOTO STRT3 PRINT "Array-kopie gemaakt - filter 3 doorlopen": 'for debug flow '**************************************************************************** FILTER4: 'stap 2 analyseer de harmonie IF EXPERT = 0 THEN t% = NotTot% \ 3 IF EXPERT = -1 AND LOP <= 2 THEN t% = NotTot% \ 3 IF EXPERT = -1 AND LOP > 2 THEN t% = NotTot% * (LOP - 2) \ LOP DO GOSUB CHORD AKKOORDSTUDIE: GEVAL1: '******************************************************************** IF ((B AND Cis) AND G) THEN PRINT " G E V A L 1 ! " ' kijk per stem naar de volgende te spelen noot en maak er b,dis,gis van i% = 1 DO IF i% > 5 THEN EXIT DO q = t% DO q = q + 1 IF q > NotTot% THEN EXIT DO Nv%(i%) = N%(t%, i%): ' zoek volgende noot in die stem LOOP WHILE Nv%(i%) <= 0 ' nu staat de naam van de volgende noot in kanaal i% in Nv%(i%) IF ((Nv%(i%) MOD 12 = (Mcn% MOD 12) - 3) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 2) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 5)) THEN 'volgende noot is goed dus laat de noot staan i% = i% + 1: ' ga naar volgende kanaal GOTO LFC1 ELSE 'bestaat er wel een speelbare nieuwe noot ? Ja = 0 FOR Nq = Tes(i%, 1) TO Tes(i%, 2): ' zoek binnen de tessituurgrens FOR Nqt = 0 TO NtNr%: ' zoek binnen de toonladder IF (Nq = Pl%(Nqt)) THEN IF ((Nq MOD 12) = (Mcn% MOD 12) - 3) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12) + 2) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12) + 5) THEN Ja = -1 END IF NEXT Nqt NEXT Nq IF Ja = 0 THEN N%(q, i%) = Mcn% + 2: i% = i% + 1: GOTO LFC1 IF Ja THEN NWNT1: ' zoek de nieuwe noot Nv%(i%) = Pl%(RND(1) * NtNr) IF (Nv%(i%) < Tes%(i%, 1)) OR (Nv%(i%) > Tes%(i%, 2)) THEN GOTO NWNT1: IF (Nv%(i%) MOD 12 = (Mcn% MOD 12) - 3) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 2) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 5) THEN IF q >= NotTot% THEN N%(NotTot%, i%) = Nv%(i%): EXIT DO N%(q, i%) = Nv%(i%) ELSE GOTO NWNT1 END IF 'zoek een nieuwe noot en schrijf ze weg in array N%(t%,i%) END IF i% = i% + 1 LFC1: IF q > NotTot% THEN EXIT DO END IF LOOP ELSEIF (((A OR B) AND Dis) AND Fis) THEN : 'geval 2 ************************************** GEVAL2: PRINT " GEVAL2" i% = 1 DO IF i% > 5 THEN EXIT DO q = t% DO q = q + 1 IF q > NotTot% THEN EXIT DO Nv%(i%) = N%(t%, i%): ' zoek volgende noot in die stem LOOP WHILE Nv%(i%) <= 0 IF ((Nv%(i%) MOD 12 = (Mcn% MOD 12) - 2) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 5) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 2)) THEN i% = i% + 1: ' ga naar volgende kanaal GOTO LFC2 ELSE Ja = 0 FOR Nq = Tes(i%, 1) TO Tes(i%, 2): ' zoek binnen de tessituurgrens FOR Nqt = 0 TO NtNr%: ' zoek binnen de toonladder IF (Nq = Pl%(Nqt)) THEN IF ((Nq MOD 12) = (Mcn% MOD 12) + 5) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12) - 2) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12) + 2) THEN Ja = -1 END IF NEXT Nqt NEXT Nq IF Ja = 0 THEN N%(q, i%) = Mcn% - 2: i% = i% + 1: GOTO LFC2 IF Ja THEN NWNT2: ' zoek de nieuwe noot Nv%(i%) = Pl%(RND(1) * NtNr) IF (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 5) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) - 2) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 2) THEN IF q > NotTot% THEN q = NotTot% N%(q, i%) = Nv%(i%) ELSE GOTO NWNT2 END IF END IF i% = i% + 1 LFC2: END IF LOOP ELSEIF ((Gis AND Cis) AND E) THEN GEVAL3: PRINT "G E V A L 3 " i% = 1 DO IF i% > 5 THEN EXIT DO q = t% DO q = q + 1: IF q > NotTot% THEN EXIT DO Nv%(i%) = N%(t%, i%) LOOP WHILE Nv%(i%) <= 0 IF ((Nv%(i%) MOD 12 = (Mcn% MOD 12) - 3) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12)) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 3) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 5)) THEN i% = i% + 1 GOTO LFC3 ELSE Ja = 0 FOR Nq = Tes(i%, 1) TO Tes(i%, 2): ' zoek binnen de tessituurgrens FOR Nqt = 0 TO NtNr%: ' zoek binnen de toonladder IF (Nq = Pl%(Nqt)) THEN IF ((Nq MOD 12) = (Mcn% MOD 12) - 3) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12)) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12) + 3) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12) + 5) THEN Ja = -1 END IF NEXT Nqt NEXT Nq IF Ja = 0 THEN N%(q, i%) = Mcn%: i% = i% + 1: GOTO LFC3 IF Ja THEN NWNT3: ' zoek de nieuwe noot Nv%(i%) = Pl%(RND(1) * NtNr) IF (Nv%(i%) MOD 12 = (Mcn% MOD 12) - 3) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12)) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 3) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 5) THEN IF q > NotTot% THEN q = NotTot% N%(q, i%) = Nv%(i%) ELSE GOTO NWNT3 END IF END IF i% = i% + 1 LFC3: END IF LOOP ELSEIF ((Fis AND A) AND Cis) THEN GEVAL4: PRINT "G E V A L 4" i% = 1 DO IF i% > 5 THEN EXIT DO q = t% DO q = q + 1: IF q > NotTot% THEN EXIT DO Nv%(i%) = N%(t%, i%) LOOP WHILE Nv%(i%) <= 0 IF ((Nv%(i%) MOD 12 = (Mcn% MOD 12) - 1) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 1) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 5)) THEN i% = i% + 1 GOTO LFC4 ELSE Ja = 0 FOR Nq = Tes(i%, 1) TO Tes(i%, 2): ' zoek binnen de tessituurgrens FOR Nqt = 0 TO NtNr%: ' zoek binnen de toonladder IF (Nq = Pl%(Nqt)) THEN IF ((Nq MOD 12) = (Mcn% MOD 12) - 1) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12) + 1) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12) + 5) THEN Ja = -1 END IF NEXT Nqt NEXT Nq IF Ja THEN PRINT " er bestaat een alternatieve noot ! " IF Ja = 0 THEN N%(q, i%) = Mcn% - 1: i% = i% + 1: GOTO LFC4 IF Ja THEN NWNT4: Nv%(i%) = Pl%(RND(1) * NtNr) IF (Nv%(i%) MOD 12 = (Mcn% MOD 12) - 1) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 1) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 5) THEN IF q > NotTot% THEN q = NotTot% N%(q, i%) = Nv%(i%) ELSE GOTO NWNT4 END IF END IF i% = i% + 1 LFC4: END IF LOOP ELSEIF ((G AND B) AND F) THEN GEVAL5: ' maak volgende noten A,CIS,FIS PRINT "G e v a l 5" i% = 1 DO IF i% > 5 THEN EXIT DO q = t% DO q = q + 1: IF q > NotTot% THEN EXIT DO Nv%(i%) = N%(t%, i%) LOOP WHILE Nv%(i%) <= 0 IF ((Nv%(i%) MOD 12 = (Mcn% MOD 12) - 5) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) - 1) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 2)) THEN i% = i% + 1 GOTO LFC5 ELSE Ja = 0 FOR Nq = Tes(i%, 1) TO Tes(i%, 2): ' zoek binnen de tessituurgrens FOR Nqt = 0 TO NtNr%: ' zoek binnen de toonladder IF (Nq = Pl%(Nqt)) THEN IF ((Nq MOD 12) = (Mcn% MOD 12) - 5) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12) - 1) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12) + 2) THEN Ja = -1 END IF NEXT Nqt NEXT Nq IF Ja THEN PRINT " er bestaat een alternatieve noot ! " IF Ja = 0 THEN N%(q, i%) = Mcn% - 1: i% = i% + 1: GOTO LFC5 IF Ja THEN NWNT5: Nv%(i%) = Pl%(RND(1) * NtNr%) IF (Nv%(i%) MOD 12 = (Mcn% MOD 12) - 5) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) - 1) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 2) THEN IF q >= NotTot% THEN q = NotTot% N%(q, i%) = Nv%(i%) ELSE GOTO NWNT5 END IF END IF i% = i% + 1 LFC5: END IF LOOP ELSEIF ((Cis AND E) AND Fis) THEN GEVAL6: PRINT "G E V A L 6" i% = 1 DO IF i% > 5 THEN EXIT DO q = t% DO q = q + 1: IF q > NotTot% THEN EXIT DO Nv%(i%) = N%(t%, i%) LOOP WHILE Nv%(i%) <= 0 IF ((Nv%(i%) MOD 12 = (Mcn% MOD 12) - 5) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) - 3) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 1)) THEN i% = i% + 1 GOTO LFC6 ELSE Ja = 0 FOR Nq = Tes(i%, 1) TO Tes(i%, 2): ' zoek binnen de tessituurgrens FOR Nqt = 0 TO NtNr%: ' zoek binnen de toonladder IF (Nq = Pl%(Nqt)) THEN IF ((Nq MOD 12) = (Mcn% MOD 12) - 5) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12) + 1) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12) - 3) THEN Ja = -1 END IF NEXT Nqt NEXT Nq IF Ja THEN PRINT " er bestaat een alternatieve noot ! " IF Ja = 0 THEN N%(q, i%) = Mcn% + 1: i% = i% + 1: GOTO LFC6 IF Ja THEN NWNT6: Nv%(i%) = Pl%(RND(1) * NtNr) IF (Nv%(i%) MOD 12 = (Mcn% MOD 12) - 5) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 1) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) - 3) THEN IF q > NotTot% THEN q = NotTot% N%(q, i%) = Nv%(i%) ELSE GOTO NWNT6 END IF END IF i% = i% + 1 LFC6: END IF LOOP GEVAL7: '******************************************************************** ELSEIF ((B AND Cis) AND F) THEN PRINT " G E V A L 7 ! " ' kijk per stem naar de volgende te spelen noot en maak er cis,fis,a van i% = 1 DO IF i% > 5 THEN EXIT DO q = t% DO q = q + 1 IF q > NotTot% THEN EXIT DO Nv%(i%) = N%(t%, i%): ' zoek volgende noot in die stem LOOP WHILE Nv%(i%) <= 0 IF ((Nv%(i%) MOD 12 = (Mcn% MOD 12) - 5) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12)) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 3)) THEN i% = i% + 1: ' ga naar volgende kanaal GOTO LFC7 ELSE Ja = 0 FOR Nq = Tes(i%, 1) TO Tes(i%, 2): ' zoek binnen de tessituurgrens FOR Nqt = 0 TO NtNr%: ' zoek binnen de toonladder IF (Nq = Pl%(Nqt)) THEN IF ((Nq MOD 12) = (Mcn% MOD 12) - 5) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12)) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12) + 3) THEN Ja = -1 END IF NEXT Nqt NEXT Nq IF Ja THEN PRINT " er bestaat een alternatieve noot ! " IF Ja = 0 THEN N%(q, i%) = Mcn%: i% = i% + 1: GOTO LFC1 IF Ja THEN NWNT7: ' zoek de nieuwe noot Nv%(i%) = Pl%(RND(1) * NtNr) IF (Nv%(i%) < Tes%(i%, 1)) OR (Nv%(i%) > Tes%(i%, 2)) THEN GOTO NWNT7: IF (Nv%(i%) MOD 12 = (Mcn% MOD 12) - 5) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12)) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 3) THEN IF q >= NotTot% THEN N%(NotTot%, i%) = Nv%(i%): EXIT DO N%(q, i%) = Nv%(i%) ELSE GOTO NWNT7 END IF END IF i% = i% + 1 LFC7: IF q > NotTot% THEN EXIT DO END IF LOOP GEVAL8: '******************************************************************** ELSEIF ((Dis AND Gis) AND B) THEN PRINT " G E V A L 8 ! " ' kijk per stem naar de volgende te spelen noot en maak er cis,e,gis van i% = 1 DO IF i% > 5 THEN EXIT DO q = t% DO q = q + 1 IF q > NotTot% THEN EXIT DO Nv%(i%) = N%(t%, i%): ' zoek volgende noot in die stem LOOP WHILE Nv%(i%) <= 0 IF ((Nv%(i%) MOD 12 = (Mcn% MOD 12) - 5) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) - 2) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 2)) THEN i% = i% + 1: ' ga naar volgende kanaal GOTO LFC8 ELSE Ja = 0 FOR Nq = Tes(i%, 1) TO Tes(i%, 2): ' zoek binnen de tessituurgrens FOR Nqt = 0 TO NtNr%: ' zoek binnen de toonladder IF (Nq = Pl%(Nqt)) THEN IF ((Nq MOD 12) = (Mcn% MOD 12) - 5) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12) - 2) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12) + 2) THEN Ja = -1 END IF NEXT Nqt NEXT Nq IF Ja THEN PRINT " er bestaat een alternatieve noot ! " IF Ja = 0 THEN N%(q, i%) = Mcn% - 2: i% = i% + 1: GOTO LFC8 IF Ja THEN NWNT8: ' zoek de nieuwe noot Nv%(i%) = Pl%(RND(1) * NtNr) IF (Nv%(i%) < Tes%(i%, 1)) OR (Nv%(i%) > Tes%(i%, 2)) THEN GOTO NWNT8: IF (Nv%(i%) MOD 12 = (Mcn% MOD 12) - 5) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) - 2) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 2) THEN IF q >= NotTot% THEN N%(NotTot%, i%) = Nv%(i%): EXIT DO N%(q, i%) = Nv%(i%) ELSE GOTO NWNT8 END IF END IF i% = i% + 1 LFC8: IF q > NotTot% THEN EXIT DO END IF LOOP GEVAL9: '******************************************************************** ELSEIF ((Cis AND Gis) AND F) THEN PRINT " G E V A L 9 ! " ' kijk per stem naar de volgende te spelen noot en maak er cis,e,fis,a van i% = 1 DO IF i% > 5 THEN EXIT DO q = t% DO q = q + 1 IF q > NotTot% THEN EXIT DO Nv%(i%) = N%(t%, i%): ' zoek volgende noot in die stem LOOP WHILE Nv%(i%) <= 0 IF ((Nv%(i%) MOD 12 = (Mcn% MOD 12) - 5) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) - 2) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12)) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 3)) THEN i% = i% + 1: ' ga naar volgende kanaal GOTO LFC9 ELSE Ja = 0 FOR Nq = Tes(i%, 1) TO Tes(i%, 2): ' zoek binnen de tessituurgrens FOR Nqt = 0 TO NtNr%: ' zoek binnen de toonladder IF (Nq = Pl%(Nqt)) THEN IF ((Nq MOD 12) = (Mcn% MOD 12) - 5) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12) - 2) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12)) THEN Ja = -1 IF ((Nq MOD 12) = (Mcn% MOD 12) + 3) THEN Ja = -1 END IF NEXT Nqt NEXT Nq IF Ja THEN PRINT " er bestaat een alternatieve noot ! " IF Ja = 0 THEN N%(q, i%) = Mcn% - 2: i% = i% + 1: GOTO LFC9 IF Ja THEN NWNT9: ' zoek de nieuwe noot Nv%(i%) = Pl%(RND(1) * NtNr) IF (Nv%(i%) < Tes%(i%, 1)) OR (Nv%(i%) > Tes%(i%, 2)) THEN GOTO NWNT9: IF (Nv%(i%) MOD 12 = (Mcn% MOD 12) - 5) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) - 2) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12)) OR (Nv%(i%) MOD 12 = (Mcn% MOD 12) + 3) THEN IF q >= NotTot% THEN N%(NotTot%, i%) = Nv%(i%): EXIT DO N%(q, i%) = Nv%(i%) ELSE GOTO NWNT9 END IF END IF i% = i% + 1 LFC9: IF q > NotTot% THEN EXIT DO END IF LOOP END IF EF4: GOSUB TESFIL: ' check tessituur ! q = q - t% IF t% < NotTot% THEN IF q < 1 THEN q = 1 IF q < 12 THEN t% = t% + q ELSE t% = t% + 11 IF t% > NotTot% THEN t% = NotTot% PRINT t%; END IF LOOP WHILE t% < NotTot% FILTER5: '*************************** FILTER 5 *************************************** 'RITMIEK PRINT " Filter 5 : ritmiek " ERASE Ch% IF EXPERT = 0 THEN DIM Ch%(NotTot% * 2, 5) ELSE DIM Ch%(NotTot%, 5) t% = 0: TQ = 0 FOR t% = 0 TO NotTot% SamTot% = 0: NulTot% = 0 FOR i% = 1 TO 5 IF N%(t%, i%) > 0 THEN SamTot% = SamTot% + 1 IF N%(t%, i%) < 0 THEN NulTot% = NulTot% + 1 IF EXPERT = -1 THEN SamTot% = 1: NulTot% = 1 NEXT i% IF SamTot% = 5 THEN q = 23: N%(t%, 0) = SamTot% IF SamTot% = 4 THEN q = 19: N%(t%, 0) = SamTot% IF NulTot% = 5 THEN q = 17: N%(t%, 0) = NulTot% IF NulTot% = 4 THEN q = 13: N%(t%, 0) = NulTot% FOR i% = 1 TO 5: Ch%(TQ, i%) = N%(t%, i%): NEXT i% IF SamTot% > 3 OR NulTot% > 3 THEN Ch%(TQ, 0) = q FOR C = TQ + 1 TO TQ + q FOR i% = 1 TO 5 IF Ch%(TQ, i%) > 0 THEN Ch%(C, i%) = 0: ' houdt noot aan IF Ch%(TQ, i%) = 0 THEN Ch%(C, i%) = -1: ' schakel noot uit IF Ch%(TQ, i%) < 0 THEN Ch%(C, i%) = -1: ' rust blijft rust NEXT i% NEXT C TQ = TQ + q + 1 ELSE TQ = TQ + 1 END IF NEXT t% IF TQ > NotTot% THEN TQ = NotTot% FOR i% = 1 TO 5: Ch%(TQ, i%) = -1: NEXT i%: ' stilte na laatste noot ! PRINT " de partituur is nu "; TQ; " tellen lang" ERASE N% NotTot% = TQ: ' het nieuwe aantal tijden komt terug in NOTTOT% DIM N%(NotTot% + 1, 5): ' het nieuwe partituurarray wordt gedimensioneerd FOR t% = 0 TO NotTot% N%(t%, 0) = Ch%(t%, 0) FOR i% = 1 TO 5 N%(t%, i%) = Ch%(t%, i%) IF N%(t%, i%) > 0 THEN IF (N%(t%, i%) >= Tes(i%, 1)) AND (N%(t%, i%) <= Tes(i%, 2)) THEN N%(t%, i%) = Ch%(t%, i%) ELSE IF N%(t%, i%) < Tes(i%, 1) THEN ' noot is te laag j = 0 DO WHILE j < NtNr IF (N%(t%, i%) MOD 12 = Pl%(j) MOD 12) AND (Pl%(j) >= Tes(i%, 1)) AND (Pl%(j) <= Tes(i%, 2)) THEN N%(t%, i%) = Pl%(j): EXIT DO ELSE j = j + 1 END IF LOOP IF j >= NtNr THEN N%(t%, i%) = -1 ELSE ' noot is te hoog j = NtNr DO WHILE j > 0 IF (N%(t%, i%) MOD 12 = Pl%(j) MOD 12) AND (Pl%(j) <= Tes(i%, 2)) AND (Pl%(j) >= Tes(i%, 1)) THEN N%(t%, i%) = Pl%(j): EXIT DO ELSE j = j - 1 END IF LOOP IF j = 0 THEN N%(t%, i%) = -1 END IF END IF END IF NEXT i% NEXT t% ERASE Ch%: ' het kopij-array mag weg nu ... ' einde filter 5 *********************************************************** 'filter6 - opkuisfilter FILTER6: FOR t% = 0 TO NotTot% FOR i% = 1 TO 5 IF (N%(t%, i%) = -1) AND (t% < NotTot%) THEN IF N%(t% + 1, i%) = 0 THEN N%(t% + 1, i%) = -1 END IF NEXT i% NEXT t% 'voorlaatste noot in array : N%(NotTot% - 1, 1) = Mcn% + 17 N%(NotTot% - 1, 2) = Mcn% + 2 N%(NotTot% - 1, 3) = Mcn% - 31 N%(NotTot% - 1, 4) = Mcn% + 2 N%(NotTot% - 1, 5) = Mcn% - 2 '************************menu : play-array of print-score of print parts ... MENU3: CLS IF Bevel$ = "PP" THEN k$ = "1": GOTO SkipMenu3: LOCATE 10, 10: PRINT " PRIMES - MENU Nr.3 : " LOCATE 12, 10: PRINT " 1.- Midi-simulator [***] " LOCATE 13, 10: PRINT " 2.- Partituur naar file schrijven " LOCATE 14, 10: PRINT " 3.- Partituur uitprinten " LOCATE 15, 10: PRINT " 4.- Partij 1 printen " LOCATE 16, 10: PRINT " 5.- Partij 2 printen " LOCATE 17, 10: PRINT " 6.- Partij 3 printen " LOCATE 18, 10: PRINT " 7.- Partij 4 printen " LOCATE 19, 10: PRINT " 8.- Save score-array for expert " LOCATE 20, 10: PRINT " 9.- Programma verlaten " LOCATE 21, 40: PRINT "KEUZE ? "; DO: k$ = INKEY$: LOOP UNTIL VAL(k$) > 0 AND VAL(k$) <= 9 SkipMenu3: SELECT CASE VAL(k$) CASE 1 Miplay CASE 2 F$ = "PRIMES.SCR" GOSUB PARTITUUR CASE 3 F$ = "LPT1:" GOSUB PARTITUUR CASE 4, 5, 6, 7 Part = VAL(k$) - 3 k = VAL(k$) GOSUB PARTS CASE 8 GOSUB SVEARR CASE 9 END END SELECT END PARTITUUR: OPEN F$ FOR OUTPUT AS #1 FOR t% = 0 TO NotTot% FOR i% = 5 TO 1 STEP -1: 'lage instrumenten onderaan ! - fluit boven IF N%(t%, i%) > 0 THEN PRINT #1, Nm$(N%(t%, i%)); N%(t%, i%), : GOTO ESCR IF N%(t%, i%) < 0 THEN PRINT #1, " ", : GOTO ESCR IF N%(t%, i%) = 0 THEN IF N%(t% - 1, i%) >= 0 THEN PRINT #1, " | ", ELSE PRINT #1, " ", END IF END IF ESCR: NEXT i% IF N%(t%, 0) <= 0 THEN IF (t% MOD 4) = 0 THEN PRINT #1, " * " ELSE PRINT #1, " " ELSE PRINT #1, t% + 1; " "; N%(t%, 0) END IF NEXT t% PRINT #1, DATE$, TIME$, " Godfried-Willem RAES " CLOSE #1 RETURN PARTS: i% = Part F$ = "C:\BC7\PRIMES\PART_" + CHR$(48 + i%) + ".SCR" OPEN F$ FOR OUTPUT AS #1 FOR t% = 0 TO NotTot% IF N%(t%, i%) > 0 THEN PRINT #1, Nm$(N%(t%, i%)); IF N%(t%, i%) = 0 THEN PRINT #1, " = "; IF N%(t%, i%) = -1 THEN PRINT #1, " 0 "; NEXT t% PRINT #1, " " CLOSE #1 RETURN 'subroutine die initieel partij na partij berekent en in het array schrijft PARTIJ: t% = 1: C = 0 DO UNTIL t% > NotTot% IF (t% MOD Rt%(i%)) THEN N%(t%, i%) = 0: ' houdt noot aan t% = t% + 1: ' tel 1 tijd verder GOTO EINDELUS ELSE OPN: q% = RND(1) * NtNr N%(t%, i%) = Pl%(q%) IF N%(t%, i%) < Tes(i%, 1) OR N%(t%, i%) > Tes(i%, 2) THEN GOTO OPN 'filteralgoritme voor verloop kompositie OPBOUW: IF (t% < NotTot% \ 11) THEN IF RND(1) * 2 > 1 THEN s = -1 ELSE s = 1 N%(t%, i%) = Mcn% + (RND(1) * s) GOTO FILTER2: ELSEIF t% < (NotTot% \ 9) THEN IF RND(1) * 2 > 1 THEN s = 1 ELSE s = -1 N%(t%, i%) = Mcn% + (RND(1) * s * 2) GOTO FILTER2: ELSEIF t% < (NotTot% \ 7) THEN IF RND(1) * 2 > 1 THEN s = 1 ELSE s = -1 N%(t%, i%) = Mcn% + (RND(1) * s * 3) GOTO FILTER2: ELSEIF C < NtNr / 2 THEN IF t% MOD (Rt(i%) ^ 2) = 0 THEN C = C + 1 IF RND(1) * 2 > 1 THEN s = -1 ELSE s = 1 q = RND(1) * C * s N%(t%, i%) = Pl%((NtNr / 2) + q) GOTO FILTER2: ELSEIF (t% < NotTot% \ 5) AND ((N%(t%, i%) > Hcn%) OR (N%(t%, i%) < Lcn%)) THEN Range% = (Hcn% - Lcn%) / 2 CALL PRIEM(p%, Range%) N%(t%, i%) = Mcn% + p% GOTO FILTER2: ELSEIF (t% < (NotTot% * 2) \ 5) AND ((N%(t%, i%) > Hcn% + 7) OR (N%(t%, i%) < Lcn% - 7)) THEN Range% = ((Hcn% - Lcn%) / 2) + 7 CALL PRIEM(p%, Range%) N%(t%, i%) = Mcn% + p% GOTO FILTER2: ELSEIF (t% = (NotTot% * 4) \ 7) THEN IF RND(1) * 10 > 5 THEN s = -1 ELSE s = 1 q = i% MOD 13 IF q MOD 2 = 0 THEN q = q + 1 IF q = 9 THEN q = 17 N%(t%, i%) = Mcn% + (s * q) GOTO FILTER2: ELSEIF (t% < (NotTot% * 4) \ 7) AND ((N%(t%, i%) > Hcn% + 11) OR (N%(t%, i%) < Lcn% - 11)) THEN Range% = ((Hcn% - Lcn%) / 2) + 11 CALL PRIEM(p%, Range%) N%(t%, i%) = Mcn% + p% GOTO FILTER2: ELSEIF (t% < (NotTot% * 7) \ 11) AND ((N%(t%, i%) > Hcn% + 18) OR (N%(t%, i%) < Lcn% - 18)) THEN Range% = ((Hcn% - Lcn%) / 2) + 18 CALL PRIEM(p%, Range%) N%(t%, i%) = Mcn% + p% GOTO FILTER2: ELSEIF (t% < (NotTot% * 5) \ 7) THEN Range% = ((Tes%(i%, 2) - Tes%(i%, 1)) / 2) CALL PRIEM(p%, Range%) N%(t%, i%) = Mcn% + p% GOTO FILTER2: ELSEIF (t% < (NotTot% * 6) \ 7) THEN Range% = ((Tes%(i%, 2) - Tes%(i%, 1)) / 2) CALL PRIEM(p%, Range%) IF Range% > Mcn% THEN N%(t%, i%) = Mcn% + ABS(p%) IF Range% = Mcn% THEN N%(t%, i%) = Mcn% + p% IF Range% < Mcn% THEN N%(t%, i%) = Mcn% - ABS(p%) GOTO FILTER2: ELSEIF t% < NotTot% THEN Range% = Hcn% - Mcn% CALL PRIEM(p%, Range%) IF ((Tes%(i%, 2) - Tes%(i%, 1)) / 2) > Mcn% THEN N%(t%, i%) = Mcn% + ABS(p%) ELSE N%(t%, i%) = Mcn% - ABS(p%) END IF FILTER2: END IF GOSUB TESFIL END IF EINDEFILTER: t% = t% + Rt(i%) CALL RITME(Rt(), NotTot%) IF t% > NotTot% THEN EXIT DO EINDELUS: LOOP 'voorlaatste noot in array : N%(NotTot% - 1, 1) = Mcn% + 17 N%(NotTot% - 1, 2) = Mcn% + 2 N%(NotTot% - 1, 3) = Mcn% - 31 N%(NotTot% - 1, 4) = Mcn% + 2 N%(NotTot% - 1, 5) = Mcn% - 2 RETURN PRIMLAD: 'deze subroutine maakt het priemtoonladder array rond NC% als centrale noot 'en retourneert deze in het array PL%() . Het aantal noten waaruit deze 'toonladder bestaat komt in de variabele NTNR terecht. i% = Nc%: RESTORE ' initiele index van de centrale noot is het nootgetal zelf DO WHILE Pl%(i%) <= 127 AND i% < 128 READ Pk: IF Nc% + Pk > 127 THEN EXIT DO Pl%(i%) = Nc% + Pk: i% = i% + 1 LOOP RESTORE: i% = Nc% DO WHILE Pl%(i%) >= 0 AND i% >= 0 READ Pk: IF Nc% - Pk < 0 THEN EXIT DO Pl%(i%) = Nc% - Pk: i% = i% - 1: IF i% < 0 THEN EXIT DO LOOP 'elimineer alle nullen : j = 0 FOR i% = 0 TO 127 IF Pl%(i%) > 0 THEN Pl%(j) = Pl%(i%): j = j + 1 NEXT i% FOR i% = j TO 127: Pl%(i%) = 0: NEXT i% NtNr = j - 1 RETURN CHORD: C = 0: Cis = 0: D = 0: Dis = 0: E = 0: F = 0: Fis = 0: G = 0: Gis = 0: A = 0: Bes = 0: B = 0 FOR i% = 1 TO 5 IF Ch%(t%, i%) = 0 THEN GOTO STP2: IF Ch%(t%, i%) MOD 12 = (Mcn% MOD 12) - 6 THEN C = -1 IF Ch%(t%, i%) MOD 12 = (Mcn% MOD 12) - 5 THEN Cis = -1 IF Ch%(t%, i%) MOD 12 = (Mcn% MOD 12) - 4 THEN D = -1 IF Ch%(t%, i%) MOD 12 = (Mcn% MOD 12) - 3 THEN Dis = -1 IF Ch%(t%, i%) MOD 12 = (Mcn% MOD 12) - 2 THEN E = -1 IF Ch%(t%, i%) MOD 12 = (Mcn% MOD 12) - 1 THEN F = -1 IF Ch%(t%, i%) MOD 12 = (Mcn% MOD 12) THEN Fis = -1 IF Ch%(t%, i%) MOD 12 = (Mcn% MOD 12) + 1 THEN G = -1 IF Ch%(t%, i%) MOD 12 = (Mcn% MOD 12) + 2 THEN Gis = -1 IF Ch%(t%, i%) MOD 12 = (Mcn% MOD 12) + 3 THEN A = -1 IF Ch%(t%, i%) MOD 12 = (Mcn% MOD 12) + 4 THEN Bes = -1 IF Ch%(t%, i%) MOD 12 = (Mcn% MOD 12) + 5 THEN B = -1 STP2: NEXT i% RETURN TESFIL: ' filter voor de speelbaarheid van de berekende noten door de ' gegeven instrumenten IF i% > 5 THEN RETURN IF t% > NotTot% THEN RETURN IF (N%(t%, i%) < Tes%(i%, 1)) OR (N%(t%, i%) > Tes%(i%, 2)) THEN N%(t%, i%) = -1 IF N%(t%, 5) > N%(t%, 4) THEN SWAP N%(t%, 5), N%(t%, 4) RETURN SVEARR: ' save array as binary file to disk - for use in expert-system mode XP$ = "primes.xpt" XPL$ = "primes.lop" OPEN XP$ FOR OUTPUT AS #1 OPEN XPL$ FOR INPUT AS #2 IF NOT EOF(2) THEN INPUT #2, A: ' vorig notentotaal IF NOT EOF(2) THEN INPUT #2, LOP: ' aantal maal dat de expert loop werd doorlopen CLOSE #2 OPEN XPL$ FOR OUTPUT AS #2 PRINT #2, NotTot%; LOP + 1 CLOSE #2 FOR t% = 0 TO NotTot%: FOR i% = 0 TO 5 PRINT #1, N%(t%, i%); NEXT i%: NEXT t% PRINT #1, CLOSE #1 RETURN 'priemgetallen van 0 tot 127: (34 stuks) DATA 0,1,2,3,5,7,11,13,17,19,23 DATA 29,31,37,41,43,47,53,57,59,61,67,71,73,79 DATA 83,89,97,101,103,107,109,113,127 DEFSNG X-Z SUB INSTRUMENTATIE (Tes%(), Nc(), Hcn, Lcn, Mcn%) STATIC 'berekening van de muzikale mogelijkheden en grenzen van het ensemble STRUM: 'TES%(x,y)= tessituur van instrument x ( vier instrumenten) ' instrument 4= piano , of polyfoon-instrument ' y=1 is de laagste noot ' y=2 is de hoogste noot ' cheops bezetting OPEN "CHEOPS.DTA" FOR INPUT AS #1 FOR i% = 1 TO 4: INPUT #1, Tes%(i%, 1): NEXT i% FOR i% = 1 TO 4: INPUT #1, Tes%(i%, 2): NEXT i% CLOSE #1 'bereken de centrale noot voor ieder instrument afzonderlijk FOR i% = 1 TO 4 Nc(i%) = ((Tes%(i%, 2) - Tes%(i%, 1)) \ 2) + Tes%(i%, 1) NEXT i% 'bereken de midden-tessituurnoot voor het hele ensemble Nc(0) = 0 FOR i% = 1 TO 4 Nc(0) = Nc(0) + Nc(i%) NEXT i% Nc(0) = Nc(0) \ 4 'ga na of deze mid-tessituurnoot door alle instrumenten kan gespeeld worden A = 0 FOR i% = 1 TO 4 IF Nc(0) >= Tes%(i%, 1) AND Nc(0) <= Tes%(i%, 2) THEN A = A + 1 NEXT i% 'IF A > 1 THEN alles o.k. GEMTES: 'bepaal de laagste en de hoogste gemeenschappelijke noot van het ensemble N = 0 TSTNN: N = N + 1 IF N >= Tes%(1, 1) AND N >= Tes%(2, 1) AND N >= Tes%(3, 1) AND N >= Tes%(4, 1) AND N <= Tes%(1, 2) AND N <= Tes%(2, 2) AND N <= Tes%(3, 2) AND N <= Tes%(4, 2) THEN Lcn% = N ELSE GOTO TSTNN N = 127 TSTNM: N = N - 1 IF N <= Tes%(1, 2) AND N <= Tes%(2, 2) AND N <= Tes%(3, 2) AND N <= Tes%(4, 2) AND N >= Tes%(1, 1) AND N >= Tes%(2, 1) AND N >= Tes%(3, 1) AND N >= Tes%(4, 1) THEN Hcn% = N ELSE GOTO TSTNM 'LOCATE 12, 10: PRINT "Lowest Common note ="; Lcn 'LOCATE 13, 10: PRINT "Highest Common note="; Hcn Mcn% = ((Hcn% - Lcn) \ 2) + Lcn 'LOCATE 14, 10: PRINT "Medium common note= "; Mcn% 'LOCATE 15, 10: PRINT "Centernote of ensemble range="; Nc(0) STRUMEND: 'LOCATE 17, 10: PRINT " Calculating a score for 'Primes'. Please wait ... " END SUB SUB PRIEM (p%, Range%) LOCAL q%, i% LOCAL N AS INTEGER 'real-time priemgenerator q% = p% p% = RND(1) * Range% IF p% = 0 THEN EXIT SUB N = 0 FOR i% = 2 TO p% - 1 IF p% MOD i% = 0 THEN N = N + 1 NEXT i% IF N > 0 THEN EXIT SUB IF p% = ABS(q%) THEN EXIT SUB IF RND(1) * 2 > 1 THEN s = 1 ELSE s = -1 p% = p% * s END SUB SUB RITME (Rt%(), NotTot%) DIM R(5) AS STATIC INTEGER DIM RNS(5) AS STATIC INTEGER LOCAL i% LOCAL j AS INTEGER LOCAL Gp AS DWORD '1= fluit - rootritmegetal =3 '2= hobo - rootritmegetal =5 '3= kontrabas - rootritmegetal =11 '4= piano rechts - rootritmegetal =7 '5= piano links - rootritmegetal =2 R(1) = 3: R(2) = 5: R(3) = 11: R(4) = 7: R(5) = 2 NotTot% = R(1) * R(2) * R(3) * R(4) * R(5) FOR i% = 1 TO 5 IF RND(1) * 10 > 6 THEN Rt(i%) = R(i%) ELSE Rt(i%) = 1 NEXT i% Gp = Rt%(1) * Rt%(2) * Rt%(3) * Rt%(4) * Rt%(5): ' goedel-product DO UNTIL Gp = NotTot j = 0 FOR i% = 1 TO 5 IF Gp MOD R(i%) THEN j = j + 1: RNS(j) = R(i%) NEXT i% ' in RNS(J) staan nu J niet gebruikte root-priemgetallen voor ritme j = 1 FOR i% = 5 TO 1 STEP -1 IF Rt%(i%) = 1 THEN IF RND(1) * 10 > 5 THEN Rt%(i%) = RNS(j): j = j + 1 END IF NEXT i% Gp = Rt%(1) * Rt%(2) * Rt%(3) * Rt%(4) * Rt%(5) LOOP END SUB #ENDIF