I made some more modifications:
Code: (Select All)
| |
| |
| |
| |
| OPTION _EXPLICIT |
| |
| DIM frag(1 TO 48) AS STRING |
| DIM scales(1 TO 2, 1 TO 5) AS INTEGER |
| DIM phrase(1 TO 10) AS STRING |
| DIM AS INTEGER basenote, numfrag, n, vu, ve, u, a, b, c, d |
| DIM AS INTEGER x, y |
| DIM e$, f$, notes$, nop$, ncl$, double1 AS _BYTE, double2 AS _BYTE |
| DIM octav$, setdot AS _BYTE, fe as long |
| |
| notes$ = "C C#D D#E F F#G G#A A#B " |
| |
| RANDOMIZE TIMER |
| |
| octav$ = "O3" |
| double1 = Random1(2) - 1 |
| double2 = Random1(2) - 1 |
| FOR y = 1 TO 2 |
| basenote = Random1(12) * 2 - 1 |
| FOR x = 1 TO 5 |
| scales(y, x) = basenote |
| basenote = basenote + Rand(3, 6) * 2 |
| if y = 1 and basenote >= 40 then octav$ = "O2" |
| NEXT |
| NEXT |
| |
| vu = 0 |
| ve = 0 |
| FOR y = 1 TO 32 |
| setdot = 0 |
| u = Random1(10) |
| SELECT CASE u |
| CASE 1: e$ = "L4~~" |
| CASE 2: e$ = "L8~~~~" |
| CASE 3: e$ = "L4~L8~~" |
| CASE 4: e$ = "L8~~L4~" |
| CASE 5: e$ = "L8~L4~L8~" |
| CASE 6: e$ = "L16~~L8~L4~" |
| CASE 7: e$ = "L16~~~~L4~" |
| CASE 8: e$ = "L8~~L16~~~~" |
| CASE 9: e$ = "L8~L16~~L8~L16~~" |
| CASE 10 |
| setdot = 1 |
| e$ = "L4~L8~" |
| END SELECT |
| |
| setdot = 0 |
| x = CountString(e$, "~") |
| n = scales(1, Random1(2)) |
| DO WHILE x > 0 |
| nop$ = "" |
| ncl$ = "" |
| DO WHILE n > 23 |
| nop$ = nop$ + ">" |
| ncl$ = ncl$ + "<" |
| n = n - 24 |
| LOOP |
| DO |
| vu = Random1(3) |
| LOOP WHILE vu = ve |
| ve = vu |
| SELECT CASE vu |
| CASE 1: nop$ = nop$ + "V50" |
| CASE 2: nop$ = nop$ + "V25" |
| CASE 3: nop$ = nop$ + "V12" |
| END SELECT |
| IF setdot THEN |
| setdot = 0 |
| nop$ = nop$ + RTRIM$(MID$(notes$, n, 2)) + "." + ncl$ |
| ELSE |
| nop$ = nop$ + RTRIM$(MID$(notes$, n, 2)) + ncl$ |
| END IF |
| ReplaceString2 e$, "~", nop$, 1 |
| n = scales(1, Random1(5)) |
| x = x - 1 |
| LOOP |
| frag(y) = e$ |
| NEXT |
| |
| vu = 0 |
| ve = 0 |
| FOR y = 33 TO 48 |
| u = Random1(10) |
| SELECT CASE u |
| CASE 1: e$ = "L4~~" |
| CASE 2: e$ = "L8~~~~" |
| CASE 3: e$ = "L4~L8~~" |
| CASE 4: e$ = "L8~~L4~" |
| CASE 5: e$ = "L8~L4~L8~" |
| CASE 6: e$ = "L16~~L8~L4~" |
| CASE 7: e$ = "L16~~~~L4~" |
| CASE 8: e$ = "L8~~L16~~~~" |
| CASE 9: e$ = "L8~L16~~L8~L16~~" |
| CASE 10 |
| setdot = 1 |
| e$ = "L4~L8~" |
| END SELECT |
| |
| x = CountString(e$, "~") |
| DO WHILE x > 0 |
| n = scales(2, Random1(5)) |
| nop$ = "" |
| ncl$ = "" |
| DO WHILE n > 23 |
| nop$ = nop$ + ">" |
| ncl$ = ncl$ + "<" |
| n = n - 24 |
| LOOP |
| DO |
| vu = Random1(3) |
| LOOP WHILE vu = ve |
| ve = vu |
| SELECT CASE vu |
| CASE 1: nop$ = nop$ + "V50" |
| CASE 2: nop$ = nop$ + "V25" |
| CASE 3: nop$ = nop$ + "V12" |
| END SELECT |
| IF setdot THEN |
| setdot = 0 |
| nop$ = nop$ + RTRIM$(MID$(notes$, n, 2)) + "." + ncl$ |
| ELSE |
| nop$ = nop$ + RTRIM$(MID$(notes$, n, 2)) + ncl$ |
| END IF |
| ReplaceString2 e$, "~", nop$, 1 |
| x = x - 1 |
| LOOP |
| frag(y) = e$ |
| NEXT |
| |
| DO |
| |
| |
| e$ = "MB" |
| if val(right$(time$, 1)) mod 4 = 2 then |
| e$ = e$ + "MST" + _TRIM$(STR$(Rand(18, 25) * 10)) |
| else |
| e$ = e$ + "MNT" + _TRIM$(STR$(Rand(9, 16) * 10)) |
| end if |
| e$ = e$ + "@" + _TRIM$(STR$(Random1(4))) + octav$ |
| |
| |
| |
| _TITLE "Press [ESC] to quit." |
| CLS |
| PRINT e$ |
| PLAY e$ |
| |
| numfrag = Rand(6, 16) |
| n = numfrag |
| FOR x = 1 TO 5 |
| a = Random1(10) |
| b = Random1(10) |
| c = Random1(10) |
| d = Random1(10) |
| phrase(x) = frag(a) + frag(b) + frag(c) + frag(d) |
| IF double1 AND x < 3 THEN phrase(x) = phrase(x) + frag(a) + frag(b) + frag(c) + frag(d) |
| NEXT |
| FOR x = 6 TO 10 |
| a = Rand(33, 40) |
| b = Rand(33, 40) |
| c = Rand(33, 40) |
| d = Rand(33, 40) |
| phrase(x) = frag(a) + frag(b) + frag(c) + frag(d) |
| IF double2 AND x < 8 THEN phrase(x) = phrase(x) + frag(a) + frag(b) + frag(c) + frag(d) |
| NEXT |
| |
| n = numfrag |
| u = 11 |
| DO WHILE n > 0 |
| a = advanceu(11, 24, u) |
| b = advanceu(11, 24, u) |
| c = advanceu(11, 24, u) |
| d = advanceu(11, 24, u) |
| f$ = phrase(Random1(5)) + frag(a) + frag(b) + frag(c) + frag(d) |
| PRINT f$ |
| e$ = e$ + f$ |
| PLAY f$ |
| DO WHILE PLAY(0) > 0 |
| _LIMIT 600 |
| IF _KEYDOWN(27) THEN EXIT DO |
| LOOP |
| IF _KEYDOWN(27) THEN EXIT DO |
| n = n - 1 |
| LOOP |
| IF _KEYDOWN(27) THEN EXIT DO |
| |
| u = Rand(33, 40) |
| n = numfrag |
| DO WHILE n > 0 |
| a = advanceu(33, 48, u) |
| b = advanceu(33, 48, u) |
| c = advanceu(33, 48, u) |
| d = advanceu(33, 48, u) |
| f$ = phrase(Random1(5) + 5) + frag(a) + frag(b) + frag(c) + frag(d) |
| PRINT f$ |
| e$ = e$ + f$ |
| PLAY f$ |
| DO WHILE PLAY(0) > 0 |
| _LIMIT 600 |
| IF _KEYDOWN(27) THEN EXIT DO |
| LOOP |
| IF _KEYDOWN(27) THEN EXIT DO |
| n = n - 1 |
| LOOP |
| IF _KEYDOWN(27) THEN EXIT DO |
| |
| u = Rand(11, 24) |
| n = numfrag |
| DO WHILE n > 0 |
| a = advanceu(11, 32, u) |
| b = advanceu(11, 32, u) |
| c = advanceu(11, 32, u) |
| d = advanceu(11, 32, u) |
| f$ = phrase(Random1(5)) + frag(a) + frag(b) + frag(c) + frag(d) |
| PRINT f$ |
| e$ = e$ + f$ |
| PLAY f$ |
| DO WHILE PLAY(0) > 0 |
| _LIMIT 600 |
| IF _KEYDOWN(27) THEN EXIT DO |
| LOOP |
| IF _KEYDOWN(27) THEN EXIT DO |
| n = n - 1 |
| LOOP |
| |
| LOOP UNTIL 1 |
| |
| _CLIPBOARD$ = e$ |
| fe = FREEFILE |
| OPEN "mnrvovrfc-musak.bas" FOR OUTPUT AS fe |
| PRINT #fe, "PLAY "; CHR$(34); e$; CHR$(34) |
| CLOSE fe |
| SYSTEM |
| |
| |
| |
| FUNCTION advanceu% (fromval AS INTEGER, totoval AS INTEGER, u AS INTEGER) |
| u = u + 1 |
| IF u > totoval THEN u = fromval |
| advanceu% = u |
| END FUNCTION |
| |
| |
| FUNCTION Rand& (fromval&, toval&) |
| DIM sg%, f&, t& |
| IF fromval& = toval& THEN |
| Rand& = fromval& |
| EXIT FUNCTION |
| END IF |
| f& = fromval& |
| t& = toval& |
| IF (f& < 0) AND (t& < 0) THEN |
| sg% = -1 |
| f& = f& * -1 |
| t& = t& * -1 |
| ELSE |
| sg% = 1 |
| END IF |
| IF f& > t& THEN SWAP f&, t& |
| Rand& = INT(RND * (t& - f& + 1) + f&) * sg% |
| END FUNCTION |
| |
| FUNCTION Random1& (maxvaluu&) |
| DIM sg% |
| sg% = SGN(maxvaluu&) |
| IF sg% = 0 THEN |
| Random1& = 0 |
| ELSE |
| IF sg% = -1 THEN maxvaluu& = maxvaluu& * -1 |
| Random1& = INT(RND * maxvaluu& + 1) * sg% |
| END IF |
| END FUNCTION |
| |
| SUB ReplaceString2 (tx AS STRING, sfind AS STRING, repl AS STRING, numtimes AS _UNSIGNED LONG) |
| DIM AS STRING s, t |
| DIM AS _UNSIGNED LONG ls, lx, count, u |
| DIM goahead AS _BYTE |
| IF (tx = "") OR (sfind = "") OR (sfind = repl) OR (LEN(sfind) > LEN(tx)) THEN EXIT SUB |
| s = UCASE$(sfind): t = UCASE$(tx) |
| ls = LEN(s) |
| count = 0 |
| goahead = 1 |
| DO |
| u = INSTR(t, s) |
| IF u > 0 THEN |
| tx$ = LEFT$(tx, u - 1) + repl + MID$(tx, u + ls) |
| t = UCASE$(tx) |
| IF numtimes > 0 THEN count = count + 1: IF count >= numtimes THEN goahead = 0 |
| ELSE |
| goahead = 0 |
| END IF |
| LOOP WHILE goahead |
| END SUB |
| |
| FUNCTION CountString% (tx$, delim$) |
| DIM AS LONG count, z1, z2, lx |
| IF (tx$ = "") OR (delim$ = "") THEN |
| CountString% = 0 |
| EXIT FUNCTION |
| END IF |
| lx = LEN(delim$) |
| z1 = 1 |
| z2 = INSTR(tx$, delim$) |
| count = 0 |
| DO UNTIL z2 = 0 |
| count = count + 1 |
| z1 = z2 + lx |
| z2 = INSTR(z1, tx$, delim$) |
| LOOP |
| CountString% = count |
| END FUNCTION |
Otherwise the music pitch was going too high. I desired to include staccato play option like my other program, and I neglected the sinewave. Yeah it's boring and absolutely needs the octave to start at 2 instead of 3 because the highest pitches could barely be heard...
Fixed measuring wrong which was "L4." then "L16". The last one should be "L8", that is three "L8" of one note, then one "L8" of different note.
I also changed it so it involves way more volume commands -- make it more dynamic. But I wish I could clean up all those angle brackets which look unsightly. Could take down about half the string changing all the ">>" into "O4", and delete the corresponding "<<" while the base is "O2", or something like that.
Now chunks of the PLAY string are played while the program checks for escape key press to quit. EDIT: was forced to change where _CLIPBOARD$ resided because I had a good one playing and, in the process of copying and pasting this text into the forum I lost the song. (boo-hoo)
EDIT: Having problems with Firefox on Manjaro KDE and other stuff so I also added the ability to save to a BAS file called "mnrvovrfc-musak.bas" in the same directory as the executable, with the created PLAY string completed or not, and ready to be loaded and run into the QB64 IDE.
