Viewing contents of file '../idllib/jhuapls1r/usr2/sound.pro'
;-------------------------------------------------------------
;+
; NAME:
;       SOUND
; PURPOSE:
;       Gives sound on sparc station 1.
; CATEGORY:
; CALLING SEQUENCE:
;       sound, f
; INPUTS:
;       f = frequency array (Hz).             in
;       May be 2-d: f = [[f1],[f2],...]
;       where length of f1 = length of f2 ...
; KEYWORD PARAMETERS:
;       Keywords:
;         OUT = c.  Returns array to be sent to sparc speaker.
;         IN = c.   Play given array through sparc speaker.
;            If IN is given then f is ignored.
;         /PLAY = play sound from array f or IN.
;            Must be used to play sound.
;         ENVELOPE=env  Loudness envelope (def=all 1).
;            Must have as many points as f.  May be 2-d with
;            a separate envelope for each freq array.
;         SMAX=smax  Max loudness (0 to 1., def=1.).
; OUTPUTS:
; COMMON BLOCKS:
; NOTES:
;       Note: f is processed at the rate of 8192
;         elements/second.  So for 1 second of
;         sound the array must be 8192 elements long.
; MODIFICATION HISTORY:
;       R. Sterner, 26 Dec, 1989
;
; Copyright (C) 1989, Johns Hopkins University/Applied Physics Laboratory
; This software may be used, copied, or redistributed as long as it is not
; sold and this copyright notice is reproduced on each copy made.  This
; routine is provided as is without any express or implied warranties
; whatsoever.  Other limitations apply as described in the file disclaimer.txt.
;-
;-------------------------------------------------------------
 
	pro sound, f, help=hlp, out=c, in=cin, play=ply, $
	  envelope=env, smax=smax, debug=dbg
 
	if keyword_set(hlp) then begin
	  print,' Gives sound on sparc station 1.'
	  print,' sound, f'
	  print,'   f = frequency array (Hz).             in'
	  print,'   May be 2-d: f = [[f1],[f2],...]'
	  print,'   where length of f1 = length of f2 ...'
	  print,' Keywords:'
	  print,'   OUT = c.  Returns array to be sent to sparc speaker.'
	  print,'   IN = c.   Play given array through sparc speaker.'
	  print,'      If IN is given then f is ignored.'
	  print,'   /PLAY = play sound from array f or IN.
	  print,'      Must be used to play sound.'
	  print,'   ENVELOPE=env  Loudness envelope (def=all 1).'
	  print,'      Must have as many points as f.  May be 2-d with'
	  print,'      a separate envelope for each freq array.'
	  print,'   SMAX=smax  Max loudness (0 to 1., def=1.).'
	  print,' Note: f is processed at the rate of 8192'
	  print,'   elements/second.  So for 1 second of'
	  print,'   sound the array must be 8192 elements long.'
	  return
	endif
 
	if n_elements(smax) eq 0 then smax = 1.
 
	eflag = 0
	if n_elements(env) ne 0 then begin
	  eflag = 1
	  sz = size(env)
	  if sz(0) eq 1 then lste=0 else lste=sz(2)-1
	endif
 
	if n_params(0) gt 0 then begin
	  t = 2.*!dpi/8192.
	  sz = size(f)
	  nx = sz(1) + 0.			; Length of each component.
	  if sz(0) eq 1 then begin		; Only one component.
	    s = sin(cumulate(t*(f>1)))		; Waveform.
	    if eflag then s = env(*,lste)*s	; Loudness envelope.
	  endif else begin			; Multiple components.
	    s = sin(cumulate(t*(f(*,0)>1)))     ; First component.
	    if eflag then s = env(*,lste)*s     ; Loudness envelope.
	    for j = 1, sz(2)-1 do begin		; Add other components.
	      s2 = sin(cumulate(t*(f(*,j)>1)))
	      if eflag then s2 = env(*,lste)*s2; Loudness envelope.
	      s = s + s2			; Add result.
	    endfor
	  endelse
	  c = s/max(abs(s))
	  c = fix(c*smax*32767)
	endif
 
	if keyword_set(dbg) then stop,'Stopped in sound.'
 
	if n_elements(cin) gt 0 then c = cin	; Use sound array provided.
 
	if keyword_set(ply) then begin		; Play sound.
	  on_ioerror, done
	  get_lun, lun
	  openw, lun, '/dev/audio'
	  writeu, lun, c
	  free_lun, lun
done:	  free_lun, lun
	endif
 
	return
	end