(* ;;-*-LISP-*- KEEP EMACS HAPPY ********************************
*
*     SPEECH USER INTERFACE.
*
*() Pull SWITCH and NCF off of SPEECH.*PARAM*
****************************************************************)

(LOAD? '{PHYLUM}<LISPCORE>LIBRARY>ATTACHEDWINDOW.DCOM)

(RECORD POINT (TIME . VALUE))

(DEFVAR USER.TRAJS)
(DEFVAR USER.WINDOW)
(DEFVAR USER.MENU)
(DEFVAR USER.TMIN 0)
(DEFVAR USER.TMAX 700)
(DEFVAR USER.VMIN 0)
(DEFVAR USER.VMAX 200)
(DEFVAR USER.PNAMES
  '(AV ASV FGP BGP FGZ BGZ BGS SWITCH AFRIC AASPIR NCF
       F0 A1 B1 F1 A2 B2 F2 A3 B3 F3 A4 B4 F4 A5 B5
       F5 A6 B6 F6 FNZ BNZ ANP FNP BNP AB GAIN))

(DEFEXPR (USER.INIT)
  (PROG ()
    (COND ((NULL USER.WINDOW)
	   (SETQ USER.WINDOW (USER.CREATE.WINDOW))))
    (COND ((NULL USER.MENU)
	   (SETQ USER.MENU (USER.CREATE.MENU))))
    (COND ((NULL USER.DEFAULT.PARAM)
	   (USER.CREATE.PARAMS)))
    (COND ((NULL USER.TRAJS)
	   (SETQ USER.TRAJS (USER.CREATE.TRAJS))))
))

(* ****************************************************************
*
*     PARAMS
*
****************************************************************)

(DEFVAR USER.DEFAULT.PARAM)
(DEFVAR USER.MAX.PARAM)
(DEFVAR USER.MIN.PARAM)

(DEFEXPR (USER.CREATE.PARAMS)
  (PROG ()
    (SETQ USER.DEFAULT.PARAM
	  (CREATE PARAM
		 AV _ 60
		 ASV _ 0
		 AASPIR _ 0
		 AFRIC _ 0
		 F0 _ 120
		 FGP _ 0
		 BGP _ 100
		 FGZ _ 1500
		 BGZ _ 6000
		 FNP _ 250
		 BNP _ 100
		 FNZ _ 250
		 BNZ _ 100
		 BGS _ 200
		 F1 _ 680
		 B1 _ 90
		 F2 _ 1890
		 B2 _ 200
		 F3 _ 2650
		 B3 _ 170
		 F4 _ 3300
		 B4 _ 250
		 F5 _ 3850
		 B5 _ 200
		 F6 _ 4900
		 B6 _ 1000
		 A1 _ 0
		 ANP _ 0
		 A2 _ 0
		 A3 _ 0
		 A4 _ 0
		 A5 _ 0
		 A6 _ 0
		 AB _ 0
		 SWITCH _ 'CASCADE
		 GAIN _ 36
		 NCF _ 5))
    (SETQ USER.MIN.PARAM
	  (CREATE PARAM
		 AV _ 0
		 ASV _ 0
		 AASPIR _ 0
		 AFRIC _ 0
		 F0 _ 0
		 FGP _ 0
		 BGP _ 50
		 FGZ _ 750
		 BGZ _ 3000
		 FNP _ 125
		 BNP _ 50
		 FNZ _ 250
		 BNZ _ 50
		 BGS _ 100
		 F1 _ 200
		 B1 _ 40
		 F2 _ 600
		 B2 _ 40
		 F3 _ 1300
		 B3 _ 40
		 F4 _ 1650
		 B4 _ 125
		 F5 _ 1925
		 B5 _ 100
		 F6 _ 2450
		 B6 _ 500
		 A1 _ 0
		 ANP _ 0
		 A2 _ 0
		 A3 _ 0
		 A4 _ 0
		 A5 _ 0
		 A6 _ 0
		 AB _ 0
		 SWITCH _ 'CASCADE
		 GAIN _ 0
		 NCF _ 5))
    (SETQ USER.MAX.PARAM
	  (CREATE PARAM
		 AV _ 80
		 ASV _ 80
		 AASPIR _ 80
		 AFRIC _ 80
		 F0 _ 400
		 FGP _ 500
		 BGP _ 200
		 FGZ _ 3000
		 BGZ _ 12000
		 FNP _ 500
		 BNP _ 200
		 FNZ _ 700
		 BNZ _ 200
		 BGS _ 400
		 F1 _ 900
		 B1 _ 500
		 F2 _ 2400
		 B2 _ 500
		 F3 _ 3100
		 B3 _ 500
		 F4 _ 6600
		 B4 _ 500
		 F5 _ 7700
		 B5 _ 400
		 F6 _ 9800
		 B6 _ 2000
		 A1 _ 80
		 ANP _ 80
		 A2 _ 80
		 A3 _ 80
		 A4 _ 80
		 A5 _ 80
		 A6 _ 80
		 AB _ 80
		 SWITCH _ 'CASCADE
		 GAIN _ 100
		 NCF _ 5))
))

