'18.446.744.073.709.551.616 sonata's for piano and organs '001109 eerste versie. maakt beginakkoorden. 'iets mis met gemaakte seq-file. wordt niet correct vertaald door h2m. 'wordt wel juist afgespeeld door een eigen gmt-applicatie, module psf.bas 'STATUS=INFO('dropped seq file, becam real=time') '0011xx 'problem w/ some character in h.vel > string not processed correctly!!??? '001227 'solved '010130 'TO DO>STATUS=POSSIBILITY&QUESTIONABLE: make 3 averagers, freq = qv. fr. / 3 'melo = transposed hist, middle regions, as other voices move to extremes eventually '010209 'algo more or less ok(??) 'TO DO>STATUS=DONE: play notes through filter function that doesn't put notes on that are allready on and that alternates ocateves for fast repeats 'find moment + action for end '010308 'bouncing tasks play out of their rang notes (or at least notes are shown out of ragne in dbg window 'at fast tempo we should slow down some timez '01051x 'BUG: tempo of realplayer sometimes goes 0 >> smells like wrong ptr 'for the rest it seems to wprk fine 'CONSTANTS------------------------------------- %nrchords = 17 '33 %lowestnote = 24 %highestnote = 104 %tonalcenter = 1 'C# %BOSS = 14 %LPT = 15 'LowestPlayerTask %LOH = 32 '24 '16 '5000 'length of history - 1 %RP = %LPT + 15 '%pps3_debug = %true 'SUB/FCT DECLARATIONS---------------------------------- DECLARE FUNCTION ComputeArc (ArcStart AS DWORD, ArcLength AS DWORD, bg$) AS DWORD DECLARE FUNCTION GetNewNote(BYVAL id AS DWORD) AS BYTE DECLARE FUNCTION GetFirstNote(BYVAL id AS LONG) AS BYTE DECLARE FUNCTION FCMGVoice(id AS LONG) AS LONG DECLARE FUNCTION NoteAllReadyOn(noot AS BYTE, id AS LONG) AS LONG 'returns true if the note passed is on allready DECLARE SUB WriteMyFile() DECLARE SUB ForPlay (BYVAL ch AS BYTE, BYVAL note AS BYTE, BYVAL velo AS BYTE, BYVAL id AS BYTE) DECLARE SUB InitChordSeQuence () DECLARE SUB Player1 DECLARE SUB Player2 DECLARE SUB Player3 DECLARE SUB pps3dbg(BYVAL id AS LONG) DECLARE SUB pps3master 'VARIABLE DECLARATIONS--------------------------------- TYPE pps3Type noot AS BYTE oldnoot AS BYTE velo AS BYTE lowtes AS SINGLE 'BYTE 'boundaries of pitch single precision for computations hightes AS SINGLE 'BYTE hidest AS SINGLE 'BYTE lodest AS SINGLE 'BYTE ctes AS BYTE 'central pitch direction AS SINGLE 'of melodie, integrated over time minfreq AS SINGLE 'of task '!!can be assigned dynamicly during piece maxfreq AS SINGLE recent (0 TO 3) AS BYTE tog AS LONG done AS LONG 'new 010510, set if a voice reached its destination ambituswise END TYPE GLOBAL H()AS HarmType ' harmony array that contains chordseq from wich plqyer voices are extracted GLOBAL P() AS pps3type ' general meta params GLOBAL pHist AS BYTE PTR 'pointer to history string GLOBAL HarTOn() AS STRING * 128 'to put on 'simile to har.vel GLOBAL HarTof() AS STRING*128 'to put off GLOBAL HarNOn() AS STRING*128 'on now '======================================================== 'initialisation------------------------------------------ FUNCTION Initpps3 AS LONG DIM H(0 TO %nrChords) '0 = empty chord! DIM P(%LPT TO %LPT+10) DIM HarTOn(0 TO 4) DIM HarTof(0 TO 4) DIM HarNOn(0 TO 4) STATIC HIST() AS BYTE DIM hist(1 TO %LOH) 'INIT HISTORY pHist = VARPTR(hist(1)) POKE$ pHist,STRING$(%LOH,80) RANDOMIZE TIMER '17325 '51 '2001 note 51 was fine, 1 was fine too IF TIMER >= 85500 THEN MSGBOX "please wait until midnight before starting the piece" + _ CHR$(13) + "it's now" + STR$(INT((86400 - TIMER)/60))+ " min. before midnight"_ +CHR$(13)+CHR$(13) + "( sorry, i didn't make this stupid windows timer :) )",, "timer error" FUNCTION = %false EXIT FUNCTION END IF InitChordSequence WriteMyFile ' MSGBOX "yoooo" 'FOR CHANGING TASKNRS, ONLY CHANZE %LPT 'OR BE CAREFULL, AS SEVERAL VOICET_TYPE BOUND ARRAYS ARE HARD DIMMED ' ShowHar H(1 + count MOD 17),1,280,1 ' 'IF count <= 20 THEN '%LPT + 20 THEN ' IF count = 8 THEN count = 13 'AND count < 14 THEN EXIT SUB IF (count > 6) AND (count <= 10) THEN ' IF ISFALSE(count MOD 2) THEN StartTask %LPT + count ' \ 2 ' END IF ' IF count = %LPT + 1 THEN '010501 ' StartTask %RP + 1 ' END IF ' IF count = %LPT + 3 THEN count = %LPT + 6 EXIT SUB END IF FOR i = %LPT TO %LPT + 10 IF (P(i).hightes - P(i).lowtes) <= 4 THEN 'ABS(P(i).lowtes - P(i).lodest) < 2 AND ABS(P(i).hightes = P(i).hidest) < 2 THEN P(i).maxfreq = ( 12 * P(i).maxfreq + 0.3 + (i - %LPT) / 10 ) / 13 P(i).minfreq = ( 12 * P(i).minfreq + 0.2 + (i - %LPT) / 10 ) / 13 tog = %true END IF IF i = %LPT + 3 THEN i = %LPT + 6 NEXT IF tog THEN EXIT SUB IF DeltaTime >= TIMER THEN P(%LPT).maxfreq = (12 * P(%lpt).maxfreq + 6) / 13 P(%LPT + 1).maxfreq = (12 * P(%lpt + 1).maxfreq + 7) / 13 P(%LPT + 2).maxfreq = (12 * P(%lpt + 2).maxfreq + 8) / 13 P(%LPT + 3).maxfreq = (12 * P(%lpt + 3).maxfreq + 9) / 13 P(%LPT + 7).maxfreq = (12 * P(%lpt + 7).maxfreq + 29) / 13 P(%LPT + 8).maxfreq = (12 * P(%lpt + 8).maxfreq + 30) / 13 P(%LPT + 9).maxfreq = (12 * P(%lpt + 9).maxfreq + 31) / 13 P(%LPT + 10).maxfreq = (12 * P(%lpt + 10).maxfreq + 32) / 13 ELSE P(%LPT).minfreq = (12 * P(%lpt).minfreq + .92) / 13 P(%LPT + 1).minfreq = (12 * P(%lpt + 1).minfreq + 1) / 13 P(%LPT + 2).minfreq = (12 * P(%lpt + 2).minfreq + 1.04) / 13 P(%LPT + 3).minfreq = (12 * P(%lpt + 3).minfreq + 1.135) / 13 P(%LPT + 7).minfreq = (12 * P(%lpt + 7).minfreq + 3) / 13 P(%LPT + 8).minfreq = (12 * P(%lpt + 8).minfreq + 2.9) / 13 P(%LPT + 9).minfreq = (12 * P(%lpt + 9).minfreq + 3.1) / 13 P(%LPT + 10).minfreq = (12 * P(%lpt + 10).minfreq + 2.8) / 13 END IF END SUB FUNCTION RoundFreq(BYVAL raw AS SINGLE,BYVAL id AS LONG) AS SINGLE LOCAL i AS LONG LOCAL sumfreq AS SINGLE LOCAL buffer AS SINGLE FOR i =%lpt TO %lpt + 3 sumfreq = sumfreq + task(i).freq NEXT FOR i = %lpt + 7 TO %lpt + 10 sumfreq = sumfreq + task(i).freq NEXT IF sumfreq > 18 THEN sumfreq = sumfreq / 8 IF raw > sumfreq THEN ' FUNCTION = (2 * raw + sumfreq)/6 ' EXIT FUNCTION buffer = (2 * raw + sumfreq)/3 '6 END IF ' FUNCTION = raw ' EXIT FUNCTION GOTO resultaat END IF IF sumfreq > 6 THEN sumfreq = sumfreq / 8 'presuming there are 4 voices, eq. average now IF raw > sumfreq THEN IF raw - sumfreq <= 2 THEN ' FUNCTION = (6 * raw + sumfreq) / 8 ' EXIT FUNCTION buffer = (6 * raw + sumfreq) /7 ' 8 ELSE buffer = (4 * raw + P(id).maxfreq) / 5 ' FUNCTION = (4 * raw + P(id).maxfreq) / 5 ' EXIT FUNCTION END IF ELSE END IF GOTO resultaat ELSE sumfreq = sumfreq / 8 IF raw > sumfreq THEN ' FUNCTION = (4 * raw + P(id).maxfreq ) / 5 buffer = (4 * raw + P(id).maxfreq ) / 5 GOTO resultaat ELSE END IF END IF IF id > %lpt + 3 THEN IF task(id - 7).freq / task(id).freq > 3 THEN ' FUNCTION = (3 * task(id).freq + task(id - 7).freq ) / 4 ' EXIT FUNCTION buffer = (3 * task(id).freq + task(id - 7).freq ) / 4 END IF END IF resultaat: IF ISFALSE buffer THEN buffer = raw IF buffer < P(id).MinFreq THEN buffer = P(id).minFreq IF buffer > P(id).MaxFreq THEN buffer = P(id).maxFreq FUNCTION = buffer END FUNCTION 'start playing-------------------------------------------- SUB StartPps3 ButnSW_StartStopToggle StartTask %BOSS StartTask %RP ' StartTask %RP + 1 ' StartTask %LPT ' StartTask %LPT + 1 ' StartTask %LPT + 2 ' StartTask %LPT + 3 ' StartTask %LPT + 7 ' StartTask %LPT + 8 ' StartTask %LPT + 9 ' StartTask %LPT + 10 END SUB 'debugwindow proc----------------------------------------- SUB pps3dbg(BYVAL id AS LONG) #IF %DEF(%pps3_debug) STATIC hDlg AS LONG LOCAL i AS LONG, j AS LONG LOCAL buf AS STRING IF ISFALSE hDlg THEN DIALOG NEW %HWND_DESKTOP, "PPS3 debug window",0,0,450,250 TO hDlg CONTROL ADD LABEL, hDlg,-1,"id" ,5,5,65,12, %SS_SUNKEN CONTROL ADD LABEL, hDlg,-1,"freq" ,75,5,55,12, %SS_SUNKEN CONTROL ADD LABEL, hDlg,-1,"note" ,140,5,25,12, %SS_SUNKEN CONTROL ADD LABEL, hDlg,-1,"velo" ,170,5,25,12, %SS_SUNKEN CONTROL ADD LABEL, hDlg,-1,"[ note" ,205,5,25,12, %SS_SUNKEN CONTROL ADD LABEL, hDlg,-1,"note ]" ,235,5,25,12, %SS_SUNKEN CONTROL ADD LABEL, hDlg, -1,"[freq", 265,5,55,12, %SS_SUNKEN CONTROL ADD LABEL, hDlg, -1,"freq]", 325,5,55,12, %SS_SUNKEN CONTROL ADD LABEL, hDlg, -1, "dir", 390,5,55,12, %SS_SUNKEN FOR i = %LPT TO %LPT + 10 CONTROL ADD LABEL, hDlg, -1, task(i).naam, 5, 26 + 14 * (i - %LPT),65,12,%SS_SUNKEN CONTROL ADD LABEL, hDlg, i * 10, "?", 75, 26 + 14 * (i - %LPT),55,12,%SS_SUNKEN CONTROL ADD LABEL, hDlg, i * 10 + 1, "?", 140, 26 + 14 * (i - %LPT),25,12,%SS_SUNKEN CONTROL ADD LABEL, hDlg, i * 10 + 2, "?", 170, 26 + 14 * (i - %LPT),25,12,%SS_SUNKEN CONTROL ADD LABEL, hDlg, i * 10 + 3, "?", 205, 26 + 14 * (i - %LPT),25,12,%SS_SUNKEN CONTROL ADD LABEL, hDlg, i * 10 + 4, "?", 235, 26 + 14 * (i - %LPT),25,12,%SS_SUNKEN CONTROL ADD LABEL, hDlg, i * 10 + 5, "?", 265, 26 + 14 * (i - %LPT),55,12,%SS_SUNKEN CONTROL ADD LABEL, hDlg, i * 10 + 6, "?", 325, 26 + 14 * (i - %LPT),55,12,%SS_SUNKEN CONTROL ADD LABEL, hDlg, i * 10 + 7, "!", 390, 26 + 14 * (i - %LPT),25,12,%SS_SUNKEN NEXT CONTROL ADD LABEL, hDlg, 1000, "?",5,200,340,12, %SS_SUNKEN DIALOG SHOW MODELESS hDlg END IF IF id THEN CONTROL SET TEXT hDlg, id * 10, STR$(task(id).freq) CONTROL SET TEXT hDlg, id * 10 + 1, STR$(P(id).noot) CONTROL SET TEXT hDlg, id * 10 + 2, STR$(P(id).velo) CONTROL SET TEXT hDlg, id * 10 + 3, STR$(INT(P(id).LowTes)) CONTROL SET TEXT hDlg, id * 10 + 4, STR$(INT(P(id).HighTes)) CONTROL SET TEXT hDlg, id * 10 + 5, STR$(P(id).minFreq) CONTROL SET TEXT hDlg, id * 10 + 6, STR$(P(id).maxFreq) CONTROL SET TEXT hDlg, id * 10 + 7, STR$(P(id).direction) END IF IF id >=%LPT + 7 THEN FOR i = 0 TO 32 'show last 70 buf = buf + CHR$(@pHist[i]) NEXT CONTROL SET TEXT hDlg, 1000, buf END IF #ENDIF END SUB 'FirstGenerationMarkovChainVoice-------------------------- 'prototype for playing tasks 'called by tasks 'function, but no retval for now FUNCTION FGMCVoice(id AS LONG) AS LONG LOCAL i AS DWORD LOCAL bufferfreq AS SINGLE STATIC jump AS LONG ' IF jump THEN ' = a rest ' ForPlay task(id).channel, P(id).noot, 0, id ' jump = %false ' EXIT FUNCTION ' END IF IF P(id).noot THEN ' MSGBOX STR$(id) IF ASC(MID$(HarTOn(task(id).channel), P(id).noot,1)) THEN EXIT FUNCTION 'note is still waiting to be played new 010427 ForPlay task(id).channel, P(id).noot, 0, id ' MSGBOX STR$(task(id).channel) +STR$(id) P(id).OldNoot = P(id).noot P(id).recent(3) = P(id).recent(2) 'new 010504 P(id).recent(2) = P(id).recent(1) P(id).recent(1) = P(id).recent(0) P(id).recent(0) = P(id).noot P(id).noot =%false ' jump = %true IF P(id).done THEN EXIT FUNCTION IF CINT(P(id).hightes) = CINT(P(id).hidest) THEN 'we put this here so we're sure the task didnt leave on a note (! sure?!) IF CINT(P(id).lowtes) = CINT(P(id).lodest) THEN 'stoptask id task(id).freq = P(id).MinFreq 'we'll still have deviations, but slow P(id).done = 1 'MSGBOX STR$(id)+"is @ home",,"yp!" '<010510 new end> -- moved to bouncingvoice ' IF P(%LPT).done AND P(%LPT + 1).done AND P(%LPT + 2).done AND P(%LPT + 3).done THEN ' FOR i = 0 TO 10 ' StopTask %LPT + i ' IF i = 3 THEN i = 6 ' NEXT ' ' END IF ' END IF END IF '< new 010327 > EXIT FUNCTION ' END IF ' ELSE ' GetNote: P(id).noot = GetNewNote(id) ' IF NoteAllreadyOn(P(id).noot, id) THEN P(id).noot = %false 'if note is allready on, act as if no note was found - obsolete if we use a diff channel / voice IF P(id).noot = %false THEN P(id).oldnoot = P(id).CTes '(id) ' MSGBOX "no note "+STR$(id),,"____." EXIT FUNCTION '010503 ' P(id).noot = P(id).cTes'GetFirstNote(id) ' IF P(id).noot < CEIL(P(id).lowtes) THEN ' P(id).noot = %false 'CEIL(P(id).lowtes) 'REM 010503 ' EXIT FUNCTION ' ELSEIF P(id).noot > INT(P(id).hightes) THEN ' P(id).noot = %false 'INT(P(id).hightes) 'REM 010503 ' EXIT FUNCTION ' END IF ' IF P(id).noot = %false THEN MSGBOX "invalid ctes " + STR$(id)+ STR$(P(id).cTes) END IF ' IF NoteAllreadyOn(P(id).noot, id) THEN GOTO GetNote 'created feedback loop POKE$ pHist + 1, PEEK$(pHist, %LOH - 1) @pHist[0] = P(id).noot 'P(id).direction =( 3 * P(id).direction + P(id).noot - P(id).oldNoot ) / 4 P(id).direction = 10 * (P(id).noot - P(id).oldNoot) / (P(id).HighTes - P(id).LowTes) IF (P(id).noot >= P(id).LowTes) AND (P(id).noot <= P(id).HighTes) THEN 'MSGBOX "forplay:" + STR$(id) + STR$(task(id).channel),,"FGMCVoice" ForPlay task(id).channel,P(id).noot, P(id).velo, id ELSE MSGBOX "invalid note" + STR$(id) + CHR$(13) + STR$(P(id).lowTes) + STR$(P(id).highTes) + STR$(P(id).cTes) + STR$(P(id).noot) P(id).noot = %false END IF IF P(id).done THEN task(id).freq = P(id).MinFreq Pps3dbg id EXIT FUNCTION END IF ' END IF 'get new task freq. SELECT CASE ABS(P(id).direction) CASE > 5 bufferfreq = (task(id).freq + ABS(P(id).MaxFreq + SGN(P(id).direction)) ) / 2 'min was max CASE 3 TO 5 bufferfreq = ( 2 * task(id).freq + ABS(P(id).MaxFreq + SGN(P(id).direction)) ) / 3 'min was max CASE 1 TO 3 bufferfreq = ( 4 * task(id).freq + P(id).MaxFreq ) / 5 'CASE < 0.1 ' bufferfreq = P(id).MaxFreq 'P(id).MinFreq 'leave it CASE ELSE bufferfreq = ( 3 * task(id).freq + P(id).MinFreq) / 4 'P(id).MinFreq) / 4 END SELECT 'slow down if note has been played recently SELECT CASE P(id).noot CASE P(id).recent(3) bufferfreq = (2 * bufferfreq + P(id).MinFreq) / 3 CASE P(id).recent(2) bufferfreq = (3 * bufferfreq + P(id).MaxFreq) / 4 CASE P(id).recent(1) bufferfreq = (2 * bufferfreq + P(id).MaxFreq) / 3 CASE P(id).recent(0) 'repeat = speed up bufferfreq = (bufferfreq + P(id).MaxFreq) / 2 CASE ELSE 'speed up less bufferfreq = (4 * bufferfreq + P(id).MaxFreq) / 5 END SELECT task(id).freq = RoundFreq(bufferfreq, id) 'as we decided to use the organs for this voice, changing velo maeks no sence ' IF P(id).noot > P(id).cTes THEN ' P(id).velo = ( 7 * P(id).velo _ ' + 8 + 50! * ( P(id).noot - P(id).cTes) / (P(id).highTes - P(id).cTes)_ ' ) / 8 ' ELSEIF (P(id).noot) AND (P(id).noot < P(id).cTes) THEN ' P(id).velo = ( 7 * P(id).velo _ ' + 8 + 50! * ( P(id).cTes - P(id).noot) / (P(id).cTes - P(id).lowTes)_ ' ) / 8 ' ELSE ' noot = ctes ' P(id).velo = (5 * P(id).velo + 70) / 6 ' END IF ' IF task(id).freq < .1 THEN P(id).velo =( (3 * P(id).velo + 100) / 4 ) ' IF P(id).velo < 4 THEN P(id).velo = 4 PPS3dbg id END FUNCTION FUNCTION NoteAllReadyOn(noot AS BYTE, id AS LONG) AS LONG 'returns true if the note passed is on allready or is allready scheduled IF ( ASC(MID$(HarNOn(%LPT), noot,1)) ) OR _ ( ASC(MID$(HarNOn(%LPT + 1), noot,1)) ) OR _ ( ASC(MID$(HarNOn(%LPT + 2), noot,1)) ) OR _ ( ASC(MID$(HarNOn(%LPT + 3), noot,1)) ) THEN FUNCTION = %true EXIT FUNCTION END IF IF ( ASC(MID$(HarTOn(%LPT), noot,1)) ) OR _ ( ASC(MID$(HarTOn(%LPT + 1), noot,1)) ) OR _ ( ASC(MID$(HarTOn(%LPT + 2), noot,1)) ) OR _ ( ASC(MID$(HarTOn(%LPT + 3), noot,1)) ) THEN FUNCTION = %true EXIT FUNCTION END IF FUNCTION = %false END FUNCTION 'if corresponding (id - 7) task plays its cTes note repeat it w/ rythm and velo curve of bouncing ball 'notes are history of sum of first four voices (arr hist. ind as counter in array) FUNCTION BouncingVoice(id AS LONG) AS LONG LOCAL buffer AS BYTE LOCAL i AS LONG STATIC init AS LONG STATIC MatchTime() AS SINGLE 'time of last note matching with ctes, if too long ago, D ctesuntil ones found STATIC ind() AS LONG STATIC MyBuf AS STRING IF init P(id).highTes P(id).noot = P(id).noot - 12 LOOP MatchTime(id) = TIMER END IF IF ( (TIMER - MatchTime(id)) > (50 ) ) AND ( P(id).done = %false )THEN '60 '.5 - 1 min was 2.5-1 IF RND > .49 THEN IF P(id - 7).cTes < P(id - 7).HighTes THEN INCR P(id - 7).cTes ELSE IF P(id - 7).cTes - INT(RND * 5) > P(id - 7).LowTes THEN DECR P(id - 7).cTes END IF task(id).freq = ( 8 * task(id).freq + P(id).MaxFreq ) / 9 task(id).freq = RoundFreq(task(id).freq, id) 'stop possible sounding note IF ( P(id).noot > 0 ) AND ( ASC(MID$(HarTOn(task(id).channel), P(id).noot,1)) )THEN EXIT FUNCTION 'note is not played yet ForPlay task(id).channel, P(id).noot, 0, id 'set a new note, but do not reset velofreq or matchtime ' P(id).noot = P(id - 7).cTes 'remmed010218 END IF IF P(id - 7).noot = P(id - 7).cTes THEN buffer = P(id - 7).noot ELSEIF P(id - 7).oldNoot = P(id - 7).cTes THEN buffer = P(id - 7).oldnoot END IF IF buffer AND ( P(id).done = %false )THEN 'add several times to history POKE$ pHist + 3, PEEK$( pHist, %LOH - 3) POKE$ pHist, STRING$(3, buffer) task(id).freq = P(id).MaxFreq ' MyBuf(id) = @pHist'CHR$(buffer) ind(id)=0 '%LOH + 1 '0 'decrease range of parentvoice unless this has been done recently IF (TIMER - MatchTime(id)) > 5 THEN P(id).LowTes = ( 3 * P(id).LowTes + P(id).LoDest) / 4 P(id).HighTes = ( 3 * P(id).HighTes + P(id).HiDest) / 4 P(id - 7).LowTes = ( 3* P(id - 7).LowTes + P(id - 7).LoDest) / 4 P(id - 7).HighTes = ( 3 * P(id - 7).HighTes + P(id - 7).HiDest) / 4 IF P(id - 7).done THEN IF CINT(P(id).LowTes) = CINT(P(id).LoDest) THEN IF CINT(P(id).HighTes) = CINT(P(id).HiDest) THEN P(id).done = 1 task(id).freq = P(id).MinFreq IF P(%LPT + 7).done AND P(%LPT + 8).done AND P(%LPT + 9).done AND P(%LPT + 10).done THEN StopTask %RP FOR i = 0 TO 10 StopTask %LPT + i IF i = 3 THEN i = 6 IF P(i).noot > P(i).LowTes THEN Play task(i).channel, P(i).noot, 80 ELSE Play task(i).channel, P(i).LowTes, 80 END IF NEXT ' THREAD CREATE EndOfPiece(0) TO i SLEEP 12000 FOR i = 0 TO 15 AllNotesOff i NEXT ' mt_Stop = %true END IF END IF END IF END IF END IF IF (TIMER - MatchTime(id)) > 5 THEN MatchTime(id) = TIMER 'here we could put an end condition 'set params P(id).velo = 100 'was 50 @ 000430 'INCR ind(id) DECR ind(id) IF ind(id) >%LOH THEN ind(id) = 1 '< 2 THEN ind(id) = %LOH' ' IF ind(id) > %LOH THEN ' MyBuf(id) = @pHist 'CHR$(buffer) ' ind(id) = 1 ' END IF P(id).noot = @phist[ind(id)]'P(id - 7).cTes DO WHILE P(id).noot < P(id).lowtes P(id).noot = P(id).noot + 12 LOOP DO WHILE P(id).noot > P(id).highTes P(id).noot = P(id).noot - 12 LOOP IF P(id).noot < CEIL(P(id).lowtes) THEN 'didn't fit in octave, remap it. P(id).noot = CEIL(P(id).lowtes) ' + (P(id).lowtes - P(id).noot) * ( (P(id).highTes - P(id).LowTes) / 12! ) ELSEIF P(id).noot > INT(P(id).hightes) THEN P(id).noot = INT(P(id).hightes) '- (P(id).noot - P(id).hightes) * ( (P(id).highTes - P(id).LowTes) / 12! ) END IF ' IF RND > .49 THEN IF P(id - 7).cTes < P(id - 7).HighTes THEN INCR P(id - 7).cTes ELSE IF P(id - 7).cTes - INT(RND * 5) > P(id - 7).LowTes THEN DECR P(id - 7).cTes END IF P(id).tog = %false ' ELSEIF buffer END IF IF P(id).noot THEN 'only <> 0 when bouncing IF ASC(MID$(HarTOn(task(id).channel), P(id).noot,1)) THEN EXIT FUNCTION 'note is not played yet IF P(id).tog = 2 THEN ForPlay task(id).channel, P(id).noot, 0, id DECR P(id).tog ELSEIF P(id).tog = 1 THEN INCR ind(id) IF ind(id)>%LOH THEN ind(id) = 1 P(id).noot = @pHist[ind(id)] DO WHILE P(id).noot < P(id).lowtes P(id).noot = P(id).noot + 12 '11 'sic shift per g seventh LOOP DO WHILE P(id).noot > P(id).highTes P(id).noot = P(id).noot - 12 '11 LOOP DECR P(id).tog IF P(id).noot < CEIL(P(id).lowtes) THEN 'didn't fit in octave, remap it. P(id).noot = CEIL(P(id).lowtes) ' + (P(id).lowtes - P(id).noot) * ( (P(id).highTes - P(id).LowTes) / 12! ) ELSEIF P(id).noot > INT(P(id).hightes) THEN P(id).noot = INT(P(id).hightes) '- (P(id).noot - P(id).hightes) * ( (P(id).highTes - P(id).LowTes) / 12! ) END IF ELSE 'tog = 0 P(id).tog = 2 ForPlay task(id).channel, P(id).noot, P(id).velo, id task(id).freq = (10 * task(id).freq + P(id).minFreq) / 11 task(id).freq = roundFreq(task(id).freq, id) 'velo: first from max down, then goes back to and roughly follows playerx IF task(id).freq > (P(id).minfreq + (1/3) * (P(id).maxFreq - P(id).minFreq)) THEN 'was > 10 P(id).velo = (12 * P(id).velo + 33) / 13! '33 was 3 - maybe back to 3 on real piano. with 3 P(id).velo never dropped below 8 ELSE P(id).velo = (10 * P(id).velo + 2/3 * P(id - 7).velo) / 11 END IF END IF ELSE END IF IF P(id).done THEN task(id).freq = P(id).MinFreq pps3dbg id END FUNCTION 'Playing tasks --------------------------------------- 'PlayerX calls a MarkovChainVoice wit its own params 'params are in global type array, sub gives passes his id = tasknr = index in type SUB Player1 STATIC id AS LONG LOCAL i AS LONG 'PIPEROLA IF ISFALSE id THEN id = %LPT P(id).LowTes = 54 '50'65 P(id).HighTes = 78 '70'90 P(id).CTes = 77 '69 '58' 84 P(id).lodest = 87 '105 '92 P(id).hidest = 91 '108 '98 P(id).velo = 127 '90 P(id).minfreq = .23 '0.005 P(id).maxfreq = .5'.2 '1 '3 '6'11 ProgChange task(id).channel, task(id).patch END IF FGMCVoice(id) END SUB SUB Player2 'PIPEROLA STATIC id AS LONG LOCAL i AS LONG 'MSGBOX "player2" IF ISFALSE id THEN id = %LPT + 1 P(id).LowTes = 48'58 P(id).HighTes =72'82 P(id).CTes = 67 '66 '51 '59'69 P(id).lodest = 70 '92 '78 P(id).hidest = 74 '95 P(id).velo = 127 '90 P(id).minfreq = 0.18 '0.006 P(id).maxfreq = .29 '1 '2.3 '7'11 ProgChange task(id).channel, task(id).patch END IF FGMCVoice(id) END SUB SUB Player3 'HUMANOLA STATIC id AS LONG LOCAL i AS LONG IF ISFALSE id THEN id = %LPT + 2 P(id).LowTes = 48'37 '20 40 61 80 102 P(id).HighTes = 72'62 '20 - 43 , 33 - 55 , 65 - 89, 79 - 102 P(id).CTes = 56 '68 '60'49 P(id).lodest = 52 '79 '66 P(id).hidest = 56 '82 '72 P(id).velo = 127 '90 P(id).minfreq = 0.22 '0.007 P(id).maxfreq = .38 '1 '2.6 '8'11 ProgChange task(id).channel, task(id).patch END IF FGMCVoice(id) END SUB SUB Player4 STATIC id AS LONG 'HUMANOLA / /+ BOURDON LOCAL i AS LONG IF ISFALSE id THEN id = %LPT + 3 P(id).LowTes = 44'24 P(id).HighTes = 64'70'49 P(id).lodest = 36 '69 '52 P(id).hidest = 41 '58 P(id).CTes = 57 '60 '62'30 P(id).velo = 127 '100 P(id).minfreq = 0.16 '0.008 P(id).maxfreq = .27 '1 '3 '9'11 ProgChange task(id).channel, task(id).patch END IF FGMCVoice(id) END SUB 'additional playing tasks---------------------------------- SUB Bounce1 STATIC id AS LONG IF ISFALSE id THEN 'PLAYERPIANO id = %LPT + 7 P(id).LowTes = 45 '50 '75 P(id).HighTes =65 '70'90 P(id).lodest = 96 '58 P(id).hidest = 100 '61 P(id).velo = 80 P(id).minfreq = 0.01 '0.5 '1.5 '3 '1'0.5 '0.1 '!! spelen maar om de drie stappen P(id).maxfreq = 5 '35 END IF BouncingVoice(id) END SUB SUB Bounce2 STATIC id AS LONG IF ISFALSE id THEN id = %LPT + 8 P(id).LowTes = 50'57 P(id).HighTes = 70'82 P(id).lodest = 71 '47 P(id).hidest = 74 '50 P(id).velo = 80 P(id).minfreq = 0.02 '0.45 '1.45 '2.95 '1'0.505 '0.1 P(id).maxfreq = 5 '40 'sic END IF BouncingVoice(id) END SUB SUB Bounce3 STATIC id AS LONG IF ISFALSE id THEN id = %LPT + 9 P(id).LowTes = 50'32 P(id).HighTes = 70'57 P(id).lodest = 46 '34 P(id).hidest = 49 '37 P(id).velo = 80 P(id).minfreq = 0.03 '0.4 '1.4 '2.9 '1'0.51'0.1 P(id).maxfreq = 5 '35 END IF BouncingVoice(id) END SUB SUB Bounce4 STATIC id AS LONG IF ISFALSE id THEN id = %LPT + 10 P(id).LowTes = 50'20 P(id).HighTes = 70'45 P(id).lodest = 24 '22 P(id).hidest = 27 '25 P(id).velo = 80 P(id).minfreq = 0.04 '0.35 '1.35 '2.8 '1'0.515 '0.05 'sic P(id).maxfreq = 5 '35 END IF BouncingVoice(id) END SUB 'note retrieveing functions--------------------------------- FUNCTION GetFirstNote(BYVAL id AS LONG) AS BYTE 'returns random note in range out of sequence LOCAL j AS DWORD LOCAL i AS DWORD LOCAL s AS DWORD LOCAL noot AS BYTE LOCAL hfile AS LONG OPEN "c:\windows\desktop\pps3.log" FOR APPEND AS hfile WRITE# hfile, "new session-----------------------------", id ' IF LowTes > HighTes THEN SWAP LowTes, HighTes WRITE# hfile, "lowtes, hightes", P(id).lowtes; P(id).hightes s = CEIL(RND * UBOUND(H)) 'min 1 j = s DO INCR j IF j > UBOUND(h) THEN j = LBOUND(h) IF s = j THEN FUNCTION = %false WRITE# hfile, "failed" CLOSE hfile EXIT FUNCTION END IF END IF WRITE# hfile, "j="; j FOR i = P(id).LowTes TO P(id).Hightes WRITE# hfile, "t";i IF ASC(MID$(H(j).vel,i, 1)) > 0 THEN noot = i WRITE# hfile, "found";noot ' MSGBOX "found "+STR$(noot) 'close hfile ' Play task(id).channel,noot, velo EXIT FOR END IF NEXT LOOP WHILE ISFALSE noot FUNCTION = noot CLOSE hfile END FUNCTION FUNCTION GetNewNote(BYVAL id AS DWORD) AS BYTE 'gives new note 'derived in markov-chain-alike way from chord sequence 'id is number of requesting task LOCAL i AS DWORD LOCAL j AS BYTE LOCAL nr AS DWORD LOCAL buf AS BYTE LOCAL Ho AS BYTE, L AS BYTE ' LOCAL hfile AS LONG DIM NoteArr(1 TO 127) AS LOCAL SINGLE DIM ValidArr(1 TO 127) AS LOCAL SINGLE DIM me(1 TO 127) AS LOCAL SINGLE L = CEIL(P(id).lowtes) Ho = FIX(P(id).hightes) IF Ho < L THEN SWAP Ho, L FOR i = 0 TO UBOUND(H) - 1 IF ASC(MID$(H(i).vel, P(id).OldNoot, 1)) > 0 THEN FOR j = L TO Ho'1 TO 127 buf = ASC(MID$(H(i+1).vel, j, 1)) IF buf THEN '(buf >= L)AND (buf <= Ho) THEN INCR NoteArr(j) '= NoteArr(j) + 1 END IF NEXT END IF NEXT FOR j = 1 TO 127 me(j) = j NEXT ARRAY SORT NoteArr() ,TAGARRAY me(), DESCEND FOR j = 1 TO 127 IF NoteArr(j) > 0 THEN INCR nr ValidArr(nr) = me(j) END IF NEXT IF ISFALSE nr THEN ' MSGBOX "no note found!" 'we add the note somewhere to avoid recursive loops AddNote2Har H(INT(RND * UBOUND(H))),P(id).OldNoot,P(id).velo FUNCTION = %false EXIT FUNCTION END IF ' ARRAY SORT ValidArr(), DESCEND 'most chance = lowest in array = most chance to be chosen FOR j = 1 TO nr - 1 IF RND > .333 THEN '.5 010503 FUNCTION = ValidArr(j) EXIT FUNCTION END IF NEXT FUNCTION = ValidArr(nr) END FUNCTION SUB ForPlay(BYVAL ch AS BYTE ,BYVAL note AS BYTE, BYVAL velo AS BYTE, BYVAL id AS BYTE) LOCAL i AS LONG, j AS LONG STATIC init AS LONG DIM OwnOff(0 TO 4) AS STATIC STRING * 127 IF ISFALSE init THEN FOR j = 0 TO 4 HarNon(j) = STRING$(128, CHR$(0)) HarTon(j) = STRING$(128, CHR$(0)) HarTof(j) = STRING$(128, CHR$(0)) NEXT init =%true END IF ' MSGBOX STR$(note) + STR$(velo),,"forplay" IF ch >0 THEN velo = 1 + velo/2 '@!!!VOORLOOPIGE rescaling!! IF ch > 4 THEN MSGBOX "unexpected channel ",,"ERR in module ForPlay" 'so we can extend to more channels later on IF note > 108 THEN MSGBOX "note = "+STR$(note),,"ERR in module ForPlay" IF ASC(MID$(HarTOn(ch),128,1)) THEN MSGBOX "highest note on: " + STR$(ASC(MID$(HarTOn(ch),128,1))),,"ERR in module ForPlay" IF ISFALSE velo THEN MID$(HarTOf(ch), note) = "y" MID$(HarTOn(ch), note, 1) = CHR$(0) '"y" new 010427 FOR i = 0 TO 127 FOR j = 0 TO 4 IF ASC(MID$(OwnOff(j),i)) THEN MID$(HarTOf(j),i) = "Y" NEXT NEXT ELSE IF ASC(MID$(HarTOn(ch), note, 1)) > 0 OR ASC(MID$(HarNOn(ch), note,1)) > 0 THEN ' Play 0, note, velo ' MID$(HarTon, note, 1) = CHR$(0) MID$(HarTOf(ch), note,1) = "Y" IF (ASC(MID$(HarTOn(ch), note + 12, 1)) > 0) OR (ASC(MID$(HarNOn(ch), note + 12,1)) > 0) THEN IF (ASC(MID$(HarTOn(ch), note - 12, 1)) = 0) AND ASC(MID$(HarNOn(ch), note - 12, 1)) > 0 AND (note > 35) THEN IF (note - 12 >=P(id).lowtes) AND (note - 12 <= P(id).hightes) THEN Play 0, note - 12 - 1, velo MID$(HarTOf(ch), note - 12) = CHR$(Velo) END IF END IF ELSEIF (ASC(MID$(HarTOn(ch), note)) + 12 > 0) AND (ASC(MID$(HarNOn(ch), note + 12)) > 0) AND note < 85 THEN IF (note - 12 >=P(id).lowtes) AND (note - 12 <= P(id).hightes) THEN Play 0, note - 12 - 1, velo MID$(HarTOf(ch), note - 12) = CHR$(Velo) END IF END IF ELSE MID$(HarTOn(ch), note,1) = CHR$(velo) END IF END IF END SUB SUB RealPleier LOCAL i AS LONG, j AS LONG LOCAL cAkts AS LONG 'counte of acts for one sub call LOCAL velo AS LONG STATIC buffer AS SINGLE STATIC this AS LONG STATIC hld AS BYTE STATIC count AS DWORD IF ISFALSE this THEN hld = 3 this = %RP buffer = task(this).freq END IF 'percussion > becomes organ's perc INCR count SELECT CASE count MOD 7 CASE 0 Play 9, 64, 0 Play 9, 58, 64 CASE 1 Play 9, 58, 0 Play 9, 59, 64 CASE 2 Play 9, 59, 0 Play 9, 60, 64 CASE 3 Play 9, 60, 0 Play 9, 61, 64 CASE 4 Play 9, 61, 0 Play 9, 62, 64 CASE 5 Play 9, 62, 0 Play 9, 63, 64 CASE 6 Play 9, 63, 0 Play 9, 64, 64 END SELECT IF ISFALSE count OR ISFALSE ( count MOD 11 ) THEN Play 9, 54, 64 ELSEIF (count MOD 9) = 1 THEN Play 9, 54, 0 END IF IF (count = 1) OR ISFALSE (count MOD 13) THEN Play 9, 55, 64 ELSEIF (count = 2) OR (count MOD 15) = 1 THEN Play 9, 55, 0 END IF IF (count = 2) OR ISFALSE (count MOD 17) THEN Play 9, 56, 64 ELSEIF (count = 3) OR (count MOD 19) = 1 THEN Play 9, 56, 0 END IF IF (count = 3) OR ISFALSE (count MOD 21) THEN Play 9, 57, 64 ELSEIF (count = 4) OR (count MOD 23) = 1 THEN Play 9, 57, 0 END IF IF (count = 4) OR ISFALSE (count MOD 25) THEN Play 9, 50, 80 ELSEIF (count = 5) OR (count MOD 27) = 1 THEN Play 9,50,0 END IF IF (count = 5) OR ISFALSE (count MOD 31) THEN Play 9, 40, 100 ELSEIF (count = 6) OR (count MOD 34) = 1 THEN Play 9,40,0 END IF IF (count = 6) OR ISFALSE (count MOD 37) THEN Play 9, 39, 100 ELSEIF (count = 7) OR (count MOD 41) = 1 THEN Play 9,39,0 END IF IF (count = 7) OR ISFALSE (count MOD 43) THEN Play 9, 38, 100 ELSEIF (count = 8) OR (count MOD 47) = 1 THEN Play 9,38,0 END IF ' buffer = 1 'for safety ' CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 11, STR$(task(this).freq) FOR j = 0 TO 4 FOR i = 20 TO 120 '1 TO 127 velo = ASC(MID$(HarTOn(j), i, 1)) IF velo THEN Play j, i - 1, velo INCR cakts MID$(HarTOn(j), i,1) = CHR$(0) MID$(HarNOn(j), i,1) = CHR$(velo) IF ISFALSE (task(this + 1).pan) THEN task(this + 1).pan = 1 END IF 'important: note off check should come after note on, as if a note-submitting task is faster then this one 'we might receive on & of at the same time IF ASC(MID$(HarTOf(j), i,1))THEN Play j,i - 1, 0 '-1 = kruft, for co;patibility with playhar. who's wrong?? INCR cAkts MID$(HarTOf(j), i,1) = CHR$(0) MID$(HarNOn(j), i,1) = CHR$(0) END IF NEXT NEXT IF cAkts < 2 THEN '< 2 was isfalse buffer = buffer * .75 ' / 2 ' ELSEIF cAkts < 4 THEN 'do nothing ELSE buffer = (20 * buffer + 6 * cAkts) / 21 '6 was 5 was 4 END IF IF (buffer > 14) THEN buffer = .15 + INT(RND * hld) / 112 IF hld < 56 THEN INCR hld END IF IF ABS(12 - buffer) < .2 THEN buffer = 12 ELSEIF ABS(10 - buffer) < .2 THEN buffer = 10 ELSEIF ABS(8 - buffer) < .15 THEN buffer = 8 ELSEIF ABS(6 - buffer) < .1 THEN buffer = 6 END IF '<000511 add metrikz> IF buffer < .18 THEN buffer = .18 IF buffer < 2 THEN task(this).freq =INT(buffer * 6) / 6 ELSEIF buffer < 4 THEN task(this).freq = INT(buffer * 3) / 3 ELSE task(this).freq = INT(buffer * 2) / 2 END IF ' 'task(this).freq = buffer CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 12, STR$(task(this).freq) CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 13, STR$(buffer) END SUB SUB sensuur 'avoids conconants by transposing them w/ 1,2, 6 ans playing back ther result 'switched pon by realpleier, checks, next time plays normal har again so wrong notes are put off STATIC this AS LONG LOCAL i AS LONG LOCAL buffer AS SINGLE STATIC myH AS HarmType LOCAL bufH AS HarmType STATIC t AS INTEGER 'transpos ' STATIC tog AS LONG IF ISFALSE this THEN this = %RP + 1 t = -6 END IF ' FOR i = %LPT TO %LPT + 3 buffer = buffer + task(i).freq NEXT buffer = buffer '/2 ' /4 for average, * 2 for step-toggle task(this).freq = (4 * task(this).freq + buffer) / 5 CONTROL SET TEXT gh.Cockpit, %GMT_TEXT0_ID + 12, STR$(task(this).freq) ' myH.vel = HarNOn(1) 'alleen orgel , was 0: alleen piano sensureren @010501 FillHarType myH 'thisone seems to be wrong!! bufH.vel = HarNon(0) FillHarType bufH bufH.vel = SumHar(bufH, myH) FillHarType bufH ShowHar bufH,1,140,1 ' PlayHar myH, task(this).channel 'should put of our own notes as they are not in HarNon,= not taken in account for other algo ' ' EXIT SUB ' IF ISFALSE task(this).pan THEN 'tog = %false 'StopTask this EXIT SUB ELSEIF task(this).pan = 2 THEN myH.vel = STRING$(128,CHR$(0)) 'REMmed 010501 PlayHar myH, task(this).channel ShowHar myH,1,280,1 task(this).pan = %false EXIT SUB ELSEIF task(this).pan = 1 THEN INCR task(this).pan EXIT SUB ELSE ' task(this).pan = 2 'tog = %true END IF CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 10, STR$(bufH.Kon) CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 11, STR$(bufH.Dis) ' ' EXIT SUB ' IF (bufH.dis < .1) AND (bufH.dis > 0.0) THEN 'was myH.kon > .3 ' IF MyH.Dis < .1 THEN ' MSGBOX "ja hoor",,"sensuur" ' warning "sensured" + STR$(myH.Kon) + CHR$(13)+ " " + CHR$(13), 500 TransHarm myH, -t ' ConvergeHar myH, 64, 0.5 FillHarType myH ' MSGBOX myH.vel PlayHar myH, task(this).channel ShowHar myH,1,280,1 SELECT CASE t CASE -1 t = 1 CASE 1 t = -2 CASE -2 t = 2 CASE 2 t = - 6 CASE -6 t = - 1 END SELECT task(this).pan = 1 END IF END SUB SUB WriteMyFile() LOCAL i AS LONG LOCAL j AS LONG LOCAL f AS LONG f = FREEFILE OPEN "pps3.seq" FOR OUTPUT AS f FOR i = LBOUND(H) TO UBOUND(H) IF PARSECOUNT(H(i).Vel, CHR$(34)) THEN ' FOR j = 1 TO 128 ' IF MID$(H(i).Vel,j,1) = CHR$(34) THEN ' MID$(H(i).Vel,j,1) = CHR$(35) ' END IF ' NEXT END IF WRITE #f,0 ;10 + i*50; "H"; H(i).Vel 'Harm(n).Vel NEXT CLOSE f END SUB FUNCTION CN2F! (noot!) 'geeft ander resultaat dan gmts nf2f!!? FUNCTION = (GrondDo * (2 ^ (noot! / 12!))) 'GrondDo is juist END FUNCTION FUNCTION F2CN! (f!) IF f! < 1 THEN F2CN! = 0: EXIT FUNCTION FUNCTION = (12 * (LOG(f!) - LOG(GrondDo)) / (LOG(2))) END FUNCTION SUB InitChordSeQuence () LOCAL i AS SINGLE, j AS DWORD, n AS BYTE DIM theme(1 TO 17) AS LOCAL BYTE LOCAL dummy$ GOTO currenttheme theme(0) = 0: theme(1) = 0: Theme(2) = 1: theme(3) = -1: theme(4) = 0:theme(5) = 3: theme(6) = 1:theme(7) = 1: theme(8) = - 2:theme(9) = -2:theme(10) = -3:theme(11) = -1 theme(12) = 3:theme(13) = - 3 :theme(14) = -2:theme(15) = 0: theme(16) = 2:theme(17) = - 3 ' currenttheme: theme(0) = 0: theme(1) = 0: Theme(2) = 1: theme(3) = -1: theme(4) = -3:theme(5) = -5: theme(6) = 7:theme(7) = 5: theme(8) = 4:theme(9) = 1:theme(10) = -1:theme(11) = 0 theme(12) = -2:theme(13) = - 4 :theme(14) = -6:theme(15) = -5: theme(16) = -5:theme(17) = - 2 ' currenttheme: theme(0) = 0: theme(1) = -2: Theme(2) = -4: theme(3) = 6: theme(4) = 4:theme(5) = 2: theme(6) = 2:theme(7) = 2: theme(8) = 0:theme(9) = -2:theme(10) = -2:theme(11) = -4 theme(12) = 6:theme(13) = 4 :theme(14) = 2:theme(15) = 1: theme(16) = 0:theme(17) = - 1 ' currenttheme: theme(0) = 0: theme(1) = 2: Theme(2) = 1: theme(3) = 3: theme(4) = 0:theme(5) = 1: theme(6) = 4:theme(7) = 1: theme(8) = 5:theme(9) = 0:theme(10) = 5:theme(11) = 1 theme(12) = 0:theme(13) = 4 :theme(14) = 0:theme(15) = 6: theme(16) = 1:theme(17) = 0 ' currenttheme: theme(0) = 0: theme(1) = 1: Theme(2) = 3: theme(3) = 6: theme(4) = -2:theme(5) = 3: theme(6) = -3:theme(7) = 4: theme(8) = 0:theme(9) = -3:theme(10) = -5:theme(11) = 6 theme(12) = 0:theme(13) =-1 :theme(14) = 2:theme(15) = -4: theme(16) = 5:theme(17) = 0 FOR i = 20 TO 112 STEP (112 - 20) / 10 '13 FOR j = 1 TO 17 AddNote2Har H(j), i + theme(j), 100 NEXT NEXT currenttheme: ' 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 'bassline [36 - 39]:36 40 39 38 40 37 41 36 38 40 39 37 36 41 39 36 38 i = 36 j = 1 DO 'fill harm with overtone series... n = INT(f2cn(cn2f(i) * j)) 'MSGBOX "n=" + STR$(n) + CHR$(13) + "f = " + STR$(nf2f(i)) + CHR$(13) + "seed = " + STR$(i),,"1" IF n => 127 THEN EXIT DO AddNote2Har H(1),n,100 ' AddNote2Har H(2), n , 100 AddNote2Har H(8), n , 100 AddNote2Har H(13), n , 100 AddNote2Har H(16), n , 100 INCR j LOOP i = 37 j = 1 DO 'fill harm with overtone series... n = INT(f2cn(cn2f(i) * j)) IF n >= 127 THEN EXIT DO AddNote2Har H(6),n,100 AddNote2Har H(12), n , 100 INCR j LOOP i = 38 j = 1 DO 'fill harm with overtone series... n = INT(f2cn(cn2f(i) * j)) IF n >= 127 THEN EXIT DO AddNote2Har H(5),n,100 ' AddNote2Har H(7), n , 100 AddNote2Har H(10),n,100 ' AddNote2Har H(14), n , 100 AddNote2Har H(17), n , 100 INCR j LOOP i = 39 j = 1 DO 'fill harm with overtone series... n = INT(f2cn(cn2f(i) * j)) IF n >= 127 THEN EXIT DO AddNote2Har H(3),n,100 ' AddNote2Har H(4), n , 100 ' AddNote2Har H(6),n,100 AddNote2Har H(11), n , 100 AddNote2Har H(15), n , 100 INCR j LOOP i = 40 j = 1 DO 'fill harm with overtone series... n = INT(f2cn(cn2f(i) * j)) IF n >= 127 THEN EXIT DO AddNote2Har H(2),n,100 AddNote2Har H(4), n , 100 AddNote2Har H(9),n,100 ' AddNote2Har H(11), n , 100 ' AddNote2Har H(15), n , 100 INCR j LOOP i = 41 j = 1 DO n = INT(f2cn(cn2f(i) * j )) IF n >= 127 THEN EXIT DO AddNote2Har H(7), n , 100 AddNote2Har H(14), n , 100 INCR j LOOP EXIT SUB 'usedtobe @ 010228 AddNote2Har H(1), 22, 100 :AddNote2Har H(1), 27, 100 :AddNote2Har H(1), 34, 100 AddNote2Har H(2), 22, 100 :AddNote2Har H(2), 34, 100 :AddNote2Har H(2), 42, 100 AddNote2Har H(3), 33, 100 :AddNote2Har H(3), 30, 100 :AddNote2Har H(3), 43, 100 AddNote2Har H(4), 22, 100 :AddNote2Har H(4), 27, 100 :AddNote2Har H(4), 35, 100 AddNote2Har H(5), 32, 100 :AddNote2Har H(5), 28, 100 :AddNote2Har H(5), 41, 100 AddNote2Har H(6), 25, 100 :AddNote2Har H(6), 34, 100 :AddNote2Har H(6), 42, 100 AddNote2Har H(7), 23, 100 :AddNote2Har H(7), 41, 100 :AddNote2Har H(7), 36, 100 AddNote2Har H(8), 33, 100 :AddNote2Har H(8), 37, 100 :AddNote2Har H(8), 40, 100 AddNote2Har H(9), 24, 100 :AddNote2Har H(9), 37, 100 :AddNote2Har H(9), 41, 100 AddNote2Har H(10), 23, 100 :AddNote2Har H(10), 37, 100 :AddNote2Har H(10), 38, 100 AddNote2Har H(11), 27, 100 :AddNote2Har H(11), 34, 100 :AddNote2Har H(11), 43, 100 AddNote2Har H(12), 26, 100 :AddNote2Har H(12), 33, 100 :AddNote2Har H(12), 35, 100 AddNote2Har H(13), 25, 100 :AddNote2Har H(13), 28, 100 :AddNote2Har H(13), 39, 100 AddNote2Har H(14), 25, 100 :AddNote2Har H(14), 31, 100 :AddNote2Har H(14), 39, 100 AddNote2Har H(15), 24, 100 :AddNote2Har H(15), 29, 100 :AddNote2Har H(15), 36, 100 AddNote2Har H(16), 28, 100 :AddNote2Har H(16), 30, 100 :AddNote2Har H(16), 40, 100 AddNote2Har H(17), 26, 100 :AddNote2Har H(17), 29, 100 :AddNote2Har H(17), 35, 100 AddNote2Har H(1),43 , 100 :AddNote2Har H(1),54 , 100 :AddNote2Har H(1),62 , 100 AddNote2Har H(2),47 , 100 :AddNote2Har H(2),58 , 100 :AddNote2Har H(2),59 , 100 AddNote2Har H(3),47 , 100 :AddNote2Har H(3),56 , 100 :AddNote2Har H(3),60 , 100 AddNote2Har H(4),46 , 100 :AddNote2Har H(4),55 , 100 :AddNote2Har H(4),60 , 100 AddNote2Har H(5),44 , 100 :AddNote2Har H(5),51 , 100 :AddNote2Har H(5),64 , 100 AddNote2Har H(6),47 , 100 :AddNote2Har H(6),53 , 100 :AddNote2Har H(6),67 , 100 AddNote2Har H(7),47 , 100 :AddNote2Har H(7),55 , 100 :AddNote2Har H(7),61 , 100 AddNote2Har H(8),45 , 100 :AddNote2Har H(8),56 , 100 :AddNote2Har H(8),61 , 100 AddNote2Har H(9),45 , 100 :AddNote2Har H(9),52 , 100 :AddNote2Har H(9),67 , 100 AddNote2Har H(10),50 , 100 :AddNote2Har H(10),52 , 100 :AddNote2Har H(10),66 , 100 AddNote2Har H(11),50 , 100 :AddNote2Har H(11),52 , 100 :AddNote2Har H(11),66 , 100 AddNote2Har H(12),44 , 100 :AddNote2Har H(12),56 , 100 :AddNote2Har H(12),68 , 100 AddNote2Har H(13),47 , 100 :AddNote2Har H(13),54 , 100 :AddNote2Har H(13),65 , 100 AddNote2Har H(14),51 , 100 :AddNote2Har H(14),55 , 100 :AddNote2Har H(14),65 , 100 AddNote2Har H(15),49 , 100 :AddNote2Har H(15),50 , 100 :AddNote2Har H(15),64 , 100 AddNote2Har H(16),47 , 100 :AddNote2Har H(16),59 , 100 :AddNote2Har H(16),63 , 100 AddNote2Har H(17),47 , 100 :AddNote2Har H(17),57 , 100 :AddNote2Har H(17),63 , 100 AddNote2Har H(1),75 , 100 :AddNote2Har H(1),76 , 100 :AddNote2Har H(1),87 , 100 AddNote2Har H(2),75 , 100 :AddNote2Har H(2),81 , 100 :AddNote2Har H(2),88 , 100 AddNote2Har H(3),73 , 100 :AddNote2Har H(3),77 , 100 :AddNote2Har H(3),90 , 100 AddNote2Har H(4),72 , 100 :AddNote2Har H(4),79 , 100 :AddNote2Har H(4),91 , 100 AddNote2Har H(5),74 , 100 :AddNote2Har H(5),83 , 100 :AddNote2Har H(5),89 , 100 AddNote2Har H(6),69 , 100 :AddNote2Har H(6),82 , 100 :AddNote2Har H(6),84 , 100 AddNote2Har H(7),73 , 100 :AddNote2Har H(7),83 , 100 :AddNote2Har H(7),92 , 100 AddNote2Har H(8),68 , 100 :AddNote2Har H(8),81 , 100 :AddNote2Har H(8),92 , 100 AddNote2Har H(9),71 , 100 :AddNote2Har H(9),79 , 100 :AddNote2Har H(9),78 , 100 AddNote2Har H(10),71 , 100 :AddNote2Har H(10),80 , 100 :AddNote2Har H(10),89 , 100 AddNote2Har H(11),70 , 100 :AddNote2Har H(11),84 , 100 :AddNote2Har H(11),88 , 100 AddNote2Har H(12),70 , 100 :AddNote2Har H(12),87 , 100 :AddNote2Har H(12),90 , 100 AddNote2Har H(13),72 , 100 :AddNote2Har H(13),85 , 100 :AddNote2Har H(13),91 , 100 AddNote2Har H(14),77 , 100 :AddNote2Har H(14),86 , 100 :AddNote2Har H(14),93 , 100 AddNote2Har H(15),74 , 100 :AddNote2Har H(15),80 , 100 :AddNote2Har H(15),82 , 100 AddNote2Har H(16),78 , 100 :AddNote2Har H(16),82 , 100 :AddNote2Har H(16),86 , 100 AddNote2Har H(17),76 , 100 :AddNote2Har H(17),91 , 100 :AddNote2Har H(17),85 , 100 AddNote2Har H(1),93 , 100 :AddNote2Har H(1),104 , 100 :AddNote2Har H(1),107 , 100 AddNote2Har H(2),95 , 100 :AddNote2Har H(2),120 , 100 :AddNote2Har H(2),107 , 100 AddNote2Har H(3),97 , 100 :AddNote2Har H(3),110 , 100 :AddNote2Har H(3),108 , 100 AddNote2Har H(4),99 , 100 :AddNote2Har H(4),105 , 100 :AddNote2Har H(4),108 , 100 AddNote2Har H(5),100 , 100 :AddNote2Har H(5),103 , 100 :AddNote2Har H(5),108 , 100 AddNote2Har H(6),101 , 100 :AddNote2Har H(6),119 , 100 :AddNote2Har H(6),88 , 100 AddNote2Har H(7),96 , 100 :AddNote2Har H(7),101 , 100 :AddNote2Har H(7),108 , 100 AddNote2Har H(8),98 , 100 :AddNote2Har H(8),102 , 100 :AddNote2Har H(8),106 , 100 AddNote2Har H(9),94 , 100 :AddNote2Har H(9),103 , 100 :AddNote2Har H(9),106 , 100 AddNote2Har H(10),97 , 100 :AddNote2Har H(10),103 , 100 :AddNote2Har H(10),116 , 100 AddNote2Har H(11),100 , 100 :AddNote2Har H(11),104 , 100 :AddNote2Har H(11),99 , 100 AddNote2Har H(12),103 , 100 :AddNote2Har H(12),105 , 100 :AddNote2Har H(12),99 , 100 AddNote2Har H(13),102 , 100 :AddNote2Har H(13),110 , 100 :AddNote2Har H(13),99 , 100 AddNote2Har H(14),99 , 100 :AddNote2Har H(14),106 , 100 :AddNote2Har H(14),93 , 100 AddNote2Har H(15),98 , 100 :AddNote2Har H(15),106 , 100 :AddNote2Har H(15),93 , 100 AddNote2Har H(16),95 , 100 :AddNote2Har H(16),106 , 100 :AddNote2Har H(16),75 , 100 AddNote2Har H(17),96 , 100 :AddNote2Har H(17),107 , 100 :AddNote2Har H(17),75 , 100 AddNote2Har H(1),90 , 100 ':AddNote2Har H(1), , 100 :AddNote2Har H(1), , 100 AddNote2Har H(2),90 , 100 ':AddNote2Har H(2), , 100 :AddNote2Har H(1), , 100 AddNote2Har H(3),90 , 100 ':AddNote2Har H(3), , 100 :AddNote2Har H(1), , 100 AddNote2Har H(4),80 , 100 ':AddNote2Har H(4), , 100 :AddNote2Har H(1), , 100 AddNote2Har H(5),80 , 100 ':AddNote2Har H(5), , 100 :AddNote2Har H(1), , 100 AddNote2Har H(6),81 , 100 ':AddNote2Har H(6), , 100 :AddNote2Har H(1), , 100 AddNote2Har H(7),80 , 100 ':AddNote2Har H(7), , 100 :AddNote2Har H(1), , 100 AddNote2Har H(8),84 , 100 ':AddNote2Har H(8), , 100 :AddNote2Har H(1), , 100 AddNote2Har H(9),84 , 100 ':AddNote2Har H(9), , 100 :AddNote2Har H(1), , 100 AddNote2Har H(10),81 , 100 ':AddNote2Har H(10), , 100 :AddNote2Har H(1), , 100 AddNote2Har H(11),84 , 100 ':AddNote2Har H(11), , 100 :AddNote2Har H(1), , 100 AddNote2Har H(12),98 , 100 ':AddNote2Har H(12), , 100 :AddNote2Har H(1), , 100 AddNote2Har H(13),98 , 100 ':AddNote2Har H(13), , 100 :AddNote2Har H(1), , 100 AddNote2Har H(14),98 , 100 ':AddNote2Har H(14), , 100 :AddNote2Har H(1), , 100 AddNote2Har H(15),101 , 100 ':AddNote2Har H(15), , 100 :AddNote2Har H(1), , 100 AddNote2Har H(16),98 , 100 ':AddNote2Har H(16), , 100 :AddNote2Har H(1), , 100 AddNote2Har H(17),90 , 100 ':AddNote2Har H(17), , 100 :AddNote2Har H(1), , 100 'REDIM PRESERVE H(0 TO 12) EXIT SUB 'usd to be this: AddNote2Har H(1),22,100 AddNote2Har H(1),23,100 AddNote2Har H(1),25,100 AddNote2Har H(1),28,100 AddNote2Har H(1),60,100 AddNote2Har H(1),74,80 AddNote2Har H(1),76,90 AddNote2Har H(1),61,100 AddNote2Har H(1),75,80 AddNote2Har H(1),88,100 AddNote2Har H(1),49,80 ComPuteArc 1,%nrChords - 1,"CYCLE" FOR i = LBOUND(H) TO UBOUND(H) FillHarType H(i) ' MSGBOX STR$(i) + " " + H(i).vel + " _ " NEXT '' FOR i = %lowestnote TO %highestnote STEP 11 '' AddNote2Har H(1), i, 100 '' NEXT '' i = 1 ' FOR i = 0 TO %nrChords STEP 2 ' ' MSGBOX STR$(i) ' dummy="" ' FOR j = 20 TO 102 STEP 1 + i ' AddNote2Har H(i), j, 100 ' AddNote2Har H(i + %nrChords / 2), j, 100 ' dummy = dummy + STR$(j) ' NEXT ' FillHarType H(i) ' ' MSGBOX dummy ' FillHarType H(i + %nrChords / 2) ' H(i + 1).vel = SolveHar (H(i),-1, 0) ' FillHarType H(i + 1) ' NEXT WriteMyFile ' FOR i = LBOUND(H) TO UBOUND(H) ' FillHarType H(i) ' MSGBOX STR$(i) + " " + H(i).vel + " _ " ' NEXT END SUB FUNCTION ComputeArc(ArcStart AS DWORD, ArcLength AS DWORD, bg$) AS DWORD LOCAL ArcEnd AS DWORD LOCAL MetaCt AS DWORD LOCAL HMetaCt AS DWORD LOCAL LocalCt AS DWORD LOCAL mode AS DWORD LOCAL i AS LONG ArcEnd = ArcStart + ArcLength H(ArcEnd).vel = SolveHar$( H(ArcStart), %tonalcenter, .1 ) MetaCt = 2 HMetaCt = 1 bg$ = UCASE$(TRIM$(bg$)) SELECT CASE bg$ CASE "R", "RANDOM" mode = 1 CASE "C", "CYCLE" mode = 2 bg$ = "U" END SELECT FOR i = 0 TO ArcLength H(i).vel = STRING$(128, 1) NEXT DO IF ArcLength < MetaCt THEN EXIT LOOP 'MSGBOX STR$(ArcLength) + CHR$(13) + STR$(MetaCt) FOR LocalCt = 1 TO MetaCt - 1 STEP 2 SELECT CASE mode CASE 1 SELECT CASE RND CASE < .33 Bg$ = "U" CASE < .66 Bg$ = "D" CASE ELSE Bg$ = "=" END SELECT CASE 2 SELECT CASE bg$ CASE "U" bg$ = "D" CASE "D" bg$ = "=" CASE "=" bg$ = "U" END SELECT END SELECT SELECT CASE bg$ CASE "+", "UP", "U" H(ArcStart + LocalCt * ArcLength / MetaCt).vel =_ InBetWeenHarUp$(_ H(ArcStart + (LocalCt - 1) * ArcLength / MetaCt ),_ H(ArcStart + (LocalCt + 1)* ARcLength / MetaCt)_ ) CASE "-","DOWN", "D" H(ArcStart + LocalCt * ArcLength / MetaCt).vel =_ InBetWeenHarDown$(_ H(ArcStart + (LocalCt - 1) * ArcLength / MetaCt ),_ H(ArcStart + (LocalCt + 1)* ARcLength / MetaCt)_ ) CASE ELSE H(ArcStart + LocalCt * ArcLength / MetaCt).vel =_ InBetWeenHar$(_ H(ArcStart + (LocalCt - 1) * ArcLength / MetaCt ),_ H(ArcStart + (LocalCt + 1)* ARcLength / MetaCt)_ ) END SELECT NEXT HMetaCt = MetaCt SHIFT LEFT MetaCt, 1 LOOP FUNCTION = ArcEnd END FUNCTION FUNCTION ExtractMelodies(H() AS HarmType) AS LONG LOCAL i AS LONG LOCAL maxpos AS LONG END FUNCTION