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

(RECORD SPOINT2 (TIME VALUE))
(RECORD SPOINT (TIME VALUE M B))

(DEFEXPR (SPEECH.GLUE C1 V C2)
  (PROG (DEFAULT DELTA TRAJ ANSWER)
    (SETQ ANSWER
	  (CREATE PVECTOR
		  TYPE _ 'TRAJ
		  SOUND _ (PACK* (PVECTOR.SOUND C1)
				 (PVECTOR.SOUND V)
				 (PVECTOR.SOUND C2))
		  CV _ 'CVC
		  COMMENT _ `(* Concatenation of
				,(PVECTOR.SOUND C1)
				,(PVECTOR.SOUND V)
				,(PVECTOR.SOUND C2) *)))
    (FOR PNAME IN PVECTOR.PNAMES
     DO (SETQ DEFAULT (PVECTOR.GET PVECTOR.DEFAULT PNAME))
     (PVECTOR.PUT ANSWER PNAME
		  (LIST (CREATE SPOINT2
				TIME _ 0
				VALUE _ DEFAULT)
			(CREATE SPOINT2
				TIME _ 700
				VALUE _ DEFAULT))))
    (SPEECH.OVERLAY ANSWER V)
    (SPEECH.OVERLAY ANSWER C1)
    (* Adjust C2 to begin at the logic end of V. *)
    (SETQ C2 (COPYALL C2))
    (SETQ DELTA (- (SPOINT.TIME (CAR (LAST (PVECTOR.GET V 'AV))))
		   400))
    (FOR PNAME IN PVECTOR.PNAMES
     DO (SETQ TRAJ (PVECTOR.GET C2 PNAME))
     (FOR POINT IN TRAJ
      WHEN (<> (SPOINT.TIME POINT) 700)
      DO (SETF (SPOINT.TIME POINT)
	       (+ (SPOINT.TIME POINT) DELTA))))
    (* Now overlay C2. *)
    (SPEECH.OVERLAY ANSWER C2)
    (RETURN ANSWER)
))

(DEFEXPR (SPEECH.OVERLAY BUFFER S)
  (* Overlay BUFFER with segment S. *)
  (PROG ()
    (FOR PNAME IN PVECTOR.PNAMES
     WHEN (NOT (EQ PNAME 'SWITCH))
     DO (SPEECH.OVERLAY1 BUFFER S PNAME))
))

(DEFEXPR (SPEECH.OVERLAY1 BUFFER S PNAME)
  (* Overlay BUFFER PNAME traj with S PNAME traj. *)
  (PROG (BTRAJ STRAJ BTIME ETIME TRAJ)
    (SETQ BTRAJ (PVECTOR.GET BUFFER PNAME))
    (SETQ STRAJ (PVECTOR.GET S PNAME))
    (COND ((NULL STRAJ)(RETURN)))
    (SETQ BPOINT (CAR STRAJ))
    (SETQ EPOINT (CAR (LAST STRAJ))) 
    (SETQ BTIME (SPOINT.TIME BPOINT))
    (SETQ ETIME (SPOINT.TIME EPOINT))
    (* Points before overlay. *)
    (FOR POINT IN BTRAJ
     WHILE (< (SPOINT.TIME POINT) (1- BTIME))
     DO (PUSH TRAJ POINT))
    (* Discontinuity *)
    (COND ((AND (<> BTIME 0)
		(OR (NULL (SPOINT.M BPOINT))
		    (<>$ (SPOINT.M BPOINT) 1.0)
		    (<>$ (SPOINT.B BPOINT) 0.0)))
	   (PUSH TRAJ (CREATE SPOINT2
			      TIME _ (1- BTIME)
			      VALUE _ (SPEECH.INTERPOLATE BTRAJ (1- BTIME))))))
    (* Overlaying points. *)
    (FOR POINT IN STRAJ
     DO (COND ((NULL (SPOINT.M POINT))
	       (* No equation. *)
	       (PUSH TRAJ POINT))
	      (T (* Equation *)
		 (SETQ VALUE (SPEECH.INTERPOLATE BTRAJ (SPOINT.TIME POINT)))
		 (SETQ VALUE (+$ (x$ (SPOINT.M POINT) VALUE) (SPOINT.B POINT)))
		 (PUSH TRAJ (CREATE SPOINT2
				    TIME _ (SPOINT.TIME POINT)
				    VALUE _ VALUE)))))
    (* Discontinuity *)
    (COND ((AND (<> ETIME 700)
		(OR (NULL (SPOINT.M EPOINT))
		    (<>$ (SPOINT.M EPOINT) 1.0)
		    (<>$ (SPOINT.B EPOINT) 0.0)))
	   (PUSH TRAJ (CREATE SPOINT2
			      TIME _ (1+ ETIME)
			      VALUE _ (SPEECH.INTERPOLATE BTRAJ (1+ ETIME))))))
    (* Points after overlay. *)
    (FOR POINT IN BTRAJ
     WHEN (> (SPOINT.TIME POINT) (1+ ETIME))
     DO (PUSH TRAJ POINT))
    (SETQ TRAJ (DREVERSE TRAJ))
    (PVECTOR.PUT BUFFER PNAME TRAJ)
))

(DEFEXPR (SPEECH.INTERPOLATE TRAJ TIME)
  (PROG (LEFTPOINT RIGHTPOINT LTIME RTIME LVALUE RVALUE K VALUE)
    (FOR L IN TRAJ
     AS R IN (CDR TRAJ)
     WHEN (AND (<= (SPOINT.TIME L) TIME)
	       (>= (SPOINT.TIME R) TIME))
     DO (SETQ LEFTPOINT L)
     (SETQ RIGHTPOINT R)
     (RETURN))
    (COND ((OR (NULL LEFTPOINT) (NULL RIGHTPOINT))
	   (PRINT '(Interpolation out of range))
	   (SHOULDNT)))
    (SETQ LTIME (SPOINT.TIME LEFTPOINT))
    (SETQ RTIME (SPOINT.TIME RIGHTPOINT))
    (SETQ LVALUE (SPOINT.VALUE LEFTPOINT))
    (SETQ RVALUE (SPOINT.VALUE RIGHTPOINT))
    (SETQ K (/$ (-$ TIME LTIME) (-$ RTIME LTIME)))
    (SETQ VALUE (+$ (x$ K RVALUE) (x$ (-$ 1.0 K) LVALUE)))
    (RETURN VALUE)
))

STOP