home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
m
/
me_cd25.zip
/
MUTT2.ZIP
/
POPUP.MUT
< prev
next >
Wrap
Lisp/Scheme
|
1992-11-09
|
4KB
|
110 lines
;; 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)
))
})
})
})