06-23-2023, 11:32 PM
(06-23-2023, 06:55 PM)mnrvovrfc Wrote: I was supposed to go further with my "musak" creators for PLAY, but decided this time to provide something different. This was an idea I already revealed. I would like to thank Mr.Why from the old forum, from the one Galleon was administrator, for inspiring me many years ago into stuff like this.
This is a program that does silly "space music". It creates an empty QB64 screenie because I'm not a good artist, I focused only on the sound. Press [ESC] to quit. Don't panic if it doesn't leave straight away, give it 3 seconds at least until the sound dies away.
This purposely does 440 samples to generate sound or not, then checks if it could create a new voice. Usually the "space dot" is created which is very brief. At other times, it could create a whitenoise wash (would like to be able to produce a brown or pink noise here instead), or it could create a "space rumble" although not a very good one maybe because the pitches are a bit too high.
There are two constants that could be adjusted near the top of the program. I don't recommend changing "NUMNOISE" to a value near "NUMSOUNDS", otherwise the program will choose the "deep" noises more often than the "dots".
Code: (Select All)
'by mnrvovrfc 23-June-2023
OPTION _EXPLICIT
CONST NUMSOUNDS = 50, NUMNOISE = 10
'active = the voice is active (1=dot random sine; 2=whitenoise; 3=deep space "rumble" sine)
'enable = the voice is being sent to audio output
' (after amplitude envelope goes through attack and release, this is set to zero and "hold" is updated)
'freq = voice frequency, could be changed by "tun"
'acount = amplitude attack increment in degrees
'rcount = amplitude release increment in degrees
' these two operate over half a sinewave to do an amplitude envelope
'a = degrees for amplitude envelope
't = time according to computation in QB64 Wiki example for _SNDRAW
'vol = volume adjustment for the voice
'tun = small change in frequency only for active=3
'hold = after the voice stops being enabled, how long to hold until making this voice available again
' this is a count in samples so depends on sampling rate
' I assumed 44100Hz so this could go for as long as four seconds but not less than 1/4-second
' this is to prevent the sound scape from being too thick
TYPE spacemtype
AS _BYTE active, enable
AS SINGLE freq, acount, rcount, tun, vol, a
AS LONG t, hold
END TYPE
DIM SHARED s(1 TO NUMSOUNDS) AS spacemtype
DIM AS INTEGER kount, i, j, o
DIM AS SINGLE twopi, ao, ag, samprate
twopi = _PI * 2
samprate = _SNDRATE
RANDOMIZE TIMER
_TITLE "Fake Cosmos!"
DO
IF kount < NUMNOISE THEN
kount = kount + 1
createnewsound Rand(2, 3)
ELSE
createnewsound 1
END IF
FOR o = 1 TO 440
ag = 0
FOR i = 1 TO NUMSOUNDS
IF s(i).active THEN
s(i).t = s(i).t + 1
IF s(i).a > 90 THEN
s(i).a = s(i).a + s(i).rcount
ELSE
s(i).a = s(i).a + s(i).acount
END IF
IF s(i).a > 180 THEN
s(i).enable = 0
s(i).hold = s(i).hold - 1
IF s(i).hold < 1 THEN
IF s(i).active > 1 THEN kount = kount - 1
s(i).active = 0
EXIT FOR
END IF
END IF
IF s(i).enable THEN
IF s(i).freq THEN
ao = s(i).freq
IF s(i).tun THEN s(i).freq = s(i).freq + s(i).tun
ELSE
ao = Random1(7900) + 100
END IF
ao = ao / samprate
ao = (SIN(ao * twopi * s(i).t) * s(i).vol * SIN(_D2R(s(i).a)))
ag = ag + ao
END IF
END IF
NEXT 'i
IF ag < -1.0 THEN ag = -1.0
IF ag > 1.0 THEN ag = 1.0
_SNDRAW ag
NEXT 'o
DO WHILE _SNDRAWLEN > 3
_LIMIT 100
IF _KEYDOWN(27) THEN EXIT DO
LOOP
LOOP UNTIL _KEYDOWN(27)
DO WHILE _SNDRAWLEN
_LIMIT 100
LOOP
SYSTEM
SUB createnewsound (which)
DIM AS INTEGER i, j
FOR i = 1 TO NUMSOUNDS
IF s(i).active = 0 THEN j = i: EXIT FOR
NEXT i
IF j = 0 THEN EXIT SUB
s(j).active = which
s(j).enable = 1
s(j).a = 0
IF which = 1 THEN
s(j).freq = Rand(5, 80) * 50
s(j).acount = Rand(30, 100) / 100
s(j).rcount = Rand(30, 100) / 100
s(j).tun = 0
s(j).vol = Rand(10, 50) / 100
s(j).hold = 0
ELSEIF which = 2 THEN
s(j).freq = 0
s(j).tun = 0
s(j).acount = Rand(7, 50) / 10000
s(j).rcount = Rand(25, 100) / 2000
s(j).vol = 0.0625
s(j).hold = Rand(11025, 88200)
ELSEIF which = 3 THEN
s(j).freq = Rand(80, 240)
s(j).acount = Rand(25, 100) / 2000
s(j).rcount = Rand(7, 50) / 10000
s(j).vol = 0.125
s(j).hold = Rand(22050, 176400)
IF Random1(3) = 1 THEN
IF s(j).freq > 160 THEN s(j).tun = -1 ELSE s(j).tun = 1
s(j).tun = s(j).tun * Random1(100) / 1E+6
ELSE
s(j).tun = 0
END IF
END IF
END SUB
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
Fascinating sounds; this will be great for space-theme background music.
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) 