I made some more modifications:
Code: (Select All)
'by mnrvovrfc 20-June-2023
'works in QB64 Phoenix Edition v3.8 and later
'otherwise see below
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 'ONLY ONCE
'the following up to the next comment for QB64PE v3.8 or later:
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$
'use this line instead for earlier QB64PE, or for other QB64:
'e$ = "MBMNT" + _TRIM$(STR$(Rand(9, 16) * 10)) + "O3"
_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
'CHANGED: u
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.
