!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Sergio Steffe' - Laboratorio Sperimentale di Matematica Computazionale
! Dipartimento di Matematica - Universita' di Pisa - AA 2002/2003
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
program sorgente
!
!!!!!!!!!!!!!!! descrizione !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!suono generato da sorgente di cui e' assegnata
!  posizione xs,ys
!  durata ts
!  frequenza freqs
!  ampiezza amps
!
!formato di uscita: (16bit big endian stereo PCM)
!
!!!!!!!!!!!!!!! dichiarazioni !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
IMPLICIT NONE
!
!
INTEGER,PARAMETER ::  iduemax=32767
!mi tengo sotto il minimo valore 32767 per non avere guai con l'arrotondamento
!
!
!2 pi greco
DOUBLE PRECISION pi2
!
!frequenza di campionamento
DOUBLE PRECISION fsample
!
!velocita del suono
DOUBLE PRECISION csound
!
!semidistanza tra le orecchie
DOUBLE PRECISION delta
!
!frequenza del suono 
DOUBLE PRECISION freqs
!
!durata totale del suono
DOUBLE PRECISION ts
!
!posizione sorgente
DOUBLE PRECISION xs,ys
!
!ampiezza del suono generato
DOUBLE PRECISION amps
!
!distanza sorgente orecchie
DOUBLE PRECISION ddss,dsns
!tempi di volo sorgente orecchie
DOUBLE PRECISION tdss,tsns
!
!
!numero capionature
INTEGER NTOT
!
!nome del file di output
CHARACTER(len=25) FILENAME
!
!posfisso da aggiungere al nome file
CHARACTER(len=4) :: POSTF='.cdr'
!
!variabile per lettura nome file
CHARACTER(len=20) FILENAME1
!
!
!contatore principale del generatore del suono
INTEGER I
!
!istante di tempo 
DOUBLE PRECISION t
!
!segnale sonoro a ds e sn in scala arbitraria tra -1 e +1
DOUBLE PRECISION soundds,soundsn
!
!interi usati per conversioni da real a intero due bytes big little endian
INTEGER(2) iids,iisn,ii,iii,jj
!
!
!!!!!!!!!!!!!! assegnazione delle variabili !!!!!!!!!!!!!!!!!!!!!!!!!!!
write(*,*)'Nome del file (max 20 char senza spazi): '
read(*,*) FILENAME1
FILENAME = FILENAME1(1:SCAN( FILENAME1,' ',.FALSE.)-1)//POSTF
write(*,*)'hai detto: ',FILENAME
!
write(*,*)'Frequenza:'
read(*,*) freqs
write(*,*)'hai detto: ',freqs
!
write(*,*)'Ampiezza (0.0-1.0):'
read(*,*) amps
IF (amps < 0.0) THEN
amps=0.0
ENDIF
IF (amps > 1.0) THEN
amps=1.0
ENDIF
write(*,*)'hai detto: ',amps
!
write(*,*)'Posizione (x,y):'
read(*,*)xs,ys
write(*,*)'hai detto: ',xs,ys
!
write(*,*)'Durata in secondi:'
read(*,*)ts
write(*,*)'hai detto: ',ts
!
!
!!!!!!!!!!!!!! inizio calcoli !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!si apre il file
!REPLACE crea o cancella se esistente
!UNFORMATTED usa formato interno per salvare i dati
!DIRECT usa l'accesso ad un qualsiasi record
!RECL e' la lunghezza di ogni record (4 bytes)
!
open(unit=10,file=FILENAME,status='REPLACE',form='UNFORMATTED',access='DIRECT',RECL=4)
!
!setup delle variabili
!
pi2=8*atan(1.0)
fsample=44100.0
csound=330.0
delta=0.1
!
!distanze e tempo di volo
!
ddss=sqrt((xs+delta)**2 + ys**2)
dsns=sqrt((xs-delta)**2 + ys**2)
tdss=ddss/csound
tsns=dsns/csound
!
NTOT=ts*fsample +0.5
!
!loop principale
!
do I=1,NTOT
!istante di tempo
t=i
t=t/fsample
!

soundds=((amps*sin((t-tdss)*pi2*freqs))*iduemax)/ddss
soundsn=((amps*sin((t-tsns)*pi2*freqs))*iduemax)/dsns
!
ii=soundds
call MVBITS(ii,0,8,iids,8)
call MVBITS(ii,8,8,iids,0)
ii=soundsn
call MVBITS(ii,0,8,iisn,8)
call MVBITS(ii,8,8,iisn,0)
!
write(unit=10,rec=i) iids,iisn

end do	
close(unit=10)
write(*,*)'Scritti',ts,'secondi suono (PCM 2x16 bit big endian) nel file:',FILENAME
end program sorgente

