(* ;;-*-LISP-*- KEEP EMACS HAPPY ********************************
*
*     SPEECH
*
****************************************************************)

(DEFCONST PI 3.14159265)
(DEFCONST TWOPI (x$ 2.0 PI))
(DEFVAR SR 10000)
(DEFVAR NWS 50)
(DEFVAR NSAMI .02)
(DEFVAR PERIODT .0001)
(DEFVAR PIT .0003141593)
(DEFVAR TWOPIT .0006283186)

(DEFVAR F0 125)
(DEFVAR F1 625)
(DEFVAR F2 1275)
(DEFVAR F3 2500)
(DEFVAR F4 5000)
(DEFVAR B1 80)
(DEFVAR B2 70)
(DEFVAR B3 70)
(DEFVAR B4 70)
(DEFVAR PERIOD)
(DEFVAR RES1)
(DEFVAR RES2)
(DEFVAR RES3)
(DEFVAR RES4)
(DEFVAR ANTIRES1)
(DEFVAR ANTIRES2)
(DEFVAR ANTIRES3)
(DEFVAR ANTIRES4)
(DEFVAR RESS)
(DEFVAR ANTIRESS)
(DEFEXPR (TEST.INIT)
  (PROG ()
    (SETQ PERIOD (/ 10000 F0))
    (SETQ RES1 (CREATE RES))
    (SETQ RES2 (CREATE RES))
    (SETQ RES3 (CREATE RES))
    (SETQ RES4 (CREATE RES))
    (SETQ RESS (LIST RES4 RES3 RES2 RES1))
    (SETQ ANTIRES1 (CREATE RES))
    (SETQ ANTIRES2 (CREATE RES))
    (SETQ ANTIRES3 (CREATE RES))
    (SETQ ANTIRES4 (CREATE RES))
    (SETQ ANTIRESS (LIST ANTIRES4 ANTIRES3 ANTIRES2 ANTIRES1))
    (PARCOE.SET.RES RES1 F1 B1)
    (PARCOE.SET.RES RES2 F2 B2)
    (PARCOE.SET.RES RES3 F3 B3)
    (PARCOE.SET.RES RES4 F4 B4)
    (PARCOE.SET.RES ANTIRES1 (0-$ F1) B1)
    (PARCOE.SET.RES ANTIRES2 (0-$ F2) B2)
    (PARCOE.SET.RES ANTIRES3 (0-$ F3) B3)
    (PARCOE.SET.RES ANTIRES4 (0-$ F4) B4)
))

