reduce-historical/psl-1983/3-1/glisp/window20.sl

% {DSK}WINDOW.PSL;1  4-MAR-83 16:25:00 





(GLISPOBJECTS


(MENU (listobject (ITEMS (LISTOF ATOM))
                  (window window))
MSG     ((SELECT MENU-select RESULT ATOM)))


(MOUSE ANYTHING)


(WINDOW (listobject (start vector)
                    (size vector)
                    (title string)
                    (lastfilledline integer))

PROP    ((leftmargin (left + 1))
         (rightmargin (right - 2)))

MSG     ((CLEAR window-clear)
	 (OPEN window-open)
	 (CLOSE window-close)
         (movetoxy window-movetoxy)
         (invertvideo ((pbout escapechar)(pbout (char !p))))
         (normalvideo ((pbout escapechar)(pbout (char !q))))
         (graphicsmode (nil))
         (normalmode   (nil))
         (eraseeol ((pbout escapechar)(pbout (char K))))
	 (INVERTAREA WINDOW-INVERTAREA)
	 (MOVETO WINDOW-MOVETO)
	 (PRINTAT WINDOW-PRINTAT)
         (printatxy window-printatxy)
	 (PRETTYPRINTAT WINDOW-PRETTYPRINTAT)
	 (UNPRINTAT WINDOW-UNPRINTAT)
         (unprintatxy window-unprintatxy)
	 (DRAWLINE WINDOW-DRAWLINE)
         (drawlinexy window-drawlinexy)
	 (UNDRAWLINE WINDOW-UNDRAWLINE)
         (undrawlinexy window-undrawlinexy)
	 (CENTEROFFSET WINDOW-CENTEROFFSET))
supers (region) )

)

  

(GLISPGLOBALS
(MOUSE MOUSE)
)

(glispconstants
(windowcharwidth 8 integer)
(windowlineyspacing 12 integer)
(verticalbarchar 73 integer)
(horizontalbarchar 33 integer)
(escapechar 27 integer)
(blankchar 32 integer)
)

% Initialize graphics routines.
(dg window-init (w:window)
)

% Done with graphics
(dg window-term (w:window)
)



% Open a graphics window.
(dg window-open (w:window)
(prog (ttl nbl)
  (send w movetoxy w:left + 1 w:top)
  (ttl _ w:title or " ")
  (l _ ttl:length)
  (send w invertvideo)
  (if ttl:length > w:width - 2
      then (ttl _ (substring ttl 1 w:width - 2)))
  (nbl _ (w:width - ttl:length)/2 - 1)
  (printnc nbl blankchar)
  (prin2 ttl)
  (printnc (w:width - ttl:length - nbl - 2) blankchar)
  (send w normalvideo)
  (terpri)
  (w:lastfilledline _ w:bottom + 1)
  (send w movetoxy w:left w:top)
  (pbout verticalbarchar)
  (send w movetoxy w:right - 1 w:top)
  (pbout verticalbarchar)
  (send w movetoxy w:left w:bottom)
  (pbout verticalbarchar)
  (printnc w:width - 2 horizontalbarchar)
  (pbout verticalbarchar)
  (terpri)
  (send w clear)
  (send w movetoxy 0 2))
)

% Close a graphics window.
(dg window-close (w:window)

)


% GSN  2-FEB-83 13:57 
(DG WINDOW-CENTEROFFSET (W:WINDOW V:VECTOR)
(SEND W:REGION CENTEROFFSET V))


% GSN 28-FEB-83 16:10 
(DG WINDOW-DRAWLINE (W:WINDOW FROM:VECTOR TO:VECTOR)
  (if from:y=to:y then (send w moveto from)
                       (printnc (to:x - from:x + 1) horizontalbarchar)))


% GSN 28-FEB-83 16:58 
(DG WINDOW-INVERTAREA (W:WINDOW AREA:REGION)
  nil)


% GSN 13-JAN-83 15:29 
(DG WINDOW-MOVETO (W:WINDOW POS:VECTOR)
  (send w movetoxy pos:x pos:y))

% Move to position specified as separate x and y coordinates.
(dg window-movetoxy (w:window x:integer y:integer)
  (if x < 0 then (x _ 0) elseif x > 79 then (x _ 79))
  (if y < 0 then (y _ 0) elseif Y > 23 then (y _ 23))
  (pbout escapechar)
  (pbout (char Y))
  (pbout (55 - y))
  (pbout (32 + x)))

% GSN  2-MAR-83 13:58 
(DG WINDOW-PRETTYPRINTAT (W:WINDOW VALUE POSITION:VECTOR)
  (send w printat value position))


% GSN 13-JAN-83 16:25 
(DG WINDOW-PRINTAT (W:WINDOW S:STRING POS:VECTOR)
  (send w moveto pos)
  (prin2 s))


% GSN 28-FEB-83 16:10 
(DG WINDOW-unDRAWLINE (W:WINDOW FROM:VECTOR TO:VECTOR)
  (if from:y=to:y then (send w moveto from)
                       (printnc (to:x - from:x + 1) blankchar)))

% GSN 13-JAN-83 16:24 
(DG WINDOW-UNPRINTAT (W:WINDOW S:STRING POS:VECTOR)
  (send w moveto pos)
  (printnc s:length " "))

% Present a pop-up menu and select an item from it.    GSN   14 March 83
(dg menu-select (m:menu)
(prog (maxw i n)
  (maxw _ 0)
  (for x in m:items do (maxw _ (max maxw x:pname:length)))
  (maxw _ (min maxw 20))
  (m:window _ (a window with start = menustart
                   size = (a vector with x = (maxw + 5)* windowcharwidth
                            y = (min (length n:items) 19) * windowlineyspacing)
                   title = "Menu"))
  (send m:window open)
  (I _ 0)
  (for x in m:items do
    (i _+ 1)
    (send m:window printatxy (concat (gevstringify i)
                                     (if i<10 then "  " else " ")
                                     (gevstringify x))))
  (send m:window movetoxy 0 2)
  (send m:window eraseeol)
lp
  (send m:window movetoxy 0 2)
  (prin2 "Menu:")
  (n _ (read))
  (if n is integer and n > 0 and n <= (length m:items)
      then (return (nth m:items n))
      else (prin1 n)
           (prin2 " ?")
           (send m:window eraseeol)
           (go lp) )))

% Print the same character n times.
(dg printnc (n:integer c:integer)
  (while n > 0 do (n _- 1) (prin2 c)))

(dg window-clear (w:window)
  (prog (y)
    (y _ w:top - 1)
    (while y >= w:lastfilledline do
      (send w movetoxy w:left y)
      (prin2 verticalbarchar)
      (send w eraseeol)
      (send w movetoxy w:right - 1 y)
      (prin2 verticalbarchar)
      (y _- 1))
))