;	** (c) Copyright 1980 Massachusetts Institute of Technology **

(DECLARE (SPECIAL CONSOLE-IO-PC-PPR TV-DEFAULT-SCREEN))

(EVAL-WHEN (COMPILE LOAD EVAL)
(DEFSTRUCT (MENU (DEFAULT-POINTER MENU))
        MENU-NAME		;MOSTLY FOR DEBUGGING
        MENU-PC-PPR		;PC-PPR FOR OUTPUTING
        MENU-ITEM-LIST		;LIST OF MENU ITEMS (EACH GETS DISPLAYED ON SCREEN)
        MENU-ITEM-LOCS		;LIST OF Y COORDINATE (RELATIVE TO PC-PPR) OF EACH ITEM
        MENU-SELECTED-ITEM	;LAST ITEM MOUSED.  NOT AFFECTED WHEN CURSOR CLEARED.
        MENU-CURSOR-Y		;Y COORD (RELATIVE TO PC-PPR) OF MENU CURSOR (OR NIL IF NOT
				;  DISPLAYED)
        MENU-OPTIONS		;LIST OF KEYWORD S WHICH SELECT VARIOUS OPTIONS FOR THIS MENU
))

(DEFUN DEFINE-MENU (NAME ITEM-LIST &REST &EVAL OPTIONS 
   &AUX TOP BOTTOM LEFT RIGHT MENU-OPTIONS
	(SIZING-PC-PPR CONSOLE-IO-PC-PPR) PC-PPR  
        X-SIZE Y-SIZE (MAX-X-SIZE 0) (Y-TOTAL-SIZE 0) MENU)
	(SETQ BOTTOM (- (SCREEN-HEIGHT TV-DEFAULT-SCREEN) 12))
	(SETQ RIGHT (- (SCREEN-WIDTH TV-DEFAULT-SCREEN) 10))
    (DO OP OPTIONS (CDDR OP) (NULL OP)
      (SELECTQ (CAR OP)
	(TOP (SETQ TOP (CADR OP)))
	(BOTTOM (SETQ BOTTOM (CADR OP)))
	(LEFT (SETQ LEFT (CADR OP)))
	(RIGHT (SETQ RIGHT (CADR OP)))
	(PC-PPR (SETQ PC-PPR (CADR OP)))
	(SIZING-PC-PPR (SETQ SIZING-PC-PPR (CADR OP)))
	(OPTION (SETQ MENU-OPTIONS (CONS (CADR OP) MENU-OPTIONS)))
       (OTHERWISE (FERROR NIL "~S is not a recognized option" (CAR OP)))))
   (COND ((NULL PC-PPR)
    (DO ITEM ITEM-LIST (CDR ITEM) (NULL ITEM)
        (MULTIPLE-VALUE (X-SIZE Y-SIZE)
            (TV-COMPUTE-MOTION SIZING-PC-PPR 0 0 (STRING (CAR ITEM))))
;	(SETQ X-SIZE (- X-SIZE (PC-PPR-LEFT SIZING-PC-PPR)))
;	(SETQ Y-SIZE (- Y-SIZE (PC-PPR-TOP  SIZING-PC-PPR)))
        (COND ((> X-SIZE MAX-X-SIZE)
               (SETQ MAX-X-SIZE X-SIZE)))
        (SETQ Y-TOTAL-SIZE (+ Y-TOTAL-SIZE (+ Y-SIZE (PC-PPR-LINE-HEIGHT SIZING-PC-PPR)))) )
    (SETQ MAX-X-SIZE (+ MAX-X-SIZE 
			(* 2 (PC-PPR-CHAR-WIDTH SIZING-PC-PPR))))  ;FOR CURSOR,SLOP
    (SETQ PC-PPR (TV-DEFINE-PC-PPR NAME (LIST (SCREEN-DEFAULT-FONT TV-DEFAULT-SCREEN))
         'TOP (COND (TOP) (T (- BOTTOM Y-TOTAL-SIZE)))
         'BOTTOM BOTTOM 
         'LEFT (COND (LEFT) (T (- RIGHT  MAX-X-SIZE)))
         'RIGHT RIGHT 
         'BLINKER-P NIL
         'MORE-P NIL))))
   (SETQ MENU (MAKE-MENU))
   (SETF (MENU-NAME MENU) NAME)
   (SETF (MENU-PC-PPR MENU) PC-PPR)
   (SETF (MENU-ITEM-LIST MENU) ITEM-LIST)
   (SETF (MENU-OPTIONS MENU) MENU-OPTIONS)
   (TV-HOME PC-PPR)
   (DO ITEM ITEM-LIST (CDR ITEM) (NULL ITEM)
	(SETF (MENU-ITEM-LOCS MENU)
	      (NCONC (MENU-ITEM-LOCS MENU)
		     (LIST (- (PC-PPR-CURRENT-Y PC-PPR) (PC-PPR-TOP PC-PPR)))))
	(TV-FAKE-STRING-OUT PC-PPR " ")	;LEAVE ROOM FOR CURSOR
        (TV-FAKE-STRING-OUT PC-PPR (STRING (CAR ITEM)))
        (COND ((CDR ITEM) (TV-FAKE-CRLF PC-PPR))) )
    MENU)

(DEFUN TV-FAKE-STRING-OUT (PC-PPR STRING)
  (PROG (X Y)
	(MULTIPLE-VALUE (X Y) (TV-COMPUTE-MOTION PC-PPR NIL NIL STRING))
	(SETF (PC-PPR-CURRENT-X PC-PPR) (+ X (PC-PPR-LEFT PC-PPR)))
	(SETF (PC-PPR-CURRENT-Y PC-PPR) (+ Y (PC-PPR-TOP PC-PPR)))
))

(DEFUN TV-FAKE-CRLF (PC-PPR)
  (PROG (X Y)
	(MULTIPLE-VALUE (X Y) (TV-COMPUTE-MOTION PC-PPR NIL NIL "" 0 NIL T))
	(SETF (PC-PPR-CURRENT-X PC-PPR) (+ X (PC-PPR-LEFT PC-PPR)))
	(SETF (PC-PPR-CURRENT-Y PC-PPR) (+ Y (PC-PPR-TOP PC-PPR)))
))

(DEFUN DISPLAY-MENU (MENU &AUX PC-PPR ITEM-LIST)
   (ERASE-MENU MENU)
   (SETQ PC-PPR (MENU-PC-PPR MENU))
   (SETQ ITEM-LIST (MENU-ITEM-LIST MENU))
   (SETF (MENU-CURSOR-Y MENU) NIL)
   (DO ITEM ITEM-LIST (CDR ITEM) (NULL ITEM)
	(TV-STRING-OUT PC-PPR " ")
	(TV-STRING-OUT PC-PPR (STRING (CAR ITEM)))
	(COND ((CDR ITEM) (TV-CRLF PC-PPR))))
)

(DEFUN ERASE-MENU (MENU &AUX PC-PPR)
   (SETQ PC-PPR (MENU-PC-PPR MENU))
   (TV-CLEAR-PC-PPR PC-PPR)
)

(DEFUN SELECT-ITEM-FROM-MENU (MENU X Y &OPTIONAL ADVANCE-ENABLE)   ;RETURNS NIL OR 
							;ITEM-NUMBER, SELECTED-ITEM
  (PROG (PC-PPR TEM CNT DIST)
	(MENU-CLEAR-CURSOR MENU)
	(SETQ PC-PPR (MENU-PC-PPR MENU))
	(COND ((> (SETQ DIST (PC-PPR-MAX-DISTANCE PC-PPR X Y)) 0)
	   	(GO AWAY)))   ;NOT WITHIN PC-PPR, IS ADVANCING OPTION SELECTED?
	(SETQ X (- X (PC-PPR-LEFT PC-PPR)) Y (- Y (PC-PPR-TOP PC-PPR)))
	(SETQ TEM (MENU-ITEM-LOCS MENU))
	(SETQ CNT 0)
   L	(COND ((OR (NULL (CDR TEM)) (> (CADR TEM) Y))
		(GO SELECT)))
	(SETQ TEM (CDR TEM))
	(SETQ CNT (1+ CNT))
	(GO L)
 SELECT	(TV-SET-CURSORPOS PC-PPR 0 	;SELECT ITEM NUMBER IN CNT
	    (SETF (MENU-CURSOR-Y MENU) (NTH CNT (MENU-ITEM-LOCS MENU))))
	(TV-STRING-OUT PC-PPR ">")
	(RETURN CNT (SETF (MENU-SELECTED-ITEM MENU)
			 (NTH CNT (MENU-ITEM-LIST MENU))))
  AWAY	(COND ((OR (NULL (MEMQ 'ADVANCING (MENU-OPTIONS MENU)))
		   (< DIST 100))   ;IF CLOSE TO PC-PPR, HE S PROBABLY TRYING TO SELECT
		(RETURN NIL)))	   ; THE REGULAR WAY.
	(SETQ CNT (FIND-POSITION-IN-LIST (MENU-SELECTED-ITEM MENU)
					 (MENU-ITEM-LIST MENU)))
	(COND (ADVANCE-ENABLE (SETQ CNT (COND (CNT (1+ CNT))
					      (T 0)))))	  ;SELECT FIRST ITEM FROM FRESH MENU
	(COND ((NULL CNT) (RETURN NIL)))
	(COND ((= CNT (LENGTH (MENU-ITEM-LIST MENU)))
		(SETQ CNT 0)))
	(GO SELECT)
))

(DEFUN PC-PPR-MAX-DISTANCE (PC-PPR X Y)   ;RETURNS MAX DIST (X,Y) IS FROM PC-PPR RECTANGLE
	(MAX (- (PC-PPR-TOP PC-PPR) Y)	  ; HORIZONALLY OR VERTICALLY. RESULT IS NEGATIVE
	     (- Y (PC-PPR-BOTTOM PC-PPR)) ; IF X,Y IS WITHIN PC-PPR.
	     (- (PC-PPR-LEFT PC-PPR) X)
	     (- X (PC-PPR-RIGHT PC-PPR))))

(DEFUN MENU-CLEAR-CURSOR (MENU &OPTIONAL C-STRING &AUX PC-PPR TEM)
   (COND ((SETQ TEM (MENU-CURSOR-Y MENU))
	    (SETQ PC-PPR (MENU-PC-PPR MENU))
	    (TV-SET-CURSORPOS PC-PPR 0 TEM)
	    (TV-CLEAR-CHAR PC-PPR)
	    (COND (C-STRING (TV-STRING-OUT PC-PPR C-STRING))
	          (T (SETF (MENU-CURSOR-Y MENU) NIL))))))