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

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