Artifact 3541800032036ee0b62c6fad2cc0398ad4134012e5140de5fcf27b1c6c90987e:

• File psl-1983/3-1/glisp/window.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: 6417) [annotate] [blame] [check-ins using] [more...]

% WINDOW.SL.10     28 March 83

% derived from {DSK}WINDOW.PSL;1  4-MAR-83 16:25:00 




(glispconstants

(screenxoffset -255 integer)
(screenyoffset -255 integer)
(screenxscale 256.0 real)
(screenyscale 256.0 real)
)



(GLISPOBJECTS


(MENU (listobject (ITEMS (LISTOF ATOM))
                  (window window))
MSG     ((SELECT MENU-select RESULT ATOM)))


(MOUSE ANYTHING)

(grpos integer
prop ((screenvalue ((self  + screenxoffset) / screenxscale ))))

(grvector (list (x grpos) (y grpos))
  supers (vector))

(WINDOW (listobject (start grvector)
                    (size grvector)
                    (title string)
                    (lastfilledline integer)
                    (lastposition grvector))

PROP    ((leftmargin (left + 1))
         (rightmargin (right - 2)))

MSG     ((CLEAR window-clear)
	 (OPEN window-open)
	 (CLOSE window-close)
         (movetoxy window-movetoxy OPEN T)
	 (INVERTAREA WINDOW-INVERTAREA)
	 (MOVETO WINDOW-MOVETO OPEN T)
	 (PRINTAT WINDOW-PRINTAT OPEN T)
         (printatxy window-printatxy)
	 (PRETTYPRINTAT WINDOW-PRETTYPRINTAT)
	 (UNPRINTAT WINDOW-UNPRINTAT OPEN T)
         (unprintatxy window-unprintatxy)
	 (DRAWLINE WINDOW-DRAWLINE OPEN T)
         (drawlinexy window-drawlinexy OPEN T)
	 (UNDRAWLINE WINDOW-UNDRAWLINE OPEN T)
         (undrawlinexy window-undrawlinexy OPEN T)
	 (CENTEROFFSET WINDOW-CENTEROFFSET))
supers (region) )

)

  

(GLISPGLOBALS
(MOUSE MOUSE)
)

(glispconstants
(windowcharwidth 8 integer)
(windowlineyspacing 20 integer)
)