(DEFEXPR (SPEECH.TEST)
  (PROG (FILE STREAM HINPUT LINPUT)
    (SETQ REG1 (CREATE REG))
    (SETQ REG2 (CREATE REG))
    (SETQ REG3 (CREATE REG))
    (SPEECH.INIT.REG REG1)
    (SPEECH.INIT.REG REG2)
    (SPEECH.INIT.REG REG3)
    (SETQ FILE '{CORE}SPEECH)
    (COND ((FULLNAME FILE)
	   (CLOSEF? FILE)
	   (DELFILE FILE)))
    (SETQ STREAM (OPENSTREAM FILE 'OUTPUT))
    (SETQ LINPUT (0- (/ AV PERIOD)))
    (SETQ HINPUT (/ (x AV (1- PERIOD)) PERIOD))
    (FOR I FROM 0 TO (x 6 PERIOD)
     DO (COND ((EVENP I PERIOD)
	       (SETQ INPUT HINPUT))
	      (T (SETQ INPUT LINPUT)))
     (SPEECH.STEP STREAM INPUT))
    (RETURN (CLOSEF STREAM))
))


(* ****************************************************************
*
*     WAVES
*
****************************************************************)

(DEFVAR SPEECH.WAVESIZE 700)
(DEFEXPR (SPEECH.CREATEWAVE)
  (ARRAY SPEECH.WAVESIZE 'FIXP)
)

(DEFEXPR (SPEECH.GETWAVE FILENAME)
  (PROG (STREAM ANSWER)
    (SETQ ANSWER (SPEECH.CREATEWAVE))
    (SETQ STREAM (OPENSTREAM FILENAME 'INPUT))
    (FOR I FROM 1 TO (IMIN (GETFILEINFO STREAM 'LENGTH) SPEECH.WAVESIZE)
     DO (SETF (ELT ANSWER I) (SPEECH.BIN STREAM)))
    (CLOSEF STREAM)
    (RETURN ANSWER)
))

(DEFEXPR (SPEECH.PUTWAVE WAVE FILENAME)
  (PROG (STREAM)
    (SETQ STREAM (OPENSTREAM FILENAME 'OUTPUT))
    (FOR I FROM 1 TO SPEECH.WAVESIZE
     DO (SPEECH.BOUT 
	 STREAM 
	 (SPEECH.RANGECHECK (ELT WAVE I) -128 127)))
    (RETURN (CLOSEF STREAM))
))

(DEFEXPR (SPEECH.SINEWAVE AMP PERIOD PHASE)
  (PROG (ANSWER FREQ)
    (SETQ ANSWER (SPEECH.CREATEWAVE))
    (SETQ FREQ (/$ TWOPI (FLOAT PERIOD)))
    (FOR I FROM 1 TO SPEECH.WAVESIZE
     DO (SETF (ELT ANSWER I)
	      (x$ AMP (SIN (+$ (x$ FREQ I) PHASE) T))))
    (RETURN ANSWER)
))

(DEFEXPR (SPEECH.DELTAWAVE AMP PERIOD)
  (SPEECH.BOXWAVE 0 (1- PERIOD) AMP 1))

(DEFEXPR (SPEECH.BOXWAVE AMP1 PERIOD1 AMP2 PERIOD2)
  (PROG (ANSWER PERIOD)
    (SETQ ANSWER (SPEECH.CREATEWAVE))
    (SETQ PERIOD (+ PERIOD1 PERIOD2))
    (FOR I FROM 1 TO SPEECH.WAVESIZE
     DO (COND ((< (\ (1- I) PERIOD) PERIOD1)
	       (SETQ AMP AMP1))
	      (T (SETQ AMP AMP2)))
     (SETF (ELT ANSWER I) AMP))
    (RETURN ANSWER)
))


(* ****************************************************************
*
*     OPERATIONS ON WAVES
*
****************************************************************)

(DEFEXPR (SPEECH.WAVEPLUS WAVE1 WAVE2)
  (PROG (ANSWER)
    (SETQ ANSWER (SPEECH.CREATEWAVE))
    (FOR I FROM 1 TO SPEECH.WAVESIZE
     DO (SETF (ELT ANSWER I)
	      (+ (ELT WAVE1 I) (ELT WAVE2 I))))
    (RETURN ANSWER)
))

(DEFEXPR (SPEECH.WAVEDIFFERENCE WAVE1 WAVE2)
  (PROG (ANSWER)
    (SETQ ANSWER (SPEECH.CREATEWAVE))
    (FOR I FROM 1 TO SPEECH.WAVESIZE
     DO (SETF (ELT ANSWER I)
	      (- (ELT WAVE1 I) (ELT WAVE2 I))))
    (RETURN ANSWER)
))

(DEFEXPR (SPEECH.WAVETIMES WAVE1 WAVE2)
  (PROG (ANSWER)
    (SETQ ANSWER (SPEECH.CREATEWAVE))
    (FOR I FROM 1 TO SPEECH.WAVESIZE
     DO (SETF (ELT ANSWER I)
	      (x (ELT WAVE1 I) (ELT WAVE2 I))))
    (RETURN ANSWER)
))

(DEFEXPR (SPEECH.WAVEQUOTIENT WAVE1 WAVE2)
  (PROG (ANSWER)
    (SETQ ANSWER (SPEECH.CREATEWAVE))
    (FOR I FROM 1 TO SPEECH.WAVESIZE
     DO (SETF (ELT ANSWER I)
	      (/ (ELT WAVE1 I) (ELT WAVE2 I))))
    (RETURN ANSWER)
))

(DEFEXPR (SPEECH.WAVERES WAVE RES)
  (* Pass WAVE through resonator RES *)
  (PROG (ANSWER REG)
    (SETQ ANSWER (SPEECH.CREATEWAVE))
    (SETQ REG (CREATE REG))
    (FOR I FROM 1 TO SPEECH.WAVESIZE
     DO (SETF (ELT ANSWER I)
	      (COEWAVE.STEP.RES (ELT WAVE I) RES REG)))
    (RETURN ANSWER)
))

(DEFEXPR (SPEECH.WAVEANTIRES WAVE ANTIRES)
  (* Pass WAVE through antiresonator ANTIRES *)
  (PROG (ANSWER REG)
    (SETQ ANSWER (SPEECH.CREATEWAVE))
    (SETQ REG (CREATE REG))
    (FOR I FROM 1 TO SPEECH.WAVESIZE
     DO (SETF (ELT ANSWER I)
	      (COEWAVE.STEP.ANTIRES (ELT WAVE I) ANTIRES REG)))
    (RETURN ANSWER)
))

(DEFEXPR (SPEECH.WAVERESS WAVE RESS)
  (* Pass WAVE through cascade of resonators RESS *)
  (PROG (ANSWER)
    (SETQ ANSWER WAVE)
    (FOR RES IN RESS
     DO (SETQ ANSWER (SPEECH.WAVERES ANSWER RES)))
    (RETURN ANSWER)
))

(DEFEXPR (SPEECH.WAVEANTIRESS WAVE ANTIRESS)
  (* Pass WAVE through cascade of antiresonators ANTIRESS *)
  (PROG (ANSWER)
    (SETQ ANSWER WAVE)
    (FOR ANTIRES IN ANTIRESS
     DO (SETQ ANSWER (SPEECH.WAVEANTIRES ANSWER ANTIRES)))
    (RETURN ANSWER)
))

(DEFEXPR (SPEECH.WAVEAVERAGE WAVE PERIOD)
  (* Assume WAVE periodic with period PERIOD.  ANSWER is same as WAVE,
     but with noise smoothed out. *)
  (PROG (ANSWER N SUM AVG)
    (SETQ ANSWER (SPEECH.CREATEWAVE))
    (FOR I FROM 1 TO PERIOD
     DO (SETQ SUM 0)
     (SETQ N 0)
     (FOR J _ I BY (+ J PERIOD)
      WHILE (<= J SPEECH.WAVESIZE)
      DO (SETQ SUM (+ SUM (ELT WAVE J)))
      (SETQ N (1+ N)))
     (SETQ AVG (/ SUM N))
     (FOR J _ I BY (+ J PERIOD)
      WHILE (<= J SPEECH.WAVESIZE)
      DO (SETF (ELT ANSWER J) AVG)))
    (RETURN ANSWER)
))


(* ****************************************************************
*
*     DISPLAY
*
****************************************************************)

(DEFVAR SPEECH.TIMEAXIS 15)
(DEFVAR SPEECH.YM128 (1+ SPEECH.TIMEAXIS))
(DEFVAR SPEECH.Y0 (+ SPEECH.YM128 128))
(DEFVAR SPEECH.Y127 (+ SPEECH.Y0 127))
(DEFEXPR (SPEECH.DISPLAYWINDOW TITLE)
  (* Manufacture blank window suitable for displaying waves *)
  (PROG (HEIGHT WIDTH REGION WINDOW)
    (SETQ HEIGHT (HEIGHTIFWINDOW SPEECH.Y127 T))
    (SETQ WIDTH (WIDTHIFWINDOW SPEECH.WAVESIZE))
    (SETQ REGION (GETBOXREGION WIDTH HEIGHT NIL NIL NIL
			       "Position Display Window"))
    (SETQ WINDOW (CREATEW REGION TITLE))
    (WINDOWPROP WINDOW 'REPAINTFN 'SPEECH.REPAINTFN)
    (SPEECH.CLEARW WINDOW)
    (RETURN WINDOW)
))

(DEFVAR SPEECH.DISPLAYWINDOW)
(DEFEXPR (SPEECH.DISPLAY WAVE WINDOW)
  (PROG ()
    (COND ((NULL WINDOW)
	   (COND ((NULL SPEECH.DISPLAYWINDOW)
		  (SETQ SPEECH.DISPLAYWINDOW
			(SPEECH.DISPLAYWINDOW))))
	   (SETQ WINDOW SPEECH.DISPLAYWINDOW)))
    (SPEECH.DISPLAY1 WAVE WINDOW)
))
(MOVD 'SPEECH.DISPLAY 'SD)

(DEFEXPR (SPEECH.DISPLAY1 WAVE WINDOW)
  (PROG ()
    (COND ((NOT (ARRAYP WAVE))
	   (LISPERROR "ILLEGAL ARG" WAVE)))
    (COND ((NULL WINDOW)
	   (SETQ WINDOW (SPEECH.DISPLAYWINDOW))))
    (WINDOWPROP WINDOW 'WAVE WAVE)
    (REDISPLAYW WINDOW)
))
(MOVD 'SPEECH.DISPLAY1 'SD1)

(DEFEXPR (SPEECH.REPAINTFN WINDOW REGION)
  (PROG (HEIGHT X Y Y0 WAVE)
    (SPEECH.CLEARW WINDOW)
    (SETQ WAVE (WINDOWPROP WINDOW 'WAVE))
    (COND ((NULL WAVE)(RETURN)))
    (FOR X FROM 1 TO SPEECH.WAVESIZE
     DO (SETQ Y (ELT WAVE X))
     (SPEECH.DRAWXY X Y WINDOW))
))

(DEFEXPR (SPEECH.DRAWXY X Y WINDOW)
  (PROG ()
    (DRAWLINE X SPEECH.Y0 X (+ Y SPEECH.Y0) 1 'PAINT WINDOW)
))

(DEFEXPR (SPEECH.CLEARW WINDOW)
  (PROG ()
    (DSPRESET WINDOW)
    (SPEECH.DRAWXAXIS WINDOW)
    (SPEECH.DRAWTIMEAXIS WINDOW)
))

(DEFEXPR (SPEECH.DRAWXAXIS WINDOW)
  (PROG ()
    (FOR X FROM 0 TO (WINDOWPROP WINDOW 'WIDTH) BY 3
     DO (DRAWLINE X SPEECH.Y0 X SPEECH.Y0 1 'PAINT WINDOW))
))

(DEFEXPR (SPEECH.DRAWTIMEAXIS WINDOW)
  (PROG (WIDTH FONT SW)
    (SETQ WIDTH (WINDOWPROP WINDOW 'WIDTH))
    (SETQ FONT (DSPFONT NIL WINDOW))
    (DRAWLINE 0 SPEECH.TIMEAXIS 
	      WIDTH SPEECH.TIMEAXIS
	      1 'PAINT WINDOW)
    (FOR X FROM 20 TO WIDTH BY 20
     DO (DRAWLINE X SPEECH.TIMEAXIS X (+ SPEECH.TIMEAXIS 4) 1 'PAINT WINDOW)
     (SETQ SW (STRINGWIDTH X FONT))
     (COND ((ODDP (/ X 20))
	    (MOVETO (- X (/ SW 2)) 0 WINDOW)
	    (PRIN1 X WINDOW))))
))


(* ****************************************************************
*
*     I/O
*
****************************************************************)

STOP