86 lines
2.6 KiB
Fortran
86 lines
2.6 KiB
Fortran
module soundbrotch
|
|
|
|
implicit none
|
|
! ---------------------------------------------------------
|
|
type t_sample2i
|
|
integer :: left
|
|
integer :: right
|
|
end type
|
|
! ---------------------------------------------------------
|
|
! some private variables
|
|
|
|
integer, private :: samplerate = 48000
|
|
real, private :: diapason = 440.0
|
|
contains
|
|
! ---------------------------------------------------------
|
|
subroutine soundbrotch_version ()
|
|
write(0, '(1X,A)') "--- this is soundbrotch version alpha 667"
|
|
write(0, *) "--- samplerate", samplerate
|
|
write(0, *) "--- diapason ", diapason
|
|
end subroutine
|
|
! ---------------------------------------------------------
|
|
! ---------------------------------------------------------
|
|
! premier essai, le prototype peut changer !
|
|
|
|
subroutine sinw_burst2i (dst, numbs, fra, frb, level)
|
|
integer, intent(in) :: dst ! output unit number
|
|
integer, intent(in) :: numbs ! number of sample to be made
|
|
real, intent(in) :: fra, frb ! left and right frequency
|
|
real, intent(in) :: level ! amplitude in [0..1]
|
|
|
|
integer :: idx, left, right
|
|
real :: coef
|
|
|
|
! XXX temporary dirty hack
|
|
if (dst .NE. 6) then
|
|
STOP ' OUPS, NOT ON STDOUT!'
|
|
endif
|
|
|
|
coef = (3.141592654 * 2.0) / real(samplerate)
|
|
do idx=0, numbs
|
|
left = INT(32e3 * level * sin(coef*real(idx)*fra))
|
|
right = INT(32e3 * level * sin(coef*real(idx)*frb))
|
|
call xper_spit_2i(left, right)
|
|
enddo
|
|
|
|
end subroutine
|
|
! ---------------------------------------------------------
|
|
! mmmm ?
|
|
subroutine silence_burst2i(nbsmpl)
|
|
integer, intent(in) :: nbsmpl
|
|
integer :: idx
|
|
do idx=0, nbsmpl
|
|
call xper_spit_2i(0, 0)
|
|
enddo
|
|
end subroutine
|
|
! ---------------------------------------------------------
|
|
! mmmm ?
|
|
subroutine xper_spit_2i(lsmpl, rsmpl)
|
|
integer, intent(in) :: lsmpl, rsmpl
|
|
integer, save :: oldl, oldr
|
|
integer :: tmpl, tmpr
|
|
|
|
tmpl = (lsmpl + oldl) / 2
|
|
tmpr = (rsmpl + oldr) / 2
|
|
print *, tmpl, tmpr
|
|
oldl = tmpl
|
|
oldr = tmpr
|
|
|
|
end subroutine
|
|
! ---------------------------------------------------------
|
|
!
|
|
function midi2freq(note)
|
|
integer, intent(in) :: note
|
|
real :: midi2freq
|
|
|
|
real :: freq
|
|
|
|
freq = (DIAPASON/32.0) * (2.0 ** (real(note - 9) / 12.0));
|
|
! write(0, *) "> ", note, freq
|
|
|
|
midi2freq = freq
|
|
|
|
end function
|
|
end module
|
|
|