56 lines
1.6 KiB
Fortran
56 lines
1.6 KiB
Fortran
module soundbrotch
|
|
|
|
implicit none
|
|
! ---------------------------------------------------------
|
|
type t_sample2i
|
|
integer :: left
|
|
integer :: right
|
|
end type
|
|
! ---------------------------------------------------------
|
|
contains
|
|
! ---------------------------------------------------------
|
|
|
|
subroutine soundbrotch_version ()
|
|
write(0, '(1X,A)') "--- this is soundbrotch version alpha 666"
|
|
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
|
|
integer, save :: oldl=0, oldr=0
|
|
|
|
coef = (3.141592654 * 2.0) / 44.1e3
|
|
do idx=0, numbs
|
|
left = INT(32e3 * level * sin(coef*real(idx)*fra))
|
|
left = (left + oldl) / 2
|
|
right = INT(32e3 * level * sin(coef*real(idx)*frb))
|
|
right = (right + oldr) / 2
|
|
print *, left, right
|
|
oldl = left
|
|
oldr = right
|
|
enddo
|
|
! add silence at the end of the burst
|
|
left = 0
|
|
right = 0
|
|
do idx=0, numbs/3
|
|
left = (left + oldl) / 2
|
|
right = (right + oldr) / 2
|
|
print *, 0, 0
|
|
oldl = left
|
|
oldr = right
|
|
enddo
|
|
|
|
end subroutine
|
|
! ---------------------------------------------------------
|
|
|
|
end module
|
|
|