What extra features does VARPTR provide?
#9
Music 
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. Smile

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".
Reply


Messages In This Thread
RE: What extra features does VARPTR provide? - by mnrvovrfc - 06-23-2023, 06:52 PM



Users browsing this thread: 5 Guest(s)