(* ;;-*-LISP-*- KEEP EMACS HAPPY ********************************
*
*    SPEECH -- TRANSLATION OF HANDSY 
*
****************************************************************)

(DEFVAR SPEECH.*MEMORY*)
(DEFVAR SPEECH.*PARAM*)
(DEFVAR SPEECH.*COEFF*)
(DEFVAR SPEECH.*WAVE*)

(DEFEXPR (SPEECH.INIT)
  (PROG ()
    (USER.INIT)
    (COND ((NULL SPEECH.*MEMORY*)
	   (SETQ SPEECH.*MEMORY* (SPEECH.CREATE.MEMORY))))
    (COND ((NULL SPEECH.*PARAM*)
	   (SETQ SPEECH.*PARAM* (SPEECH.CREATE.PARAM))))
    (COND ((NULL SPEECH.*COEFF*)
	   (SETQ SPEECH.*COEFF* (SPEECH.CREATE.COEFF))))
    (COND ((NULL SPEECH.*WAVE*)
	   (SETQ SPEECH.*WAVE* (ARRAY 40000 'FLOATP 0))))
	(* The array type used to be BYTE but we are now putting
	   FLOATPs in it; having the type be BYTE causes a break on
	   SETA) 
    (SPEECH.SR 10000)
    (SPEECH.INIT.COEFF SPEECH.*PARAM* SPEECH.*COEFF*)
    (SPEECH.INIT.MEMORY SPEECH.*MEMORY*)
    (SPEECH.TRACE 'ULIPS)
    (SCOPE.SETUP -128 128)
))

(DEFEXPR (SPEECH.TEST)
  (PROG ()
    (SCOPE.CLEAR)
    (SPEECH.INIT.COEFF SPEECH.*PARAM* SPEECH.*COEFF*)
    (SPEECH.INIT.MEMORY SPEECH.*MEMORY*)
    (FOR OFFSET ← 0 BY (+ OFFSET NWS)
     WHILE (< OFFSET (ARRAYSIZE SPEECH.*WAVE*))
     DO (USER.INTERPOLATE SPEECH.*PARAM* OFFSET USER.TRAJS)
     (SPEECH.PARAM.TO.COEFF SPEECH.*PARAM* SPEECH.*COEFF*)
     (SPEECH.COEFF.TO.WAVE
      SPEECH.*MEMORY*
      SPEECH.*COEFF*
      SPEECH.*WAVE*
      OFFSET
      NWS))
))

(DEFEXPR (SPEECH.SHORTCUT)
  (PROG (PERIOD)
    (SCOPE.CLEAR)
    (SPEECH.INIT.COEFF SPEECH.*PARAM* SPEECH.*COEFF*)
    (SPEECH.INIT.MEMORY SPEECH.*MEMORY*)
    (* PERIOD = glottal period. *)
    (SETQ PERIOD (/ SR (PARAM.F0 SPEECH.*PARAM*)))
    (FOR OFFSET ← 0 BY (+ OFFSET PERIOD)
     AS I FROM 1 TO 4
     DO (SPEECH.PARAM.TO.COEFF SPEECH.*PARAM* SPEECH.*COEFF*)
     (SPEECH.COEFF.TO.WAVE
      SPEECH.*MEMORY*
      SPEECH.*COEFF*
      SPEECH.*WAVE*
      OFFSET
      PERIOD))
    (FOR I FROM (x 4 PERIOD) TO (ARRAYSIZE SPEECH.*WAVE*)
     DO (SETF (ELT SPEECH.*WAVE* I)
	      (ELT SPEECH.*WAVE* (+ (x 3 PERIOD) (\ I PERIOD)))))
))

(DEFEXPR (SPEECH.PLAY)
  (PROG (STREAM)
    (SETQ STREAM (OPENSTREAM '{CORE}SPEECH.PCM 'OUTPUT 'OLD/NEW))
    (FOR I FROM 1 TO (ARRAYSIZE SPEECH.*WAVE*)
     DO (BOUT STREAM (ELT SPEECH.*WAVE* I)))
    (CLOSEF STREAM)
    (AUDIO.PLAY.FILE '{CORE}SPEECH.PCM)
))

(DEFEXPR (SPEECH.DISPLAY.FILE FILE (OPTIONAL PTR 0))
  (PROG (WINDOW EXTENT)
    (SETQ FILE (FULLNAME FILE 'OLD))
    (SETQ WINDOW (CREATEW NIL FILE))
    (WINDOWPROP WINDOW 'FILE FILE)
    (WINDOWPROP WINDOW 'REPAINTFN 'SPEECH.DISPLAY.FILE.REPAINTFN)
    (WINDOWPROP WINDOW 'SCROLLFN 'SCROLLBYREPAINTFN)
    (SETQ EXTENT (CREATE REGION
			 LEFT ← 0
			 BOTTOM ← 0
			 WIDTH ← (GETFILEINFO FILE 'LENGTH)
			 HEIGHT ← -1))
    (WINDOWPROP WINDOW 'EXTENT EXTENT)
    (REDISPLAYW WINDOW)
))

(DEFEXPR (SPEECH.DISPLAY.FILE.REPAINTFN WINDOW REGION)
  (PROG (HEIGHT X Y Y0 STREAM)
    (SETQ HEIGHT (WINDOWPROP WINDOW 'HEIGHT))
    (SETQ Y0 (/ HEIGHT 2))
    (SETQ STREAM (OPENSTREAM (WINDOWPROP WINDOW 'FILE) 'INPUT 'OLD))
    (SETFILEPTR STREAM (REGION.LEFT REGION))
    (WHILE (NOT (EOFP STREAM))
     AS X FROM 1 TO (REGION.WIDTH REGION)
     DO (SETQ Y (\BIN STREAM))
     (COND ((< Y 128)(SETQ Y (+ Y 128)))
	   (T (SETQ Y (- 256 Y))))
     (SETQ Y (/ (x HEIGHT Y) 255))
     (DRAWLINE X Y0 X Y 1 'PAINT WINDOW))
    (CLOSEF STREAM)
))

(* ****************************************************************
*STOP
****************************************************************)

STOP