(setq mouse 'mouse)
(setq gevmenuwindow nil)
(setq menustart (a vector with x = 320 y = 0))

% Initialize graphics routines.
(dg window-init (w:window)
 (prog ()
  (graphics-init)
  (color-display)
  (set-color white)
  (set-line-style solid)
  (set-char-size (quotient 7.0 screenxscale) (quotient 16.0 screenyscale))
))

% Done with graphics
(dg window-term (w:window)
  (prog ()
    (graphics-term)))


% Alias graphics function names without underline characters
(de graphics-init () (graphics_init))
(de graphics-term () (graphics_term))
(de display-init (unit mode) (display_init unit mode))
(de set-color (x) (set_color x))
(de set-line-style (x) (set_line_style x))
(de clear-display () (clear_display))
(de set-char-size (w h) (set_char_size w h))
(de set-text-rot (x y) (set_text_rot x y))
(de set-display-lim (x0 x1 y0 y1) (set_display_lim x0 x1 y0 y1))
(de set-viewport (x0 x1 y0 y1) (set_viewport x0 x1 y0 y1))
(de init-9111 () (init_9111))
(de sample-locator () (sample_locator))
(de await-locator () (await_locator))
(de color-display () (color_display))


% Clear a graphics window.
(dg window-clear (w:window)
)

% Open a graphics window.
(dg window-open (w:window)
(send w drawlinexy w:left w:bottom w:left w:top)
(send w drawlinexy w:left w:top w:right w:top)
(send w drawlinexy w:right w:top w:right w:bottom)
(send w drawlinexy w:right w:bottom w:left w:bottom)
)

% Open a graphics window.
(dg window-close (w:window)
(send w undrawlinexy w:left w:bottom w:left w:top)
(send w undrawlinexy w:left w:top w:right w:top)
(send w undrawlinexy w:right w:top w:right w:bottom)
(send w undrawlinexy w:right w:bottom w:left w:bottom)
)

% GSN  2-MAR-83 16:19 
(DG MOUSE-POSITIONIN (M:MOUSE W:WINDOW)
(GETMOUSESTATE)(A VECTOR WITH X = (LASTMOUSEX W)
		  Y = (LASTMOUSEY W)))


% GSN  2-MAR-83 16:19 
(DG MOUSE-TESTBUTTON (M:MOUSE BUTTON:INTEGER)
(GETMOUSESTATE)(NOT (ZEROP (LOGAND LASTMOUSEBUTTONS BUTTON))))


% GSN  2-FEB-83 13:57 
(DG WINDOW-CENTEROFFSET (W:WINDOW V:VECTOR)
(SEND W:REGION CENTEROFFSET V))


% GSN 28-FEB-83 16:10 
(DG WINDOW-DRAWLINE (W:WINDOW FROM:grVECTOR TO:grVECTOR)
  (send w drawlinexy from:x from:y to:x to:y))

(DG WINDOW-DRAWLINExy (W:WINDOW fromx:grpos fromy:grpos tox:grpos toy:grpos)
  (gdraw white solid fromx:screenvalue fromy:screenvalue
                     tox:screenvalue   toy:screenvalue))

% GSN 28-FEB-83 16:58 
(DG WINDOW-INVERTAREA (W:WINDOW AREA:REGION)
  nil)


% GSN 13-JAN-83 15:29 
(DG WINDOW-MOVETO (W:WINDOW POS:grVECTOR)
  (send w movetoxy pos:x pos:y))

% Move to position specified as separate x and y coordinates.
(dg window-movetoxy (w:window x:grpos y:grpos)
  (gmove x:screenvalue y:screenvalue))

% GSN  2-MAR-83 13:58 
(DG WINDOW-PRETTYPRINTAT (W:WINDOW VALUE POSITION:grVECTOR)
  (set-color white)
  (send w moveto pos)
  (w:lastposition _ position)
  (gtext value))


% GSN 13-JAN-83 16:25 
(DG WINDOW-PRINTAT (W:WINDOW S:STRING POS:grVECTOR)
  (set-color white)
  (send w moveto pos)
  (gtext s))

(DG WINDOW-PRINTATxy (W:WINDOW S:STRING x:grpos y:grpos)
  (set-color white)
  (send w movetoxy x y)
  (gtext s))


% GSN 28-FEB-83 16:11 
(DG WINDOW-UNDRAWLINE (W:WINDOW FROM:VECTOR TO:grVECTOR)
  (send w undrawlinexy from:x from:y to:x to:y))

(DG WINDOW-unDRAWLINExy (W:WINDOW fromx:grpos fromy:grpos tox:grpos toy:grpos)
  (gdraw background solid fromx:screenvalue fromy:screenvalue
                     tox:screenvalue   toy:screenvalue))


% GSN 13-JAN-83 16:24 
(DG WINDOW-UNPRINTAT (W:WINDOW S:STRING POS:grVECTOR)
  (set-color background)
  (send w moveto pos)
  (gtext s))

(DG WINDOW-UNPRINTATxy (W:WINDOW S:STRING x:grpos y:grpos)
  (set-color background)
  (send w movetoxy x y)
  (gtext s))

% Present a pop-up menu and select an item from it.    GSN   14 March 83
(dg menu-select (m:menu)
(prog (maxw i n saveglq result)
  (if ~gevactiveflg then (geventer))
  (saveglq _ glquietflg)
  (glquiteflg _ t)
  (maxw _ 0)
  (for x in m:items do (maxw _ (max maxw x:pname:length)))
  (maxw _ (min maxw 20))
  (m:window _ (a window with start = menustart
                   size = (a vector with x = (maxw + 5)* windowcharwidth
                            y = (min (length m:items) 19) * windowlineyspacing)
                   title = "Menu"))
  (send m:window open)
  (I _ 0)
  (for x in m:items do
    (i _+ 1)
    (send m:window printatxy (concat (gevstringify i)
                                     (concat (if i<10 then "  " else " ")
                                             (gevstringify x)))
           1 (m:window:height - i * windowlineyspacing) ))
lp
  (prin2 "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)
           (prin2 " ?")
           (terpri)
           (go lp) )
out
  (setq glquietflg saveglq)
  (if ~gevactiveflg then (gevexit))
  (return result)
))