(FILECREATED "17-Jan-84 14:01:46" {PHYLUM}<LISPCORE>SOURCES>WINDOW.;180 153972
changes to: (FNS SHAPEW \MAKEICONWINDOW CREATEWFROMIMAGE \TITLEICONMINSIZE)
(VARS WINDOWCOMS)
previous date: "13-Jan-84 10:51:35" {PHYLUM}<LISPCORE>SOURCES>WINDOW.;179)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT WINDOWCOMS)
(RPAQQ WINDOWCOMS [(COMS (FNS WINDOWWORLD WINDOWWORLDP CHANGEBACKGROUND CHANGEBACKGROUNDBORDER TILE
LOGOW \DRAWLOGOWINDOWIMAGE \TTY.CREATING.DISPLAYSTREAM
\CREATE.TTY.OUTCHARFN \CREATE.TTYDISPLAYSTREAM HASTTYWINDOWP
TTYINFOSTREAM)
(VARS (\TTYREGIONOFFSETSPTR))
[INITVARS [TTYREGIONOFFSETS (QUOTE ((0 . 0)
(20 . -20)
(40 . 0)
(20 . 20]
(DEFAULTTTYREGION (QUOTE (153 100 384 208]
(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 \ONSCREENCLIPPINGREGION RELMOVEW PAINTW
PAINTW.READBRUSHSHADE PAINTW.READMODE PAINTW.READBRUSHSHAPE PAINTW.READBRUSHSIZE
SHAPEW SHAPEW1 RESHOWBORDER \RESHOWBORDER1 TRACKW SNAPW WINDOWREGION)
(FNS MINIMUMWINDOWSIZE))
[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)
(* for compiling windowprops.)
(PROP ARGNAMES WINDOWPROP)
(MACROS WINDOWPROP)
(FNS CWINDOWPROP CGETWINDOWPROP))
[COMS (FNS OPENWP RESHAPEBYREPAINTFN DECODE/WINDOW/OR/DISPLAYSTREAM GROW/REGION 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)
(* this function should be on LLDISPLAY but Ron has it checked out. Move it later -
rrb.)
(FNS \DSPUNTRANSFORMREGION))
(COMS (* icon functions)
(FNS SHRINKW \MAKEICONWINDOW \TITLEICONMINSIZE \NOTENEWICONPOSITION 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 26)
(MinWindowHeight 16))
(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 34850)
(WBorder 4)
(SCROLLBARWIDTH 24)
(SCROLLWAITTIME 100)
(WAITBEFORESCROLLTIME 750)
(WAITBETWEENSCROLLTIME 100)
(PAINTCOMMANDBRUSH (QUOTE (ROUND 2)))
(PAINTCOMMANDMODE (QUOTE PAINT))
(PAINTCOMMANDMENU)
(PAINTCOMMANDSHADE BLACKSHADE)
(PAINTSIZEMENU)
(PAINTSHAPEMENU)
(PAINTSHADEMENU)
(PAINTMODEMENU)
(HIGHLIGHTSHADE 32800))
(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 "12-Jan-84 14:33")
(* 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 (DISPLAYSTREAMP WindowTitleDisplayStream))
(SETQ WindowTitleDisplayStream (DSPCREATE))
(DSPOPERATION (QUOTE INVERT)
WindowTitleDisplayStream)
(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 ← 8
BOTTOM ← 378
WIDTH ← 550
HEIGHT ← 333)
(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 NIL
(SETQ PROMPTWINDOW (CREATEW (create REGION
LEFT ←(IDIFFERENCE (FOLDLO SCREENWIDTH 2)
275)
BOTTOM ←(IDIFFERENCE SCREENHEIGHT 76)
WIDTH ← 550
HEIGHT ←(HEIGHTIFWINDOW 60 T 2))
"Prompt Window" 2))
(DSPTEXTURE BLACKSHADE PROMPTWINDOW)
(DSPOPERATION (QUOTE ERASE)
PROMPTWINDOW)
(DSPSCROLL (QUOTE ON)
PROMPTWINDOW)
(WINDOWPROP PROMPTWINDOW (QUOTE SHRINKFN)
(QUOTE DON'T))
(CLEARW PROMPTWINDOW) (* set it so that PROMPTWINDOW doesn't hold.)
(WINDOWPROP PROMPTWINDOW (QUOTE PAGEFULLFN)
(FUNCTION NILL)))
(SETQ LOGOW (LOGOW "Interlisp-D" (create POSITION
XCOORD ← 594
YCOORD ← 548)))
[WINDOWPROP LOGOW (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (W) (* clear the variable so that it will be collected.)
(SETQ LOGOW NIL] (* attach the current line buffer to the top level
window.)
(WINDOWPROP (SETQ \TopLevelTtyWindow (CREATEW (TTYDISPLAYSTREAM)
"Top level typescript window"))
(QUOTE \LINEBUF.OFD)
(OR \LINEBUF.OFD (\CREATELINEBUFFER))))
(* 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) (* rmk: "26-AUG-83 14:10")
(* 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))
(RETURN (PROG1 CURRENTBACKGROUNDSHADE (SETQ CURRENTBACKGROUNDSHADE SHADE)
[COND
((TEXTUREP SHADE)
(CLEAR (SCREENBITMAP)
SHADE))
((BITMAPP SHADE)
(TILE SHADE (SCREENBITMAP]
(for W in OPENWINDOWS do (\OPENW1 W])
(CHANGEBACKGROUNDBORDER
[LAMBDA (SHADE) (* bvm: "27-OCT-83 15:02")
(* Changes the screen border on a Dandelion.
SHADE is a 8x2 pattern)
(SELECTC \MACHINETYPE
(\DANDELION (PROG1 (fetch DLDISPBORDER of \IOPAGE)
(replace DLDISPBORDER of \IOPAGE with SHADE)))
0])
(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 (* rmk: "27-AUG-83 13:41")
(* 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]
(replace OUTCHARFN of DS with (FUNCTION \CREATE.TTY.OUTCHARFN))
(replace FULLFILENAME of DS with T)
(RETURN DS])
(\CREATE.TTY.OUTCHARFN
[LAMBDA (STREAM CHAR) (* rmk: "26-AUG-83 12:25")
(* 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 (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])
(TTYINFOSTREAM
[LAMBDA (PROCESS) (* bvm: "12-NOV-83 22:55")
(* * Returns a stream to which to print informative messages = TtyDisplayStream if PROCESS has one, else
PROMPTWINDOW)
(DECLARE (GLOBALVARS \DEFAULTTTYDISPLAYSTREAM))
(PROG [(STREAM (COND
((NULL PROCESS)
TtyDisplayStream)
(T (PROCESS.TTY PROCESS]
(RETURN (COND
((AND STREAM (NEQ STREAM \DEFAULTTTYDISPLAYSTREAM))
STREAM)
(T (\GETSTREAM PROMPTWINDOW])
)
(RPAQQ \TTYREGIONOFFSETSPTR NIL)
(RPAQ? TTYREGIONOFFSETS (QUOTE ((0 . 0)
(20 . -20)
(40 . 0)
(20 . 20))))
(RPAQ? DEFAULTTTYREGION (QUOTE (153 100 384 208)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \TTYREGIONOFFSETSPTR TTYREGIONOFFSETS)
)
(* Window menu operations)
(DEFINEQ
(WINDOW.MOUSE.HANDLER
[LAMBDA NIL (* rrb "28-OCT-83 09:59")
(* * 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)))
(ERSETQ (APPLY* \MHCOM \LastInWindow]
[COND
((AND \MHWINDOW (SETQ \MHCOM (fetch CURSORINFN
of \MHWINDOW)))
(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.)
(DOWINDOWCOM \MHWINDOW)
(* this attempts to prevent the cursorout fn and
scrolling fns from being called if the \LastInWindow was
closed.)
(OR (OPENWP \LastInWindow)
(SETQ \LastInWindow NIL)))
(\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 "15-Dec-83 17:55")
(* the button handler for the window system.)
(COND
[(type? WINDOW WINDOW)
(PROG ($$VAR)
(COND
((SETQ $$VAR (WINDOWPROP WINDOW (QUOTE DOWINDOWCOMFN)))
(RETURN (APPLY* $$VAR WINDOW)))
(T (TOTOPW WINDOW)
(RETURN (COND
([SETQ $$VAR
(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* $$VAR 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) (* rrb "26-OCT-83 14:43")
(* 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 (WINDOW 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 (QUOTE CLOSED])
(\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) (* rrb "26-OCT-83 14:42")
(UNINTERRUPTABLY
(replace (WINDOW 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.)
(* Assume that the DSP of a window is guaranteed to be a
display-stream)
(\SW2BM (fetch DDDestination of (fetch IMAGEDATA of \TOPWDS))
(fetch (WINDOW REG) of WINDOW)
(fetch (WINDOW SAVE) of WINDOW)
NIL))])
(CREATEW
[LAMBDA (REGION TITLE BORDERSIZE NOOPENFLG) (* rrb "27-OCT-83 11:15")
(PROG (REG DSP DISPLAYDATA (TITLEHEIGHT (COND
(TITLE (IMINUS (DSPLINEFEED NIL
WindowTitleDisplayStream)))
(T 0)))
WINDOW
(WBORDER (OR (NUMBERP BORDERSIZE)
WBorder)))
[COND
[(AND (DISPLAYSTREAMP REGION)
(EQ (SCREENBITMAP)
(DSPDESTINATION NIL DSP)))
(SETQ DSP REGION)
(SETQ DISPLAYDATA (fetch IMAGEDATA of DSP))
(SETQ REG (ffetch DDClippingRegion of DISPLAYDATA))
(* adjust region by offsets and reduce to size screen.
(destination bitmap.))
(SETQ REG (create REGION
LEFT ←(IDIFFERENCE (IMAX (IPLUS (fetch DDXOFFSET of DISPLAYDATA)
(fetch (REGION LEFT) of REG))
0)
WBORDER)
BOTTOM ←(IDIFFERENCE (IMAX (IPLUS (ffetch DDYOFFSET of DISPLAYDATA)
(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 REGION) (* Copy so that smash-happy user won't clobber the
window system smashing the region he gives us.)
(create REGION using REGION))
(T (AND TITLE (printout PROMPTWINDOW T "Specify region for window %"" TITLE "%""))
(PROG1 (GETREGION MinWindowWidth MinWindowHeight)
(AND TITLE (CLRPROMPT]
(SETQ DSP (DSPCREATE))
(SETQ DISPLAYDATA (fetch IMAGEDATA of DSP]
(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
NEXTW ←(QUOTE CLOSED)))
(replace XWINDOWHINT of DISPLAYDATA with WINDOW)
(ADVISEWDS WINDOW)
(MOVETOUPPERLEFT WINDOW)
(SHOWWFRAME WINDOW)
(COND
((NOT NOOPENFLG)
(OPENW WINDOW)))
(RETURN WINDOW])
(MOVEW
[LAMBDA (WINDOW POSorX Y) (* rrb "26-OCT-83 18:13")
(* 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 OLDLEFT OLDBOTTOM OLDWIDTH OLDHEIGHT OLDCLIPREGION LFT BTM REG FN)
(COND
([COND
((LISTP USERMOVEFN)
(FMEMB (QUOTE DON'T)
USERMOVEFN))
(T (EQ USERMOVEFN (QUOTE DON'T]
(PROMPTPRINT "Can't move this window.")
(RETURN)))
[COND
((NOT (SUBREGIONP OLDREGION WHOLEDISPLAY))
(SETQ OLDCLIPREGION (\ONSCREENCLIPPINGREGION WINDOW]
(SETQ OLDLEFT (fetch (REGION LEFT) of OLDREGION))
(SETQ OLDBOTTOM (fetch (REGION BOTTOM) of OLDREGION))
(SETQ OLDWIDTH (fetch (REGION WIDTH) of OLDREGION))
(SETQ OLDHEIGHT (fetch (REGION HEIGHT) of OLDREGION))
(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.)
[COND
[(AND (SETQ FN (WINDOWPROP WINDOW (QUOTE CALCULATEREGIONFN)))
(SETQ REG (APPLY* FN WINDOW))) (* prompt with a region that is calculated by the
window)
[SETQ POS (GETBOXPOSITION (fetch (REGION WIDTH) of REG)
(fetch (REGION HEIGHT) of REG)
(SETQ LFT (fetch (REGION LEFT) of REG))
(SETQ BTM (fetch (REGION BOTTOM) of REG]
(* use a position that is offset by the same amount as
the calculated region was from the window's region.)
(SETQ POS (create POSITION
XCOORD ←(IPLUS (fetch (POSITION XCOORD) of POS)
(IDIFFERENCE OLDLEFT LFT))
YCOORD ←(IPLUS (fetch (POSITION YCOORD) of POS)
(IDIFFERENCE OLDBOTTOM BTM]
(T (SETQ POS (GETBOXPOSITION OLDWIDTH OLDHEIGHT OLDLEFT OLDBOTTOM]
(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)
OLDLEFT)
(NEQ (fetch YCOORD of POS)
OLDBOTTOM))
(SETQ NEWREGION (create REGION
LEFT ←(fetch (POSITION XCOORD) of POS)
BOTTOM ←(fetch (POSITION YCOORD) of POS)
WIDTH ← OLDWIDTH
HEIGHT ← OLDHEIGHT))
(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))
[COND
((AND (WINDOWPROP WINDOW (QUOTE REPAINTFN))
OLDCLIPREGION) (* redisplay those parts that were off the screen.)
[PROG ((NEWCLIPPINGREGION (\ONSCREENCLIPPINGREGION WINDOW))
NCL OCL NCB OCB OCR NCR OCW NCW OCH NCH OCT NCT)
(* the title may be the only thing now on the screen.)
(OR NEWCLIPPINGREGION (RETURN))
(SETQ NCB (fetch (REGION BOTTOM) of NEWCLIPPINGREGION))
(SETQ OCB (fetch (REGION BOTTOM) of OLDCLIPREGION))
(SETQ OCW (fetch (REGION WIDTH) of OLDCLIPREGION))
(SETQ NCW (fetch (REGION WIDTH) of NEWCLIPPINGREGION))
(SETQ OCH (fetch (REGION HEIGHT) of OLDCLIPREGION))
(SETQ NCH (fetch (REGION HEIGHT) of NEWCLIPPINGREGION))
[COND
((ILESSP (SETQ NCL (fetch (REGION LEFT) of NEWCLIPPINGREGION))
(SETQ OCL (fetch (REGION LEFT) of OLDCLIPREGION)))
(REDISPLAYW WINDOW (CREATEREGION NCL OCB (IDIFFERENCE OCL NCL)
OCH]
[COND
((ILESSP (SETQ OCR (IPLUS OCL OCW))
(SETQ NCR (IPLUS NCL NCW)))
(* some stuff appeared from the right.)
(REDISPLAYW WINDOW (CREATEREGION OCR OCB (IDIFFERENCE NCR OCR)
OCH]
[COND
((ILESSP NCB OCB)
(REDISPLAYW WINDOW (CREATEREGION NCL NCB NCW (IDIFFERENCE OCB NCB]
(COND
((ILESSP (SETQ OCT (IPLUS OCB OCH))
(SETQ NCT (IPLUS NCB NCH)))
(* some stuff appeared from the top)
(REDISPLAYW WINDOW (CREATEREGION NCL OCT NCW (IDIFFERENCE NCT OCT]
(COND
((IGREATERP (IPLUS OLDBOTTOM OLDHEIGHT)
SCREENHEIGHT) (* should reshow the title but don't have any entry for
that.)
NIL]
(DOUSERFNS (WINDOWPROP WINDOW (QUOTE AFTERMOVEFN))
WINDOW)))
(RETURN POS])
(\ONSCREENCLIPPINGREGION
[LAMBDA (WIN) (* rmk: "30-AUG-83 13:20")
(* returns a region which is the part of the windows
clipping region that is on the screen.)
(INTERSECTREGIONS (DSPCLIPPINGREGION NIL WIN)
(\DSPUNTRANSFORMREGION WHOLEDISPLAY (fetch IMAGEDATA
of (WINDOWPROP WIN (QUOTE DSP])
(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])
(PAINTW
[LAMBDA (WINDOW) (* rrb "18-OCT-83 18:37")
(* 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) (* look for a previously stored brush.)
[COND
((SETQ BRUSH (WINDOWPROP WINDOW (QUOTE PAINTBRUSH)))
(SETQ PAINTCOMMANDMODE (CAR BRUSH))
(SETQ PAINTCOMMANDSHADE (CADR BRUSH))
(SETQ PAINTCOMMANDBRUSH (CADDR BRUSH]
(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
((OR (INSIDE? (DSPCLIPPINGREGION NIL DS)
(LASTMOUSEX DS)
(LASTMOUSEY DS))
(NOT (WHICHW LASTMOUSEX LASTMOUSEY)))
(* 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))
(CLRPROMPT)
(WINDOWPROP WINDOW (QUOTE PAINTBRUSH)
(LIST PAINTCOMMANDMODE PAINTCOMMANDSHADE (COPY PAINTCOMMANDBRUSH])
(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 "17-Jan-84 11:57")
(* entry that shapes a window checking the userfns for DON'T and interacting to get a region if necessary.
This also checks for a user function to do the actual reshaping.)
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(PROG (USERFN X)
(COND
((\USERFNISDON'T (fetch (WINDOW RESHAPEFN) of WINDOW))
(* don't allow the window to be reshaped.)
(PROMPTPRINT "This window cannot be reshaped.")
(RETURN NIL)))
(SETQ X (MINIMUMWINDOWSIZE WINDOW))
[SETQ X (COND
(NEWREGION (COND
[(OR (LESSP (fetch (REGION WIDTH) of NEWREGION)
(CAR X))
(LESSP (fetch (REGION HEIGHT) of NEWREGION)
(CDR X))) (* given a region that is too small)
(CREATEREGION (fetch (REGION LEFT) of NEWREGION)
(fetch (REGION BOTTOM) of NEWREGION)
(IMAX (fetch (REGION WIDTH) of NEWREGION)
(CAR X))
(IMAX (fetch (REGION HEIGHT) of NEWREGION)
(CDR X]
(T NEWREGION)))
(T (GETREGION (CAR X)
(CDR X)
(WINDOWREGION WINDOW)
(fetch NEWREGIONFN of WINDOW)
WINDOW]
(RETURN (COND
((SETQ USERFN (WINDOWPROP WINDOW (QUOTE DOSHAPEFN)))
(APPLY* USERFN WINDOW X))
(T (SHAPEW1 WINDOW X])
(SHAPEW1
[LAMBDA (WINDOW REGION) (* rrb "18-NOV-83 15:40")
(* entry for shaping a window that does the reshape
without checking for a user function.)
(DECLARE (LOCALVARS . T))
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(OR (REGIONP REGION)
(\ILLEGAL.ARG REGION))
(PROG ((OLDREGION (fetch REG of WINDOW))
(OLDCLIPREG (DSPCLIPPINGREGION NIL (fetch (WINDOW DSP) of WINDOW)))
(WBORDER (fetch WBORDER of WINDOW))
NUSAV NOWOPEN?)
(SETQ NUSAV (BITMAPCREATE (fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION)))
(UNINTERRUPTABLY
(COND
((OPENWP WINDOW) (* notice whether window is open or not to call OPENFNs
only if not now open.)
(SETQ NOWOPEN? T)
(\CLOSEW1 WINDOW))) (* Save window image)
(replace REG of WINDOW with REGION)
[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 (fetch (WINDOW RESHAPEFN) of WINDOW)
(FUNCTION RESHAPEBYREPAINTFN))
WINDOW NUSAV (create REGION
LEFT ← WBORDER
BOTTOM ← WBORDER
WIDTH ←(fetch (REGION WIDTH) of OLDCLIPREG)
HEIGHT ←(fetch (REGION HEIGHT) of OLDCLIPREG)))
(RETURN WINDOW])
(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 " 9-Dec-83 15:29")
(* makes a new window which is a copy of the bits
underneath the REGION read from the user.)
(PROG ((REG (GETREGION 30 20))
NEWWINDOW)
(OR (type? REGION REG)
(HELP "Not a region" REG))
(SETQ NEWWINDOW (CREATEW (GROW/REGION REG WBorder)
NIL NIL T)) (* keep it closed so it doesn't cover any of the bits it
is to copy.)
(* put existing screen bits from SAVE.)
(BITBLT (SCREENBITMAP)
(fetch (REGION LEFT) of REG)
(fetch (REGION BOTTOM) of REG)
(fetch SAVE of NEWWINDOW)
WBorder WBorder (fetch (REGION WIDTH) of REG)
(fetch (REGION HEIGHT) of REG)
(QUOTE INPUT)
(QUOTE REPLACE))
(OPENW NEWWINDOW)
(MOVEW NEWWINDOW)
(RETURN NEWWINDOW])
(WINDOWREGION
[LAMBDA (WINDOW) (* rrb "27-OCT-83 15:24")
(* gets the region that a window wants to consider to be
its.)
(PROG (FN)
(RETURN (COND
((SETQ FN (WINDOWPROP WINDOW (QUOTE CALCULATEREGIONFN)))
(APPLY* FN WINDOW))
(T (WINDOWPROP WINDOW (QUOTE REGION])
)
(DEFINEQ
(MINIMUMWINDOWSIZE
[LAMBDA (WINDOW) (* rrb "20-NOV-83 12:06")
(* returns the minimum extent of a window)
(PROG [(EXT (WINDOWPROP WINDOW (QUOTE MINSIZE]
[COND
[(NULL EXT)
(SETQ EXT (CONS MinWindowWidth (HEIGHTIFWINDOW (FONTPROP WINDOW (QUOTE HEIGHT))
(WINDOWPROP WINDOW (QUOTE TITLE]
((LITATOM EXT)
(SETQ EXT (APPLY* EXT WINDOW]
[COND
[(AND (NUMBERP (CAR EXT))
(NUMBERP (CDR EXT]
(T (SETQ EXT (ERROR "Illegal extent property" EXT]
(RETURN EXT])
)
(* Window utilities)
(DEFINEQ
(ADVISEWDS
[LAMBDA (WINDOW OLDREG MOVEONLYFLG) (* rrb "19-OCT-83 13:18")
(DECLARE (LOCALVARS . T))
(* called whenever the dimensions of a guaranteed 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) (* if the previous right margin was the default, change
it.)
(AND (OR (NOT OLDREG)
(EQ (DSPRIGHTMARGIN NIL D)
(IDIFFERENCE (fetch (REGION WIDTH) of OLDREG)
TWICEBORDER)))
(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) (* rrb "26-OCT-83 14:56")
(COND
[(fetch (WINDOW 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 (WINDOW NEXTW) of WS)) (* doesn't have to be uninterruptable here because
TOTOPW is.)
(replace (WINDOW NEXTW) of WS with (fetch (WINDOW NEXTW) of WINDOW))
(replace (WINDOW NEXTW) of WINDOW with TOPW)
(SETQ TOPW WINDOW)
(SETQ \TOPWDS (fetch (WINDOW DSP) of WINDOW)))
(T (\TTW1 WINDOW (fetch (WINDOW 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 "26-OCT-83 14:56")
(COND
((POSITIONP X)
(WHICHW (fetch (POSITION XCOORD) of X)
(fetch (POSITION YCOORD) of X)))
(T (for (WINDOW ← TOPW) by (fetch (WINDOW 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 "26-OCT-83 14:57")
(* Finds or creates a window for a display stream)
(* uses an XPointer from the displaystream as a hint.
This means that the window might have been garbage
collected, hence all the confirmation.)
(DECLARE (GLOBALVARS \DEFAULTTTYDISPLAYSTREAM))
(PROG (HINTW (DD (\GETDISPLAYDATA DS DS)))
(COND
((AND (SETQ HINTW (ffetch XWINDOWHINT of DD))
(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 DDDestination of DD)
(SCREENBITMAP)) (* for now color display streams don't have windows
associated with them.)
(RETURN NIL))
([SETQ HINTW (for (WINDOW ← TOPW) by (fetch (WINDOW 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 "28-OCT-83 10:15")
(* gets values from a window.
Called by the macro for WINDOWPROP.)
[OR (type? WINDOW WINDOW)
(COND
((DISPLAYSTREAMP (\OUTSTREAMARG 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 EXTENT) of WINDOW))
(REPAINTFN (fetch (WINDOW REPAINTFN) 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 "28-OCT-83 11:00")
(* 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 (WINDOW USERDATA) of (\INSUREWINDOW WINDOW))
USERPROP])
(PUTWINDOWPROP
[LAMBDA (WINDOW PROP VALUE) (* rrb "28-OCT-83 10:15")
[OR (type? WINDOW WINDOW)
(COND
((DISPLAYSTREAMP (\OUTSTREAMARG 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 REPAINTFN) of WINDOW)
(replace (WINDOW REPAINTFN) of WINDOW with VALUE)))
(EXTENT (PROG1 (fetch (WINDOW EXTENT) of WINDOW)
(OR (NULL VALUE)
(REGIONP VALUE)
(\ILLEGAL.ARG VALUE))
(replace (WINDOW EXTENT) 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) (* rmk: "31-AUG-83 16:42")
[OR (type? WINDOW WINDOW)
(COND
((DISPLAYSTREAMP (\OUTSTREAMARG 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])
)
(* for compiling windowprops.)
(PUTPROPS WINDOWPROP ARGNAMES (NIL (WINDOW PROP {NEWVALUE}) . U))
(DECLARE: EVAL@COMPILE
(PUTPROPS WINDOWPROP MACRO (ARGS (CWINDOWPROP ARGS)))
)
(DEFINEQ
(CWINDOWPROP
[LAMBDA (FORMTAIL) (* rrb "28-OCT-83 10:51")
(* compiles calls to WINDOWPROP)
(COND
((NULL (CDR FORMTAIL)) (* less that 2 args)
(printout T "Possible error in call to WINDOWPROP: less than 2 args" T (LIST (QUOTE
WINDOWPROP)
FORMTAIL)
T)
(CGETWINDOWPROP (CAR FORMTAIL)
NIL))
((NOT (EQ (CAADR FORMTAIL)
(QUOTE QUOTE))) (* property is not quoted.)
(QUOTE IGNOREMACRO))
[(NULL (CDDR FORMTAIL)) (* fetching a window property.)
(CGETWINDOWPROP (CAR FORMTAIL)
(CADR (CADR FORMTAIL]
(T (* storing a window property)
(CONS (QUOTE PUTWINDOWPROP)
FORMTAIL])
(CGETWINDOWPROP
[LAMBDA (WINFORM PROP) (* rrb "28-OCT-83 16:30")
(* compiles calls on WINDOWPROP that are fetching
values. This needs to be changed whenever GETWINDOWPROP
is changed.)
(PROG NIL
(RETURN (SUBST (LIST (QUOTE \INSUREWINDOW)
WINFORM)
(QUOTE DATUM)
(SELECTQ PROP
[RIGHTBUTTONFN (CONSTANT (RECORDACCESSFORM (QUOTE RIGHTBUTTONFN)
(QUOTE DATUM)
(QUOTE ffetch]
[BUTTONEVENTFN (CONSTANT (RECORDACCESSFORM (QUOTE BUTTONEVENTFN)
(QUOTE DATUM)
(QUOTE ffetch]
[CURSORINFN (CONSTANT (RECORDACCESSFORM (QUOTE CURSORINFN)
(QUOTE DATUM)
(QUOTE ffetch]
[CURSOROUTFN (CONSTANT (RECORDACCESSFORM (QUOTE CURSOROUTFN)
(QUOTE DATUM)
(QUOTE ffetch]
[CURSORMOVEDFN (CONSTANT (RECORDACCESSFORM (QUOTE CURSORMOVEDFN)
(QUOTE DATUM)
(QUOTE ffetch]
[DSP (CONSTANT (RECORDACCESSFORM (QUOTE DSP)
(QUOTE DATUM)
(QUOTE ffetch]
[SCROLLFN (CONSTANT (RECORDACCESSFORM (QUOTE SCROLLFN)
(QUOTE DATUM)
(QUOTE ffetch]
[MOVEFN (CONSTANT (RECORDACCESSFORM (QUOTE MOVEFN)
(QUOTE DATUM)
(QUOTE ffetch]
[RESHAPEFN (CONSTANT (RECORDACCESSFORM (QUOTE RESHAPEFN)
(QUOTE DATUM)
(QUOTE ffetch]
[EXTENT (CONSTANT (RECORDACCESSFORM (QUOTE EXTENT)
(QUOTE DATUM)
(QUOTE ffetch]
[REPAINTFN (CONSTANT (RECORDACCESSFORM (QUOTE REPAINTFN)
(QUOTE DATUM)
(QUOTE ffetch]
[CLOSEFN (CONSTANT (RECORDACCESSFORM (QUOTE CLOSEFN)
(QUOTE DATUM)
(QUOTE ffetch]
[WINDOWENTRYFN (CONSTANT (RECORDACCESSFORM (QUOTE WINDOWENTRYFN)
(QUOTE DATUM)
(QUOTE ffetch]
[PROCESS (CONSTANT (RECORDACCESSFORM (QUOTE PROCESS)
(QUOTE DATUM)
(QUOTE ffetch]
[REGION (CONSTANT (RECORDACCESSFORM (QUOTE REG)
(QUOTE DATUM)
(QUOTE ffetch]
[NEWREGIONFN (CONSTANT (RECORDACCESSFORM (QUOTE NEWREGIONFN)
(QUOTE DATUM)
(QUOTE ffetch]
[TITLE (CONSTANT (RECORDACCESSFORM (QUOTE WTITLE)
(QUOTE DATUM)
(QUOTE ffetch]
[BORDER (CONSTANT (RECORDACCESSFORM (QUOTE WBORDER)
(QUOTE DATUM)
(QUOTE ffetch]
[IMAGECOVERED (CONSTANT (RECORDACCESSFORM (QUOTE SAVE)
(QUOTE DATUM)
(QUOTE ffetch]
[HEIGHT (CONSTANT (RECORDACCESSFORM (QUOTE (REGION HEIGHT))
(LIST (QUOTE DSPCLIPPINGREGION)
NIL
(RECORDACCESSFORM
(QUOTE DSP)
(QUOTE DATUM)
(QUOTE ffetch)))
(QUOTE ffetch]
[WIDTH (CONSTANT (RECORDACCESSFORM (QUOTE (REGION WIDTH))
(LIST (QUOTE DSPCLIPPINGREGION)
NIL
(RECORDACCESSFORM
(QUOTE DSP)
(QUOTE DATUM)
(QUOTE ffetch)))
(QUOTE ffetch]
(RETURN (PROGN (* return around SUBST. GETWINDOWUSERPROP will perform
the window check and this avoids compiling code for it
at every call.)
(LIST (QUOTE GETWINDOWUSERPROP)
WINFORM
(KWOTE PROP])
)
(DEFINEQ
(OPENWP
[LAMBDA (WINDOW) (* rrb "26-OCT-83 15:01")
(* is WINDOW an open window?)
(AND (type? WINDOW WINDOW)
(NEQ (fetch (WINDOW NEXTW) of WINDOW)
(QUOTE CLOSED))
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 (DSORW WINDOWVAR TITLE BORDER) (* rmk: "12-OCT-83 11:31")
(* provides a defaulting mechanism for display-streams that uses windows too. If DSORW is NIL, it uses the value
of WINDOWVAR and if DSORW is NEW, it creates a new one.)
(COND
((DISPLAYSTREAMP DSORW))
((WINDOWP DSORW)
(OPENW DSORW)
(AND TITLE (NOT (EQUAL TITLE (fetch WTITLE of DSORW)))
(WINDOWPROP DSORW (QUOTE TITLE)
TITLE))
(AND BORDER (WINDOWPROP DSORW (QUOTE BORDER)
BORDER))
(fetch DSP of DSORW))
[(NULL DSORW)
(fetch DSP of (PROG ((WINDOW (EVALV WINDOWVAR)))
(RETURN (COND
((WINDOWP WINDOW)
(OPENW WINDOW)
(AND TITLE (NOT (EQUAL TITLE (fetch WTITLE of WINDOW)))
(WINDOWPROP WINDOW (QUOTE TITLE)
TITLE))
(AND BORDER (WINDOWPROP WINDOW (QUOTE BORDER)
BORDER))
WINDOW)
(T (SET WINDOWVAR (CREATEW NIL TITLE BORDER]
[(EQ DSORW (QUOTE NEW))
(fetch DSP of (SET WINDOWVAR (CREATEW NIL TITLE BORDER]
(T (ERROR "Illegal args" (LIST DSORW WINDOWVAR])
(GROW/REGION
[LAMBDA (REGION AMOUNT) (* rrb "19-OCT-83 11:18")
(* increase REGION by amount in all directions)
(CREATEREGION (IDIFFERENCE (fetch (REGION LEFT) of REGION)
AMOUNT)
(IDIFFERENCE (fetch (REGION BOTTOM) of REGION)
AMOUNT)
(IPLUS (fetch (REGION WIDTH) of REGION)
(SETQ AMOUNT (ITIMES AMOUNT 2)))
(IPLUS (fetch (REGION HEIGHT) of REGION)
AMOUNT])
(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) (* rmk: " 1-SEP-83 10:25")
(* coerces to a window)
(COND
((type? WINDOW WINDOW)
WINDOW)
((AND (DISPLAYSTREAMP (\OUTSTREAMARG WINDOW T))
(WFROMDS WINDOW)))
(T (\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 "17-Jan-84 13:51")
(* creates a window that has IMAGE as an image.
It is initially closed and can be opened.)
(PROG ((WINDOW (CREATEW (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ←(BITMAPWIDTH IMAGE)
HEIGHT ←(BITMAPHEIGHT IMAGE))
NIL 0 T)))
[WINDOWPROP WINDOW (QUOTE MINSIZE)
(CONS (IMIN MinWindowWidth (BITMAPWIDTH IMAGE))
(IMIN MinWindowWidth (BITMAPHEIGHT IMAGE]
(BITBLT IMAGE 0 0 (fetch (WINDOW SAVE) of WINDOW))
(RETURN 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) (* rmk: "31-AUG-83 11:56")
(* standard scrolling function that scrolls by blting
existing bits and then calling the windows repaintfn to
repaint the newly exposed bits.)
(PROG ((DSP (WINDOWPROP WINDOW (QUOTE DSP)))
(EXTENT (WINDOWPROP WINDOW (QUOTE EXTENT)))
X CRHEIGHT CRWIDTH CRLEFT CRBOTTOM WHOLEHEIGHT WHOLEWIDTH)
(SETQ X (DSPCLIPPINGREGION NIL DSP))
(SETQ WHOLEWIDTH (fetch (REGION WIDTH) of X))
(SETQ WHOLEHEIGHT (fetch (REGION HEIGHT) of X))
[COND
([NOT (SUBREGIONP WHOLEDISPLAY (WINDOWPROP WINDOW (QUOTE REGION]
(* reduce clipping region to be that part of the window
that is on the screen.)
(SETQ X (INTERSECTREGIONS X (\DSPUNTRANSFORMREGION WHOLEDISPLAY (fetch IMAGEDATA
of DSP]
(SETQ CRLEFT (fetch (REGION LEFT) of X))
(SETQ CRBOTTOM (fetch (REGION BOTTOM) of X))
(SETQ CRWIDTH (fetch (REGION WIDTH) of X))
(SETQ CRHEIGHT (fetch (REGION HEIGHT) of X))
(* 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)
WHOLEWIDTH]
(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 CRLEFT (fetch (REGION LEFT) of EXTENT))
(IMAX (IDIFFERENCE (IPLUS CRLEFT CRWIDTH)
(fetch (REGION PRIGHT) of EXTENT))
XDELTA))) (* make sure it is still not 0)
(NEQ XDELTA 0))
(T T)))
(BITBLT WINDOW CRLEFT CRBOTTOM WINDOW (IPLUS XDELTA CRLEFT)
CRBOTTOM CRWIDTH CRHEIGHT (QUOTE INPUT)
(QUOTE REPLACE))
(WXOFFSET XDELTA DSP)
(SETQ CRLEFT (IDIFFERENCE CRLEFT XDELTA))
(REDISPLAYW WINDOW (COND
((IGREATERP XDELTA 0) (* moving to right, create new region on left for
repaintfn)
(CREATEREGION CRLEFT CRBOTTOM (IMIN XDELTA CRWIDTH)
CRHEIGHT))
(T (* moving to left.)
(CREATEREGION (IMAX (IPLUS CRLEFT CRWIDTH XDELTA)
CRLEFT)
CRBOTTOM
(IMIN (IMINUS XDELTA)
CRWIDTH)
CRHEIGHT)))
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)))
WHOLEHEIGHT)
(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 (SETQ X (PLUS CRBOTTOM CRHEIGHT))
(fetch (REGION PTOP) of EXTENT))
(IMIN (IDIFFERENCE (SUB1 X)
(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 CRLEFT CRBOTTOM WINDOW CRLEFT (IPLUS YDELTA CRBOTTOM)
CRWIDTH CRHEIGHT (QUOTE INPUT)
(QUOTE REPLACE))
(WYOFFSET YDELTA DSP) (* use X as pointer to bottom in scrolled clipping
region.)
(SETQ X (IDIFFERENCE CRBOTTOM YDELTA))
(REDISPLAYW WINDOW [COND
((IGREATERP YDELTA 0) (* moving up.)
(CREATEREGION CRLEFT X CRWIDTH (IMIN YDELTA CRHEIGHT)))
(T (* moving down, fill in top)
(CREATEREGION CRLEFT (IMAX (IPLUS CRHEIGHT X YDELTA)
X)
CRWIDTH
(IMIN (IMINUS YDELTA)
CRHEIGHT]
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 "20-OCT-83 10:24")
(* is X, Y in the scroll bar for WINDOW?)
(AND (fetch SCROLLFN of WINDOW)
(COND
((INSIDE? (fetch (WINDOW VERTSCROLLREG) of WINDOW)
X Y))
((INSIDE? (fetch (WINDOW HORIZSCROLLREG) of WINDOW)
X Y)
(* 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.)
(PROG [(EXTENT (WINDOWPROP WINDOW (QUOTE EXTENT]
(RETURN (COND
((AND EXTENT (NEQ (fetch (REGION WIDTH) of EXTENT)
-1))
(EXTENDPASTHORIZBOUNDARIES (DSPCLIPPINGREGION NIL WINDOW)
EXTENT))
(T T])
(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) (* JonL "17-Dec-83 03:20")
(* cursor has moved into scroll region. region of a window that has a scrollfn and has been IN/SCROLL/BAR? 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? TIMEIN TIMEINTIMER (SCROLLWINDOWTOTOPWAIT 1200))
(* 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 (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.)
(SETQ TIMEIN (SETUPTIMER SCROLLWINDOWTOTOPWAIT))
(RETURN (RESETFORM (CURSOR SCROLLCURSOR)
(PROG NIL
LP (GETMOUSESTATE)
(if (AND TIMEIN (TIMEREXPIRED? TIMEIN))
then (* after a little while, bring the window to the top.
This avoids bringing it up if nothing is happening.)
(SETQ TIMEIN NIL)
(TOTOPW WINDOW))
(if (NOT (OPENWP WINDOW))
then (* the user closed the window, quit.)
(CLOSEW SCROLLW)
(SETQ \LastInWindow NIL)
(RETURN T)
elseif (NOT (INSIDE? SCROLLREG LASTMOUSEX LASTMOUSEY))
then (* 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)) (* bring the scroll window to the top so that it will be
visible.)
(TOTOPW SCROLLW)
(if (LASTMOUSESTATE UP)
then (* no buttons down; if there was one down, take action;
otherwise, wait for one to go down.)
(if BUTTON
then (if CONTINUOUSSCROLL?
then
(* were continuously scrolling, stop it.)
(SETQ CONTINUOUSSCROLL? NIL)
else (\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)
else (BLOCK))
elseif (LASTMOUSESTATE (OR LEFT RIGHT))
then (if (AND (LASTMOUSESTATE LEFT)
(NEQ BUTTON (QUOTE LEFT)))
then (* LEFT button just when down.)
(SETQ BUTTON (QUOTE LEFT))
(SETQ TIMEDOWN (CLOCK 0))
(CURSOR LEFTCURSOR)
elseif (AND (LASTMOUSESTATE RIGHT)
(NEQ BUTTON (QUOTE RIGHT)))
then (* RIGHT button just when down.)
(SETQ BUTTON (QUOTE RIGHT))
(SETQ TIMEDOWN (CLOCK 0))
(CURSOR RIGHTCURSOR)
elseif (AND CONTINUOUSSCROLL? (\CLOCKGREATERP TIMEDOWN
WAITBETWEENSCROLLTIME))
then (* 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)
elseif (\CLOCKGREATERP TIMEDOWN WAITBEFORESCROLLTIME)
then (* has enough time past to start continuous scroll?)
(SETQ CONTINUOUSSCROLL? T))
elseif (LASTMOUSESTATE MIDDLE)
then (if (NEQ BUTTON (QUOTE MIDDLE))
then (* MIDDLE button just when down.)
(SETQ BUTTON (QUOTE MIDDLE))
(* don't keep track of time down for middle buttons.)
(CURSOR MIDDLECURSOR)
else NIL))
(GO LP)))))))
(\SCROLL.HANDLER.DOIT
[LAMBDA (WINDOW BUTTON DIRECTION SCROLLREGION XPOS YPOS CONTINUOUS?)
(* rrb " 5-Dec-83 11:51")
(* decodes how far to scroll given that the button was
let up at position XPOS YPOS in the scroll region
SCROLLREGION.)
(ERSETQ (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) (* rmk: " 1-SEP-83 10:25")
(* 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 (OR (DISPLAYSTREAMP (\OUTSTREAMARG WINDOW))
(\ILLEGAL.ARG 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) (* rmk: "31-AUG-83 16:44")
(* 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 (OR (DISPLAYSTREAMP (\OUTSTREAMARG WINDOW))
(\ILLEGAL.ARG 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])
)
(* this function should be on LLDISPLAY but Ron has it checked out. Move it later - rrb.)
(DEFINEQ
(\DSPUNTRANSFORMREGION
[LAMBDA (REGION DISPLAYDATA) (* rmk: "30-AUG-83 13:19")
(* translates a region from destination coordinates into
display stream coordinates.)
(CREATEREGION (\DSPUNTRANSFORMX (fetch (REGION LEFT) of REGION)
DISPLAYDATA)
(\DSPUNTRANSFORMY (fetch (REGION BOTTOM) of REGION)
DISPLAYDATA)
(fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION])
)
(* icon functions)
(DEFINEQ
(SHRINKW
[LAMBDA (WINDOW TOWHAT ICONPOSITION EXPANDFN) (* rrb "13-Jan-84 10:43")
(* 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.)
(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.)
(RETURN NIL)))
[SETQ ICONW (COND
((type? BITMAP TOWHAT) (* use bitMap to create a WINDOW)
(* save the icon on the window so that next time it will
shrink to the same thing.)
(WINDOWPROP WINDOW (QUOTE ICON)
TOWHAT)
[WINDOWPROP WINDOW (QUOTE ICON)
(SETQ ICONW (CREATEWFROMIMAGE (BITMAPCOPY TOWHAT]
ICONW)
((WINDOWP TOWHAT) (* use given WINDOW as icon)
(OR (POSITIONP ICONPOSITION)
(SETQ ICONPOSITION (QUOTE SAME))) (* save the icon on the window so that next time it will
shrink to the same thing.)
(WINDOWPROP WINDOW (QUOTE ICON)
TOWHAT)
TOWHAT)
((STRINGP TOWHAT)
(\MAKEICONWINDOW TOWHAT))
(T (* current call doesn't specify an icon window.
Look for something on the window.)
[SETQ TOWHAT (COND
[(SETQ FN (WINDOWPROP WINDOW (QUOTE ICONFN)))
(* User fn to create an icon.
Can return cached value)
(APPLY* FN WINDOW (WINDOWPROP WINDOW (QUOTE ICONWINDOW]
(T (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 (\MAKEICONWINDOW (OR TOWHAT (WINDOWPROP WINDOW (QUOTE TITLE))
(CONCAT "Icon made " (DATE]
(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))
(WINDOWADDFNPROP ICONW (QUOTE MOVEFN)
(QUOTE \NOTENEWICONPOSITION))
(AND EXPANDFN (WINDOWADDFNPROP WINDOW (QUOTE EXPANDFN)
EXPANDFN))
(WINDOWPROP ICONW (QUOTE DOWINDOWCOMFN)
(QUOTE DOICONWINDOWCOM))
[OR (EQ ICONPOSITION (QUOTE SAME))
(MOVEW ICONW (COND
((POSITIONP ICONPOSITION)
(WINDOWPROP ICONW (QUOTE ICONPOSITION)
ICONPOSITION)
ICONPOSITION)
[(POSITIONP (WINDOWPROP WINDOW (QUOTE 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)))
(IMAX 0 (fetch (REGION LEFT) of WREG)))
(T (IDIFFERENCE (IMIN SCREENWIDTH
(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)))
(IMAX 0 (fetch (REGION BOTTOM) of WREG)))
(T (IDIFFERENCE (IMIN SCREENHEIGHT
(fetch (REGION PTOP)
of WREG))
(fetch (REGION HEIGHT)
of ICONREG]
(\CLOSEW1 WINDOW)
(OPENW ICONW)
(RETURN ICONW])
(\MAKEICONWINDOW
[LAMBDA (ICONTEXT) (* rrb "17-Jan-84 13:56")
(* returns an icon window with the text ICONTEXT as its
label.)
(PROG ((W (CREATEW (create REGION
LEFT ← LASTMOUSEX
BOTTOM ← LASTMOUSEY
HEIGHT ←(IMINUS (DSPLINEFEED NIL WindowTitleDisplayStream))
WIDTH ←(IPLUS 8 (STRINGWIDTH ICONTEXT WindowTitleDisplayStream)))
ICONTEXT NIL T)))
(WINDOWPROP W (QUOTE MINSIZE)
(FUNCTION \TITLEICONMINSIZE))
(RETURN W])
(\TITLEICONMINSIZE
[LAMBDA (WINDOW) (* rrb "17-Jan-84 13:56")
(* returns the minimum size the default icon can be.)
(CONS MinWindowWidth (IMINUS (DSPLINEFEED NIL WindowTitleDisplayStream])
(\NOTENEWICONPOSITION
[LAMBDA (ICONW NEWPOS) (* rrb "13-Jan-84 10:39")
(* saves the new position of the icon on the property
list so that the icon will come up there again.)
(AND (SETQ ICONW (WINDOWPROP ICONW (QUOTE ICONFOR)))
(WINDOWPROP ICONW (QUOTE ICONPOSITION)
NEWPOS))
NEWPOS])
(EXPANDW
[LAMBDA (ICONW) (* rrb "24-Dec-83 13:01")
(* expands an icon window into its main window.)
(PROG ((IW ICONW)
MAINWINDOW USEREXPANDFN)
(COND
[(SETQ MAINWINDOW (WINDOWPROP IW (QUOTE ICONFOR]
((SETQ IW (WINDOWPROP IW (QUOTE ICONWINDOW))) (* user has passed in the window to expand, not its
icon.)
(SETQ MAINWINDOW ICONW)))
(COND
([AND MAINWINDOW (NULL (\USERFNISDON'T (SETQ USEREXPANDFN (WINDOWPROP MAINWINDOW
(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 IW)
(WINDOWDELPROP MAINWINDOW (QUOTE OPENFN)
(QUOTE CLOSEICONWINDOW))
(WINDOWDELPROP IW (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 IW (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 15))
(16 16
"@A@@"
"@CH@"
"@CH@"
"@GL@"
"@GL@"
"@ON@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@ON@"
"@GL@"
"@GL@"
"@CH@"
"@CH@"
"@A@@")(RPAQ ScrollUpCursor (CURSORCREATE (READBITMAP) 7 15))
(16 16
"@A@@"
"@CH@"
"@CH@"
"@GL@"
"@GL@"
"@ON@"
"@ON@"
"AOO@"
"AOO@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@")(RPAQ ScrollDownCursor (CURSORCREATE (READBITMAP) 7 15))
(16 16
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"AOO@"
"AOO@"
"@ON@"
"@ON@"
"@GL@"
"@GL@"
"@CH@"
"@CH@"
"@A@@")(RPAQ HorizScrollCursor (CURSORCREATE (READBITMAP) 7 5))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@HB@"
"AHC@"
"CHCH"
"GHCL"
"OOON"
"OOON"
"GHCL"
"CHCH"
"AHC@"
"@HB@")(RPAQ ScrollLeftCursor (CURSORCREATE (READBITMAP) 8 5))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@H@"
"@CH@"
"@OH@"
"COH@"
"OOOO"
"OOOO"
"COH@"
"@OH@"
"@CH@"
"@@H@")(RPAQ ScrollRightCursor (CURSORCREATE (READBITMAP) 7 5))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@A@@"
"@AL@"
"@AO@"
"@AOL"
"OOOO"
"OOOO"
"@AOL"
"@AO@"
"@AL@"
"@A@@")(RPAQ VertThumbCursor (CURSORCREATE (READBITMAP) 6 8))
(16 16
"@@@@"
"OH@@"
"@@@@"
"OO@@"
"@@@@"
"OON@"
"@@@@"
"OOOH"
"@@@@"
"OON@"
"@@@@"
"OO@@"
"@@@@"
"OH@@"
"@@@@"
"@@@@")(RPAQ HorizThumbCursor (CURSORCREATE (READBITMAP) 6 6))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@B@@"
"@B@@"
"@JH@"
"@JH@"
"@JH@"
"BJJ@"
"BJJ@"
"BJJ@"
"JJJH"
"JJJH"
"JJJH"
"JJJH"
"JJJH")(RPAQ WAITINGCURSOR (CURSORCREATE (READBITMAP) 7 8))
(16 16
"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 26)
(RPAQQ MinWindowHeight 16)
(CONSTANTS (MinWindowWidth 26)
(MinWindowHeight 16))
)
(* FOLLOWING DEFINITIONS EXPORTED)
[DECLARE: EVAL@COMPILE
(DATATYPE WINDOW (DSP NEXTW SAVE REG BUTTONEVENTFN RIGHTBUTTONFN CURSORINFN CURSOROUTFN CURSORMOVEDFN
REPAINTFN RESHAPEFN EXTENT 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
REPAINTFN RESHAPEFN EXTENT USERDATA VERTSCROLLREG HORIZSCROLLREG SCROLLFN
VERTSCROLLWINDOW HORIZSCROLLWINDOW CLOSEFN MOVEFN WTITLE NEWREGIONFN WBORDER
PROCESS WINDOWENTRYFN))
]
(/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 34850)
(RPAQ? WBorder 4)
(RPAQ? SCROLLBARWIDTH 24)
(RPAQ? SCROLLWAITTIME 100)
(RPAQ? WAITBEFORESCROLLTIME 750)
(RPAQ? WAITBETWEENSCROLLTIME 100)
(RPAQ? PAINTCOMMANDBRUSH (QUOTE (ROUND 2)))
(RPAQ? PAINTCOMMANDMODE (QUOTE PAINT))
(RPAQ? PAINTCOMMANDMENU )
(RPAQ? PAINTCOMMANDSHADE BLACKSHADE)
(RPAQ? PAINTSIZEMENU )
(RPAQ? PAINTSHAPEMENU )
(RPAQ? PAINTSHADEMENU )
(RPAQ? PAINTMODEMENU )
(RPAQ? HIGHLIGHTSHADE 32800)
(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" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (7402 20103 (WINDOWWORLD 7412 . 12115) (WINDOWWORLDP 12117 . 12355) (CHANGEBACKGROUND
12357 . 13147) (CHANGEBACKGROUNDBORDER 13149 . 13582) (TILE 13584 . 14094) (LOGOW 14096 . 15903) (
\DRAWLOGOWINDOWIMAGE 15905 . 16484) (\TTY.CREATING.DISPLAYSTREAM 16486 . 17010) (\CREATE.TTY.OUTCHARFN
17012 . 17735) (\CREATE.TTYDISPLAYSTREAM 17737 . 19098) (HASTTYWINDOWP 19100 . 19548) (TTYINFOSTREAM
19550 . 20101)) (20420 27120 (WINDOW.MOUSE.HANDLER 20430 . 25318) (DOWINDOWCOM 25320 . 26275) (
DOBACKGROUNDCOM 26277 . 27118)) (27121 59352 (BURYW 27131 . 27620) (CLEARW 27622 . 28106) (CLOSEW
28108 . 28527) (\CLOSEW1 28529 . 29397) (\OKTOCLOSEW 29399 . 29806) (OPENW 29808 . 30771) (DOUSERFNS
30773 . 31691) (DOUSERFNS2 31693 . 32204) (\USERFNISDON'T 32206 . 32542) (\OPENW1 32544 . 33246) (
CREATEW 33248 . 36027) (MOVEW 36029 . 42586) (\ONSCREENCLIPPINGREGION 42588 . 43054) (RELMOVEW 43056
. 43575) (PAINTW 43577 . 48874) (PAINTW.READBRUSHSHADE 48876 . 49478) (PAINTW.READMODE 49480 . 50048)
(PAINTW.READBRUSHSHAPE 50050 . 50358) (PAINTW.READBRUSHSIZE 50360 . 50632) (SHAPEW 50634 . 52165) (
SHAPEW1 52167 . 53852) (RESHOWBORDER 53854 . 54340) (\RESHOWBORDER1 54342 . 56939) (TRACKW 56941 .
57829) (SNAPW 57831 . 58914) (WINDOWREGION 58916 . 59350)) (59353 60021 (MINIMUMWINDOWSIZE 59363 .
60019)) (60051 73982 (ADVISEWDS 60061 . 64355) (SHOWWFRAME 64357 . 65737) (SHOWWTITLE 65739 . 67028) (
\STRINGWIDTHGUESS 67030 . 67803) (RESHOWTITLE 67805 . 70859) (TOTOPW 70861 . 71818) (\INTERNALTOTOPW
71820 . 72401) (\TTW1 72403 . 73581) (WHICHW 73583 . 73980)) (74065 76613 (SWITCHDEF 74075 . 74255) (
NU\BACKGROUND 74257 . 74420) (WFROMDS 74422 . 75836) (NU\TOTOPWDS 75838 . 76152) (\COERCETODS 76154 .
76611)) (77076 87199 (WINDOWP 77086 . 77224) (WINDOWPROP 77226 . 77689) (WINDOWADDPROP 77691 . 78243)
(WINDOWDELPROP 78245 . 78671) (GETWINDOWPROP 78673 . 80681) (GETWINDOWUSERPROP 80683 . 81114) (
PUTWINDOWPROP 81116 . 85742) (REMWINDOWPROP 85744 . 86441) (WINDOWADDFNPROP 86443 . 87197)) (87395
91840 (CWINDOWPROP 87405 . 88338) (CGETWINDOWPROP 88340 . 91838)) (91841 97404 (OPENWP 91851 . 92165)
(RESHAPEBYREPAINTFN 92167 . 93916) (DECODE/WINDOW/OR/DISPLAYSTREAM 93918 . 95124) (GROW/REGION 95126
. 95667) (PPROMPT3 95669 . 96042) (CLRPROMPT 96044 . 96324) (PROMPTPRINT 96326 . 96592) (OPENWINDOWS
96594 . 97035) (\INSUREWINDOW 97037 . 97402)) (97605 100065 (OVERLAPPINGWINDOWS 97615 . 99281) (
WOVERLAPP 99283 . 99588) (ORDERFROMBOTTOMTOTOP 99590 . 100063)) (100110 104297 (\ONSCREENW 100120 .
100796) (\PUTONSCREENW 100798 . 101315) (\UPDATECACHEDFIELDS 101317 . 101641) (\WWCHANGESCREENSIZE
101643 . 102827) (CREATEWFROMIMAGE 102829 . 103541) (UPDATEWFROMIMAGE 103543 . 104295)) (104580 135355
(SCROLLW 104590 . 105063) (SCROLLBYREPAINTFN 105065 . 111868) (ADJUSTOFFSETS 111870 . 112239) (
CREATESCROLLINGW 112241 . 112454) (IN/SCROLL/BAR? 112456 . 113326) (RELDSPXOFFSET 113328 . 113521) (
RELDSPYOFFSET 113523 . 113716) (SCROLL.HANDLER 113718 . 120237) (\SCROLL.HANDLER.DOIT 120239 . 121770)
(\UPDATE.EXTENT.IMAGE 121772 . 124958) (EXTENDPASTHORIZBOUNDARIES 124960 . 125429) (REDISPLAYW 125431
. 126884) (FILLWITHBACKGROUND 126886 . 127265) (UPDATE/SCROLL/REG 127267 . 128919) (WTODSX 128921 .
129357) (WTODSY 129359 . 129797) (WXOFFSET 129799 . 130638) (WYOFFSET 130640 . 131483) (BITMAPSCROLLFN
131485 . 131784) (SCROLLBITMAP 131786 . 132817) (REDISPLAYBITMAP 132819 . 133389) (ULREDISPLAYBITMAP
133391 . 134081) (EXTENDEXTENT 134083 . 134585) (WIDTHIFWINDOW 134587 . 134915) (HEIGHTIFWINDOW 134917
. 135353)) (135454 136025 (\DSPUNTRANSFORMREGION 135464 . 136023)) (136053 146850 (SHRINKW 136063 .
141326) (\MAKEICONWINDOW 141328 . 141966) (\TITLEICONMINSIZE 141968 . 142277) (\NOTENEWICONPOSITION
142279 . 142715) (EXPANDW 142717 . 144051) (DOICONWINDOWCOM 144053 . 144917) (CLOSEMAINWINDOW 144919
. 146092) (CLOSEICONWINDOW 146094 . 146848)))))
STOP