;; popup.mut : put a popup window on the screen
  ;; The window is transient - it goes away on redraw.
  ;; ME knows nothing about the window
  ;; C Durland

(include max.mut)

(const
  UPPER-LEFT-CORNER "." UPPER-RIGHT-CORNER "."
  LOWER-LEFT-CORNER "`" LOWER-RIGHT-CORNER "'"
  LEFT-SIDE         "|" RIGHT-SIDE         "|"
  HEDGES  "--------------------------------------------------------------------------------"
  BLANKS "                                                                            "
)

(small-int ulrow ulcol brow bcol)

(defun
  popup-window (int row col width length)
  {
    (int j r)

    (ulrow (brow (+ row 1)))(ulcol (bcol (+ col 1)))
    (move-cursor row col)
    (puts UPPER-LEFT-CORNER (extract-elements HEDGES 0 width)
	  UPPER-RIGHT-CORNER)
    (for {(r ulrow)(j 0)} (< j length) {(+= j 1)(+= r 1)}
    {
      (move-cursor r col)
      (puts LEFT-SIDE (extract-elements BLANKS 0 width) RIGHT-SIDE)
    })
    (move-cursor r col)
    (puts LOWER-LEFT-CORNER (extract-elements HEDGES 0 width)
	  LOWER-RIGHT-CORNER)
  }
  wputs	(string msg)
  {
    (move-cursor brow bcol)(puts msg)
    (+= brow 1)
  }
)

;******************************************************************************;
;***                                                                        ***;
;**                           . . M E N U - B O X                            **;
;***                                                                        ***;
;******************************************************************************;

; Desc: Draw one or more boxes justified to the top right corner of the screen.
;       Each parameter represents a line in the box. 
;       The box width is ajusted to the max width of the lines to be
;       contained in the current box.
;       If a box does not fit vertically, it is broken in 2 boxes.
;       Some lines (parameters) have special effect:
;           ''      Close current box and open a new box in the next column.
;                       To have a blank line, just use ' '.
;           '-'     Is replaced by a solid line across the box.
;           '>xxxx' xxxx is centered in the box.
;       
; Use : For popup menus
; Call: (menu-box text text ...)
; Author: Orginal idea and code from Michel St-Louis, rewritten by C Durland

(const
  BOX-OVERLAP	 2		;; 1 (share borders) or 2 (don't share)
  BOX-MAX-LENGTH 3		;; 4 (don't cover modeline), 3 (go ahead)
)

(defun menu-box
{
  (array small-int box-width 10 box-length 10)
  (int boxes i j k w l max-length left-edge total-width)

  (max-length (- (screen-length) BOX-MAX-LENGTH))
  (for (total-width (boxes (j (w (l 0))))) (< j (nargs)) (+= j 1)
    {
      (w (max w (length-of (arg j))))
      (if (or (== "" (arg j)) (== (+= l 1) max-length))	;; need another box
	{
	  (box-width boxes w)(box-length boxes l)(+= boxes 1)
	  (+= total-width (+ w BOX-OVERLAP))
	  (w (l 0))
	})
    })
  (box-width boxes w)(box-length boxes l)(+= boxes 1)
  (+= total-width (+ w 2))

  (left-edge (- (screen-width) total-width))
  (for (i (j 0)) (< i boxes) (+= i 1)
    {
      (popup-window 0 left-edge (box-width i) (box-length i))
      (+= left-edge (box-width i) BOX-OVERLAP)
      (if (== "" (arg j)) (+= j 1))

      (for (k 0) (< k (box-length i)) { (+= k 1)(+= j 1) }
        {
	  (wputs
	    (cond
	      (== '-' (arg j)) (extract-elements HEDGES 0 (box-width i))
	      (== '>' (extract-elements (arg j) 0 1))
	          (concat
		    (extract-elements BLANKS 0
			    (/ (- (box-width i) (length-of (arg j))) 2))
		    (extract-elements (arg j) 1 100))
	      TRUE  (arg j)
	    ))
	})
    })
})