Fake space music

[PhilOfPerth]

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.