'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '+ + '+ + '+ 4,294,967,296 sonata's for piano, organs and percussion + '+ + '+ + '+ kopyleft: kristof lauwers + '+ + '+ + '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '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, became real=time) '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(??) '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 STATUS=?solved?: tempo of realplayer sometimes goes 0 >> smells like wrong ptr 'for the rest it seems to wprk fine '0111xx 'some bugs solved, now it's ok > ready to try on real machines... ' '011122 'adaption to real machines... '011219 'started working on strange attractors... 'first test: extreme values seem to work 'now we have to make pps3_strangeattractor variable [-1 > 1] as [disso > conso] '020125 'attractor steer con/d.sonance + speed=sync 'still some param tweeking needed (?) '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 %pilovelo = 10 'lowest velo dest for piano - we never really get this low %pihivelo = 36 'max velo for piano %pps3_debug = %true 'SUB/FCT DECLARATIONS---------------------------------- 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 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 RealPleier DECLARE SUB pps3dbg '(BYVAL id AS LONG) DECLARE SUB pps3master DECLARE FUNCTION Pps3_GetDissonanceInContext(BYVAL i AS BYTE) AS SINGLE DECLARE CALLBACK FUNCTION EndProcess DECLARE CALLBACK FUNCTION ChangeSpeed DECLARE CALLBACK FUNCTION ForceBounce DECLARE CALLBACK FUNCTION PiOff DECLARE CALLBACK FUNCTION PipOff DECLARE CALLBACK FUNCTION StartPps3 'VARIABLE DECLARATIONS--------------------------------- TYPE pps3Type tasknr AS LONG noot AS BYTE 'filled in as soon as is determined wich will be played aan AS BYTE '0 for rest, notevalue if actually sounding oldnoot AS BYTE velo AS BYTE scalev AS SINGLE 'ADDED to velo (only for vibi) 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 versionnr AS DWORD GLOBAL percussionflags AS WORD 'bit 0: humanola perc, bit 1: piperola perc, bit 2: troms, bit 3: thunderwood GLOBAL pps3_tromchan AS INTEGER 'keep it as variable for flexibility GLOBAL pps3_twchan AS INTEGER GLOBAL pps3_smalpercchan AS INTEGER GLOBAL pps3_castagnetschan AS INTEGER GLOBAL pps3_strangeattractor AS SINGLE GLOBAL pps3_soundingHar AS HarmType 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 GLOBAL hDlg AS LONG ' for setup and control window GLOBAL MatchTime() AS SINGLE 'for bouncingvoice - can be influenced by user input '======================================================== 'initialisation------------------------------------------ FUNCTION Initpps3 AS LONG DIM H(0 TO %nrChords) '0 = empty chord! DIM P(0 TO 7) DIM HarTOn(0 TO 7) DIM HarTof(0 TO 7) DIM HarNOn(0 TO 7) STATIC HIST() AS BYTE 'INIT HISTORY DIM hist(1 TO %LOH) LOCAL b$ '< D E B U G> ' pps3_strangeattractor = 1 '-1 pHist = VARPTR(hist(1)) POKE$ pHist,STRING$(%LOH,80) 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 IF ISFALSE hMidiO(0) THEN MSGBOX "Please select a midi output device ",,"Err" FUNCTION = %false EXIT FUNCTION END IF ' LOCAL hDlg AS LONG DIALOG NEW 0, "4,294,967,296 Sonatas for playerpiano, automated organ and percussion automats",1,1,360,220 TO hdlg CONTROL ADD LABEL, hDlg, 100, "Wich sonata do you want to play? (0 - 4,294,967,295)",5,5,180,12 CONTROL ADD TEXTBOX, hDlg, 101,"0",190,5,70,12, %ES_NUMBER OR %WS_TABSTOP, %WS_EX_CLIENTEDGE CONTROL ADD FRAME, hDlg, 200, " Setup: ",5, 25, 170, 160 CONTROL ADD LABEL, hDlg, -1, "Instrument:", 15, 40,60,15 CONTROL ADD LABEL, hDlg, -1, "Channel:", 130,40,30,12 CONTROL ADD CHECKBOX, hDlg, 201, "Piperola", 15, 60, 60, 12 CONTROL ADD CHECKBOX, hDlg, 202, "Humanola (percussion only)", 15, 75, 60, 12 CONTROL ADD CHECKBOX, hDlg, 203, "Bourdon", 15, 90, 60, 12 CONTROL ADD CHECKBOX, hDlg, 204, "Harma", 15, 105, 60, 12 CONTROL ADD CHECKBOX, hDlg, 205, "Playerpiano", 15, 120, 60, 12 CONTROL ADD CHECKBOX, hDlg, 206, "Vibi", 15, 135, 60, 12 CONTROL ADD CHECKBOX, hDlg, 207, "Troms", 15, 150, 60, 12 CONTROL ADD CHECKBOX, hDlg, 208, "Thunderwood", 15, 165, 60, 12 CONTROL SET CHECK hDlg, 201, 1 CONTROL SET CHECK hDlg, 204, 1 CONTROL SET CHECK hDlg, 205, 1 CONTROL DISABLE hDlg, 201 CONTROL DISABLE hDlg, 203 CONTROL DISABLE hDlg, 204 CONTROL DISABLE hDlg, 205 CONTROL DISABLE hDlg, 208 CONTROL ADD TEXTBOX, hDlg, 211, "2",130,60,30,12 CONTROL ADD TEXTBOX, hDlg, 212, "1",130,75,30,12 CONTROL ADD TEXTBOX, hDlg, 213, "10",130,90,30,12 CONTROL ADD TEXTBOX, hDlg, 214, "9",130,105,30,12 CONTROL ADD TEXTBOX, hDlg, 215, "0",130,120,30,12 CONTROL ADD TEXTBOX, hDlg, 216, "10",130,135,30,12 CONTROL ADD TEXTBOX, hDlg, 217, "6",130,150,30,12 CONTROL ADD TEXTBOX, hDlg, 218, "8",130,165,30,12 CONTROL ADD BUTTON, hDlg, 300, "&Start", 5, 195, 170, 15, %BS_DEFAULT CALL StartPps3 LOCAL buf$ buf$ = "piperola, harma and the playerpiano are obligato" + CHR$(13) + _ "the other automats can be added in any combination" + CHR$(13) + _ "the End buttons below end one of the four processes early" + CHR$(13) + _ "Bounc forces a bounce event" + CHR$(13) + _ "tasks can be toggled bit this will halt one of the processes!" CONTROL ADD LABEL, hDlg, -1, buf$, 182, 25, 173, 58, %SS_SUNKEN CONTROL ADD BUTTON, hDlg, 1000, "End 0", 182, 87, 30, 12, %WS_DISABLED CALL EndProcess CONTROL ADD BUTTON, hDlg, 1001, "End 1", 215, 87, 30, 12, %WS_DISABLED CALL EndProcess CONTROL ADD BUTTON, hDlg, 1002, "End 2", 248, 87, 30, 12, %WS_DISABLED CALL EndProcess CONTROL ADD BUTTON, hDlg, 1003, "End 3", 281, 87, 30, 12, %WS_DISABLED, CALL EndProcess CONTROL ADD BUTTON, hDlg, 1100, "Bounc 0", 182, 105, 30, 12, %WS_DISABLED CALL ForceBounce CONTROL ADD BUTTON, hDlg, 1101, "Bounc 1", 215, 105, 30, 12, %WS_DISABLED CALL ForceBounce CONTROL ADD BUTTON, hDlg, 1102, "Bounc 2", 248, 105, 30, 12, %WS_DISABLED CALL ForceBounce CONTROL ADD BUTTON, hDlg, 1103, "Bounc 3", 281, 105, 30, 12, %WS_DISABLED CALL ForceBounce CONTROL ADD LABEL, hDlg, -1, "Realplayer freq", 182, 125, 60, 12 CONTROL ADD LABEL, hDlg, 2000, "", 182, 138, 60, 12, %SS_SUNKEN CONTROL ADD BUTTON, hDlg, 2010, "<", 245, 138, 30, 12 CALL ChangeSpeed CONTROL ADD BUTTON, hDlg, 2011, ">",278, 138, 30, 12 CALL ChangeSpeed CONTROL ADD BUTTON, hDlg, 3000, "PiOff", 182, 156, 30, 12 CALL PiOff CONTROL ADD BUTTON, hDlg, 3001, "PipOff", 215, 156, 30, 12 CALL PipOff DIALOG SHOW MODELESS hDlg InitChordSequence 'FOR CHANGING TASKNRS, ONLY CHANZE %LPT 'OR BE CAREFULL, AS SEVERAL VOICET_TYPE BOUND ARRAYS ARE HARD DIMMED task(%BOSS).naam="god" task(%BOSS).freq = .14 'was .12 @020219 was .1 020124 task(%BOSS).cptr = CODEPTR(pps3master) Task(%LPT).naam="Player1" Task(%LPT).freq = .1 '1 '.23 '5 '.001 Task(%LPT).channel = 1 Task(%LPT ).patch = 17 Task(%LPT).cptr = CODEPTR(Player1) Task(%LPT + 1).naam="Player2" Task(%LPT + 1).freq = .09 '1 '.1 '.17 Task(%LPT + 1).channel = 2 Task(%LPT + 1).patch = 16 Task(%LPT + 1).cptr = CODEPTR(Player2) Task(%LPT + 2).naam="Player3" Task(%LPT + 2).freq = .08 '1 '.23 Task(%LPT + 2).channel = 3 Task(%LPT + 2).patch = 19 Task(%LPT + 2).cptr = CODEPTR(Player3) Task(%LPT + 3).naam="Player4" Task(%LPT + 3).freq = .07 '1 '.25 Task(%LPT + 3).channel = 4 Task(%LPT + 3).patch = 20 Task(%LPT + 3).cptr = CODEPTR(Player4) Task(%LPT + 7).naam="Bounce1" Task(%LPT + 7).freq = .25 Task(%LPT + 7).channel = 0 Task(%LPT + 7).cptr = CODEPTR(Bounce1) Task(%LPT + 8).naam="Bounce2" Task(%LPT + 8).freq = .26 Task(%LPT + 8).channel = 0 Task(%LPT + 8).cptr = CODEPTR(Bounce2) Task(%LPT + 9).naam="Bounce3" Task(%LPT + 9).freq = .27 Task(%LPT + 9).channel = 0 Task(%LPT + 9).cptr = CODEPTR(Bounce3) Task(%LPT + 10).naam="Bounce4" Task(%LPT + 10).freq = .28 Task(%LPT + 10).channel = 0 Task(%LPT + 10).cptr = CODEPTR(Bounce4) Task(%RP ).naam="Realp" Task(%RP ).freq = .7 '2 Task(%RP ).channel = 0 Task(%RP ).cptr = CODEPTR(Realpleier) ' Task(%RP + 1).naam = "sensuur" ' Task(%RP + 1).freq = 1 ' task(%RP + 1).channel = 0 ' was 1 '!!!!!! sic !!!!!!!! ' Task(%RP + 1).cptr = CODEPTR(Sensuur) task(%RP + 2).naam = "coda" task(%RP + 2).freq = 1 task(%RP + 2).channel = 0 task(%RP + 2).cptr = CODEPTR(PPS3_Coda) #IF %DEF(%pps3_debug) Task(%RP + 5).naam="dbg" Task(%RP + 5).freq = 80 Task(%RP + 5).channel = 0 Task(%RP + 5).cptr = CODEPTR(pps3dbg) #ENDIF BUTNSW(1).cptr = CODEPTR(StartPps3) FUNCTION = %true END FUNCTION CALLBACK FUNCTION EndProcess LOCAL ID AS LONG IF CBCTLMSG <> %BN_CLICKED THEN EXIT FUNCTION ID = CBCTL - 1000 P(ID).LowTes = P(ID).lodest P(ID).hightes = P(ID).hidest P(ID + 4).LowTes = P(ID + 4).lodest P(ID + 4).hightes = P(ID + 4).hidest P(ID).done = %true CONTROL DISABLE CBHNDL, CBCTL END FUNCTION CALLBACK FUNCTION ChangeSpeed IF CBCTLMSG <> %BN_CLICKED THEN EXIT FUNCTION SELECT CASE CBCTL CASE 2010 task(%RP).freq = task(%RP).freq * .9 CASE 2011 task(%RP).freq = task(%RP).freq * 1.1 END SELECT CONTROL SET TEXT CBHNDL, 2000, STR$(Task(%RP).freq, 6) END FUNCTION SUB PPS3_Coda STATIC FinalEndTim AS LONG LOCAL i AS LONG LOCAL n AS LONG IF ISFALSE FinalEndTim THEN FinalEndTim = TIMER + 30 END IF FOR i = 0 TO 3 P(i).MaxFreq = (20 * P(i).MaxFreq + P(i).MinFreq) / 21 P(i).MinFreq = (6 * P(i).MinFreq + .05) / 7 NEXT IF (FinalEndTim - 15) < TIMER THEN FOR i = 4 TO 7 StopTask P(i).tasknr NEXT END IF IF FinalEndTim < TIMER THEN StopTask %RP StopTask %RP + 1 StopTask %RP + 5 StopTask %BOSS FOR i = 0 TO 3 StopTask P(i).tasknr NEXT END IF IF (FinalEndTim + 6) < TIMER THEN StopTask %RP + 2 DIALOG DOEVENTS FOR n = 20 TO 127 NoteOff task(%LPT).channel, n DIALOG DOEVENTS: DIALOG DOEVENTS 'only to slow down... NoteOff task(%LPT + 2).channel, n DIALOG DOEVENTS: DIALOG DOEVENTS NoteOff task(%LPT + 3).channel, n DIALOG DOEVENTS: DIALOG DOEVENTS NoteOff task(%LPT + 4).channel, n DIALOG DOEVENTS: DIALOG DOEVENTS NEXT FOR n = 24 TO 108 NoteOff 0, n DIALOG DOEVENTS: DIALOG DOEVENTS NEXT FOR i = 0 TO 15 AllNotesOff i NEXT MSGBOX "thanks for listening to Sonata #"+STR$(versionnr, 10)+" for playerpiano, automated organ and percussion automats",,"The End!" END IF END SUB SUB PPS3Master 'starts voices and steers their min/max freq's LOCAL i AS LONG STATIC THIS AS LONG STATIC COUNT AS LONG 'QUAD 'LONG STATIC pps3_deltatime AS DOUBLE 'SINGLE STATIC IntroTime AS DOUBLE STATIC AttractorTime() AS DWORD IF ISFALSE THIS THEN THIS = %BOSS COUNT = -1 '%LPT-1' +6 pps3_deltatime = TIMER + 180 '220 '300 IntroTime = pps3_deltatime - 150 StartTask %LPT PPS3_StrangeAttractor = 0 DIM AttractorTime(0 TO 4) AttractorTime(0) = TIMER + 161 AttractorTime(1) = TIMER + 230 AttractorTime(2) = TIMER + 280 AttractorTime(3) = TIMER + 310 AttractorTime(4) = TIMER + 360 END IF INCR COUNT IF (COUNT > 0) AND (COUNT <= 6) THEN IF ISFALSE (COUNT MOD 2) THEN StartTask %LPT + COUNT \ 2 END IF EXIT SUB END IF IF (COUNT >= 8) AND (COUNT <= 15) THEN IF ISFALSE (COUNT MOD 2) THEN StartTask %LPT + (COUNT \ 2) + 3 '1 EXIT SUB END IF END IF IF COUNT = 17 THEN task(THIS).freq = 1.1 END IF 'from pps3_deltatime on we grad. increase min otherwise incr max freq. IF TIMER < IntroTime THEN EXIT SUB IF (ISFALSE (COUNT MOD 10)) OR (COUNT < 17) THEN IF pps3_deltatime >= TIMER THEN 'WAS P(0).maxfreq = (19 * P(0).maxfreq + 6) / 20 '4.5 8, 4.5 6 P(1).maxfreq = (19 * P(1).maxfreq + 4) / 20 '7, 4 7 P(2).maxfreq = (19 * P(2).maxfreq + 4) / 20 '6, 3 8 P(3).maxfreq = (19 * P(3).maxfreq + 3.5) / 20 '5, 2 9 ' P(4).maxfreq = (18 * P(4).maxfreq + 20) / 19 '15 29 ' P(5).maxfreq = (18 * P(5).maxfreq + 14) / 19 '30 ' P(6).maxfreq = (18 * P(6).maxfreq + 13) / 19 '31 ' P(7).maxfreq = (18 * P(7).maxfreq + 20) / 19 '12 32 EXIT SUB ELSE IF ISFALSE P(0).done THEN P(0).minfreq = (12 * P(0).minfreq + .92) / 13 ELSE P(0).minfreq = (6 * P(0).minfreq + .05) / 7 END IF IF ISFALSE P(1).done THEN P(1).minfreq = (12 * P(1).minfreq + 1) / 13 ELSE P(1).minfreq = (6 * P(1).minfreq + .051) / 7 END IF IF ISFALSE P(2).done THEN P(2).minfreq = (12 * P(2).minfreq + 1.04) / 13 ELSE P(2).minfreq = (6 * P(2).minfreq + .052) / 7 END IF IF ISFALSE P(3).done THEN P(3).minfreq = (12 * P(3).minfreq + 1.135) / 13 ELSE P(3).minfreq = (6 * P(3).minfreq + .053) / 7 END IF P(4).minfreq = (12 * P(4).minfreq + .12) / 13 P(5).minfreq = (12 * P(5).minfreq + .123) / 13 P(6).minfreq = (12 * P(6).minfreq + .126) / 13 P(7).minfreq = (12 * P(7).minfreq + .13) / 13 END IF P(4).maxfreq = (18 * P(4).maxfreq + 10) / 19 '20 15 29 P(5).maxfreq = (18 * P(5).maxfreq + 7) / 19 '14 30 P(6).maxfreq = (18 * P(6).maxfreq + 6.53) / 19 '13 31 P(7).maxfreq = (18 * P(7).maxfreq + 8) / 19 '20 12 32 END IF IF TIMER > AttractorTime(0) AND TIMER < AttractorTime(1) THEN '0 > -1 PPS3_StrangeAttractor = - (TIMER - AttractorTime(0)) / (AttractorTime(1) - AttractorTime(0)) ELSEIF TIMER > AttractorTime(1) AND TIMER < AttractorTime(2) THEN 'subito 1, 1 > 0 PPS3_StrangeAttractor = ( (AttractorTime(2) - AttractorTime(1)) - (TIMER - AttractorTime(1)) ) / (AttractorTime(2) - AttractorTime(1)) ELSEIF TIMER > AttractorTime(2) AND TIMER < AttractorTime(3) THEN '0 > -1 PPS3_StrangeAttractor = - (TIMER - AttractorTime(2)) / (AttractorTime(3) - AttractorTime(2)) ELSEIF TIMER > AttractorTime(3) AND TIMER < attractorTime(4) THEN 'subito 0, 0 > 1 was 1, 1> 0 @ 0202120343 PPS3_StrangeAttractor = 1 - ( (AttractorTime(4) - AttractorTime(3)) - (TIMER - AttractorTime(3)) ) / (AttractorTime(4) - AttractorTime(3)) ELSEIF AttractorTime(4) AND AttractorTime(4) < TIMER THEN FOR i = 1 TO 7 task(P(i).tasknr).freq = task(P(i).tasknr).freq / 2 NEXT AttractorTime(4) = %false ' PPS3_StrangeAttractor = 0 END IF END SUB FUNCTION PPS3_Roundfreq(BYVAL raw AS SINGLE,BYVAL ID AS LONG) AS SINGLE IF raw < .05 THEN raw = .05 FUNCTION = raw EXIT FUNCTION 'obsolete? since realpleier is rounding LOCAL i AS LONG LOCAL sumfreq AS SINGLE LOCAL buffer AS SINGLE FOR i =0 TO 7 sumfreq = sumfreq + task(P(i).tasknr).freq NEXT IF sumfreq > 18 THEN sumfreq = sumfreq / 8 IF raw > sumfreq THEN buffer = (2 * raw + sumfreq)/3 '6 END IF 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 buffer = (6 * raw + sumfreq) /7 ' 8 ELSE buffer = (4 * raw + P(ID).maxfreq) / 5 END IF ELSE END IF GOTO resultaat ELSE sumfreq = sumfreq / 8 IF raw > sumfreq THEN buffer = (4 * raw + P(ID).maxfreq ) / 5 GOTO resultaat ELSE END IF END IF IF ID > 3 THEN IF task(P(ID-4).tasknr).freq / task(P(ID).tasknr).freq > 3 THEN buffer = (3 * task(P(ID).tasknr).freq + task(P(ID - 4).tasknr).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-------------------------------------------- CALLBACK FUNCTION StartPps3 STATIC tog AS LONG LOCAL buf$ LOCAL bufval AS LONG LOCAL i AS LONG IF tog THEN EXIT FUNCTION IF CBCTLMSG <> %BN_CLICKED THEN EXIT FUNCTION IF CBCTL <> 300 THEN MSGBOX "Please use the button in the setup window to start.",,"err" EXIT FUNCTION END IF tog = %true percussionflags = 2 CONTROL DISABLE CBHNDL, CBCTL CONTROL GET TEXT CBHNDL, 101 TO buf$ CONTROL KILL CBHNDL, 101 CONTROL SET TEXT CBHNDL, 100, "Playing sonata "+ TRIM$(buf$) versionnr = VAL(buf$) CONTROL GET TEXT CBHNDL, 211 TO buf$ 'piperola bufval = VAL(buf$) task(%LPT).channel = bufval task(%LPT + 1).channel = bufval pps3_smalpercchan = bufval CONTROL GET TEXT CBHNDL, 214 TO buf$ 'harma bufval = VAL(buf$) task(%LPT + 2).channel = bufval task(%LPT + 3).channel = bufval 'now all 4 melo voices have a channel - optionally overwrite some @ luser input task(%LPT + 2).patch = &B00111 task(%LPT + 3).patch = &B00111 ProgChange task(%LPT + 2).channel, &B0111 mPlay task(%LPT + 2).channel, 28, 127 ModeMess task(%LPT + 2).channel, 7, 127 CONTROL GET CHECK CBHNDL, 202 TO bufval 'humanola IF bufval THEN CONTROL GET TEXT CBHNDL, 212 TO buf$ BIT SET percussionflags, 0 bufval = VAL(buf$) pps3_castagnetschan = bufval END IF CONTROL GET CHECK CBHNDL, 203 TO bufval 'bourdon IF bufval THEN CONTROL GET TEXT CBHNDL, 213 TO buf$ bufval = VAL(buf$) task(%LPT + 3).channel = bufval END IF CONTROL GET CHECK CBHNDL, 207 TO bufval 'troms IF bufval THEN ' MSGBOX "troms selected!" percussionflags = percussionflags OR &B100 CONTROL GET TEXT CBHNDL, 217 TO buf$ pps3_tromchan = VAL(buf$) ' msgbox str$(pps3_tromchan) END IF CONTROL GET CHECK CBHNDL, 208 TO bufval 'tw IF bufval THEN percussionflags = percussionflags OR &B1000 CONTROL GET TEXT CBHNDL, 218 TO buf$ pps3_twchan = VAL(buf$) END IF CONTROL GET TEXT CBHNDL, 215 TO buf$ 'piano bufval = VAL(buf$) FOR i = 7 TO 10 task(%LPT + i).channel = bufval NEXT CONTROL GET CHECK CBHNDL, 206 TO bufval 'vibi IF bufval THEN CONTROL GET TEXT CBHNDL, 216 TO buf$ bufval = VAL(buf$) task(%LPT + 7).channel = bufval P(4).scalev = 26 'always added to velo for vibi ModeMess task(%LPT+7).channel, 64, 1 'vibi END IF FOR i = 200 TO 208: CONTROL DISABLE CBHNDL, i: CONTROL DISABLE CBHNDL, i + 10: NEXT FOR i = 1000 TO 1003: CONTROL ENABLE CBHNDL, i: CONTROL ENABLE CBHNDL, i + 100: NEXT ' msgbox bin$(percussionflags) RANDOMIZE versionnr 'get config + update .... App.MTstart = %True App.tstart = timeGetTime ' start the chronometerfunction IF hMidiI(0) THEN ClearMiBuf 0 ' start with a blank midi input buffer BlockSysExReception hMidiI(0) ' dll procedure END IF 'IF App.PromilTasknr > -1 THEN StartTask App.PromilTaskNr 'IF App.RunTimeTaskNr > -1 THEN StartTask App.RunTimeTaskNr Promil %True Runtime %True StartTask %BOSS StartTask %RP END FUNCTION '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 P(ID).noot THEN ForPlay task(P(ID).tasknr).channel, P(ID).noot, 0, 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 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 task(P(ID).tasknr).freq = P(ID).MinFreq 'we'll still have deviations, but slow P(ID).done = 1 END IF END IF EXIT FUNCTION END IF P(ID).noot = GetNewNote(ID) IF P(ID).noot = %false THEN IF P(ID).oldnoot < P(ID).LowTes THEN P(ID).oldnoot = P(ID).LowTes ELSE INCR P(ID).oldnoot END IF IF P(ID).oldnoot > P(ID).HighTes THEN P(ID).oldnoot = P(ID).HighTes EXIT FUNCTION '010503 END IF POKE$ pHist + 1, PEEK$(pHist, %LOH - 1) @pHist[0] = P(ID).noot 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 ForPlay task(P(ID).tasknr).channel,P(ID).noot, P(ID).velo, ID ELSE DECR P(ID).lowTes INCR P(ID).highTes P(ID).noot = %false END IF IF P(ID).done THEN task(P(ID).tasknr).freq = P(ID).MinFreq EXIT FUNCTION END IF SELECT CASE ABS(P(ID).direction) CASE > 5 bufferfreq = (task(P(ID).tasknr).freq + ABS(P(ID).MaxFreq + SGN(P(ID).direction)) ) / 2 'min was max CASE 3 TO 5 bufferfreq = ( 2 * task(P(ID).tasknr).freq + ABS(P(ID).MaxFreq + SGN(P(ID).direction)) ) / 3 'min was max CASE 1 TO 3 bufferfreq = ( 4 * task(P(ID).tasknr).freq + P(ID).MaxFreq ) / 5 CASE ELSE bufferfreq = ( 3 * task(P(ID).tasknr).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(P(ID).tasknr).freq = PPS3_Roundfreq(bufferfreq, ID) END FUNCTION 'if we play corresponding (id - 4) task's 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 LOCAL disso AS SINGLE LOCAL lpcnt AS LONG 'infinite loop prevention counter 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 STATIC toleranceminor AS SINGLE STATIC tolerancemajor AS SINGLE '--initialisation-- IF init < ID THEN IF ISFALSE init THEN DIM ind(4 TO 7) DIM Matchtime(4 TO 7) DIM MyBuf(4 TO 7) AS STRING END IF init = ID toleranceminor = 34 '36 tolerancemajor = 59 '54 MatchTime(ID) = TIMER END IF '--if it took a long time before a note was found, increase our range, ultima casa select a note we didn't play anyway-- IF ( (TIMER - MatchTime(ID)) > toleranceminor) AND ( P(ID).done = %false )THEN '(longer then 60" since match) ' if isfalse Matchtime(id) then msgbox "bounce forced!" IF ( TIMER - MatchTime(ID)) > tolerancemajor THEN '(90" since match) tolerancemajor = (20 + 13 * tolerancemajor ) / 14 'tolerancemajor * .96 'new 011003 IF P(ID).highTes < P(ID).hiDest THEN INCR P(ID).highTes ELSEIF P(ID).lowTes > P(ID).loDest THEN DECR P(ID).lowTes END IF buffer = P(ID - 4).cTes ELSE '(in between 60 & 90" since match) task(P(ID).tasknr).freq = ( 8 * task(P(ID).tasknr).freq + P(ID).MaxFreq ) / 9 task(P(ID).tasknr).freq = PPS3_Roundfreq(task(P(ID).tasknr).freq, ID) END IF END IF '--if we match an unison/octave w/ parent voice..-- IF ( P(ID ).noot MOD 12 ) = ( P(ID - 4).noot MOD 12) AND (P(ID).noot > 0) AND (P(ID - 4).noot > 0) THEN 'noot was stes buffer = P(ID ).noot END IF IF buffer AND ( P(ID).done = %false ) AND (TIMER - MatchTime(ID) > 5) THEN toleranceminor = (8 + 11 * toleranceminor) / 12 ' * .8 tolerancemajor = (20 + 11 * tolerancemajor) / 12 '-add several times to history- POKE$ pHist + 3, PEEK$( pHist, %LOH - 3) POKE$ pHist, STRING$(3, buffer) task(P(ID).tasknr).freq = (task(P(ID).tasknr).freq + P(ID).MaxFreq) / 2 'was = P(id).Maxfreq @020219 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 = ( 2.5 * P(ID).LowTes + P(ID).LoDest) / 3.5 'was 3* en /4 P(ID).HighTes = ( 2.5 * P(ID).HighTes + P(ID).HiDest) / 3.5 'was 3* en /4 IF ABS(P(ID - 4).LowTes - P(ID - 4).LoDest) > 15 THEN P(ID - 4).LowTes = ( 6 * P(ID - 4).LowTes + P(ID - 4).LoDest) / 7 ELSE P(ID - 4).LowTes = (2.5 * P(ID - 4).LowTes + P(ID - 4).LoDest) / 3.5 END IF IF ABS(P(ID - 4).HiDest - P(ID - 4).HighTes) > 15 THEN P(ID - 4).HighTes = ( 6 * P(ID - 4).HighTes + P(ID - 4).HiDest) / 7 ELSE P(ID - 4).HighTes = (2.5 * P(ID - 4).HighTes + P(ID - 4).HiDest) / 3.5 END IF '-check if the voice reached its destination- IF P(ID - 4).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 CONTROL DISABLE hDlg, 2000 + i - 4 task(P(ID).tasknr).freq = P(ID).MinFreq IF P(4).done AND P(5).done AND P(6).done AND P(7).done THEN StartTask %RP + 2 'coda END IF END IF END IF END IF END IF '-update matchtime- IF (TIMER - MatchTime(ID)) > 5 THEN MatchTime(ID) = TIMER '-old note of- rem not always necessary ForPlay task(P(ID).tasknr).channel, P(ID).noot, 0, ID '-set new note, velo, tes- P(ID).velo = %pihivelo '127 'was 50 @ 000430 INCR ind(ID) '???? was decr _bug? IF ind(ID) >%LOH THEN ind(ID) = 1 '< 2 THEN ind(id) = %LOH' 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) ELSEIF P(ID).noot > INT(P(ID).hightes) THEN P(ID).noot = INT(P(ID).hightes) END IF IF RND > .49 THEN IF P(ID - 4).cTes < P(ID - 4).HighTes THEN INCR P(ID - 4).cTes ELSE IF P(ID - 4).cTes - INT(RND * 4) > P(ID - 4).LowTes THEN DECR P(ID - 4).cTes END IF IF P(ID - 4).cTes < P(ID - 4).Lowtes THEN P(ID - 4).cTes = P(ID - 4).Lowtes P(ID).tog = %false '(like this it will play the note immediately w.out recomputing) ' Bouncingvoice(ID) RealPleier ' END IF '--compute, play notes, put notes off etc... IF ASC(MID$(HarTOn(task(P(ID).tasknr).channel), P(ID).noot,1)) THEN EXIT FUNCTION 'note is not played yet IF P(ID).tog = 2 THEN '(hold note) DECR P(ID).tog ELSEIF P(ID).tog = 1 THEN '(rest + compute next note) INCR ind(ID) ForPlay task(P(ID).tasknr).channel, P(ID).noot, 0, ID 'put old one off lpcnt = 0 ' equals %LOH if we tried all notes and none matches disso/consonantness required... newnote: 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 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 SELECT CASE Pps3_StrangeAttractor CASE > 0 'favor consonants disso = Pps3_GetDissonanceInContext(P(ID).noot) IF disso > (1.2 - Pps3_StrangeAttractor) THEN INCR ind(ID) INCR lpcnt IF lpcnt > %LOH THEN GOTO noteok 'EXIT SELECT 'take this note anyway GOTO newnote END IF CASE < 0 'favor dissonants disso = Pps3_GetDissonanceInContext(P(ID).noot) IF disso < ABS(Pps3_StrangeAttractor) THEN INCR ind(ID) INCR lpcnt IF lpcnt > %LOH THEN GOTO noteok 'EXIT SELECT 'take this note anyway GOTO newnote END IF END SELECT noteok: DECR P(ID).tog ELSE 'tog = 0 - play new note P(ID).tog = 2 ForPlay task(P(ID).tasknr).channel, P(ID).noot, P(ID).velo, ID task(P(ID).tasknr).freq = (10 * task(P(ID).tasknr).freq + P(ID).minFreq) / 11 ' task(P(id).tasknr).freq = PPS3_Roundfreq(task(P(id).tasknr).freq, id) 'obsolete? '-velo: first from max down, then goes back to 70- IF task(P(ID).tasknr).freq > (P(ID).minfreq + (1/3) * (P(ID).maxFreq - P(ID).minFreq)) THEN 'was > 10 P(ID).velo = (12 * P(ID).velo + %pilovelo) / 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 + %pihivelo * 2/3) / 11 END IF END IF IF P(ID).done THEN task(P(ID).tasknr).freq = P(ID).MinFreq: PPS3_StrangeAttractor = %false END FUNCTION CALLBACK FUNCTION ForceBounce 'forces a bounce in bouncingvoice by resetting matchtime LOCAL ID AS LONG IF CBCTLMSG <> %BN_CLICKED THEN EXIT FUNCTION ID = CBCTL - 1100 + 4 Matchtime(ID) = 0 END FUNCTION 'Playing tasks --------------------------------------- 'PlayerX calls a MarkovChainVoice with its own params 'params are in global type array, sub passes its id = index in type SUB Player1 STATIC ID AS LONG STATIC init AS LONG 'as our id == 0 !!!! IF ISFALSE init THEN init = %true ID = 0 '%LPT P(ID).LowTes = 62 '60 '54 '50'65 P(ID).HighTes = 70 '72 '78 '70'90 P(ID).CTes = 56 '69 '58' 84 P(ID).lodest = 100 '92 P(ID).hidest = 104 '98 P(ID).velo = 40 P(ID).minfreq = .06 '.23 '0.005 P(ID).maxfreq = .1 'is increased immediately at start! '.2 '.5'.2 '1 '3 '6'11 P(ID).tasknr = %LPT task(P(ID).tasknr).freq = P(ID).minfreq ProgChange task(p(ID).tasknr).channel, task(p(ID).tasknr).patch END IF FGMCVoice(ID) END SUB SUB Player2 'PIPEROLA STATIC ID AS LONG LOCAL i AS LONG IF ISFALSE ID THEN ID = 1 '%LPT + 1 P(ID).LowTes = 62 '60 '47'58 P(ID).HighTes =70 '72 '70'82 P(ID).CTes = 67 '66 '51 '59'69 P(ID).lodest = 96 '69 '92 '78 P(ID).hidest = 100 '72 '95 P(ID).velo = 40 P(ID).minfreq = .05 '0.18 '0.006 P(ID).maxfreq = .09 '.2 '1 '2.3 '7'11 P(ID).tasknr = %LPT + 1 task(P(ID).tasknr).freq = P(ID).minfreq ProgChange task(p(ID).tasknr).channel, task(p(ID).tasknr).patch END IF FGMCVoice(ID) END SUB SUB Player3 'HUMANOLA STATIC ID AS LONG IF ISFALSE ID THEN ID = 2 '%LPT + 2 P(ID).LowTes = 62 '60 '48'37 '20 40 61 80 102 P(ID).HighTes = 70 '72'62 '20 - 43 , 33 - 55 , 65 - 89, 79 - 102 P(ID).CTes = 56 '68 '60'49 P(ID).lodest = 46 '43 '40 '79 '66 P(ID).hidest = 53 '50 '82 '72 P(ID).velo = 40 P(ID).minfreq = .05'0.22 '0.007 P(ID).maxfreq = .08 '.2 '1 '2.6 '8'11 P(ID).tasknr = %LPT + 2 task(P(ID).tasknr).freq = P(ID).minfreq ProgChange task(p(ID).tasknr).channel, task(p(ID).tasknr).patch END IF FGMCVoice(ID) END SUB SUB Player4 STATIC ID AS LONG 'HUMANOLA / /+ BOURDON IF ISFALSE ID THEN ID = 3 '%LPT + 3 P(ID).LowTes = 62 '56 '44'24 P(ID).HighTes = 68 '62 '64'70'49 P(ID).lodest = 39 '36 '69 '52 P(ID).hidest = 45 '42 '46 '58 P(ID).CTes = 57 '60 '62'30 P(ID).velo = 40 P(ID).minfreq = .05 '0.16 '0.008 P(ID).maxfreq = .07 '.2 '.27 '1 '3 '9'11 P(ID).tasknr = %LPT + 3 task(P(ID).tasknr).freq = P(ID).minfreq ProgChange task(p(ID).tasknr).channel, task(p(ID).tasknr).patch END IF FGMCVoice(ID) END SUB 'additional playing tasks---------------------------------- SUB Bounce1 STATIC ID AS LONG IF ISFALSE ID THEN 'PLAYERPIANO ID = 4 '%LPT + 7 P(ID).LowTes = 62 '60 '50 '75 P(ID).HighTes =70 '72 '70'90 P(ID).lodest = 88 '58 P(ID).hidest = 92 '61 P(ID).velo = 30 P(ID).minfreq = 0.4 ' 0.2 '0.5 '1.5 '3 '1'0.5 '0.1 '!! spelen maar om de drie stappen P(ID).maxfreq = 1 '5 '35 P(ID).tasknr = %LPT + 7 END IF BouncingVoice(ID) END SUB SUB Bounce2 STATIC ID AS LONG IF ISFALSE ID THEN ID = 5 '%LPT + 8 P(ID).LowTes = 62 '60'57 P(ID).HighTes = 70 '72'82 P(ID).lodest = 96 '100 '47 P(ID).hidest = 100 '104 '50 P(ID).velo = 30 P(ID).minfreq = 0.2 '0.45 '1.45 '2.95 '1'0.505 '0.1 P(ID).maxfreq = 1 '5 '40 'sic P(ID).tasknr = %LPT + 8 END IF BouncingVoice(ID) END SUB SUB Bounce3 STATIC ID AS LONG IF ISFALSE ID THEN ID = 6 '%LPT + 9 P(ID).LowTes = 62 '60 '50'32 P(ID).HighTes = 70 '72'57 P(ID).lodest = 34 '31 '30 '34 P(ID).hidest = 40 '37 '36 '37 P(ID).velo = 30 P(ID).minfreq = 0.3 '0.4 '1.4 '2.9 '1'0.51'0.1 P(ID).maxfreq = 1 '5 '35 P(ID).tasknr = %LPT + 9 END IF BouncingVoice(ID) END SUB SUB Bounce4 STATIC ID AS LONG IF ISFALSE ID THEN ID = 7 '%LPT + 10 P(ID).LowTes = 62 '56'20 P(ID).HighTes = 68 '62'45 P(ID).lodest = 27 '24 '22 P(ID).hidest = 33 '30 '25 P(ID).velo = 30 P(ID).minfreq = 0.4 '0.35 '1.35 '2.8 '1'0.515 '0.05 'sic P(ID).maxfreq = 1 '5 '35 P(ID).tasknr = %LPT + 10 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 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 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 disso AS SINGLE DIM NoteArr(1 TO 127) AS LOCAL SINGLE DIM ValidArr(1 TO 127) AS LOCAL SINGLE DIM men(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 men(j) = j NEXT SELECT CASE Pps3_StrangeAttractor CASE 0 ' ARRAY SORT NoteArr() ,TAGARRAY me(), DESCEND CASE > 0 'consonant IF RND > PPS3_StrangeAttractor THEN FUNCTION = P(ID).OldNoot: EXIT FUNCTION FOR i = 0 TO 127 'check with pps3_soundinghar, make notarr dependent on consonantness j = 0 'is for dissonance here IF NoteArr(i) THEN disso = pps3_getDissonanceInContext(i) NoteArr(i) = 10 * NoteArr(i) / (1 + disso * 9) IF NoteArr(i)= 0 THEN NoteArr(i) = 1 'check formula END IF NEXT CASE < 0 'dissonant FOR i = 0 TO 127 'check with pps3_soundinghar, make notarr dependent on consonantness IF NoteArr(i) THEN disso = pps3_getDissonanceInContext(i) NoteArr(i) = NoteArr(i) * (1 + disso * 2) IF NoteArr(i)= 0 THEN NoteArr(i) = 1 'check formula END IF NEXT END SELECT ARRAY SORT NoteArr() ,TAGARRAY men(), DESCEND FOR j = 1 TO 127 IF j MOD 12 = P(ID).oldnoot MOD 12 THEN ITERATE FOR IF NoteArr(j) > 0 THEN INCR nr ValidArr(nr) = men(j) END IF NEXT IF ISFALSE nr THEN 'we add the note somewhere to avoid recursive loops invalid: AddNote2Har H(INT(RND * UBOUND(H))),P(ID).OldNoot,64 'P(id).velo FUNCTION = %false EXIT FUNCTION END IF IF nr = 1 THEN IF ISFALSE(INT(ValidArr(1))) THEN GOTO invalid 'FUNCTION = ValidArr(1) als er maar 1 keuze is doen we niets.. 0202122033 EXIT FUNCTION END IF FOR j = 1 TO nr - 1 IF RND < 1.2/nr THEN '.5 010503 'this means chance distrib now is f(nr) - last may even have most chance.... FUNCTION = ValidArr(j) EXIT FUNCTION END IF NEXT 'FUNCTION = ValidArr(nr) none 020212 - now last one can't have most chance anymore... END FUNCTION FUNCTION Pps3_GetDissonanceInContext(BYVAL i AS BYTE) AS SINGLE 'not! general purpose. we know that we have max 8 notes and that they don't form dense clusters.. LOCAL disso AS SINGLE IF IsNoteInHar(pps3_soundinghar, i-1) THEN disso = disso + .5 IF IsNoteInHar(pps3_soundinghar, i+1) THEN disso = disso + .5 IF IsNoteInHar(pps3_soundinghar, i-2) THEN disso = disso + .45 IF IsNoteInHar(pps3_soundinghar, i+2) THEN disso = disso + .45 IF IsNoteInHar(pps3_soundinghar, i+6) THEN disso = disso + .4 IF IsNoteInHar(pps3_soundinghar, i-6) THEN disso = disso + .4 IF IsNoteInHar(pps3_soundinghar, i+10) THEN disso = disso + .2 IF IsNoteInHar(pps3_soundinghar, i-10) THEN disso = disso + .2 IF IsNoteInHar(pps3_soundinghar, i+11) THEN disso = disso + .3 IF IsNoteInHar(pps3_soundinghar, i-11) THEN disso = disso + .3 IF IsNoteInHar(pps3_soundinghar, i+13) THEN disso = disso + .27 IF IsNoteInHar(pps3_soundinghar, i-13) THEN disso = disso + .27 IF IsNoteInHar(pps3_soundinghar, i+14) THEN disso = disso + .17 IF IsNoteInHar(pps3_soundinghar, i-14) THEN disso = disso + .17 FUNCTION = disso 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 7) AS STATIC STRING * 127 IF ISFALSE init THEN FOR j = 0 TO 7 HarNon(j) = STRING$(128, CHR$(0)) HarTon(j) = STRING$(128, CHR$(0)) HarTof(j) = STRING$(128, CHR$(0)) NEXT init =%true END IF 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(ID), note) = "y" MID$(HarTOn(ID), note, 1) = CHR$(0) '"y" new 010427 FOR i = 0 TO 127 FOR j = 0 TO 7 IF ASC(MID$(OwnOff(j),i)) THEN MID$(HarTOf(j),i) = "Y" NEXT NEXT ELSE IF ASC(MID$(HarTOn(ID), note, 1)) > 0 OR ASC(MID$(HarNOn(ID), note,1)) > 0 THEN MID$(HarTOf(ID), note,1) = "Y" IF (ASC(MID$(HarTOn(ID), note - 12, 1)) = 0) AND ASC(MID$(HarNOn(ID), note - 12, 1)) = 0 THEN 'AND (note > 35) THEN IF (note - 12 >=P(ID).lodest) AND (note - 12 <= P(ID).hidest) THEN ' dest's were tes mPlay task(P(ID).tasknr).channel, note - 12 - 1, velo MID$(HarTOf(ID), note - 12) = CHR$(Velo) END IF ELSEIF (ASC(MID$(HarTOn(ID), note)) + 12 = 0) AND (ASC(MID$(HarNOn(ID), note + 12)) = 0) THEN 'AND note < 85 THEN IF (note + 12 >=P(ID).lodest) AND (note + 12 <= P(ID).hidest) THEN mPlay task(P(ID).tasknr).channel, note + 12 - 1, velo MID$(HarTOf(ID), note + 12) = CHR$(Velo) END IF END IF ELSE AddNote2Har pps3_SoundingHar, note, velo MID$(HarTOn(ID), note,1) = CHR$(velo) END IF END IF END SUB SUB RealPleier LOCAL i AS LONG, j AS LONG LOCAL cAkts AS LONG 'count of acts for one sub call LOCAL note AS LONG LOCAL velo AS LONG LOCAL dummy AS LONG STATIC buffer AS SINGLE STATIC THIS AS LONG STATIC hld AS BYTE STATIC COUNT AS DWORD STATIC putoff() AS BYTE 'new 011126 : chance to put note off immediately on next round (bigger chance in extreme registers) LOCAL buf$ LOCAL pDest AS BYTE PTR LOCAL psrc AS STRING PTR IF ISFALSE THIS THEN hld = 3 THIS = %RP DIM putoff(0 TO 7) buffer = task(THIS).freq 'rhytm instruments play sequences... 'think of lentgh for patterns vox+piper together should have a long one... 'others should be different length IF BIT(percussionflags, 0) THEN DIM voxpattern(0 TO 70) AS STATIC WORD 'pattern for rhytms to be played note+velo packed in integer buf$ = REPEAT$(140, CHR$(0)) MID$(buf$, 19) = CHR$(120, 15):MID$(buf$, 25) = CHR$(121, 23, 127, 23) MID$(buf$, 31) = CHR$(125, 15): MID$(buf$, 37) = CHR$(124, 23) FOR i = 53 TO 102 STEP 7: MID$(buf$, i) = CHR$(120 + (i - 53)/7, 23): NEXT MID$(buf$, 105) = CHR$(125, 23, 123, 23): MID$(buf$, 121) = CHR$(121, 23, 126, 23) pDest = VARPTR(voxpattern(0)) psrc = STRPTR(buf$) POKE$ pDest, PEEK$(pSrc, UBOUND(voxpattern) + 1) STATIC voxcount AS INTEGER 'fill in END IF IF BIT(percussionflags, 1) THEN 'piperola percussion DIM piperpattern(0 TO 93) AS STATIC BYTE buf$ = CHR$(120, 80,0,0,122, 44,0,0, 125, 44,0,0, 122, 44,0,0, 121, 44,0,0, 120, 44,0,0, 122, 44,0,0, 126, 44,0,0, 122, 44,0,0) buf$ = buf$ + CHR$(125, 44,0,0, 122,44, 0, 0, 0, 0, 120, 44 ) buf$ = buf$ + CHR$(123, 44, 0,0,0, 0, 122, 44,0,0, 124, 44,0,0, 122, 44, 0, 0, 123, 44,0,0, 124, 44,0,0, 122, 44,0,0, 123, 44) buf$ = buf$ + CHR$(0,0, 121, 44,0,0, 122, 44,0,0, 122, 44, 120, 60) pDest = VARPTR(piperpattern(0)) psrc = STRPTR(buf$) POKE$ pDest, PEEK$(pSrc, UBOUND(piperpattern) + 1) 'array should start at inex 0! ???!! sizeof(buf$) returned 4 STATIC pipercount AS INTEGER END IF IF BIT(percussionflags, 2) THEN 'troms DIM tromspattern(0 TO 97) AS STATIC WORD buf$ = REPEAT$(196 , CHR$(0)) ' msgbox str$(len(buf$)) 'ok FOR i = 3 TO 196 STEP 16: MID$(buf$, i) = CHR$(30 + INT(i/16), 15): NEXT FOR i = 15 TO 196 STEP 24: MID$(buf$, i) = CHR$(41 + INT(i/24), 20): NEXT FOR i = 3 TO 196 STEP 32: MID$(buf$, i) = CHR$(24 + INT(i/32), 15): NEXT ' msgbox buf$ pDest = VARPTR(tromspattern(0)) psrc = STRPTR(buf$) POKE$ pDest, PEEK$(psrc, UBOUND(tromspattern) + 1) STATIC tromscount AS INTEGER END IF IF BIT(percussionflags, 4) THEN DIM twpattern(0 TO 13) AS STATIC WORD STATIC twcount AS INTEGER 'fill in END IF END IF 'percussion > becomes organ's perc IF BIT(percussionflags, 0) THEN 'vox perc note = voxpattern(voxcount) AND &HFF 'Play pps3_castagnetschan, note, 0 'of necessary?? anders model after troms... IF note THEN NoteOff pps3_castagnetschan, note INCR voxcount IF voxcount > UBOUND(voxpattern) THEN voxcount = LBOUND(voxpattern) velo = voxpattern(voxcount) \ &HFF note = voxpattern(voxcount) AND &H00FF CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 13, STR$(voxcount) CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 12, STR$(note) + STR$(velo) mPlay pps3_castagnetschan, note, velo END IF IF BIT(percussionflags, 1) THEN 'piper perc note = piperpattern(pipercount) '\ &HFF mPlay pps3_smalpercchan, note, 0 INCR pipercount: INCR pipercount IF pipercount > UBOUND(piperpattern) THEN pipercount = LBOUND(piperpattern) IF RND > task(THIS).freq / 10 THEN note = piperpattern(pipercount)' \ &HFF velo = piperpattern(pipercount + 1) 'AND &H00FF mPlay task(%LPT).channel, note, velo END IF END IF IF BIT(percussionflags, 2) THEN 'troms ' msgbox str$(note) + str$(velo),,"troms" + str$(tromscount) + "_" + str$(ubound(tromspattern)) velo = tromspattern(tromscount) \ &HFF note = tromspattern(tromscount) AND &H00FF mPlay pps3_tromchan, note, velo INCR tromscount IF tromscount > UBOUND(tromspattern) THEN tromscount = LBOUND(tromspattern) END IF IF BIT(percussionflags, 4) THEN 'thunderwood note = twpattern(twcount) \ &HFF velo = twpattern(twcount) AND &H00FF mPlay pps3_twchan, note, velo INCR voxcount IF voxcount > UBOUND(voxpattern) THEN voxcount = LBOUND(voxpattern) END IF 'melodies... FOR j = 0 TO 7 IF putoff(j) THEN IF RND < (.2 + (putoff(j)-64) / 127) THEN 'was 64 - putoff(j) 020125 IF ASC(MID$(HarNOn(j), i,1))> 0 THEN NoteOff task(p(j).tasknr).channel, putoff(j) putoff(j) = 0 MID$(HarNOn(j), i,1) = CHR$(0) MID$(HarTof(j), i, 1) = CHR$(0) DelNote2Har Pps3_soundinghar , putoff(j) + 1 ', 0 END IF END IF END IF FOR i = 20 TO 120 '1 TO 127 velo = ASC(MID$(HarTOn(j), i, 1)) IF velo THEN ' IF j > 3 THEN IF PPS3_StrangeAttractor < - .2 THEN IF SQR(PPS3_GetDissonanceInContext(i)) < ABS(PPS3_StrangeAttractor) THEN CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 12, STR$(PPS3_GetDissonanceInContext(i)) MID$(HarTon(j), i, 1) = CHR$(0) ITERATE FOR END IF ELSEIF PPS3_StrangeAttractor > .2 THEN IF PPS3_GetDissonanceInContext(i) > PPs3_StrangeAttractor THEN MID$(HarTon(j), i, 1) = CHR$(0) ITERATE FOR END IF END IF END IF ' mPlay task(p(j).tasknr).channel, i - 1, velo + P(j).scalev putoff(j) = i - 1 '011126 will be put of on next call P(j).aan = i-1 ' but stays on for the algo 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 when 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)) > 0 THEN NoteOff task(p(j).tasknr).channel, i - 1 '-1 = kruft, for compatibility with playhar. who's wrong?? DelNote2Har Pps3_SoundingHar , i p(j).aan = 0 INCR cAkts MID$(HarTOf(j), i,1) = CHR$(0) MID$(HarNOn(j), i,1) = CHR$(0) END IF NEXT NEXT ' IF (ABS(PPS3_StrangeAttractor) > .01) THEN '020212: DEL "ABS()- only if attractor > 0 ' buffer = 0.7 + 8.3 * (1-ABS(PPS3_StrangeAttractor)^1.2) ' ELSE IF cAkts < 2 THEN '< 2 was isfalse buffer = buffer * .75 ' / 2 ELSE buffer = (20 * buffer + 6 * cAkts) / 21 '6 was 5 was 4 END IF ' END IF IF buffer < .251 THEN buffer = .251 ' 'IF buffer < 1 THEN ' task(this).freq =INT(buffer * 4) / 4 'ELSEIF buffer < 3 THEN ' task(this).freq = INT(buffer * 2) / 2 'ELSE ' task(this).freq = INT(buffer) ' * 2) / 2 'END IF task(THIS).freq = (20 * task(THIS).freq + buffer) / 21 ' CONTROL SET TEXT hDlg, 2000, STR$(Task(THIS).freq, 6) CONTROL SET TEXT gh.Cockpit, %GMT_TEXT0_ID + 11, STR$(PPS3_StrangeAttractor) END SUB 'SUB sensuur 'avoids consonants by transposing them w/ 1,2, 6 and playing back ther result ' 'switched on by realpleier, checks, next time plays normal har again so wrong notes are put off ' STATIC this AS LONG ' STATIC MyNote AS BYTE ' LOCAL i AS LONG, j AS LONG ' LOCAL buffer AS SINGLE ' STATIC t AS INTEGER 'transpos ' IF ISFALSE this THEN ' this = %RP + 1 ' t = 1 ' END IF ' 'new algo using p().aan @ 010612 ' IF mynote THEN ' Play task(this).channel, mynote, 0 ' mynote = %false ' END IF ' FOR i = 0 TO 6 ' IF ISFALSE p(i).aan THEN ITERATE FOR ' FOR j = i TO 7 ' IF ISFALSE p(j).aan THEN ITERATE FOR ' IF i = j THEN ITERATE FOR ' IF ( P(i).aan MOD 12 ) = ( p(j).aan MOD 12 ) THEN ' SELECT CASE t ' CASE 0 ' t = 1 ' CASE 1 ' t = - 1 ' CASE -1 ' t = 6 ' CASE 6 ' t = -2 ' CASE -2 ' t = 2 ' CASE 2 ' t = - 6 ' CASE - 6 ' t = 11 ' CASE 11 ' t = - 10 ' CASE - 10 ' t = 10 ' CASE 10 ' t = - 11 ' CASE - 11 ' t = 1 ' END SELECT ' IF mynote < 24 THEN mynote = 12 + mynote MOD 12 ' IF mynote > 100 THEN mynote = 84 + mynote MOD 12 ' mynote = P(i).aan + t ' Play task(this).channel, mynote, 50 + 4 * ABS(t) '50 was 30 - should be less on real playerpiano ' EXIT SUB ' END IF ' NEXT ' NEXT '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 () ' put this in a separate file LOCAL i AS SINGLE, j AS DWORD, n AS BYTE DIM theme(1 TO 17) AS LOCAL BYTE LOCAL dummy$ ' 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 'bassline [36 - 39]:36 40 39 41 42 38 41 37 38 40 38 38 36 41 39 36 38 i = 36 'was '37 '37 j = 1 DO 'fill harm with overtone series... n = INT(f2cn(cn2f(i) * j)) IF n => 108 THEN EXIT DO 'highest pitch on piperola AddNote2Har H(1),n,100 AddNote2Har H(13), n , 100 AddNote2Har H(16), n , 100 INCR j LOOP i = 38 j = 1 DO 'fill harm with overtone series... n = INT(f2cn(cn2f(i) * j)) IF n >= 108 THEN EXIT DO AddNote2Har H(6),n,100 AddNote2Har H(8), 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 >= 108 THEN EXIT DO AddNote2Har H(10),n,100 AddNote2Har H(11), 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 >= 108 THEN EXIT DO AddNote2Har H(3),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 >= 108 THEN EXIT DO AddNote2Har H(2),n,100 AddNote2Har H(9),n,100 INCR j LOOP i = 41 j = 1 DO n = INT(f2cn(cn2f(i) * j )) IF n >= 108 THEN EXIT DO AddNote2Har H(4), n , 100 AddNote2Har H(7), n , 100 AddNote2Har H(14), n , 100 INCR j LOOP i = 42 j = 1 DO n = INT(f2cn(cn2f(i) * j )) IF n >= 108 THEN EXIT DO AddNote2Har H(5), n , 100 INCR j LOOP ' ' 'here used to be some other fill-ins of H(). 'they can still b found in pps3_bck_010611 ' END SUB 'debugwindow proc----------------------------------------- SUB pps3dbg '(BYVAL id AS LONG) #IF %DEF(%pps3_debug) STATIC hDlg AS LONG STATIC ID 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,390,170 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, "DONE:",5, 150,25,12, %SS_SUNKEN FOR i = 0 TO 7 CONTROL ADD LABEL, hDlg, -1, task(P(i).tasknr).naam, 5, 26 + 14 * (i ),65,12,%SS_SUNKEN CONTROL ADD LABEL, hDlg, i * 10, "?", 75, 26 + 14 * (i ),55,12,%SS_SUNKEN CONTROL ADD LABEL, hDlg, i * 10 + 1, "?", 140, 26 + 14 * (i ),25,12,%SS_SUNKEN CONTROL ADD LABEL, hDlg, i * 10 + 2, "?", 170, 26 + 14 * (i ),25,12,%SS_SUNKEN CONTROL ADD LABEL, hDlg, i * 10 + 3, "?", 205, 26 + 14 * (i ),25,12,%SS_SUNKEN CONTROL ADD LABEL, hDlg, i * 10 + 4, "?", 235, 26 + 14 * (i ),25,12,%SS_SUNKEN CONTROL ADD LABEL, hDlg, i * 10 + 5, "?", 265, 26 + 14 * (i ),55,12,%SS_SUNKEN CONTROL ADD LABEL, hDlg, i * 10 + 6, "?", 325, 26 + 14 * (i ),55,12,%SS_SUNKEN CONTROL ADD LABEL, hDlg, 100 + i,"0", 35 + 24 * i,150, 20,12,%SS_SUNKEN NEXT DIALOG SHOW MODELESS hDlg END IF CONTROL SET TEXT hDlg, ID * 10, STR$(task(P(ID).tasknr).freq) CONTROL SET TEXT hDlg, ID * 10 + 1, STR$(P(ID).aan) 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) IF P(ID).done THEN CONTROL SET TEXT hDlg, 100 + ID, STR$(P(ID).done) END IF IF ID >= 7 THEN FOR i = 0 TO 32 'show last 70 buf = buf + CHR$(@pHist[i]) NEXT ID = 0 ELSE INCR ID END IF #ENDIF END SUB CALLBACK FUNCTION PiOff LOCAL i AS LONG FOR i = 0 TO 127 NoteOff task(P(7).tasknr).channel, i NEXT END FUNCTION CALLBACK FUNCTION PipOff LOCAL i AS LONG FOR i = 0 TO 127 NoteOff task(P(1).tasknr).channel, i DIALOG DOEVENTS 'slowdown NEXT END FUNCTION '[EOF] _