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

% 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)))