OK I wrote a slightly better version which doesn't use cryptic "N" commands LOL.
There's no way that I know to cause it to stop playing the current song. Unfortunately, it means this program plays one song at a time; either it ends or the user presses [ESC]. The logic that handles note amplitude is lame, could be better. I was trying to make sure the "phrases" are emphasized so this becomes less like random musak and more like pop-rock or freeform jazz or something else.
As an added bonus the generated song is copied to the text clipboard. <3
I got an "Illegal function call" from trying to use "L4." or something alike. It seems QB64 expects the dot after a note like "C#4." or "F." which is clumsier to program. If you take a closer look at this program, all the small fragments of music are the same music duration. Therefore, must take that into consideration when inserting the dot.
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$, notes$, nop$, ncl$, double1 AS _BYTE, double2 AS _BYTE
DIM setdot AS _BYTE
notes$ = "C C#D D#E F F#G G#A A#B "
RANDOMIZE TIMER
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
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~L16~"
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
'if not QB64PE might have to remove this IF statement:
IF Random1(3) = 1 THEN
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
END IF
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~L16~"
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
'if not QB64PE might have to remove this IF statement:
IF Random1(3) = 1 THEN
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
END IF
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
e$ = "MBMNT" + _TRIM$(STR$(Rand(9, 16) * 10)) + "@" + _TRIM$(STR$(Random1(3))) + "O3"
'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."
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 < 3 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)
e$ = e$ + phrase(Random1(5)) + frag(a) + frag(b) + frag(c) + frag(d)
n = n - 1
LOOP
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)
e$ = e$ + phrase(Random1(5) + 5) + frag(a) + frag(b) + frag(c) + frag(d)
n = n - 1
LOOP
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)
e$ = e$ + phrase(Random1(5)) + frag(a) + frag(b) + frag(c) + frag(d)
n = n - 1
LOOP
CLS
IF LEN(e$) <= 1596 THEN
PRINT e$
ELSE
PRINT LEFT$(e$, 1596); "..."
END IF
PLAY e$
_CLIPBOARD$ = e$
DO WHILE PLAY(0) > 0
_LIMIT 600
IF _KEYDOWN(27) THEN EXIT DO
LOOP
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
There's no way that I know to cause it to stop playing the current song. Unfortunately, it means this program plays one song at a time; either it ends or the user presses [ESC]. The logic that handles note amplitude is lame, could be better. I was trying to make sure the "phrases" are emphasized so this becomes less like random musak and more like pop-rock or freeform jazz or something else.
As an added bonus the generated song is copied to the text clipboard. <3
I got an "Illegal function call" from trying to use "L4." or something alike. It seems QB64 expects the dot after a note like "C#4." or "F." which is clumsier to program. If you take a closer look at this program, all the small fragments of music are the same music duration. Therefore, must take that into consideration when inserting the dot.