% WINDOWHRD.SL.7 07 April 83
% Window package for Methius display on HP 9836
% derived from <NOVAK>WINDOWCRT.PSL.1 20-Mar-83 12:40:45
(GLOBAL '(MENUSTART))
(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 ((YPOSITION (LASTFILLEDLINE))
(LEFTMARGIN (1))
(RIGHTMARGIN (WIDTH - 2)))
MSG ((CLEAR WINDOW-CLEAR)
(OPEN WINDOW-OPEN)
(CLOSE WINDOW-CLOSE)
(INVERTAREA WINDOW-INVERTAREA OPEN T)
(MOVETOXY WINDOW-MOVETOXY OPEN T)
(MOVETO WINDOW-MOVETO OPEN T)
(PRINTAT WINDOW-PRINTAT OPEN T)
(PRETTYPRINTAT WINDOW-PRETTYPRINTAT OPEN T)
(UNPRINTAT WINDOW-UNPRINTAT OPEN T)
(DRAWLINE WINDOW-DRAWLINE OPEN T)
(UNDRAWLINE WINDOW-UNDRAWLINE OPEN T)
(PRINTCHAR WINDOW-PRINTCHAR OPEN T)
(PRINTSTRING WINDOW-PRINTSTRING)
(PRINTNC WINDOW-PRINTNC)
(CENTEROFFSET WINDOW-CENTEROFFSET OPEN T))
SUPERS (REGION))
)
(GLISPGLOBALS
(MOUSE MOUSE)
)
(GLISPCONSTANTS
(WINDOWCHARWIDTH 8 INTEGER)
(WINDOWLINEYSPACING 16 INTEGER)
)
(SETQ MOUSE 'MOUSE)
(SETQ GEVMENUWINDOW NIL)
(SETQ MENUSTART (A VECTOR WITH X = 500 Y = 1))
% edited: 16-Mar-83 15:04
% Select an item from a pop-up menu.
(DG MENU-SELECT (M:MENU)
(PROG (MAXW I N SAVEESC SAVEGLQ SAVEGCG RESULT)
(if ~gevactiveflg then (geventer))
(SAVEGLQ _ GLQUIETFLG)
(GLQUIETFLG _ T)
(MAXW_0)
(FOR X IN M:ITEMS DO (MAXW_ (MAX MAXW X:PNAME:LENGTH)))
(IF MAXW > 20 THEN (MAXW _ 20))
(M:WINDOW _ (A WINDOW WITH START = MENUSTART SIZE =
(A VECTOR WITH X = (MAXW + 5)
*WINDOWCHARWIDTH Y = (MIN (LENGTH M:ITEMS)
+ 1 19)
*WINDOWLINEYSPACING)
TITLE = "Menu"))
(SEND M:WINDOW OPEN)
(I_0)
(FOR X IN M:ITEMS DO (I _+ 1)
(SEND M:WINDOW PRINTAT (CONCAT (GEVSTRINGIFY I)
(concat (IF I<10 THEN " " ELSE " ")
(gevstringify X)))
(A VECTOR WITH X = 1 Y = M:WINDOW:HEIGHT
- I * windowlineyspacing)))
LP
(PRIN1 "Menu: ")
(N _ (READ))
(IF N IS INTEGER AND N>0 AND N<= (LENGTH M:ITEMS)
THEN
(RESULT _ (CAR (PNth M:ITEMS N)))
(GO OUT)
ELSEIF N = 'Q
THEN
(RESULT _ NIL)
(GO OUT)
ELSE
(PRIN1 N)
(SPACES 1)
(PRINC "?")
(terpri)
(GO LP))
OUT
(SEND M:WINDOW CLOSE)
(TERPRI)
(SETQ GLQUIETFLG SAVEGLQ)
(if ~gevactiveflg then (gevexit))
(RETURN RESULT)))
% edited: 16-Mar-83 14:02
% Open a window in a H-19 terminal.
(DG WINDOW-CLEAR (W:WINDOW)
(PROG ()
(M-ERASE W:LEFT W:BOTTOM W:RIGHT W:TOP)
(M-RECT-OUTLINE W:LEFT W:BOTTOM W:RIGHT W:TOP) ))
(DG WINDOW-CLOSE (W:WINDOW)
(M-ERASE W:LEFT W:BOTTOM W:RIGHT W:TOP)
)
% edited: 12-Mar-83 15:22
(DG WINDOW-DRAWLINE (W:WINDOW FROM:VECTOR TO:VECTOR)
(M-VECTOR FROM:X FROM:Y TO:X TO:Y))
% edited: 12-Mar-83 15:17
(DG WINDOW-INVERTAREA (W:WINDOW AREA:REGION)
NIL)
% edited: 12-Mar-83 15:18
(DG WINDOW-MOVETO (W:WINDOW POS:VECTOR)
(SEND W MOVETOXY POS:X POS:Y))
% edited: 19-Mar-83 20:25
% Move cursor to X-Y position relative to window.
(DG WINDOW-MOVETOXY (W:WINDOW X:INTEGER Y:INTEGER)
(M-MOVEP1 X+W:LEFT Y+W:BOTTOM))
% edited: 19-Mar-83 20:39
% Open a window on a terminal.
(DG WINDOW-OPEN (W:WINDOW)
(SEND W CLEAR))
% edited: 12-Mar-83 17:03
(DG WINDOW-PRETTYPRINTAT (W:WINDOW VALUE POSITION:VECTOR)
(SEND W PRINTAT VALUE POSITION))
% edited: 16-Mar-83 14:18
(DG WINDOW-PRINTAT (W:WINDOW S:STRING POS:VECTOR)
(IF POS:Y > 0 THEN (SEND W MOVETO POS)
(SEND W PRINTSTRING S)
(IF POS:Y < W:LASTFILLEDLINE THEN (W:LASTFILLEDLINE _ POS:Y))))
% edited: 12-Mar-83 15:23
(DG WINDOW-UNDRAWLINE (W:WINDOW FROM:VECTOR TO:VECTOR)
NIL)
% edited: 16-Mar-83 14:19
(DG WINDOW-UNPRINTAT (W:WINDOW S:STRING POS:VECTOR)
(IF POS:Y > 0 THEN (SEND W MOVETO POS)
(SEND W PRINTNC S:LENGTH " ")))
% edited: 11-Mar-83 22:42
% Print a character N times.
(DG WINDOW-PRINTNC (W:WINDOW N:INTEGER C:STRING)
(WHILE N > 0 DO (N _- 1)
(SEND W PRINTCHAR C)))
% Print a character on the display
(DG WINDOW-PRINTCHAR (W:WINDOW S:STRING)
(M-CHAR (INDX S 0)))
% Print a string on the display.
(DG WINDOW-PRINTSTRING (W:WINDOW S:STRING)
(PROG (L:INTEGER I)
(S _ (GEVSTRINGIFY S))
(L _ (SIZE S))
(I _ 0)
(WHILE I <= L DO (M-CHAR (INDX S I))
(I _+ 1)) ))