(DEFEXPR (USER.CREATE.TRAJS)
  (PROG (TRAJS VALUE)
    (SETQ TRAJS (CREATE PARAM))
    (FOR PNAME IN USER.PNAMES
     DO (SETQ VALUE (USER.GETPARAM PNAME USER.DEFAULT.PARAM))
     (USER.SETPARAM
      PNAME
      (LIST (CREATE POINT
		    TIME _ USER.TMIN
		    VALUE _ VALUE)
	    (CREATE POINT
		    TIME _ USER.TMAX
		    VALUE _ VALUE))
      TRAJS))
    (RETURN TRAJS)))

(* ****************************************************************
*
*     INTERPOLATION
*
****************************************************************)

(DEFEXPR (USER.INTERPOLATE SLICE TIME TRAJS)
  (* Return slice in TRAJS at TIME. *)
  (PROG ()
    (FOR PNAME IN USER.PNAMES
     WHEN (NOT (MEMB PNAME '(SWITCH NCF)))
     DO (USER.INTERPOLATE.PNAME SLICE PNAME TIME TRAJS))
))

(DEFEXPR (USER.INTERPOLATE.PNAME SLICE PNAME TIME TRAJS)
  (PROG (TRAJ LEFTPOINT RIGHTPOINT LTIME RTIME LVALUE RVALUE K VALUE)
    (SETQ TRAJ (USER.GETPARAM PNAME TRAJS))
    (FOR L IN TRAJ
     AS R IN (CDR TRAJ)
     WHEN (AND (<= (POINT.TIME L) TIME)
	       (> (POINT.TIME R) TIME))
     DO (SETQ LEFTPOINT L)
     (SETQ RIGHTPOINT R)
     (RETURN))
    (SETQ LTIME (POINT.TIME LEFTPOINT))
    (SETQ RTIME (POINT.TIME RIGHTPOINT))
    (SETQ LVALUE (POINT.VALUE LEFTPOINT))
    (SETQ RVALUE (POINT.VALUE RIGHTPOINT))
    (SETQ K (/$ (-$ TIME LTIME) (-$ RTIME LTIME)))
    (SETQ VALUE (+$ (x$ K RVALUE) (x$ (-$ 1.0 K) LVALUE)))
    (USER.SETPARAM PNAME VALUE SLICE)
))


(* ****************************************************************
*
*     WINDOW OPERATIONS
*
****************************************************************)

(DEFEXPR (USER.CREATE.WINDOW)
  (PROG (WINDOW)
    (SETQ WINDOW (CREATEW NIL "USER WINDOW"))
    (WINDOWPROP WINDOW 'REPAINTFN 'USER.REPAINTFN)
    (WINDOWPROP WINDOW 'BUTTONEVENTFN 'USER.BUTTONEVENTFN)
    (RETURN WINDOW)
))

(DEFEXPR (USER.REPAINTFN WINDOW)
  (* WINDOW = USER.WINDOW. *)
  (PROG (TRAJ)
    (CLEARW WINDOW)
    (SETQ TRAJ (USER.GETPARAM (WINDOWPROP WINDOW 'PNAME)
			      USER.TRAJS))
    (FOR POINT1 IN TRAJ
     AS POINT2 IN (CDR TRAJ)
     WHILE POINT2
     DO (USER.DRAWLINE POINT1 POINT2))
    (FOR POINT IN TRAJ
     DO (USER.DRAWPOINT POINT))
))

(DEFEXPR (USER.BUTTONEVENTFN WINDOW)
  (TOTOPW WINDOW)
  (COND ((LASTMOUSESTATE MIDDLE)
	 (USER.MIDDLEBUTTONFN))
	((LASTMOUSESTATE LEFT)
	 (USER.LEFTBUTTONFN))))

(* ****************************************************************
*
*     MENU OPERATIONS
*
****************************************************************)

(DEFEXPR (USER.CREATE.MENU)
  (PROG (MENU)
    (SETQ MENU
	  (CREATE MENU
		  TITLE _ "USER MENU"
		  ITEMS _ USER.PNAMES
		  MENUCOLUMNS _ 7
		  WHENSELECTEDFN _ 'USER.WHENSELECTEDFN))
    (ATTACHMENU MENU USER.WINDOW 'TOP 'RIGHT)
    (* This causes MENU to open. *)
    (CLOSEW USER.WINDOW)
    (OPENW USER.WINDOW)
    (* Okey Dokey. *)
    (RETURN MENU)
))

(DEFEXPR (USER.WHENSELECTEDFN ITEM MENU KEY)
  (PROG ()
    (SHADEITEM ITEM MENU BLACKSHADE)
    (USER.EDITTRAJ ITEM)
    (SHADEITEM ITEM MENU WHITESHADE)
))

(DEFEXPR (USER.EDITTRAJ PNAME)
  (PROG (TRAJ)
    (SETQ USER.VMIN (USER.GETPARAM PNAME USER.MIN.PARAM))
    (SETQ USER.VMAX (USER.GETPARAM PNAME USER.MAX.PARAM))
    (SETQ TRAJ (USER.GETPARAM PNAME USER.TRAJS))
    (WINDOWPROP USER.WINDOW 'PNAME PNAME)
    (WINDOWPROP USER.WINDOW 'TRAJ TRAJ)
    (REDISPLAYW USER.WINDOW)
    (* TBW *)
))

(* ****************************************************************
*
*     LINE DRAWING
*
****************************************************************)

(DEFEXPR (USER.DRAWLINE POINT1 POINT2)
  (PROG (T1 V1 T2 V2 X1 Y1 Y2 X2 HEIGHT WIDTH)
    (SETQ T1 (POINT.TIME POINT1))
    (SETQ V1 (POINT.VALUE POINT1))
    (SETQ T2 (POINT.TIME POINT2))
    (SETQ V2 (POINT.VALUE POINT2))
    (SETQ HEIGHT (WINDOWPROP USER.WINDOW 'HEIGHT))
    (SETQ WIDTH (WINDOWPROP USER.WINDOW 'WIDTH))
    (SETQ X1 (FIXR (x$ WIDTH (/$ (-$ T1 USER.TMIN)
				 (-$ USER.TMAX USER.TMIN)))))
    (SETQ Y1 (FIXR (x$ HEIGHT (/$ (-$ V1 USER.VMIN)
				  (-$ USER.VMAX USER.VMIN)))))
    (SETQ X2 (FIXR (x$ WIDTH (/$ (-$ T2 USER.TMIN)
				 (-$ USER.TMAX USER.TMIN)))))
    (SETQ Y2 (FIXR (x$ HEIGHT (/$ (-$ V2 USER.VMIN)
				  (-$ USER.VMAX USER.VMIN)))))
    (DRAWLINE X1 Y1 X2 Y2 1 'PAINT USER.WINDOW)
))

(DEFEXPR (USER.ERASELINE POINT1 POINT2)
  (PROG (T1 V1 T2 V2 X1 Y1 Y2 X2 HEIGHT WIDTH)
    (SETQ T1 (POINT.TIME POINT1))
    (SETQ V1 (POINT.VALUE POINT1))
    (SETQ T2 (POINT.TIME POINT2))
    (SETQ V2 (POINT.VALUE POINT2))
    (SETQ HEIGHT (WINDOWPROP USER.WINDOW 'HEIGHT))
    (SETQ WIDTH (WINDOWPROP USER.WINDOW 'WIDTH))
    (SETQ X1 (FIXR (x$ WIDTH (/$ (-$ T1 USER.TMIN)
				 (-$ USER.TMAX USER.TMIN)))))
    (SETQ Y1 (FIXR (x$ HEIGHT (/$ (-$ V1 USER.VMIN)
				  (-$ USER.VMAX USER.VMIN)))))
    (SETQ X2 (FIXR (x$ WIDTH (/$ (-$ T2 USER.TMIN)
				 (-$ USER.TMAX USER.TMIN)))))
    (SETQ Y2 (FIXR (x$ HEIGHT (/$ (-$ V2 USER.VMIN)
				  (-$ USER.VMAX USER.VMIN)))))
    (DRAWLINE X1 Y1 X2 Y2 1 'ERASE USER.WINDOW)
))

(DEFEXPR (USER.DRAWPOINT POINT)
  (PROG ()
    (* TBW: Draw spot at point. *)
))

(DEFVAR USER.COMMAND.MENU
  (CREATE MENU
	  ITEMS _ '(PROMPT&ADD POINT&ADD PROMPT&DELETE POINT&DELETE 
			       POINT&MOVE)))
(DEFVAR USER.COMMAND 'ADD)
(DEFEXPR (USER.MIDDLEBUTTONFN)
  (PROG (COMMAND)
    (SETQ COMMAND (MENU USER.COMMAND.MENU))
    (COND (COMMAND (SETQ USER.COMMAND COMMAND)
		   (SELECTQ USER.COMMAND
		     (PROMPT&ADD (USER.PROMPT&ADD))
		     (PROMPT&DELETE (USER.PROMPT&DELETE))
		     (* Wait for point. *))))
))

(DEFEXPR (USER.LEFTBUTTONFN)
  (SELECTQ USER.COMMAND
    (POINT&ADD (USER.POINT&ADD))
    (POINT&DELETE (USER.POINT&DELETE))
    (POINT&MOVE (USER.PROMPT&MOVE))
    NIL)
)

(DEFEXPR (USER.PROMPT&ADD)
  (PROG (TIME VALUE POINT)
    (DO (FRESHLINE PROMPTWINDOW)
     (SETQ TIME (MKATOM (PROMPTFORWORD "TIME = " NIL NIL PROMPTWINDOW)))
     (COND ((OR (NOT (NUMBERP TIME)) (< TIME USER.TMIN) (> TIME USER.TMAX))
	    (RETURN)))
     (FRESHLINE PROMPTWINDOW)
     (SETQ VALUE (MKATOM (PROMPTFORWORD "VALUE = " NIL NIL PROMPTWINDOW)))
     (COND ((NOT (NUMBERP VALUE))(RETURN)))
     (SETQ POINT (CREATE POINT
			 TIME _ TIME
			 VALUE _ VALUE))
     (USER.ADDPOINT POINT))
))

(DEFEXPR (USER.ADDPOINT POINT)
  (PROG (TIME VALUE TRAJ N OLDPOINT RIGHTPOINT LEFTPOINT)
    (SETQ TIME (POINT.TIME POINT))
    (SETQ VALUE (POINT.VALUE POINT))
    (SETQ TRAJ (WINDOWPROP USER.WINDOW 'TRAJ))
    (COND ((= TIME USER.TMIN)
	   (USER.ERASELINE (KTH TRAJ 1) (KTH TRAJ 2))
	   (SETF (POINT.VALUE (KTH TRAJ 1)) VALUE)
	   (USER.DRAWLINE (KTH TRAJ 1) (KTH TRAJ 2)))
	  ((= TIME USER.TMAX)
	   (SETQ N (LENGTH TRAJ))
	   (USER.ERASELINE (KTH TRAJ (1- N)) (KTH TRAJ N))
	   (SETF (POINT.VALUE (KTH TRAJ N)) VALUE)
	   (USER.DRAWLINE (KTH TRAJ (1- N)) (KTH TRAJ N)))
	  ((SETQ OLDPOINT
		 (FOR P IN TRAJ
		  THEREIS (= TIME (POINT.TIME P))))
	   (SETQ N (LENGTH (MEMB OLDPOINT TRAJ)))
	   (USER.ERASELINE (KTH TRAJ (1- N)) (KTH TRAJ N))
	   (USER.ERASELINE (KTH TRAJ N) (KTH TRAJ (1+ N)))
	   (SETF (POINT.VALUE OLDPOINT) VALUE)
	   (USER.DRAWLINE (KTH TRAJ (1- N)) (KTH TRAJ N))
	   (USER.DRAWLINE (KTH TRAJ N) (KTH TRAJ (1+ N))))
	  (T (FOR L IN TRAJ
	      AS R IN (CDR TRAJ)
	      WHEN (AND (< (POINT.TIME L) TIME)
			(> (POINT.TIME R) TIME))
	      DO (SETQ LEFTPOINT L)
	      (SETQ RIGHTPOINT R)
	      (RETURN))
	     (USER.ERASELINE LEFTPOINT RIGHTPOINT)
	     (PUSH (CDR (MEMB LEFTPOINT TRAJ)) POINT)
	     (USER.DRAWLINE LEFTPOINT POINT)
	     (USER.DRAWLINE POINT RIGHTPOINT)))
))

(DEFEXPR (USER.GETPARAM PNAME PARAM)
  (EVAL `(FETCH (PARAM ,PNAME) OF ',PARAM)))

(DEFEXPR (USER.SETPARAM PNAME VALUE PARAM)
  (EVAL `(REPLACE (PARAM ,PNAME) OF `,PARAM WITH ',VALUE)))

STOP