+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Experimental wave sequence creator (/showthread.php?tid=1966)
Experimental wave sequence creator - mnrvovrfc - 09-03-2023
I'm going to post this program here for not having anything else better to offer. It's a silly sound generator that exports to wave and supports crude wavetable synthesis. This program should also work in the older QB64, down to v0.98.
Because the size of attachments could be limited by this forum, and because with my online connection, upload is very slow, I have cut all wave files in half of what they were originally. The "scan1.wav" and "scan2.wav" are exactly 12 seconds long, and "scan3.wav" is eight seconds long, this will make it easier to use offsets if that makes any sense for something that is nowhere near acoustic drum rhythms. You could supply your own but they have to have the names "scan1.wav" to "scan6.wav" for this program. Keep the samples as short as possible, not much longer than 12 seconds. If you choose a power of 2 as the length it becomes easy to create wavetable messes at 120 beats per minute.
The wave files to be used with this program must be 44100Hz 16-bit mono (one channel). It saves in that format. It cannot handle any other format.
The format of "wavesa.txt" is:
one section has "functions" which are explained in the other documentation file.
the "===" separator.
the second section which recalls the "functions" by line number.
It's recommended the "wavesa.txt" file is 1000 lines or less.
I show the source code for the program here but please read the documentation.
Code: (Select All)
'by mnrvovrfc 2020/10/10
'fixed on 2023/9/3 so it works on QB64PE, and on Linux as well as Windows
_DEFINE A-Z AS LONG
TYPE wavetypehead
ariff AS STRING * 4
num1 AS LONG
wavefmt AS STRING * 8
junk AS STRING * 20
adata AS STRING * 4
num2 AS LONG
END TYPE
DIM bufi(1 TO 6, 1 TO 1323000) AS INTEGER, bufs(1 TO 6)
DIM ss(1 TO 1000) AS STRING
DIM wh AS wavetypehead
DIM goahead AS _BIT, usetan AS _BIT, sampvolu AS _BIT, quadruple AS _BIT, multbefore AS _BIT
DIM loadscan AS _BIT, dcdc AS INTEGER
DIM xx AS SINGLE, yy AS SINGLE, torad AS SINGLE, volu AS SINGLE, twopi AS SINGLE, etarpmas AS SINGLE
wavefilehead$ = "RIFF WAVEfmt " + chrn$(16000101068, 2, 1, 1, 1, 1, 1, 1, 1, 2)_
+ chrn$(17200136881020, 3, 1, 1, 3, 2, 1, 1, 1, 1) + chr$(16) + chr$(0) + "data"
torad = 4 * ATN(1)
twopi = torad * 2
torad = torad / 180
etarpmas = 1 / 44100
FOR w = 1 TO 6
afile$ = "scan" + CHR$(48 + w) + ".wav"
IF NOT _FILEEXISTS(afile$) THEN
PRINT "File NOT found: "; afile$
GOTO pend
END IF
NEXT
ifile$ = "wavesa.txt"
outfile$ = "wavesa-render.wav"
REDIM sc(1 TO 1) AS STRING
cycle = 360
limsec = 0
volu = 0.25
dcdc = 0
u = GetCommand(sc())
IF u > 0 THEN
FOR w = 1 TO u
IF INSTR(LCASE$(sc(w)), ".txt") > 0 THEN
a$ = sc(w)
IF _FILEEXISTS(a$) THEN
ifile$ = a$
PRINT "Input text filename set to:"
PRINT ifile$
END IF
ELSEIF LEFT$(sc(w), 2) = "--" THEN
a$ = LCASE$(MID$(sc(w), 3))
IF a$ = "help" THEN
helpme
ELSEIF LEFT$(a$, 3) = "out" THEN
b$ = MID$(a$, 4)
IF INSTR(LCASE$(b$), ".wav") > 0 THEN
IF _FILEEXISTS(b$) THEN
PRINT "Cannot execute to overwrite output file."
PRINT b$
GOTO pend
END IF
outfile$ = b$
PRINT "Output filename set to:"
PRINT outfile$
END IF
ELSEIF LEFT$(a$, 5) = "cycle" THEN
n = VAL(MID$(a$, 6))
IF n < 360 THEN
PRINT "Cannot accept a 'cycle' less than 360!"
ELSE
cycle = n
END IF
ELSEIF a$ = "tan" THEN
usetan = NOT usetan
ELSEIF a$ = "samp" THEN
sampvolu = NOT sampvolu
ELSEIF a$ = "quad" THEN
quadruple = NOT quadruple
ELSEIF a$ = "mult" THEN
multbefore = NOT multbefore
ELSEIF LEFT$(a$, 3) = "vol" THEN
n = VAL(MID$(a$, 4))
IF n < 1 THEN
PRINT "Volume control cannot be silence!"
ELSEIF n > 100 THEN
n = 100
END IF
volu = n / 100
ELSEIF LEFT$(a$, 3) = "lim" OR LEFT$(a$, 5) = "limit" THEN
IF LEFT$(a$, 5) = "limit" THEN x = 6 ELSE x = 4
b$ = MID$(a$, x)
n = VAL(b$)
IF INSTR(b$, ".") > 0 AND INT(n) >= 1 THEN
limsec = INT(VAL(b$) * 44100)
ELSEIF n < 4410 THEN
PRINT "Output wave file must be at least 4410 samples. Size is NOT limited."
ELSEIF n > 1323000 THEN
PRINT "Provided output file size longer than 1 minute, thus it's NOT limited."
limsec = 0
ELSE
limsec = n
END IF
ELSEIF LEFT$(a$, 2) = "dc" THEN
b$ = MID$(a$, 3)
IF LEN(b$) <= 4 THEN
n = VAL("&H" + b$)
IF n <> 0 AND limsec > 0 THEN
dcdc = n
PRINT "Requested overlaid DC offset of"; dcdc
END IF
END IF
END IF
END IF
NEXT
END IF
IF NOT _FILEEXISTS(ifile$) THEN
PRINT "File NOT found: "; ifile$
GOTO pend
END IF
brekass = 0
fi = FREEFILE
OPEN ifile$ FOR INPUT AS fi
n = 0
DO UNTIL EOF(fi)
LINE INPUT #fi, a$
a$ = NewTrim$(a$, 1, 1)
IF a$ <> "" THEN
n = n + 1
ss(n) = a$
IF a$ = "===" THEN brekass = n
IF NOT loadscan THEN
IF INSTR(a$, "+") > 0 THEN loadscan = -1
END IF
IF n >= 1000 THEN EXIT DO
END IF
LOOP
CLOSE fi
IF n = 0 OR brekass < 2 OR brekass = n THEN
PRINT "Input text file is not in the correct format!"
GOTO pend
END IF
brekass = brekass + 1
nitems = n
IF limsec = 0 THEN
bg = 4410
REDIM bufo(1 TO bg) AS INTEGER
ELSE
REDIM bufo(1 TO limsec) AS INTEGER
END IF
IF loadscan THEN
FOR w = 1 TO 6
afile$ = "scan" + CHR$(48 + w) + ".wav"
goahead = 0
fi = FREEFILE
OPEN afile$ FOR BINARY AS fi
GET #fi, , wh
IF wh.ariff = "RIFF" AND wh.wavefmt = "WAVEfmt " AND wh.adata = "data" THEN
u = wh.num2 \ 2
IF u > 1323000 THEN
CLOSE fi
PRINT "Input wave file is too big to be used for this process."
PRINT afile$
GOTO pend
END IF
bufs(w) = u
REDIM buftemp(1 TO u) AS INTEGER
GET #fi, , buftemp()
goahead = -1
END IF
CLOSE fi
IF goahead THEN
FOR i = 1 TO u
bufi(w, i) = buftemp(i)
NEXT
ERASE buftemp
ELSE
PRINT "The following file could not be processed:"
PRINT afile$
GOTO pend
END IF
NEXT
ELSE
PRINT "Warning: input wave files were NOT loaded!"
END IF
hp = 1
FOR i = brekass TO nitems
f = VAL(ss(i))
IF f > 0 AND f <= brekass - 2 THEN
l = 0
u = INSTR(ss(f), "+")
v = 1
IF u > 0 THEN
IF NOT loadscan THEN
PRINT "Something is wrong! Input waves weren't loaded..."
GOTO pend
END IF
ELSE
u = INSTR(ss(f), "*")
v = 2
END IF
IF u = 0 THEN
u = INSTR(ss(f), "#")
v = 4
END IF
IF u = 0 THEN
u = INSTR(ss(f), "&")
v = 5
END IF
IF u = 0 THEN v = 3
SELECT CASE v
CASE 1
n = VAL(LEFT$(ss(f), u - 1))
xx = VAL(MID$(ss(f), u + 1))
m = INT(xx)
IF n > 0 AND n < 7 AND m >= 0 AND m <= 100 THEN
xx = xx / 100
m = -1 * INT((-1 * xx) * bufs(n))
m = m + 1
FOR j = 1 TO cycle
IF sampvolu THEN
e = INT(bufi(n, m) * volu)
ELSE
e = bufi(n, m)
END IF
IF l < 20 THEN
bufo(hp) = INT(e * (l / 20))
l = l + 1
ELSE
bufo(hp) = e
END IF
m = m + 1
IF m > bufs(n) THEN m = 1
hp = hp + 1
IF limsec > 0 AND hp > limsec THEN EXIT FOR
IF limsec = 0 AND hp > bg THEN GOSUB realloc
NEXT
GOSUB dofadeout
END IF
CASE 2
IF LEFT$(ss(f), 2) = "0*" OR VAL(ss(f)) = 0 THEN
n = VAL(MID$(ss(f), u + 1))
DO WHILE n > 0
bufo(hp) = 0
hp = hp + 1
IF limsec > 0 AND hp > limsec THEN EXIT DO
IF limsec = 0 AND hp > bg THEN GOSUB realloc
n = n - 1
LOOP
ELSE
xx = VAL(LEFT$(ss(f), u - 1))
n = VAL(MID$(ss(f), u + 1))
IF usetan AND quadruple THEN n = n * 4
yy = 0
DO WHILE n > 0
DO WHILE yy < 360
goahead = -1
IF usetan THEN
m = INT(yy)
IF m >= 105 AND m <= 255 THEN
IF multbefore THEN
e = INT(TAN(yy * torad) * 32767 * volu)
ELSE
e = INT(TAN(yy * torad) * 32767)
END IF
IF e < -32768 THEN e = -32768
IF e > 32767 THEN e = 32767
IF NOT multbefore THEN e = INT(e * volu)
ELSE
goahead = 0
END IF
ELSE
e = INT(SIN(yy * torad) * 32767 * volu)
END IF
IF goahead THEN
IF l < 20 THEN
bufo(hp) = INT(e * (l / 20))
l = l + 1
ELSE
bufo(hp) = e
END IF
hp = hp + 1
IF limsec > 0 AND hp > limsec THEN EXIT DO
IF limsec = 0 AND hp > bg THEN GOSUB realloc
END IF
yy = yy + xx
LOOP
IF limsec > 0 AND hp > limsec THEN EXIT DO
yy = yy - 360
n = n - 1
LOOP
GOSUB dofadeout
END IF
CASE 3
n = INT(VAL(ss(f)) * volu)
IF n >= -32768 AND n <= 32767 THEN
FOR j = 1 TO cycle
bufo(hp) = n
hp = hp + 1
IF limsec > 0 AND hp > limsec THEN EXIT FOR
IF limsec = 0 AND hp > bg THEN GOSUB realloc
NEXT
END IF
CASE 4
IF LEFT$(ss(f), 2) <> "0#" THEN
xx = VAL(LEFT$(ss(f), u - 1))
IF xx > 0 THEN
n = VAL(MID$(ss(f), u + 1)) * cycle
yy = 0
FOR j = 1 TO n
DO
goahead = -1
IF usetan THEN
m = INT(yy)
IF m >= 105 AND m <= 255 THEN
IF multbefore THEN
e = INT(TAN(yy * torad) * 32767 * volu)
ELSE
e = INT(TAN(yy * torad) * 32767)
END IF
IF e < -32768 THEN e = -32768
IF e > 32767 THEN e = 32767
IF NOT multbefore THEN e = INT(e * volu)
ELSE
goahead = 0
END IF
ELSE
e = INT(SIN(yy * torad) * 32767 * volu)
END IF
IF goahead THEN
IF l < 20 THEN
bufo(hp) = INT(e * (l / 20))
l = l + 1
ELSE
bufo(hp) = e
END IF
hp = hp + 1
IF limsec > 0 AND hp > limsec THEN EXIT FOR
IF limsec = 0 AND hp > bg THEN GOSUB realloc
END IF
yy = yy + xx
IF INT(yy) >= 360 THEN yy = yy - 360
LOOP UNTIL goahead
NEXT
GOSUB dofadeout
END IF
END IF
CASE 5
IF LEFT$(ss(f), 2) <> "0&" THEN
xx = VAL(LEFT$(ss(f), u - 1))
IF xx > 0 AND xx < 8000 THEN
IF usetan THEN xx = xx / 4
xx = xx * twopi * etarpmas
n = VAL(MID$(ss(f), u + 1)) * cycle
''note this time "yy" has to be in RADIANS
yy = 0
FOR j = 1 TO n
DO
goahead = -1
IF usetan THEN
m = INT(yy / torad)
IF m >= 105 AND m <= 255 THEN
IF multbefore THEN
e = INT(TAN(yy) * 32767 * volu)
ELSE
e = INT(TAN(yy) * 32767)
END IF
IF e < -32768 THEN e = -32768
IF e > 32767 THEN e = 32767
IF NOT multbefore THEN e = INT(e * volu)
ELSE
goahead = 0
END IF
ELSE
e = INT(SIN(yy) * 32767 * volu)
END IF
IF goahead THEN
IF l < 20 THEN
bufo(hp) = INT(e * (l / 20))
l = l + 1
ELSE
bufo(hp) = e
END IF
hp = hp + 1
IF limsec > 0 AND hp > limsec THEN EXIT FOR
IF limsec = 0 AND hp > bg THEN GOSUB realloc
END IF
yy = yy + xx
IF yy >= twopi THEN yy = yy - twopi
LOOP UNTIL goahead
NEXT
GOSUB dofadeout
END IF
END IF
END SELECT
END IF
IF limsec > 0 AND hp > limsec THEN
PRINT "Limit reached around line"; i
EXIT FOR
END IF
NEXT
IF limsec = 0 THEN
ac = bg * 2
ELSE
ac = limsec * 2
IF dcdc <> 0 THEN
FOR i = 1 TO limsec
u = bufo(i) + dcdc
IF u < -32768 THEN u = -32768
IF u > 32767 THEN u = 32767
bufo(i) = u
NEXT
END IF
END IF
ab = ac + &H24
ff = FREEFILE
OPEN outfile$ FOR BINARY AS ff
PUT #ff, , wavefilehead$
PUT #ff, , ac
PUT #ff, , bufo()
PUT #ff, 5, ab
CLOSE ff
PRINT "Output wave file created:"
PRINT outfile$
GOTO pend
pend:
END
realloc:
bg = bg + 4410
REDIM _PRESERVE bufo(1 TO bg) AS INTEGER
RETURN
dofadeout:
l = hp
IF l < 20 THEN RETURN
IF limsec > 0 AND hp > limsec THEN l = limsec
FOR j = 0 TO 19
bufo(l) = bufo(l) * (j / 20)
l = l - 1
NEXT
RETURN
SUB helpme ()
DIM sh(1 TO 23) AS STRING
CLS
sh(1) = "$07Usage: $01wavesa.exe $04{$09text-file.txt$04} {$09switches$04}"
sh(2) = "$07 Input text file should have full path,"
sh(3) = "$07 Otherwise it's assumed to be $0F'wavesa.txt'"
sh(4) = "$07 in the same directory as this EXE file."
sh(5) = "$07 Text file $0Fmust$07 have $0F'==='$07 to separate"
sh(6) = "$07 functions from indexes."
sh(7) = " Switches (prefix with $0F'--'$07) are:"
sh(8) = "$0F out$09abc $07Name the output wave file."
sh(9) = "$0F cycle$09# $07Set the size of a cycle"
sh(10) = "$07 (default=360, cannot set less than this)"
sh(11) = "$07 This indicates how much of imported sample"
sh(12) = "$07 per function execution."
sh(13) = "$0F limit$09#.# $07Output wave file limit"
sh(14) = "$0F $09x $07= integer number of samples"
sh(15) = "$0F $09x.y $07= float number of seconds"
sh(16) = "$0F vol$09# $07Volume control (1 to 100, 100=max amplitude, default=25)"
sh(17) = "$07 This is always applied to generated waveforms."
sh(18) = "$0F dc$09hhhh $07Overlay a DC offset. Number must be in hexadecimal."
sh(19) = "$0F tan $07Use tangent instead of sine for waveform generation."
sh(20) = "$0F samp $07Subject imported samples to volume control."
sh(21) = "$0F mult $07For tangent waveform generation, do multiplication"
sh(22) = "$07 and attenuation before clipping."
sh(23) = "$0F quad $07Quadruple the passes for tangent waveform generation."
FOR i = 1 TO 23
LOCATE i, 1
TXIprint sh(i)
NEXT
END SUB
FUNCTION chrn$ (nn AS _UNSIGNED _INTEGER64, a1 AS _BYTE, a2 AS _BYTE, a3 AS _BYTE, a4 AS _BYTE, a5 AS _BYTE, a6 AS _BYTE, a7 AS _BYTE, a8 AS _BYTE, a9 AS _BYTE)
DIM aa(1 TO 9) AS _UNSIGNED _BYTE, ab(1 TO 9) AS _UNSIGNED _BYTE
IF nn = 0 THEN chrn$ = "": EXIT FUNCTION
aa(1) = a1: aa(2) = a2: aa(3) = a3
aa(4) = a4: aa(5) = a5: aa(6) = a6
aa(7) = a7: aa(8) = a8: aa(9) = a9
j = 1
a$ = LTRIM$(STR$(nn))
DO UNTIL a$ = ""
IF aa(j) = 0 THEN EXIT DO
ab(j) = VAL(LEFT$(a$, aa(j)))
a$ = MID$(a$, aa(j) + 1)
j = j + 1
IF j > 9 THEN EXIT DO
LOOP
sret$ = ""
FOR i = 1 TO 9
IF aa(i) > 0 THEN sret$ = sret$ + CHR$(ab(i))
NEXT
chrn$ = sret$
END FUNCTION
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
FUNCTION FieldString$ (tx$, ndx%, delim$)
DIM AS LONG count, z1, z2, lx, y
IF (tx$ = "") OR (delim$ = "") OR (ndx% < 1) THEN
FieldString$ = ""
ELSE
count = CountString(tx$, delim$) + 1
IF ndx% > count THEN
FieldString$ = ""
EXIT FUNCTION
END IF
lx = LEN(delim$)
z1 = 1
z2 = INSTR(tx$, delim$)
y = 0
DO UNTIL z2 = 0
y = y + 1
IF y >= ndx% THEN EXIT DO
z1 = z2 + lx
z2 = INSTR(z1, tx$, delim$)
LOOP
IF (z2 = 0) AND (y <= ndx%) THEN
FieldString$ = MID$(tx$, z1)
ELSE
FieldString$ = MID$(tx$, z1, z2 - z1)
END IF
END IF
END FUNCTION
FUNCTION GetCommand% (args$())
comd$ = COMMAND$
IF comd$ = "" THEN
GetCommand% = 0
EXIT FUNCTION
END IF
delim$ = CHR$(1)
inquote = 0
lx = LEN(comd$)
DO UNTIL lx < 1
b$ = MID$(comd$, lx, 1)
IF b$ = CHR$(34) THEN
inquote = NOT inquote
ELSEIF (b$ = " ") AND (inquote = 0) THEN
MID$(comd$, lx, 1) = delim$
END IF
lx = lx - 1
LOOP
z = CountString(comd$, delim$) + 1
REDIM args$(1 TO z)
FOR y = 1 TO z
args$(y) = FieldString$(comd$, y, delim$)
IF (LEFT$(args$(y), 1) = CHR$(34)) AND (RIGHT$(args$(y), 1) = CHR$(34)) THEN
lx = LEN(args$(y)) - 2
args$(y) = MID$(args$(y), 2, lx)
END IF
NEXT
GetCommand% = z
END FUNCTION
FUNCTION NewTrim$ (tx$, fromleft%, fromright%)
DIM a$, b AS INTEGER
DIM AS LONG j, lx
IF (fromleft% = 0) AND (fromright% = 0) THEN
NewTrim$ = tx$
EXIT FUNCTION
END IF
a$ = tx$
lx = LEN(a$)
IF fromleft% THEN
FOR j = 1 TO lx
b = ASC(a$, j)
IF b > 32 THEN EXIT FOR
NEXT
IF j <= lx THEN a$ = MID$(a$, j): lx = LEN(a$)
END IF
IF fromright% THEN
FOR j = lx TO 1 STEP -1
b = ASC(a$, j)
IF b > 32 THEN EXIT FOR
NEXT j
IF j > 0 THEN a$ = LEFT$(a$, j)
END IF
NewTrim$ = a$
END FUNCTION
SUB TXIprint (t$)
IF t$ = "" THEN EXIT SUB
IF LTRIM$(RTRIM$(t$)) = "" THEN EXIT SUB
sl = LEN(t$)
j = 1
DO WHILE j <= sl
b$ = MID$(t$, j, 1)
IF b$ = "#" OR b$ = "$" THEN
z$ = MID$(t$, j + 1, 2)
o = VAL("&H" + z$)
IF o > 0 OR (o = 0 AND z$ = "00") THEN
IF b$ = "$" THEN
COLOR o MOD 16, o \ 16
ELSE
PRINT CHR$(o);
END IF
END IF
j = j + 3
ELSE
PRINT b$;
j = j + 1
END IF
LOOP
END SUB
The "GetCommand()" could be replaced, but it's there because early QB64 versions don't support "conditional" compilation.
The "TXIPrint" subprogram reveals another mess that I might post about in the future...
mnrvovrfc-wavesa.zip (Size: 4.61 MB / Downloads: 33)