Artifact fa68ce3b425744da80b4be1d9fce7b6985ec9e607048a76625487fd754a8762b:

• File psl-1983/3-1/glisp/windowhrd.sl — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 4502) [annotate] [blame] [check-ins using] [more...]

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