(FILECREATED "17-AUG-83 13:22:42" {PHYLUM}<LISPCORE>SOURCES>WINDOW.;143 430415Q
changes to: (FNS ADVISEWDS HASTTYWINDOWP)
previous date: "16-AUG-83 12:22:29" {PHYLUM}<LISPCORE>SOURCES>WINDOW.;142)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT WINDOWCOMS)
(RPAQQ WINDOWCOMS [(COMS (FNS WINDOWWORLD WINDOWWORLDP CHANGEBACKGROUND TILE LOGOW
\DRAWLOGOWINDOWIMAGE \TTY.CREATING.DISPLAYSTREAM \CREATE.TTY.OUTCHARFN
\CREATE.TTYDISPLAYSTREAM HASTTYWINDOWP)
(VARS (\TTYREGIONOFFSETSPTR))
[INITVARS [TTYREGIONOFFSETS (QUOTE ((0 . 0)
(24Q . -24Q)
(50Q . 0)
(24Q . 24Q]
(DEFAULTTTYREGION (QUOTE (231Q 144Q 600Q 320Q]
(GLOBALVARS \TTYREGIONOFFSETSPTR TTYREGIONOFFSETS))
(COMS (* Window menu operations)
(FNS WINDOW.MOUSE.HANDLER DOWINDOWCOM DOBACKGROUNDCOM)
(FNS BURYW CLEARW CLOSEW \CLOSEW1 \OKTOCLOSEW OPENW DOUSERFNS DOUSERFNS2 \USERFNISDON'T
\OPENW1 CREATEW MOVEW RELMOVEW HARDCOPYW PAINTW PAINTW.READBRUSHSHADE
PAINTW.READMODE PAINTW.READBRUSHSHAPE PAINTW.READBRUSHSIZE SHAPEW RESHOWBORDER
\RESHOWBORDER1 TRACKW SNAPW FRAME/EXISTING/BITS))
[COMS (* Window utilities)
(FNS ADVISEWDS SHOWWFRAME SHOWWTITLE \STRINGWIDTHGUESS RESHOWTITLE TOTOPW
\INTERNALTOTOPW \TTW1 WHICHW)
(VARS (WINDOWTITLEPRINTLEVEL (QUOTE (2 . 5]
[COMS (* Window vs non-window world)
(FNS SWITCHDEF NU\BACKGROUND WFROMDS NU\TOTOPWDS \COERCETODS)
(DECLARE: DONTCOPY (EXPORT (MACROS \COERCETODS .WHILE.ON.TOP.]
(COMS (* User interface functions)
(FNS WINDOWP WINDOWPROP WINDOWADDPROP WINDOWDELPROP GETWINDOWPROP GETWINDOWUSERPROP
PUTWINDOWPROP REMWINDOWPROP WINDOWADDFNPROP)
(PROP ARGNAMES WINDOWPROP)
(EXPORT (MACROS WINDOWPROP)))
[COMS (FNS OPENWP RESHAPEBYREPAINTFN DECODE/WINDOW/OR/DISPLAYSTREAM GROW/REGION ONWINDOWCHAIN
PPROMPT3 CLRPROMPT PROMPTPRINT OPENWINDOWS \INSUREWINDOW)
(* these entries are left in for backward compatibility. They were dedocumented 6/83.
rrb.)
(P (MOVD (QUOTE OPENWP)
(QUOTE ACTIVEWP))
(MOVD (QUOTE OPENWINDOWS)
(QUOTE ACTIVEWINDOWS)))
(FNS OVERLAPPINGWINDOWS WOVERLAPP ORDERFROMBOTTOMTOTOP)
(* screen size changing functions.)
(FNS \ONSCREENW \PUTONSCREENW \UPDATECACHEDFIELDS \WWCHANGESCREENSIZE CREATEWFROMIMAGE
UPDATEWFROMIMAGE)
(EXPORT (DECLARE: DOEVAL@COMPILE DONTCOPY (MACROS WINDOWWORLD]
(COMS (* Scrolling stuff)
(FNS SCROLLW SCROLLBYREPAINTFN ADJUSTOFFSETS CREATESCROLLINGW IN/SCROLL/BAR?
RELDSPXOFFSET RELDSPYOFFSET SCROLL.HANDLER \SCROLL.HANDLER.DOIT
\UPDATE.EXTENT.IMAGE EXTENDPASTHORIZBOUNDARIES REDISPLAYW FILLWITHBACKGROUND
UPDATE/SCROLL/REG WTODSX WTODSY WXOFFSET WYOFFSET BITMAPSCROLLFN SCROLLBITMAP
REDISPLAYBITMAP ULREDISPLAYBITMAP EXTENDEXTENT WIDTHIFWINDOW HEIGHTIFWINDOW))
(COMS (* icon functions)
(FNS SHRINKW EXPANDW DOICONWINDOWCOM CLOSEMAINWINDOW CLOSEICONWINDOW)
(VARS IconMenuItems))
(CURSORS VertScrollCursor ScrollUpCursor ScrollDownCursor HorizScrollCursor ScrollLeftCursor
ScrollRightCursor VertThumbCursor HorizThumbCursor WAITINGCURSOR)
(DECLARE: EVAL@COMPILE DONTCOPY
(GLOBALVARS \LastCursorPosition \LastInWindow WindowMenu BackgroundMenu
BackgroundMenuCommands \LastWindowButtons WWFNS WindowMenuCommands
IconWindowMenu IconWindowMenuCommands VertScrollCursor ScrollUpCursor
ScrollDownCursor ScrollLeftCursor ScrollRightCursor HorizScrollCursor
WindowTitleDisplayStream WINDOWTITLEPRINTLEVEL WBorder \TOPWDS
WINDOWBACKGROUNDSHADE CURRENTBACKGROUNDSHADE BACKGROUNDFNS)
(CONSTANTS (MinWindowWidth 32Q)
(MinWindowHeight 20Q))
(EXPORT (RECORDS WINDOW)))
(DECLARE: EVAL@COMPILE (EXPORT (GLOBALVARS TOPW WINDOWUSERFORMS ENDOFWINDOWUSERFORMS
PROMPTWINDOW KNOWNWINDOWS)))
(SYSRECORDS WINDOW)
(INITRECORDS WINDOW)
(INITVARS (WWFNS (QUOTE (\TOTOPWDS)))
(WindowTitleDisplayStream)
(WindowMenu)
(BackgroundMenu)
(TOPW)
(\LastCursorPosition (CREATEPOSITION))
(\LastInWindow)
(\LastWindowButtons 0)
(IconWindowMenu)
(KNOWNWINDOWS)
(WINDOWBACKGROUNDSHADE 104042Q)
(WBorder 4)
(SCROLLBARWIDTH 30Q)
(SCROLLWAITTIME 144Q)
(WAITBEFORESCROLLTIME 1356Q)
(WAITBETWEENSCROLLTIME 144Q)
(PAINTCOMMANDBRUSH (QUOTE (ROUND 2)))
(PAINTCOMMANDMODE (QUOTE PAINT))
(PAINTCOMMANDMENU)
(PAINTCOMMANDSHADE BLACKSHADE)
(PAINTSIZEMENU)
(PAINTSHAPEMENU)
(PAINTSHADEMENU)
(PAINTMODEMENU)
(HIGHLIGHTSHADE 100040Q))
(ADDVARS (WindowMenuCommands (Close (QUOTE CLOSEW)
"Closes a window")
(Snap (QUOTE SNAPW)
"Saves a snapshot of a region of the screen.")
(Paint (QUOTE PAINTW)
"Starts a painting mode in which the mouse can
be used to draw pictures or make notes on windows.
Includes a HARDCOPY command.")
(Clear (QUOTE CLEARW)
"Clears a window to its gray.")
(Bury (QUOTE BURYW)
"Puts a window on the bottom.")
(Redisplay (QUOTE REDISPLAYW)
"Redisplays a window using its REPAINTFN.")
(Move (QUOTE MOVEW)
"Moves a window by a corner.")
(Shape (QUOTE SHAPEW)
"Gets a new region for a window.
Left button down marks fixed corner; sweep to other corner.
Middle button down moves closest corner.")
(Shrink (QUOTE SHRINKW)
"Replaces this window with its icon (or title if it doesn't have an icon."))
(IconWindowMenuCommands (Close (QUOTE CLOSEW)
"Closes the icon and its assciated window")
(Snap (QUOTE SNAPW)
"Saves a snapshot of a region of the screen.")
(Paint (QUOTE PAINTW)
"Starts a painting mode in which the mouse can
be used to draw pictures or make notes on windows.
Includes a HARDCOPY command.")
(Bury (QUOTE BURYW)
"Puts a window on the bottom.")
(Move (QUOTE MOVEW)
"Moves a window by a corner.")
(Shape (QUOTE SHAPEW)
"Gets a new region for a window.
Left button down marks fixed corner; sweep to other corner.
Middle button down moves closest corner.")
(Expand (QUOTE EXPANDW)
"Expands the window for which this is the ICON."))
(BackgroundMenuCommands (SaveVM (QUOTE (SAVEVM))
"Updates the virtual memory.")
(Snap (QUOTE (SNAPW))
"Saves a snapshot of a region of the screen.")
(Hardcopy (QUOTE (HARDCOPYW))
"Send hardcopy of screen region to printer.")))
(ADDVARS (WINDOWUSERFORMS)
(ENDOFWINDOWUSERFORMS))
(DECLARE: DOCOPY DONTEVAL@LOAD (P (WINDOWWORLD T))
(ADDVARS (GLOBALVARS SCROLLBARWIDTH SCROLLWAITTIME WAITBEFORESCROLLTIME
WAITBETWEENSCROLLTIME WAITINGCURSOR)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA PROMPTPRINT
WINDOWPROP
WINDOWWORLD])
(DEFINEQ
(WINDOWWORLD
[LAMBDA CHANGEIT (* rrb "16-AUG-83 11:38")
(* returns T if the window system is active.
If CHANGEIT is given, the window system will be turned
off or on.)
(DECLARE (GLOBALVARS \TopLevelTtyWindow))
(PROG1 (type? WINDOW TOPW)
(COND
((ZEROP CHANGEIT))
((ARG CHANGEIT 1)
(UNINTERRUPTABLY
(SETQ CURRENTBACKGROUNDSHADE (CLEAR (SCREENBITMAP)
WINDOWBACKGROUNDSHADE))
(COND
((WINDOWWORLD) (* Windows already on; close then all This keeps them
from being confused about where their image is NIL)
(for WINDOW in (OPENWINDOWS) do (CLOSEW WINDOW)))
(T (* Initially no windows)
(for FN in WWFNS do (SWITCHDEF FN (QUOTE \OLD)
(QUOTE NU)))
(COND
((NOT (type? DISPLAYSTREAM WindowTitleDisplayStream))
(DSPOPERATION (QUOTE INVERT)
(SETQ WindowTitleDisplayStream (DSPCREATE)))
(DSPFONT (FONTCREATE (QUOTE HELVETICA)
8)
WindowTitleDisplayStream)
(* set right margin so title doesn't autoCR.)
(DSPRIGHTMARGIN 60000 WindowTitleDisplayStream)))
(DSPXOFFSET 0 (TTYDISPLAYSTREAM)) (* Get TTY in shape. Region is only approx as user can
change it.)
(DSPYOFFSET 0 (TTYDISPLAYSTREAM))
(DSPCLIPPINGREGION (create REGION
LEFT ← SCROLLBARWIDTH
BOTTOM ← 378
WIDTH ← 550
HEIGHT ← 350)
(TTYDISPLAYSTREAM))
(* First attempt to print creates TTY window)
(\STARTDISPLAY) (* Not DISPLAYSTREAMINIT. No point in leaving a TTY
area)
(DSPDESTINATION (SCREENBITMAP)
(TTYDISPLAYSTREAM))
(* SCREENBITMAP changes in STARTDISPLAY)
(SETLINELENGTH) (* Resets line length for TTY)
))
(SETQ \DEFAULTTTYDISPLAYSTREAM (\TTY.CREATING.DISPLAYSTREAM))
(SETQ TOPW NIL)
(SETQ \TOPWDS NIL) (* set up PROMPTWINDOW and TTY window and LOGO windows)
(PROG ((DS (DSPCREATE)))
(DSPTEXTURE BLACKSHADE DS)
(DSPOPERATION (QUOTE ERASE)
DS)
(DSPSCROLL (QUOTE ON)
DS)
(DSPCLIPPINGREGION [create REGION
LEFT ←(IDIFFERENCE (FOLDLO SCREENWIDTH 2)
250)
BOTTOM ←(IPLUS SCREENHEIGHT
(ITIMES 4 (DSPLINEFEED NIL DS))
-8)
WIDTH ← 500
HEIGHT ←(ITIMES 3 (IMINUS (DSPLINEFEED NIL DS]
DS)
(WINDOWPROP (SETQ PROMPTWINDOW (CREATEW DS "Prompt Window" 2))
(QUOTE SHRINKFN)
(QUOTE DON'T)) (* set it so that PROMPTWINDOW doesn't hold.)
(WINDOWPROP PROMPTWINDOW (QUOTE PAGEFULLFN)
(FUNCTION NILL)))
(SETQ LOGOW (LOGOW "Interlisp-D" (create POSITION
XCOORD ← 600
YCOORD ← 552)))
[WINDOWPROP LOGOW (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (W) (* clear the variable so that it will be collected.)
(SETQ LOGOW NIL]
(SETQ \TopLevelTtyWindow (CREATEW (TTYDISPLAYSTREAM)
"Top level typescript window")))
(* initialize the window mouse handler variables.)
(SETQ \LastInWindow)
(SETQ \LastWindowButtons 0)
(SETQ \LastCursorPosition (create POSITION))
(MAPC WINDOWUSERFORMS (FUNCTION EVAL)))
((WINDOWWORLD) (* if its on turn it off)
(MAPC ENDOFWINDOWUSERFORMS (FUNCTION EVAL))
(UNINTERRUPTABLY
(for F in WWFNS do (SWITCHDEF F (QUOTE NU)
(QUOTE \OLD)))
(AND (LISTP BACKGROUNDFNS)
(SETQ BACKGROUNDFNS (DREMOVE (QUOTE WINDOW.MOUSE.HANDLER)
BACKGROUNDFNS)))
(BITBLT NIL 0 0 (SCREENBITMAP)
0 0 NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)
(DISPLAYSTREAMINIT 65)
(SETLINELENGTH)
(SETQ TOPW NIL)
(SETQ \TOPWDS (SETQ \TopLevelTtyWindow NIL))
(SETQ PROMPTWINDOW T))])
(WINDOWWORLDP
[LAMBDA NIL (* rrb " 7-MAY-82 18:39")
(* is the window system operating?)
(type? WINDOW TOPW])
(CHANGEBACKGROUND
[LAMBDA (SHADE) (* rrb "28-JUN-83 11:51")
(* changes the window world background to SHADE)
(COND
((OR (EQ SHADE T)
(NULL SHADE))
(SETQ SHADE WINDOWBACKGROUNDSHADE))
((NOT (OR (TEXTUREP SHADE)
(BITMAPP SHADE)))
(\ILLEGAL.ARG SHADE)))
(PROG ((OPENWINDOWS (OPENWINDOWS)))
(for W in OPENWINDOWS do (\CLOSEW1 W T))
(RETURN (PROG1 CURRENTBACKGROUNDSHADE (SETQ CURRENTBACKGROUNDSHADE SHADE)
[COND
((TEXTUREP SHADE)
(CLEAR (SCREENBITMAP)
SHADE))
((BITMAPP SHADE)
(TILE SHADE (SCREENBITMAP]
(for W in OPENWINDOWS do (\OPENW1 W])
(TILE
[LAMBDA (SRC DST) (* lmm "25-APR-82 21:55")
(PROG ((X 0)
(Y 0)
(W (fetch BITMAPWIDTH of SRC))
(H (fetch BITMAPHEIGHT of SRC))
(DSTW (fetch BITMAPWIDTH of DST))
(DSTH (fetch BITMAPHEIGHT of DST)))
(while (ILESSP X DSTW) do (SETQ Y 0)
(while (ILESSP Y DSTH)
do (BITBLT SRC 0 0 DST X Y W H NIL (QUOTE REPLACE))
(add Y H))
(add X W])
(LOGOW
[LAMBDA (STRING WHERE TITLE ANGLEDELTA) (* edited: " 1-AUG-83 22:55")
(* creates a logo window.)
(PROG ((CIRCLESIZE 60)
(LOGOXCENTER 70)
(LOGOYCENTER 65)
(LOGOWINDOWHEIGHT 180)
W LOGOWINDOWWIDTH WIMAGEWIDTH WIMAGEHEIGHT (STRING (OR STRING "Interlisp-D")))
(OR ANGLEDELTA (SETQ ANGLEDELTA 23))
(SETQ WIMAGEWIDTH (FIX (FTIMES CIRCLESIZE .62)))
(SETQ WIMAGEHEIGHT (FIX (FTIMES CIRCLESIZE .5)))
[SETQ LOGOWINDOWWIDTH (IPLUS LOGOXCENTER 30 WIMAGEWIDTH (STRINGWIDTH STRING
(QUOTE (TIMESROMAND
36]
[SETQ W (COND
((TYPENAMEP WHERE (QUOTE WINDOW))
WHERE)
(T (CREATEW (COND
((POSITIONP WHERE)
(create REGION
LEFT ←(fetch (POSITION XCOORD) of WHERE)
BOTTOM ←(fetch (POSITION YCOORD) of WHERE)
WIDTH ← LOGOWINDOWWIDTH
HEIGHT ← LOGOWINDOWHEIGHT))
(T (GETBOXREGION LOGOWINDOWWIDTH LOGOWINDOWHEIGHT NIL NIL NIL
"Specify location for logo window.")))
(OR TITLE (CONCAT "Copyright (c) by Xerox Corporation" " "
(OR MAKESYSDATE (DATE]
(for ANGLE from 0 to 270 by ANGLEDELTA do (\DRAWLOGOWINDOWIMAGE (IPLUS LOGOXCENTER
(FTIMES
CIRCLESIZE
(COS ANGLE)))
(IPLUS LOGOYCENTER
(FTIMES
CIRCLESIZE
(SIN ANGLE)))
WIMAGEWIDTH WIMAGEHEIGHT 2
W))
(MOVETO (IPLUS LOGOXCENTER 10 WIMAGEWIDTH)
(IPLUS 2 (IDIFFERENCE LOGOYCENTER CIRCLESIZE))
W)
(DSPFONT (QUOTE (TIMESROMAND 36))
W)
(PRIN3 STRING W)
(RETURN W])
(\DRAWLOGOWINDOWIMAGE
[LAMBDA (XPOS YPOS WIDTH HEIGHT BORDER W) (* rrb "22-FEB-82 18:04")
(* makes a window image. This is part of the logo
drawing.)
(BITBLT NIL NIL NIL W XPOS YPOS WIDTH HEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)
(BITBLT NIL NIL NIL W (IPLUS BORDER XPOS)
(IPLUS BORDER YPOS)
(IDIFFERENCE WIDTH (ITIMES BORDER 2))
(IDIFFERENCE HEIGHT (ITIMES BORDER 3))
(QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE])
(\TTY.CREATING.DISPLAYSTREAM
[LAMBDA NIL (* rrb " 8-AUG-83 18:31")
(* creates a displaystream that points to a stream that has a OUTCHARFN that creates a new displaystream.
It is used as the default TtyDisplayStream in a process.)
(PROG ((DS (DSPCREATE (BITMAPCREATE 1 1)))
DSSTREAM)
(replace OUTCHARFN of (SETQ DSSTREAM (\DisplayOpenFile DS (QUOTE OUTPUT)))
with (FUNCTION \CREATE.TTY.OUTCHARFN))
(replace FULLFILENAME of DSSTREAM with T)
(RETURN DS])
(\CREATE.TTY.OUTCHARFN
[LAMBDA (STREAM CHAR) (* rrb "12-AUG-83 11:26")
(* outcharfn for \DEFAULTTTYDISPLAYSTREAM which creates
a new window and then bouts to it.)
(* make the new window the ttydisplaystream)
(COND
((HASTTYWINDOWP NIL)
(* the only case where the ttydisplaystream isn't the default is when the users has called
(PRINT foo (TTYDISPLAYSTREAM)) and this is other than the first character of foo.)
(\CREATE.TTYDISPLAYSTREAM)))
(\OUTCHAR (fetch (DISPLAYSTREAM \SFOFD) of (TTYDISPLAYSTREAM))
CHAR])
(\CREATE.TTYDISPLAYSTREAM
[LAMBDA NIL (* rrb "16-AUG-83 12:20")
(* makes a new window and makes it the ttydisplaystream)
(COND
((WINDOWWORLDP)
(* \TTYWINDOW saves the window so it wouldn't get collected. This allows WFROMDS to find it even if it is closed.
In future, windows will be streams and this can go away.)
(COND
((NULL (SETQ \TTYREGIONOFFSETSPTR (CDR \TTYREGIONOFFSETSPTR)))
(* the offsets distribute the break windows a little so
many can be seen.)
(SETQ \TTYREGIONOFFSETSPTR TTYREGIONOFFSETS)))
(TTYDISPLAYSTREAM (SETQ \TTYWINDOW (CREATEW (CREATEREGION (IPLUS (fetch (REGION LEFT)
of DEFAULTTTYREGION)
(CAR (CAR
\TTYREGIONOFFSETSPTR)))
(IPLUS (fetch (REGION BOTTOM)
of DEFAULTTTYREGION)
(CDR (CAR
\TTYREGIONOFFSETSPTR)))
(fetch (REGION WIDTH) of
DEFAULTTTYREGION)
(fetch (REGION HEIGHT)
of DEFAULTTTYREGION))
(CONCAT "TTY window for " (PROCESSPROP
(THIS.PROCESS)
(QUOTE NAME)))
NIL T])
(HASTTYWINDOWP
[LAMBDA (PROCESS) (* bvm: "17-AUG-83 13:21")
(* determines if PROCESS has a tty window yet.)
(DECLARE (GLOBALVARS \DEFAULTTTYDISPLAYSTREAM))
(PROG NIL
(RETURN (NEQ (COND
((NULL PROCESS)
TtyDisplayStream)
((PROCESS.TTY PROCESS))
(T (RETURN)))
\DEFAULTTTYDISPLAYSTREAM])
)
(RPAQQ \TTYREGIONOFFSETSPTR NIL)
(RPAQ? TTYREGIONOFFSETS (QUOTE ((0 . 0)
(24Q . -24Q)
(50Q . 0)
(24Q . 24Q))))
(RPAQ? DEFAULTTTYREGION (QUOTE (231Q 144Q 600Q 320Q)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \TTYREGIONOFFSETSPTR TTYREGIONOFFSETS)
)
(* Window menu operations)
(DEFINEQ
(WINDOW.MOUSE.HANDLER
[LAMBDA NIL (* rrb "21-JUL-83 12:22")
(* * Does user window operations if state of buttons has changed or mouse has changed windows)
(COND
(\INTERRUPTABLE (* don't do anything if uninterruptable)
(PROG [\MHWINDOW \MHCOM \MHPROCESS (NBREAKS (COND
((IGREATERP 0 NBREAKS)
(* bind NBREAKS to a positive values so that breaks will
occur in background functions.)
(IMINUS NBREAKS))
(T NBREAKS]
(GETMOUSESTATE)
(COND
((OR (NEQ LASTMOUSEX (fetch XCOORD of \LastCursorPosition))
(NEQ LASTMOUSEY (fetch YCOORD of \LastCursorPosition))
(NEQ LASTMOUSEBUTTONS \LastWindowButtons))
(* Cursor has changed position or a button is down, see
if it is in a window or scroll area.)
(replace XCOORD of \LastCursorPosition with LASTMOUSEX)
(replace YCOORD of \LastCursorPosition with LASTMOUSEY)
(SETQ \MHWINDOW (WHICHW LASTMOUSEX LASTMOUSEY))
(COND
[(NEQ \MHWINDOW \LastInWindow)
(* Cursor has moved outside the current window, check to see if it moved into the scroll area and that the scroll
handler wants it.)
(COND
((AND \LastInWindow (IN/SCROLL/BAR? \LastInWindow LASTMOUSEX
LASTMOUSEY)
(PROGN (\CHECKCARET (PROCESS.TTY (TTY.PROCESS)))
(* SCROLL.HANDLER returns NIL if this window doesn't
want to scroll.)
(SCROLL.HANDLER \LastInWindow)))
(replace XCOORD of \LastCursorPosition with -1)
(GETMOUSESTATE)
(SETQ \LastWindowButtons LASTMOUSEBUTTONS)
(RETURN))
((OR (ZEROP LASTMOUSEBUTTONS)
(NEQ LASTMOUSEBUTTONS \LastWindowButtons))
(* Cursor has changed windows, so call CURSOROUTFN of old window, CURSORINFN of new. The user enters another
window by moving the cursor into it with no buttons pressed or by pressing a button in the window.
This allows the user to go into a window with a button down, release it and still be "in" the window he came
from.)
[COND
((AND \LastInWindow (SETQ \MHCOM (fetch CURSOROUTFN
of \LastInWindow)))
(\CHECKCARET (PROCESS.TTY (TTY.PROCESS)))
(ERSETQ (APPLY* \MHCOM \LastInWindow]
[COND
((AND \MHWINDOW (SETQ \MHCOM (fetch CURSORINFN
of \MHWINDOW)))
(\CHECKCARET (PROCESS.TTY (TTY.PROCESS)))
(ERSETQ (APPLY* \MHCOM \MHWINDOW]
(SETQ \LastInWindow \MHWINDOW)
(SETQ \LastWindowButtons LASTMOUSEBUTTONS]
([AND (LASTMOUSESTATE (ONLY RIGHT))
(NOT (AND \MHWINDOW (fetch RIGHTBUTTONFN of \MHWINDOW]
(* right button when down, normally this is window
system commands but can be overridden.)
(* this is separated out so that window commands don't
grab the tty.)
(\CHECKCARET (PROCESS.TTY (TTY.PROCESS)))
(DOWINDOWCOM \MHWINDOW))
(\MHWINDOW (* look for button change or cursor moving fn.)
(COND
([SETQ \MHCOM (COND
[(NEQ LASTMOUSEBUTTONS \LastWindowButtons)
(* Button change within same window)
(COND
((AND (LASTMOUSESTATE (NOT UP))
(SETQ \MHPROCESS (WINDOWPROP
\MHWINDOW
(QUOTE PROCESS)))
(NOT (TTY.PROCESSP \MHPROCESS)))
(* make sure that if this window has a process that that
process has the tty.)
(fetch WINDOWENTRYFN of \MHWINDOW))
((LASTMOUSESTATE (ONLY RIGHT))
(fetch RIGHTBUTTONFN of \MHWINDOW))
(T (fetch BUTTONEVENTFN of \MHWINDOW]
(T (* cursor must have moved.)
(fetch (WINDOW CURSORMOVEDFN) of \MHWINDOW]
(\CHECKCARET (PROCESS.TTY (TTY.PROCESS)))
(ERSETQ (APPLY* \MHCOM \MHWINDOW))
(* Look at mouse again, since user fn may have waited
for mouse to come up)
(GETMOUSESTATE)
(SETQ \LastWindowButtons LASTMOUSEBUTTONS)
T])
(DOWINDOWCOM
[LAMBDA (WINDOW) (* rrb " 7-AUG-83 18:50")
(* the button handler for the window system.)
(COND
[(type? WINDOW WINDOW)
(PROG (COM)
(TOTOPW WINDOW)
(RETURN (COND
([SETQ COM
(MENU (COND
((type? MENU WindowMenu)
WindowMenu)
(T (SETQ WindowMenu
(create MENU
ITEMS ← WindowMenuCommands
CHANGEOFFSETFLG ←(QUOTE Y)
MENUOFFSET ←(create POSITION
XCOORD ← -1
YCOORD ← 0)
WHENHELDFN ←(FUNCTION PPROMPT3)
WHENUNHELDFN ←(FUNCTION CLRPROMPT)
CENTERFLG ← T]
(APPLY* COM WINDOW)
T]
((NULL WINDOW)
(DOBACKGROUNDCOM])
(DOBACKGROUNDCOM
[LAMBDA NIL (* rrb " 7-AUG-83 18:50")
(* something has happened and the cursor is not in a
window. Default is bring up background menu if button is
down.)
(COND
((MOUSESTATE RIGHT)
(PROG (FORM)
(AND [SETQ FORM (MENU (COND
((type? MENU BackgroundMenu)
BackgroundMenu)
(T (SETQ BackgroundMenu
(create MENU
ITEMS ← BackgroundMenuCommands
CHANGEOFFSETFLG ←(QUOTE Y)
MENUOFFSET ←(create POSITION
XCOORD ← -1
YCOORD ← 0)
WHENHELDFN ←(FUNCTION PPROMPT3)
WHENUNHELDFN ←(FUNCTION CLRPROMPT)
CENTERFLG ← T]
(ERSETQ (EVAL FORM])
)
(DEFINEQ
(BURYW
[LAMBDA (WINDOW) (* rrb " 5-NOV-82 10:09")
(* HACK: Puts WINDOW at the bottom by putting everything
that touches it to the top!)
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(for TOUCHEDW in (ORDERFROMBOTTOMTOTOP (DREMOVE WINDOW (OVERLAPPINGWINDOWS WINDOW)))
first (TOTOPW WINDOW T) do (TOTOPW TOUCHEDW T])
(CLEARW
[LAMBDA (WINDOW) (* rrb "27-AUG-82 11:28")
(* clears a window to its background shade, resets its offsets to 0,0 in the lower left corner and resets the
position to the upper left {first line of text}.)
(WXOFFSET (WXOFFSET NIL (SETQ WINDOW (\INSUREWINDOW WINDOW)))
WINDOW)
(WYOFFSET (WYOFFSET NIL WINDOW)
WINDOW)
(DSPRESET (fetch DSP of WINDOW])
(CLOSEW
[LAMBDA (WINDOW) (* rrb "28-JUN-83 11:52")
(* closes a window. saves the current state in the
WINDOW and allow it to be reOPENWed.)
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(COND
((OPENWP WINDOW)
(COND
((\OKTOCLOSEW WINDOW)
(\CLOSEW1 WINDOW])
(\CLOSEW1
[LAMBDA (WINDOW WILLREOPENFLG) (* rrb "13-APR-83 12:26")
(* actually does the closing operation.
Is used by SHRINKW to avoid the CLOSEFN mechanism.)
(.WHILE.ON.TOP. WINDOW (\SW2BM (SCREENBITMAP)
(fetch (WINDOW REG) of WINDOW)
(fetch (WINDOW SAVE) of WINDOW)
NIL)
(COND
((SETQ TOPW (fetch NEXTW of WINDOW))
(SETQ \TOPWDS (fetch (WINDOW DSP) of TOPW)))
(T (* users is closing the last window.
make sure \TOPWDS is NIL also.)
(SETQ \TOPWDS))) (* smash the window's link to other's in the chain.)
(replace (WINDOW NEXTW) of WINDOW with NIL)
(COND
((NOT WILLREOPENFLG) (* clip the link between this window's display stream
and its STREAM.)
(replace (DISPLAYSTREAM \SFOFD) of (fetch (WINDOW DSP) of WINDOW)
with NIL])
(\OKTOCLOSEW
[LAMBDA (WINDOW) (* rrb "14-JUN-82 12:40")
(* calls the windows closefns.
Returns T if it is ok to close the window.)
(COND
((EQ (DOUSERFNS (fetch (WINDOW CLOSEFN) of WINDOW)
WINDOW T)
(QUOTE DON'T))
NIL)
(T WINDOW])
(OPENW
[LAMBDA (WINDOW) (* rrb "28-JUN-83 11:52")
(* opens a window by putting on the window stack and putting its bits on the screen. Returns the window if it was
actually opened.)
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(COND
((OPENWP WINDOW) (* used to bring the window to top but doesn't since
TOTOPW has been documented.)
NIL)
(T (PROG [(USEROPENFN (WINDOWPROP WINDOW (QUOTE OPENFN]
(COND
((\USERFNISDON'T USEROPENFN) (* one of the OPENFNs is DON'T)
NIL)
(T (* open it by putting it on top and swapping its bits
in)
(\OPENW1 WINDOW) (* call the openfns after the window has been opened.)
(DOUSERFNS USEROPENFN WINDOW)
(RETURN WINDOW])
(DOUSERFNS
[LAMBDA (FNLST WINDOW CHECKFORDON'TFLG) (* rrb " 5-NOV-82 09:49")
(* applys a list of user functins and If CHECKFORDON'TFLG is non-NIL, it stops if don't is returned as one of
thevalues and returns DON'T)
(DECLARE (GLOBALVARS LAMBDASPLST))
(COND
[(OR (NLISTP FNLST)
(FMEMB (CAR FNLST)
LAMBDASPLST))
(COND
((AND CHECKFORDON'TFLG (EQ FNLST (QUOTE DON'T)))
(QUOTE DON'T))
(FNLST (AND (EQ (APPLY* FNLST WINDOW)
(QUOTE DON'T))
(QUOTE DON'T]
((AND CHECKFORDON'TFLG (FMEMB (QUOTE DON'T)
FNLST))
(QUOTE DON'T))
((for USERFN in FNLST when (EQ (APPLY* USERFN WINDOW)
(QUOTE DON'T))
do (* return if any of the openfns says don't)
(AND CHECKFORDON'TFLG (RETURN (QUOTE DON'T])
(DOUSERFNS2
[LAMBDA (FNLST WINDOW ARG1 ARG2) (* rrb "11-FEB-83 19:13")
(* applys a list of user functions to two arguments.
This is used by SHAPEW.)
(DECLARE (GLOBALVARS LAMBDASPLST))
(COND
[(OR (NLISTP FNLST)
(FMEMB (CAR FNLST)
LAMBDASPLST))
(COND
(FNLST (APPLY* FNLST WINDOW ARG1 ARG2]
((for USERFN in FNLST do (APPLY* USERFN WINDOW ARG1 ARG2])
(\USERFNISDON'T
[LAMBDA (USERFN) (* rrb "18-JUN-82 12:16")
(* determines if one of the userfunction is DON'T)
(COND
((NLISTP USERFN)
(EQ USERFN (QUOTE DON'T)))
(T (FMEMB (QUOTE DON'T)
USERFN])
(\OPENW1
[LAMBDA (WINDOW) (* bas: "21-OCT-82 16:48")
(UNINTERRUPTABLY
(replace NEXTW of WINDOW with TOPW)
(SETQ TOPW WINDOW)
(SETQ \TOPWDS (fetch (WINDOW DSP) of TOPW)) (* changed from (SCREENBITMAP) to destination in
preparation for multiple screens.)
(\SW2BM (fetch (DISPLAYSTREAM \SFDestination) of \TOPWDS)
(fetch (WINDOW REG) of WINDOW)
(fetch (WINDOW SAVE) of WINDOW)
NIL))])
(CREATEW
[LAMBDA (DSP/REGION TITLE BORDERSIZE NOOPENFLG) (* rrb " 5-NOV-82 11:34")
(PROG (REG DSP (TITLEHEIGHT (COND
(TITLE (IMINUS (DSPLINEFEED NIL WindowTitleDisplayStream)))
(T 0)))
WINDOW
(WBORDER (OR (NUMBERP BORDERSIZE)
WBorder)))
[COND
[(AND (type? DISPLAYSTREAM DSP/REGION)
(EQ (SCREENBITMAP)
(DSPDESTINATION NIL DSP/REGION)))
(SETQ REG (DSPCLIPPINGREGION NIL (SETQ DSP DSP/REGION)))
(* adjust region by offsets and reduce to size screen.
(destination bitmap.))
(SETQ REG (create REGION
LEFT ←(IDIFFERENCE (IMAX (IPLUS (DSPXOFFSET NIL DSP)
(fetch (REGION LEFT) of REG))
0)
WBORDER)
BOTTOM ←(IDIFFERENCE (IMAX (IPLUS (DSPYOFFSET NIL DSP)
(fetch (REGION BOTTOM)
of REG))
0)
WBORDER)
WIDTH ←(IPLUS (IMIN SCREENWIDTH (fetch (REGION WIDTH) of REG))
(UNFOLD WBORDER 2))
HEIGHT ←(IPLUS (IMIN (IDIFFERENCE SCREENHEIGHT TITLEHEIGHT)
(fetch (REGION HEIGHT) of REG))
(UNFOLD WBORDER 2)
TITLEHEIGHT]
(T [SETQ REG (COND
((type? REGION DSP/REGION) (* Copy so that smash-happy user won't clobber the
window system smashing the region he gives us.)
(create REGION using DSP/REGION))
(T (AND TITLE (printout PROMPTWINDOW T "Specify region for window %"" TITLE "%""))
(PROG1 (GETREGION MinWindowWidth MinWindowHeight)
(AND TITLE (CLRPROMPT]
(SETQ DSP (DSPCREATE]
(OR (type? REGION REG)
(HELP "Not a region" REG))
(OR (IGREATERP (IMIN (fetch (REGION WIDTH) of REG)
(fetch (REGION HEIGHT) of REG))
(UNFOLD WBORDER 2))
(ERROR "Region too small to use as a window" REG))
(DSPDESTINATION (SCREENBITMAP)
DSP)
(SETQ WINDOW (create WINDOW
DSP ← DSP
REG ← REG
SAVE ←(BITMAPCREATE (fetch (REGION WIDTH) of REG)
(fetch (REGION HEIGHT) of REG))
WTITLE ← TITLE
WBORDER ← WBORDER))
(replace (DISPLAYSTREAM XWINDOWHINT) of DSP with WINDOW)
(ADVISEWDS WINDOW)
(MOVETO (DSPLEFTMARGIN NIL DSP)
(IPLUS (fetch (REGION HEIGHT) of (DSPCLIPPINGREGION NIL DSP))
(DSPLINEFEED NIL DSP))
DSP)
(SHOWWFRAME WINDOW)
(COND
((NOT NOOPENFLG)
(OPENW WINDOW)))
(RETURN WINDOW])
(MOVEW
[LAMBDA (WINDOW POSorX Y) (* rrb "28-JUN-83 11:53")
(* moves a window. If window is closed and position is
given, it won't open the window.
It also calls the window's MOVEFN property.)
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(PROG ((OLDREGION (fetch REG of WINDOW))
(USERMOVEFN (fetch (WINDOW MOVEFN) of WINDOW))
(OPEN? (OPENWP WINDOW))
POS NEWREGION)
(COND
([COND
((LISTP USERMOVEFN)
(FMEMB (QUOTE DON'T)
USERMOVEFN))
(T (EQ USERMOVEFN (QUOTE DON'T]
(PROMPTPRINT "Can't move this window.")
(RETURN)))
(COND
([AND POSorX (SETQ POS (COND
((POSITIONP POSorX)
POSorX)
[(NUMBERP POSorX)
(COND
((NUMBERP Y)
(create POSITION
XCOORD ← POSorX
YCOORD ← Y))
(T (\ILLEGAL.ARG Y]
((REGIONP POSorX)
(create POSITION
XCOORD ←(fetch (REGION LEFT) of POSorX)
YCOORD ←(fetch (REGION BOTTOM) of POSorX)))
(T (\ILLEGAL.ARG POSorX] (* if not aready open, don't)
(AND OPEN? (TOTOPW WINDOW)))
(T (* no position to move to has been given, ask user for
one.)
(TOTOPW WINDOW) (* TOTOPW opens the window if it is not already.)
(SETQ POS (GETBOXPOSITION (fetch (REGION WIDTH) of OLDREGION)
(fetch (REGION HEIGHT) of OLDREGION)
(fetch (REGION LEFT) of OLDREGION)
(fetch (REGION BOTTOM) of OLDREGION)))
(SETQ OPEN? T)))
[COND
((AND (LISTP USERMOVEFN)
(NOT (FMEMB (CAR USERMOVEFN)
LAMBDASPLST)))
(AND (EQ [for MFN in USERMOVEFN
do (SETQ NEWREGION (APPLY* MFN WINDOW POS))
(COND
((EQ NEWREGION (QUOTE DON'T))
(RETURN (QUOTE DON'T)))
((POSITIONP NEWREGION)
(SETQ POS NEWREGION]
(QUOTE DON'T))
(RETURN)))
(USERMOVEFN (SETQ NEWREGION (APPLY* USERMOVEFN WINDOW POS))
(COND
((EQ NEWREGION (QUOTE DON'T))
(RETURN))
((POSITIONP NEWREGION)
(SETQ POS NEWREGION]
(COND
((OR (NEQ (fetch XCOORD of POS)
(fetch (REGION LEFT) of OLDREGION))
(NEQ (fetch YCOORD of POS)
(fetch (REGION BOTTOM) of OLDREGION)))
(SETQ NEWREGION (create REGION
LEFT ←(fetch (POSITION XCOORD) of POS)
BOTTOM ←(fetch (POSITION YCOORD) of POS)
WIDTH ←(fetch (REGION WIDTH) of OLDREGION)
HEIGHT ←(fetch (REGION HEIGHT) of OLDREGION)))
(UNINTERRUPTABLY
[COND
(OPEN? (* if window is open, move it to top as its MOVEFN may
have changed things and swap its bits to its new
location)
(.WHILE.ON.TOP. WINDOW (\SW2BM (SCREENBITMAP)
OLDREGION
(fetch SAVE of WINDOW)
NIL)
(\SW2BM (fetch SAVE of WINDOW)
NIL
(SCREENBITMAP)
NEWREGION]
(replace REG of WINDOW with NEWREGION)
(ADVISEWDS WINDOW OLDREGION T))
(DOUSERFNS (WINDOWPROP WINDOW (QUOTE AFTERMOVEFN))
WINDOW)))
(RETURN POS])
(RELMOVEW
[LAMBDA (WINDOW POS) (* rrb "13-JUN-82 15:54")
(* Move WINDOW by relative DX DY)
(PROG [(WINREG (WINDOWPROP WINDOW (QUOTE REGION]
(MOVEW WINDOW (create POSITION
XCOORD ←(IPLUS (fetch LEFT of WINREG)
(fetch (POSITION XCOORD) of POS))
YCOORD ←(IPLUS (fetch BOTTOM of WINREG)
(fetch (POSITION YCOORD) of POS])
(HARDCOPYW
[LAMBDA (WINDOW/BITMAP/REGION FILE HOST SCALEFACTOR ROTATION)
(* edited: " 1-AUG-83 22:52")
(* makes a hard copy of a window)
(* WINDOW/BITMAP/REGION can be a WINDOW, a REGION, a
BITMAP, or NIL = select region)
(* If FILE supplied, output goes there.
If HOST supplied, IT is printed.
If neither FILE nor HOST supplied, default is to print)
(PROG ((BITMAP (SCREENBITMAP))
REGION)
[SETQ REGION
(COND
((WINDOWP WINDOW/BITMAP/REGION)
(COND
((OPENWP WINDOW/BITMAP/REGION)
(TOTOPW WINDOW/BITMAP/REGION)
(WINDOWPROP WINDOW/BITMAP/REGION (QUOTE REGION)))
(T (SETQ BITMAP (WINDOWPROP WINDOW/BITMAP/REGION (QUOTE IMAGECOVERED)))
NIL)))
((BITMAPP WINDOW/BITMAP/REGION)
(SETQ BITMAP WINDOW/BITMAP/REGION)
NIL)
((type? REGION WINDOW/BITMAP/REGION)
WINDOW/BITMAP/REGION)
(T (PROGN (\SETCURSORPOSITION 0 SCREENHEIGHT)
(GETREGION NIL NIL
(create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← SCREENWIDTH
HEIGHT ← SCREENHEIGHT]
[COND
((NOT SCALEFACTOR)
[SETQ SCALEFACTOR (COND
(REGION (APPLY* PRINTER.BITMAPSCALE (fetch WIDTH of REGION)
(fetch HEIGHT of REGION)
(OR HOST FILE)))
(T (APPLY* PRINTER.BITMAPSCALE (fetch BITMAPWIDTH of BITMAP)
(fetch BITMAPHEIGHT of BITMAP)
(OR HOST FILE]
(COND
((LISTP SCALEFACTOR)
(SETQ ROTATION (CDR SCALEFACTOR))
(SETQ SCALEFACTOR (CAR SCALEFACTOR]
(SETQ FULLFILE (APPLY* PRINTER.BITMAPFILE (OR FILE (QUOTE {CORE}SCREEN.PRESS))
BITMAP SCALEFACTOR REGION NIL "Window Image"))
[COND
((OR HOST (NULL FILE))
(ADD.PROCESS [LIST (QUOTE PROGN)
(LIST PRINTER.SENDTOPRINTER
[KWOTE (OR HOST (PRINTINGHOST (AND SCALEFACTOR
(NOT (EQUAL SCALEFACTOR 1]
(KWOTE FULLFILE)
1 NIL "Window Image")
(AND (NULL FILE)
(LIST (QUOTE DELFILE)
(KWOTE FULLFILE]
(QUOTE NAME)
(QUOTE HARDCOPYW]
(RETURN (COND
((NULL FILE)
NIL)
(T FULLFILE])
(PAINTW
[LAMBDA (WINDOW) (* rrb "17-JUN-83 11:19")
(* allows the user to paint with the cursor)
(* should make sure cursor has moved or a button has
change before proceeding with the inner loop.)
(* has some of the stuff to allow the brush to be an
arbitrary bitmap but not all.)
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(printout PROMPTWINDOW
"Left button paints; Middle button erases.
Right button pops up a command menu.
To stop, select the QUIT command.")
(RESETLST (RESETSAVE NIL (LIST (QUOTE CURSOR)
(CURSOR)))
(PROG (BRUSH DS HOTX HOTY)
(TOTOPW WINDOW)
(SETQ DS (fetch DSP of WINDOW))
BRUSHLP
[SETQ BRUSH (COND
((BITMAPP PAINTCOMMANDBRUSH))
(T (\GETBRUSH PAINTCOMMANDBRUSH] (* clear cursor)
(BITBLT NIL NIL NIL (CURSORBITMAP)
0 0 CURSORWIDTH CURSORHEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE) (* put lower left part of brush shape in cursor)
(BITBLT BRUSH 0 0 (CURSORBITMAP)
0 0 CURSORWIDTH CURSORHEIGHT (QUOTE INPUT)
(QUOTE REPLACE)) (* set the hot spot to the middle of the brush.)
[CURSORHOTSPOT (create POSITION
XCOORD ←(SETQ HOTX (HALF (IMIN (fetch BITMAPWIDTH
of BRUSH)
CURSORWIDTH)))
YCOORD ←(SETQ HOTY (HALF (IMIN (fetch BITMAPHEIGHT
of BRUSH)
CURSORHEIGHT]
PAINTLP
(GETMOUSESTATE)
[COND
[(LASTMOUSESTATE RIGHT)
(COND
((INSIDE? (DSPCLIPPINGREGION NIL DS)
(LASTMOUSEX DS)
(LASTMOUSEY DS)) (* inside the interior, give command menu)
(SELECTQ [MENU (COND
((type? MENU PAINTCOMMANDMENU)
PAINTCOMMANDMENU)
(T (SETQ PAINTCOMMANDMENU
(create MENU
ITEMS ←(QUOTE ((HardCopy (QUOTE HARDCOPY)
"Makes a press file of the window and prints it")
(SetMode (QUOTE MODE)
"Allows specification of how new bits are merged")
(SetShade (QUOTE SHADE)
"Allows specification of new shade.")
(SetShape (QUOTE SHAPE)
"Allows specification of brush shape")
(SetSize (QUOTE SIZE)
"Allows specification of the brush size")
(QUIT (QUOTE QUIT)
"Exits painting mode"]
(SHADE (SETQ PAINTCOMMANDSHADE (OR (PAINTW.READBRUSHSHADE)
PAINTCOMMANDSHADE))
(GO BRUSHLP))
(MODE (SETQ PAINTCOMMANDMODE (OR (PAINTW.READMODE)
PAINTCOMMANDMODE))
(GO BRUSHLP))
(SHAPE (RPLACA PAINTCOMMANDBRUSH (OR (PAINTW.READBRUSHSHAPE)
(CAR PAINTCOMMANDBRUSH)))
(GO BRUSHLP))
(SIZE (RPLACA (CDR PAINTCOMMANDBRUSH)
(OR (PAINTW.READBRUSHSIZE)
(CADR PAINTCOMMANDBRUSH)))
(GO BRUSHLP))
(QUIT (RETURN))
(HARDCOPY (RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW)
(HARDCOPYW WINDOW)))
NIL))
(T (* do the window menu)
(DOWINDOWCOM (WHICHW LASTMOUSEX LASTMOUSEY]
[(AND (LASTMOUSESTATE LEFT)
(OR (EQ PAINTCOMMANDMODE (QUOTE REPLACE))
(NEQ PAINTCOMMANDSHADE BLACKSHADE)))
(* painting in grey is slightly harder.)
(COND
((EQ PAINTCOMMANDMODE (QUOTE REPLACE))
(* erase what is there now)
(BITBLT BRUSH 0 0 DS (IDIFFERENCE (LASTMOUSEX DS)
HOTX)
(IDIFFERENCE (LASTMOUSEY DS)
HOTY)
NIL NIL (QUOTE INPUT)
(QUOTE ERASE)) (* put in grey)
(BITBLT BRUSH 0 0 DS (IDIFFERENCE (LASTMOUSEX DS)
HOTX)
(IDIFFERENCE (LASTMOUSEY DS)
HOTY)
NIL NIL (QUOTE MERGE)
(QUOTE PAINT)
PAINTCOMMANDSHADE))
(T (BITBLT BRUSH 0 0 DS (IDIFFERENCE (LASTMOUSEX DS)
HOTX)
(IDIFFERENCE (LASTMOUSEY DS)
HOTY)
NIL NIL (QUOTE MERGE)
PAINTCOMMANDMODE PAINTCOMMANDSHADE]
((LASTMOUSESTATE (OR MIDDLE LEFT))
(BITBLT BRUSH 0 0 DS (IDIFFERENCE (LASTMOUSEX DS)
HOTX)
(IDIFFERENCE (LASTMOUSEY DS)
HOTY)
NIL NIL (QUOTE INPUT)
(COND
((LASTMOUSESTATE MIDDLE)
(QUOTE ERASE))
(T PAINTCOMMANDMODE]
(GO PAINTLP])
(PAINTW.READBRUSHSHADE
[LAMBDA NIL (* rrb " 1-DEC-82 17:28")
(SELECTQ [MENU (COND
((type? MENU PAINTSHADEMENU)
PAINTSHADEMENU)
(T (SETQ PAINTSHADEMENU (create MENU
ITEMS ←(QUOTE ((NewShade (QUOTE NEW)
"Allows creation of a new brush shade")
(HiLite (QUOTE HILITE)
"a shade for high lighting text")
GRAY BLACK]
(NEW (EDITSHADE))
(BLACK BLACKSHADE)
(GRAY GRAYSHADE)
(HILITE HIGHLIGHTSHADE)
NIL])
(PAINTW.READMODE
[LAMBDA NIL (* rrb " 1-DEC-82 17:29")
(MENU (COND
((type? MENU PAINTMODEMENU)
PAINTMODEMENU)
(T (SETQ PAINTMODEMENU (create MENU
ITEMS ←(QUOTE ((REPLACE (QUOTE REPLACE)
"the screen bits are replaced by the brush bits")
(INVERT (QUOTE INVERT)
"the screen bits inverted whereever brush bits are")
(ADD (QUOTE PAINT)
"the brush bits are added to the bits on the screen"])
(PAINTW.READBRUSHSHAPE
[LAMBDA NIL (* rrb " 1-DEC-82 17:29")
(MENU (COND
((type? MENU PAINTSHAPEMENU)
PAINTSHAPEMENU)
(T (SETQ PAINTSHAPEMENU (create MENU
ITEMS ←(QUOTE (DIAGONAL VERTICAL HORIZONTAL SQUARE ROUND])
(PAINTW.READBRUSHSIZE
[LAMBDA NIL (* rrb " 1-DEC-82 17:30")
(MENU (COND
((type? MENU PAINTSIZEMENU)
PAINTSIZEMENU)
(T (SETQ PAINTSIZEMENU (create MENU
ITEMS ←(QUOTE (16 8 4 2 1])
(SHAPEW
[LAMBDA (WINDOW NEWREGION) (* rrb "28-JUN-83 11:55")
(DECLARE (LOCALVARS . T))
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(PROG ((OLDREGION (fetch REG of WINDOW))
(OLDCLIPREG (DSPCLIPPINGREGION NIL (fetch (WINDOW DSP) of WINDOW)))
(WBORDER (fetch WBORDER of WINDOW))
(USERSHAPEFN (fetch (WINDOW RESHAPEFN) of WINDOW))
NUSAV NOWOPEN?)
(COND
((\USERFNISDON'T USERSHAPEFN) (* don't allow the window to be reshaped.)
(PROMPTPRINT "This window cannot be reshaped.")
(RETURN)))
(OR NEWREGION (SETQ NEWREGION (GETREGION MinWindowWidth MinWindowHeight OLDREGION
(fetch NEWREGIONFN of WINDOW)
WINDOW)))
(SETQ NUSAV (BITMAPCREATE (fetch (REGION WIDTH) of NEWREGION)
(fetch (REGION HEIGHT) of NEWREGION)))
(UNINTERRUPTABLY
(COND
((OPENWP WINDOW) (* notice whether window is open or not to call OPENFNs
only if not now open.)
(SETQ NOWOPEN? T)
(\CLOSEW1 WINDOW T))) (* Save window image)
(replace REG of WINDOW with NEWREGION)
[replace SAVE of WINDOW with (PROG1 NUSAV (SETQ NUSAV (fetch SAVE of WINDOW]
(ADVISEWDS WINDOW OLDREGION)
(SHOWWFRAME WINDOW)
(COND
(NOWOPEN? (\OPENW1 WINDOW))
(T (OPENW WINDOW))))
(DOUSERFNS2 (OR USERSHAPEFN (FUNCTION RESHAPEBYREPAINTFN))
WINDOW NUSAV (create REGION
LEFT ← WBORDER
BOTTOM ← WBORDER
WIDTH ←(fetch (REGION WIDTH) of OLDCLIPREG)
HEIGHT ←(fetch (REGION HEIGHT) of OLDCLIPREG])
(RESHOWBORDER
[LAMBDA (BORDER WINDOW) (* rrb "15-JUN-83 14:46")
(* updates a windows display with a new border)
(* if the border is the same, don't change anything.)
(OR (EQ BORDER (fetch (WINDOW WBORDER) of WINDOW))
(\RESHOWBORDER1 BORDER (fetch (WINDOW WBORDER) of WINDOW)
WINDOW])
(\RESHOWBORDER1
[LAMBDA (NEWBORDER OLDBORDER WINDOW) (* rrb "15-JUN-83 16:02")
(* redisplays the border of a window. Is called by RESHOWBORDER and RESHOWTITLE. It doesn't check for equality
between the new and old borders because it is also used when a title is added or deleted. NIL)
(PROG ((REGION (fetch REG of WINDOW))
(OLDSAVE (fetch SAVE of WINDOW))
NUSAV DELTA NUWIDTH NUHEIGHT)
(SETQ DELTA (IDIFFERENCE NEWBORDER OLDBORDER))
[SETQ NUSAV (BITMAPCREATE (SETQ NUWIDTH (IPLUS (fetch (REGION WIDTH) of REGION)
(ITIMES DELTA 2)))
(SETQ NUHEIGHT (IDIFFERENCE
(IPLUS (fetch (REGION HEIGHT)
of (DSPCLIPPINGREGION NIL (FETCH (WINDOW DSP)
OF WINDOW)))
(ITIMES NEWBORDER 2))
(COND
((fetch (WINDOW WTITLE) of WINDOW)
(DSPLINEFEED NIL WindowTitleDisplayStream))
(T 0]
(.WHILE.ON.TOP. WINDOW (* Save window image)
(\SW2BM (SCREENBITMAP)
REGION
(fetch SAVE of WINDOW)
NIL) (* put new save image into window)
(replace SAVE of WINDOW with NUSAV)
(replace (WINDOW WBORDER) of WINDOW with NEWBORDER)
(* create a region that coresponds to the old region
with the new border.)
(replace (WINDOW REG) of WINDOW with (create REGION
LEFT ←(IDIFFERENCE
(fetch (REGION LEFT)
of REGION)
DELTA)
BOTTOM ←(IDIFFERENCE
(fetch (REGION BOTTOM)
of REGION)
DELTA)
WIDTH ← NUWIDTH
HEIGHT ← NUHEIGHT))
(* draw border in the new image.)
(SHOWWFRAME WINDOW) (* copy the visible part from the old image into the new
one.)
(BITBLT OLDSAVE OLDBORDER OLDBORDER NUSAV NEWBORDER NEWBORDER
(IDIFFERENCE (fetch BITMAPWIDTH of OLDSAVE)
(ITIMES 2 OLDBORDER))
(fetch (REGION HEIGHT) of (DSPCLIPPINGREGION NIL
(fetch (WINDOW DSP)
of WINDOW)))
(QUOTE INPUT)
(QUOTE REPLACE)) (* put the new image up on the screen.)
(\SW2BM (SCREENBITMAP)
(fetch REG of WINDOW)
(fetch SAVE of WINDOW)
NIL])
(TRACKW
[LAMBDA (WINDOW) (* rrb " 9-MAR-82 14:28")
(* causes a window to follow the cursor.
found to be not useful but very pretty for small
windows.)
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(RESETFORM (CURSOR CROSSHAIRS)
(TOTOPW WINDOW)
(until (MOUSESTATE (NOT UP)))
(CURSOR LOCKEDSPOT)
(bind (DX ←(IDIFFERENCE (fetch (REGION LEFT) of (fetch (WINDOW REG) of WINDOW))
LASTMOUSEX))
(DY ←(IDIFFERENCE (fetch (REGION BOTTOM) of (fetch (WINDOW REG) of WINDOW))
LASTMOUSEY))
until (MOUSESTATE UP) do (MOVEW WINDOW (create POSITION
XCOORD ←(IPLUS LASTMOUSEX DX)
YCOORD ←(IPLUS LASTMOUSEY DY])
(SNAPW
[LAMBDA NIL (* rrb "30-JUN-82 16:00")
(* makes a new window which is a copy of the bits
underneath the REGION read from the user.)
(PROG ((REG (GETREGION 30 20))
(DSP (DSPCREATE))
NEWWINDOW)
(OR (type? REGION REG)
(HELP "Not a region" REG))
(SETQ NEWWINDOW (create WINDOW
DSP ← DSP
NEXTW ← TOPW
REG ←(GROW/REGION REG WBorder)
SAVE ←(BITMAPCREATE (fetch (REGION WIDTH) of REG)
(fetch (REGION HEIGHT) of REG))
WBORDER ← WBorder))
(replace (DISPLAYSTREAM XWINDOWHINT) of DSP with NEWWINDOW)
(ADVISEWDS NEWWINDOW)
(UNINTERRUPTABLY
(SETQ TOPW NEWWINDOW)
(SETQ \TOPWDS (fetch (WINDOW DSP) of TOPW)))
(FRAME/EXISTING/BITS TOPW REG)
(MOVEW TOPW])
(FRAME/EXISTING/BITS
[LAMBDA (WIN REG) (* rrb " 9-MAR-82 14:34")
(PROG (LEFT BOTTOM W H)
(SETQ LEFT (fetch (REGION LEFT) of REG))
(SETQ BOTTOM (fetch (REGION BOTTOM) of REG))
(SETQ W (fetch (REGION WIDTH) of REG))
(SETQ H (fetch (REGION HEIGHT) of REG)) (* save the screen bits in SAVE.)
(BITBLT (SCREENBITMAP)
LEFT BOTTOM (fetch SAVE of WIN)
0 0 W H (QUOTE INPUT)
(QUOTE REPLACE)) (* create desired top image by creating boarder on
screen then blting from SAVE.)
(BITBLT NIL NIL NIL (SCREENBITMAP)
LEFT BOTTOM W H (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)
[PROG ((BLACKPARTSIZE (FOLDHI (fetch WBORDER of WIN)
2)))
(BITBLT NIL NIL NIL (SCREENBITMAP)
(IPLUS LEFT BLACKPARTSIZE)
(IPLUS BOTTOM BLACKPARTSIZE)
[IDIFFERENCE W (SETQ BLACKPARTSIZE (ITIMES 2 (IDIFFERENCE (fetch WBORDER
of WIN)
BLACKPARTSIZE]
(IDIFFERENCE H BLACKPARTSIZE)
(QUOTE TEXTURE)
(QUOTE REPLACE)
(DSPTEXTURE NIL (fetch DSP of WIN] (* Boarder has been created, put existing screen bits
from SAVE.)
(BITBLT (fetch SAVE of WIN)
(fetch WBORDER of WIN)
(fetch WBORDER of WIN)
(SCREENBITMAP)
(IPLUS LEFT (fetch WBORDER of WIN))
(IPLUS BOTTOM (fetch WBORDER of WIN))
(IDIFFERENCE W (ITIMES (fetch WBORDER of WIN)
2))
(IDIFFERENCE H (ITIMES (fetch WBORDER of WIN)
2))
(QUOTE INPUT)
(QUOTE REPLACE])
)
(* Window utilities)
(DEFINEQ
(ADVISEWDS
[LAMBDA (WINDOW OLDREG MOVEONLYFLG) (* bvm: "17-AUG-83 13:18")
(DECLARE (LOCALVARS . T))
(* called whenever the dimensions of a WINDOW change. Updates the dependent fields in the associated
DisplayStream. Also updates dependent fields in the WINDOW such as Scroll region.)
(* OLDREG if given, is the region this window used to have and is used to maintain the relationship between the
WINDOW coordinates and the displaystreams when the WINDOW moves.)
(* MOVEONLYFLG indicates that the dimensions of the
region haven't changed.)
(PROG ((R (fetch REG of WINDOW))
(D (fetch DSP of WINDOW))
(WBORDERSIZE (fetch WBORDER of WINDOW))
CLIPREG TWICEBORDER PROC)
(SETQ TWICEBORDER (UNFOLD WBORDERSIZE 2))
(COND
(OLDREG (RELDSPXOFFSET (IDIFFERENCE (fetch (REGION LEFT) of R)
(fetch (REGION LEFT) of OLDREG))
D)
(RELDSPYOFFSET (IDIFFERENCE (fetch (REGION BOTTOM) of R)
(fetch (REGION BOTTOM) of OLDREG))
D)
(* if only moving, the clipping region remains the same. This is checked for because the height of the window
title may have changed and this calculation results in the wrong answer. All other calls to ADVISEWDS should
repaint the border.)
(OR MOVEONLYFLG (DSPCLIPPINGREGION [create REGION
LEFT ←(fetch (REGION LEFT)
of (SETQ CLIPREG
(DSPCLIPPINGREGION
NIL D)))
BOTTOM ←(fetch (REGION BOTTOM)
of CLIPREG)
WIDTH ←(IDIFFERENCE
(fetch (REGION WIDTH) of R)
TWICEBORDER)
HEIGHT ←(IPLUS
(IDIFFERENCE (fetch (REGION HEIGHT)
of R)
TWICEBORDER)
(COND
((fetch (WINDOW WTITLE)
of WINDOW)
(DSPLINEFEED NIL
WindowTitleDisplayStream))
(T 0]
D)))
(T (DSPXOFFSET (IPLUS (fetch (REGION LEFT) of R)
WBORDERSIZE)
D)
(DSPYOFFSET (IPLUS (fetch (REGION BOTTOM) of R)
WBORDERSIZE)
D)
(DSPCLIPPINGREGION [create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ←(IDIFFERENCE (fetch (REGION WIDTH) of R)
TWICEBORDER)
HEIGHT ←(IPLUS (IDIFFERENCE (fetch (REGION HEIGHT)
of R)
TWICEBORDER)
(COND
((fetch (WINDOW WTITLE) of WINDOW)
(DSPLINEFEED NIL
WindowTitleDisplayStream))
(T 0]
D)))
[COND
((NULL MOVEONLYFLG)
(DSPRIGHTMARGIN (IDIFFERENCE (fetch (REGION WIDTH) of R)
TWICEBORDER)
D)
(COND
((AND (SETQ PROC (WINDOWPROP WINDOW (QUOTE PROCESS)))
(EQ D (PROCESS.TTY PROC))) (* if the window changing is a tty, set its linelength.)
[PROCESS.EVAL PROC (LIST (FUNCTION PAGEHEIGHT)
(IQUOTIENT (fetch (REGION HEIGHT)
of (SETQ CLIPREG (DSPCLIPPINGREGION NIL D)))
(IMINUS (DSPLINEFEED NIL D]
(PROCESS.EVAL PROC (QUOTE (SETLINELENGTH)))
(COND
((EQ (PROCESSPROP PROC (QUOTE NAME))
(QUOTE EXEC)) (* in the exec process, make sure the current position
is inside the new shape. reuse variables R and
TWICEBORDER to save binding.)
(COND
((ILESSP (SETQ R (DSPYPOSITION NIL D))
(SETQ TWICEBORDER (fetch (REGION BOTTOM) of CLIPREG)))
(DSPYPOSITION TWICEBORDER D))
((IGREATERP R (SETQ TWICEBORDER (IPLUS (fetch (REGION HEIGHT) of CLIPREG)
TWICEBORDER)))
(DSPYPOSITION (IDIFFERENCE TWICEBORDER (FONTPROP D (QUOTE ASCENT)))
D]
(UPDATE/SCROLL/REG WINDOW))
WINDOW])
(SHOWWFRAME
[LAMBDA (WIN) (* rrb "15-JUN-83 16:14")
(* Displays the border and title in the save image of a
window)
(PROG ((TITLE (fetch WTITLE of WIN))
(BORDER (fetch WBORDER of WIN))
(DSP (fetch DSP of WIN))
(SAVEIMAGE (fetch SAVE of WIN))
WINWDTH WINHGHT BLACKPART WHITEPART)
[SETQ WINHGHT (fetch (REGION HEIGHT) of (SETQ WINWDTH (fetch (WINDOW REG) of WIN]
(SETQ WINWDTH (fetch (REGION WIDTH) of WINWDTH)) (* make most of the border black)
(SETQ BLACKPART (IMAX (FOLDHI BORDER 2)
(IDIFFERENCE BORDER 2)))
(SETQ WHITEPART (IDIFFERENCE BORDER BLACKPART)) (* Fill in frame in save image)
(BITBLT NIL NIL NIL SAVEIMAGE 0 0 WINWDTH WINHGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE) (* White out the frame in the saved image)
(BITBLT NIL NIL NIL SAVEIMAGE BLACKPART BLACKPART (IDIFFERENCE WINWDTH (ITIMES 2 BLACKPART))
(IPLUS (fetch (REGION HEIGHT) of (DSPCLIPPINGREGION NIL DSP))
(ITIMES 2 WHITEPART))
(QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)
(AND TITLE (SHOWWTITLE TITLE SAVEIMAGE BORDER)))
WIN])
(SHOWWTITLE
[LAMBDA (TITLE BM BORDER CENTERFLG) (* rrb "22-JUL-83 14:23")
(* prints a title in a window.)
(PROG ((FONT (DSPFONT NIL WindowTitleDisplayStream))
BOTTOM BMWIDTH HEIGHT)
(DSPDESTINATION BM WindowTitleDisplayStream)
(DSPCLIPPINGREGION (create REGION
LEFT ← 0
BOTTOM ←[SETQ BOTTOM (IDIFFERENCE (IPLUS (BITMAPHEIGHT BM)
(COND
((ZEROP BORDER)
0)
(T
(* if room, leave a line of the border at the top of the
title.)
-1)))
(SETQ HEIGHT
(FONTPROP FONT (QUOTE HEIGHT]
WIDTH ←(SETQ BMWIDTH (BITMAPWIDTH BM))
HEIGHT ← HEIGHT)
WindowTitleDisplayStream)
(MOVETO (COND
(CENTERFLG (IMAX BORDER (IQUOTIENT (IDIFFERENCE BMWIDTH (\STRINGWIDTHGUESS TITLE
FONT))
2)))
(T BORDER))
(IPLUS BOTTOM (FONTPROP FONT (QUOTE DESCENT)))
WindowTitleDisplayStream)
(RESETFORM (PRINTLEVEL WINDOWTITLEPRINTLEVEL)
(PROG ((PLVLFILEFLG T))
(PRIN3 TITLE WindowTitleDisplayStream])
(\STRINGWIDTHGUESS
[LAMBDA (X FONT) (* rrb "23-FEB-83 16:26")
(* returns a guess as to the string width of X. It goes one level so works on circular structures.
It is used as a heuristic by functions who are going to print something with printlevel.)
(COND
((NLISTP X)
(STRINGWIDTH X FONT))
(T (* Might be circular, don't call STRINGWIDTH)
(bind (SPACEWIDTH ←(CHARWIDTH (CHARCODE % )
FONT))
for ELT in X sum (IPLUS SPACEWIDTH (COND
((NLISTP ELT)
(STRINGWIDTH ELT FONT))
(T (* use some number for embedded lists.)
(ITIMES 7 SPACEWIDTH])
(RESHOWTITLE
[LAMBDA (TITLE WINDOW) (* rrb " 9-MAY-83 10:40")
(* updates a windows display with a new title)
(PROG ((WREG (fetch (WINDOW REG) of WINDOW))
(TITLEHEIGHT (IMINUS (DSPLINEFEED NIL WindowTitleDisplayStream)))
(OLDTITLE (fetch (WINDOW WTITLE) of WINDOW))
(BORDER (fetch WBORDER of WINDOW))
BM BMBTM HGHT)
(COND
((EQ TITLE (fetch (WINDOW WTITLE) of WINDOW))
(RETURN)))
(replace (WINDOW WTITLE) of WINDOW with TITLE)
(COND
([OR (NULL OLDTITLE)
(NULL TITLE)
(NEQ TITLEHEIGHT (IDIFFERENCE (fetch (REGION HEIGHT) of WREG)
(IPLUS (fetch (REGION HEIGHT)
of (DSPCLIPPINGREGION NIL
(fetch (WINDOW DSP)
of WINDOW)))
(ITIMES 2 BORDER]
(* Previously no title, so make space for one)
(* Have to remove title)
(* or title height changed.)
(* so windows region on the screen has to be made
larger.)
(\RESHOWBORDER1 (fetch (WINDOW WBORDER) of WINDOW)
(fetch (WINDOW WBORDER) of WINDOW)
WINDOW)
(RETURN))) (* code from here is to reprint the title in place to
avoid creating any large bitmaps.)
[SETQ BM (BITMAPCREATE (fetch (REGION WIDTH) of WREG)
(SETQ TITLEHEIGHT (ADD1 TITLEHEIGHT]
(BITBLT NIL NIL NIL BM 0 0 NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE) (* use SHOWWTITLE to put the image of the title into the
auxilliary bitmap.)
(SHOWWTITLE TITLE BM BORDER)
[COND
((IGREATERP TITLEHEIGHT (SETQ HGHT (fetch (REGION HEIGHT) of WREG)))
(SETQ BMBTM (IDIFFERENCE (SUB1 TITLEHEIGHT)
HGHT]
(UNINTERRUPTABLY
(TOTOPW WINDOW)
(BITBLT BM 0 (COND
(BMBTM)
((IGREATERP BORDER 0) (* if there is a border, the title was printed in the
scratch bitmap so to leave one point of the border on
top)
0)
(T 1))
(SCREENBITMAP)
(fetch (REGION LEFT) of WREG)
[IDIFFERENCE (fetch (REGION PTOP) of WREG)
(COND
(BMBTM HGHT)
(T (IPLUS TITLEHEIGHT (COND
((IGREATERP BORDER 0)
(* if there is a border, the title was printed in the
scratch bitmap so to leave one point of the border on
top)
0)
(T -1]
NIL
(COND
(BMBTM HGHT))))])
(TOTOPW
[LAMBDA (WINDOW NOCALLTOTOPFNFLG) (* rrb "28-JUN-83 11:55")
(* user entry to bring a window to the top.
Unless NOCALLTOTOPFNFLG is non-NIL, it will call the
windows TOTOPFN)
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(COND
((EQ WINDOW TOPW))
((OPENWP WINDOW)
(OR NOCALLTOTOPFNFLG (DOUSERFNS (WINDOWPROP WINDOW (QUOTE TOTOPFN))
WINDOW))
(\INTERNALTOTOPW WINDOW))
((OPENW WINDOW) (* if it is not open, open it and then call the TOTOPFN)
(OR NOCALLTOTOPFNFLG (DOUSERFNS (WINDOWPROP WINDOW (QUOTE TOTOPFN))
WINDOW)))
(T (* window won't open probably because of DON'T OPENFN)
(ERROR "Window won't open; Can't be bring to top." WINDOW)))
WINDOW])
(\INTERNALTOTOPW
[LAMBDA (W1 RPT) (* bas: "21-OCT-82 16:50")
(SETQ W1 (\INSUREWINDOW W1))
(OR (EQ W1 TOPW)
(COND
((NULL TOPW) (* all windows are closed open this one.)
(OPENW W1))
(T (UNINTERRUPTABLY
(\TTW1 W1 TOPW) (* GC msgs or other glitches can cause W1 not to make
it. Check and try ONCE more)
(COND
((EQ W1 TOPW))
(RPT (SHOULDNT))
(T (\INTERNALTOTOPW W1 T))))])
(\TTW1
[LAMBDA (WINDOW WS) (* bas: "21-OCT-82 16:06")
(COND
[(fetch NEXTW of WS)
(PROG ((ISECT (INTERSECTREGIONS (fetch REG of WINDOW)
(fetch REG of WS)
WHOLESCREEN)))
(AND ISECT (\SW2BM (fetch SAVE of WS)
(TRANSLATEREG ISECT (fetch REG of WS))
(SCREENBITMAP)
ISECT))
[COND
((EQ WINDOW (fetch NEXTW of WS)) (* doesn't have to be uninterruptable here because
TOTOPW is.)
(replace NEXTW of WS with (fetch NEXTW of WINDOW))
(replace NEXTW of WINDOW with TOPW)
(SETQ TOPW WINDOW)
(SETQ \TOPWDS (fetch (WINDOW DSP) of WINDOW)))
(T (\TTW1 WINDOW (fetch NEXTW of WS]
(AND ISECT (\SW2BM (fetch SAVE of WINDOW)
(TRANSLATEREG ISECT (fetch REG of WINDOW))
(fetch SAVE of WS)
(TRANSLATEREG ISECT (fetch REG of WS]
((type? WINDOW WINDOW) (* must be closed window; reopen it)
(OPENW WINDOW])
(WHICHW
[LAMBDA (X Y) (* rrb "14-JUL-82 17:41")
(COND
((POSITIONP X)
(WHICHW (fetch (POSITION XCOORD) of X)
(fetch (POSITION YCOORD) of X)))
(T (for (WINDOW ← TOPW) by (fetch NEXTW of WINDOW) while WINDOW
thereis (INSIDE? (fetch REG of WINDOW)
X Y])
)
(RPAQQ WINDOWTITLEPRINTLEVEL (2 . 5))
(* Window vs non-window world)
(DEFINEQ
(SWITCHDEF
[LAMBDA (F FROM TO)
(* rrb "24-JUN-81 14:52")
(MOVD? F (PACK* FROM F))
(AND (GETD (PACK* TO F))
(MOVD (PACK* TO F)
F))
F])
(NU\BACKGROUND
[LAMBDA (DUMMY) (* rmk: "21-OCT-81 22:58")
(WINDOW.MOUSE.HANDLER)
(\OLD\BACKGROUND])
(WFROMDS
[LAMBDA (DS) (* rrb "29-JUL-83 17:58")
(* Finds or creates a window for a display stream)
(* uses an XPointer from the displaystream as a hint.)
(DECLARE (GLOBALVARS \DEFAULTTTYDISPLAYSTREAM))
(PROG (HINTW (DS (\SFInsureDisplayStream DS)))
(COND
((AND (SETQ HINTW (ffetch (DISPLAYSTREAM XWINDOWHINT) of DS))
(EQ (ffetch (WINDOW DSP) of HINTW)
DS))
(RETURN HINTW))
[(AND (EQ DS \DEFAULTTTYDISPLAYSTREAM)
(EQ (TTYDISPLAYSTREAM)
\DEFAULTTTYDISPLAYSTREAM)) (* assume this process is doing something with T.)
(\CREATE.TTYDISPLAYSTREAM)
(RETURN (WFROMDS (TTYDISPLAYSTREAM]
((NEQ (ffetch (DISPLAYSTREAM \SFDestination) of DS)
(SCREENBITMAP)) (* for now color display streams don't have windows
associated with them.)
(RETURN NIL))
([SETQ HINTW (for (WINDOW ← TOPW) by (fetch NEXTW of WINDOW) while WINDOW
thereis (EQ DS (fetch DSP of WINDOW]
(RETURN HINTW))
(T (RETURN (CREATEW DS])
(NU\TOTOPWDS
[LAMBDA (DS) (* rmk: "21-OCT-81 22:31")
(* Moves the window of displaystream DS to the top)
(AND (EQ (DSPDESTINATION NIL DS)
(SCREENBITMAP))
(TOTOPW (WFROMDS DS])
(\COERCETODS
[LAMBDA (X) (* rrb "23-OCT-81 13:29")
(* Called from \SFInsureDisplayStream macro.
Compiles open in system code, closed call in user code,
and equivalent to \ILLEGAL.ARG if no window package.)
(COND
((type? WINDOW X)
(fetch (WINDOW DSP) of X))
(T (\ILLEGAL.ARG X])
)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS \COERCETODS MACRO [OPENLAMBDA (X)
(COND
((type? WINDOW X)
(fetch (WINDOW DSP) of X))
(T (\ILLEGAL.ARG X])
(PUTPROPS .WHILE.ON.TOP. MACRO ((FIRST . REST)
(UNINTERRUPTABLY
(\INTERNALTOTOPW FIRST) . REST)))
)
(* END EXPORTED DEFINITIONS)
)
(* User interface functions)
(DEFINEQ
(WINDOWP
[LAMBDA (X) (* rrb "20-NOV-81 07:30")
(AND (type? WINDOW X)
X])
(WINDOWPROP
[LAMBDA X (* rrb "26-AUG-82 17:36")
(* general top level entry for both fetching and setting
window properties.)
(COND
((IGREATERP X 2)
(PUTWINDOWPROP (ARG X 1)
(ARG X 2)
(ARG X 3)))
((EQ X 2)
(GETWINDOWPROP (ARG X 1)
(ARG X 2)))
(T (\ILLEGAL.ARG NIL])
(WINDOWADDPROP
[LAMBDA (WINDOW PROP ITEMTOADD) (* rrb "14-JUN-82 15:10")
(* adds an element to a window property.)
(PROG ((CURRENT (WINDOWPROP WINDOW PROP)))
(RETURN (WINDOWPROP WINDOW PROP (COND
((NULL CURRENT)
(LIST ITEMTOADD))
((NLISTP CURRENT)
(LIST CURRENT ITEMTOADD))
((FMEMB ITEMTOADD CURRENT) (* don't put things on twice.)
CURRENT)
(T (NCONC1 (APPEND CURRENT)
ITEMTOADD])
(WINDOWDELPROP
[LAMBDA (WINDOW PROP ITEMTODELETE) (* rrb "13-JUN-82 17:58")
(* deletes a property from a window property.)
(PROG ((CURRENT (WINDOWPROP WINDOW PROP)))
(RETURN (COND
((LISTP CURRENT)
(AND (FMEMB ITEMTODELETE CURRENT)
(WINDOWPROP WINDOW PROP (REMOVE ITEMTODELETE CURRENT])
(GETWINDOWPROP
[LAMBDA (WINDOW PROP) (* rrb "11-JUL-83 14:30")
(* gets values from a window.
Called by the macro for WINDOWPROP.)
[OR (type? WINDOW WINDOW)
(COND
((type? DISPLAYSTREAM WINDOW)
(SETQ WINDOW (WFROMDS WINDOW)))
(T (\ILLEGAL.ARG WINDOW]
(SELECTQ PROP
(RIGHTBUTTONFN (fetch (WINDOW RIGHTBUTTONFN) of WINDOW))
(BUTTONEVENTFN (fetch (WINDOW BUTTONEVENTFN) of WINDOW))
(CURSORINFN (fetch (WINDOW CURSORINFN) of WINDOW))
(CURSOROUTFN (fetch (WINDOW CURSOROUTFN) of WINDOW))
(CURSORMOVEDFN (fetch (WINDOW CURSORMOVEDFN) of WINDOW))
(DSP (fetch (WINDOW DSP) of WINDOW))
(SCROLLFN (fetch (WINDOW SCROLLFN) of WINDOW))
(RESHAPEFN (fetch (WINDOW RESHAPEFN) of WINDOW))
(EXTENT (fetch (WINDOW OBJECTEXTENT) of WINDOW))
(REPAINTFN (fetch (WINDOW DISPLAYCONTENTSFN) of WINDOW))
(MOVEFN (fetch (WINDOW MOVEFN) of WINDOW))
(CLOSEFN (fetch (WINDOW CLOSEFN) of WINDOW))
(WINDOWENTRYFN (fetch (WINDOW WINDOWENTRYFN) of WINDOW))
(PROCESS (fetch (WINDOW PROCESS) of WINDOW))
[HEIGHT (fetch (REGION HEIGHT) of (DSPCLIPPINGREGION NIL (fetch DSP of WINDOW]
[WIDTH (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL (fetch DSP of WINDOW]
(REGION (* make a copy so we don't have to worry about {or
document} the user clobbering it.)
(fetch (WINDOW REG) of WINDOW))
(NEWREGIONFN (fetch (WINDOW NEWREGIONFN) of WINDOW))
(TITLE (fetch (WINDOW WTITLE) of WINDOW))
(BORDER (fetch (WINDOW WBORDER) of WINDOW))
(IMAGECOVERED (fetch (WINDOW SAVE) of WINDOW))
(GETWINDOWUSERPROP WINDOW PROP])
(GETWINDOWUSERPROP
[LAMBDA (WINDOW USERPROP) (* rrb "27-JAN-83 19:36")
(* gets a property from the USERDATA property list of a window. This is the function called by the macro for
GETWINDOWPROP which result from a call to WINDOWPROP that doesn't have a third argument.)
(LISTGET (fetch USERDATA of WINDOW)
USERPROP])
(PUTWINDOWPROP
[LAMBDA (WINDOW PROP VALUE) (* rrb " 1-AUG-83 15:22")
[OR (type? WINDOW WINDOW)
(COND
((type? DISPLAYSTREAM WINDOW)
(SETQ WINDOW (WFROMDS WINDOW)))
(T (\ILLEGAL.ARG WINDOW]
(SELECTQ PROP
(RIGHTBUTTONFN (PROG1 (fetch (WINDOW RIGHTBUTTONFN) of WINDOW)
(replace (WINDOW RIGHTBUTTONFN) of WINDOW with VALUE)))
(BUTTONEVENTFN (PROG1 (fetch (WINDOW BUTTONEVENTFN) of WINDOW)
(replace (WINDOW BUTTONEVENTFN) of WINDOW with VALUE)))
(CLOSEFN (PROG1 (fetch (WINDOW CLOSEFN) of WINDOW)
(replace (WINDOW CLOSEFN) of WINDOW with VALUE)))
(MOVEFN (PROG1 (fetch (WINDOW MOVEFN) of WINDOW)
(replace (WINDOW MOVEFN) of WINDOW with VALUE)))
(CURSORINFN (PROG1 (fetch (WINDOW CURSORINFN) of WINDOW)
(replace (WINDOW CURSORINFN) of WINDOW with VALUE)))
(CURSOROUTFN (PROG1 (fetch (WINDOW CURSOROUTFN) of WINDOW)
(replace (WINDOW CURSOROUTFN) of WINDOW with VALUE)))
(CURSORMOVEDFN (PROG1 (fetch (WINDOW CURSORMOVEDFN) of WINDOW)
(replace (WINDOW CURSORMOVEDFN) of WINDOW with VALUE)))
(DSP (ERROR "Can't change DSP of a window" WINDOW))
(RESHAPEFN (PROG1 (fetch (WINDOW RESHAPEFN) of WINDOW)
(replace (WINDOW RESHAPEFN) of WINDOW with VALUE)))
(REPAINTFN (PROG1 (fetch (WINDOW DISPLAYCONTENTSFN) of WINDOW)
(replace (WINDOW DISPLAYCONTENTSFN) of WINDOW with VALUE)))
(EXTENT (PROG1 (fetch (WINDOW OBJECTEXTENT) of WINDOW)
(OR (NULL VALUE)
(REGIONP VALUE)
(\ILLEGAL.ARG VALUE))
(replace (WINDOW OBJECTEXTENT) of WINDOW with VALUE)))
(SCROLLFN (PROG1 (fetch (WINDOW SCROLLFN) of WINDOW)
(replace (WINDOW SCROLLFN) of WINDOW with VALUE)
(UPDATE/SCROLL/REG WINDOW)))
(IMAGECOVERED (ERROR "Not implemented to change IMAGECOVERED property." WINDOW))
(HEIGHT (ERROR "Not implemented to change HEIGHT as property." WINDOW))
(WIDTH (ERROR "Not implemented to change WIDTH as property." WINDOW))
[REGION (PROG [(CURREGION (WINDOWPROP WINDOW (QUOTE REGION]
(COND
((NOT (REGIONP VALUE))
(\ILLEGAL.ARG VALUE))) (* there is no check for where the new region is nor how
big it is; this is left to MOVEW and RESHAPEW.)
(COND
((AND (EQ (fetch (REGION WIDTH) of CURREGION)
(fetch (REGION WIDTH) of VALUE))
(EQ (fetch (REGION HEIGHT) of CURREGION)
(fetch (REGION HEIGHT) of VALUE)))
(* width and height are the same, move the window)
(MOVEW WINDOW (fetch (REGION LEFT) of VALUE)
(fetch (REGION BOTTOM) of VALUE)))
(T (* dimensions changed, reshape it.)
(SHAPEW WINDOW VALUE]
(NEWREGIONFN (PROG1 (fetch (WINDOW NEWREGIONFN) of WINDOW)
(replace (WINDOW NEWREGIONFN) of WINDOW with VALUE)))
(TITLE (PROG1 (fetch (WINDOW WTITLE) of WINDOW)
(RESHOWTITLE VALUE WINDOW)))
[BORDER (PROG1 (fetch (WINDOW WBORDER) of WINDOW)
(COND
((NUMBERP VALUE)
(RESHOWBORDER VALUE WINDOW))
(T (\ILLEGAL.ARG VALUE]
(PROCESS (PROG1 (fetch (WINDOW PROCESS) of WINDOW)
(replace (WINDOW PROCESS) of WINDOW with VALUE)))
(WINDOWENTRYFN (PROG1 (fetch (WINDOW WINDOWENTRYFN) of WINDOW)
(replace (WINDOW WINDOWENTRYFN) of WINDOW with VALUE)))
(PROG ((OLDDATA (fetch USERDATA of WINDOW))
OLDVALUE)
(RETURN (COND
(OLDDATA (SETQ OLDVALUE (LISTGET OLDDATA PROP))
[COND
(VALUE (LISTPUT OLDDATA PROP VALUE))
(OLDVALUE (* Remove the property)
(COND
((EQ (CAR OLDDATA)
PROP)
(replace USERDATA of WINDOW
with (CDDR OLDDATA)))
(T (for TAIL on (CDR OLDDATA)
by (CDDR TAIL) when (EQ (CADR TAIL)
PROP)
do (FRPLACD TAIL (CDDDR TAIL))
(RETURN]
OLDVALUE)
(VALUE (replace USERDATA of WINDOW with (LIST PROP VALUE))
(* know old value is NIL)
NIL])
(REMWINDOWPROP
[LAMBDA (WINDOW PROP) (* lmm "13-OCT-82 10:09")
[OR (type? WINDOW WINDOW)
(COND
((type? DISPLAYSTREAM WINDOW)
(SETQ WINDOW (WFROMDS WINDOW)))
(T (LISPERROR "ILLEGAL ARG" WINDOW]
(PROG ((DATA (fetch USERDATA of WINDOW)))
(RETURN (for TAIL on DATA by (CDDR TAIL) bind PREV
do (COND
((EQ (CAR TAIL)
PROP)
(COND
(PREV (RPLACD (CDR PREV)
(CDDR TAIL)))
((CDDR TAIL)
(FRPLNODE2 TAIL (CDDR TAIL)))
(T (replace USERDATA of WINDOW with NIL)))
(RETURN PROP)))
(SETQ PREV TAIL])
(WINDOWADDFNPROP
[LAMBDA (WINDOW PROP ITEMTOADD) (* rrb "18-JUN-82 16:30")
(* adds A functional element to a window property.
This is different from WINDOWADDTOPROP because is checks
for LAMBDA expressions as a single element.)
(PROG ((CURRENT (WINDOWPROP WINDOW PROP)))
(RETURN (WINDOWPROP WINDOW PROP (COND
((NULL CURRENT)
(LIST ITEMTOADD))
((OR (NLISTP CURRENT)
(FMEMB (CAR CURRENT)
LAMBDASPLST))
(LIST CURRENT ITEMTOADD))
((FMEMB ITEMTOADD CURRENT) (* don't put things on twice.)
CURRENT)
(T (NCONC1 (APPEND CURRENT)
ITEMTOADD])
)
(PUTPROPS WINDOWPROP ARGNAMES (WINDOW PROP NEWVALUE))
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS WINDOWPROP MACRO (X (CONS (COND
((IGREATERP (LENGTH X)
2)
(QUOTE PUTWINDOWPROP))
(T (QUOTE GETWINDOWPROP)))
X)))
)
(* END EXPORTED DEFINITIONS)
(DEFINEQ
(OPENWP
[LAMBDA (WINDOW) (* rrb "28-JUN-83 12:00")
(* is WINDOW an open window?)
(AND (type? WINDOW WINDOW)
(ONWINDOWCHAIN WINDOW TOPW)
WINDOW])
(RESHAPEBYREPAINTFN
[LAMBDA (WNEW OLDIMAGEBM OLDREGION) (* rrb "12-MAY-83 10:33")
(* default reshaping function that copies the lower left portion of the old image into the new image and calls the
repaint function on the newly exposed portions.)
(PROG ((DSP (WINDOWPROP WNEW (QUOTE DSP)))
(OLDWIDTH (fetch (REGION WIDTH) of OLDREGION))
(OLDHEIGHT (fetch (REGION HEIGHT) of OLDREGION))
WREGION)
(SETQ WREGION (DSPCLIPPINGREGION NIL DSP))
(BITBLT OLDIMAGEBM (fetch (REGION LEFT) of OLDREGION)
(fetch (REGION BOTTOM) of OLDREGION)
DSP
(fetch (REGION LEFT) of WREGION)
(fetch (REGION BOTTOM) of WREGION)
OLDWIDTH OLDHEIGHT NIL (QUOTE REPLACE))
(COND
((IGREATERP (fetch (REGION WIDTH) of WREGION)
OLDWIDTH)
(REDISPLAYW WNEW (create REGION
LEFT ←(IPLUS (fetch (REGION LEFT) of WREGION)
OLDWIDTH)
BOTTOM ←(fetch (REGION BOTTOM) of WREGION)
WIDTH ←(IDIFFERENCE (fetch (REGION WIDTH) of WREGION)
OLDWIDTH)
HEIGHT ←(IMIN OLDHEIGHT (fetch (REGION HEIGHT) of WREGION)))
T)))
(COND
((IGREATERP (fetch (REGION HEIGHT) of WREGION)
OLDHEIGHT)
(REDISPLAYW WNEW (create REGION
LEFT ←(fetch (REGION LEFT) of WREGION)
BOTTOM ←(IPLUS (fetch (REGION BOTTOM) of WREGION)
OLDHEIGHT)
WIDTH ←(fetch (REGION WIDTH) of WREGION)
HEIGHT ←(IDIFFERENCE (fetch (REGION HEIGHT) of WREGION)
OLDHEIGHT))
T)))
(RETURN WNEW])
(DECODE/WINDOW/OR/DISPLAYSTREAM
[LAMBDA (DSARG WINDOWVAR TITLE BORDER) (* rrb "28-JUN-83 11:56")
(* provides a defaulting mechanism displaystreams that uses windows too. If windowworld is on, if DSARG is NIL, it
uses the value of WINDOWVAR and if DSARG is NEW, it creates a new one. If windowworld is not on, it uses the
current displaystream.)
(COND
[(NULL DSARG)
(COND
[(WINDOWWORLD)
(PROG ((WINDOW (EVALV WINDOWVAR)))
(RETURN (COND
((type? WINDOW WINDOW)
(OR (OPENWP WINDOW)
(OPENW WINDOW))
(AND TITLE (NOT (EQUAL TITLE (fetch WTITLE of WINDOW)))
(WINDOWPROP WINDOW (QUOTE TITLE)
TITLE))
(fetch DSP of WINDOW))
(T (fetch DSP of (SET WINDOWVAR (CREATEW NIL TITLE BORDER]
(T (PROG ((DS (EVALV WINDOWVAR)))
(RETURN (COND
((type? DISPLAYSTREAM DS)
DS)
(T (SET WINDOWVAR (DSPCREATE]
((type? DISPLAYSTREAM DSARG)
DSARG)
((type? WINDOW DSARG)
(OR (OPENWP DSARG)
(OPENW DSARG))
(fetch DSP of DSARG))
[(EQ DSARG (QUOTE NEW))
(COND
((WINDOWWORLD)
(fetch DSP of (CREATEW NIL TITLE BORDER)))
(T (DSPCREATE]
(T (SHOULDNT])
(GROW/REGION
[LAMBDA (REGION AMOUNT) (* rrb " 9-MAR-82 14:34")
(* increase REGION by amount in all directions)
(replace (REGION LEFT) of REGION with (IDIFFERENCE (fetch (REGION LEFT) of REGION)
AMOUNT))
(replace (REGION BOTTOM) of REGION with (IDIFFERENCE (fetch (REGION BOTTOM) of REGION)
AMOUNT))
(replace (REGION WIDTH) of REGION with (IPLUS (fetch (REGION WIDTH) of REGION)
(ITIMES AMOUNT 2)))
(replace (REGION HEIGHT) of REGION with (IPLUS (fetch (REGION HEIGHT) of REGION)
(ITIMES AMOUNT 2)))
REGION])
(ONWINDOWCHAIN
[LAMBDA (WINDOW WCHAIN) (* bvm: " 2-AUG-81 17:19")
(* Is WINDOW on the window chain WCHAIN.)
(for WX←WCHAIN by (fetch NEXTW of WX) while WX thereis (EQ WX WINDOW])
(PPROMPT3
[LAMBDA (ITEM) (* rrb "17-NOV-81 12:15")
(* prints the third element of ITEM in the prompt
window. This is the default WHENHELDFN for MENUs.)
(COND
((AND (LISTP ITEM)
(CADDR ITEM))
(PROMPTPRINT (CADDR ITEM])
(CLRPROMPT
[LAMBDA NIL (* lmm "28-MAY-83 12:06")
(* clears the prompt window)
(COND
((type? WINDOW PROMPTWINDOW)
(CLEARW PROMPTWINDOW))
(T (TERPRI PROMPTWINDOW)
(TERPRI PROMPTWINDOW])
(PROMPTPRINT
[LAMBDA N (* lmm "28-MAY-83 14:45")
(* prints its arguments in the prompt window.)
(CLRPROMPT)
(for I from 1 to N do (PRIN1 (ARG N I)
PROMPTWINDOW])
(OPENWINDOWS
[LAMBDA NIL (* rrb "28-JUN-83 12:00")
(* returns a list of all open windows)
(PROG (WINDOWS WPTR)
(SETQ WPTR TOPW)
LP (COND
((NULL WPTR)
(RETURN WINDOWS))
(T (SETQ WINDOWS (CONS WPTR WINDOWS))
(SETQ WPTR (fetch (WINDOW NEXTW) of WPTR))
(GO LP])
(\INSUREWINDOW
[LAMBDA (WINDOW) (* rrb "29-JUL-83 17:37")
(* coerces to a window)
(PROG (X)
(RETURN (COND
((type? WINDOW WINDOW)
WINDOW)
((AND (type? DISPLAYSTREAM WINDOW)
(WFROMDS WINDOW)))
((AND (SETQ X (\GETOFD WINDOW NIL T))
(SETQ X (\GETDISPLAYSTREAMFROMSTREAM X))
(WFROMDS X)))
(T (ERROR "ILLEGAL ARG" WINDOW])
)
(* these entries are left in for backward compatibility. They were dedocumented 6/83. rrb.)
(MOVD (QUOTE OPENWP)
(QUOTE ACTIVEWP))
(MOVD (QUOTE OPENWINDOWS)
(QUOTE ACTIVEWINDOWS))
(DEFINEQ
(OVERLAPPINGWINDOWS
[LAMBDA (WINDOW) (* rrb "16-AUG-81 17:07")
(* returns all windows that overlap with WINDOW or that
overlap a window that is in the OVERLAPPINGWINDOWS of
WINDOW.)
(PROG ((WPTR TOPW)
(OVERLAPS (CONS WINDOW))
DONTS)
LP [COND
((NULL WPTR)
(RETURN OVERLAPS))
((EQ WPTR WINDOW) (* skip the window itself)
NIL)
([SOME OVERLAPS (FUNCTION (LAMBDA (X)
(WOVERLAPP WPTR X] (* this window overlaps a member of the interesting
ones.)
(SETQ OVERLAPS (CONS WPTR OVERLAPS)) (* find all members of donts that overlap this new
window and move them {and ones that overlap them} to
OVERLAPS.)
(PROG ((ADDS (CONS WPTR))
OVERLAPPED)
NWLP(COND
((for old OVERLAPPED in DONTS thereis (WOVERLAPP (CAR ADDS)
OVERLAPPED))
(* the window that was added overlaps one of the
previously looked at windows that was untouched.)
(SETQ ADDS (CONS OVERLAPPED ADDS))
(SETQ OVERLAPS (CONS OVERLAPPED OVERLAPS))
(SETQ DONTS (REMOVE OVERLAPPED DONTS))
(GO NWLP))
((SETQ ADDS (CDR ADDS)) (* there are more windows that were added.)
(GO NWLP)))
(RETURN)))
(T (SETQ DONTS (CONS WPTR DONTS]
(SETQ WPTR (fetch (WINDOW NEXTW) of WPTR))
(GO LP])
(WOVERLAPP
[LAMBDA (W1 W2) (* rrb "16-AUG-81 08:30")
(* do these windows overlap?)
(REGIONSINTERSECTP (fetch (WINDOW REG) of W1)
(fetch (WINDOW REG) of W2])
(ORDERFROMBOTTOMTOTOP
[LAMBDA (WLST) (* rrb "16-AUG-81 16:57")
(* returns a list of windows in order from bottom to
top)
(PROG (ANS (WPTR TOPW))
LP [COND
((NULL WPTR)
(RETURN ANS))
((FMEMB WPTR WLST)
(SETQ ANS (CONS WPTR ANS]
(SETQ WPTR (fetch (WINDOW NEXTW) of WPTR))
(GO LP])
)
(* screen size changing functions.)
(DEFINEQ
(\ONSCREENW
[LAMBDA (W) (* rrb "14-OCT-81 11:19")
(* does W have any part on the screen?)
(* for now only consider that it might be too far to the
right as this is the wide to narrow screen case.)
(* CURSORWIDTH is to make sure the cursor can be set in the window. It can be taken out when cursor hotspot can go
anywhere.)
(IGREATERP (IDIFFERENCE SCREENWIDTH CURSORWIDTH)
(fetch (REGION LEFT) of (WINDOWPROP W (QUOTE REGION])
(\PUTONSCREENW
[LAMBDA (W) (* rrb " 3-MAR-82 11:16")
(* moves W so that it will be on the screen.
For now, moves it to the left by screenwidth)
(MOVEW W (create POSITION
XCOORD ←(IDIFFERENCE (fetch (REGION LEFT) of (fetch (WINDOW REG) of W))
SCREENWIDTH)
YCOORD ←(fetch (REGION BOTTOM) of (WINDOWPROP W (QUOTE REGION])
(\UPDATECACHEDFIELDS
[LAMBDA (DS) (* rrb "14-OCT-81 16:53")
(* updates the cached fields of a displaystream for the
fact that the screen bitmap changed sizes)
(\SFFixDestination DS])
(\WWCHANGESCREENSIZE
[LAMBDA NIL (* rrb "28-JUN-83 11:57")
(* the sysout has been moved to a screen of a different size. All windows are closed, the screenbitmap is updated
to correct new size and the windows are reopened so that at least part of each is visible.)
(PROG [(WINDOWS (DREVERSE (OPENWINDOWS] (* OPENWINDOWS returns the windows with bottom window
first.)
(for W in WINDOWS do (CLOSEW W))
(\STARTDISPLAY)
(CLEAR (SCREENBITMAP)
WINDOWBACKGROUNDSHADE) (* update cached bitmap width information that is in the
display streams)
[for W in WINDOWS do (\UPDATECACHEDFIELDS (WINDOWPROP W (QUOTE DSP]
[for W in KNOWNWINDOWS do (\UPDATECACHEDFIELDS (WINDOWPROP W (QUOTE DSP]
(* bring back windows)
(for W in (DREVERSE WINDOWS)
do (COND
((NOT (\ONSCREENW W))
(\PUTONSCREENW W)))
(OPENW W])
(CREATEWFROMIMAGE
[LAMBDA (IMAGE) (* rrb "16-NOV-81 08:01")
(* creates a window that has IMAGE as an image.
It is initially closed and can be opened.)
(PROG ((WINDOW (create WINDOW
DSP ← (DSPCREATE)
REG ← (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← (fetch (BITMAP BITMAPWIDTH) of IMAGE)
HEIGHT ← (fetch (BITMAP BITMAPHEIGHT) of IMAGE))
WBORDER ← 0
SAVE ← IMAGE)))
(replace (DISPLAYSTREAM XWINDOWHINT) of (fetch (WINDOW DSP) of WINDOW) with WINDOW)
(RETURN (ADVISEWDS WINDOW])
(UPDATEWFROMIMAGE
[LAMBDA (WINDOW) (* rrb " 9-MAR-82 14:33")
(* makes the fields of a window consistent with its
image.)
(PROG ((REGION (fetch REG of WINDOW))
(IMAGE (fetch SAVE of WINDOW)))
(replace (REGION LEFT) of REGION with 0)
(replace (REGION BOTTOM) of REGION with 0)
(replace (REGION WIDTH) of REGION with (fetch (BITMAP BITMAPWIDTH) of IMAGE))
(replace (REGION HEIGHT) of REGION with (fetch (BITMAP BITMAPHEIGHT) of IMAGE))
(replace WBORDER of WINDOW with 0])
)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS WINDOWWORLD MACRO [X (COND
((NULL X)
(QUOTE (type? WINDOW TOPW)))
(T (QUOTE IGNOREMACRO])
)
)
(* END EXPORTED DEFINITIONS)
(* Scrolling stuff)
(DEFINEQ
(SCROLLW
[LAMBDA (WINDOW DX DY CONTINUOUSFLG) (* rrb "27-JAN-83 18:15")
(* scrolls a window by DX in the X direction and DY in the Y direction. If CONTINUOUSFLG is non-NIL, this is part
of a continuous scroll so that the window scrolling function can decide for example to scroll a constant smount.)
(APPLY* (OR (fetch SCROLLFN of WINDOW)
(FUNCTION SCROLLBYREPAINTFN))
WINDOW DX DY CONTINUOUSFLG])
(SCROLLBYREPAINTFN
[LAMBDA (WINDOW XDELTA YDELTA CONTINUOUSFLG) (* rrb "21-JUN-83 10:22")
(* standard scrolling function that scrolls by blting existing bits and then calling the windows repaintfn to
repaint the newly exposed bits. (SCROLLW W 0 -3 T))
(PROG ((DSP (WINDOWPROP WINDOW (QUOTE DSP)))
(EXTENT (WINDOWPROP WINDOW (QUOTE EXTENT)))
CLIPREG)
(SETQ CLIPREG (DSPCLIPPINGREGION NIL DSP))
(* only one of XDELTA or YDELTA should be non-zero but do both anyway. When both can be non-zero, this code should
avoid calling the repaintfn on the part of the object that is scrolled on by X but then scrolled off by Y.)
(* do X first because in the common case of printing it
is faster to do it first.)
[COND
((FLOATP XDELTA) (* thumb scroll, XDELTA gives the fraction of the way
from the left margin the cursor was.)
(COND
[(AND EXTENT (NEQ (fetch (REGION WIDTH) of EXTENT)
-1))
(PROG (OLDX NEWX) (* if there is an extent, calculate a value of XDELTA
that moves to the proper place.
If there is not, Don't do anything.)
[SETQ NEWX (IPLUS (fetch (REGION LEFT) of EXTENT)
(FIXR (FTIMES XDELTA (IDIFFERENCE (fetch (REGION WIDTH)
of EXTENT)
(fetch (REGION WIDTH)
of CLIPREG]
(SETQ OLDX (WXOFFSET NIL DSP))
(SETQ XDELTA (IDIFFERENCE OLDX NEWX]
(T (SETQ XDELTA 0]
[COND
(CONTINUOUSFLG (* if continuous set it scroll by the linefeed height
{no particularly good reason why the linefeed height but
why not}.)
(COND
((EQ XDELTA 0))
[(IGREATERP XDELTA 0) (* linefeed height is normally negative.)
(SETQ XDELTA (IMINUS (DSPLINEFEED NIL DSP]
(T (SETQ XDELTA (DSPLINEFEED NIL DSP]
(COND
((AND (NEQ XDELTA 0)
(COND
((AND EXTENT (NEQ (fetch (REGION WIDTH) of EXTENT)
-1)) (* limit amount by the extent)
(* for now limit right extent to right of window ETC. ie
keep it always visible.)
(SETQ XDELTA (IMIN (IDIFFERENCE (fetch (REGION LEFT) of CLIPREG)
(fetch (REGION LEFT) of EXTENT))
(IMAX (IDIFFERENCE (fetch (REGION PRIGHT) of CLIPREG)
(fetch (REGION PRIGHT) of EXTENT))
XDELTA))) (* make sure it is still not 0)
(NEQ XDELTA 0))
(T T)))
(BITBLT WINDOW (WTODSX 0 WINDOW)
(WTODSY 0 WINDOW)
WINDOW
(WTODSX XDELTA WINDOW)
(WTODSY 0 WINDOW)
(fetch (REGION WIDTH) of CLIPREG)
(fetch (REGION HEIGHT) of CLIPREG)
(QUOTE INPUT)
(QUOTE REPLACE))
(WXOFFSET XDELTA DSP)
(REDISPLAYW WINDOW [COND
((IGREATERP XDELTA 0) (* moving to right, create new region on left for
repaintfn)
(create REGION
LEFT ←(WTODSX 0 WINDOW)
BOTTOM ←(WTODSY 0 WINDOW)
WIDTH ←(IMIN XDELTA (fetch (REGION WIDTH) of CLIPREG))
HEIGHT ←(fetch (REGION HEIGHT) of CLIPREG)))
(T (* moving to left.)
(create REGION
LEFT ←(IMAX (WTODSX (IPLUS (fetch (REGION WIDTH) of CLIPREG)
XDELTA)
WINDOW)
(fetch (REGION LEFT) of CLIPREG))
BOTTOM ←(WTODSY 0 WINDOW)
WIDTH ←(IMIN (IMINUS XDELTA)
(fetch (REGION WIDTH) of CLIPREG))
HEIGHT ←(fetch (REGION HEIGHT) of CLIPREG]
T)))
[COND
((FLOATP YDELTA) (* thumb scroll, YDELTA gives the fraction of the way
from the top margin the cursor was.)
(COND
[(AND EXTENT (NEQ (fetch (REGION HEIGHT) of EXTENT)
-1))
(PROG (OLDY NEWY) (* if there is an extent, calculate a value of YDELTA
that moves to the proper place.
If there is not, Don't do anything.)
(SETQ NEWY (IPLUS (IDIFFERENCE (FIXR (FTIMES (FDIFFERENCE 1.0 YDELTA)
(fetch (REGION HEIGHT)
of EXTENT)))
(fetch (REGION HEIGHT) of CLIPREG))
(fetch (REGION BOTTOM) of EXTENT)))
(SETQ OLDY (WYOFFSET NIL DSP))
(SETQ YDELTA (IDIFFERENCE OLDY NEWY]
(T (SETQ YDELTA 0]
[COND
(CONTINUOUSFLG (* if continuous set it scroll by the linefeed height)
(COND
((EQ YDELTA 0))
[(IGREATERP YDELTA 0) (* linefeed height is normally negative.)
(SETQ YDELTA (IMINUS (DSPLINEFEED NIL DSP]
(T (SETQ YDELTA (DSPLINEFEED NIL DSP]
(COND
((AND (NEQ YDELTA 0)
(COND
((AND EXTENT (NEQ (fetch (REGION HEIGHT) of EXTENT)
-1)) (* limit amount by the extent)
(SETQ YDELTA (IMAX (IDIFFERENCE (fetch (REGION PTOP) of CLIPREG)
(fetch (REGION PTOP) of EXTENT))
(IMIN (IDIFFERENCE (fetch (REGION TOP) of CLIPREG)
(fetch (REGION BOTTOM) of EXTENT))
YDELTA))) (* make sure its still not 0)
(NEQ YDELTA 0))
(T T))) (* move the current image if any of it is still in
view.)
(BITBLT WINDOW (WTODSX 0 WINDOW)
(WTODSY 0 WINDOW)
WINDOW
(WTODSX 0 WINDOW)
(WTODSY YDELTA WINDOW)
(fetch (REGION WIDTH) of CLIPREG)
(fetch (REGION HEIGHT) of CLIPREG)
(QUOTE INPUT)
(QUOTE REPLACE))
(WYOFFSET YDELTA DSP)
(REDISPLAYW WINDOW [COND
[(IGREATERP YDELTA 0) (* moving up.)
(create REGION
LEFT ←(WTODSX 0 WINDOW)
BOTTOM ←(WTODSY 0 WINDOW)
WIDTH ←(fetch (REGION WIDTH) of CLIPREG)
HEIGHT ←(IMIN YDELTA (fetch (REGION HEIGHT) of CLIPREG]
(T (* moving down, fill in top)
(create REGION
LEFT ←(WTODSX 0 WINDOW)
BOTTOM ←(IMAX (WTODSY (IPLUS (fetch (REGION HEIGHT)
of CLIPREG)
YDELTA)
WINDOW)
(fetch (REGION BOTTOM) of CLIPREG))
WIDTH ←(fetch (REGION WIDTH) of CLIPREG)
HEIGHT ←(IMIN (IMINUS YDELTA)
(fetch (REGION HEIGHT) of CLIPREG]
T)))
(RETURN])
(ADJUSTOFFSETS
[LAMBDA (WINDOW XDELTA YDELTA) (* rrb "26-AUG-81 15:38")
(PROG [(DSP (WINDOWPROP WINDOW (QUOTE DSP] (* determine the change in offsets caused by the scroll.
and redisplay the graph.)
(WYOFFSET YDELTA DSP)
(WXOFFSET XDELTA DSP)
(RETURN])
(CREATESCROLLINGW
[LAMBDA (TITLE BORDER) (* rrb "30-DEC-81 12:00")
(WINDOWPROP (CREATEW NIL TITLE BORDER)
(QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN])
(IN/SCROLL/BAR?
[LAMBDA (WINDOW X Y) (* rrb "10-AUG-81 18:40")
(* is X, Y in the scroll bar for WINDOW?)
(AND (fetch SCROLLFN of WINDOW)
(OR (INSIDE? (fetch (WINDOW VERTSCROLLREG) of WINDOW)
X Y)
(INSIDE? (fetch (WINDOW HORIZSCROLLREG) of WINDOW)
X Y])
(RELDSPXOFFSET
[LAMBDA (DX DISPLAYSTREAM) (* relative offsetting function.)
(DSPXOFFSET (IPLUS DX (DSPXOFFSET NIL DISPLAYSTREAM))
DISPLAYSTREAM])
(RELDSPYOFFSET
[LAMBDA (DY DISPLAYSTREAM) (* relative offsetting function.)
(DSPYOFFSET (IPLUS DY (DSPYOFFSET NIL DISPLAYSTREAM))
DISPLAYSTREAM])
(SCROLL.HANDLER
[LAMBDA (WINDOW) (* rrb "26-JUL-83 13:02")
(* cursor has moved into scroll region.
Handle interaction to determine type of scroll, if any,
desired.)
(* returns non-NIL if scrolling was applicable.)
(PROG [SCROLLREG SCROLLW BUTTON DIRECTION SCROLLCURSOR LEFTCURSOR RIGHTCURSOR MIDDLECURSOR
TIMEDOWN CONTINUOUSSCROLL? (EXTENT (WINDOWPROP WINDOW (QUOTE EXTENT]
(* create a window as the easiest thing to do.
Fairly inefficient.)
(GETMOUSESTATE)
(COND
((AND (INSIDE? (SETQ SCROLLREG (fetch (WINDOW VERTSCROLLREG) of WINDOW))
LASTMOUSEX LASTMOUSEY)
(PROGN (DISMISS SCROLLWAITTIME)
(GETMOUSESTATE)
(INSIDE? SCROLLREG LASTMOUSEX LASTMOUSEY)))
[COND
((SETQ SCROLLW (fetch (WINDOW VERTSCROLLWINDOW) of WINDOW))
(* if there is one already, reopen it.)
(OPENW SCROLLW))
((SETQ SCROLLW (replace (WINDOW VERTSCROLLWINDOW) of WINDOW
with (CREATEW SCROLLREG NIL 2]
(SETQ DIRECTION (QUOTE VERT))
(SETQ SCROLLCURSOR VertScrollCursor)
(SETQ LEFTCURSOR ScrollUpCursor)
(SETQ RIGHTCURSOR ScrollDownCursor)
(SETQ MIDDLECURSOR VertThumbCursor))
((AND (COND
((AND EXTENT (NEQ (fetch (REGION WIDTH) of EXTENT)
-1))
(* if there is an extent, make sure it is past the current view boundaries. -1 is used to mark an unknown width,
treat it as if EXTENT wasn't given.)
(EXTENDPASTHORIZBOUNDARIES (DSPCLIPPINGREGION NIL WINDOW)
EXTENT))
(T T))
(INSIDE? (SETQ SCROLLREG (fetch (WINDOW HORIZSCROLLREG) of WINDOW))
LASTMOUSEX LASTMOUSEY)
(PROGN (DISMISS SCROLLWAITTIME)
(GETMOUSESTATE)
(INSIDE? SCROLLREG LASTMOUSEX LASTMOUSEY)))
[COND
((SETQ SCROLLW (fetch (WINDOW HORIZSCROLLWINDOW) of WINDOW))
(* if there is one already, reopen it.)
(OPENW SCROLLW))
((SETQ SCROLLW (replace (WINDOW HORIZSCROLLWINDOW) of WINDOW
with (CREATEW SCROLLREG NIL 2]
(SETQ DIRECTION (QUOTE HORIZ))
(SETQ SCROLLCURSOR HorizScrollCursor)
(SETQ LEFTCURSOR ScrollLeftCursor)
(SETQ MIDDLECURSOR HorizThumbCursor)
(SETQ RIGHTCURSOR ScrollRightCursor))
(T (* moved out quickly)
(RETURN NIL)))
(\UPDATE.EXTENT.IMAGE SCROLLW DIRECTION WINDOW) (* bring window being scrolled to top.)
(TOTOPW WINDOW)
(RETURN (RESETFORM (CURSOR SCROLLCURSOR)
(PROG NIL
LP (GETMOUSESTATE)
[COND
((NOT (INSIDE? SCROLLREG LASTMOUSEX LASTMOUSEY))
(* if cursor is no longer in scroll region, quit.)
(CLOSEW SCROLLW)
(* if the mouse is in the window, set last in window so window will get control again. If it is outside, don't set
it so that the cursoroutfn for WINDOW will get called.)
(AND (INSIDE? (WINDOWPROP WINDOW (QUOTE REGION))
LASTMOUSEX LASTMOUSEY)
(SETQ \LastInWindow NIL))
(RETURN T))
[(LASTMOUSESTATE UP) (* no buttons down; if there was one down, take action;
otherwise, wait for one to go down.)
(COND
(BUTTON (COND
(CONTINUOUSSCROLL?
(* were continuously scrolling, stop it.)
(SETQ CONTINUOUSSCROLL? NIL))
(T (\SCROLL.HANDLER.DOIT WINDOW BUTTON DIRECTION
SCROLLREG LASTMOUSEX
LASTMOUSEY)
(\UPDATE.EXTENT.IMAGE SCROLLW DIRECTION WINDOW))
)
(CURSOR SCROLLCURSOR)
(SETQ BUTTON)
(* if a button went up, reset the timedown for
scrolling.)
(SETQ TIMEDOWN)
(SETQ CONTINUOUSSCROLL? NIL]
[(LASTMOUSESTATE (OR LEFT RIGHT))
(COND
((AND (LASTMOUSESTATE LEFT)
(NEQ BUTTON (QUOTE LEFT)))
(* LEFT button just when down.)
(SETQ BUTTON (QUOTE LEFT))
(SETQ TIMEDOWN (CLOCK 0))
(CURSOR LEFTCURSOR))
((AND (LASTMOUSESTATE RIGHT)
(NEQ BUTTON (QUOTE RIGHT)))
(* RIGHT button just when down.)
(SETQ BUTTON (QUOTE RIGHT))
(SETQ TIMEDOWN (CLOCK 0))
(CURSOR RIGHTCURSOR))
((AND CONTINUOUSSCROLL? (IGREATERP (CLOCKDIFFERENCE TIMEDOWN)
WAITBETWEENSCROLLTIME))
(* button is still down, keep scrolling.)
(* note time before calling scroll fn so time to display
is included in the wait time.)
(SETQ TIMEDOWN (CLOCK0 TIMEDOWN))
(\SCROLL.HANDLER.DOIT WINDOW BUTTON DIRECTION SCROLLREG
LASTMOUSEX LASTMOUSEY T)
(\UPDATE.EXTENT.IMAGE SCROLLW DIRECTION WINDOW))
((IGREATERP (CLOCKDIFFERENCE TIMEDOWN)
WAITBEFORESCROLLTIME)
(* has enough time past to start continuous scroll?)
(SETQ CONTINUOUSSCROLL? T]
((LASTMOUSESTATE MIDDLE)
(COND
((NEQ BUTTON (QUOTE MIDDLE))
(* MIDDLE button just when down.)
(SETQ BUTTON (QUOTE MIDDLE))
(* don't keep track of time down for middle buttons.)
(CURSOR MIDDLECURSOR))
(T NIL]
(GO LP])
(\SCROLL.HANDLER.DOIT
[LAMBDA (WINDOW BUTTON DIRECTION SCROLLREGION XPOS YPOS CONTINUOUS?)
(* rrb "27-JAN-83 18:54")
(* decodes how far to scroll given that the button was
let up at position XPOS YPOS in the scroll region
SCROLLREGION.)
(SCROLLW WINDOW (COND
((EQ DIRECTION (QUOTE HORIZ))
(SELECTQ BUTTON
(LEFT (IDIFFERENCE (fetch (REGION LEFT) of SCROLLREGION)
XPOS))
(RIGHT (IDIFFERENCE XPOS (fetch (REGION LEFT) of SCROLLREGION)))
[MIDDLE (MIN 1.0 (MAX 0.0 (FQUOTIENT (IDIFFERENCE
XPOS
(IPLUS 2 (fetch (REGION LEFT)
of SCROLLREGION)))
(IDIFFERENCE (fetch (REGION WIDTH)
of SCROLLREGION)
4]
(SHOULDNT)))
(T 0))
(COND
((EQ DIRECTION (QUOTE VERT))
(SELECTQ BUTTON
(LEFT (IDIFFERENCE (fetch (REGION TOP) of SCROLLREGION)
YPOS))
(RIGHT (IDIFFERENCE YPOS (fetch (REGION TOP) of SCROLLREGION)))
[MIDDLE (MIN 1.0 (MAX 0.0 (FQUOTIENT (IDIFFERENCE
(IDIFFERENCE (fetch (REGION TOP)
of SCROLLREGION)
2)
YPOS)
(IDIFFERENCE (fetch (REGION HEIGHT)
of SCROLLREGION)
4]
(SHOULDNT)))
(T 0))
CONTINUOUS?])
(\UPDATE.EXTENT.IMAGE
[LAMBDA (SCROLLBARW DIRECTION SCROLLINGW) (* rrb "26-JUL-83 13:05")
(* paints the appropriate grey region in the scrolling
bar window.)
(CLEARW SCROLLBARW)
(PROG [(EXTENT (WINDOWPROP SCROLLINGW (QUOTE EXTENT]
(OR EXTENT (RETURN NIL))
(COND
((EQ DIRECTION (QUOTE VERT))
(PROG ((SCROLLBARSHADE 32800)
GRAYHEIGHT GRAYBOTTOM SCROLLWIDTH SCROLLHEIGHT (WINREGION (DSPCLIPPINGREGION
NIL SCROLLINGW))
(SCROLLREGION (DSPCLIPPINGREGION NIL SCROLLBARW))
WINHEIGHT
(EXHEIGHT (fetch (REGION HEIGHT) of EXTENT)))
(* -1 is used to mark an extent of unknown height.)
(AND (EQ EXHEIGHT -1)
(RETURN))
(SETQ SCROLLWIDTH (fetch (REGION WIDTH) of SCROLLREGION))
(SETQ SCROLLHEIGHT (fetch (REGION HEIGHT) of SCROLLREGION))
(SETQ WINHEIGHT (fetch (REGION HEIGHT) of WINREGION))
(SETQ GRAYHEIGHT (IMIN SCROLLHEIGHT (IQUOTIENT (ITIMES WINHEIGHT SCROLLHEIGHT)
EXHEIGHT)))
(SETQ GRAYBOTTOM (IDIFFERENCE (IDIFFERENCE
SCROLLHEIGHT
(IQUOTIENT (ITIMES WINHEIGHT
(IDIFFERENCE
(fetch (REGION TOP)
of EXTENT)
(fetch (REGION TOP)
of WINREGION)))
EXHEIGHT))
GRAYHEIGHT))
(BITBLT NIL NIL NIL SCROLLBARW 0 GRAYBOTTOM SCROLLWIDTH GRAYHEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)
(BITBLT NIL NIL NIL SCROLLBARW 1 (IPLUS GRAYBOTTOM 2)
(IDIFFERENCE SCROLLWIDTH 2)
(IDIFFERENCE GRAYHEIGHT 4)
(QUOTE TEXTURE)
(QUOTE REPLACE)
SCROLLBARSHADE)))
((EQ DIRECTION (QUOTE HORIZ))
(PROG ((SCROLLBARSHADE 32800)
GRAYWIDTH GRAYLEFT SCROLLWIDTH SCROLLHEIGHT (WINREGION (DSPCLIPPINGREGION NIL
SCROLLINGW))
(SCROLLREGION (DSPCLIPPINGREGION NIL SCROLLBARW))
WINWIDTH
(EXWIDTH (fetch (REGION WIDTH) of EXTENT)))
(* -1 is used to mark an EXTENT of unknown width.)
(AND (EQ EXWIDTH -1)
(RETURN))
(SETQ SCROLLWIDTH (fetch (REGION WIDTH) of SCROLLREGION))
(SETQ SCROLLHEIGHT (fetch (REGION HEIGHT) of SCROLLREGION))
(SETQ WINWIDTH (fetch (REGION WIDTH) of WINREGION))
(SETQ GRAYWIDTH (IMIN SCROLLWIDTH (IQUOTIENT (ITIMES WINWIDTH SCROLLWIDTH)
EXWIDTH)))
(SETQ GRAYLEFT (IQUOTIENT (ITIMES WINWIDTH (IDIFFERENCE (fetch (REGION LEFT)
of WINREGION)
(fetch (REGION LEFT)
of EXTENT)))
EXWIDTH))
(BITBLT NIL NIL NIL SCROLLBARW GRAYLEFT 0 GRAYWIDTH SCROLLHEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)
(BITBLT NIL NIL NIL SCROLLBARW (IPLUS GRAYLEFT 2)
1
(IDIFFERENCE GRAYWIDTH 4)
(IDIFFERENCE SCROLLHEIGHT 2)
(QUOTE TEXTURE)
(QUOTE REPLACE)
SCROLLBARSHADE])
(EXTENDPASTHORIZBOUNDARIES
[LAMBDA (VIEW EXTENT) (* rrb "24-JAN-82 11:13")
(* does VIEW entirely cover the hoizontal dimensions of
EXTENT?)
(OR (IGREATERP (fetch (REGION LEFT) of VIEW)
(fetch (REGION LEFT) of EXTENT))
(IGREATERP (fetch (REGION RIGHT) of EXTENT)
(fetch (REGION RIGHT) of VIEW])
(REDISPLAYW
[LAMBDA (WINDOW REGION ALWAYSFLG) (* rrb "28-JUN-83 14:20")
(* calls a repaint function after setting the clipping region of the window to it. If ALWAYSFLG is NIL, it won't
redisplay unless there is a window repaintfn.)
(PROG ((DSP (fetch (WINDOW DSP) of WINDOW))
REPAINTFN CLIPREG)
(COND
[(SETQ REPAINTFN (WINDOWPROP WINDOW (QUOTE REPAINTFN]
(ALWAYSFLG (SETQ REPAINTFN (FUNCTION NILL)))
(T (PROMPTPRINT "Window has no REPAINTFN. Can't redisplay.")
(RETURN)))
(SETQ CLIPREG (DSPCLIPPINGREGION NIL DSP))
(RETURN (COND
(REGION [COND
((NOT (SUBREGIONP CLIPREG REGION))
(* reduce REGION so that it is within the clipping
region of the window)
(SETQ REGION (INTERSECTREGIONS REGION CLIPREG]
(RESETLST (RESETSAVE NIL (LIST (QUOTE DSPCLIPPINGREGION)
(DSPCLIPPINGREGION REGION DSP)
DSP))
(RESETSAVE NIL (LIST (QUOTE DSPXOFFSET)
(DSPXOFFSET NIL DSP)
DSP))
(RESETSAVE NIL (LIST (QUOTE DSPYOFFSET)
(DSPYOFFSET NIL DSP)
DSP))
(FILLWITHBACKGROUND WINDOW REGION)
(DOUSERFNS2 REPAINTFN WINDOW REGION)))
(T (FILLWITHBACKGROUND WINDOW REGION)
(DOUSERFNS2 REPAINTFN WINDOW CLIPREG])
(FILLWITHBACKGROUND
[LAMBDA (WIN REG) (* rrb "31-DEC-81 12:17")
(* fills a window with its background.
This is the default window repainting function.)
(DSPFILL REG (DSPTEXTURE NIL WIN)
(QUOTE REPLACE)
(WINDOWPROP WIN (QUOTE DSP])
(UPDATE/SCROLL/REG
[LAMBDA (WINDOW) (* rrb " 9-MAR-82 14:34")
(* updates the scroll region field of the WINDOW)
(COND
((fetch SCROLLFN of WINDOW)
(PROG ((IMAGEREG (fetch REG of WINDOW))) (* kill the cache for the scroll region.)
(COND
((fetch (WINDOW VERTSCROLLWINDOW) of WINDOW)
(CLOSEW (fetch (WINDOW VERTSCROLLWINDOW) of WINDOW))
(replace (WINDOW VERTSCROLLWINDOW) of WINDOW with NIL)))
(COND
((fetch (WINDOW HORIZSCROLLWINDOW) of WINDOW)
(CLOSEW (fetch (WINDOW HORIZSCROLLWINDOW) of WINDOW))
(replace (WINDOW HORIZSCROLLWINDOW) of WINDOW with NIL)))
[replace (WINDOW VERTSCROLLREG) of WINDOW
with (create REGION
LEFT ←(IMAX 0 (IDIFFERENCE (fetch (REGION LEFT) of IMAGEREG)
SCROLLBARWIDTH))
BOTTOM ←(fetch (REGION BOTTOM) of IMAGEREG)
WIDTH ← SCROLLBARWIDTH
HEIGHT ←(IPLUS (fetch (REGION HEIGHT) of IMAGEREG)
(COND
((fetch (WINDOW WTITLE) of WINDOW)
(DSPLINEFEED NIL WindowTitleDisplayStream))
(T 0]
(replace (WINDOW HORIZSCROLLREG) of WINDOW
with (create REGION
LEFT ←(fetch (REGION LEFT) of IMAGEREG)
BOTTOM ←(IMAX 0 (IDIFFERENCE (fetch (REGION BOTTOM) of IMAGEREG)
SCROLLBARWIDTH))
WIDTH ←(fetch (REGION WIDTH) of IMAGEREG)
HEIGHT ← SCROLLBARWIDTH])
(WTODSX
[LAMBDA (WX WINDOW) (* rrb " 9-MAR-82 14:32")
(* converts from the window natural coordinates which
have 0,0 at lower left corner of the window and the
displaystreams coordinates.)
(IPLUS WX (fetch (REGION LEFT) of (DSPCLIPPINGREGION NIL (fetch DSP of WINDOW])
(WTODSY
[LAMBDA (WY WINDOW) (* rrb " 9-MAR-82 14:23")
(* converts from the window natural coordinates which
have 0,0 at lower left corner of the window and the
displaystreams coordinates.)
(IPLUS WY (fetch (REGION BOTTOM) of (DSPCLIPPINGREGION NIL (fetch DSP of WINDOW])
(WXOFFSET
[LAMBDA (DX WINDOW) (* rrb " 9-MAR-82 14:32")
(* offsets a displaystream by a given delta but leaves
its clipping region where it was.
Used for offsetting display streams under window.)
(PROG [CR (DS (COND
((NULL WINDOW)
(fetch DSP of TOPW))
((type? DISPLAYSTREAM WINDOW)
WINDOW)
(T (fetch DSP of WINDOW]
(SETQ CR (DSPCLIPPINGREGION NIL DS))
(RETURN (PROG1 (fetch (REGION LEFT) of CR)
(COND
((NUMBERP DX)
(DSPXOFFSET (IPLUS DX (DSPXOFFSET NIL DS))
DS)
(add (fetch (REGION LEFT) of CR)
(IMINUS DX)) (* recall DSPCLIPPINGREGION to update dependent fields
in DS.)
(DSPCLIPPINGREGION CR DS])
(WYOFFSET
[LAMBDA (DY WINDOW) (* rrb " 9-MAR-82 14:23")
(* offsets a displaystream by a given delta but leaves
its clipping region where it was.
Used for offsetting display streams under window.)
(PROG [CR (DS (COND
((NULL WINDOW)
(fetch DSP of TOPW))
((type? DISPLAYSTREAM WINDOW)
WINDOW)
(T (fetch DSP of WINDOW]
(SETQ CR (DSPCLIPPINGREGION NIL DS))
(RETURN (PROG1 (fetch (REGION BOTTOM) of CR)
(COND
((NUMBERP DY)
(DSPYOFFSET (IPLUS DY (DSPYOFFSET NIL DS))
DS)
(add (fetch (REGION BOTTOM) of CR)
(IMINUS DY)) (* recall DSPCLIPPINGREGION to update dependent fields
in DS.)
(DSPCLIPPINGREGION CR DS])
(BITMAPSCROLLFN
[LAMBDA (WINDOW XDELTA YDELTA) (* rrb "17-AUG-81 15:16")
(* scrolls a bitmap under a window)
(SCROLLBITMAP (WINDOWPROP WINDOW (QUOTE BITMAP))
WINDOW XDELTA YDELTA])
(SCROLLBITMAP
[LAMBDA (BITMAP WINDOW XDELTA YDELTA) (* rrb " 9-MAR-82 14:33")
(* scrolls a bitmap under a window.)
(PROG ((DSP (WINDOWPROP WINDOW (QUOTE DSP)))
REGION)
(COND
((NOT (type? BITMAP BITMAP))
(RETURN)))
(SETQ REGION (DSPCLIPPINGREGION NIL DSP)) (* determine the change in offsets caused by the
scroll.)
(WYOFFSET (IMAX (IMIN (fetch (REGION BOTTOM) of REGION)
YDELTA)
(IDIFFERENCE (fetch (REGION HEIGHT) of REGION)
(fetch (BITMAP BITMAPHEIGHT) of BITMAP)))
DSP)
(WXOFFSET (IMAX (IMIN (fetch (REGION LEFT) of REGION)
XDELTA)
(IDIFFERENCE (fetch (REGION WIDTH) of REGION)
(fetch (BITMAP BITMAPWIDTH) of BITMAP)))
DSP) (* stuff new image over old)
(BITBLT BITMAP 0 0 DSP])
(REDISPLAYBITMAP
[LAMBDA (BITMAP WINDOW) (* rrb " 9-MAR-82 14:32")
(* blts a bitmap into a window so that the lower left corner of the bitmap is in the lower left corner of the
window.)
(OR (type? BITMAP BITMAP)
(ERROR "ILLEGAL ARG" BITMAP))
(PROG ((DSP (WINDOWPROP WINDOW (QUOTE DSP)))
WREGION)
(SETQ WREGION (DSPCLIPPINGREGION NIL DSP))
(RETURN (BITBLT BITMAP 0 0 DSP (fetch (REGION LEFT) of WREGION)
(fetch (REGION BOTTOM) of WREGION])
(ULREDISPLAYBITMAP
[LAMBDA (BITMAP WNEW) (* rrb " 9-MAR-82 14:33")
(* blts a bitmap into a window so that the upper left corner of the bitmap is in the upper left corner of the
window.)
(OR (type? BITMAP BITMAP)
(ERROR "ILLEGAL ARG" BITMAP))
(PROG ((DSP (WINDOWPROP WNEW (QUOTE DSP)))
REGION)
(SETQ REGION (DSPCLIPPINGREGION NIL DSP))
(RETURN (BITBLT BITMAP 0 0 DSP (fetch (REGION LEFT) of REGION)
(IDIFFERENCE (IPLUS (fetch (REGION BOTTOM) of REGION)
(fetch (REGION HEIGHT) of REGION))
(fetch BITMAPHEIGHT of BITMAP])
(EXTENDEXTENT
[LAMBDA (WINDOW INCLUDEREGION) (* rrb "20-JAN-82 10:05")
(* destructively changes the EXTENT region of a WINDOW
to include INCLUDEREGION)
(PROG [(EXTENT (WINDOWPROP WINDOW (QUOTE EXTENT]
(RETURN (COND
(EXTENT (EXTENDREGION EXTENT INCLUDEREGION))
(T (WINDOWPROP WINDOW (QUOTE EXTENT)
(create REGION using INCLUDEREGION])
(WIDTHIFWINDOW
[LAMBDA (INTERIORWIDTH BORDER) (* rrb "28-JUN-83 14:17")
(* returns the exterior width of a window with interior
dimension INTERIORWIDTH)
(IPLUS INTERIORWIDTH (ITIMES 2 (OR BORDER WBorder])
(HEIGHTIFWINDOW
[LAMBDA (INTERIORHEIGHT TITLEFLG BORDER) (* rrb "28-JUN-83 14:18")
(* returns the exterior height of a window which has
interior height dimension INTERIORHEIGHT)
(IPLUS INTERIORHEIGHT (COND
(TITLEFLG (IMINUS (DSPLINEFEED NIL WindowTitleDisplayStream)))
(T 0))
(ITIMES 2 (OR BORDER WBorder])
)
(* icon functions)
(DEFINEQ
(SHRINKW
[LAMBDA (WINDOW TOWHAT ICONPOSITION EXPANDFN) (* rrb "28-JUN-83 11:58")
(* Create a small WINDOW which acts as an Icon of window. This "icon window" provides a popup menu which will open
the main WINDOW again, and run the function EXPANDFN. TOWHAT can be a BITMAP which will be used to make a WINDOW
image, an existing window, or a string which will be printed in TITLE only icon window, or can be an existing
window. If TOWHAT is NIL, the TITLE of the main WINDOW is used as the TOWHAT for the icon.
If ICONPOSITION is not given, the user is asked to move the WINDOW)
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(PROG (TITLE ICONW FN) (* get the icon specification from the window if none is
given.)
(COND
((NOT (OPENWP WINDOW)) (* if it is not currently active, don't do anything.
Maybe something should happen here but I don't
understand what -
rrb)
(RETURN NIL))
((WINDOWPROP WINDOW (QUOTE ICONFOR)) (* This is already an icon!)
(RETURN))
((EQ (DOUSERFNS (WINDOWPROP WINDOW (QUOTE SHRINKFN))
WINDOW T)
(QUOTE DON'T)) (* one of the shrinkfns disallowed the shrinkage.)
(PROMPTPRINT "Can't SHRINK that window.")
(RETURN NIL)))
[SETQ ICONW (COND
((type? BITMAP TOWHAT) (* use bitMap to create a WINDOW)
(CREATEWFROMIMAGE (BITMAPCOPY TOWHAT)))
((WINDOWP TOWHAT) (* use given WINDOW as icon)
(OR (POSITIONP ICONPOSITION)
(SETQ ICONPOSITION (QUOTE SAME)))
TOWHAT)
(T (* current call doesn't specify an icon window.
Look for something on the window.)
(SETQ ICONW (WINDOWPROP WINDOW (QUOTE ICONWINDOW)))
(* Get cached iconwindow)
[SETQ TOWHAT (COND
((SETQ FN (WINDOWPROP WINDOW (QUOTE ICONFN)))
(* User fn to create an icon.
Can return cached value)
(APPLY* FN WINDOW ICONW))
(T (OR ICONW (WINDOWPROP WINDOW (QUOTE ICON]
(COND
((WINDOWP TOWHAT) (* use given WINDOW as icon)
(OR (POSITIONP ICONPOSITION)
(SETQ ICONPOSITION (QUOTE SAME)))
TOWHAT)
((type? BITMAP TOWHAT) (* use bitMap to create a WINDOW)
(CREATEWFROMIMAGE (BITMAPCOPY TOWHAT)))
(T [SETQ TITLE (OR TOWHAT (WINDOWPROP WINDOW (QUOTE TITLE))
(CONCAT "Icon made " (DATE]
(* Used as label in icon)
(CREATEW (create REGION
LEFT ← LASTMOUSEX
BOTTOM ← LASTMOUSEY
HEIGHT ←(IMINUS (DSPLINEFEED NIL WindowTitleDisplayStream))
WIDTH ←(IPLUS 8 (STRINGWIDTH TITLE WindowTitleDisplayStream)))
TITLE NIL T]
(* keep track of the icon so that won't have to constantly recreate. Means that this must be removed before
changes to icon property will take effect.)
(WINDOWPROP WINDOW (QUOTE ICONWINDOW)
ICONW)
(WINDOWPROP ICONW (QUOTE ICONFOR)
WINDOW) (* set up so that if icon is closed, main window will be
also.)
(WINDOWADDFNPROP ICONW (QUOTE CLOSEFN)
(QUOTE CLOSEMAINWINDOW)) (* set up so that if main window is opened, icon is
closed.)
(WINDOWADDFNPROP WINDOW (QUOTE OPENFN)
(QUOTE CLOSEICONWINDOW))
(AND EXPANDFN (WINDOWADDFNPROP WINDOW (QUOTE EXPANDFN)
EXPANDFN))
(WINDOWPROP ICONW (QUOTE RIGHTBUTTONFN)
(QUOTE DOICONWINDOWCOM))
[OR (EQ ICONPOSITION (QUOTE SAME))
(MOVEW ICONW (COND
((POSITIONP ICONPOSITION)
ICONPOSITION)
(T (* leave it in its current location.)
(PROG [(WREG (WINDOWPROP WINDOW (QUOTE REGION)))
(ICONREG (WINDOWPROP ICONW (QUOTE REGION]
(RETURN (create POSITION
XCOORD ←[COND
((ILESSP (fetch (REGION LEFT) of WREG)
(IDIFFERENCE SCREENWIDTH
(fetch (REGION PRIGHT)
of WREG)))
(fetch (REGION LEFT) of WREG))
(T (IDIFFERENCE (fetch (REGION PRIGHT)
of WREG)
(fetch (REGION WIDTH) of ICONREG]
YCOORD ←(COND
((ILESSP (fetch (REGION BOTTOM) of WREG)
(IDIFFERENCE SCREENHEIGHT
(fetch (REGION PTOP)
of WREG)))
(fetch (REGION BOTTOM) of WREG))
(T (IDIFFERENCE (fetch (REGION PTOP) of WREG)
(fetch (REGION HEIGHT)
of ICONREG]
(\CLOSEW1 WINDOW)
(OPENW ICONW)
(RETURN ICONW])
(EXPANDW
[LAMBDA (ICONW) (* rrb "18-JUN-82 16:27")
(* expands an icon window into its main window.)
(PROG (MAINWINDOW USEREXPANDFN)
(COND
([NULL (\USERFNISDON'T (SETQ USEREXPANDFN (WINDOWPROP (SETQ MAINWINDOW
(WINDOWPROP ICONW (QUOTE ICONFOR))
)
(QUOTE EXPANDFN]
(* if the main window will open and none of the
expandfns stop it, open the main window and Close icon
Window)
(\OPENW1 MAINWINDOW)
(\CLOSEW1 ICONW)
(WINDOWDELPROP MAINWINDOW (QUOTE OPENFN)
(QUOTE CLOSEICONWINDOW))
(WINDOWDELPROP ICONW (QUOTE CLOSEFN)
(QUOTE CLOSEMAINWINDOW)) (* call the expand functions after the window has been
opened.)
(DOUSERFNS USEREXPANDFN MAINWINDOW) (* break link from icon to window.)
(RETURN (WINDOWPROP ICONW (QUOTE ICONFOR)
NIL])
(DOICONWINDOWCOM
[LAMBDA (WINDOW) (* rrb " 7-AUG-83 18:52")
(* the button handler for an ICON window Test for non-NIL WINDOW means that caller needn't worry about whether the
mouse is pointing at a window.)
(AND (type? WINDOW WINDOW)
(PROG (COM)
(TOTOPW WINDOW)
(RETURN (COND
((SETQ COM (MENU [COND
((TYPENAMEP IconWindowMenu (QUOTE MENU))
IconWindowMenu)
((SETQ IconWindowMenu
(create MENU
ITEMS ← IconWindowMenuCommands
CHANGEOFFSETFLG ←(QUOTE Y)
MENUOFFSET ←(create POSITION
XCOORD ← -1
YCOORD ← 0)
WHENHELDFN ←(FUNCTION PPROMPT3)
WHENUNHELDFN ←(FUNCTION CLRPROMPT)
CENTERFLG ← T]
IconWindowMenu))
(APPLY* COM WINDOW)
T])
(CLOSEMAINWINDOW
[LAMBDA (ICONWIN) (* rrb "28-JUN-83 11:58")
(* the closefn for an icon window that closes the main
window as well.)
(PROG [(MAINWIN (WINDOWPROP ICONWIN (QUOTE ICONFOR]
[COND
(MAINWIN (COND
((NULL (\OKTOCLOSEW MAINWIN))
(* Call the main windows closefns. If main window won't close, don't close the icon. The main window has already
been removed from the window stack but its closefns haven't been executed.)
(RETURN (QUOTE DON'T)))
(T (* closefns for main window may have opened it for
example by printing to it. Close it if it is open.)
(AND (OPENWP MAINWIN)
(\CLOSEW1 MAINWIN]
(* break link between the icon and the main window. This may give problems if someone holds onto the icon window
and explicitly reopens it and expects it to still be an icon.)
(WINDOWPROP ICONWIN (QUOTE ICONFOR)
NIL)
(RETURN NIL])
(CLOSEICONWINDOW
[LAMBDA (MAINWIN) (* bvm: "15-JUN-82 16:56")
(* the open function for a window which has an icon.
It closes the icon.)
(PROG [(ICONW (WINDOWPROP MAINWIN (QUOTE ICONWINDOW]
(COND
(ICONW (* Don't die if user removed the ICONWINDOW prop)
(WINDOWDELPROP ICONW (QUOTE CLOSEFN)
(QUOTE CLOSEMAINWINDOW)) (* remove the mainwindowclosing function first.)
(CLOSEW ICONW))) (* remove icon closing function.)
(WINDOWDELPROP MAINWIN (QUOTE OPENFN)
(QUOTE CLOSEICONWINDOW])
)
(RPAQQ IconMenuItems (Expand))
(RPAQ VertScrollCursor (CURSORCREATE (READBITMAP) 7 17Q))
(20Q 20Q
"@A@@"
"@CH@"
"@CH@"
"@GL@"
"@GL@"
"@ON@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@ON@"
"@GL@"
"@GL@"
"@CH@"
"@CH@"
"@A@@")(RPAQ ScrollUpCursor (CURSORCREATE (READBITMAP) 7 17Q))
(20Q 20Q
"@A@@"
"@CH@"
"@CH@"
"@GL@"
"@GL@"
"@ON@"
"@ON@"
"AOO@"
"AOO@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@")(RPAQ ScrollDownCursor (CURSORCREATE (READBITMAP) 7 17Q))
(20Q 20Q
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"AOO@"
"AOO@"
"@ON@"
"@ON@"
"@GL@"
"@GL@"
"@CH@"
"@CH@"
"@A@@")(RPAQ HorizScrollCursor (CURSORCREATE (READBITMAP) 7 5))
(20Q 20Q
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@HB@"
"AHC@"
"CHCH"
"GHCL"
"OOON"
"OOON"
"GHCL"
"CHCH"
"AHC@"
"@HB@")(RPAQ ScrollLeftCursor (CURSORCREATE (READBITMAP) 10Q 5))
(20Q 20Q
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@H@"
"@CH@"
"@OH@"
"COH@"
"OOOO"
"OOOO"
"COH@"
"@OH@"
"@CH@"
"@@H@")(RPAQ ScrollRightCursor (CURSORCREATE (READBITMAP) 7 5))
(20Q 20Q
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@A@@"
"@AL@"
"@AO@"
"@AOL"
"OOOO"
"OOOO"
"@AOL"
"@AO@"
"@AL@"
"@A@@")(RPAQ VertThumbCursor (CURSORCREATE (READBITMAP) 6 10Q))
(20Q 20Q
"@@@@"
"OH@@"
"@@@@"
"OO@@"
"@@@@"
"OON@"
"@@@@"
"OOOH"
"@@@@"
"OON@"
"@@@@"
"OO@@"
"@@@@"
"OH@@"
"@@@@"
"@@@@")(RPAQ HorizThumbCursor (CURSORCREATE (READBITMAP) 6 6))
(20Q 20Q
"@@@@"
"@@@@"
"@@@@"
"@B@@"
"@B@@"
"@JH@"
"@JH@"
"@JH@"
"BJJ@"
"BJJ@"
"BJJ@"
"JJJH"
"JJJH"
"JJJH"
"JJJH"
"JJJH")(RPAQ WAITINGCURSOR (CURSORCREATE (READBITMAP) 7 10Q))
(20Q 20Q
"OOON"
"L@@F"
"F@AL"
"CMGH"
"AOO@"
"@ON@"
"@FL@"
"@CH@"
"@BH@"
"@FL@"
"@MF@"
"AIC@"
"CGMH"
"FGNL"
"OOON"
"OOON")(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \LastCursorPosition \LastInWindow WindowMenu BackgroundMenu
BackgroundMenuCommands \LastWindowButtons WWFNS WindowMenuCommands IconWindowMenu
IconWindowMenuCommands VertScrollCursor ScrollUpCursor ScrollDownCursor ScrollLeftCursor
ScrollRightCursor HorizScrollCursor WindowTitleDisplayStream WINDOWTITLEPRINTLEVEL WBorder
\TOPWDS WINDOWBACKGROUNDSHADE CURRENTBACKGROUNDSHADE BACKGROUNDFNS)
)
(DECLARE: EVAL@COMPILE
(RPAQQ MinWindowWidth 32Q)
(RPAQQ MinWindowHeight 20Q)
(CONSTANTS (MinWindowWidth 32Q)
(MinWindowHeight 20Q))
)
(* FOLLOWING DEFINITIONS EXPORTED)
[DECLARE: EVAL@COMPILE
(DATATYPE WINDOW (DSP NEXTW SAVE REG BUTTONEVENTFN RIGHTBUTTONFN CURSORINFN CURSOROUTFN CURSORMOVEDFN
DISPLAYCONTENTSFN RESHAPEFN OBJECTEXTENT USERDATA VERTSCROLLREG HORIZSCROLLREG
SCROLLFN VERTSCROLLWINDOW HORIZSCROLLWINDOW CLOSEFN MOVEFN WTITLE NEWREGIONFN
WBORDER PROCESS WINDOWENTRYFN)
BUTTONEVENTFN ←(FUNCTION TOTOPW)
WBORDER ← WBorder WINDOWENTRYFN ←(FUNCTION GIVE.TTY.PROCESS))
]
(/DECLAREDATATYPE (QUOTE WINDOW)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)))
(* END EXPORTED DEFINITIONS)
)
(DECLARE: EVAL@COMPILE
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS TOPW WINDOWUSERFORMS ENDOFWINDOWUSERFORMS PROMPTWINDOW KNOWNWINDOWS)
)
(* END EXPORTED DEFINITIONS)
)
[ADDTOVAR SYSTEMRECLST
(DATATYPE WINDOW (DSP NEXTW SAVE REG BUTTONEVENTFN RIGHTBUTTONFN CURSORINFN CURSOROUTFN CURSORMOVEDFN
DISPLAYCONTENTSFN RESHAPEFN OBJECTEXTENT USERDATA VERTSCROLLREG HORIZSCROLLREG
SCROLLFN VERTSCROLLWINDOW HORIZSCROLLWINDOW CLOSEFN MOVEFN WTITLE NEWREGIONFN
WBORDER PROCESS WINDOWENTRYFN)
BUTTONEVENTFN ←(FUNCTION TOTOPW)
WBORDER ← WBorder WINDOWENTRYFN ←(FUNCTION GIVE.TTY.PROCESS))
]
(/DECLAREDATATYPE (QUOTE WINDOW)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)))
(RPAQ? WWFNS (QUOTE (\TOTOPWDS)))
(RPAQ? WindowTitleDisplayStream )
(RPAQ? WindowMenu )
(RPAQ? BackgroundMenu )
(RPAQ? TOPW )
(RPAQ? \LastCursorPosition (CREATEPOSITION))
(RPAQ? \LastInWindow )
(RPAQ? \LastWindowButtons 0)
(RPAQ? IconWindowMenu )
(RPAQ? KNOWNWINDOWS )
(RPAQ? WINDOWBACKGROUNDSHADE 104042Q)
(RPAQ? WBorder 4)
(RPAQ? SCROLLBARWIDTH 30Q)
(RPAQ? SCROLLWAITTIME 144Q)
(RPAQ? WAITBEFORESCROLLTIME 1356Q)
(RPAQ? WAITBETWEENSCROLLTIME 144Q)
(RPAQ? PAINTCOMMANDBRUSH (QUOTE (ROUND 2)))
(RPAQ? PAINTCOMMANDMODE (QUOTE PAINT))
(RPAQ? PAINTCOMMANDMENU )
(RPAQ? PAINTCOMMANDSHADE BLACKSHADE)
(RPAQ? PAINTSIZEMENU )
(RPAQ? PAINTSHAPEMENU )
(RPAQ? PAINTSHADEMENU )
(RPAQ? PAINTMODEMENU )
(RPAQ? HIGHLIGHTSHADE 100040Q)
(ADDTOVAR WindowMenuCommands (Close (QUOTE CLOSEW)
"Closes a window")
(Snap (QUOTE SNAPW)
"Saves a snapshot of a region of the screen.")
(Paint (QUOTE PAINTW)
"Starts a painting mode in which the mouse can
be used to draw pictures or make notes on windows.
Includes a HARDCOPY command.")
(Clear (QUOTE CLEARW)
"Clears a window to its gray.")
(Bury (QUOTE BURYW)
"Puts a window on the bottom.")
(Redisplay (QUOTE REDISPLAYW)
"Redisplays a window using its REPAINTFN.")
(Move (QUOTE MOVEW)
"Moves a window by a corner.")
(Shape (QUOTE SHAPEW)
"Gets a new region for a window.
Left button down marks fixed corner; sweep to other corner.
Middle button down moves closest corner.")
(Shrink (QUOTE SHRINKW)
"Replaces this window with its icon (or title if it doesn't have an icon."))
(ADDTOVAR IconWindowMenuCommands (Close (QUOTE CLOSEW)
"Closes the icon and its assciated window")
(Snap (QUOTE SNAPW)
"Saves a snapshot of a region of the screen.")
(Paint (QUOTE PAINTW)
"Starts a painting mode in which the mouse can
be used to draw pictures or make notes on windows.
Includes a HARDCOPY command.")
(Bury (QUOTE BURYW)
"Puts a window on the bottom.")
(Move (QUOTE MOVEW)
"Moves a window by a corner.")
(Shape (QUOTE SHAPEW)
"Gets a new region for a window.
Left button down marks fixed corner; sweep to other corner.
Middle button down moves closest corner.")
(Expand (QUOTE EXPANDW)
"Expands the window for which this is the ICON."))
(ADDTOVAR BackgroundMenuCommands (SaveVM (QUOTE (SAVEVM))
"Updates the virtual memory.")
(Snap (QUOTE (SNAPW))
"Saves a snapshot of a region of the screen.")
(Hardcopy (QUOTE (HARDCOPYW))
"Send hardcopy of screen region to printer."))
(ADDTOVAR WINDOWUSERFORMS )
(ADDTOVAR ENDOFWINDOWUSERFORMS )
(DECLARE: DOCOPY DONTEVAL@LOAD
(WINDOWWORLD T)
(ADDTOVAR GLOBALVARS SCROLLBARWIDTH SCROLLWAITTIME WAITBEFORESCROLLTIME WAITBETWEENSCROLLTIME
WAITINGCURSOR)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA PROMPTPRINT WINDOWPROP WINDOWWORLD)
)
(PUTPROPS WINDOW COPYRIGHT ("Xerox Corporation" 3676Q 3677Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (15546Q 44356Q (WINDOWWORLD 15560Q . 26437Q) (WINDOWWORLDP 26441Q . 27017Q) (
CHANGEBACKGROUND 27021Q . 30450Q) (TILE 30452Q . 31450Q) (LOGOW 31452Q . 35071Q) (\DRAWLOGOWINDOWIMAGE
35073Q . 36176Q) (\TTY.CREATING.DISPLAYSTREAM 36200Q . 37331Q) (\CREATE.TTY.OUTCHARFN 37333Q . 40727Q
) (\CREATE.TTYDISPLAYSTREAM 40731Q . 43452Q) (HASTTYWINDOWP 43454Q . 44354Q)) (45064Q 61506Q (
WINDOW.MOUSE.HANDLER 45076Q . 56323Q) (DOWINDOWCOM 56325Q . 57771Q) (DOBACKGROUNDCOM 57773Q . 61504Q))
(61507Q 155064Q (BURYW 61521Q . 62472Q) (CLEARW 62474Q . 63440Q) (CLOSEW 63442Q . 64305Q) (\CLOSEW1
64307Q . 66430Q) (\OKTOCLOSEW 66432Q . 67261Q) (OPENW 67263Q . 71166Q) (DOUSERFNS 71170Q . 73016Q) (
DOUSERFNS2 73020Q . 74017Q) (\USERFNISDON'T 74021Q . 74541Q) (\OPENW1 74543Q . 75560Q) (CREATEW 75562Q
. 102745Q) (MOVEW 102747Q . 111641Q) (RELMOVEW 111643Q . 112652Q) (HARDCOPYW 112654Q . 117505Q) (
PAINTW 117507Q . 130773Q) (PAINTW.READBRUSHSHADE 130775Q . 132127Q) (PAINTW.READMODE 132131Q . 133221Q
) (PAINTW.READBRUSHSHAPE 133223Q . 133707Q) (PAINTW.READBRUSHSIZE 133711Q . 134331Q) (SHAPEW 134333Q
. 137773Q) (RESHOWBORDER 137775Q . 140743Q) (\RESHOWBORDER1 140745Q . 146012Q) (TRACKW 146014Q .
147604Q) (SNAPW 147606Q . 151552Q) (FRAME/EXISTING/BITS 151554Q . 155062Q)) (155122Q 207577Q (
ADVISEWDS 155134Q . 165035Q) (SHOWWFRAME 165037Q . 167603Q) (SHOWWTITLE 167605Q . 172216Q) (
\STRINGWIDTHGUESS 172220Q . 173625Q) (RESHOWTITLE 173627Q . 201605Q) (TOTOPW 201607Q . 203504Q) (
\INTERNALTOTOPW 203506Q . 204613Q) (\TTW1 204615Q . 206767Q) (WHICHW 206771Q . 207575Q)) (207722Q
214547Q (SWITCHDEF 207734Q . 210220Q) (NU\BACKGROUND 210222Q . 210465Q) (WFROMDS 210467Q . 213136Q) (
NU\TOTOPWDS 213140Q . 213632Q) (\COERCETODS 213634Q . 214545Q)) (215472Q 241274Q (WINDOWP 215504Q .
215716Q) (WINDOWPROP 215720Q . 216637Q) (WINDOWADDPROP 216641Q . 217711Q) (WINDOWDELPROP 217713Q .
220565Q) (GETWINDOWPROP 220567Q . 224526Q) (GETWINDOWUSERPROP 224530Q . 225352Q) (PUTWINDOWPROP
225354Q . 236423Q) (REMWINDOWPROP 236425Q . 237706Q) (WINDOWADDFNPROP 237710Q . 241272Q)) (242004Q
256312Q (OPENWP 242016Q . 242443Q) (RESHAPEBYREPAINTFN 242445Q . 245772Q) (
DECODE/WINDOW/OR/DISPLAYSTREAM 245774Q . 250477Q) (GROW/REGION 250501Q . 252064Q) (ONWINDOWCHAIN
252066Q . 252560Q) (PPROMPT3 252562Q . 253347Q) (CLRPROMPT 253351Q . 254001Q) (PROMPTPRINT 254003Q .
254415Q) (OPENWINDOWS 254417Q . 255310Q) (\INSUREWINDOW 255312Q . 256310Q)) (256623Q 263457Q (
OVERLAPPINGWINDOWS 256635Q . 262037Q) (WOVERLAPP 262041Q . 262522Q) (ORDERFROMBOTTOMTOTOP 262524Q .
263455Q)) (263534Q 274154Q (\ONSCREENW 263546Q . 265012Q) (\PUTONSCREENW 265014Q . 266021Q) (
\UPDATECACHEDFIELDS 266023Q . 266527Q) (\WWCHANGESCREENSIZE 266531Q . 270771Q) (CREATEWFROMIMAGE
270773Q . 272570Q) (UPDATEWFROMIMAGE 272572Q . 274152Q)) (274613Q 370224Q (SCROLLW 274625Q . 275556Q)
(SCROLLBYREPAINTFN 275560Q . 313453Q) (ADJUSTOFFSETS 313455Q . 314236Q) (CREATESCROLLINGW 314240Q .
314565Q) (IN/SCROLL/BAR? 314567Q . 315426Q) (RELDSPXOFFSET 315430Q . 315731Q) (RELDSPYOFFSET 315733Q
. 316234Q) (SCROLL.HANDLER 316236Q . 332372Q) (\SCROLL.HANDLER.DOIT 332374Q . 335333Q) (
\UPDATE.EXTENT.IMAGE 335335Q . 343517Q) (EXTENDPASTHORIZBOUNDARIES 343521Q . 344446Q) (REDISPLAYW
344450Q . 347325Q) (FILLWITHBACKGROUND 347327Q . 350122Q) (UPDATE/SCROLL/REG 350124Q . 353310Q) (
WTODSX 353312Q . 354176Q) (WTODSY 354200Q . 355066Q) (WXOFFSET 355070Q . 356723Q) (WYOFFSET 356725Q .
360564Q) (BITMAPSCROLLFN 360566Q . 361241Q) (SCROLLBITMAP 361243Q . 363252Q) (REDISPLAYBITMAP 363254Q
. 364346Q) (ULREDISPLAYBITMAP 364350Q . 365632Q) (EXTENDEXTENT 365634Q . 366622Q) (WIDTHIFWINDOW
366624Q . 367334Q) (HEIGHTIFWINDOW 367336Q . 370222Q)) (370260Q 412216Q (SHRINKW 370272Q . 402455Q) (
EXPANDW 402457Q . 404637Q) (DOICONWINDOWCOM 404641Q . 406401Q) (CLOSEMAINWINDOW 406403Q . 410630Q) (
CLOSEICONWINDOW 410632Q . 412214Q)))))
STOP