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

(RECORD TVPOINT2 (TIME VALUE))
(RECORD TVPOINT (TIME VALUE M B))

(DEFEXPR (SYNTH.GLUE C1 V C2)
  (* Glue C1, V, & C2 SEGMENTs to get TRAJ *)
  (PROG (DEFAULT DELTA PATH 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 TVPOINT2
				TIME ← 0
				VALUE ← DEFAULT)
			(CREATE TVPOINT2
				TIME ← 700
				VALUE ← DEFAULT))))
    (SYNTH.OVERLAY ANSWER V)
    (SYNTH.OVERLAY ANSWER C1)
    (* Adjust C2 to begin at the logic end of V. *)
    (SETQ C2 (COPYALL C2))
    (SETQ DELTA (- (TVPOINT.TIME (CAR (LAST (PVECTOR.GET V 'AV))))
		   400))
    (FOR PNAME IN PVECTOR.PNAMES
     DO (SETQ PATH (PVECTOR.GET C2 PNAME))
     (FOR POINT IN PATH
      WHEN (<> (TVPOINT.TIME POINT) 700)
      DO (SETF (TVPOINT.TIME POINT)
	       (+ (TVPOINT.TIME POINT) DELTA))))
    (* Now overlay C2. *)
    (SYNTH.OVERLAY ANSWER C2)
    (RETURN ANSWER)
))

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

(DEFEXPR (SYNTH.OVERLAY1 BUFFER S PNAME)
  (* Overlay BUFFER PNAME path with S PNAME path. *)
  (PROG (BPATH SPATH BPOINT EPOINT BTIME ETIME PATH VALUE)
    (SETQ BPATH (PVECTOR.GET BUFFER PNAME))
    (SETQ SPATH (PVECTOR.GET S PNAME))
    (COND ((NULL SPATH)(RETURN)))
    (SETQ BPOINT (CAR SPATH))
    (SETQ EPOINT (CAR (LAST SPATH))) 
    (SETQ BTIME (TVPOINT.TIME BPOINT))
    (SETQ ETIME (TVPOINT.TIME EPOINT))
    (* Points before overlay. *)
    (FOR POINT IN BPATH
     WHILE (< (TVPOINT.TIME POINT) (1- BTIME))
     DO (PUSH PATH POINT))
    (* Discontinuity *)
    (COND ((AND (<> BTIME 0)
		(OR (NULL (TVPOINT.M BPOINT))
		    (<>$ (TVPOINT.M BPOINT) 1.0)
		    (<>$ (TVPOINT.B BPOINT) 0.0)))
	   (PUSH PATH (CREATE TVPOINT2
			      TIME ← (1- BTIME)
			      VALUE ← (SYNTH.INTERPOLATE BPATH (1- BTIME))))))
    (* Overlaying points. *)
    (FOR POINT IN SPATH
     DO (COND ((NULL (TVPOINT.M POINT))
	       (* No equation. *)
	       (PUSH PATH POINT))
	      (T (* Equation *)
		 (SETQ VALUE (SYNTH.INTERPOLATE BPATH (TVPOINT.TIME POINT)))
		 (SETQ VALUE (+$ (x$ (TVPOINT.M POINT) VALUE) (TVPOINT.B POINT)))
		 (PUSH PATH (CREATE TVPOINT2
				    TIME ← (TVPOINT.TIME POINT)
				    VALUE ← VALUE)))))
    (* Discontinuity *)
    (COND ((AND (<> ETIME 700)
		(OR (NULL (TVPOINT.M EPOINT))
		    (<>$ (TVPOINT.M EPOINT) 1.0)
		    (<>$ (TVPOINT.B EPOINT) 0.0)))
	   (PUSH PATH (CREATE TVPOINT2
			      TIME ← (1+ ETIME)
			      VALUE ← (SYNTH.INTERPOLATE BPATH (1+ ETIME))))))
    (* Points after overlay. *)
    (FOR POINT IN BPATH
     WHEN (> (TVPOINT.TIME POINT) (1+ ETIME))
     DO (PUSH PATH POINT))
    (SETQ PATH (DREVERSE PATH))
    (PVECTOR.PUT BUFFER PNAME PATH)
))

(DEFEXPR (SYNTH.INTERPOLATE PATH TIME)
  (PROG (LEFTPOINT RIGHTPOINT LTIME RTIME LVALUE RVALUE K VALUE)
    (FOR L IN PATH
     AS R IN (CDR PATH)
     WHEN (AND (<= (TVPOINT.TIME L) TIME)
	       (>= (TVPOINT.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 (TVPOINT.TIME LEFTPOINT))
    (SETQ RTIME (TVPOINT.TIME RIGHTPOINT))
    (SETQ LVALUE (TVPOINT.VALUE LEFTPOINT))
    (SETQ RVALUE (TVPOINT.VALUE RIGHTPOINT))
    (SETQ K (/$ (-$ TIME LTIME) (-$ RTIME LTIME)))
    (SETQ VALUE (+$ (x$ K RVALUE) (x$ (-$ 1.0 K) LVALUE)))
    (RETURN VALUE)
))

STOP