OpenEuphoria

Re: OOPS Re: New procedure: play()

• Posted by "Carl R. White" <C.R.White at SCM.BRAD.AC.UK> Nov 03, 1998
• 1003 views

This is from my projects directory (Notice I haven't built frequency
tables. You could build them if you want to though...):

--------------------------------------------------------------------------
-- Speaker.E -------------------------------------------------------------
--------------------------------------------------------------------------

constant M_SOUND = 1 -- from graphics.e

constant
    Octave = 12,
    Semitone = power(2, 1/Octave)

constant
    A_Diapazon = 440,--Hz
    Middle_C_Offset = -1*Octave + 2--Semitones

procedure sound(atom f) -- from graphics.e
    machine_proc(M_SOUND, f)
end procedure

global procedure dsound(atom frequency, atom delay)
    atom T

    if frequency > 16383 then
        frequency = 0
    end if

    sound(frequency)

    T = time() + (delay / 100)
    while time() < T do
        -- wait
    end while

end procedure

global procedure stopsound()
    sound(0)
end procedure

global procedure note(integer n, atom delay)

    dsound(A_Diapazon * power(Semitone, n+Middle_C_Offset), delay)

end procedure

global procedure endnote(integer n, atom delay)

    note(n, delay)
    stopsound()

end procedure

--------------------------------------------------------------------------
-- SpeaTest.Ex -----------------------------------------------------------
--------------------------------------------------------------------------

include speaker.e

constant
    Data = {1,5,8,10,11,10,8,5}, -- A "groovy" 50's riff!
    Keys = {1, 1, 6, 1, 8, 6, 1} -- A chord scheme

for j = 1 to length(Keys) do
    for i = 1 to length(Data) do
        endnote(Data[i]+Keys[j]-1, 14)
        endnote(Data[i]+Keys[j]-1, 14)
    end for
end for
stopsound()

--
Carl R White -- Final Year Computer Science at the University of Bradford
E-mail...: cyrek- at -bigfoot.com -- Remove the hyphens before mailing. Ta :)
URL......: http://www.bigfoot.com/~cyrek/
Ykk rnyllaqur rgiokc cea nyemdok ymc giququezka caysgr -- B.Q.Vgesa