% WINDOWCRT.SL.11 07 April 83
% derived from <NOVAK>WINDOWCRT.PSL.1 20-Mar-83 12:40:45
% Written by Gordon Novak Jr.
% Copyright (c) 1983 Hewlett-Packard
(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)
(CENTEROFFSET WINDOW-CENTEROFFSET OPEN T))
SUPERS (REGION))
)
(GLISPGLOBALS
(MOUSE MOUSE)
)
(GLISPCONSTANTS
(WINDOWCHARWIDTH 1 INTEGER)
(WINDOWLINEYSPACING 1 INTEGER)
)
(SETQ MOUSE 'MOUSE)
(SETQ GEVMENUWINDOW NIL)
(SETQ MENUSTART (A VECTOR WITH X = 50 Y = 3))
% 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)))
(SEND M:WINDOW MOVETOXY 0 -1)
(SEND TERMINAL ERASEEOL)
LP
(SEND M:WINDOW MOVETOXY 0 -1)
(SEND TERMINAL PRINTSTRING "Menu: ")
(SEND TERMINAL ERASEEOL)
(echoon)
(N _ (READ))
(echooff)
(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)
(SEND TERMINAL PRINTSTRING "?")
(SEND TERMINAL ERASEEOL)
(GO LP))
OUT
(SEND M:WINDOW CLOSE)
(SEND M:WINDOW MOVETOXY 0 -1)
(TERPRI)
(SEND TERMINAL ERASEEOL)
(SETQ GLQUIETFLG SAVEGLQ)
(if ~gevactiveflg then (gevexit))
(RETURN RESULT)))
% edited: 11-Mar-83 22:42
% Print a character N times.
(DG PRINTNC (N:INTEGER C:STRING)
(WHILE N > 0 DO (N _- 1)
(SEND TERMINAL PRINTCHAR C)))
% edited: 16-Mar-83 14:02
% Open a window in a H-19 terminal.
(DG WINDOW-CLEAR (W:WINDOW)
(PROG (TTL NBL Y NLINES)
(NLINES_0)
(SEND TERMINAL GRAPHICSMODE)
(Y _ W:HEIGHT - 1)
(WHILE Y >= W:LASTFILLEDLINE DO (SEND W MOVETOXY 0 Y)
(SEND TERMINAL PRINTCHAR LVERTICALBARCHAR)
(IF Y<W:TOP THEN (SEND TERMINAL ERASEEOL))
(SEND W MOVETOXY W:WIDTH - 1 Y)
(SEND TERMINAL PRINTCHAR RVERTICALBARCHAR)
(IF (NLINES _+ 1)
>3 THEN (TERPRI)
(NLINES_0))
(Y_-1))
(SEND TERMINAL NORMALMODE)
(SEND W MOVETOXY 0 -1)
(TERPRI)
(W:LASTFILLEDLINE _ W:HEIGHT)
(SEND W MOVETOXY 0 -1)))
(DG WINDOW-CLOSE (W:WINDOW)
(PROG (Y NLINES)
(Y _ W:HEIGHT)
(NLINES _ 0)
(WHILE Y >= 0 DO (SEND W MOVETOXY 0 Y)
(SEND TERMINAL ERASEEOL)
(IF (NLINES _+ 1)
> 8 THEN (TERPRI)
(NLINES _ 0))
(Y _- 1))
(TERPRI)))
% edited: 12-Mar-83 15:22
(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)
HORIZONTALLINECHAR)
(IF FROM:Y < W:LASTFILLEDLINE THEN (W:LASTFILLEDLINE _ FROM: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)
(SEND TERMINAL MOVETOXY X+W:LEFT Y+W:BOTTOM))
% edited: 19-Mar-83 20:39
% Open a window on a H-19 terminal.
(DG WINDOW-OPEN (W:WINDOW)
(PROG (TTL NBL L)
(SEND W MOVETOXY 1 W:HEIGHT)
(TTL _ W:TITLE OR " ")
(L_TTL:LENGTH)
(SEND TERMINAL 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)
(SEND TERMINAL PRINTSTRING TTL)
(PRINTNC (W:WIDTH - TTL:LENGTH - NBL - 2)
BLANKCHAR)
(SEND TERMINAL NORMALVIDEO)
(TERPRI)
(SEND TERMINAL GRAPHICSMODE)
(W:LASTFILLEDLINE _ 1)
(SEND W MOVETOXY 0 W:HEIGHT)
(SEND TERMINAL PRINTCHAR LVERTICALBARCHAR)
(SEND W MOVETOXY W:WIDTH - 1 W:HEIGHT)
(SEND TERMINAL PRINTCHAR RVERTICALBARCHAR)
(SEND W MOVETOXY 0 0)
(SEND TERMINAL PRINTCHAR LVERTICALBARCHAR)
(PRINTNC W:WIDTH - 2 HORIZONTALBARCHAR)
(SEND TERMINAL PRINTCHAR RVERTICALBARCHAR)
(send terminal eraseeol)
(SEND TERMINAL NORMALMODE)
(TERPRI)
(SEND W CLEAR)
(SEND W MOVETOXY 0 -1)))
% edited: 12-Mar-83 17:03
(DG WINDOW-PRETTYPRINTAT (W:WINDOW VALUE POSITION:VECTOR)
(SEND W MOVETO POSITION)(RESETLST (RESETSAVE SYSPRETTYFLG T)
(RESETSAVE TTYLINELENGTH
(W:WIDTH - POSITION:X - 1))
(SHOWPRINT VALUE)
(W:LASTFILLEDLINE _ 1)))
% 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 TERMINAL PRINTSTRING S)
(TERPRI)
(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)
(IF FROM:Y=TO:Y THEN (SEND W MOVETO FROM)
(PRINTNC (TO:X - FROM:X + 1)
BLANKCHAR)))
% edited: 16-Mar-83 14:19
(DG WINDOW-UNPRINTAT (W:WINDOW S:STRING POS:VECTOR)
(IF POS:Y > 0 THEN (SEND W MOVETO POS)
(PRINTNC S:LENGTH BLANKCHAR)))