06-23-2023, 11:38 PM
(06-23-2023, 06:52 PM)mnrvovrfc Wrote: This program (which could be run in any "modern" QB64) is a somewhat frivolous and lengthy example of VARPTR$(). I fixed my "musak" creator to do one set of phrases. This program limits itself only to messing around with the note lengths and with the volume.
Code: (Select All)
'by mnrvovrfc 23-June-2023
OPTION _EXPLICIT
DIM frag(1 TO 48) AS STRING
DIM scales(1 TO 2, 1 TO 5) AS INTEGER
DIM phrase(1 TO 15) AS STRING
DIM AS INTEGER basenote, numfrag, n, vu, ve, u, a, b, c, d
DIM AS INTEGER x, y
DIM AS INTEGER el4, el8, el16, pvol
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
y = 1
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
vu = 0
ve = 0
FOR y = 1 TO 32
setdot = 0
u = Random1(10)
SELECT CASE u
CASE 1: e$ = "L=" + VARPTR$(el4) + "~~"
CASE 2: e$ = "L=" + VARPTR$(el8) + "~~~~"
CASE 3: e$ = "L=" + VARPTR$(el4) + "~L=" + VARPTR$(el8) + "~~"
CASE 4: e$ = "L=" + VARPTR$(el8) + "~~L=" + VARPTR$(el4) + "~"
CASE 5: e$ = "L=" + VARPTR$(el8) + "~L=" + VARPTR$(el4) + "~L=" + VARPTR$(el8) + "~"
CASE 6: e$ = "L=" + VARPTR$(el16) + "~~L=" + VARPTR$(el8) + "~L=" + VARPTR$(el4) + "~"
CASE 7: e$ = "L=" + VARPTR$(el16) + "~~~~L=" + VARPTR$(el4) + "~"
CASE 8: e$ = "L=" + VARPTR$(el8) + "~~L=" + VARPTR$(el16) + "~~~~"
CASE 9: e$ = "L=" + VARPTR$(el8) + "~L=" + VARPTR$(el16) + "~~L=" + VARPTR$(el8) + "~L=" + VARPTR$(el16) + "~~"
CASE 10
setdot = 1
e$ = "L=" + VARPTR$(el4) + "~L=" + VARPTR$(el8) + "~"
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
DO 'ONLY ONCE
e$ = "MBMNT" + _TRIM$(STR$(Rand(9, 16) * 10)) + octav$
_TITLE "Press [ESC] to quit."
CLS
PRINT "Sorry, cannot print out the song because it contains junk known to computers!"
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
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)
u = Random1(4)
select case u
case 1
el4 = 2: el8 = 4: el16 = 8
case 2
el4 = 8: el8 = 16: el16 = 32
case else
el4 = 4: el8 = 8: el16 = 16
end select
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
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
The "L4" was simply changed to "L=" + VARPTR$(el4) for which in half the cases of choosing a random number, "el4" is set to four. There are three variables which control the length and are constantly changed in a related way, so that a portion of the music is played half as fast, or twice as fast. A couple of "phrases" are being played back with the changes to the three note length variables. Note that the volume is still being forced as string because it would require at least an array of four elements each having its own value, and going through it in series for each note in a "phrase".
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) 