(FILECREATED "25-Apr-86 15:58:12" {ERIS}<LISPCORE>SOURCES>WINDOW.;98 260976
changes to: (FNS CHANGEBACKGROUNDBORDER WINDOWWORLD)
(VARS WINDOWCOMS)
previous date: "21-Apr-86 16:27:33" {ERIS}<LISPCORE>SOURCES>WINDOW.;97)
(* Copyright (c) 1982, 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT WINDOWCOMS)
(RPAQQ WINDOWCOMS
[(COMS (FNS WINDOWWORLD WINDOWWORLDP CHANGEBACKGROUND CHANGEBACKGROUNDBORDER TILE LOGOW
\DRAWLOGOWINDOWIMAGE \TTY.CREATING.DISPLAYSTREAM \CREATE.TTY.OUTCHARFN
\CREATE.TTYDISPLAYSTREAM HASTTYWINDOWP TTYINFOSTREAM CREATESCREEN \INSURESCREEN
\BITMAPTOSCREEN MAINSCREEN)
(VARS (\TTYREGIONOFFSETSPTR))
(INITVARS [TTYREGIONOFFSETS (QUOTE ((0 . 0)
(20 . -20)
(40 . 0)
(20 . 20]
(DEFAULTTTYREGION (QUOTE (153 100 384 208)))
(\MAINSCREEN)
(\CURRENTBACKGROUNDBORDER)
(\SCREENS)
(\SCREENBITMAPS))
(GLOBALVARS \TTYREGIONOFFSETSPTR TTYREGIONOFFSETS))
(COMS (* Window menu operations)
(FNS WINDOW.MOUSE.HANDLER \PROTECTED.APPLY DOWINDOWCOM DOBACKGROUNDCOM
DEFAULT.BACKGROUND.COPYFN)
(VARS (BackgroundCopyMenu))
(INITVARS BackgroundCopyMenuCommands)
(FNS BURYW CLEARW CLOSEW \CLOSEW1 \OKTOCLOSEW OPENW DOUSERFNS DOUSERFNS2 \USERFNISDON'T
\OPENW1 CREATEW OPENDISPLAYSTREAM MOVEW \ONSCREENCLIPPINGREGION RELMOVEW PAINTW
PAINTW.READMODE PAINTW.READBRUSHSHAPE PAINTW.READBRUSHSIZE SHAPEW SHAPEW1
RESHOWBORDER \RESHOWBORDER1 TRACKW SNAPW WINDOWREGION PAINTW.READCOMMAND)
(COMS (FNS PAINTW.READBRUSHSHADE PAINTW.READBRUSHTEXTURE PAINTW.READ.AND.SAVE.SHADE
PAINTW.CACHE.SHADE PAINTW.SHADE.LABEL)
(INITVARS (PAINTW.SHADES))
(GLOBALVARS PAINTW.SHADES))
(FNS MINIMUMWINDOWSIZE)
(INITVARS (BACKGROUNDCURSORINFN)
(BACKGROUNDBUTTONEVENTFN)
(BACKGROUNDCURSOROUTFN)
(BACKGROUNDCURSORMOVEDFN)
(BACKGROUNDCOPYBUTTONEVENTFN)
(BACKGROUNDCOPYRIGHTBUTTONEVENTFN (FUNCTION DEFAULT.BACKGROUND.COPYFN))
(BACKGROUNDCURSOREXITFN))
(GLOBALVARS BACKGROUNDCURSORINFN BACKGROUNDBUTTONEVENTFN BACKGROUNDCURSOROUTFN
BACKGROUNDCURSORMOVEDFN \LASTKEYSTATE BACKGROUNDCOPYBUTTONEVENTFN
BACKGROUNDCOPYRIGHTBUTTONEVENTFN \CARET.UP BACKGROUNDCURSOREXITFN)
(EXPORT (MACROS .COPYKEYDOWNP. WSOP))
(PROP ARGNAMES WSOP)
(RECORDS WSOPS WSDATA))
(COMS (* image object support - here so that DEDIT can use it without needing TEDIT to be
loaded.)
(RECORDS IMAGEOBJ IMAGEFNS IMAGEBOX)
(FNS COPYINSERT IMAGEBOX IMAGEFNSCREATE IMAGEFNSP IMAGEOBJCREATE IMAGEOBJP IMAGEOBJPROP
\IMAGEUSERPROP HPRINT.IMAGEOBJ COPYIMAGEOBJ READIMAGEOBJ WRITEIMAGEOBJ)
(ADDVARS (HPRINTMACROS (IMAGEOBJ . WRITEIMAGEOBJ)))
(GLOBALVARS (IMAGEOBJTYPES NIL)
(IMAGEOBJGETFNS NIL)))
(COMS (* For encapsulating unknown-type IMAGEOBJs.)
(FNS ENCAPSULATEDOBJ.BUTTONEVENTINFN ENCAPSULATEDOBJ.PUTFN ENCAPSULATEDOBJ.DISPLAYFN
ENCAPSULATEDOBJ.IMAGEBOXFN ENCAPSULATEDIMAGEFNS)
(INITVARS ENCAPSULATEDIMAGEFNS)
(GLOBALVARS ENCAPSULATEDIMAGEFNS))
(COMS (* Window utilities)
(FNS ADVISEWDS SHOWWFRAME SHOWWTITLE \STRINGWIDTHGUESS RESHOWTITLE TOTOPW
\INTERNALTOTOPW \TTW1 WHICHW)
(VARS (WINDOWTITLEPRINTLEVEL (QUOTE (2 . 5)))
(WINDOWTITLESHADE BLACKSHADE)))
[COMS (* Window vs non-window world)
(FNS SWITCHDEF WFROMDS NU\TOTOPWDS \COERCETODS)
(DECLARE: DONTCOPY (EXPORT (MACROS \COERCETODS .WHILE.ON.TOP.)))
(P (MOVD (QUOTE NU\TOTOPWDS)
(QUOTE \TOTOPWDS]
(COMS (* User interface functions)
(FNS WINDOWP INSURE.WINDOW WINDOWPROP WINDOWADDPROP WINDOWDELPROP GETWINDOWPROP
GETWINDOWUSERPROP PUTWINDOWPROP REMWINDOWPROP WINDOWADDFNPROP)
(* for compiling windowprops.)
(PROP ARGNAMES WINDOWPROP)
(MACROS WINDOWPROP)
(FNS CWINDOWPROP CGETWINDOWPROP \GETWINDOWHEIGHT \GETWINDOWWIDTH))
(COMS (FNS OPENWP TOPWP RESHAPEBYREPAINTFN \INBETWEENP 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))
(COMS (* Scrolling stuff)
(FNS SCROLLW SCROLLBYREPAINTFN ADJUSTOFFSETS CREATESCROLLINGW IN/SCROLL/BAR?
RELDSPXOFFSET RELDSPYOFFSET SCROLL.HANDLER \SCROLL.HANDLER.DOIT \DECODE.EXTENT.USE
\UPDATE.EXTENT.IMAGE EXTENDPASTHORIZBOUNDARIES EXTENDPASTVERTBOUNDARIES 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 ICONBUTTONEVENTFN ICONPOSITION.FROM.WINDOW MAKETITLEBARICON
\TITLEICONMINSIZE \NOTENEWICONPOSITION EXPANDW DOICONWINDOWCOM CLOSEMAINWINDOW
CLOSEICONWINDOW)
(INITVARS (IconWindowMenu)
(DEFAULTICONFN (QUOTE MAKETITLEBARICON)))
(ADDVARS (IconWindowMenuCommands (Close (QUOTE CLOSEW)
"Closes the icon and its associated 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.")))
(GLOBALVARS DEFAULTICONFN IconWindowMenu IconWindowMenuCommands))
(CURSORS VertScrollCursor ScrollUpCursor ScrollDownCursor HorizScrollCursor ScrollLeftCursor
ScrollRightCursor VertThumbCursor HorizThumbCursor WAITINGCURSOR)
(DECLARE: EVAL@COMPILE DONTCOPY
(GLOBALVARS \LastCursorPosition \LastInWindow WindowMenu BackgroundMenu
BackgroundMenuCommands \LastWindowButtons WWFNS WindowMenuCommands
VertScrollCursor ScrollUpCursor ScrollDownCursor ScrollLeftCursor
ScrollRightCursor HorizScrollCursor WindowTitleDisplayStream
WINDOWTITLEPRINTLEVEL WBorder \TOPWDS WINDOWBACKGROUNDSHADE
CURRENTBACKGROUNDSHADE BACKGROUNDFNS)
(CONSTANTS (MinWindowWidth 26)
(MinWindowHeight 16))
(EXPORT (RECORDS WINDOW SCREEN)))
(DECLARE: EVAL@COMPILE (EXPORT (GLOBALVARS WINDOWUSERFORMS ENDOFWINDOWUSERFORMS PROMPTWINDOW)
))
(SYSRECORDS WINDOW SCREEN)
(INITRECORDS WINDOW SCREEN)
(INITVARS (WWFNS (QUOTE (\TOTOPWDS)))
(WindowMenu)
(BackgroundMenu)
(\LastCursorPosition (CREATEPOSITION))
(\LastInWindow)
(\LastWindowButtons 0)
(WINDOWBACKGROUNDSHADE 34850)
(WBorder 4)
(SCROLLBARWIDTH 24)
(SCROLLWAITTIME 100)
(SCROLLBARSHADE 32800)
(WAITBEFORESCROLLTIME 750)
(WAITBETWEENSCROLLTIME 100)
(PAINTCOMMANDBRUSH (QUOTE (ROUND 2)))
(PAINTCOMMANDMODE (QUOTE PAINT))
(PAINTCOMMANDMENU)
(PAINTCOMMANDSHADE BLACKSHADE)
(PAINTSIZEMENU)
(PAINTSHAPEMENU)
(PAINTSHADEMENU)
(PAINTMODEMENU)
(HIGHLIGHTSHADE 32800)
(PAINTCURSOR)
(WINDOWBACKGROUNDBORDER 34850))
[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.")
(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.")
(Hardcopy (QUOTE HARDCOPYIMAGEW)
"Prints a window using its HARDCOPYFN."
(SUBITEMS ("To a file" (QUOTE HARDCOPYIMAGEW.TOFILE)
"Puts image on a file; prompts for filename and format"
)
("To a printer" (QUOTE HARDCOPYIMAGEW.TOPRINTER)
"Sends image to a printer of your choosing")))
(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."
))
(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."
(SUBITEMS ("To a file" (QUOTE (HARDCOPYREGION.TOFILE))
"Writes a region of screen to a file; prompts for filename and format"
)
("To a printer" (QUOTE (HARDCOPYREGION.TOPRINTER))
"Sends a region of screen to a printer of your choosing"]
(ADDVARS (WINDOWUSERFORMS)
(ENDOFWINDOWUSERFORMS))
(P (PAINTW.CACHE.SHADE BLACKSHADE)
(PAINTW.CACHE.SHADE GRAYSHADE)
(PAINTW.CACHE.SHADE HIGHLIGHTSHADE))
(DECLARE: DOCOPY DONTEVAL@LOAD [P (COND ((NULL \MAINSCREEN)
(SETQ \MAINSCREEN (CREATESCREEN (SCREENBITMAP)))
(SETQ \CURSORSCREEN \MAINSCREEN)
(SETQ LASTSCREEN \MAINSCREEN)
(WINDOWWORLD (QUOTE ON)
\MAINSCREEN T]
(ADDVARS (GLOBALVARS SCROLLBARWIDTH SCROLLWAITTIME SCROLLBARSHADE WAITBEFORESCROLLTIME
WAITBETWEENSCROLLTIME WAITINGCURSOR))
(VARS (\WINDOWWORLD T)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA PROMPTPRINT
WINDOWPROP
IMAGEOBJPROP])
(DEFINEQ
(WINDOWWORLD
[LAMBDA (ONOFF SCREEN MAINFLG) (* lmm "25-Apr-86 15:50")
(* ONOFF should be ON or OFF. SCREEN will generally be either \MAINSCREEN or
\COLORSCREEN. MAINFLG = T if this is the first window world being created
(\MAINSCREEN), in which case we create the EXEC window, PROMPTWINDOW, and
LOGOW. *)
(DECLARE (GLOBALVARS \TopLevelTtyWindow))
(PROG NIL
(SETQ SCREEN (\INSURESCREEN SCREEN))
(COND
((NULL ONOFF)
(RETURN (fetch (SCREEN SCONOFF) of SCREEN)))
((EQ ONOFF (fetch (SCREEN SCONOFF) of SCREEN)) (* Already on or off.
*)
)
((EQ ONOFF (QUOTE ON))
(UNINTERRUPTABLY
(\CLEARBM (fetch (SCREEN SCDESTINATION) of SCREEN)
WINDOWBACKGROUNDSHADE) (* Initially there are no windows.
SCTOPW must be NIL before any CREATEWs
are done. *)
(replace (SCREEN SCTOPW) of SCREEN with NIL)
(CHANGEBACKGROUNDBORDER WINDOWBACKGROUNDBORDER)
(SETQ \TOPWDS NIL)
(push \SCREENBITMAPS (fetch (SCREEN SCDESTINATION) of SCREEN))
(push \SCREENS SCREEN)
(replace (SCREEN SCONOFF) of SCREEN with (QUOTE ON))
[COND
(MAINFLG (* WindowTitleDisplayStream *)
(SETQ WindowTitleDisplayStream (fetch (SCREEN SCTITLEDS) of SCREEN))
(* Get TTY in shape.
Region is only approx as user can
change it.)
(DSPXOFFSET 0 (TTYDISPLAYSTREAM))
(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 (fetch (SCREEN SCDESTINATION) of SCREEN)
(TTYDISPLAYSTREAM)) (* SCREENBITMAP changes in
STARTDISPLAY)
(SETLINELENGTH) (* Resets line length for TTY)
(SETQ \DEFAULTTTYDISPLAYSTREAM (\TTY.CREATING.DISPLAYSTREAM))
(* attach the current line buffer to
the top level window.)
(SETQ \TopLevelTtyWindow (CREATEW (TTYDISPLAYSTREAM)
"Lisp Executive"))
(WINDOWPROP \TopLevelTtyWindow (QUOTE \LINEBUF.OFD)
(OR \LINEBUF.OFD (\CREATELINEBUFFER)))
(* Create PROMPTWINDOW.
*)
(SETQ PROMPTWINDOW (CREATEW (create REGION
LEFT ←(IDIFFERENCE
(FOLDLO (fetch (SCREEN SCWIDTH)
of SCREEN)
2)
275)
BOTTOM ←(IDIFFERENCE
(fetch (SCREEN SCHEIGHT)
of SCREEN)
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)
(WINDOWPROP PROMPTWINDOW (QUOTE PAGEFULLFN)
(FUNCTION NILL)) (* Create LOGOW. *)
(SETQ LOGOW (LOGOW NIL (create POSITION
XCOORD ← 594
YCOORD ← 544)))
[WINDOWPROP LOGOW (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (W) (* clear the variable so that it will
be collected.)
(SETQ LOGOW NIL]
(SETQ \LastInWindow NIL)
(SETQ \LastWindowButtons 0)
(SETQ \LastCursorPosition (create POSITION))
(MAPC WINDOWUSERFORMS (FUNCTION EVAL])
(* initialize the window mouse handler
variables.)
)
((EQ ONOFF (QUOTE OFF)) (* if its on turn it off)
[COND
(MAINFLG (MAPC ENDOFWINDOWUSERFORMS (FUNCTION EVAL]
(UNINTERRUPTABLY
(\CLEARBM (fetch (SCREEN SCDESTINATION) of SCREEN)
WHITESHADE)
[COND
(MAINFLG (* TBW: WINDOW.MOUSE.HANDLER should
just be left on BACKGROUNDFNS and
allow itself to act if the cursor
destination's window world is on.
*)
(AND (LISTP BACKGROUNDFNS)
(SETQ BACKGROUNDFNS (DREMOVE (QUOTE WINDOW.MOUSE.HANDLER)
BACKGROUNDFNS)))
(DISPLAYSTREAMINIT 65)
(SETLINELENGTH)
(SETQ \TopLevelTtyWindow NIL)
(SETQ PROMPTWINDOW T)
(TTYDISPLAYSTREAM (DSPCREATE (fetch (SCREEN SCDESTINATION) of SCREEN]
(replace (SCREEN SCTOPW) of SCREEN with NIL)
(SETQ \TOPWDS NIL)
(SETQ \SCREENBITMAPS (DREMOVE (fetch (SCREEN SCDESTINATION) of SCREEN)
\SCREENBITMAPS))
(SETQ \SCREENS (DREMOVE SCREEN \SCREENS))
(replace (SCREEN SCONOFF) of SCREEN with (QUOTE OFF)))])
(WINDOWWORLDP
[LAMBDA (SCREEN) (* kbr: "30-Mar-85 14:28")
(* is the window system operating?)
(EQ (fetch (SCREEN SCONOFF) of (\INSURESCREEN SCREEN))
(QUOTE ON])
(CHANGEBACKGROUND
[LAMBDA (SHADE SCREEN) (* kbr: "18-Aug-85 10:45")
(* changes the window world background to SHADE)
(PROG (WINDOWS)
(COND
((OR (NULL SHADE)
(EQ SHADE T))
(SETQ SHADE WINDOWBACKGROUNDSHADE))
((NOT (OR (TEXTUREP SHADE)
(BITMAPP SHADE)))
(\ILLEGAL.ARG SHADE)))
(OR SCREEN (SETQ SCREEN \CURSORSCREEN))
(SETQ WINDOWS (OPENWINDOWS SCREEN))
(for W in WINDOWS do (\CLOSEW1 W))
(COND
((TEXTUREP SHADE)
(BLTSHADE SHADE (fetch (SCREEN SCDESTINATION)
of SCREEN)))
((BITMAPP SHADE)
(TILE SHADE (fetch (SCREEN SCDESTINATION)
of SCREEN))))
(for W in WINDOWS do (\OPENW1 W])
(CHANGEBACKGROUNDBORDER
[LAMBDA (SHADE) (* lmm "25-Apr-86 15:48")
(* Changes the screen border on a
Dandelion. SHADE is a 8x2 pattern)
(PROG1 \CURRENTBACKGROUNDBORDER (COND
((SMALLP SHADE)
(SETQ \CURRENTBACKGROUNDBORDER SHADE)
(SELECTC \MACHINETYPE
(\DANDELION (replace (IOPAGE DLDISPBORDER) of \IOPAGE
with SHADE))
(\DAYBREAK (\DoveDisplay.SetBorderPattern SHADE))
NIL])
(TILE
[LAMBDA (SRC DST) (* kbr: "10-Jul-85 23:51")
(PROG (X Y W H DSTW DSTH)
(SETQ X 0)
(SETQ Y 0)
(SETQ W (BITMAPWIDTH SRC))
(SETQ H (BITMAPHEIGHT SRC))
(SETQ DSTW (BITMAPWIDTH DST))
(SETQ DSTH (BITMAPHEIGHT 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) (* Pavel "21-Apr-86 16:15")
(* creates a logo window.)
(PROG (CIRCLESIZE LOGOXCENTER LOGOYCENTER LOGOWINDOWHEIGHT W LOGOWINDOWWIDTH WIMAGEWIDTH
WIMAGEHEIGHT)
(SETQ CIRCLESIZE 60)
(SETQ LOGOXCENTER 70)
(SETQ LOGOYCENTER 65)
(SETQ LOGOWINDOWHEIGHT 180)
(SETQ STRING (OR STRING "Xerox Lisp"))
(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) (* lmm "30-Dec-85 19: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))
(T (HELP)))
(\OUTCHAR (TTYDISPLAYSTREAM)
CHAR)))
(\CREATE.TTYDISPLAYSTREAM
(LAMBDA NIL (* kbr: "25-Jan-86 12:56")
(* makes a new window and makes it the
ttydisplaystream)
(COND
((WINDOWP \TopLevelTtyWindow) (* This test works when WINDOWWORLD gets called during
a loadup. I haven't found a way to make it look
cleaner. *)
(* \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)))
(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))
(TTYDISPLAYSTREAM \TTYWINDOW)))))
(HASTTYWINDOWP
(LAMBDA (PROCESS) (* lmm "17-Jan-86 20:31")
(* determines if PROCESS has a tty window yet.)
(NEQ (OR (PROCESS.TTY PROCESS)
\DEFAULTTTYDISPLAYSTREAM)
\DEFAULTTTYDISPLAYSTREAM)))
(TTYINFOSTREAM
(LAMBDA (PROCESS) (* lmm "17-Jan-86 20:29")
(* * Returns a stream to which to print informative messages = PROCESS tty if PROCESS has one, else PROMPTWINDOW)
(DECLARE (GLOBALVARS \DEFAULTTTYDISPLAYSTREAM))
(PROG ((STREAM (PROCESS.TTY PROCESS)))
(RETURN (COND
((AND STREAM (NEQ STREAM \DEFAULTTTYDISPLAYSTREAM))
STREAM)
(T (\GETSTREAM PROMPTWINDOW)))))))
(CREATESCREEN
(LAMBDA (DESTINATION) (* gbn: "25-Jan-86 16:42")
(* * destination is the framebuffer for the screen you want created.e.g. (SCREENBITMAP))
(PROG (TITLEDS SCREEN) (* Create TITLEDS. *)
(SETQ TITLEDS (DSPCREATE DESTINATION))
(DSPOPERATION (QUOTE INVERT)
TITLEDS)
(DSPFONT (FONTCREATE (QUOTE HELVETICA)
8)
TITLEDS) (* Set right margin so title doesn't autoCR.
*)
(DSPRIGHTMARGIN MAX.SMALLP TITLEDS) (* Create SCREEN. *)
(SETQ SCREEN (create SCREEN
SCONOFF ← (QUOTE OFF)
SCDESTINATION ← DESTINATION
SCWIDTH ← (BITMAPWIDTH DESTINATION)
SCHEIGHT ← (BITMAPHEIGHT DESTINATION)
SCTOPW ← NIL
SCTITLEDS ← TITLEDS))
(RETURN SCREEN))))
(\INSURESCREEN
(LAMBDA (SCREEN) (* kbr: " 4-Aug-85 13:30")
(COND
((type? SCREEN SCREEN)
SCREEN)
((NULL SCREEN)
\CURSORSCREEN)
(T (\ILLEGAL.ARG SCREEN)))))
(\BITMAPTOSCREEN
(LAMBDA (BITMAP) (* gbn: "25-Jan-86 16:44")
(* * returns the screen with this bitmap as its destination, NIL otherwise)
(for SCREEN in \SCREENS thereis (EQ (fetch (SCREEN SCDESTINATION) of SCREEN)
BITMAP))))
(MAINSCREEN
(LAMBDA NIL (* kbr:
" 2-Feb-86 14:55")
\MAINSCREEN))
)
(RPAQQ \TTYREGIONOFFSETSPTR NIL)
(RPAQ? TTYREGIONOFFSETS (QUOTE ((0 . 0)
(20 . -20)
(40 . 0)
(20 . 20))))
(RPAQ? DEFAULTTTYREGION (QUOTE (153 100 384 208)))
(RPAQ? \MAINSCREEN )
(RPAQ? \CURRENTBACKGROUNDBORDER )
(RPAQ? \SCREENS )
(RPAQ? \SCREENBITMAPS )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TTYREGIONOFFSETSPTR TTYREGIONOFFSETS)
)
(* Window menu operations)
(DEFINEQ
(WINDOW.MOUSE.HANDLER
(LAMBDA NIL (* kbr: "25-Jan-86 13:13")
(* * Does user window operations if state of buttons has changed or mouse has changed windows)
(COND
(\INTERRUPTABLE (* don't do anything if uninterruptable)
(PROG ((NBREAKS (COND
((IGREATERP 0 NBREAKS)
(* bind NBREAKS to a positive values so that breaks
will occur in background functions.)
(IMINUS NBREAKS))
(T NBREAKS)))
\MHCOM \MHPROCESS \MHWINDOW)
(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.)
(PROG ((\MOUSEBUSY T))
(DECLARE (SPECVARS \MOUSEBUSY))
(* Indicates to others that the mouse process is doing
something "interesting")
(replace XCOORD of \LastCursorPosition with
LASTMOUSEX)
(replace YCOORD of \LastCursorPosition with
LASTMOUSEY)
(SETQ \MHWINDOW (WHICHW LASTMOUSEX LASTMOUSEY
\CURSORSCREEN))
(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
(* SCROLL.HANDLER returns NIL if this window doesn't
want to scroll.)
(SCROLL.HANDLER \LastInWindow)))
(replace XCOORD of \LastCursorPosition
with -1)
(GO RESETBUTTONS))
((OR (EQ LASTMOUSEBUTTONS 0)
(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
((NULL \LastInWindow)
(AND BACKGROUNDCURSOROUTFN (GETD
BACKGROUNDCURSOROUTFN)
(\PROTECTED.APPLY
BACKGROUNDCURSOROUTFN)))
((SETQ \MHCOM (fetch CURSOROUTFN
of \LastInWindow))
(ERSETQ (DOUSERFNS \MHCOM \LastInWindow))))
(COND
((NULL \MHWINDOW)
(AND BACKGROUNDCURSORINFN (GETD
BACKGROUNDCURSORINFN)
(\PROTECTED.APPLY BACKGROUNDCURSORINFN)
))
((SETQ \MHCOM (fetch CURSORINFN of
\MHWINDOW))
(ERSETQ (DOUSERFNS \MHCOM \MHWINDOW))))
(SETQ \LastInWindow \MHWINDOW)
(COND
((EQ LASTMOUSEBUTTONS 0)
(* Don't show transition to UP as we come out of
another window)
(SETQ \LastWindowButtons LASTMOUSEBUTTONS)
(RETURN))))
(T (* Mouse is down and had not changed.
Nothing interesting to do -- act as if we are still in
old window)
(RETURN)))))
(* * We have now taken care of window changing stuff, and \MHWINDOW = \LastInWindow -- Now take care of button
transitions)
(COND
((AND (LASTMOUSESTATE (ONLY RIGHT))
(NOT (AND \MHWINDOW (fetch RIGHTBUTTONFN
of \MHWINDOW))))
(* Right button is down. This does window com unless
overridden by RIGHTBUTTONFN)
(* this is separated out from the process stuff below
so that window commands don't grab the tty.)
(COND
((AND (NULL \MHWINDOW)
(.COPYKEYDOWNP.)
BACKGROUNDCOPYRIGHTBUTTONEVENTFN
(GETD BACKGROUNDCOPYRIGHTBUTTONEVENTFN))
(* check for copy key.)
(\PROTECTED.APPLY
BACKGROUNDCOPYRIGHTBUTTONEVENTFN))
(T (* if \MHWINDOW is NIL, this does background menu
stuff.)
(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))
(GO RESETBUTTONS))
(\MHWINDOW (* Mouse is in a window, look for button change or
cursor moving fn.)
(COND
((NEQ LASTMOUSEBUTTONS \LastWindowButtons)
(* Button change within same window)
(COND
((AND (LASTMOUSESTATE (NOT UP))
(SETQ \MHPROCESS
(WINDOWPROP \MHWINDOW
(QUOTE PROCESS)
))
(NOT (TTY.PROCESSP
\MHPROCESS))
(NOT (.COPYKEYDOWNP.))
(SETQ \MHCOM
(fetch WINDOWENTRYFN
of \MHWINDOW)))
(* make sure that if this window has a process that
that process has the tty.)
(ERSETQ (DOUSERFNS \MHCOM
\MHWINDOW))
(GO RESETBUTTONS))
((SETQ \MHCOM
(COND
((AND (.COPYKEYDOWNP.)
(WINDOWPROP
\MHWINDOW
(QUOTE
COPYBUTTONEVENTFN))))
((LASTMOUSESTATE (ONLY RIGHT))
(fetch RIGHTBUTTONFN
of \MHWINDOW))
(T (fetch BUTTONEVENTFN
of \MHWINDOW))))
(\PROTECTED.APPLY \MHCOM \MHWINDOW)
(GO RESETBUTTONS)))
(SETQ \LastWindowButtons
LASTMOUSEBUTTONS))
((SETQ \MHCOM (fetch (WINDOW
CURSORMOVEDFN)
of \MHWINDOW))
(* cursor must have moved.)
(ERSETQ (DOUSERFNS \MHCOM \MHWINDOW))))
)
(T (* look for button change or cursor moving in
background)
(COND
((NEQ LASTMOUSEBUTTONS \LastWindowButtons)
(* Button change within background)
(COND
((AND (NULL \MHWINDOW)
(.COPYKEYDOWNP.)
BACKGROUNDCOPYBUTTONEVENTFN
(GETD BACKGROUNDCOPYBUTTONEVENTFN))
(\PROTECTED.APPLY
BACKGROUNDCOPYBUTTONEVENTFN)
(GO RESETBUTTONS))
((AND BACKGROUNDBUTTONEVENTFN (GETD
BACKGROUNDBUTTONEVENTFN))
(\PROTECTED.APPLY BACKGROUNDBUTTONEVENTFN)
(GO RESETBUTTONS)))
(SETQ \LastWindowButtons LASTMOUSEBUTTONS))
((AND BACKGROUNDCURSORMOVEDFN (GETD
BACKGROUNDCURSORMOVEDFN))
(* cursor must have moved.)
(\PROTECTED.APPLY BACKGROUNDCURSORMOVEDFN)
(GO RESETBUTTONS))
((AND BACKGROUNDCURSOREXITFN
(OR (EQ LASTMOUSEX 0)
(EQ LASTMOUSEX (SUB1
\CURSORDESTWIDTH))))
(* cursor must have moved.)
(ERSETQ (APPLY* BACKGROUNDCURSOREXITFN))
(GETMOUSESTATE)
(replace (POSITION XCOORD) of
\LastCursorPosition
with LASTMOUSEX)
(replace (POSITION YCOORD) of
\LastCursorPosition
with LASTMOUSEY))))))))
(RETURN)
RESETBUTTONS (* Look at mouse again, since user fn may have waited
for mouse to come up)
(GETMOUSESTATE)
(SETQ \LastWindowButtons LASTMOUSEBUTTONS)
(RETURN))))))
(\PROTECTED.APPLY
(LAMBDA (FN WINDOW) (* bvm: "20-Apr-84 16:20")
(DECLARE (LOCALVARS . T))
(* * Apply FN to WINDOW under an errorset to trap errors)
(ERSETQ (APPLY* FN WINDOW))))
(DOWINDOWCOM
(LAMBDA (WINDOW) (* lmm " 8-May-84 17:51")
(* 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 (\CHECKCARET WINDOW)
(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))))))))
(DEFAULT.BACKGROUND.COPYFN
(LAMBDA NIL (* bvm: "17-Oct-85 00:02")
(* * the default function called when the right button goes down in the background and the copy key is held down.)
(COND
((AND (MOUSESTATE (NOT UP))
BackgroundCopyMenuCommands)
(LET ((FORM (MENU (COND
((type? MENU BackgroundCopyMenu)
BackgroundCopyMenu)
(T (SETQ BackgroundCopyMenu
(create MENU
ITEMS ← BackgroundCopyMenuCommands
CHANGEOFFSETFLG ← (QUOTE Y)
MENUOFFSET ←
(create POSITION
XCOORD ← -1
YCOORD ← 0)
CENTERFLG ← T)))))))
(AND FORM (ERSETQ (EVAL FORM))))))))
)
(RPAQQ BackgroundCopyMenu NIL)
(RPAQ? BackgroundCopyMenuCommands NIL)
(DEFINEQ
(BURYW
(LAMBDA (WINDOW) (* rrb " 2-May-84 16:14")
(* HACK: Puts WINDOW at the bottom by putting
everything that touches it to the top!)
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(PROG ((OVERLAPPINGWINDOWS (ORDERFROMBOTTOMTOTOP (OVERLAPPINGWINDOWS WINDOW)))
ABOVEWINDOWS ATWINS)
(SETQ ABOVEWINDOWS (REMOVE WINDOW (LDIFFERENCE OVERLAPPINGWINDOWS (SETQ ATWINS
(ALLATTACHEDWINDOWS WINDOW)))))
(* close them in order from the top. This should be the fastest since they would have to come to the top to be
closed anyway.)
(for W in (REVERSE OVERLAPPINGWINDOWS) do (\CLOSEW1 W))
(\OPENW1 WINDOW) (* put attached windows below the other windows.)
(for W in ATWINS do (\OPENW1 W)) (* finally open the other windows.)
(for W in ABOVEWINDOWS do (\OPENW1 W))
(RETURN WINDOW))))
(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 " 1-May-85 14:11")
(* 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) (* one of the CLOSEFNs may have closed the window.
If so, don't reopen it.)
(AND (OPENWP WINDOW)
(\CLOSEW1 WINDOW))))))))
(\CLOSEW1
(LAMBDA (WINDOW) (* kbr: "25-Jan-86 13:27")
(* actually does the closing operation.
Is used by SHRINKW to avoid the CLOSEFN mechanism.)
(LET (SCREEN NEXTW)
(SETQ SCREEN (fetch (WINDOW SCREEN) of WINDOW))
(.WHILE.TOP.DS. WINDOW (\SW2BM (fetch (SCREEN SCDESTINATION) of SCREEN)
(fetch (WINDOW REG) of WINDOW)
(fetch (WINDOW SAVE) of WINDOW)
NIL)
(SETQ NEXTW (fetch (WINDOW NEXTW) of WINDOW))
(replace (SCREEN SCTOPW) of SCREEN with NEXTW)
(SETQ \TOPWDS (COND
(NEXTW (fetch (WINDOW DSP) of NEXTW))))
(* 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 "20-Mar-84 16:18")
(* applys a list of user functins and If CHECKFORDON'TFLG is non-NIL, it stops if don't is returned as one of the
values 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 ARG3) (* rrb " 3-Jul-84 15:59")
(* 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 ARG3))))
((for USERFN in FNLST do (APPLY* USERFN WINDOW ARG1 ARG2 ARG3))))))
(\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) (* kbr: "24-Aug-85 15:06")
(PROG (SCREEN DD)
(SETQ SCREEN (fetch (WINDOW SCREEN) of WINDOW))
(UNINTERRUPTABLY
(replace (WINDOW NEXTW) of WINDOW
with (fetch (SCREEN SCTOPW) of SCREEN))
(replace (SCREEN SCTOPW) of SCREEN with WINDOW)
(SETQ \TOPWDS (fetch (WINDOW DSP) of WINDOW))
(* DSP of a window is guaranteed to be a display-stream)
(SETQ DD (fetch (STREAM IMAGEDATA) of \TOPWDS))
(* Just in case screen width has changed.
*)
(replace (PILOTBBT PBTDESTBPL)
of (fetch (\DISPLAYDATA DDPILOTBBT)
of DD)
with (UNFOLD (fetch (BITMAP BITMAPRASTERWIDTH)
of (fetch (SCREEN
SCDESTINATION)
of SCREEN))
BITSPERWORD))
(.WHILE.TOP.DS. WINDOW (\SW2BM (fetch (\DISPLAYDATA
DDDestination)
of DD)
(fetch (WINDOW
REG)
of WINDOW)
(fetch (WINDOW
SAVE)
of WINDOW)
NIL)))])
(CREATEW
(LAMBDA (REGION TITLE BORDERSIZE NOOPENFLG) (* kbr: "25-Jan-86 14:54")
(PROG (SCREEN REG DSP DISPLAYDATA TITLEHEIGHT WINDOW WBORDER)
(SETQ WBORDER (OR (NUMBERP BORDERSIZE)
WBorder))
(COND
((NULL REGION)
(printout PROMPTWINDOW T "Specify region for window")
(COND
(TITLE (printout PROMPTWINDOW " %"" TITLE "%"")))
(SETQ REGION (GETSCREENREGION MinWindowWidth MinWindowHeight))
(SETQ SCREEN (fetch (SCREENREGION SCREEN) of REGION))
(SETQ REG (COPY (fetch (SCREENREGION REGION) of REGION))))
((type? REGION REGION)
(SETQ SCREEN \CURSORSCREEN) (* Protect against user smashing REGION laster on.
*)
(SETQ REG (COPY REGION)))
((type? SCREENREGION REGION)
(SETQ SCREEN (fetch (SCREENREGION SCREEN) of REGION))
(SETQ REG (COPY (fetch (SCREENREGION REGION) of REGION))))
((DISPLAYSTREAMP REGION)
(SETQ DSP REGION)
(SETQ DISPLAYDATA (fetch (STREAM IMAGEDATA) of DSP))
(SETQ SCREEN (\BITMAPTOSCREEN (fetch (\DISPLAYDATA DDDestination) of
DISPLAYDATA)))
(COND
((NULL SCREEN)
(ERROR "Displaystream destination not a screen" DSP)))
(SETQ TITLEHEIGHT (COND
(TITLE (IMINUS (DSPLINEFEED NIL (fetch (SCREEN SCTITLEDS) of SCREEN))))
(T 0)))
(SETQ REG (fetch (\DISPLAYDATA DDClippingRegion) of DISPLAYDATA))
(* adjust region by offsets and reduce to size screen.
(destination bitmap.))
(SETQ REG (create REGION
LEFT ← (IDIFFERENCE (IMAX (IPLUS (fetch (\DISPLAYDATA
DDXOFFSET)
of DISPLAYDATA)
(fetch (REGION LEFT)
of REG))
0)
WBORDER)
BOTTOM ← (IDIFFERENCE (IMAX (IPLUS (fetch (\DISPLAYDATA
DDYOFFSET)
of DISPLAYDATA)
(fetch (REGION
BOTTOM)
of REG))
0)
WBORDER)
WIDTH ← (IPLUS (IMIN (fetch (SCREEN SCWIDTH)
of SCREEN)
(fetch (REGION WIDTH) of REG))
(UNFOLD WBORDER 2))
HEIGHT ← (IPLUS (IMIN (IDIFFERENCE (fetch (SCREEN
SCHEIGHT)
of SCREEN)
TITLEHEIGHT)
(fetch (REGION HEIGHT)
of REG))
(UNFOLD WBORDER 2)
TITLEHEIGHT))))
(T (ERROR "Not a region" REG)))
(COND
((NULL DSP) (* Don't have a DSP yet. User passed some kind of
region. *)
(SETQ DSP (DSPCREATE (fetch (SCREEN SCDESTINATION) of SCREEN)))
(SETQ DISPLAYDATA (fetch (STREAM IMAGEDATA) of DSP))))
(COND
((NOT (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)))
(SETQ WINDOW (create WINDOW
DSP ← DSP
REG ← REG
SAVE ← (BITMAPCREATE (fetch (REGION WIDTH) of REG)
(fetch (REGION HEIGHT) of REG)
(BITSPERPIXEL (fetch (SCREEN
SCDESTINATION)
of SCREEN)))
WTITLE ← TITLE
WBORDER ← WBORDER
NEXTW ← (QUOTE CLOSED)
SCREEN ← SCREEN))
(replace (\DISPLAYDATA XWINDOWHINT) of DISPLAYDATA with WINDOW)
(ADVISEWDS WINDOW) (* make the display stream and window agree about
dimensions.)
(MOVETOUPPERLEFT WINDOW)
(SHOWWFRAME WINDOW)
(COND
((NOT NOOPENFLG)
(OPENW WINDOW)))
(RETURN WINDOW))))
(OPENDISPLAYSTREAM
(LAMBDA (FILE OPTIONS) (* hdj "17-Jan-86 14:47")
(GETSTREAM (CREATEW (LISTGET OPTIONS (QUOTE REGION))
(COND
((EQ FILE (QUOTE {LPT}))
"Display image stream")
(T FILE))))))
(MOVEW
(LAMBDA (WINDOW POSorX Y) (* kbr: "25-Jan-86 15:03")
(* 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 (WINDOW REG) of WINDOW))
(USERMOVEFN (fetch (WINDOW MOVEFN) of WINDOW))
(OPEN? (OPENWP WINDOW))
OLDSCREEN POS NEWREGION OLDLEFT OLDBOTTOM OLDWIDTH OLDHEIGHT OLDCLIPREGION LFT BTM REG
FN)
(SETQ OLDSCREEN (fetch (WINDOW SCREEN) of WINDOW))
(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 (fetch (SCREEN SCREGION) of OLDSCREEN)))
(* use T as an indication that the window was
completely off screen.)
(SETQ OLDCLIPREGION (OR (\ONSCREENCLIPPINGREGION WINDOW)
T))))
(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 (QUOTE MOVEW))))
(* 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 (NOT (EQ (fetch (POSITION XCOORD) of POS)
OLDLEFT))
(NOT (EQ (fetch (POSITION 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.TOP.DS. WINDOW (\SW2BM (fetch (SCREEN SCDESTINATION)
of OLDSCREEN)
OLDREGION
(fetch (WINDOW SAVE) of WINDOW)
NIL)
(\SW2BM (fetch (WINDOW SAVE) of WINDOW)
NIL
(fetch (SCREEN SCDESTINATION) of OLDSCREEN)
NEWREGION))))
(replace (WINDOW REG) of WINDOW with NEWREGION)
(ADVISEWDS WINDOW OLDREGION T))
(COND
((AND (WINDOWPROP WINDOW (QUOTE REPAINTFN))
OLDCLIPREGION) (* redisplay those parts that were off the screen.)
(COND
((EQ OLDCLIPREGION T) (* whole window was off.)
(REDISPLAYW WINDOW NIL T))
(T (PROG (NEWCLIPPINGREGION NCL OCL NCB OCB OCR NCR OCW NCW OCH NCH OCT NCT)
(SETQ NEWCLIPPINGREGION (\ONSCREENCLIPPINGREGION WINDOW))
(* 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)
(fetch (SCREEN SCHEIGHT) of OLDSCREEN))
(* should reshow the title but don't have any entry
for that.)
NIL)))))))
(DOUSERFNS (WINDOWPROP WINDOW (QUOTE AFTERMOVEFN))
WINDOW)))
(RETURN POS))))
(\ONSCREENCLIPPINGREGION
[LAMBDA (WIN) (* kbr: "26-Mar-85 23:34")
(* returns a region which is the part of the windows clipping region that is on the screen.)
(INTERSECTREGIONS (DSPCLIPPINGREGION NIL WIN)
(\DSPUNTRANSFORMREGION
(fetch (SCREEN SCREGION)
of (fetch (WINDOW SCREEN)
of WIN))
(fetch (STREAM 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) (* kbr: " 6-Sep-85 00: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 (DS BITSPERPIXEL MASKSHADE BRUSH MASK 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 (WINDOW DSP) of WINDOW))
(SETQ BITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL)
of (DSPDESTINATION NIL DS)))
(SETQ MASKSHADE (SELECTQ BITSPERPIXEL
(1 BLACKSHADE)
(MASK.1'S 0 BITSPERPIXEL)))
BRUSHLP
(SETQ BRUSH (COND
((BITMAPP PAINTCOMMANDBRUSH))
(T (\GETBRUSH PAINTCOMMANDBRUSH))))
(SETQ HOTX (HALF (fetch (BITMAP BITMAPWIDTH)
of BRUSH)))
(SETQ HOTY (HALF (fetch (BITMAP BITMAPHEIGHT)
of BRUSH)))
(SETQ PAINTWCURSOR
(create CURSOR
CUIMAGE ← BRUSH
CUMASK ← BRUSH
CUHOTSPOTX ← HOTX
CUHOTSPOTY ← HOTY
CUDATA ← NIL using PAINTWCURSOR))
(CURSOR PAINTWCURSOR)
(COND
((NOT (EQ BITSPERPIXEL 1))
(CURSORCOLOR PAINTCOMMANDSHADE)))
(* BRUSH can change if PAINTW is to color screen.
*)
(SETQ BRUSH (fetch (CURSOR CUIMAGE) of
PAINTWCURSOR))
(SETQ MASK (fetch (CURSOR CUMASK) of PAINTWCURSOR)
)
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 (PAINTW.READCOMMAND)
(SHADE (SETQ PAINTCOMMANDSHADE
(OR (
PAINTW.READBRUSHTEXTURE
BITSPERPIXEL)
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))
NIL))
(T (* do the window menu)
(DOWINDOWCOM (WHICHW LASTMOUSEX LASTMOUSEY)))
))
((AND (LASTMOUSESTATE LEFT)
(OR (EQ PAINTCOMMANDMODE (QUOTE REPLACE))
(NOT (EQ PAINTCOMMANDSHADE MASKSHADE))
)) (* painting in grey is slightly harder.)
(COND
((EQ PAINTCOMMANDMODE (QUOTE REPLACE))
(* erase what is there now)
(BITBLT MASK 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))
(WINDOWPROP WINDOW (QUOTE PAINTBRUSH)
(LIST PAINTCOMMANDMODE PAINTCOMMANDSHADE
(COPY PAINTCOMMANDBRUSH])
(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) (* jow "26-Aug-85 13:46")
(* 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. look for a function on windowprop INITCORNERSFN,
which will take the window and return the initcorners for the window, to be passed to getregion.)
(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)
(CAR X)
(CDR X)))
(T NEWREGION)))
((WINDOWPROP WINDOW (QUOTE INITCORNERSFN))
(GETREGION (CAR X)
(CDR X)
(WINDOWREGION WINDOW (QUOTE SHAPEW))
(fetch NEWREGIONFN of WINDOW)
WINDOW
(APPLY* (WINDOWPROP WINDOW (QUOTE INITCORNERSFN))
WINDOW)))
(T (GETREGION (CAR X)
(CDR X)
(WINDOWREGION WINDOW (QUOTE SHAPEW))
(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) (* kbr: "25-Jan-86 15:08")
(* 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 (WINDOW REG) of WINDOW))
(OLDCLIPREG (DSPCLIPPINGREGION NIL (fetch (WINDOW DSP) of WINDOW)))
(WBORDER (fetch (WINDOW WBORDER) of WINDOW))
SCREEN NUSAV NOWOPEN?)
(SETQ SCREEN (fetch (WINDOW SCREEN) of WINDOW))
(SETQ NUSAV (BITMAPCREATE (fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION)
(fetch (BITMAP BITMAPBITSPERPIXEL)
of (fetch (SCREEN SCDESTINATION) of SCREEN))))
(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 (WINDOW REG) of WINDOW with REGION)
(replace (WINDOW SAVE) of WINDOW with (PROG1 NUSAV (SETQ NUSAV
(fetch (WINDOW 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))
OLDREGION)
(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) (* kbr: "25-Jan-86 15:13")
(* 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.)
(PROG ((REGION (fetch (WINDOW REG) of WINDOW))
(OLDSAVE (fetch (WINDOW SAVE) of WINDOW))
NUSAV DELTA NUWIDTH NUHEIGHT)
(SETQ DELTA (IDIFFERENCE NEWBORDER OLDBORDER))
(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 (fetch (SCREEN SCTITLEDS)
of (fetch (WINDOW SCREEN)
of WINDOW))))
(T 0))))
(SETQ NUSAV (BITMAPCREATE NUWIDTH NUHEIGHT (fetch (BITMAP BITMAPBITSPERPIXEL)
of OLDSAVE)))
(.WHILE.TOP.DS. WINDOW (* Save window image)
(\SW2BM (fetch (SCREEN SCDESTINATION) of (fetch (WINDOW SCREEN)
of WINDOW))
REGION
(fetch (WINDOW SAVE) of WINDOW)
NIL) (* put new save image into window)
(replace (WINDOW 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))
(UPDATE/SCROLL/REG WINDOW) (* 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 (BITMAP 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 (fetch (SCREEN SCDESTINATION) of (fetch (WINDOW SCREEN)
of WINDOW))
(fetch (WINDOW REG) of WINDOW)
(fetch (WINDOW 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 (* kbr: "25-Jan-86 15:15")
(* makes a new window which is a copy of the bits
underneath the REGION read from the user.)
(PROG (SCREENREGION SCREEN REGION NEWWINDOW)
(SETQ SCREENREGION (GETSCREENREGION 30 20))
(SETQ SCREEN (fetch (SCREENREGION SCREEN) of SCREENREGION))
(SETQ REGION (fetch (SCREENREGION REGION) of SCREENREGION))
(SETQ NEWWINDOW (CREATEW (create SCREENREGION
SCREEN ← SCREEN
REGION ← (GROW/REGION REGION 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 (fetch (SCREEN SCDESTINATION) of SCREEN)
(fetch (REGION LEFT) of REGION)
(fetch (REGION BOTTOM) of REGION)
(fetch (WINDOW SAVE) of NEWWINDOW)
WBorder WBorder (fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION)
(QUOTE INPUT)
(QUOTE REPLACE))
(OPENW NEWWINDOW)
(MOVEW NEWWINDOW)
(RETURN NEWWINDOW))))
(WINDOWREGION
(LAMBDA (WINDOW COM) (* jow "26-Aug-85 13:48")
(* gets the region that a window wants to consider to be its. COM can be a window com used to help calculate the
region, ie for shaping or moving...)
(PROG (FN)
(RETURN (COND
((SETQ FN (WINDOWPROP WINDOW (QUOTE CALCULATEREGIONFN)))
(APPLY* FN WINDOW COM))
(T (WINDOWPROP WINDOW (QUOTE REGION))))))))
(PAINTW.READCOMMAND
(LAMBDA NIL (* gbn: "25-Jan-86 16:35")
(MENU (COND
((type? MENU PAINTCOMMANDMENU)
PAINTCOMMANDMENU)
(T (SETQ PAINTCOMMANDMENU (create MENU
ITEMS ← (QUOTE ((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"))))
))))))
)
(DEFINEQ
(PAINTW.READBRUSHSHADE
(LAMBDA NIL (* rrb " 7-Oct-85 14:30")
(* reads a shade)
(PROG (SHADE)
(* I removed the 16x16 case because PAINTW uses merge mode and the alignment of 16x16 texture is off in that case.
When fixed at the menu item ("16x16 shade" (QUOTE 16X16) "Allows creation of a 16 bits by 16 bits shade"))
(SELECTQ (SETQ SHADE (MENU (create MENU
CENTERFLG ← T
TITLE ← "Choose shade"
ITEMS ←
(APPEND (for FILLPAT in PAINTW.SHADES
collect
(LIST (CAR FILLPAT)
(KWOTE (CADR FILLPAT)
)
"changes filling to this pattern"))
(QUOTE (("4 x 4 shade"
(QUOTE 4X4)
"Allows creation of a 4 bits by 4 bits shade"))))
MENUBORDERSIZE ← 1)))
(4X4 (RETURN (PAINTW.READ.AND.SAVE.SHADE)))
(16X16 (RETURN (PAINTW.READ.AND.SAVE.SHADE T)))
(RETURN SHADE)))))
(PAINTW.READBRUSHTEXTURE
(LAMBDA NIL (* gbn: "25-Jan-86 17:15")
(SELECTQ (BITSPERPIXEL \CURSORDESTINATION)
(1 (PAINTW.READBRUSHSHADE))
(MENU (COLORMENU (BITSPERPIXEL \CURSORDESTINATION))))))
(PAINTW.READ.AND.SAVE.SHADE
(LAMBDA (16X16FLG) (* rrb " 4-Oct-85 11:34")
(* reads a new filling, confirms it with the user and
adds it to PAINTW.SHADES)
(PROG (SHADE)
(COND
((NULL (SETQ SHADE (EDITSHADE (COND
(16X16FLG (BITMAPCREATE 16 16))))))
(* user aborted)
(RETURN NIL)))
(PAINTW.CACHE.SHADE SHADE)
(RETURN SHADE))))
(PAINTW.CACHE.SHADE
(LAMBDA (SHADE) (* rrb " 4-Oct-85 11:32")
(* adds a shade to the global cache.)
(OR (for ENTRY in PAINTW.SHADES when (EQUAL (CADR ENTRY)
SHADE)
do (RETURN T))
(COND
(PAINTW.SHADES (NCONC1 PAINTW.SHADES (LIST (PAINTW.SHADE.LABEL SHADE)
SHADE)))
(T (SETQ PAINTW.SHADES (LIST (LIST (PAINTW.SHADE.LABEL SHADE)
SHADE)))
(QUOTE ADDED))))))
(PAINTW.SHADE.LABEL
(LAMBDA (FILLING) (* rrb " 7-Oct-85 14:29")
(* creates a bitmap label which fills it with the
texture FILLING.)
(PROG ((BM (BITMAPCREATE (PLUS 8 (STRINGWIDTH "4 x 4 shade" MENUFONT))
(FONTPROP MENUFONT (QUOTE HEIGHT)))))
(BLTSHADE FILLING BM)
(RETURN BM))))
)
(RPAQ? PAINTW.SHADES )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS PAINTW.SHADES)
)
(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))))
)
(RPAQ? BACKGROUNDCURSORINFN )
(RPAQ? BACKGROUNDBUTTONEVENTFN )
(RPAQ? BACKGROUNDCURSOROUTFN )
(RPAQ? BACKGROUNDCURSORMOVEDFN )
(RPAQ? BACKGROUNDCOPYBUTTONEVENTFN )
(RPAQ? BACKGROUNDCOPYRIGHTBUTTONEVENTFN (FUNCTION DEFAULT.BACKGROUND.COPYFN))
(RPAQ? BACKGROUNDCURSOREXITFN )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS BACKGROUNDCURSORINFN BACKGROUNDBUTTONEVENTFN BACKGROUNDCURSOROUTFN
BACKGROUNDCURSORMOVEDFN \LASTKEYSTATE BACKGROUNDCOPYBUTTONEVENTFN
BACKGROUNDCOPYRIGHTBUTTONEVENTFN \CARET.UP BACKGROUNDCURSOREXITFN)
)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
[PUTPROPS .COPYKEYDOWNP. MACRO (NIL (OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT))
(KEYDOWNP (QUOTE COPY]
[PUTPROPS WSOP MACRO (ARGS (LET ((METHOD (CADR (CAR ARGS)))
(DISPLAY (CADR ARGS))
(OTHERARGS (CDDR ARGS)))
(BQUOTE (SPREADAPPLY* (fetch (WSOPS (\, METHOD))
of
(fetch (FDEV WINDOWOPS)
of
(\, DISPLAY)))
(\, DISPLAY)
(\,@ OTHERARGS]
)
(* END EXPORTED DEFINITIONS)
(PUTPROPS WSOP ARGNAMES (METHOD DISPLAY . OTHERARGS))
[DECLARE: EVAL@COMPILE
(RECORD WSOPS (STARTBOARD STARTCOLOR STOPCOLOR EVENTFN SENDCOLORMAPENTRY SENDPAGE PILOTBITBLT))
(RECORD WSDATA (WSDESTINATION WSREGION WSBACKGROUND WSCOLORMAP)
(SYSTEM))
]
(* image object support - here so that DEDIT can use it without needing TEDIT to be loaded.)
[DECLARE: EVAL@COMPILE
(DATATYPE IMAGEOBJ (OBJECTDATUM IMAGEOBJPLIST IMAGEOBJFNS)
(SYSTEM))
(DATATYPE IMAGEFNS (DISPLAYFN (* FN called to display the object's
image)
IMAGEBOXFN (* To tell how big it is)
PUTFN (* To write it onto a file)
GETFN (* To read it back from the file)
COPYFN (* To make a copy of the object)
BUTTONEVENTINFN (* Called when the mouse goes down
over the object)
COPYBUTTONEVENTINFN (* Called when the MIDDLE mouse button
goes down over the object)
WHENMOVEDFN (* Called when the object is moved
within a document or other environment)
WHENINSERTEDFN (* Called when the object is inserted
into a context)
WHENDELETEDFN (* Called when the object is removed
from a context)
WHENCOPIEDFN (* Called when the object is copied
within a context)
WHENOPERATEDONFN (* Called when something interesting
happens to the object)
PREPRINTFN IMAGECLASSNAME (* LITATOM unique name by which this
kind of IMAGEOBJ is to be known to the
world.))
(SYSTEM))
(RECORD IMAGEBOX (XSIZE YSIZE YDESC XKERN)
(SYSTEM))
]
(/DECLAREDATATYPE (QUOTE IMAGEOBJ)
(QUOTE (POINTER POINTER POINTER))
(QUOTE ((IMAGEOBJ 0 POINTER)
(IMAGEOBJ 2 POINTER)
(IMAGEOBJ 4 POINTER)))
(QUOTE 6))
(/DECLAREDATATYPE (QUOTE IMAGEFNS)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER))
(QUOTE ((IMAGEFNS 0 POINTER)
(IMAGEFNS 2 POINTER)
(IMAGEFNS 4 POINTER)
(IMAGEFNS 6 POINTER)
(IMAGEFNS 8 POINTER)
(IMAGEFNS 10 POINTER)
(IMAGEFNS 12 POINTER)
(IMAGEFNS 14 POINTER)
(IMAGEFNS 16 POINTER)
(IMAGEFNS 18 POINTER)
(IMAGEFNS 20 POINTER)
(IMAGEFNS 22 POINTER)
(IMAGEFNS 24 POINTER)
(IMAGEFNS 26 POINTER)))
(QUOTE 28))
(DEFINEQ
(COPYINSERT
(LAMBDA (IMAGEOBJ) (* rrb "29-Jun-84 18:31")
(* * inserts IMAGEOBJ into the window that currently has the tty. If this window has a COPYINSERTFN property, that
is called, otherwise BKSYSBUF is called.)
(PROG ((TTYW (\INSUREWINDOW (WFROMDS (PROCESS.TTY (TTY.PROCESS)))))
INSERTFN)
(COND
((SETQ INSERTFN (WINDOWPROP TTYW (QUOTE COPYINSERTFN)))
(APPLY* INSERTFN IMAGEOBJ TTYW))
(T (* IMAGEOBJ can be a list of things too.)
(for IMOBJ inside IMAGEOBJ
do (BKSYSBUF (OR (COND
((IMAGEOBJP IMOBJ)
(COND
((SETQ INSERTFN (IMAGEOBJPROP IMOBJ
(QUOTE
PREPRINTFN)))
(APPLY* INSERTFN IMOBJ))
(T (IMAGEOBJPROP IMOBJ (QUOTE OBJECTDATUM)))))
(T IMOBJ))
"")
T
(PROCESS.EVAL (TTY.PROCESS)
(GETREADTABLE)
T))))))))
(IMAGEBOX
(LAMBDA (OBJ STREAM MODE) (* jds " 8-Feb-84 10:48")
(APPLY* (IMAGEOBJPROP OBJ (QUOTE IMAGEBOXFN))
OBJ STREAM MODE)))
(IMAGEFNSCREATE
(LAMBDA (DISPLAYFN IMAGEBOXFN PUTFN GETFN COPYFN BUTTONEVENTINFN COPYBUTTONEVENTINFN WHENMOVEDFN
WHENINSERTEDFN WHENDELETEDFN WHENCOPIEDFN WHENOPERATEDONFN PREPRINTFN CLASSNAME)
(* jds "19-Feb-85 09:33")
(* returns a structure which contains the image
functions for a type of image object.)
(COND
(GETFN (* If a GETFN was specified, add it to the list of
known GETFNs, so that people who verify them will know
about it.)
(OR (ASSOC GETFN IMAGEOBJGETFNS)
(push IMAGEOBJGETFNS (LIST GETFN)))))
(create IMAGEFNS
DISPLAYFN ← DISPLAYFN
IMAGEBOXFN ← IMAGEBOXFN
PUTFN ← PUTFN
GETFN ← GETFN
COPYFN ← COPYFN
BUTTONEVENTINFN ← BUTTONEVENTINFN
COPYBUTTONEVENTINFN ← COPYBUTTONEVENTINFN
WHENMOVEDFN ← WHENMOVEDFN
WHENINSERTEDFN ← WHENINSERTEDFN
WHENDELETEDFN ← WHENDELETEDFN
WHENCOPIEDFN ← WHENCOPIEDFN
WHENOPERATEDONFN ← WHENOPERATEDONFN
PREPRINTFN ← PREPRINTFN)))
(IMAGEFNSP
(LAMBDA (X) (* rrb " 1-Feb-84 11:13")
(* is X an IMAGEFNS?)
(AND (type? IMAGEFNS X)
X)))
(IMAGEOBJCREATE
(LAMBDA (OBJECTDATUM IMAGEFNS) (* jds " 8-Feb-84 10:20")
(* returns an image object)
(OR (IMAGEFNSP IMAGEFNS)
(\ILLEGAL.ARG IMAGEFNS)) (* Make sure he handed us a valid set of fn
references)
(create IMAGEOBJ
OBJECTDATUM ← OBJECTDATUM
IMAGEOBJPLIST ← NIL
IMAGEOBJFNS ← IMAGEFNS)))
(IMAGEOBJP
(LAMBDA (X) (* rrb " 1-Feb-84 16:22")
(* is X an IMAGEOBJ?)
(AND (type? IMAGEOBJ X)
X)))
(IMAGEOBJPROP
(LAMBDA NARGS (* jds "18-Feb-85 18:22")
(* accesses and sets properties of an IMAGEOBJ.)
(SELECTQ NARGS
((0 1)
(\ILLEGAL.ARG NIL))
(PROG ((IMAGEOBJ (ARG NARGS 1))
(PROP (ARG NARGS 2))
(VAL (AND (IGREATERP NARGS 2)
(ARG NARGS 3)))
(SET? (NEQ NARGS 2))
IMAGEFNS)
(COND
((NOT (IMAGEOBJP IMAGEOBJ))
(\ILLEGAL.ARG IMAGEOBJ)))
(SETQ IMAGEFNS (fetch (IMAGEOBJ IMAGEOBJFNS) of IMAGEOBJ))
(RETURN (SELECTQ PROP
(OBJECTDATUM (PROG1 (fetch (IMAGEOBJ OBJECTDATUM)
of IMAGEOBJ)
(COND
(SET? (replace (IMAGEOBJ
OBJECTDATUM)
of IMAGEOBJ
with VAL)))))
(DISPLAYFN (PROG1 (fetch (IMAGEFNS DISPLAYFN)
of IMAGEFNS)
(COND
(SET? (replace (IMAGEFNS
DISPLAYFN)
of IMAGEFNS
with VAL)))))
(IMAGEBOXFN (PROG1 (fetch (IMAGEFNS IMAGEBOXFN)
of IMAGEFNS)
(COND
(SET? (replace (IMAGEFNS
IMAGEBOXFN)
of IMAGEFNS
with VAL)))))
(PUTFN (PROG1 (fetch (IMAGEFNS PUTFN) of IMAGEFNS)
(COND
(SET? (replace (IMAGEFNS PUTFN)
of IMAGEFNS with VAL)))))
(GETFN (PROG1 (fetch (IMAGEFNS GETFN) of IMAGEFNS)
(COND
(SET? (replace (IMAGEFNS GETFN)
of IMAGEFNS with VAL)))))
(COPYFN (PROG1 (fetch (IMAGEFNS COPYFN) of IMAGEFNS)
(COND
(SET? (replace (IMAGEFNS COPYFN)
of IMAGEFNS with VAL)))))
(BUTTONEVENTINFN (PROG1 (fetch (IMAGEFNS
BUTTONEVENTINFN)
of IMAGEFNS)
(COND
(SET? (replace
(IMAGEFNS
BUTTONEVENTINFN)
of IMAGEFNS
with VAL)))))
(COPYBUTTONEVENTINFN (PROG1
(fetch (IMAGEFNS
COPYBUTTONEVENTINFN)
of IMAGEFNS)
(COND
(SET? (replace (IMAGEFNS
COPYBUTTONEVENTINFN)
of IMAGEFNS
with VAL)))))
(WHENMOVEDFN (PROG1 (fetch (IMAGEFNS WHENMOVEDFN)
of IMAGEFNS)
(COND
(SET? (replace (IMAGEFNS
WHENMOVEDFN)
of IMAGEFNS
with VAL)))))
(WHENINSERTEDFN (PROG1 (fetch (IMAGEFNS
WHENINSERTEDFN)
of IMAGEFNS)
(COND
(SET? (replace (IMAGEFNS
WHENINSERTEDFN)
of IMAGEFNS
with VAL)))))
(WHENDELETEDFN (PROG1 (fetch (IMAGEFNS WHENDELETEDFN)
of IMAGEFNS)
(COND
(SET? (replace (IMAGEFNS
WHENDELETEDFN)
of IMAGEFNS
with VAL)))))
(WHENCOPIEDFN (PROG1 (fetch (IMAGEFNS WHENCOPIEDFN)
of IMAGEFNS)
(COND
(SET? (replace (IMAGEFNS
WHENCOPIEDFN)
of IMAGEFNS
with VAL)))))
(WHENOPERATEDONFN (PROG1 (fetch (IMAGEFNS
WHENOPERATEDONFN)
of IMAGEFNS)
(COND
(SET? (replace
(IMAGEFNS
WHENOPERATEDONFN)
of IMAGEFNS
with VAL)))))
(PREPRINTFN (PROG1 (fetch (IMAGEFNS PREPRINTFN)
of IMAGEFNS)
(COND
(SET? (replace (IMAGEFNS
PREPRINTFN)
of IMAGEFNS
with VAL)))))
(IMAGECLASSNAME (PROG1 (fetch (IMAGEFNS
IMAGECLASSNAME)
of IMAGEFNS)
(COND
(SET? (replace (IMAGEFNS
IMAGECLASSNAME)
of IMAGEFNS
with VAL)))))
(\IMAGEUSERPROP IMAGEOBJ PROP VAL SET?)))))))
(\IMAGEUSERPROP
(LAMBDA (IMAGEOBJ PROP VAL SET?) (* rrb " 1-Feb-84 11:44")
(* reads and sets the values of properties on an
IMAGEOBJ)
(PROG ((PLIST (fetch (IMAGEOBJ IMAGEOBJPLIST) of IMAGEOBJ)))
(RETURN (PROG1 (LISTGET PLIST PROP)
(COND
(SET? (COND
(PLIST (LISTPUT PLIST PROP VAL))
(T (replace (IMAGEOBJ IMAGEOBJPLIST) of IMAGEOBJ
with (LIST PROP VAL)))))))))))
(HPRINT.IMAGEOBJ
(LAMBDA (IMAGEOBJ STREAM) (* rrb "19-Dec-84 16:22")
(* HPRINT function for writing out IMAGE OBJECTS)
(* write out the name of the function to read things
back in with.)
(PRIN2 (LIST (fetch (IMAGEFNS GETFN) of (fetch (IMAGEOBJ IMAGEOBJFNS) of IMAGEOBJ)))
STREAM HPRINTRDTBL)
(APPLY* (fetch (IMAGEFNS PUTFN) of (fetch (IMAGEOBJ IMAGEOBJFNS) of IMAGEOBJ))
IMAGEOBJ STREAM)
T))
(COPYIMAGEOBJ
(LAMBDA (FROM TO) (* jds "19-Feb-85 09:59")
(* Copis the contents of one IMAGEOBJ nto another,
effectively making TO be the same object as FROM.)
(replace (IMAGEOBJ OBJECTDATUM) of TO with (fetch (IMAGEOBJ OBJECTDATUM) of FROM))
(replace (IMAGEOBJ IMAGEOBJPLIST) of TO with (fetch (IMAGEOBJ IMAGEOBJPLIST)
of FROM))
(replace (IMAGEOBJ IMAGEOBJFNS) of TO with (fetch (IMAGEOBJ IMAGEOBJFNS) of FROM))))
(READIMAGEOBJ
[LAMBDA (STREAM GETFN NOERROR DATANBYTES) (* rrb
"18-Mar-86 11:35")
(DECLARE (SPECVARS UNDERREADIMAGEOBJ)) (* Reads an IMAGEOBJ,
using GETFN. Verifies
that the GETFN is
legitimate)
(* the variable UNDERREADIMAGEOBJ is used in HVBAKREAD to determine if
it should do a validity check on the function which is read from the file.)
(LET*((ENTRY (ASSOC GETFN IMAGEOBJGETFNS))
(SUPPORTFILE (LISTGET (CDR ENTRY)
(QUOTE FILE)))
(UNDERREADIMAGEOBJ T))
[COND
((OR (NOT GETFN)
(NOT (GETD GETFN))
(NOT ENTRY)) (* This function
wasn't specified in the
IMAGEOBJTYPES list, or
isn't defined.
Try loading the support
file.)
(COND
((AND SUPPORTFILE (MOUSECONFIRM (CONCAT "Trying to read an IMAGEOBJ with GETFN " GETFN
". Shall I load the support file, " SUPPORTFILE
"?")
NIL NIL NIL)) (* Ask if the user
wants to load the
support file.)
(DOFILESLOAD (LIST SUPPORTFILE)) (* LOAD the file)
]
(COND
[(OR (NOT GETFN)
(NOT (GETD GETFN))
(NOT (ASSOC GETFN IMAGEOBJGETFNS))) (* Still no support
for this kind of
IMAGEOBJ. Encapsulate
it in something safe.)
(COND
(NOERROR (* The caller doesn't
want errors if there's
a failure.)
NIL)
(T (LET*[(OBJ (IMAGEOBJCREATE NIL (ENCAPSULATEDIMAGEFNS GETFN]
(* Build an
ENCAPSULATED imageobj.)
(IMAGEOBJPROP OBJ (QUOTE FILE)
(FULLNAME STREAM)
STREAM) (* Remember which
file it came from so
that it could be
written back out.)
(IMAGEOBJPROP OBJ (QUOTE FILEPTR)
(GETFILEPTR STREAM))
(IMAGEOBJPROP OBJ (QUOTE OBJSIZE)
DATANBYTES) (* And where on the
file)
(IMAGEOBJPROP OBJ (QUOTE UNKNOWNGETFN)
GETFN)
(AND DATANBYTES (SETFILEPTR STREAM (PLUS (GETFILEPTR STREAM)
DATANBYTES))) (* And the name of
its GETFN)
OBJ]
(T (APPLY* GETFN STREAM])
(WRITEIMAGEOBJ
(LAMBDA (IMAGEOBJ STREAM) (* jds "19-Feb-85 09:36")
(* HPRINT function for writing out IMAGE OBJECTS)
(* write out the name of the function to read things
back in with.)
(COND
((NOT (fetch (IMAGEFNS GETFN) of (fetch (IMAGEOBJ IMAGEOBJFNS) of IMAGEOBJ)))
(* This IMAGEOBJ has no GETFN.
Complain!)
(HELP "No GETFN for IMAGEOBJ " IMAGEOBJ)))
(PRIN2 (LIST (QUOTE READIMAGEOBJ)
NIL
(KWOTE (fetch (IMAGEFNS GETFN) of (fetch (IMAGEOBJ IMAGEOBJFNS)
of IMAGEOBJ))))
STREAM HPRINTRDTBL) (* Write out a call to READIMAGEOBJ, which takes the
input stream and a GETFN name as arguments.)
(APPLY* (fetch (IMAGEFNS PUTFN) of (fetch (IMAGEOBJ IMAGEOBJFNS) of IMAGEOBJ))
IMAGEOBJ STREAM) (* Then write out the guts of the IMAGEOBJ itself.)
T))
)
(ADDTOVAR HPRINTMACROS (IMAGEOBJ . WRITEIMAGEOBJ))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS (IMAGEOBJTYPES NIL)
(IMAGEOBJGETFNS NIL))
)
(* For encapsulating unknown-type IMAGEOBJs.)
(DEFINEQ
(ENCAPSULATEDOBJ.BUTTONEVENTINFN
[LAMBDA (IMAGEOBJ WINDOW) (* rrb
" 3-Feb-86 19:32")
(* * The user hit a button inside this object.
Try loading it now.)
(SETFILEPTR (IMAGEOBJPROP IMAGEOBJ (QUOTE FILE))
(IMAGEOBJPROP IMAGEOBJ (QUOTE FILEPTR))) (* Move to where the
IMAGEOBJ's description
started in the file we
read it from)
(PROG [(OBJ (READIMAGEOBJ (IMAGEOBJPROP IMAGEOBJ (QUOTE FILE))
(IMAGEOBJPROP IMAGEOBJ (QUOTE UNKNOWNGETFN))
T
(IMAGEOBJPROP IMAGEOBJ (QUOTE ENDOFOBJFILEPTR]
(COND
(OBJ (* We succeeded in
reading the object this
time. Copy its guts
over the placeholder.)
(COPYIMAGEOBJ OBJ IMAGEOBJ)
(RETURN (QUOTE CHANGED)))
(T (PRIN1 "Still no support for this image object." (GETPROMPTWINDOW WINDOW])
(ENCAPSULATEDOBJ.PUTFN
[LAMBDA (IMAGEOBJ STREAM) (* rrb
"17-Mar-86 13:16")
(* * image object put function for unknown image objects.
It copies the bytes from the source file to the output file if the range
of the object is known. If not, it errors because nothing else I could
think of makes sense. Since the name of the GETFN has already been written
out and we don't know what format it is expecting we can't write out
anything that wouldn't cause an error when read in so erroring now is
better.)
(PROG ((DATANBYTES (IMAGEOBJPROP IMAGEOBJ (QUOTE OBJSIZE)))
(FILE (IMAGEOBJPROP IMAGEOBJ (QUOTE FILE)))
(BEGOFOBJ (IMAGEOBJPROP IMAGEOBJ (QUOTE FILEPTR)))
INSTREAM)
(OR (NUMBERP DATANBYTES)
(ERROR "No length information for this image object.
Either delete this image object or load its support files." IMAGEOBJ)
(RETURN))
(SETQ INSTREAM (OPENSTREAM FILE (QUOTE INPUT)))
(COPYBYTES INSTREAM STREAM BEGOFOBJ (PLUS BEGOFOBJ DATANBYTES))
T])
(ENCAPSULATEDOBJ.DISPLAYFN
(LAMBDA (OBJ STREAM) (* jds "19-Feb-85 10:37")
(* Display function for an IMAGEOBJ that has been
encapsulated for safety)
(* Displays as a box containing text saying
"Unknown IMAGEOBJ type", and naming the unknown
GETFN.)
(LET* ((CURX (DSPXPOSITION NIL STREAM))
(CURY (DSPYPOSITION NIL STREAM))
(FONT (FONTCREATE (QUOTE HELVETICA)
8
(QUOTE BOLD)
NIL STREAM))
(OLDFONT (DSPFONT FONT STREAM))
(GETFN (IMAGEOBJPROP OBJ (QUOTE UNKNOWNGETFN)))
(TYPE (IMAGEOBJPROP OBJ (QUOTE TYPE)))
(OBJBOX (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX)))
(XSIZE (IDIFFERENCE (fetch XSIZE of OBJBOX)
4))
(YSIZE (IDIFFERENCE (fetch YSIZE of OBJBOX)
4)))
(RELMOVETO 3 (IPLUS (FONTPROP FONT (QUOTE HEIGHT))
3)
STREAM)
(PRIN1 "Unknown IMAGEOBJ type" STREAM)
(MOVETO (IPLUS CURX 3)
(IPLUS CURY 3)
STREAM)
(printout STREAM "GETFN: " GETFN)
(MOVETO CURX (IDIFFERENCE CURY (fetch YDESC of OBJBOX))
STREAM)
(RELDRAWTO XSIZE 0 2 (QUOTE PAINT)
STREAM NIL (QUOTE (16 8 8 8)))
(RELDRAWTO 0 YSIZE 2 (QUOTE PAINT)
STREAM NIL (QUOTE (16 8 8 8)))
(RELDRAWTO (IMINUS XSIZE)
0 2 (QUOTE PAINT)
STREAM NIL (QUOTE (16 8 8 8)))
(RELDRAWTO 0 (IMINUS YSIZE)
2
(QUOTE PAINT)
STREAM NIL (QUOTE (16 8 8 8)))
(DSPFONT OLDFONT STREAM))))
(ENCAPSULATEDOBJ.IMAGEBOXFN
(LAMBDA (OBJ STREAM) (* jds "19-Feb-85 10:05")
(* IMAGEOBXFN for an encapsulated IMAGEOBJ)
(PROG ((FONT (FONTCREATE (QUOTE HELVETICA)
8
(QUOTE BOLD)
NIL STREAM))
(GETFN (IMAGEOBJPROP OBJ (QUOTE UNKNOWNGETFN)))
WIDTH HEIGHT)
(SETQ HEIGHT (ITIMES 2 (FONTPROP FONT (QUOTE HEIGHT))))
(SETQ WIDTH (IMAX (STRINGWIDTH "Unknown IMAGEOBJ type" FONT)
(STRINGWIDTH (CONCAT "GETFN: " GETFN)
FONT)))
(RETURN (create IMAGEBOX
XSIZE ← (IPLUS WIDTH 6)
YSIZE ← (IPLUS HEIGHT 6)
YDESC ← 0
XKERN ← 0)))))
(ENCAPSULATEDIMAGEFNS
[LAMBDA (GETFN) (* rrb
" 3-Feb-86 18:31")
(* * Set up the IMAGEFNS for the encapsulated-IMAGEOBJ type: The way to
protect TEdit and friends from unfriendly IMAGEOBJs.
The GETFN is used as the GETFN for the imagefns so that is can be written
out. The imagefns are cached so that a new set doesn't have to be created
for each instance of an unknown image object type.)
(OR (CDR (ASSOC GETFN ENCAPSULATEDIMAGEFNS))
(PROG [(IMAGEFNS (IMAGEFNSCREATE (FUNCTION ENCAPSULATEDOBJ.DISPLAYFN)
(FUNCTION ENCAPSULATEDOBJ.IMAGEBOXFN)
(FUNCTION ENCAPSULATEDOBJ.PUTFN)
GETFN
(FUNCTION NIL)
(FUNCTION ENCAPSULATEDOBJ.BUTTONEVENTINFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL]
(SETQ ENCAPSULATEDIMAGEFNS (CONS (CONS GETFN IMAGEFNS)
ENCAPSULATEDIMAGEFNS))
(RETURN IMAGEFNS])
)
(RPAQ? ENCAPSULATEDIMAGEFNS NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS ENCAPSULATEDIMAGEFNS)
)
(* Window utilities)
(DEFINEQ
(ADVISEWDS
[LAMBDA (WINDOW OLDREG MOVEONLYFLG) (* kbr: "29-Mar-85 14:01")
(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 D WBORDERSIZE CLIPREG TWICEBORDER PROC)
(SETQ R (fetch (WINDOW REG) of WINDOW))
(SETQ D (fetch (WINDOW DSP) of WINDOW))
(SETQ WBORDERSIZE (fetch (WINDOW WBORDER) of WINDOW))
(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
(fetch (SCREEN SCTITLEDS)
of (fetch (WINDOW SCREEN)
of WINDOW))))
(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
(fetch (SCREEN SCTITLEDS)
of (fetch (WINDOW SCREEN)
of WINDOW))))
(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)))
(* try it without this. (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 "23-May-84 16:12")
(* 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 NIL WIN)))
WIN))
(SHOWWTITLE
(LAMBDA (TITLE BM BORDER CENTERFLG WINDOW) (* kbr: "25-Jan-86 15:21")
(* prints a title in a window.)
(PROG (TITLEDS FONT BLACKPART TITLESHADE BMWIDTH HEIGHT BOTTOM X LEFTMARGIN)
(SETQ TITLEDS (fetch (SCREEN SCTITLEDS) of (fetch (WINDOW SCREEN) of WINDOW)))
(SETQ FONT (DSPFONT NIL TITLEDS))
(SETQ BLACKPART (SELECTQ BORDER
(0 0)
((1 2)
1)
(3 2)
(IDIFFERENCE BORDER 2)))
(SETQ TITLESHADE (OR (TEXTUREP (OR (WINDOWPROP WINDOW (QUOTE WINDOWTITLESHADE)
)
WINDOWTITLESHADE))
BLACKSHADE))
(DSPDESTINATION BM TITLEDS)
(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)
TITLEDS)
(MOVETO (COND
(CENTERFLG (* save left margin for later shading.)
(SETQ LEFTMARGIN (IMAX BORDER (IQUOTIENT
(IDIFFERENCE BMWIDTH
(\STRINGWIDTHGUESS
TITLE FONT))
2))))
(T BORDER))
(IPLUS BOTTOM (FONTPROP FONT (QUOTE DESCENT)))
TITLEDS)
(RESETFORM (PRINTLEVEL WINDOWTITLEPRINTLEVEL)
(PROG ((PLVLFILEFLG T))
(PRIN3 TITLE TITLEDS)))
(BITBLT NIL NIL NIL TITLEDS (SETQ X (IPLUS (IMAX 2 BLACKPART)
(DSPXPOSITION NIL TITLEDS)))
(COND
((EQ BLACKPART 1)
(ADD1 BOTTOM))
(T BOTTOM))
(IDIFFERENCE BMWIDTH (IPLUS X BLACKPART))
NIL
(QUOTE TEXTURE)
(QUOTE REPLACE)
TITLESHADE) (* shade stuff before title if centered.)
(AND CENTERFLG (BITBLT NIL NIL NIL TITLEDS BORDER (COND
((EQ BLACKPART 1)
(ADD1 BOTTOM))
(T BOTTOM))
(IDIFFERENCE LEFTMARGIN (IPLUS (IMAX 2 BLACKPART)
BORDER))
NIL
(QUOTE TEXTURE)
(QUOTE REPLACE)
TITLESHADE)))))
(\STRINGWIDTHGUESS
(LAMBDA (X FONT) (* rrb "30-Apr-85 15:32")
(* 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))
(T (* Might be circular, don't call STRINGWIDTH)
(PROG ((SPACEWIDTH (CHARWIDTH (CHARCODE % )
FONT)))
(RETURN (PLUS (CHARWIDTH (CHARCODE %())
(DIFFERENCE SPACEWIDTH (CHARWIDTH (CHARCODE %()))
(for ELT in X sum (IPLUS SPACEWIDTH
(COND
((NLISTP ELT)
(STRINGWIDTH ELT FONT T))
(T
(* use some number for embedded lists.)
(ITIMES 7 SPACEWIDTH)))))))
)))))
(RESHOWTITLE
(LAMBDA (TITLE WINDOW JUSTDISPLAYFLG) (* kbr: "25-Jan-86 15:26")
(* updates a windows display with a new title)
(PROG* ((WREG (fetch (WINDOW REG) of WINDOW))
(TITLEDS (fetch (SCREEN SCTITLEDS) of (fetch (WINDOW SCREEN) of WINDOW)))
(TITLEHEIGHT (IMINUS (DSPLINEFEED NIL TITLEDS)))
(OLDTITLE (fetch (WINDOW WTITLE) of WINDOW))
(BORDER (fetch (WINDOW WBORDER) of WINDOW))
BM BMBTM HGHT)
(COND
(JUSTDISPLAYFLG)
((EQ TITLE (fetch (WINDOW WTITLE) of WINDOW))
(RETURN))
(T (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))
(BITSPERPIXEL (fetch (SCREEN SCDESTINATION)
of (fetch (WINDOW SCREEN) of WINDOW))))
)
(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 NIL WINDOW)
(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))
(fetch (SCREEN SCDESTINATION) of (fetch (WINDOW SCREEN) of WINDOW))
(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) (* kbr: "25-Jan-86 15:28")
(* 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 (fetch (SCREEN SCTOPW) of (fetch (WINDOW SCREEN) of WINDOW)))
(PROGN (* SETQ \TOPWDS (fetch (WINDOW DSP) of WINDOW))
NIL))
((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) (* gbn: "25-Jan-86 15:36")
(PROG (SCREEN SCREENTOPW)
(SETQ W1 (\INSUREWINDOW W1))
(SETQ SCREEN (fetch (WINDOW SCREEN) of W1))
(SETQ SCREENTOPW (fetch (SCREEN SCTOPW) of SCREEN))
(OR (EQ W1 SCREENTOPW)
(COND
((NULL SCREENTOPW) (* all windows are closed open this one.)
(OPENW W1))
(T (UNINTERRUPTABLY
(\TTW1 W1 SCREENTOPW)
(* * N.B. \TTW1 can side effect the screen)
(COND
((EQ W1 (fetch (SCREEN SCTOPW) of SCREEN)))
((NOT RPT) (* GC msgs or other glitches can cause W1 not to make
it. Check and try ONCE more)
(\INTERNALTOTOPW W1 T))))))))))
(\TTW1
(LAMBDA (WINDOW WS) (* kbr: "25-Jan-86 15:33")
(* * This seems to swap the intersection of bitmaps.)
(COND
((fetch (WINDOW NEXTW) of WS)
(PROG (ISECT SCREEN)
(SETQ SCREEN (fetch (WINDOW SCREEN) of WINDOW))
(.WHILE.TOP.DS. (fetch (SCREEN SCTOPW) of SCREEN)
(SETQ ISECT (INTERSECTREGIONS (fetch (WINDOW REG) of WINDOW)
(fetch (WINDOW REG) of WS)
(fetch (SCREEN SCREGION)
of SCREEN)))
(AND ISECT (\SW2BM (fetch (WINDOW SAVE) of WS)
(TRANSLATEREG ISECT (fetch (WINDOW REG)
of WS))
(fetch (SCREEN SCDESTINATION) of SCREEN)
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 (fetch
(SCREEN SCTOPW)
of SCREEN))
(replace (SCREEN SCTOPW) of SCREEN with WINDOW)
(SETQ \TOPWDS (fetch (WINDOW DSP) of WINDOW)))
(T (\TTW1 WINDOW (fetch (WINDOW NEXTW) of WS))))
(AND ISECT (\SW2BM (fetch (WINDOW SAVE) of WINDOW)
(TRANSLATEREG ISECT (fetch (WINDOW REG)
of WINDOW))
(fetch (WINDOW SAVE) of WS)
(TRANSLATEREG ISECT (fetch (WINDOW REG)
of WS)))))))
((type? WINDOW WINDOW) (* must be closed window; reopen it)
(OPENW WINDOW)))))
(WHICHW
(LAMBDA (X Y SCREEN) (* gbn: "25-Jan-86 15:47")
(SETQ SCREEN (\INSURESCREEN SCREEN))
(COND
((POSITIONP X)
(WHICHW (fetch (POSITION XCOORD) of X)
(fetch (POSITION YCOORD) of X)
SCREEN))
(T (for (WINDOW ← (fetch (SCREEN SCTOPW) of SCREEN)) by (fetch (WINDOW NEXTW)
of WINDOW)
while WINDOW thereis (INSIDE? (fetch (WINDOW REG) of WINDOW)
X Y))))))
)
(RPAQQ WINDOWTITLEPRINTLEVEL (2 . 5))
(RPAQ WINDOWTITLESHADE BLACKSHADE)
(* 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))
(WFROMDS
(LAMBDA (DS DONTCREATE) (* gbn: "25-Jan-86 15:43")
(* 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))
(COND
((WINDOWP DS)
DS)
((IMAGESTREAMP DS)
(PROG (DD HINTW)
(COND
((IMAGESTREAMTYPEP DS (QUOTE TEXT))
(* * generalize this mess!!!)
(RETURN (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ DS))))))
(SETQ DD (\GETDISPLAYDATA DS DS))
(RETURN (COND
((AND (SETQ HINTW (fetch (\DISPLAYDATA XWINDOWHINT) of DD))
(EQ (fetch (WINDOW DSP) of HINTW)
DS))
HINTW)
((AND (EQ DS \DEFAULTTTYDISPLAYSTREAM)
(EQ (TTYDISPLAYSTREAM)
\DEFAULTTTYDISPLAYSTREAM))
(* assume this process is doing something with T.)
(COND
((NOT DONTCREATE)
(\CREATE.TTYDISPLAYSTREAM)
(WFROMDS (TTYDISPLAYSTREAM)))))
((SETQ HINTW (for WINDOW in (OPENWINDOWS T)
thereis (EQ DS (fetch (WINDOW DSP) of WINDOW))))
(* (OPENWINDOWS T) returns all windows on all screens)
HINTW)
((NOT DONTCREATE)
(CREATEW DS NIL NIL T)))))))))
(NU\TOTOPWDS
[LAMBDA (DS) (* kbr: " 6-Jun-85 19:00")
(* Moves the window of displaystream DS to the top)
(AND (FMEMB (DSPDESTINATION NIL DS)
\SCREENBITMAPS)
(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)
)
(MOVD (QUOTE NU\TOTOPWDS)
(QUOTE \TOTOPWDS))
(* User interface functions)
(DEFINEQ
(WINDOWP
(LAMBDA (X) (* rrb "20-NOV-81 07:30")
(AND (type? WINDOW X)
X)))
(INSURE.WINDOW
[LAMBDA (WIN? NOERRORFLG) (* rrb
"17-Mar-86 15:39")
(* * coerces WIN? to a window.)
(COND
((type? WINDOW WIN?)
WIN?)
((DISPLAYSTREAMP (\OUTSTREAMARG WIN? T))
(WFROMDS WIN?))
((NULL NOERRORFLG)
(\ILLEGAL.ARG WIN?])
(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 FIRSTFLG) (* rrb "20-Mar-84 16:07")
(* adds an element to a window property.)
(PROG ((CURRENT (WINDOWPROP WINDOW PROP)))
(RETURN (WINDOWPROP WINDOW PROP (COND
((NULL CURRENT)
(LIST ITEMTOADD))
((NLISTP CURRENT)
(COND
((EQ CURRENT ITEMTOADD)
(LIST ITEMTOADD))
(FIRSTFLG (LIST ITEMTOADD CURRENT))
(T (LIST CURRENT ITEMTOADD))))
((FMEMB ITEMTOADD CURRENT)
(* don't put things on twice.)
(COND
((AND FIRSTFLG (NEQ (CAR CURRENT)
ITEMTOADD))
(* make it first)
(CONS ITEMTOADD (REMOVE ITEMTOADD CURRENT)))
(T CURRENT)))
(FIRSTFLG (CONS ITEMTOADD 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) (* kbr:
"13-Feb-86 16:19")
(* gets values from a
window. Called by the
macro for WINDOWPROP.)
(OR (type? WINDOW WINDOW)
(COND
((DISPLAYSTREAMP (\OUTSTREAMARG WINDOW T))
(SETQ WINDOW (WFROMDS WINDOW)))
(T (\ILLEGAL.ARG WINDOW))))
(SELECTQ PROP
(HEIGHT (\GETWINDOWHEIGHT WINDOW))
(WIDTH (* calculate the width
from the REGION in case
the user has changed the
clipping region.)
(\GETWINDOWWIDTH WINDOW))
(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))
(SCREEN (fetch (WINDOW SCREEN) 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))
(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) (* kbr:
"13-Feb-86 16:22")
(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))
(SCREEN (ERROR "Can't change SCREEN 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)
(SETQ 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 OLDVALUE)
(SETQ OLDDATA (fetch (WINDOW USERDATA) of WINDOW))
(RETURN (PROG1 (COND
(OLDDATA (SETQ OLDVALUE (LISTGET OLDDATA PROP))
(COND
(VALUE (LISTPUT OLDDATA PROP VALUE))
(OLDVALUE (* Remove the property)
(COND
((EQ (CAR OLDDATA)
PROP)
(replace (WINDOW 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 (WINDOW USERDATA) of WINDOW
with (LIST PROP VALUE)) (* know old value is
NIL)
NIL))
(COND
((AND (fetch (WINDOW WTITLE) of WINDOW)
(EQ PROP (QUOTE WINDOWTITLESHADE))) (* change
windowtitleshade.)
(RESHOWTITLE (fetch (WINDOW WTITLE) of WINDOW)
WINDOW T)))))))))
(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)
(SETQ DATA (fetch (WINDOW 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 (WINDOW 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) (* kbr:
"17-Feb-86 10:43")
(* 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 (WINDOW RIGHTBUTTONFN))
(QUOTE DATUM)
(QUOTE ffetch))))
(BUTTONEVENTFN
(CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW BUTTONEVENTFN))
(QUOTE DATUM)
(QUOTE ffetch))))
(CURSORINFN (CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW CURSORINFN))
(QUOTE DATUM)
(QUOTE ffetch))))
(CURSOROUTFN (CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW CURSOROUTFN))
(QUOTE DATUM)
(QUOTE ffetch))))
(CURSORMOVEDFN
(CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW CURSORMOVEDFN))
(QUOTE DATUM)
(QUOTE ffetch))))
(DSP (CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW DSP))
(QUOTE DATUM)
(QUOTE ffetch))))
(SCREEN (CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW SCREEN))
(QUOTE DATUM)
(QUOTE ffetch))))
(SCROLLFN (CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW SCROLLFN))
(QUOTE DATUM)
(QUOTE ffetch))))
(MOVEFN (CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW MOVEFN))
(QUOTE DATUM)
(QUOTE ffetch))))
(RESHAPEFN (CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW RESHAPEFN))
(QUOTE DATUM)
(QUOTE ffetch))))
(EXTENT (CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW EXTENT))
(QUOTE DATUM)
(QUOTE ffetch))))
(REPAINTFN (CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW REPAINTFN))
(QUOTE DATUM)
(QUOTE ffetch))))
(CLOSEFN (CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW CLOSEFN))
(QUOTE DATUM)
(QUOTE ffetch))))
(WINDOWENTRYFN
(CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW WINDOWENTRYFN))
(QUOTE DATUM)
(QUOTE ffetch))))
(PROCESS (CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW PROCESS))
(QUOTE DATUM)
(QUOTE ffetch))))
(REGION (CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW REG))
(QUOTE DATUM)
(QUOTE ffetch))))
(NEWREGIONFN (CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW NEWREGIONFN))
(QUOTE DATUM)
(QUOTE ffetch))))
(TITLE (CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW WTITLE))
(QUOTE DATUM)
(QUOTE ffetch))))
(BORDER (CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW WBORDER))
(QUOTE DATUM)
(QUOTE ffetch))))
(IMAGECOVERED (CONSTANT (RECORDACCESSFORM (QUOTE (WINDOW SAVE))
(QUOTE DATUM)
(QUOTE ffetch))))
(HEIGHT (LIST (QUOTE GETWINDOWPROP)
WINFORM
(QUOTE (QUOTE HEIGHT))))
(WIDTH (LIST (QUOTE GETWINDOWPROP)
WINFORM
(QUOTE (QUOTE WIDTH))))
(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))))))))))
(\GETWINDOWHEIGHT
(LAMBDA (WINDOW) (* gbn: "25-Jan-86 15:45")
(* calculate the height from the REGION in case user has changed the clipping region. This won't work if the height
of the title display stream has changed.)
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(DIFFERENCE (fetch (REGION HEIGHT) of (fetch (WINDOW REG) of WINDOW))
(DIFFERENCE (ITIMES 2 (fetch (WINDOW WBORDER) of WINDOW))
(COND
((fetch (WINDOW WTITLE) of WINDOW)
(DSPLINEFEED NIL (fetch (SCREEN SCTITLEDS)
of (fetch (WINDOW SCREEN) of WINDOW)))
)
(T 0))))))
(\GETWINDOWWIDTH
(LAMBDA (WINDOW) (* rrb " 4-Jun-84 18:03")
(* calculate the width from the REGION in case the
user has changed the clipping region.)
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(DIFFERENCE (fetch (REGION WIDTH) of (fetch (WINDOW REG) of WINDOW))
(ITIMES 2 (fetch (WINDOW WBORDER) of WINDOW)))))
)
(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)))
(TOPWP
(LAMBDA (WINDOW) (* kbr:
"17-Feb-86 10:37")
(* A function user's
can use to test if
WINDOW is the TOPW of
it's screen. *)
(EQ WINDOW (fetch (SCREEN SCTOPW) of (fetch (WINDOW SCREEN) of WINDOW)))))
(RESHAPEBYREPAINTFN
(LAMBDA (WINDOW OLDIMAGE IMAGEREGION OLDSCREENREGION) (* rrb "11-Oct-84 17:22")
(* 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.)
(* if IMAGEREGION shares a corner with the current region, the excess is added in the opposite directions.
Also the newly exposed region will be a subset of the EXTENT property if the window has one.)
(PROG ((NEWSCREENREGION (WINDOWPROP WINDOW (QUOTE REGION)))
(EXTENT (WINDOWPROP WINDOW (QUOTE EXTENT)))
(DSP (WINDOWPROP WINDOW (QUOTE DSP)))
(OLDWIDTH (fetch (REGION WIDTH) of IMAGEREGION))
(OLDHEIGHT (fetch (REGION HEIGHT) of IMAGEREGION))
NEWWID NEWHGHT WREGION OLDCRLFT OLDCRBTM NEWCRLFT NEWCRBTM DELTAWID DELTAHGHT NEWPTOP
OLDPTOP NEWPRIGHT OLDPRIGHT YPOS)
(SETQ WREGION (DSPCLIPPINGREGION NIL DSP))
(SETQ OLDCRLFT (fetch (REGION LEFT) of WREGION))
(SETQ OLDCRBTM (fetch (REGION BOTTOM) of WREGION))
(* calculate the position of the new clipping region.)
(SETQ NEWWID (fetch (REGION WIDTH) of WREGION))
(SETQ DELTAWID (IDIFFERENCE NEWWID OLDWIDTH))
(SETQ NEWHGHT (fetch (REGION HEIGHT) of WREGION))
(SETQ DELTAHGHT (IDIFFERENCE NEWHGHT OLDHEIGHT))
(COND
((AND OLDSCREENREGION EXTENT (EQ (fetch (REGION PRIGHT) of NEWSCREENREGION)
(fetch (REGION PRIGHT) of OLDSCREENREGION)))
(* right edges match, move the left one)
(SETQ NEWCRLFT (IDIFFERENCE OLDCRLFT DELTAWID))
(COND
((AND (IGREATERP DELTAWID 0)
(IGREATERP (fetch (REGION LEFT) of EXTENT)
NEWCRLFT))
(* this would be extending the window onto parts of the extent that don't have anything in them, reset the left so
that it gets the entire extent)
(SETQ NEWCRLFT (IMIN (fetch (REGION LEFT) of EXTENT)
(IDIFFERENCE (fetch (REGION RIGHT) of EXTENT)
NEWWID))))))
(T (* otherwise move the right edge.)
(COND
((AND (IGREATERP DELTAWID 0)
EXTENT
(IGREATERP (IPLUS OLDCRLFT NEWWID)
(fetch (REGION RIGHT) of EXTENT)))
(* this would be extending the window onto parts of the extent that don't have anything in them, reset the left so
that it gets the entire extent)
(SETQ NEWCRLFT (IMAX (IMIN (fetch (REGION LEFT) of EXTENT)
OLDCRLFT)
(IDIFFERENCE OLDCRLFT DELTAWID))))
(T (SETQ NEWCRLFT OLDCRLFT)))))
(COND
((AND OLDSCREENREGION (EQ (fetch (REGION PTOP) of NEWSCREENREGION)
(fetch (REGION PTOP) of OLDSCREENREGION)))
(* top edges match, move the bottom one)
(SETQ NEWCRBTM (IDIFFERENCE OLDCRBTM DELTAHGHT))
(COND
((AND (IGREATERP DELTAHGHT 0)
EXTENT
(IGREATERP (fetch (REGION BOTTOM) of EXTENT)
NEWCRBTM))
(* this would be extending the window onto parts of the extent that don't have anything in them, reset the bottom
so that it gets the entire extent)
(SETQ NEWCRBTM (IMIN (fetch (REGION BOTTOM) of EXTENT)
(IDIFFERENCE (fetch (REGION TOP) of EXTENT)
NEWHGHT))))))
(T (* otherwise move the top edge.)
(COND
((AND (IGREATERP DELTAHGHT 0)
EXTENT
(IGREATERP (IPLUS OLDCRBTM OLDHEIGHT DELTAHGHT)
(fetch (REGION PTOP) of EXTENT)))
(* this would be extending the window onto parts of the extent that don't have anything in them, reset the bottom
so that it gets the entire extent)
(SETQ NEWCRBTM (IMAX (IDIFFERENCE OLDCRBTM DELTAHGHT)
(fetch (REGION BOTTOM) of EXTENT)
(IDIFFERENCE (fetch (REGION PTOP) of EXTENT)
NEWHGHT))))
(T (SETQ NEWCRBTM OLDCRBTM))))) (* scroll the window so that the new left bottom is
the left bottom of the clipping region.)
(COND
((AND (NULL EXTENT)
(\INBETWEENP (DSPXPOSITION NIL WINDOW)
OLDCRLFT
(IPLUS OLDCRLFT OLDWIDTH))
(\INBETWEENP (SETQ YPOS (DSPYPOSITION NIL WINDOW))
OLDCRBTM
(IPLUS OLDCRBTM OLDHEIGHT)))
(* if the window doesn't have any EXTENT and its position is visible, make sure its Y position is visible at the
end of the scroll.)
(COND
((ILESSP YPOS NEWCRBTM) (* make sure the entire line of text being printed is
visible.)
(SETQ NEWCRBTM (DIFFERENCE YPOS (FONTPROP WINDOW (QUOTE DESCENT)))))
((IGREATERP YPOS (DIFFERENCE (IPLUS NEWCRBTM NEWHGHT)
(FONTPROP WINDOW (QUOTE ASCENT))))
(SETQ NEWCRBTM (IPLUS (IDIFFERENCE YPOS NEWHGHT)
(FONTPROP WINDOW (QUOTE ASCENT))))))))
(COND
((NEQ OLDCRLFT NEWCRLFT)
(COND
((EQ (DSPSCROLL NIL WINDOW)
(QUOTE ON)) (* if scrolling is turned on, don't change the
coordinates.)
NIL)
(T (WXOFFSET (DIFFERENCE OLDCRLFT NEWCRLFT)
WINDOW)))))
(COND
((NEQ OLDCRBTM NEWCRBTM)
(COND
((EQ (DSPSCROLL NIL WINDOW)
(QUOTE ON)) (* if scrolling is turned on, change the Y rather than
the coordinates.)
(DSPYPOSITION (PLUS (DIFFERENCE OLDCRBTM NEWCRBTM)
YPOS)
WINDOW))
(T (WYOFFSET (DIFFERENCE OLDCRBTM NEWCRBTM)
WINDOW))))) (* call the redisplay function on the four possible
areas and blt the middle one.)
(COND
((IGREATERP (SETQ NEWPTOP (IPLUS NEWCRBTM NEWHGHT))
(SETQ OLDPTOP (IPLUS OLDCRBTM OLDHEIGHT)))
(* call the display function on the newly exposed top
area.)
(REDISPLAYW WINDOW
(create REGION
LEFT ← NEWCRLFT
BOTTOM ← OLDPTOP
WIDTH ← NEWWID
HEIGHT ← (IDIFFERENCE NEWPTOP OLDPTOP))
T)))
(COND
((IGREATERP OLDCRLFT NEWCRLFT) (* call the display function on the newly exposed LEFT
area.)
(REDISPLAYW WINDOW (create REGION
LEFT ← NEWCRLFT
BOTTOM ← OLDCRBTM
WIDTH ← (IDIFFERENCE OLDCRLFT NEWCRLFT)
HEIGHT ← OLDHEIGHT)
T))) (* blt center region.)
(BITBLT OLDIMAGE (fetch (REGION LEFT) of IMAGEREGION)
(fetch (REGION BOTTOM) of IMAGEREGION)
DSP OLDCRLFT OLDCRBTM OLDWIDTH OLDHEIGHT NIL (QUOTE REPLACE))
(COND
((IGREATERP (SETQ NEWPRIGHT (IPLUS NEWCRLFT NEWWID))
(SETQ OLDPRIGHT (IPLUS OLDCRLFT OLDWIDTH)))
(* call the display function on the newly exposed
right area.)
(REDISPLAYW WINDOW (create REGION
LEFT ← OLDPRIGHT
BOTTOM ← OLDCRBTM
WIDTH ← (IDIFFERENCE NEWPRIGHT OLDPRIGHT)
HEIGHT ← OLDHEIGHT)
T)))
(COND
((IGREATERP OLDCRBTM NEWCRBTM) (* call the display function on the newly exposed LEFT
area.)
(REDISPLAYW WINDOW
(create REGION
LEFT ← NEWCRLFT
BOTTOM ← NEWCRBTM
WIDTH ← NEWWID
HEIGHT ← (IDIFFERENCE OLDCRBTM NEWCRBTM))
T)))
(RETURN WINDOW))))
(\INBETWEENP
(LAMBDA (X LFT RGHT) (* rrb "11-Oct-84 17:07")
(* returns T if X is between LEFT and RIGHT)
(AND (GEQ X LFT)
(GREATERP RGHT X))))
(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 (SCREEN) (* kbr: " 4-Aug-85 16:34")
(* returns a list of all open windows)
(PROG (WINDOW WINDOWS)
(COND
((EQ SCREEN T) (* Return all open windows. *)
(SETQ WINDOWS (for SCREEN in \SCREENS
join (OPENWINDOWS SCREEN)))
(RETURN WINDOWS)))
(SETQ SCREEN (\INSURESCREEN SCREEN))
(SETQ WINDOW (fetch (SCREEN SCTOPW) of SCREEN))
(while WINDOW
do (SETQ WINDOWS (CONS WINDOW WINDOWS))
(SETQ WINDOW (fetch (WINDOW NEXTW)
of WINDOW)))
(SETQ WINDOWS (DREVERSE WINDOWS))
(RETURN WINDOWS])
(\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) (* gbn: "25-Jan-86 15:52")
(* returns all windows that overlap with WINDOW or
that overlap a window that is in the
OVERLAPPINGWINDOWS of WINDOW.)
(PROG (WPTR OVERLAPS DONTS)
(SETQ WPTR (fetch (SCREEN SCTOPW) of (fetch (WINDOW SCREEN) of WINDOW)))
(SETQ OVERLAPS (CONS WINDOW (ALLATTACHEDWINDOWS WINDOW)))
LP (COND
((NULL WPTR)
(RETURN OVERLAPS))
((MEMB WPTR OVERLAPS) (* 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) (* gbn: "25-Jan-86 15:56")
(* returns a list of windows in order from bottom to
top)
(PROG (ANS WPTR)
(COND
((NULL WLST)
(RETURN NIL)))
(SETQ WPTR (fetch (SCREEN SCTOPW) of (fetch (WINDOW SCREEN) of (CAR WLST))))
(* start at the 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) (* kbr: "18-Jan-86 18:40")
(* 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.)
(* HARDCURSORWIDTH 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 (fetch (SCREEN SCWIDTH)
of (fetch (WINDOW SCREEN)
of W))
HARDCURSORWIDTH)
(fetch (REGION LEFT) of (WINDOWPROP
W
(QUOTE REGION])
(\PUTONSCREENW
[LAMBDA (W) (* kbr: "26-Mar-85 23:29")
(* 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))
(fetch (SCREEN SCWIDTH)
of (fetch (WINDOW SCREEN)
of W)))
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 (SCREEN) (* gbn: "25-Jan-86 16:03")
(* 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)
(SETQ SCREEN (\INSURESCREEN SCREEN))
(SETQ WINDOWS (DREVERSE (OPENWINDOWS SCREEN)))
(* OPENWINDOWS returns the windows with bottom window
first.)
(for W in WINDOWS do (\CLOSEW1 W))
(\STARTDISPLAY)
(\CLEARBM (fetch (SCREEN SCDESTINATION) of SCREEN)
WINDOWBACKGROUNDSHADE) (* update cached bitmap width information that is in
the display streams)
(for W in WINDOWS 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 SCREEN) (* gbn: "25-Jan-86 16:05")
(* creates a window that has IMAGE
(a bitmap) as an image. It is initially closed and can
be opened.)
(PROG (WINDOW)
(SETQ WINDOW (CREATEW (create SCREENREGION
SCREEN ← (\INSURESCREEN SCREEN)
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) (* kbr: "27-Jan-86 11:19")
(* makes the fields of a window consistent with its
image.)
(PROG ((REGION (fetch (WINDOW REG) of WINDOW))
(IMAGE (fetch (WINDOW 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)))))
)
(* Scrolling stuff)
(DEFINEQ
(SCROLLW
(LAMBDA (WINDOW DX DY CONTINUOUSFLG) (* lmm "11-Jun-85 14:25")
(* 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.)
(\CHECKCARET WINDOW)
(APPLY* (OR (fetch SCROLLFN of WINDOW)
(FUNCTION SCROLLBYREPAINTFN))
WINDOW DX DY CONTINUOUSFLG)))
(SCROLLBYREPAINTFN
(LAMBDA (WINDOW XDELTA YDELTA CONTINUOUSFLG) (* gbn: "25-Jan-86 16:13")
(* 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)))
(EXTENTUSE (WINDOWPROP WINDOW (QUOTE SCROLLEXTENTUSE)))
X CRHEIGHT CRWIDTH CRLEFT CRBOTTOM WHOLEHEIGHT WHOLEWIDTH XEXTENTUSE YEXTENTUSE)
(SETQ X (DSPCLIPPINGREGION NIL 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))
(AND EXTENT (SELECTQ EXTENTUSE
(NIL (* original scrolling mode.)
(SETQ XEXTENTUSE (QUOTE LIMIT))
(SETQ YEXTENTUSE (QUOTE +)))
((T + - +- LIMIT)
(SETQ XEXTENTUSE (SETQ YEXTENTUSE EXTENTUSE)))
(-+ (SETQ XEXTENTUSE (SETQ YEXTENTUSE (QUOTE +-))))
(COND
((LISTP EXTENTUSE)
(* CAR is X spec, CDR is Y spec)
(SETQ XEXTENTUSE (\DECODE.EXTENT.USE (CAR EXTENTUSE)))
(SETQ YEXTENTUSE (\DECODE.EXTENT.USE (CDR EXTENTUSE))))
(T (* unknown value, default to T)
(SETQ XEXTENTUSE (SETQ YEXTENTUSE T))))))
(* * calculate the amount to be moved in X)
(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)
CRWIDTH)))))
(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))))))
(* * calculate the amount to be moved in Y)
(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 (FIXR (FTIMES (FDIFFERENCE 1.0 YDELTA)
(IDIFFERENCE
(fetch (REGION HEIGHT)
of EXTENT)
CRHEIGHT)))
(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
((NOT (SUBREGIONP (fetch (SCREEN SCREGION) of (fetch (WINDOW SCREEN)
of WINDOW))
(WINDOWPROP WINDOW (QUOTE REGION))))
(* reduce clipping region to be that part of the
window that is on the screen.)
(COND
((NULL (SETQ X (INTERSECTREGIONS X (\DSPUNTRANSFORMREGION
(fetch (SCREEN SCREGION)
of (fetch (WINDOW SCREEN)
of WINDOW))
(fetch IMAGEDATA of DSP)))))
(* whole image is off the screen.
Just move the coordinates.)
(WXOFFSET XDELTA DSP)
(WYOFFSET YDELTA DSP)
(RETURN)))))
(* 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
((AND (NEQ XDELTA 0)
(COND
((AND EXTENT (NEQ XEXTENTUSE T)
(NEQ (fetch (REGION WIDTH) of EXTENT)
-1)) (* use the extent to limit the scrolling.)
(* for now limit right extent to right of window ETC.
ie keep it always visible.)
(SETQ XDELTA (IMIN (IDIFFERENCE CRLEFT (IDIFFERENCE
(fetch (REGION LEFT)
of EXTENT)
(SELECTQ XEXTENTUSE
((+- +)
(* if X is allowed to go off to right move effective
left of extent.)
CRWIDTH)
0)))
(IMAX (IDIFFERENCE (IPLUS CRLEFT CRWIDTH)
(PLUS (fetch
(REGION PRIGHT)
of EXTENT)
(SELECTQ
XEXTENTUSE
((- +-)
CRWIDTH)
0)))
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
((AND (NEQ YDELTA 0)
(COND
((AND EXTENT (NEQ YEXTENTUSE T)
(NEQ (fetch (REGION HEIGHT) of EXTENT)
-1)) (* limit amount by the extent)
(SETQ YDELTA (IMIN (IDIFFERENCE CRBOTTOM (IDIFFERENCE
(fetch (REGION BOTTOM)
of EXTENT)
(SELECTQ YEXTENTUSE
((+- +)
(* if Y is allowed to go off to top, move effective
bottom of extent.)
CRHEIGHT)
0)))
(IMAX (IDIFFERENCE (IPLUS CRBOTTOM CRHEIGHT)
(PLUS (fetch
(REGION PTOP)
of EXTENT)
(SELECTQ
YEXTENTUSE
((- +-)
CRHEIGHT)
0)))
YDELTA)))
(* old code (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 " 2-May-85 10:11")
(* is X, Y in the scroll bar for WINDOW?)
(AND (fetch SCROLLFN of WINDOW)
(NOT (WINDOWPROP WINDOW (QUOTE NOSCROLLBARS)))
(COND
((INSIDE? (fetch REG of WINDOW)
X Y)
(* if it is inside the window, it is not in its scroll bar. This handles case where window is near left or bottom
edge.)
NIL)
((INSIDE? (fetch (WINDOW VERTSCROLLREG) of WINDOW)
X Y)
(PROG ((EXTENT (WINDOWPROP WINDOW (QUOTE EXTENT)))
(EXTENTUSE (WINDOWPROP WINDOW (QUOTE SCROLLEXTENTUSE))))
(RETURN (COND
((OR (NOT EXTENT)
(EQ (fetch (REGION WIDTH) of EXTENT)
-1)
(NOT EXTENTUSE)
(NEQ (COND
((LISTP EXTENTUSE)
(\DECODE.EXTENT.USE (CDR EXTENTUSE)))
(T (\DECODE.EXTENT.USE EXTENTUSE)))
(QUOTE LIMIT))))
(T (EXTENDPASTVERTBOUNDARIES (DSPCLIPPINGREGION NIL WINDOW)
EXTENT))))))
((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)))
(EXTENTUSE (WINDOWPROP WINDOW (QUOTE SCROLLEXTENTUSE))))
(RETURN (COND
((OR (NOT EXTENT)
(EQ (fetch (REGION WIDTH) of EXTENT)
-1)
(NEQ (COND
((LISTP EXTENTUSE)
(\DECODE.EXTENT.USE (CAR EXTENTUSE)))
(T (\DECODE.EXTENT.USE EXTENTUSE)))
(QUOTE LIMIT))))
(T (EXTENDPASTHORIZBOUNDARIES (DSPCLIPPINGREGION NIL WINDOW)
EXTENT))))))))))
(RELDSPXOFFSET
[LAMBDA (DX DISPLAYSTREAM) (* kbr: "18-Jan-86 18:02")
(* relative offsetting function.)
(DSPXOFFSET (IPLUS DX (DSPXOFFSET NIL DISPLAYSTREAM))
DISPLAYSTREAM])
(RELDSPYOFFSET
[LAMBDA (DY DISPLAYSTREAM) (* kbr: "18-Jan-86 18:03")
(* relative offsetting function.)
(DSPYOFFSET (IPLUS DY (DSPYOFFSET NIL DISPLAYSTREAM))
DISPLAYSTREAM])
(SCROLL.HANDLER
(LAMBDA (WINDOW) (* rrb " 2-May-85 12:13")
(* 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)
(* create a window as the easiest thing to do.
Fairly inefficient.)
(* if the main window is not open, it was probably
closed before we got control here.
Don't do anything.)
(OR (OPENWP WINDOW)
(RETURN))
(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)
(* set up the timer for when to bring the window to the top. This gives the user a chance to notice that the scroll
bar has come up and get out of it if it was unintentional.)
(SETQ TIMEIN (SETUPTIMER 1200))
(RETURN (RESETFORM (CURSOR SCROLLCURSOR)
(PROG NIL
LP (GETMOUSESTATE)
(COND
((NOT (OPENWP WINDOW))
(* the user closed the window, quit.)
(CLOSEW SCROLLW)
(SETQ \LastInWindow NIL)
(RETURN T)))
(COND
((AND TIMEIN (TIMEREXPIRED? TIMEIN))
(* after a little while, bring the window to the top.
This avoids bringing it up if nothing is happening.)
(SETQ TIMEIN NIL)
(TOTOPW WINDOW)))
(COND
((NOT (INSIDE? SCROLLREG LASTMOUSEX LASTMOUSEY))
(* if cursor is no longer in scroll region quit.)
(CLOSEW SCROLLW)
(* if the mouse is in the window, set last in window so window will get control again. If it is outside, don't set
it so that the cursoroutfn for WINDOW will get called.)
(AND (INSIDE? (WINDOWPROP WINDOW (QUOTE REGION)
)
LASTMOUSEX LASTMOUSEY)
(SETQ \LastInWindow NIL))
(RETURN T)))
(* bring the scroll window to the top so that it will
be visible.)
(TOTOPW SCROLLW)
(COND
((LASTMOUSESTATE UP)
(* no buttons down; if there was one down, take
action; otherwise, wait for one to go down.)
(COND
(BUTTON (COND
(CONTINUOUSSCROLL?
(* were continuously scrolling, stop it.)
(SETQ
CONTINUOUSSCROLL? NIL)
)
(T (\SCROLL.HANDLER.DOIT WINDOW BUTTON
DIRECTION
SCROLLREG
LASTMOUSEX
LASTMOUSEY)
(\UPDATE.EXTENT.IMAGE SCROLLW
DIRECTION
WINDOW)))
(CURSOR SCROLLCURSOR)
(SETQ BUTTON)
(* if a button went up, reset the timedown for
scrolling.)
(SETQ TIMEDOWN)
(SETQ CONTINUOUSSCROLL? NIL))
(T (BLOCK))))
((LASTMOUSESTATE (OR LEFT RIGHT))
(COND
((AND (LASTMOUSESTATE LEFT)
(NEQ BUTTON (QUOTE LEFT)))
(* LEFT button just when down.)
(SETQ BUTTON (QUOTE LEFT))
(SETQ TIMEDOWN (CLOCK 0))
(CURSOR LEFTCURSOR))
((AND (LASTMOUSESTATE RIGHT)
(NEQ BUTTON (QUOTE RIGHT)))
(* RIGHT button just when down.)
(SETQ BUTTON (QUOTE RIGHT))
(SETQ TIMEDOWN (CLOCK 0))
(CURSOR RIGHTCURSOR))
((AND CONTINUOUSSCROLL? (\CLOCKGREATERP TIMEDOWN
WAITBETWEENSCROLLTIME))
(* button is still down, keep scrolling.)
(* note time before calling scroll fn so time to
display is included in the wait time.)
(SETQ TIMEDOWN (\CLOCK0 TIMEDOWN))
(\SCROLL.HANDLER.DOIT WINDOW BUTTON DIRECTION
SCROLLREG LASTMOUSEX
LASTMOUSEY T)
(\UPDATE.EXTENT.IMAGE SCROLLW DIRECTION WINDOW))
((\CLOCKGREATERP TIMEDOWN WAITBEFORESCROLLTIME)
(* has enough time past to start continuous scroll?)
(SETQ CONTINUOUSSCROLL? T))))
((LASTMOUSESTATE MIDDLE)
(COND
((NEQ BUTTON (QUOTE MIDDLE))
(* MIDDLE button just when down.)
(SETQ BUTTON (QUOTE MIDDLE))
(* don't keep track of time down for middle buttons.)
(CURSOR MIDDLECURSOR))
(T NIL))))
(GO LP)))))))
(\SCROLL.HANDLER.DOIT
(LAMBDA (WINDOW BUTTON DIRECTION SCROLLREGION XPOS YPOS CONTINUOUS?)
(* rrb " 2-Oct-85 16:31")
(* decodes how far to scroll given that the button was
let up at position XPOS YPOS in the scroll region
SCROLLREGION.)
(ERSETQ
(PROG ((WBORDER (WINDOWPROP WINDOW (QUOTE BORDER)))
LFT TOP (SIZEOFORIGIN 8)) (* correct for the border on the window so that it
never moves more than the amount that is seen.)
(SETQ LFT (IPLUS WBORDER (fetch (REGION LEFT) of SCROLLREGION)))
(SETQ TOP (IDIFFERENCE (fetch (REGION TOP) of SCROLLREGION)
WBORDER))
(RETURN
(SCROLLW
WINDOW
(COND
((EQ DIRECTION (QUOTE HORIZ))
(SELECTQ BUTTON
(LEFT (* always scroll at least 1)
(IMIN (IDIFFERENCE LFT XPOS)
1))
(RIGHT (* correct for border in window.)
(IMAX (IDIFFERENCE XPOS LFT)
1))
(MIDDLE (COND
((IGREATERP (IPLUS LFT SIZEOFORIGIN)
XPOS)
(* make a portion of the left of the scroll bar
indicate left edge of doc since it is a common case.)
0.0)
(T (MIN 1.0 (MAX 0.0
(FQUOTIENT
(IDIFFERENCE XPOS
(IPLUS LFT
SIZEOFORIGIN))
(IDIFFERENCE (fetch
(REGION WIDTH)
of SCROLLREGION)
(IPLUS 4
SIZEOFORIGIN)))))
)))
(SHOULDNT)))
(T 0))
(COND
((EQ DIRECTION (QUOTE VERT))
(SELECTQ BUTTON
(LEFT (* always scroll at least 1)
(IMAX (IDIFFERENCE TOP YPOS)
1))
(RIGHT (IMIN (IDIFFERENCE YPOS TOP)
-1))
(MIDDLE (COND
((IGREATERP YPOS (IDIFFERENCE TOP SIZEOFORIGIN))
(* make a portion of the top of the scroll bar
indicate top edge of doc since it is a common case.)
0.0)
(T (MIN 1.0 (MAX 0.0
(FQUOTIENT
(IDIFFERENCE (IDIFFERENCE
TOP SIZEOFORIGIN)
YPOS)
(IDIFFERENCE (fetch
(REGION HEIGHT)
of SCROLLREGION)
(IPLUS 4
SIZEOFORIGIN)))))
)))
(SHOULDNT)))
(T 0))
CONTINUOUS?))))))
(\DECODE.EXTENT.USE
(LAMBDA (EXTENTUSE) (* rrb " 2-May-85 08:59")
(* * decodes an indicator of how the extent should be used to limit scrolling.)
(SELECTQ EXTENTUSE
(NIL (QUOTE LIMIT))
((LIMIT T + - +-)
EXTENTUSE)
(-+ (QUOTE +-))
T)))
(\UPDATE.EXTENT.IMAGE
(LAMBDA (SCROLLBARW DIRECTION SCROLLINGW) (* rrb " 5-Oct-85 11:37")
(* 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 (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.
If height is 0, return also.)
(OR (GREATERP EXHEIGHT 0)
(RETURN))
(SETQ SCROLLWIDTH (fetch (REGION WIDTH) of SCROLLREGION))
(SETQ SCROLLHEIGHT (fetch (REGION HEIGHT) of SCROLLREGION))
(SETQ WINHEIGHT (fetch (REGION HEIGHT) of WINREGION))
(SETQ GRAYHEIGHT (IMAX 2 (IMIN SCROLLHEIGHT (IQUOTIENT (ITIMES
WINHEIGHT
SCROLLHEIGHT)
EXHEIGHT))))
(SETQ GRAYBOTTOM (IDIFFERENCE
(IDIFFERENCE SCROLLHEIGHT (IQUOTIENT
(ITIMES SCROLLHEIGHT (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)
(OR (TEXTUREP SCROLLBARSHADE)
32800))))
((EQ DIRECTION (QUOTE HORIZ))
(PROG (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.
If width is zero, return too.)
(AND (GREATERP 0 EXWIDTH)
(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)
(OR (TEXTUREP SCROLLBARSHADE)
32800))))))))
(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)))))
(EXTENDPASTVERTBOUNDARIES
(LAMBDA (VIEW EXTENT) (* rrb " 2-May-85 10:10")
(* does VIEW entirely cover the vertical dimensions of
EXTENT?)
(OR (IGREATERP (fetch (REGION BOTTOM) of VIEW)
(fetch (REGION BOTTOM) of EXTENT))
(IGREATERP (fetch (REGION TOP) of EXTENT)
(fetch (REGION TOP) of VIEW)))))
(REDISPLAYW
(LAMBDA (WINDOW REGION ALWAYSFLG) (* rrb " 3-Jul-84 17:11")
(* 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)
(OR (SETQ REGION (INTERSECTREGIONS REGION CLIPREG))
(RETURN))))
(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) (* gbn: "25-Jan-86 16:16")
(* updates the scroll region field of the WINDOW)
(COND
((fetch (WINDOW SCROLLFN) of WINDOW)
(PROG ((IMAGEREG (fetch (WINDOW 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
(fetch (SCREEN SCTITLEDS)
of (fetch
(WINDOW SCREEN)
of WINDOW))))
(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 SCREEN)
(* kbr: "29-Mar-85 14:11")
(* returns the exterior height of a window which has interior height dimension INTERIORHEIGHT)
(SETQ SCREEN (\INSURESCREEN SCREEN))
(IPLUS INTERIORHEIGHT (COND
(TITLEFLG (IMINUS (DSPLINEFEED NIL
(fetch
(SCREEN SCTITLEDS)
of SCREEN))))
(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) (* bvm:
"25-Mar-86 17:24")
(* 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))
(COND
((NOT (OPENWP WINDOW)) (* if it is not
currently open, don't do
anything. Maybe
something should happen
here but I don't
understand what -
rrb)
NIL)
((WINDOWPROP WINDOW (QUOTE ICONFOR)) (* This is already an
icon!)
NIL)
((EQ (DOUSERFNS (WINDOWPROP WINDOW (QUOTE SHRINKFN))
WINDOW T)
(QUOTE DON'T)) (* one of the shrinkfns
disallowed the
shrinkage.)
NIL)
(T (LET (TITLE ICONW FN ICONISBITMAP) (* get the icon
specification from the
window if none is given.)
[SETQ ICONW (COND
((type? BITMAP TOWHAT) (* use bitMap to create
a WINDOW)
[WINDOWPROP WINDOW (QUOTE ICON)
(SETQ TOWHAT (CREATEWFROMIMAGE (BITMAPCOPY (SETQ ICONISBITMAP
TOWHAT))
(fetch (WINDOW SCREEN) of WINDOW]
(* save the icon on the
window so that next time
it will shrink to the
same thing.)
TOWHAT)
((WINDOWP TOWHAT) (* use given WINDOW as
icon)
(WINDOWPROP WINDOW (QUOTE ICON)
TOWHAT) (* save the icon on the
window so that next time
it will shrink to the
same thing.)
TOWHAT)
((STRINGP TOWHAT)
[WINDOWPROP WINDOW (QUOTE ICON)
(SETQ TOWHAT (\DTEST (APPLY* DEFAULTICONFN WINDOW TOWHAT)
(QUOTE WINDOW]
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)
TOWHAT)
((type? BITMAP TOWHAT) (* use bitMap to create
a WINDOW)
(CREATEWFROMIMAGE (BITMAPCOPY (SETQ ICONISBITMAP TOWHAT))
(fetch (WINDOW SCREEN) of WINDOW)))
(T
(* Call default icon maker. Note: don't store this as the ICON property,
because we want it to be recomputed each time, because, for example, the
window's title, from which the icon text is derived, might change.
Not a problem for windows that have an ICONFN because then the ICONFN is
responsible for keeping it up to date)
(\DTEST (APPLY* DEFAULTICONFN WINDOW TOWHAT)
(QUOTE WINDOW]
(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)
(FUNCTION CLOSEMAINWINDOW)) (* set up so that if
main window is opened,
icon is closed.)
[COND
((EQ (WINDOWPROP ICONW (QUOTE BUTTONEVENTFN))
(QUOTE TOTOPW)) (* if the iconw doesn't
have a buttoneventfn,
give it one that the
middle expands it.)
(WINDOWPROP ICONW (QUOTE BUTTONEVENTFN)
(FUNCTION ICONBUTTONEVENTFN]
(WINDOWADDFNPROP WINDOW (QUOTE OPENFN)
(FUNCTION CLOSEICONWINDOW))
(WINDOWADDFNPROP ICONW (QUOTE MOVEFN)
(FUNCTION \NOTENEWICONPOSITION))
(AND EXPANDFN (WINDOWADDFNPROP WINDOW (QUOTE EXPANDFN)
EXPANDFN))
(WINDOWPROP ICONW (QUOTE DOWINDOWCOMFN)
(FUNCTION DOICONWINDOWCOM))
[COND
((AND (NEQ ICONPOSITION (QUOTE SAME))
(OR ICONISBITMAP (POSITIONP ICONPOSITION))) (* If ICONPOSITION given
explicitly, or we
derived the icon as a
bitmap, need to move it
into new position)
(MOVEW ICONW (COND
((POSITIONP ICONPOSITION)
(WINDOWPROP ICONW (QUOTE ICONPOSITION)
ICONPOSITION)
ICONPOSITION)
((PROG1 (POSITIONP (WINDOWPROP WINDOW (QUOTE ICONPOSITION)))
(* leave it in its
current location.)
))
(T (ICONPOSITION.FROM.WINDOW WINDOW (WINDOWPROP ICONW (QUOTE
REGION]
(TOTOPW WINDOW T) (* bring it to the top
without callings its
totopfns in case the
shrinkfns brought
another window to the
top.)
(\CLOSEW1 WINDOW)
(OPENW ICONW)
ICONW])
(ICONBUTTONEVENTFN
[LAMBDA (ICONW) (* bvm:
"25-Mar-86 17:23")
(* * Default icon BUTTONEVENTFN -- middle button expands it, left button
moves it)
(COND
[(LASTMOUSESTATE MIDDLE)
(CURSOR (PROG1 (CURSOR WAITINGCURSOR)
(EXPANDW ICONW]
(T (MOVEW ICONW])
(ICONPOSITION.FROM.WINDOW
[LAMBDA (WINDOW ICONREGION) (* bvm:
"18-Mar-86 14:03")
(OR (POSITIONP (WINDOWPROP WINDOW (QUOTE ICONPOSITION)))
(LET ((WREG (WINDOWPROP WINDOW (QUOTE REGION)))
SCREEN)
(SETQ SCREEN (fetch (WINDOW SCREEN) of WINDOW))
(create POSITION
XCOORD ←[COND
((ILESSP (fetch (REGION LEFT) of WREG)
(IDIFFERENCE (fetch (SCREEN SCWIDTH) of SCREEN)
(fetch (REGION PRIGHT) of WREG)))
(IMAX 0 (fetch (REGION LEFT) of WREG)))
(T (IDIFFERENCE (IMIN (fetch (SCREEN SCWIDTH) of SCREEN)
(fetch (REGION PRIGHT) of WREG))
(fetch (REGION WIDTH) of ICONREGION]
YCOORD ←(COND
((ILESSP (fetch (REGION BOTTOM) of WREG)
(IDIFFERENCE (fetch (SCREEN SCHEIGHT) of SCREEN)
(fetch (REGION PTOP) of WREG)))
(IMAX 0 (fetch (REGION BOTTOM) of WREG)))
(T (IDIFFERENCE (IMIN (fetch (SCREEN SCHEIGHT) of SCREEN)
(fetch (REGION PTOP) of WREG))
(fetch (REGION HEIGHT) of ICONREGION])
(MAKETITLEBARICON
[LAMBDA (WINDOW TEXT) (* bvm:
"18-Mar-86 14:04")
(* * Make a "title bar" icon consisting of TEXT or WINDOW's TITLE if TEXT
is NIL)
(PROG ((SCREEN (fetch (WINDOW SCREEN) of WINDOW))
W REG POS)
[COND
((AND (NULL TEXT)
(OR [NULL (SETQ TEXT (WINDOWPROP WINDOW (QUOTE TITLE]
(EQ (NCHARS TEXT)
0)))
(SETQ TEXT (CONCAT "Icon made " (DATE]
[SETQ POS (ICONPOSITION.FROM.WINDOW WINDOW
(SETQ REG (create REGION
LEFT ← 0
BOTTOM ← 0
HEIGHT ←(IMINUS (DSPLINEFEED NIL (fetch (SCREEN SCTITLEDS
)
of SCREEN)))
WIDTH ←(IMAX MinWindowWidth
(IPLUS 8 (STRINGWIDTH TEXT
(fetch (SCREEN SCTITLEDS)
of SCREEN]
(* Position the icon
near the current
location of the window)
(replace (REGION LEFT) of REG with (fetch (POSITION XCOORD) of POS))
(replace (REGION BOTTOM) of REG with (fetch (POSITION YCOORD) of POS))
(SETQ W (CREATEW REG TEXT NIL T))
(WINDOWPROP W (QUOTE MINSIZE)
(FUNCTION \TITLEICONMINSIZE))
(RETURN W])
(\TITLEICONMINSIZE
[LAMBDA (WINDOW) (* kbr: "29-Mar-85 14:14")
(* returns the minimum size the default icon can be.)
(CONS MinWindowWidth (IMINUS (DSPLINEFEED
NIL
(fetch (SCREEN SCTITLEDS)
of (fetch (WINDOW SCREEN)
of WINDOW])
(\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 " 2-Jul-84 15:41")
(* 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.)
(COND
((OPENWP (SETQ MAINWINDOW ICONW)) (* make sure the window is shrunken.)
(RETURN 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) (* rrb " 1-May-85 15:55")
(* the open function for a window which has an icon.
It closes the (icon and does the expandfns))
(PROG ((ICONW (WINDOWPROP MAINWIN (QUOTE ICONWINDOW)))
USEREXPANDFN)
(* this code duplicates much of EXPANDW but I couldn't quite get it to be a call because EXPANDW opens the main
window which in this case is already open.)
(COND
(ICONW (* Don't die if user removed the ICONWINDOW prop)
(WINDOWDELPROP ICONW (QUOTE CLOSEFN)
(QUOTE CLOSEMAINWINDOW))
(* remove the mainwindowclosing function first.)
(CLOSEW ICONW)
(DOUSERFNS (WINDOWPROP MAINWIN (QUOTE EXPANDFN))
MAINWIN) (* break link from icon to main window.)
(WINDOWPROP ICONW (QUOTE ICONFOR)
NIL))) (* remove icon closing function.)
(WINDOWDELPROP MAINWIN (QUOTE OPENFN)
(QUOTE CLOSEICONWINDOW)))))
)
(RPAQ? IconWindowMenu )
(RPAQ? DEFAULTICONFN (QUOTE MAKETITLEBARICON))
(ADDTOVAR IconWindowMenuCommands (Close (QUOTE CLOSEW)
"Closes the icon and its associated 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."))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS DEFAULTICONFN IconWindowMenu IconWindowMenuCommands)
)
(RPAQ VertScrollCursor (CURSORCREATE (READBITMAP) NIL 7 15))
(16 16
"@A@@"
"@CH@"
"@CH@"
"@GL@"
"@GL@"
"@ON@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@ON@"
"@GL@"
"@GL@"
"@CH@"
"@CH@"
"@A@@")(RPAQ ScrollUpCursor (CURSORCREATE (READBITMAP) NIL 7 15))
(16 16
"@A@@"
"@CH@"
"@CH@"
"@GL@"
"@GL@"
"@ON@"
"@ON@"
"AOO@"
"AOO@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@")(RPAQ ScrollDownCursor (CURSORCREATE (READBITMAP) NIL 7 15))
(16 16
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"AOO@"
"AOO@"
"@ON@"
"@ON@"
"@GL@"
"@GL@"
"@CH@"
"@CH@"
"@A@@")(RPAQ HorizScrollCursor (CURSORCREATE (READBITMAP) NIL 7 5))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@HB@"
"AHC@"
"CHCH"
"GHCL"
"OOON"
"OOON"
"GHCL"
"CHCH"
"AHC@"
"@HB@")(RPAQ ScrollLeftCursor (CURSORCREATE (READBITMAP) NIL 8 5))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@H@"
"@CH@"
"@OH@"
"COH@"
"OOOO"
"OOOO"
"COH@"
"@OH@"
"@CH@"
"@@H@")(RPAQ ScrollRightCursor (CURSORCREATE (READBITMAP) NIL 7 5))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@A@@"
"@AL@"
"@AO@"
"@AOL"
"OOOO"
"OOOO"
"@AOL"
"@AO@"
"@AL@"
"@A@@")(RPAQ VertThumbCursor (CURSORCREATE (READBITMAP) NIL 6 8))
(16 16
"@@@@"
"OH@@"
"@@@@"
"OO@@"
"@@@@"
"OON@"
"@@@@"
"OOOH"
"@@@@"
"OON@"
"@@@@"
"OO@@"
"@@@@"
"OH@@"
"@@@@"
"@@@@")(RPAQ HorizThumbCursor (CURSORCREATE (READBITMAP) NIL 6 6))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@B@@"
"@B@@"
"@JH@"
"@JH@"
"@JH@"
"BJJ@"
"BJJ@"
"BJJ@"
"JJJH"
"JJJH"
"JJJH"
"JJJH"
"JJJH")(RPAQ WAITINGCURSOR (CURSORCREATE (READBITMAP) NIL 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
(GLOBALVARS \LastCursorPosition \LastInWindow WindowMenu BackgroundMenu BackgroundMenuCommands
\LastWindowButtons WWFNS WindowMenuCommands 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 SCREEN)
BUTTONEVENTFN ←(FUNCTION TOTOPW)
WBORDER ← WBorder WINDOWENTRYFN ←(FUNCTION GIVE.TTY.PROCESS)
(SYSTEM))
(DATATYPE SCREEN (SCONOFF SCDESTINATION SCWIDTH SCHEIGHT SCTOPW SCTOPWDS SCTITLEDS SCFDEV SCDS SCDATA
)
SCONOFF ←(QUOTE OFF)
[ACCESSFNS ((SCBITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL)
of (fetch (SCREEN SCDESTINATION) of DATUM)))
(SCREGION (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ←(fetch (SCREEN SCWIDTH) of DATUM)
HEIGHT ←(fetch (SCREEN SCHEIGHT) of DATUM]
(SYSTEM))
]
(/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 POINTER))
(QUOTE ((WINDOW 0 POINTER)
(WINDOW 2 POINTER)
(WINDOW 4 POINTER)
(WINDOW 6 POINTER)
(WINDOW 8 POINTER)
(WINDOW 10 POINTER)
(WINDOW 12 POINTER)
(WINDOW 14 POINTER)
(WINDOW 16 POINTER)
(WINDOW 18 POINTER)
(WINDOW 20 POINTER)
(WINDOW 22 POINTER)
(WINDOW 24 POINTER)
(WINDOW 26 POINTER)
(WINDOW 28 POINTER)
(WINDOW 30 POINTER)
(WINDOW 32 POINTER)
(WINDOW 34 POINTER)
(WINDOW 36 POINTER)
(WINDOW 38 POINTER)
(WINDOW 40 POINTER)
(WINDOW 42 POINTER)
(WINDOW 44 POINTER)
(WINDOW 46 POINTER)
(WINDOW 48 POINTER)
(WINDOW 50 POINTER)))
(QUOTE 52))
(/DECLAREDATATYPE (QUOTE SCREEN)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((SCREEN 0 POINTER)
(SCREEN 2 POINTER)
(SCREEN 4 POINTER)
(SCREEN 6 POINTER)
(SCREEN 8 POINTER)
(SCREEN 10 POINTER)
(SCREEN 12 POINTER)
(SCREEN 14 POINTER)
(SCREEN 16 POINTER)
(SCREEN 18 POINTER)))
(QUOTE 20))
(* END EXPORTED DEFINITIONS)
)
(DECLARE: EVAL@COMPILE
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS WINDOWUSERFORMS ENDOFWINDOWUSERFORMS PROMPTWINDOW)
)
(* 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 SCREEN))
(DATATYPE SCREEN (SCONOFF SCDESTINATION SCWIDTH SCHEIGHT SCTOPW SCTOPWDS SCTITLEDS SCFDEV SCDS SCDATA
))
]
(/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 POINTER))
(QUOTE ((WINDOW 0 POINTER)
(WINDOW 2 POINTER)
(WINDOW 4 POINTER)
(WINDOW 6 POINTER)
(WINDOW 8 POINTER)
(WINDOW 10 POINTER)
(WINDOW 12 POINTER)
(WINDOW 14 POINTER)
(WINDOW 16 POINTER)
(WINDOW 18 POINTER)
(WINDOW 20 POINTER)
(WINDOW 22 POINTER)
(WINDOW 24 POINTER)
(WINDOW 26 POINTER)
(WINDOW 28 POINTER)
(WINDOW 30 POINTER)
(WINDOW 32 POINTER)
(WINDOW 34 POINTER)
(WINDOW 36 POINTER)
(WINDOW 38 POINTER)
(WINDOW 40 POINTER)
(WINDOW 42 POINTER)
(WINDOW 44 POINTER)
(WINDOW 46 POINTER)
(WINDOW 48 POINTER)
(WINDOW 50 POINTER)))
(QUOTE 52))
(/DECLAREDATATYPE (QUOTE SCREEN)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((SCREEN 0 POINTER)
(SCREEN 2 POINTER)
(SCREEN 4 POINTER)
(SCREEN 6 POINTER)
(SCREEN 8 POINTER)
(SCREEN 10 POINTER)
(SCREEN 12 POINTER)
(SCREEN 14 POINTER)
(SCREEN 16 POINTER)
(SCREEN 18 POINTER)))
(QUOTE 20))
(RPAQ? WWFNS (QUOTE (\TOTOPWDS)))
(RPAQ? WindowMenu )
(RPAQ? BackgroundMenu )
(RPAQ? \LastCursorPosition (CREATEPOSITION))
(RPAQ? \LastInWindow )
(RPAQ? \LastWindowButtons 0)
(RPAQ? WINDOWBACKGROUNDSHADE 34850)
(RPAQ? WBorder 4)
(RPAQ? SCROLLBARWIDTH 24)
(RPAQ? SCROLLWAITTIME 100)
(RPAQ? SCROLLBARSHADE 32800)
(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)
(RPAQ? PAINTCURSOR )
(RPAQ? WINDOWBACKGROUNDBORDER 34850)
(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.")
(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.")
(Hardcopy (QUOTE HARDCOPYIMAGEW)
"Prints a window using its HARDCOPYFN."
(SUBITEMS ("To a file" (QUOTE HARDCOPYIMAGEW.TOFILE)
"Puts image on a file; prompts for filename and format"
)
("To a printer" (QUOTE HARDCOPYIMAGEW.TOPRINTER)
"Sends image to a printer of your choosing")))
(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 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."
(SUBITEMS ("To a file" (QUOTE (HARDCOPYREGION.TOFILE))
"Writes a region of screen to a file; prompts for filename and format"
)
("To a printer" (QUOTE (HARDCOPYREGION.TOPRINTER))
"Sends a region of screen to a printer of your choosing"
))))
(ADDTOVAR WINDOWUSERFORMS )
(ADDTOVAR ENDOFWINDOWUSERFORMS )
(PAINTW.CACHE.SHADE BLACKSHADE)
(PAINTW.CACHE.SHADE GRAYSHADE)
(PAINTW.CACHE.SHADE HIGHLIGHTSHADE)
(DECLARE: DOCOPY DONTEVAL@LOAD
(COND ((NULL \MAINSCREEN)
(SETQ \MAINSCREEN (CREATESCREEN (SCREENBITMAP)))
(SETQ \CURSORSCREEN \MAINSCREEN)
(SETQ LASTSCREEN \MAINSCREEN)
(WINDOWWORLD (QUOTE ON)
\MAINSCREEN T)))
(ADDTOVAR GLOBALVARS SCROLLBARWIDTH SCROLLWAITTIME SCROLLBARSHADE WAITBEFORESCROLLTIME
WAITBETWEENSCROLLTIME WAITINGCURSOR)
(RPAQQ \WINDOWWORLD T)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA PROMPTPRINT WINDOWPROP IMAGEOBJPROP)
)
(PUTPROPS WINDOW COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (13966 33936 (WINDOWWORLD 13976 . 22539) (WINDOWWORLDP 22541 . 22809) (CHANGEBACKGROUND
22811 . 23687) (CHANGEBACKGROUNDBORDER 23689 . 24574) (TILE 24576 . 25130) (LOGOW 25132 . 27806) (
\DRAWLOGOWINDOWIMAGE 27808 . 28452) (\TTY.CREATING.DISPLAYSTREAM 28454 . 28988) (\CREATE.TTY.OUTCHARFN
28990 . 29741) (\CREATE.TTYDISPLAYSTREAM 29743 . 31346) (HASTTYWINDOWP 31348 . 31678) (TTYINFOSTREAM
31680 . 32176) (CREATESCREEN 32178 . 33150) (\INSURESCREEN 33152 . 33398) (\BITMAPTOSCREEN 33400 .
33727) (MAINSCREEN 33729 . 33934)) (34445 46815 (WINDOW.MOUSE.HANDLER 34455 . 43740) (\PROTECTED.APPLY
43742 . 44010) (DOWINDOWCOM 44012 . 45115) (DOBACKGROUNDCOM 45117 . 46021) (DEFAULT.BACKGROUND.COPYFN
46023 . 46813)) (46896 85662 (BURYW 46906 . 48030) (CLEARW 48032 . 48516) (CLOSEW 48518 . 49112) (
\CLOSEW1 49114 . 50117) (\OKTOCLOSEW 50119 . 50535) (OPENW 50537 . 51535) (DOUSERFNS 51537 . 52541) (
DOUSERFNS2 52543 . 53113) (\USERFNISDON'T 53115 . 53472) (\OPENW1 53474 . 54725) (CREATEW 54727 .
58802) (OPENDISPLAYSTREAM 58804 . 59100) (MOVEW 59102 . 67104) (\ONSCREENCLIPPINGREGION 67106 . 67591)
(RELMOVEW 67593 . 68143) (PAINTW 68145 . 73190) (PAINTW.READMODE 73192 . 73813) (
PAINTW.READBRUSHSHAPE 73815 . 74160) (PAINTW.READBRUSHSIZE 74162 . 74456) (SHAPEW 74458 . 76419) (
SHAPEW1 76421 . 78411) (RESHOWBORDER 78413 . 78915) (\RESHOWBORDER1 78917 . 82009) (TRACKW 82011 .
83005) (SNAPW 83007 . 84380) (WINDOWREGION 84382 . 84871) (PAINTW.READCOMMAND 84873 . 85660)) (85663
88829 (PAINTW.READBRUSHSHADE 85673 . 86871) (PAINTW.READBRUSHTEXTURE 86873 . 87164) (
PAINTW.READ.AND.SAVE.SHADE 87166 . 87762) (PAINTW.CACHE.SHADE 87764 . 88364) (PAINTW.SHADE.LABEL 88366
. 88827)) (88922 89710 (MINIMUMWINDOWSIZE 88932 . 89708)) (94957 110602 (COPYINSERT 94967 . 96077) (
IMAGEBOX 96079 . 96271) (IMAGEFNSCREATE 96273 . 97528) (IMAGEFNSP 97530 . 97767) (IMAGEOBJCREATE 97769
. 98260) (IMAGEOBJP 98262 . 98499) (IMAGEOBJPROP 98501 . 102985) (\IMAGEUSERPROP 102987 . 103566) (
HPRINT.IMAGEOBJ 103568 . 104218) (COPYIMAGEOBJ 104220 . 104852) (READIMAGEOBJ 104854 . 109365) (
WRITEIMAGEOBJ 109367 . 110600)) (110811 117929 (ENCAPSULATEDOBJ.BUTTONEVENTINFN 110821 . 112389) (
ENCAPSULATEDOBJ.PUTFN 112391 . 113682) (ENCAPSULATEDOBJ.DISPLAYFN 113684 . 115567) (
ENCAPSULATEDOBJ.IMAGEBOXFN 115569 . 116347) (ENCAPSULATEDIMAGEFNS 116349 . 117927)) (118068 136204 (
ADVISEWDS 118078 . 122802) (SHOWWFRAME 122804 . 124431) (SHOWWTITLE 124433 . 127062) (
\STRINGWIDTHGUESS 127064 . 128102) (RESHOWTITLE 128104 . 131655) (TOTOPW 131657 . 132858) (
\INTERNALTOTOPW 132860 . 133759) (\TTW1 133761 . 135662) (WHICHW 135664 . 136202)) (136327 139148 (
SWITCHDEF 136337 . 136568) (WFROMDS 136570 . 138356) (NU\TOTOPWDS 138358 . 138655) (\COERCETODS 138657
. 139146)) (139801 155039 (WINDOWP 139811 . 139957) (INSURE.WINDOW 139959 . 140407) (WINDOWPROP
140409 . 140897) (WINDOWADDPROP 140899 . 142000) (WINDOWDELPROP 142002 . 142451) (GETWINDOWPROP 142453
. 145409) (GETWINDOWUSERPROP 145411 . 145849) (PUTWINDOWPROP 145851 . 153311) (REMWINDOWPROP 153313
. 154142) (WINDOWADDFNPROP 154144 . 155037)) (155230 164406 (CWINDOWPROP 155240 . 156232) (
CGETWINDOWPROP 156234 . 163185) (\GETWINDOWHEIGHT 163187 . 163912) (\GETWINDOWWIDTH 163914 . 164404))
(164407 178234 (OPENWP 164417 . 164745) (TOPWP 164747 . 165413) (RESHAPEBYREPAINTFN 165415 . 173758) (
\INBETWEENP 173760 . 174035) (DECODE/WINDOW/OR/DISPLAYSTREAM 174037 . 175415) (GROW/REGION 175417 .
175996) (PPROMPT3 175998 . 176397) (CLRPROMPT 176399 . 176746) (PROMPTPRINT 176748 . 177079) (
OPENWINDOWS 177081 . 177844) (\INSUREWINDOW 177846 . 178232)) (178434 181401 (OVERLAPPINGWINDOWS
178444 . 180348) (WOVERLAPP 180350 . 180654) (ORDERFROMBOTTOMTOTOP 180656 . 181399)) (181446 185857 (
\ONSCREENW 181456 . 182152) (\PUTONSCREENW 182154 . 182706) (\UPDATECACHEDFIELDS 182708 . 183037) (
\WWCHANGESCREENSIZE 183039 . 184300) (CREATEWFROMIMAGE 184302 . 185139) (UPDATEWFROMIMAGE 185141 .
185855)) (185886 225459 (SCROLLW 185896 . 186413) (SCROLLBYREPAINTFN 186415 . 196129) (ADJUSTOFFSETS
196131 . 196494) (CREATESCROLLINGW 196496 . 196724) (IN/SCROLL/BAR? 196726 . 198769) (RELDSPXOFFSET
198771 . 199034) (RELDSPYOFFSET 199036 . 199299) (SCROLL.HANDLER 199301 . 206927) (
\SCROLL.HANDLER.DOIT 206929 . 209756) (\DECODE.EXTENT.USE 209758 . 210109) (\UPDATE.EXTENT.IMAGE
210111 . 213756) (EXTENDPASTHORIZBOUNDARIES 213758 . 214252) (EXTENDPASTVERTBOUNDARIES 214254 . 214745
) (REDISPLAYW 214747 . 216347) (FILLWITHBACKGROUND 216349 . 216754) (UPDATE/SCROLL/REG 216756 . 218683
) (WTODSX 218685 . 219133) (WTODSY 219135 . 219585) (WXOFFSET 219587 . 220474) (WYOFFSET 220476 .
221367) (BITMAPSCROLLFN 221369 . 221675) (SCROLLBITMAP 221677 . 222726) (REDISPLAYBITMAP 222728 .
223327) (ULREDISPLAYBITMAP 223329 . 224054) (EXTENDEXTENT 224056 . 224578) (WIDTHIFWINDOW 224580 .
224923) (HEIGHTIFWINDOW 224925 . 225457)) (225558 226144 (\DSPUNTRANSFORMREGION 225568 . 226142)) (
226172 247199 (SHRINKW 226182 . 236846) (ICONBUTTONEVENTFN 236848 . 237340) (ICONPOSITION.FROM.WINDOW
237342 . 239111) (MAKETITLEBARICON 239113 . 241295) (\TITLEICONMINSIZE 241297 . 241673) (
\NOTENEWICONPOSITION 241675 . 242128) (EXPANDW 242130 . 243731) (DOICONWINDOWCOM 243733 . 244720) (
CLOSEMAINWINDOW 244722 . 245913) (CLOSEICONWINDOW 245915 . 247197)))))
STOP