(FILECREATED "14-Oct-85 15:41:05" {ERIS}<LISPCORE>NEWWINDOWS>WINDOW.;2 210176
changes to: (FNS \CLOSEW1 \OPENW1 WWRITEMODE \MAKE.CLOSED.WINDOW.WRITABLE
\RESTORE.CLOSED.WINDOW)
(VARS WINDOWCOMS)
previous date: " 7-Oct-85 14:32:02" {ERIS}<LISPCORE>SOURCES>WINDOW.;67)
(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT WINDOWCOMS)
(RPAQQ WINDOWCOMS [(COMS (FNS WWRITEMODE \MAKE.CLOSED.WINDOW.WRITABLE \RESTORE.CLOSED.WINDOW))
(COMS (FNS WINDOWWORLD WINDOWWORLDP CHANGEBACKGROUND CHANGEBACKGROUNDBORDER TILE LOGOW
\DRAWLOGOWINDOWIMAGE \TTY.CREATING.DISPLAYSTREAM \CREATE.TTY.OUTCHARFN
\CREATE.TTYDISPLAYSTREAM HASTTYWINDOWP TTYINFOSTREAM)
(VARS (\TTYREGIONOFFSETSPTR))
[INITVARS [TTYREGIONOFFSETS (QUOTE ((0 . 0)
(20 . -20)
(40 . 0)
(20 . 20]
(DEFAULTTTYREGION (QUOTE (153 100 384 208]
(GLOBALVARS \TTYREGIONOFFSETSPTR TTYREGIONOFFSETS))
(COMS (* Window menu operations)
(FNS WINDOW.MOUSE.HANDLER \PROTECTED.APPLY DOWINDOWCOM DOBACKGROUNDCOM
DEFAULT.BACKGROUND.COPYFN)
(VARS (BACKGROUNDCOPYRIGHTBUTTONEVENTFN (FUNCTION DEFAULT.BACKGROUND.COPYFN))
(BackgroundCopyMenu))
(INITVARS BackgroundCopyMenuCommands)
(FNS BURYW CLEARW CLOSEW \CLOSEW1 \OKTOCLOSEW OPENW DOUSERFNS DOUSERFNS2 \USERFNISDON'T
\OPENW1 CREATEW MOVEW \ONSCREENCLIPPINGREGION RELMOVEW PAINTW PAINTW.READMODE
PAINTW.READBRUSHSHAPE PAINTW.READBRUSHSIZE SHAPEW SHAPEW1 RESHOWBORDER
\RESHOWBORDER1 TRACKW SNAPW WINDOWREGION)
(COMS (FNS PAINTW.READBRUSHSHADE PAINTW.READ.AND.SAVE.SHADE PAINTW.CACHE.SHADE
PAINTW.SHADE.LABEL)
(INITVARS (PAINTW.SHADES))
(GLOBALVARS PAINTW.SHADES))
(FNS MINIMUMWINDOWSIZE)
(INITVARS (BACKGROUNDCURSORINFN)
(BACKGROUNDBUTTONEVENTFN)
(BACKGROUNDCURSOROUTFN)
(BACKGROUNDCURSORMOVEDFN))
(GLOBALVARS BACKGROUNDCURSORINFN BACKGROUNDBUTTONEVENTFN BACKGROUNDCURSOROUTFN
BACKGROUNDCURSORMOVEDFN \LASTKEYSTATE BACKGROUNDCOPYBUTTONEVENTFN
BACKGROUNDCOPYRIGHTBUTTONEVENTFN \CARET.UP)
(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.DISPLAYFN
ENCAPSULATEDOBJ.IMAGEBOXFN ENCAPSULATEDOBJ.INIT)
(P (ENCAPSULATEDOBJ.INIT))
(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.]
(COMS (* User interface functions)
(FNS WINDOWP WINDOWPROP WINDOWADDPROP WINDOWDELPROP GETWINDOWPROP GETWINDOWUSERPROP
PUTWINDOWPROP REMWINDOWPROP WINDOWADDFNPROP)
(* for compiling windowprops.)
(PROP ARGNAMES WINDOWPROP)
(MACROS WINDOWPROP)
(FNS CWINDOWPROP CGETWINDOWPROP \GETWINDOWHEIGHT \GETWINDOWWIDTH))
[COMS (FNS OPENWP 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)
(EXPORT (DECLARE: DOEVAL@COMPILE DONTCOPY (MACROS WINDOWWORLD]
(COMS (* Scrolling stuff)
(FNS SCROLLW SCROLLBYREPAINTFN ADJUSTOFFSETS CREATESCROLLINGW IN/SCROLL/BAR?
RELDSPXOFFSET RELDSPYOFFSET SCROLL.HANDLER \SCROLL.HANDLER.DOIT \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 \MAKEICONWINDOW \TITLEICONMINSIZE \NOTENEWICONPOSITION EXPANDW
DOICONWINDOWCOM CLOSEMAINWINDOW CLOSEICONWINDOW)
(VARS IconMenuItems))
(CURSORS VertScrollCursor ScrollUpCursor ScrollDownCursor HorizScrollCursor ScrollLeftCursor
ScrollRightCursor VertThumbCursor HorizThumbCursor WAITINGCURSOR)
(DECLARE: EVAL@COMPILE DONTCOPY
(GLOBALVARS \LastCursorPosition \LastInWindow WindowMenu BackgroundMenu
BackgroundMenuCommands \LastWindowButtons WWFNS WindowMenuCommands
IconWindowMenu IconWindowMenuCommands VertScrollCursor ScrollUpCursor
ScrollDownCursor ScrollLeftCursor ScrollRightCursor HorizScrollCursor
WindowTitleDisplayStream WINDOWTITLEPRINTLEVEL WBorder \TOPWDS
WINDOWBACKGROUNDSHADE CURRENTBACKGROUNDSHADE BACKGROUNDFNS)
(CONSTANTS (MinWindowWidth 26)
(MinWindowHeight 16))
(EXPORT (RECORDS WINDOW)))
(DECLARE: EVAL@COMPILE (EXPORT (GLOBALVARS TOPW WINDOWUSERFORMS ENDOFWINDOWUSERFORMS
PROMPTWINDOW KNOWNWINDOWS)))
(SYSRECORDS WINDOW)
(INITRECORDS WINDOW)
(INITVARS (WWFNS (QUOTE (\TOTOPWDS)))
(WindowTitleDisplayStream)
(WindowMenu)
(BackgroundMenu)
(TOPW)
(\LastCursorPosition (CREATEPOSITION))
(\LastInWindow)
(\LastWindowButtons 0)
(IconWindowMenu)
(KNOWNWINDOWS)
(WINDOWBACKGROUNDSHADE 34850)
(WBorder 4)
(SCROLLBARWIDTH 24)
(SCROLLWAITTIME 100)
(SCROLLBARSHADE 32800)
(WAITBEFORESCROLLTIME 750)
(WAITBETWEENSCROLLTIME 100)
(PAINTCOMMANDBRUSH (QUOTE (ROUND 2)))
(PAINTCOMMANDMODE (QUOTE PAINT))
(PAINTCOMMANDMENU)
(PAINTCOMMANDSHADE BLACKSHADE)
(PAINTSIZEMENU)
(PAINTSHAPEMENU)
(PAINTSHADEMENU)
(PAINTMODEMENU)
(HIGHLIGHTSHADE 32800))
[ADDVARS (WindowMenuCommands (Close (QUOTE CLOSEW)
"Closes a window")
(Snap (QUOTE SNAPW)
"Saves a snapshot of a region of the screen.")
(Paint (QUOTE PAINTW)
"Starts a painting mode in which the mouse can be
used to draw pictures or make notes on windows.")
(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."))
(IconWindowMenuCommands (Close (QUOTE CLOSEW)
"Closes the icon and its assciated window")
(Snap (QUOTE SNAPW)
"Saves a snapshot of a region of the screen.")
(Paint (QUOTE PAINTW)
"Starts a painting mode in which the mouse can
be used to draw pictures or make notes on windows.
Includes a HARDCOPY command.")
(Bury (QUOTE BURYW)
"Puts a window on the bottom.")
(Move (QUOTE MOVEW)
"Moves a window by a corner.")
(Shape (QUOTE SHAPEW)
"Gets a new region for a window.
Left button down marks fixed corner; sweep to other corner.
Middle button down moves closest corner.")
(Expand (QUOTE EXPANDW)
"Expands the window for which this is the ICON."))
(BackgroundMenuCommands (SaveVM (QUOTE (SAVEVM))
"Updates the virtual memory.")
(Snap (QUOTE (SNAPW))
"Saves a snapshot of a region of the screen.")
(Hardcopy (QUOTE (HARDCOPYW))
"Send hardcopy of screen region to printer."
(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 (WINDOWWORLD T))
(ADDVARS (GLOBALVARS SCROLLBARWIDTH SCROLLWAITTIME SCROLLBARSHADE
WAITBEFORESCROLLTIME WAITBETWEENSCROLLTIME WAITINGCURSOR)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)
(LAMA PROMPTPRINT WINDOWPROP IMAGEOBJPROP WINDOWWORLD])
(DEFINEQ
(WWRITEMODE
[LAMBDA (WINDOW MODE) (* hdj "14-Oct-85 14:35")
(PROG1 (SELECTQ (WINDOWPROP WINDOW (QUOTE OPEN-ON-WRITE-MODE))
(T (QUOTE OPEN))
(NIL (QUOTE CLOSED))
(SHOULDNT))
(SELECTQ MODE
[OPEN (\UNINTERRUPTABLY (*)
(WINDOWPROP WINDOW (QUOTE OPEN-ON-WRITE-MODE)
T)
(if (NOT (OPENWP WINDOW))
then (replace (WINDOW NEXTW) of WINDOW
with (QUOTE CANOPEN]
[CLOSED (\UNINTERRUPTABLY (WINDOWPROP WINDOW (QUOTE OPEN-ON-WRITE-MODE)
NIL)
(if (NOT (OPENWP WINDOW))
then (replace (WINDOW NEXTW) of WINDOW
with (QUOTE CLOSED]
(NIL NIL)
(\ILLEGAL.ARG MODE])
(\MAKE.CLOSED.WINDOW.WRITABLE
[LAMBDA (WINDOW) (* hdj "14-Oct-85 14:58")
(UNINTERRUPTABLY (*)
(LET [(OLDXOFFSET (DSPXOFFSET NIL WINDOW))
(OLDYOFFSET (DSPYOFFSET NIL WINDOW))
(OLDDESTINATION (fetch (\DISPLAYDATA DDDestination) of (\GETDISPLAYDATA WINDOW)))
(SAVED-BITMAP (fetch (WINDOW SAVE) of WINDOW))
(OLDREGION (WINDOWPROP WINDOW (QUOTE REGION]
(* * get old values)
(WINDOWPROP WINDOW (QUOTE OLDXOFFSET)
OLDXOFFSET)
(WINDOWPROP WINDOW (QUOTE OLDYOFFSET)
OLDYOFFSET)
(WINDOWPROP WINDOW (QUOTE OLDDESTINATION)
OLDDESTINATION)
(* * set new ones)
(* mark it as writable while remaining closed)
(replace (WINDOW NEXTW) of WINDOW with (QUOTE CLOSED))
(replace (\DISPLAYDATA DDDestination) of (\GETDISPLAYDATA WINDOW) with
SAVED-BITMAP)
(replace (PILOTBBT PBTDESTBPL) of (fetch (\DISPLAYDATA DDPILOTBBT)
of (\GETDISPLAYDATA WINDOW))
with (fetch (BITMAP BITMAPWIDTH) of SAVED-BITMAP))
(DSPXOFFSET (IDIFFERENCE (fetch (REGION LEFT) of OLDREGION)
OLDXOFFSET)
WINDOW)
(DSPYOFFSET (IDIFFERENCE (fetch (REGION BOTTOM) of OLDREGION)
OLDYOFFSET)
WINDOW)
WINDOW))])
(\RESTORE.CLOSED.WINDOW
[LAMBDA (WINDOW) (* hdj "14-Oct-85 14:58")
(LET [(OLDXOFFSET (WINDOWPROP WINDOW (QUOTE OLDXOFFSET)))
(OLDYOFFSET (WINDOWPROP WINDOW (QUOTE OLDYOFFSET)))
(OLDDESTINATION (WINDOWPROP WINDOW (QUOTE OLDDESTINATION]
(* * clean up -- if window was modified to begin with)
(UNINTERRUPTABLY (*)
(if OLDXOFFSET
then (WINDOWPROP WINDOW (QUOTE OLDXOFFSET)
NIL)
(WINDOWPROP WINDOW (QUOTE OLDYOFFSET)
NIL)
(WINDOWPROP WINDOW (QUOTE OLDDESTINATION)
NIL)
(* * restore)
(replace (\DISPLAYDATA DDDestination) of (\GETDISPLAYDATA WINDOW)
with OLDDESTINATION)
(replace (PILOTBBT PBTDESTBPL) of (fetch (\DISPLAYDATA DDPILOTBBT)
of (\GETDISPLAYDATA WINDOW))
with (fetch (BITMAP BITMAPWIDTH) of OLDDESTINATION))
(DSPXOFFSET OLDXOFFSET WINDOW)
(DSPYOFFSET OLDYOFFSET WINDOW)))
WINDOW])
)
(DEFINEQ
(WINDOWWORLD
(LAMBDA CHANGEIT (* jwo: "23-Jul-85 02:44")
(* returns T if the window system is active.
If CHANGEIT is given, the window system will be turned
off or on.)
(DECLARE (GLOBALVARS \TopLevelTtyWindow))
(PROG1 (type? WINDOW TOPW)
(COND
((ZEROP CHANGEIT))
((ARG CHANGEIT 1)
(UNINTERRUPTABLY
(SETQ CURRENTBACKGROUNDSHADE (\CLEARBM (SCREENBITMAP)
WINDOWBACKGROUNDSHADE))
(COND
((WINDOWWORLD) (* Windows already on; close then all This keeps them
from being confused about where their image is NIL)
(for WINDOW in (OPENWINDOWS) do (CLOSEW WINDOW)))
(T (* Initially no windows)
(for FN in WWFNS do (SWITCHDEF FN (QUOTE \OLD)
(QUOTE NU)))
(COND
((NOT (DISPLAYSTREAMP WindowTitleDisplayStream))
(SETQ WindowTitleDisplayStream (DSPCREATE))
(DSPOPERATION (QUOTE INVERT)
WindowTitleDisplayStream)
(DSPFONT (FONTCREATE (QUOTE HELVETICA)
8)
WindowTitleDisplayStream)
(* set right margin so title doesn't autoCR.)
(DSPRIGHTMARGIN 60000 WindowTitleDisplayStream)))
(DSPXOFFSET 0 (TTYDISPLAYSTREAM)) (* Get TTY in shape. Region is only approx as user can
change it.)
(DSPYOFFSET 0 (TTYDISPLAYSTREAM))
(DSPCLIPPINGREGION (create REGION
LEFT ← 8
BOTTOM ← 378
WIDTH ← 550
HEIGHT ← 333)
(TTYDISPLAYSTREAM))
(* First attempt to print creates TTY window)
(\STARTDISPLAY) (* Not DISPLAYSTREAMINIT. No point in leaving a TTY
area)
(DSPDESTINATION (SCREENBITMAP)
(TTYDISPLAYSTREAM))
(* SCREENBITMAP changes in STARTDISPLAY)
(SETLINELENGTH) (* Resets line length for TTY)
))
(SETQ \DEFAULTTTYDISPLAYSTREAM (\TTY.CREATING.DISPLAYSTREAM))
(SETQ TOPW NIL)
(SETQ \TOPWDS NIL) (* set up PROMPTWINDOW and TTY window and LOGO windows)
(PROG NIL
(SETQ PROMPTWINDOW (CREATEW (create REGION
LEFT ←(IDIFFERENCE (FOLDLO SCREENWIDTH 2)
275)
BOTTOM ←(IDIFFERENCE SCREENHEIGHT 76)
WIDTH ← 550
HEIGHT ←(HEIGHTIFWINDOW 60 T 2))
"Prompt Window" 2))
(DSPTEXTURE BLACKSHADE PROMPTWINDOW)
(DSPOPERATION (QUOTE ERASE)
PROMPTWINDOW)
(DSPSCROLL (QUOTE ON)
PROMPTWINDOW)
(WINDOWPROP PROMPTWINDOW (QUOTE SHRINKFN)
(QUOTE DON'T))
(CLEARW PROMPTWINDOW) (* set it so that PROMPTWINDOW doesn't hold.)
(WINDOWPROP PROMPTWINDOW (QUOTE PAGEFULLFN)
(FUNCTION NILL)))
(SETQ LOGOW (LOGOW "Interlisp-D" (create POSITION
XCOORD ← 594
YCOORD ← 544)))
(WINDOWPROP LOGOW (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (W) (* clear the variable so that it will be collected.)
(SETQ LOGOW NIL)))) (* attach the current line buffer to the top level
window.)
(WINDOWPROP (SETQ \TopLevelTtyWindow (CREATEW (TTYDISPLAYSTREAM)
"Interlisp-D Executive"))
(QUOTE \LINEBUF.OFD)
(OR \LINEBUF.OFD (\CREATELINEBUFFER))))
(* initialize the window mouse handler variables.)
(SETQ \LastInWindow)
(SETQ \LastWindowButtons 0)
(SETQ \LastCursorPosition (create POSITION))
(MAPC WINDOWUSERFORMS (FUNCTION EVAL)))
((WINDOWWORLD) (* if its on turn it off)
(MAPC ENDOFWINDOWUSERFORMS (FUNCTION EVAL))
(UNINTERRUPTABLY
(for F in WWFNS do (SWITCHDEF F (QUOTE NU)
(QUOTE \OLD)))
(AND (LISTP BACKGROUNDFNS)
(SETQ BACKGROUNDFNS (DREMOVE (QUOTE WINDOW.MOUSE.HANDLER)
BACKGROUNDFNS)))
(BITBLT NIL 0 0 (SCREENBITMAP)
0 0 NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)
(DISPLAYSTREAMINIT 65)
(SETLINELENGTH)
(SETQ TOPW NIL)
(SETQ \TOPWDS (SETQ \TopLevelTtyWindow NIL))
(SETQ PROMPTWINDOW T)))))))
(WINDOWWORLDP
[LAMBDA NIL (* rrb " 7-MAY-82 18:39")
(* is the window system operating?)
(type? WINDOW TOPW])
(CHANGEBACKGROUND
[LAMBDA (SHADE DISPLAY) (* hdj " 3-Feb-85 13:55")
(* changes the window world background to SHADE)
(WSOP (QUOTE WSCHANGEBACKGROUND)
(OR DISPLAY DisplayFDEV)
SHADE])
(CHANGEBACKGROUNDBORDER
[LAMBDA (SHADE DISPLAY) (* hdj "31-Jan-85 23:03")
(* Changes the screen border on a Dandelion.
SHADE is a 8x2 pattern)
(WSOP (QUOTE WSCHANGEBACKGROUNDBORDER)
(OR DISPLAY DisplayFDEV)
SHADE])
(TILE
[LAMBDA (SRC DST) (* lmm "25-APR-82 21:55")
(PROG ((X 0)
(Y 0)
(W (fetch BITMAPWIDTH of SRC))
(H (fetch BITMAPHEIGHT of SRC))
(DSTW (fetch BITMAPWIDTH of DST))
(DSTH (fetch BITMAPHEIGHT of DST)))
(while (ILESSP X DSTW) do (SETQ Y 0)
(while (ILESSP Y DSTH)
do (BITBLT SRC 0 0 DST X Y W H NIL (QUOTE REPLACE))
(add Y H))
(add X W])
(LOGOW
[LAMBDA (STRING WHERE TITLE ANGLEDELTA) (* edited: " 1-AUG-83 22:55")
(* creates a logo window.)
(PROG ((CIRCLESIZE 60)
(LOGOXCENTER 70)
(LOGOYCENTER 65)
(LOGOWINDOWHEIGHT 180)
W LOGOWINDOWWIDTH WIMAGEWIDTH WIMAGEHEIGHT (STRING (OR STRING "Interlisp-D")))
(OR ANGLEDELTA (SETQ ANGLEDELTA 23))
(SETQ WIMAGEWIDTH (FIX (FTIMES CIRCLESIZE .62)))
(SETQ WIMAGEHEIGHT (FIX (FTIMES CIRCLESIZE .5)))
[SETQ LOGOWINDOWWIDTH (IPLUS LOGOXCENTER 30 WIMAGEWIDTH (STRINGWIDTH STRING
(QUOTE (TIMESROMAND
36]
[SETQ W (COND
((TYPENAMEP WHERE (QUOTE WINDOW))
WHERE)
(T (CREATEW (COND
((POSITIONP WHERE)
(create REGION
LEFT ←(fetch (POSITION XCOORD) of WHERE)
BOTTOM ←(fetch (POSITION YCOORD) of WHERE)
WIDTH ← LOGOWINDOWWIDTH
HEIGHT ← LOGOWINDOWHEIGHT))
(T (GETBOXREGION LOGOWINDOWWIDTH LOGOWINDOWHEIGHT NIL NIL NIL
"Specify location for logo window.")))
(OR TITLE (CONCAT "Copyright (c) by Xerox Corporation" " "
(OR MAKESYSDATE (DATE]
(for ANGLE from 0 to 270 by ANGLEDELTA do (\DRAWLOGOWINDOWIMAGE (IPLUS LOGOXCENTER
(FTIMES
CIRCLESIZE
(COS ANGLE)))
(IPLUS LOGOYCENTER
(FTIMES
CIRCLESIZE
(SIN ANGLE)))
WIMAGEWIDTH WIMAGEHEIGHT 2
W))
(MOVETO (IPLUS LOGOXCENTER 10 WIMAGEWIDTH)
(IPLUS 2 (IDIFFERENCE LOGOYCENTER CIRCLESIZE))
W)
(DSPFONT (QUOTE (TIMESROMAND 36))
W)
(PRIN3 STRING W)
(RETURN W])
(\DRAWLOGOWINDOWIMAGE
[LAMBDA (XPOS YPOS WIDTH HEIGHT BORDER W) (* rrb "22-FEB-82 18:04")
(* makes a window image. This is part of the logo
drawing.)
(BITBLT NIL NIL NIL W XPOS YPOS WIDTH HEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)
(BITBLT NIL NIL NIL W (IPLUS BORDER XPOS)
(IPLUS BORDER YPOS)
(IDIFFERENCE WIDTH (ITIMES BORDER 2))
(IDIFFERENCE HEIGHT (ITIMES BORDER 3))
(QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE])
(\TTY.CREATING.DISPLAYSTREAM
[LAMBDA NIL (* rmk: "27-AUG-83 13:41")
(* creates a displaystream that points to a stream that has a OUTCHARFN that creates a new displaystream.
It is used as the default TtyDisplayStream in a process.)
(PROG [(DS (DSPCREATE (BITMAPCREATE 1 1]
(replace OUTCHARFN of DS with (FUNCTION \CREATE.TTY.OUTCHARFN))
(replace FULLFILENAME of DS with T)
(RETURN DS])
(\CREATE.TTY.OUTCHARFN
[LAMBDA (STREAM CHAR) (* rmk: "26-AUG-83 12:25")
(* outcharfn for \DEFAULTTTYDISPLAYSTREAM which creates
a new window and then bouts to it.)
(* make the new window the ttydisplaystream)
(COND
((HASTTYWINDOWP NIL)
(* the only case where the ttydisplaystream isn't the default is when the users has called
(PRINT foo (TTYDISPLAYSTREAM)) and this is other than the first character of foo.)
(\CREATE.TTYDISPLAYSTREAM)))
(\OUTCHAR (TTYDISPLAYSTREAM)
CHAR])
(\CREATE.TTYDISPLAYSTREAM
[LAMBDA NIL (* rrb "16-AUG-83 12:20")
(* makes a new window and makes it the ttydisplaystream)
(COND
((WINDOWWORLDP)
(* \TTYWINDOW saves the window so it wouldn't get collected. This allows WFROMDS to find it even if it is closed.
In future, windows will be streams and this can go away.)
(COND
((NULL (SETQ \TTYREGIONOFFSETSPTR (CDR \TTYREGIONOFFSETSPTR)))
(* the offsets distribute the break windows a little so
many can be seen.)
(SETQ \TTYREGIONOFFSETSPTR TTYREGIONOFFSETS)))
(TTYDISPLAYSTREAM (SETQ \TTYWINDOW (CREATEW (CREATEREGION (IPLUS (fetch (REGION LEFT)
of DEFAULTTTYREGION)
(CAR (CAR
\TTYREGIONOFFSETSPTR)))
(IPLUS (fetch (REGION BOTTOM)
of DEFAULTTTYREGION)
(CDR (CAR
\TTYREGIONOFFSETSPTR)))
(fetch (REGION WIDTH) of
DEFAULTTTYREGION)
(fetch (REGION HEIGHT)
of DEFAULTTTYREGION))
(CONCAT "TTY window for " (PROCESSPROP
(THIS.PROCESS)
(QUOTE NAME)))
NIL T])
(HASTTYWINDOWP
[LAMBDA (PROCESS) (* bvm: "17-AUG-83 13:21")
(* determines if PROCESS has a tty window yet.)
(DECLARE (GLOBALVARS \DEFAULTTTYDISPLAYSTREAM))
(PROG NIL
(RETURN (NEQ (COND
((NULL PROCESS)
TtyDisplayStream)
((PROCESS.TTY PROCESS))
(T (RETURN)))
\DEFAULTTTYDISPLAYSTREAM])
(TTYINFOSTREAM
[LAMBDA (PROCESS) (* bvm: "12-NOV-83 22:55")
(* * Returns a stream to which to print informative messages = TtyDisplayStream if PROCESS has one, else
PROMPTWINDOW)
(DECLARE (GLOBALVARS \DEFAULTTTYDISPLAYSTREAM))
(PROG [(STREAM (COND
((NULL PROCESS)
TtyDisplayStream)
(T (PROCESS.TTY PROCESS]
(RETURN (COND
((AND STREAM (NEQ STREAM \DEFAULTTTYDISPLAYSTREAM))
STREAM)
(T (\GETSTREAM PROMPTWINDOW])
)
(RPAQQ \TTYREGIONOFFSETSPTR NIL)
(RPAQ? TTYREGIONOFFSETS (QUOTE ((0 . 0)
(20 . -20)
(40 . 0)
(20 . 20))))
(RPAQ? DEFAULTTTYREGION (QUOTE (153 100 384 208)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TTYREGIONOFFSETSPTR TTYREGIONOFFSETS)
)
(* Window menu operations)
(DEFINEQ
(WINDOW.MOUSE.HANDLER
[LAMBDA NIL (* lmm "11-Jun-85 14:27")
(* * Does user window operations if state of buttons has changed or mouse has changed windows)
(COND
(\INTERRUPTABLE (* don't do anything if uninterruptable)
(PROG [\MHWINDOW \MHCOM \MHPROCESS (NBREAKS (COND
((IGREATERP 0 NBREAKS)
(* bind NBREAKS to a positive values so that breaks
will occur in background functions.)
(IMINUS NBREAKS))
(T NBREAKS]
(GETMOUSESTATE)
[COND
((OR (NEQ LASTMOUSEX (fetch XCOORD of \LastCursorPosition))
(NEQ LASTMOUSEY (fetch YCOORD of \LastCursorPosition))
(NEQ LASTMOUSEBUTTONS \LastWindowButtons))
(* Cursor has changed position or a button is down, see
if it is in a window or scroll area.)
(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))
(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)
(GETMOUSESTATE)
(SETQ \LastWindowButtons LASTMOUSEBUTTONS)
(RETURN))
((OR (ZEROP LASTMOUSEBUTTONS)
(NEQ LASTMOUSEBUTTONS \LastWindowButtons))
(* Cursor has changed windows, so call CURSOROUTFN of old window, CURSORINFN of new. The user enters another window
by moving the cursor into it with no buttons pressed or by pressing a button in the window. This allows the user to
go into a window with a button down, release it and still be "in" the window he came from.)
[COND
((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)
(SETQ \LastWindowButtons LASTMOUSEBUTTONS]
([AND (LASTMOUSESTATE (ONLY RIGHT))
(NOT (AND \MHWINDOW (fetch RIGHTBUTTONFN of \MHWINDOW]
(* right button when down, normally this is window
system commands but can be overridden.)
(* this is separated out so that window commands don't
grab the tty.)
(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)))
[\MHWINDOW (* 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 \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))
((AND BACKGROUNDBUTTONEVENTFN (GETD
BACKGROUNDBUTTONEVENTFN))
(\PROTECTED.APPLY BACKGROUNDBUTTONEVENTFN]
((AND BACKGROUNDCURSORMOVEDFN (GETD
BACKGROUNDCURSORMOVEDFN))
(* cursor must have moved.)
(\PROTECTED.APPLY BACKGROUNDCURSORMOVEDFN]
(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 (* rrb "16-Jul-84 19:27")
(* the default function called when the right button
goes down in the background and the copy key is held
down.)
(COND
((MOUSESTATE (NOT UP))
(PROG (FORM)
(AND [SETQ 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]
(ERSETQ (EVAL FORM])
)
(RPAQ BACKGROUNDCOPYRIGHTBUTTONEVENTFN (FUNCTION DEFAULT.BACKGROUND.COPYFN))
(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) (* hdj "14-Oct-85 14:44")
(* actually does the closing operation.
Is used by SHRINKW to avoid the CLOSEFN mechanism.)
(.WHILE.ON.TOP. WINDOW (\SW2BM (SCREENBITMAP)
(fetch (WINDOW REG) of WINDOW)
(fetch (WINDOW SAVE) of WINDOW)
NIL)
(COND
((SETQ TOPW (fetch (WINDOW NEXTW) of WINDOW))
(SETQ \TOPWDS (fetch (WINDOW DSP) of TOPW)))
(T (* users is closing the last window.
make sure \TOPWDS is NIL also.)
(SETQ \TOPWDS NIL))) (* smash the window's link to other's in the chain.)
(if (WINDOWPROP WINDOW (QUOTE OPEN-ON-WRITE-MODE))
then (replace (WINDOW NEXTW) of WINDOW with (QUOTE CANOPEN))
else (\MAKE.CLOSED.WINDOW.WRITABLE WINDOW])
(\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) (* hdj "14-Oct-85 11:04")
(DECLARE (GLOBALVARS SCREENWIDTH))
(UNINTERRUPTABLY (*)
(\RESTORE.CLOSED.WINDOW WINDOW)
(replace (WINDOW NEXTW) of WINDOW with TOPW)
(SETQ TOPW WINDOW)
(SETQ \TOPWDS (fetch (WINDOW DSP) of TOPW))
(replace (PILOTBBT PBTDESTBPL) of (fetch (\DISPLAYDATA DDPILOTBBT) of (\GETDISPLAYDATA
WINDOW))
with SCREENWIDTH) (* changed from (SCREENBITMAP) to destination in
preparation for multiple screens.)
(* Assume that the DSP of a window is guaranteed to be
a display-stream)
(\SW2BM (fetch DDDestination of (fetch IMAGEDATA of \TOPWDS))
(fetch (WINDOW REG) of WINDOW)
(fetch (WINDOW SAVE) of WINDOW)
NIL))])
(CREATEW
[LAMBDA (REGION TITLE BORDERSIZE NOOPENFLG) (* rrb "27-OCT-83 11:15")
(PROG (REG DSP DISPLAYDATA (TITLEHEIGHT (COND
(TITLE (IMINUS (DSPLINEFEED NIL
WindowTitleDisplayStream)))
(T 0)))
WINDOW
(WBORDER (OR (NUMBERP BORDERSIZE)
WBorder)))
[COND
[(AND (DISPLAYSTREAMP REGION)
(EQ (SCREENBITMAP)
(DSPDESTINATION NIL DSP)))
(SETQ DSP REGION)
(SETQ DISPLAYDATA (fetch IMAGEDATA of DSP))
(SETQ REG (ffetch DDClippingRegion of DISPLAYDATA))
(* adjust region by offsets and reduce to size screen.
(destination bitmap.))
(SETQ REG (create REGION
LEFT ←(IDIFFERENCE (IMAX (IPLUS (fetch DDXOFFSET of DISPLAYDATA)
(fetch (REGION LEFT) of REG))
0)
WBORDER)
BOTTOM ←(IDIFFERENCE (IMAX (IPLUS (ffetch DDYOFFSET of DISPLAYDATA)
(fetch (REGION BOTTOM)
of REG))
0)
WBORDER)
WIDTH ←(IPLUS (IMIN SCREENWIDTH (fetch (REGION WIDTH) of REG))
(UNFOLD WBORDER 2))
HEIGHT ←(IPLUS (IMIN (IDIFFERENCE SCREENHEIGHT TITLEHEIGHT)
(fetch (REGION HEIGHT) of REG))
(UNFOLD WBORDER 2)
TITLEHEIGHT]
(T [SETQ REG (COND
((type? REGION REGION) (* Copy so that smash-happy user won't clobber the
window system smashing the region he gives us.)
(create REGION using REGION))
(T (AND TITLE (printout PROMPTWINDOW T "Specify region for window %"" TITLE "%""))
(PROG1 (GETREGION MinWindowWidth MinWindowHeight)
(AND TITLE (CLRPROMPT]
(SETQ DSP (DSPCREATE))
(SETQ DISPLAYDATA (fetch IMAGEDATA of DSP]
(OR (type? REGION REG)
(HELP "Not a region" REG))
(OR (IGREATERP (IMIN (fetch (REGION WIDTH) of REG)
(fetch (REGION HEIGHT) of REG))
(UNFOLD WBORDER 2))
(ERROR "Region too small to use as a window" REG))
(DSPDESTINATION (SCREENBITMAP)
DSP)
(SETQ WINDOW (create WINDOW
DSP ← DSP
REG ← REG
SAVE ←(BITMAPCREATE (fetch (REGION WIDTH) of REG)
(fetch (REGION HEIGHT) of REG))
WTITLE ← TITLE
WBORDER ← WBORDER
NEXTW ←(QUOTE CLOSED)))
(replace XWINDOWHINT of DISPLAYDATA with WINDOW)
(ADVISEWDS WINDOW)
(MOVETOUPPERLEFT WINDOW)
(SHOWWFRAME WINDOW)
(COND
((NOT NOOPENFLG)
(OPENW WINDOW)))
(RETURN WINDOW])
(MOVEW
[LAMBDA (WINDOW POSorX Y) (* jow "16-Aug-85 11:53")
(* moves a window. If window is closed and position is
given, it won't open the window.
It also calls the window's MOVEFN property.)
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(PROG ((OLDREGION (fetch REG of WINDOW))
(USERMOVEFN (fetch (WINDOW MOVEFN) of WINDOW))
(OPEN? (OPENWP WINDOW))
POS NEWREGION OLDLEFT OLDBOTTOM OLDWIDTH OLDHEIGHT OLDCLIPREGION LFT BTM REG FN)
(COND
([COND
((LISTP USERMOVEFN)
(FMEMB (QUOTE DON'T)
USERMOVEFN))
(T (EQ USERMOVEFN (QUOTE DON'T]
(PROMPTPRINT "Can't move this window.")
(RETURN)))
[COND
((NOT (SUBREGIONP OLDREGION WHOLEDISPLAY)) (* 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 (NEQ (fetch XCOORD of POS)
OLDLEFT)
(NEQ (fetch YCOORD of POS)
OLDBOTTOM))
(SETQ NEWREGION (create REGION
LEFT ←(fetch (POSITION XCOORD) of POS)
BOTTOM ←(fetch (POSITION YCOORD) of POS)
WIDTH ← OLDWIDTH
HEIGHT ← OLDHEIGHT))
(UNINTERRUPTABLY
[COND
(OPEN? (* if window is open, move it to top as its MOVEFN may
have changed things and swap its bits to its new
location)
(.WHILE.ON.TOP. WINDOW (\SW2BM (SCREENBITMAP)
OLDREGION
(fetch SAVE of WINDOW)
NIL)
(\SW2BM (fetch SAVE of WINDOW)
NIL
(SCREENBITMAP)
NEWREGION]
(replace REG of WINDOW with NEWREGION)
(ADVISEWDS WINDOW OLDREGION T))
[COND
((AND (WINDOWPROP WINDOW (QUOTE REPAINTFN))
OLDCLIPREGION) (* redisplay those parts that were off the screen.)
(COND
((EQ OLDCLIPREGION T) (* whole window was off.)
(REDISPLAYW WINDOW NIL T))
(T (PROG ((NEWCLIPPINGREGION (\ONSCREENCLIPPINGREGION WINDOW))
NCL OCL NCB OCB OCR NCR OCW NCW OCH NCH OCT NCT)
(* the title may be the only thing now on the screen.)
(OR NEWCLIPPINGREGION (RETURN))
(SETQ NCB (fetch (REGION BOTTOM) of NEWCLIPPINGREGION))
(SETQ OCB (fetch (REGION BOTTOM) of OLDCLIPREGION))
(SETQ OCW (fetch (REGION WIDTH) of OLDCLIPREGION))
(SETQ NCW (fetch (REGION WIDTH) of NEWCLIPPINGREGION))
(SETQ OCH (fetch (REGION HEIGHT) of OLDCLIPREGION))
(SETQ NCH (fetch (REGION HEIGHT) of NEWCLIPPINGREGION))
[COND
((ILESSP (SETQ NCL (fetch (REGION LEFT) of NEWCLIPPINGREGION))
(SETQ OCL (fetch (REGION LEFT) of OLDCLIPREGION)))
(REDISPLAYW WINDOW (CREATEREGION NCL OCB (IDIFFERENCE OCL NCL)
OCH]
[COND
((ILESSP (SETQ OCR (IPLUS OCL OCW))
(SETQ NCR (IPLUS NCL NCW)))
(* some stuff appeared from the right.)
(REDISPLAYW WINDOW (CREATEREGION OCR OCB (IDIFFERENCE NCR OCR)
OCH]
[COND
((ILESSP NCB OCB)
(REDISPLAYW WINDOW (CREATEREGION NCL NCB NCW (IDIFFERENCE OCB NCB]
[COND
((ILESSP (SETQ OCT (IPLUS OCB OCH))
(SETQ NCT (IPLUS NCB NCH)))
(* some stuff appeared from the top)
(REDISPLAYW WINDOW (CREATEREGION NCL OCT NCW (IDIFFERENCE NCT OCT]
(COND
((IGREATERP (IPLUS OLDBOTTOM OLDHEIGHT)
SCREENHEIGHT) (* should reshow the title but don't have any entry for
that.)
NIL]
(DOUSERFNS (WINDOWPROP WINDOW (QUOTE AFTERMOVEFN))
WINDOW)))
(RETURN POS])
(\ONSCREENCLIPPINGREGION
[LAMBDA (WIN) (* rmk: "30-AUG-83 13:20")
(* returns a region which is the part of the windows
clipping region that is on the screen.)
(INTERSECTREGIONS (DSPCLIPPINGREGION NIL WIN)
(\DSPUNTRANSFORMREGION WHOLEDISPLAY (fetch IMAGEDATA
of (WINDOWPROP WIN (QUOTE DSP])
(RELMOVEW
[LAMBDA (WINDOW POS) (* rrb "13-JUN-82 15:54")
(* Move WINDOW by relative DX DY)
(PROG [(WINREG (WINDOWPROP WINDOW (QUOTE REGION]
(MOVEW WINDOW (create POSITION
XCOORD ←(IPLUS (fetch LEFT of WINREG)
(fetch (POSITION XCOORD) of POS))
YCOORD ←(IPLUS (fetch BOTTOM of WINREG)
(fetch (POSITION YCOORD) of POS])
(PAINTW
[LAMBDA (WINDOW) (* mpl "21-Jul-85 14:15")
(* allows the user to paint with the cursor)
(* should make sure cursor has moved or a button has
change before proceeding with the inner loop.)
(* has some of the stuff to allow the brush to be an
arbitrary bitmap but not all.)
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(printout PROMPTWINDOW
"Left button paints; Middle button erases.
Right button pops up a command menu.
To stop, select the QUIT command.")
(RESETLST (RESETSAVE NIL (LIST (QUOTE CURSOR)
(CURSOR)))
(PROG (BRUSH DS HOTX HOTY (SCRATCHCURSOR (CURSORCREATE (BITMAPCREATE CURSORWIDTH
CURSORHEIGHT)
0 0)))
(TOTOPW WINDOW) (* look for a previously stored brush.)
[COND
((SETQ BRUSH (WINDOWPROP WINDOW (QUOTE PAINTBRUSH)))
(SETQ PAINTCOMMANDMODE (CAR BRUSH))
(SETQ PAINTCOMMANDSHADE (CADR BRUSH))
(SETQ PAINTCOMMANDBRUSH (CADDR BRUSH]
(SETQ DS (fetch DSP of WINDOW))
BRUSHLP
[SETQ BRUSH (COND
((BITMAPP PAINTCOMMANDBRUSH))
(T (\GETBRUSH PAINTCOMMANDBRUSH] (* clear cursor)
(BITBLT NIL NIL NIL (fetch CURSORBITMAP of SCRATCHCURSOR)
0 0 CURSORWIDTH CURSORHEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE) (* put lower left part of brush shape in cursor)
(BITBLT BRUSH 0 0 (fetch CURSORBITMAP of SCRATCHCURSOR)
0 0 CURSORWIDTH CURSORHEIGHT (QUOTE INPUT)
(QUOTE REPLACE)) (* set the hot spot to the middle of the brush.)
[replace CURSORHOTSPOT of SCRATCHCURSOR
with (create POSITION
XCOORD ←(SETQ HOTX (HALF (IMIN (fetch BITMAPWIDTH of BRUSH)
CURSORWIDTH)))
YCOORD ←(SETQ HOTY (HALF (IMIN (fetch BITMAPHEIGHT of BRUSH)
CURSORHEIGHT]
(SETCURSOR SCRATCHCURSOR)
PAINTLP
(GETMOUSESTATE)
[COND
[(LASTMOUSESTATE RIGHT)
(COND
((OR (INSIDE? (DSPCLIPPINGREGION NIL DS)
(LASTMOUSEX DS)
(LASTMOUSEY DS))
(NOT (WHICHW LASTMOUSEX LASTMOUSEY)))
(* inside the interior, give command menu)
(SELECTQ [MENU (COND
((type? MENU PAINTCOMMANDMENU)
PAINTCOMMANDMENU)
(T (SETQ PAINTCOMMANDMENU
(create MENU
ITEMS ←(QUOTE ((SetMode (QUOTE MODE)
"Allows specification of how new bits are merged")
(SetShade (QUOTE SHADE)
"Allows specification of new shade.")
(SetShape (QUOTE SHAPE)
"Allows specification of brush shape")
(SetSize (QUOTE SIZE)
"Allows specification of the brush size")
(QUIT (QUOTE QUIT)
"Exits painting mode"]
(SHADE (SETQ PAINTCOMMANDSHADE (OR (PAINTW.READBRUSHSHADE)
PAINTCOMMANDSHADE))
(GO BRUSHLP))
(MODE (SETQ PAINTCOMMANDMODE (OR (PAINTW.READMODE)
PAINTCOMMANDMODE))
(GO BRUSHLP))
(SHAPE (RPLACA PAINTCOMMANDBRUSH (OR (PAINTW.READBRUSHSHAPE)
(CAR PAINTCOMMANDBRUSH)))
(GO BRUSHLP))
(SIZE (RPLACA (CDR PAINTCOMMANDBRUSH)
(OR (PAINTW.READBRUSHSIZE)
(CADR PAINTCOMMANDBRUSH)))
(GO BRUSHLP))
(QUIT (RETURN))
NIL))
(T (* do the window menu)
(DOWINDOWCOM (WHICHW LASTMOUSEX LASTMOUSEY]
[(AND (LASTMOUSESTATE LEFT)
(OR (EQ PAINTCOMMANDMODE (QUOTE REPLACE))
(NEQ PAINTCOMMANDSHADE BLACKSHADE)))
(* painting in grey is slightly harder.)
(COND
((EQ PAINTCOMMANDMODE (QUOTE REPLACE))
(* erase what is there now)
(BITBLT BRUSH 0 0 DS (IDIFFERENCE (LASTMOUSEX DS)
HOTX)
(IDIFFERENCE (LASTMOUSEY DS)
HOTY)
NIL NIL (QUOTE INPUT)
(QUOTE ERASE)) (* put in grey)
(BITBLT BRUSH 0 0 DS (IDIFFERENCE (LASTMOUSEX DS)
HOTX)
(IDIFFERENCE (LASTMOUSEY DS)
HOTY)
NIL NIL (QUOTE MERGE)
(QUOTE PAINT)
PAINTCOMMANDSHADE))
(T (BITBLT BRUSH 0 0 DS (IDIFFERENCE (LASTMOUSEX DS)
HOTX)
(IDIFFERENCE (LASTMOUSEY DS)
HOTY)
NIL NIL (QUOTE MERGE)
PAINTCOMMANDMODE PAINTCOMMANDSHADE]
((LASTMOUSESTATE (OR MIDDLE LEFT))
(BITBLT BRUSH 0 0 DS (IDIFFERENCE (LASTMOUSEX DS)
HOTX)
(IDIFFERENCE (LASTMOUSEY DS)
HOTY)
NIL NIL (QUOTE INPUT)
(COND
((LASTMOUSESTATE MIDDLE)
(QUOTE ERASE))
(T PAINTCOMMANDMODE]
(GO PAINTLP))
(CLRPROMPT)
(WINDOWPROP WINDOW (QUOTE PAINTBRUSH)
(LIST PAINTCOMMANDMODE PAINTCOMMANDSHADE (COPY PAINTCOMMANDBRUSH])
(PAINTW.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) (* rrb " 3-Jul-84 15:27")
(* entry for shaping a window that does the reshape
without checking for a user function.)
(DECLARE (LOCALVARS . T))
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(OR (REGIONP REGION)
(\ILLEGAL.ARG REGION))
(PROG ((OLDREGION (fetch REG of WINDOW))
(OLDCLIPREG (DSPCLIPPINGREGION NIL (fetch (WINDOW DSP) of WINDOW)))
(WBORDER (fetch WBORDER of WINDOW))
NUSAV NOWOPEN?)
(SETQ NUSAV (BITMAPCREATE (fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION)))
(UNINTERRUPTABLY
(COND
((OPENWP WINDOW) (* notice whether window is open or not to call OPENFNs
only if not now open.)
(SETQ NOWOPEN? T)
(\CLOSEW1 WINDOW))) (* Save window image)
(replace REG of WINDOW with REGION)
[replace SAVE of WINDOW with (PROG1 NUSAV (SETQ NUSAV (fetch SAVE of WINDOW]
(ADVISEWDS WINDOW OLDREGION)
(SHOWWFRAME WINDOW)
(COND
(NOWOPEN? (\OPENW1 WINDOW))
(T (OPENW WINDOW))))
(DOUSERFNS2 (OR (fetch (WINDOW RESHAPEFN) of WINDOW)
(FUNCTION RESHAPEBYREPAINTFN))
WINDOW NUSAV (create REGION
LEFT ← WBORDER
BOTTOM ← WBORDER
WIDTH ←(fetch (REGION WIDTH) of OLDCLIPREG)
HEIGHT ←(fetch (REGION HEIGHT) of OLDCLIPREG))
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) (* rrb "17-Aug-84 16:59")
(* 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 REG of WINDOW))
(OLDSAVE (fetch SAVE of WINDOW))
NUSAV DELTA NUWIDTH NUHEIGHT)
(SETQ DELTA (IDIFFERENCE NEWBORDER OLDBORDER))
[SETQ NUSAV (BITMAPCREATE (SETQ NUWIDTH (IPLUS (fetch (REGION WIDTH) of REGION)
(ITIMES DELTA 2)))
(SETQ NUHEIGHT (IDIFFERENCE
(IPLUS (fetch (REGION HEIGHT)
of (DSPCLIPPINGREGION NIL (fetch (WINDOW DSP)
of WINDOW)))
(ITIMES NEWBORDER 2))
(COND
((fetch (WINDOW WTITLE) of WINDOW)
(DSPLINEFEED NIL WindowTitleDisplayStream))
(T 0]
(.WHILE.ON.TOP. WINDOW (* Save window image)
(\SW2BM (SCREENBITMAP)
REGION
(fetch SAVE of WINDOW)
NIL) (* put new save image into window)
(replace SAVE of WINDOW with NUSAV)
(replace (WINDOW WBORDER) of WINDOW with NEWBORDER)
(* create a region that coresponds to the old region
with the new border.)
(replace (WINDOW REG) of WINDOW with (create REGION
LEFT ←(IDIFFERENCE
(fetch (REGION LEFT)
of REGION)
DELTA)
BOTTOM ←(IDIFFERENCE
(fetch (REGION BOTTOM)
of REGION)
DELTA)
WIDTH ← NUWIDTH
HEIGHT ← NUHEIGHT))
(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 BITMAPWIDTH of OLDSAVE)
(ITIMES 2 OLDBORDER))
(fetch (REGION HEIGHT) of (DSPCLIPPINGREGION NIL
(fetch (WINDOW DSP)
of WINDOW)))
(QUOTE INPUT)
(QUOTE REPLACE)) (* put the new image up on the screen.)
(\SW2BM (SCREENBITMAP)
(fetch REG of WINDOW)
(fetch SAVE of WINDOW)
NIL])
(TRACKW
[LAMBDA (WINDOW) (* rrb " 9-MAR-82 14:28")
(* causes a window to follow the cursor.
found to be not useful but very pretty for small
windows.)
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(RESETFORM (CURSOR CROSSHAIRS)
(TOTOPW WINDOW)
(until (MOUSESTATE (NOT UP)))
(CURSOR LOCKEDSPOT)
(bind (DX ←(IDIFFERENCE (fetch (REGION LEFT) of (fetch (WINDOW REG) of WINDOW))
LASTMOUSEX))
(DY ←(IDIFFERENCE (fetch (REGION BOTTOM) of (fetch (WINDOW REG) of WINDOW))
LASTMOUSEY))
until (MOUSESTATE UP) do (MOVEW WINDOW (create POSITION
XCOORD ←(IPLUS LASTMOUSEX DX)
YCOORD ←(IPLUS LASTMOUSEY DY])
(SNAPW
[LAMBDA NIL (* rrb " 9-Dec-83 15:29")
(* makes a new window which is a copy of the bits
underneath the REGION read from the user.)
(PROG ((REG (GETREGION 30 20))
NEWWINDOW)
(OR (type? REGION REG)
(HELP "Not a region" REG))
(SETQ NEWWINDOW (CREATEW (GROW/REGION REG WBorder)
NIL NIL T)) (* keep it closed so it doesn't cover any of the bits it
is to copy.)
(* put existing screen bits from SAVE.)
(BITBLT (SCREENBITMAP)
(fetch (REGION LEFT) of REG)
(fetch (REGION BOTTOM) of REG)
(fetch SAVE of NEWWINDOW)
WBorder WBorder (fetch (REGION WIDTH) of REG)
(fetch (REGION HEIGHT) of REG)
(QUOTE INPUT)
(QUOTE REPLACE))
(OPENW NEWWINDOW)
(MOVEW NEWWINDOW)
(RETURN NEWWINDOW])
(WINDOWREGION
[LAMBDA (WINDOW 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])
)
(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.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 )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS BACKGROUNDCURSORINFN BACKGROUNDBUTTONEVENTFN BACKGROUNDCURSOROUTFN
BACKGROUNDCURSORMOVEDFN \LASTKEYSTATE BACKGROUNDCOPYBUTTONEVENTFN
BACKGROUNDCOPYRIGHTBUTTONEVENTFN \CARET.UP)
)
(* 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 . ARGS))
[DECLARE: EVAL@COMPILE
(RECORD WSOPS (WSCHANGEBACKGROUND WSCHANGEBACKGROUNDBORDER WSDISPLAYHEIGHT STARTCOLOR STOPCOLOR
SETSCREENCOLORMAP COLORLEVEL ROTATECOLORMAP MEDIUM))
(RECORD WSDATA (WSDESTINATION WSREGION WSBACKGROUND WSCOLORMAP))
]
(* image object support - here so that DEDIT can use it without needing TEDIT to be loaded.)
[DECLARE: EVAL@COMPILE
(DATATYPE IMAGEOBJ (OBJECTDATUM IMAGEOBJPLIST IMAGEOBJFNS))
(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.)))
(RECORD IMAGEBOX (XSIZE YSIZE YDESC XKERN))
]
(/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) (* jds "19-Feb-85 15:54")
(* Reads an IMAGEOBJ, using GETFN.
Verifies that the GETFN is legitimate)
(LET* [(ENTRY (ASSOC GETFN IMAGEOBJGETFNS))
(SUPPORTFILE (LISTGET (CDR ENTRY)
(QUOTE FILE]
[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)))
(* Build an ENCAPSULATED imageobj.)
(IMAGEOBJPROP OBJ (QUOTE FILE)
STREAM) (* Remember which file it came from)
(IMAGEOBJPROP OBJ (QUOTE FILEPTR)
(GETFILEPTR STREAM)) (* And where on the file)
(IMAGEOBJPROP OBJ (QUOTE UNKNOWNGETFN)
GETFN) (* 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) (* jds "19-Feb-85 10:40")
(* * 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)))
(COND
(OBJ (* We succeeded in reading the object this time.
Copy its guts over the placeholder.)
(COPYIMAGEOBJ OBJ IMAGEOBJ)))
(RETURN (QUOTE CHANGED])
(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])
(ENCAPSULATEDOBJ.INIT
[LAMBDA NIL (* jds "19-Feb-85 10:10")
(* Set up the IMAGEFNS for the encapsulated-IMAGEOBJ
type: The way to protect TEdit and friends from
unfriendly IMAGEOBJs)
(SETQ ENCAPSULATEDIMAGEFNS (IMAGEFNSCREATE (FUNCTION ENCAPSULATEDOBJ.DISPLAYFN)
(FUNCTION ENCAPSULATEDOBJ.IMAGEBOXFN)
(FUNCTION NIL)
(FUNCTION NIL)
(FUNCTION NIL)
(FUNCTION ENCAPSULATEDOBJ.BUTTONEVENTINFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL])
)
(ENCAPSULATEDOBJ.INIT)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS ENCAPSULATEDIMAGEFNS)
)
(* Window utilities)
(DEFINEQ
(ADVISEWDS
[LAMBDA (WINDOW OLDREG MOVEONLYFLG) (* rrb "11-Oct-84 16:56")
(DECLARE (LOCALVARS . T))
(* called whenever the dimensions of a guaranteed WINDOW change. Updates the dependent fields in the associated
DisplayStream. Also updates dependent fields in the WINDOW such as Scroll region.)
(* OLDREG if given, is the region this window used to have and is used to maintain the relationship between the
WINDOW coordinates and the displaystreams when the WINDOW moves.)
(* MOVEONLYFLG indicates that the dimensions of the
region haven't changed.)
(PROG ((R (fetch REG of WINDOW))
(D (fetch DSP of WINDOW))
(WBORDERSIZE (fetch WBORDER of WINDOW))
CLIPREG TWICEBORDER PROC)
(SETQ TWICEBORDER (UNFOLD WBORDERSIZE 2))
(COND
(OLDREG (RELDSPXOFFSET (IDIFFERENCE (fetch (REGION LEFT) of R)
(fetch (REGION LEFT) of OLDREG))
D)
(RELDSPYOFFSET (IDIFFERENCE (fetch (REGION BOTTOM) of R)
(fetch (REGION BOTTOM) of OLDREG))
D)
(* if only moving, the clipping region remains the same. This is checked for because the height of the window title
may have changed and this calculation results in the wrong answer. All other calls to ADVISEWDS should repaint the
border.)
(OR MOVEONLYFLG (DSPCLIPPINGREGION [create REGION
LEFT ←(fetch (REGION LEFT)
of (SETQ CLIPREG
(DSPCLIPPINGREGION
NIL D)))
BOTTOM ←(fetch (REGION BOTTOM)
of CLIPREG)
WIDTH ←(IDIFFERENCE
(fetch (REGION WIDTH) of R)
TWICEBORDER)
HEIGHT ←(IPLUS
(IDIFFERENCE (fetch (REGION HEIGHT)
of R)
TWICEBORDER)
(COND
((fetch (WINDOW WTITLE)
of WINDOW)
(DSPLINEFEED NIL
WindowTitleDisplayStream))
(T 0]
D)))
(T (DSPXOFFSET (IPLUS (fetch (REGION LEFT) of R)
WBORDERSIZE)
D)
(DSPYOFFSET (IPLUS (fetch (REGION BOTTOM) of R)
WBORDERSIZE)
D)
(DSPCLIPPINGREGION [create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ←(IDIFFERENCE (fetch (REGION WIDTH) of R)
TWICEBORDER)
HEIGHT ←(IPLUS (IDIFFERENCE (fetch (REGION HEIGHT)
of R)
TWICEBORDER)
(COND
((fetch (WINDOW WTITLE) of WINDOW)
(DSPLINEFEED NIL
WindowTitleDisplayStream))
(T 0]
D)))
[COND
((NULL MOVEONLYFLG) (* if the previous right margin was the default, change
it.)
(AND (OR (NOT OLDREG)
(EQ (DSPRIGHTMARGIN NIL D)
(IDIFFERENCE (fetch (REGION WIDTH) of OLDREG)
TWICEBORDER)))
(DSPRIGHTMARGIN (IDIFFERENCE (fetch (REGION WIDTH) of R)
TWICEBORDER)
D))
(COND
((AND (SETQ PROC (WINDOWPROP WINDOW (QUOTE PROCESS)))
(EQ D (PROCESS.TTY PROC))) (* if the window changing is a tty, set its
linelength.)
[PROCESS.EVAL PROC (LIST (FUNCTION PAGEHEIGHT)
(IQUOTIENT (fetch (REGION HEIGHT)
of (SETQ CLIPREG (DSPCLIPPINGREGION NIL D)))
(IMINUS (DSPLINEFEED NIL D]
(PROCESS.EVAL PROC (QUOTE (SETLINELENGTH)))
(* 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) (* rrb "24-May-84 11:52")
(* prints a title in a window.)
(PROG ((FONT (DSPFONT NIL WindowTitleDisplayStream))
(BLACKPART (SELECTQ BORDER
(0 0)
((1 2)
1)
(3 2)
(IDIFFERENCE BORDER 2)))
(TITLESHADE (OR (TEXTUREP (OR (WINDOWPROP WINDOW (QUOTE WINDOWTITLESHADE))
WINDOWTITLESHADE))
BLACKSHADE))
BMWIDTH HEIGHT BOTTOM X LEFTMARGIN)
(DSPDESTINATION BM WindowTitleDisplayStream)
(DSPCLIPPINGREGION (create REGION
LEFT ← 0
BOTTOM ←[SETQ BOTTOM (IDIFFERENCE (IPLUS (BITMAPHEIGHT BM)
(COND
((ZEROP BORDER)
0)
(T
(* if room, leave a line of the border at the top of the
title.)
-1)))
(SETQ HEIGHT
(FONTPROP FONT (QUOTE HEIGHT]
WIDTH ←(SETQ BMWIDTH (BITMAPWIDTH BM))
HEIGHT ← HEIGHT)
WindowTitleDisplayStream)
(MOVETO (COND
[CENTERFLG (* 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)))
WindowTitleDisplayStream)
(RESETFORM (PRINTLEVEL WINDOWTITLEPRINTLEVEL)
(PROG ((PLVLFILEFLG T))
(PRIN3 TITLE WindowTitleDisplayStream)))
(BITBLT NIL NIL NIL WindowTitleDisplayStream (SETQ X (IPLUS (IMAX 2 BLACKPART)
(DSPXPOSITION NIL
WindowTitleDisplayStream)))
(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 WindowTitleDisplayStream 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) (* rrb " 5-Jun-84 15:19")
(* updates a windows display with a new title)
(PROG ((WREG (fetch (WINDOW REG) of WINDOW))
(TITLEHEIGHT (IMINUS (DSPLINEFEED NIL WindowTitleDisplayStream)))
(OLDTITLE (fetch (WINDOW WTITLE) of WINDOW))
(BORDER (fetch WBORDER of WINDOW))
BM BMBTM HGHT)
[COND
(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]
(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))
(SCREENBITMAP)
(fetch (REGION LEFT) of WREG)
[IDIFFERENCE (fetch (REGION PTOP) of WREG)
(COND
(BMBTM HGHT)
(T (IPLUS TITLEHEIGHT (COND
((IGREATERP BORDER 0)
(* if there is a border, the title was printed in the
scratch bitmap so to leave one point of the border on
top)
0)
(T -1]
NIL
(COND
(BMBTM HGHT))))])
(TOTOPW
[LAMBDA (WINDOW NOCALLTOTOPFNFLG) (* rrb "28-JUN-83 11:55")
(* user entry to bring a window to the top.
Unless NOCALLTOTOPFNFLG is non-NIL, it will call the
windows TOTOPFN)
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(COND
((EQ WINDOW TOPW))
((OPENWP WINDOW)
(OR NOCALLTOTOPFNFLG (DOUSERFNS (WINDOWPROP WINDOW (QUOTE TOTOPFN))
WINDOW))
(\INTERNALTOTOPW WINDOW))
((OPENW WINDOW) (* if it is not open, open it and then call the TOTOPFN)
(OR NOCALLTOTOPFNFLG (DOUSERFNS (WINDOWPROP WINDOW (QUOTE TOTOPFN))
WINDOW)))
(T (* window won't open probably because of DON'T OPENFN)
(ERROR "Window won't open; Can't be bring to top." WINDOW)))
WINDOW])
(\INTERNALTOTOPW
[LAMBDA (W1 RPT) (* bas: "21-OCT-82 16:50")
(SETQ W1 (\INSUREWINDOW W1))
(OR (EQ W1 TOPW)
(COND
((NULL TOPW) (* all windows are closed open this one.)
(OPENW W1))
(T (UNINTERRUPTABLY
(\TTW1 W1 TOPW) (* GC msgs or other glitches can cause W1 not to make
it. Check and try ONCE more)
(COND
((EQ W1 TOPW))
(RPT (SHOULDNT))
(T (\INTERNALTOTOPW W1 T))))])
(\TTW1
[LAMBDA (WINDOW WS) (* rrb "26-OCT-83 14:56")
(COND
[(fetch (WINDOW NEXTW) of WS)
(PROG ((ISECT (INTERSECTREGIONS (fetch REG of WINDOW)
(fetch REG of WS)
WHOLESCREEN)))
(AND ISECT (\SW2BM (fetch SAVE of WS)
(TRANSLATEREG ISECT (fetch REG of WS))
(SCREENBITMAP)
ISECT))
[COND
((EQ WINDOW (fetch (WINDOW NEXTW) of WS)) (* doesn't have to be uninterruptable here because
TOTOPW is.)
(replace (WINDOW NEXTW) of WS with (fetch (WINDOW NEXTW) of WINDOW))
(replace (WINDOW NEXTW) of WINDOW with TOPW)
(SETQ TOPW WINDOW)
(SETQ \TOPWDS (fetch (WINDOW DSP) of WINDOW)))
(T (\TTW1 WINDOW (fetch (WINDOW NEXTW) of WS]
(AND ISECT (\SW2BM (fetch SAVE of WINDOW)
(TRANSLATEREG ISECT (fetch REG of WINDOW))
(fetch SAVE of WS)
(TRANSLATEREG ISECT (fetch REG of WS]
((type? WINDOW WINDOW) (* must be closed window; reopen it)
(OPENW WINDOW])
(WHICHW
[LAMBDA (X Y) (* rrb "26-OCT-83 14:56")
(COND
((POSITIONP X)
(WHICHW (fetch (POSITION XCOORD) of X)
(fetch (POSITION YCOORD) of X)))
(T (for (WINDOW ← TOPW) by (fetch (WINDOW NEXTW) of WINDOW) while WINDOW
thereis (INSIDE? (fetch REG of WINDOW)
X Y])
)
(RPAQQ WINDOWTITLEPRINTLEVEL (2 . 5))
(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) (* AJB " 7-Jun-85 15:08")
(* Finds or creates a window for a display stream)
(* uses an XPointer from the displaystream as a hint.
This means that the window might have been garbage
collected, hence all the confirmation.)
(DECLARE (GLOBALVARS \DEFAULTTTYDISPLAYSTREAM))
(PROG (DD HINTW)
[COND
((IMAGESTREAMTYPEP DS (QUOTE TEXT))
(RETURN (CAR (fetch \WINDOW of (TEXTOBJ DS]
(SETQ DD (\GETDISPLAYDATA DS DS))
(RETURN (COND
((AND (SETQ HINTW (ffetch XWINDOWHINT of DD))
(EQ (ffetch (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]
((NEQ (ffetch DDDestination of DD)
(SCREENBITMAP)) (* for now color display streams don't have windows
associated with them.)
NIL)
([SETQ HINTW (for (WINDOW ← TOPW) by (fetch (WINDOW NEXTW) of WINDOW)
while WINDOW thereis (EQ DS (fetch (WINDOW DSP) of WINDOW]
HINTW)
((NOT DONTCREATE)
(CREATEW DS NIL NIL T])
(NU\TOTOPWDS
[LAMBDA (DS) (* rmk: "21-OCT-81 22:31")
(* Moves the window of displaystream DS to the top)
(AND (EQ (DSPDESTINATION NIL DS)
(SCREENBITMAP))
(TOTOPW (WFROMDS DS])
(\COERCETODS
[LAMBDA (X) (* rrb "23-OCT-81 13:29")
(* Called from \SFInsureDisplayStream macro.
Compiles open in system code, closed call in user code,
and equivalent to \ILLEGAL.ARG if no window package.)
(COND
((type? WINDOW X)
(fetch (WINDOW DSP) of X))
(T (\ILLEGAL.ARG X])
)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
[PUTPROPS \COERCETODS MACRO (OPENLAMBDA (X)
(COND ((type? WINDOW X)
(fetch (WINDOW DSP)
of X))
(T (\ILLEGAL.ARG X]
[PUTPROPS .WHILE.ON.TOP. MACRO ((FIRST . REST)
(UNINTERRUPTABLY
(\INTERNALTOTOPW FIRST) . REST)]
)
(* END EXPORTED DEFINITIONS)
)
(* User interface functions)
(DEFINEQ
(WINDOWP
[LAMBDA (X) (* rrb "20-NOV-81 07:30")
(AND (type? WINDOW X)
X])
(WINDOWPROP
[LAMBDA X (* rrb "26-AUG-82 17:36")
(* general top level entry for both fetching and setting
window properties.)
(COND
((IGREATERP X 2)
(PUTWINDOWPROP (ARG X 1)
(ARG X 2)
(ARG X 3)))
((EQ X 2)
(GETWINDOWPROP (ARG X 1)
(ARG X 2)))
(T (\ILLEGAL.ARG NIL])
(WINDOWADDPROP
[LAMBDA (WINDOW PROP ITEMTOADD 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) (* rrb "30-Sep-85 17:05")
(* 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))
(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) (* rrb " 5-Jun-84 15:21")
[OR (type? WINDOW WINDOW)
(COND
((DISPLAYSTREAMP (\OUTSTREAMARG WINDOW))
(SETQ WINDOW (WFROMDS WINDOW)))
(T (\ILLEGAL.ARG WINDOW]
(SELECTQ PROP
(RIGHTBUTTONFN (PROG1 (fetch (WINDOW RIGHTBUTTONFN) of WINDOW)
(replace (WINDOW RIGHTBUTTONFN) of WINDOW with VALUE)))
(BUTTONEVENTFN (PROG1 (fetch (WINDOW BUTTONEVENTFN) of WINDOW)
(replace (WINDOW BUTTONEVENTFN) of WINDOW with VALUE)))
(CLOSEFN (PROG1 (fetch (WINDOW CLOSEFN) of WINDOW)
(replace (WINDOW CLOSEFN) of WINDOW with VALUE)))
(MOVEFN (PROG1 (fetch (WINDOW MOVEFN) of WINDOW)
(replace (WINDOW MOVEFN) of WINDOW with VALUE)))
(CURSORINFN (PROG1 (fetch (WINDOW CURSORINFN) of WINDOW)
(replace (WINDOW CURSORINFN) of WINDOW with VALUE)))
(CURSOROUTFN (PROG1 (fetch (WINDOW CURSOROUTFN) of WINDOW)
(replace (WINDOW CURSOROUTFN) of WINDOW with VALUE)))
(CURSORMOVEDFN (PROG1 (fetch (WINDOW CURSORMOVEDFN) of WINDOW)
(replace (WINDOW CURSORMOVEDFN) of WINDOW with VALUE)))
(DSP (ERROR "Can't change DSP of a window" WINDOW))
(RESHAPEFN (PROG1 (fetch (WINDOW RESHAPEFN) of WINDOW)
(replace (WINDOW RESHAPEFN) of WINDOW with VALUE)))
(REPAINTFN (PROG1 (fetch (WINDOW REPAINTFN) of WINDOW)
(replace (WINDOW REPAINTFN) of WINDOW with VALUE)))
(EXTENT (PROG1 (fetch (WINDOW EXTENT) of WINDOW)
(OR (NULL VALUE)
(REGIONP VALUE)
(\ILLEGAL.ARG VALUE))
(replace (WINDOW EXTENT) of WINDOW with VALUE)))
(SCROLLFN (PROG1 (fetch (WINDOW SCROLLFN) of WINDOW)
(replace (WINDOW SCROLLFN) of WINDOW with VALUE)
(UPDATE/SCROLL/REG WINDOW)))
(IMAGECOVERED (ERROR "Not implemented to change IMAGECOVERED property." WINDOW))
(HEIGHT (ERROR "Not implemented to change HEIGHT as property." WINDOW))
(WIDTH (ERROR "Not implemented to change WIDTH as property." WINDOW))
[REGION (PROG [(CURREGION (WINDOWPROP WINDOW (QUOTE REGION]
(COND
((NOT (REGIONP VALUE))
(\ILLEGAL.ARG VALUE))) (* there is no check for where the new region is nor how
big it is; this is left to MOVEW and RESHAPEW.)
(COND
((AND (EQ (fetch (REGION WIDTH) of CURREGION)
(fetch (REGION WIDTH) of VALUE))
(EQ (fetch (REGION HEIGHT) of CURREGION)
(fetch (REGION HEIGHT) of VALUE)))
(* width and height are the same, move the window)
(MOVEW WINDOW (fetch (REGION LEFT) of VALUE)
(fetch (REGION BOTTOM) of VALUE)))
(T (* dimensions changed, reshape it.)
(SHAPEW WINDOW VALUE]
(NEWREGIONFN (PROG1 (fetch (WINDOW NEWREGIONFN) of WINDOW)
(replace (WINDOW NEWREGIONFN) of WINDOW with VALUE)))
(TITLE (PROG1 (fetch (WINDOW WTITLE) of WINDOW)
(RESHOWTITLE VALUE WINDOW)))
[BORDER (PROG1 (fetch (WINDOW WBORDER) of WINDOW)
(COND
((NUMBERP VALUE)
(RESHOWBORDER VALUE WINDOW))
(T (\ILLEGAL.ARG VALUE]
(PROCESS (PROG1 (fetch (WINDOW PROCESS) of WINDOW)
(replace (WINDOW PROCESS) of WINDOW with VALUE)))
(WINDOWENTRYFN (PROG1 (fetch (WINDOW WINDOWENTRYFN) of WINDOW)
(replace (WINDOW WINDOWENTRYFN) of WINDOW with VALUE)))
(PROG ((OLDDATA (fetch USERDATA of WINDOW))
OLDVALUE)
(RETURN (PROG1 (COND
(OLDDATA (SETQ OLDVALUE (LISTGET OLDDATA PROP))
[COND
(VALUE (LISTPUT OLDDATA PROP VALUE))
(OLDVALUE (* Remove the property)
(COND
((EQ (CAR OLDDATA)
PROP)
(replace USERDATA of WINDOW
with (CDDR OLDDATA)))
(T (for TAIL on (CDR OLDDATA)
by (CDDR TAIL)
when (EQ (CADR TAIL)
PROP)
do (FRPLACD TAIL (CDDDR TAIL))
(RETURN]
OLDVALUE)
(VALUE (replace USERDATA of WINDOW with (LIST PROP VALUE))
(* know old value is NIL)
NIL))
(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 (fetch USERDATA of WINDOW)))
(RETURN (for TAIL on DATA by (CDDR TAIL) bind PREV
do (COND
((EQ (CAR TAIL)
PROP)
(COND
(PREV (RPLACD (CDR PREV)
(CDDR TAIL)))
((CDDR TAIL)
(FRPLNODE2 TAIL (CDDR TAIL)))
(T (replace USERDATA of WINDOW with NIL)))
(RETURN PROP)))
(SETQ PREV TAIL])
(WINDOWADDFNPROP
[LAMBDA (WINDOW PROP ITEMTOADD) (* rrb "18-JUN-82 16:30")
(* adds A functional element to a window property.
This is different from WINDOWADDTOPROP because is checks
for LAMBDA expressions as a single element.)
(PROG ((CURRENT (WINDOWPROP WINDOW PROP)))
(RETURN (WINDOWPROP WINDOW PROP (COND
((NULL CURRENT)
(LIST ITEMTOADD))
((OR (NLISTP CURRENT)
(FMEMB (CAR CURRENT)
LAMBDASPLST))
(LIST CURRENT ITEMTOADD))
((FMEMB ITEMTOADD CURRENT) (* don't put things on twice.)
CURRENT)
(T (NCONC1 (APPEND CURRENT)
ITEMTOADD])
)
(* for compiling windowprops.)
(PUTPROPS WINDOWPROP ARGNAMES (NIL (WINDOW PROP {NEWVALUE}) . U))
(DECLARE: EVAL@COMPILE
(PUTPROPS WINDOWPROP MACRO (ARGS (CWINDOWPROP ARGS)))
)
(DEFINEQ
(CWINDOWPROP
[LAMBDA (FORMTAIL) (* rrb "28-OCT-83 10:51")
(* compiles calls to WINDOWPROP)
(COND
((NULL (CDR FORMTAIL)) (* less that 2 args)
(printout T "Possible error in call to WINDOWPROP: less than 2 args" T (LIST (QUOTE
WINDOWPROP)
FORMTAIL)
T)
(CGETWINDOWPROP (CAR FORMTAIL)
NIL))
((NOT (EQ (CAADR FORMTAIL)
(QUOTE QUOTE))) (* property is not quoted.)
(QUOTE IGNOREMACRO))
[(NULL (CDDR FORMTAIL)) (* fetching a window property.)
(CGETWINDOWPROP (CAR FORMTAIL)
(CADR (CADR FORMTAIL]
(T (* storing a window property)
(CONS (QUOTE PUTWINDOWPROP)
FORMTAIL])
(CGETWINDOWPROP
[LAMBDA (WINFORM PROP) (* rrb " 5-Jun-84 11:29")
(* compiles calls on WINDOWPROP that are fetching
values. This needs to be changed whenever GETWINDOWPROP
is changed.)
(PROG NIL
(RETURN (SUBST (LIST (QUOTE \INSUREWINDOW)
WINFORM)
(QUOTE DATUM)
(SELECTQ PROP
[RIGHTBUTTONFN (CONSTANT (RECORDACCESSFORM (QUOTE RIGHTBUTTONFN)
(QUOTE DATUM)
(QUOTE ffetch]
[BUTTONEVENTFN (CONSTANT (RECORDACCESSFORM (QUOTE BUTTONEVENTFN)
(QUOTE DATUM)
(QUOTE ffetch]
[CURSORINFN (CONSTANT (RECORDACCESSFORM (QUOTE CURSORINFN)
(QUOTE DATUM)
(QUOTE ffetch]
[CURSOROUTFN (CONSTANT (RECORDACCESSFORM (QUOTE CURSOROUTFN)
(QUOTE DATUM)
(QUOTE ffetch]
[CURSORMOVEDFN (CONSTANT (RECORDACCESSFORM (QUOTE CURSORMOVEDFN)
(QUOTE DATUM)
(QUOTE ffetch]
[DSP (CONSTANT (RECORDACCESSFORM (QUOTE DSP)
(QUOTE DATUM)
(QUOTE ffetch]
[SCROLLFN (CONSTANT (RECORDACCESSFORM (QUOTE SCROLLFN)
(QUOTE DATUM)
(QUOTE ffetch]
[MOVEFN (CONSTANT (RECORDACCESSFORM (QUOTE MOVEFN)
(QUOTE DATUM)
(QUOTE ffetch]
[RESHAPEFN (CONSTANT (RECORDACCESSFORM (QUOTE RESHAPEFN)
(QUOTE DATUM)
(QUOTE ffetch]
[EXTENT (CONSTANT (RECORDACCESSFORM (QUOTE EXTENT)
(QUOTE DATUM)
(QUOTE ffetch]
[REPAINTFN (CONSTANT (RECORDACCESSFORM (QUOTE REPAINTFN)
(QUOTE DATUM)
(QUOTE ffetch]
[CLOSEFN (CONSTANT (RECORDACCESSFORM (QUOTE CLOSEFN)
(QUOTE DATUM)
(QUOTE ffetch]
[WINDOWENTRYFN (CONSTANT (RECORDACCESSFORM (QUOTE WINDOWENTRYFN)
(QUOTE DATUM)
(QUOTE ffetch]
[PROCESS (CONSTANT (RECORDACCESSFORM (QUOTE PROCESS)
(QUOTE DATUM)
(QUOTE ffetch]
[REGION (CONSTANT (RECORDACCESSFORM (QUOTE REG)
(QUOTE DATUM)
(QUOTE ffetch]
[NEWREGIONFN (CONSTANT (RECORDACCESSFORM (QUOTE NEWREGIONFN)
(QUOTE DATUM)
(QUOTE ffetch]
[TITLE (CONSTANT (RECORDACCESSFORM (QUOTE WTITLE)
(QUOTE DATUM)
(QUOTE ffetch]
[BORDER (CONSTANT (RECORDACCESSFORM (QUOTE WBORDER)
(QUOTE DATUM)
(QUOTE ffetch]
[IMAGECOVERED (CONSTANT (RECORDACCESSFORM (QUOTE SAVE)
(QUOTE DATUM)
(QUOTE ffetch]
[HEIGHT (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) (* rrb " 4-Jun-84 18:03")
(* 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 WindowTitleDisplayStream))
(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])
(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 NIL (* rrb "28-JUN-83 12:00")
(* returns a list of all open windows)
(PROG (WINDOWS WPTR)
(SETQ WPTR TOPW)
LP (COND
((NULL WPTR)
(RETURN WINDOWS))
(T (SETQ WINDOWS (CONS WPTR WINDOWS))
(SETQ WPTR (fetch (WINDOW NEXTW) of WPTR))
(GO LP])
(\INSUREWINDOW
[LAMBDA (WINDOW) (* rmk: " 1-SEP-83 10:25")
(* coerces to a window)
(COND
((type? WINDOW WINDOW)
WINDOW)
((AND (DISPLAYSTREAMP (\OUTSTREAMARG WINDOW T))
(WFROMDS WINDOW)))
(T (\ILLEGAL.ARG WINDOW])
)
(* these entries are left in for backward compatibility. They were dedocumented 6/83. rrb)
(MOVD (QUOTE OPENWP)
(QUOTE ACTIVEWP))
(MOVD (QUOTE OPENWINDOWS)
(QUOTE ACTIVEWINDOWS))
(DEFINEQ
(OVERLAPPINGWINDOWS
[LAMBDA (WINDOW) (* rrb " 8-May-84 16:26")
(* returns all windows that overlap with WINDOW or that
overlap a window that is in the OVERLAPPINGWINDOWS of
WINDOW.)
(PROG ((WPTR TOPW)
(OVERLAPS (CONS WINDOW (ALLATTACHEDWINDOWS WINDOW)))
DONTS)
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) (* rrb "16-AUG-81 16:57")
(* returns a list of windows in order from bottom to
top)
(PROG (ANS (WPTR TOPW))
LP [COND
((NULL WPTR)
(RETURN ANS))
((FMEMB WPTR WLST)
(SETQ ANS (CONS WPTR ANS]
(SETQ WPTR (fetch (WINDOW NEXTW) of WPTR))
(GO LP])
)
(* screen size changing functions.)
(DEFINEQ
(\ONSCREENW
[LAMBDA (W) (* rrb "14-OCT-81 11:19")
(* does W have any part on the screen?)
(* for now only consider that it might be too far to the
right as this is the wide to narrow screen case.)
(* CURSORWIDTH is to make sure the cursor can be set in the window. It can be taken out when cursor hotspot can go
anywhere.)
(IGREATERP (IDIFFERENCE SCREENWIDTH CURSORWIDTH)
(fetch (REGION LEFT) of (WINDOWPROP W (QUOTE REGION])
(\PUTONSCREENW
[LAMBDA (W) (* rrb " 3-MAR-82 11:16")
(* moves W so that it will be on the screen.
For now, moves it to the left by screenwidth)
(MOVEW W (create POSITION
XCOORD ←(IDIFFERENCE (fetch (REGION LEFT) of (fetch (WINDOW REG) of W))
SCREENWIDTH)
YCOORD ←(fetch (REGION BOTTOM) of (WINDOWPROP W (QUOTE REGION])
(\UPDATECACHEDFIELDS
[LAMBDA (DS) (* rrb "14-OCT-81 16:53")
(* updates the cached fields of a displaystream for the
fact that the screen bitmap changed sizes)
(\SFFixDestination DS])
(\WWCHANGESCREENSIZE
[LAMBDA NIL (* rrb "28-Aug-84 15:29")
(* the sysout has been moved to a screen of a different size. All windows are closed, the screenbitmap is updated
to correct new size and the windows are reopened so that at least part of each is visible.)
(PROG [(WINDOWS (DREVERSE (OPENWINDOWS] (* OPENWINDOWS returns the windows with bottom window
first.)
(for W in WINDOWS do (CLOSEW W))
(\STARTDISPLAY)
(\CLEARBM (SCREENBITMAP)
WINDOWBACKGROUNDSHADE) (* update cached bitmap width information that is in the
display streams)
[for W in WINDOWS do (\UPDATECACHEDFIELDS (WINDOWPROP W (QUOTE DSP]
[for W in KNOWNWINDOWS do (\UPDATECACHEDFIELDS (WINDOWPROP W (QUOTE DSP]
(* bring back windows)
(for W in (DREVERSE WINDOWS)
do (COND
((NOT (\ONSCREENW W))
(\PUTONSCREENW W)))
(OPENW W])
(CREATEWFROMIMAGE
[LAMBDA (IMAGE) (* rrb "17-Jan-84 13:51")
(* creates a window that has IMAGE as an image.
It is initially closed and can be opened.)
(PROG ((WINDOW (CREATEW (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ←(BITMAPWIDTH IMAGE)
HEIGHT ←(BITMAPHEIGHT IMAGE))
NIL 0 T)))
[WINDOWPROP WINDOW (QUOTE MINSIZE)
(CONS (IMIN MinWindowWidth (BITMAPWIDTH IMAGE))
(IMIN MinWindowWidth (BITMAPHEIGHT IMAGE]
(BITBLT IMAGE 0 0 (fetch (WINDOW SAVE) of WINDOW))
(RETURN WINDOW])
(UPDATEWFROMIMAGE
[LAMBDA (WINDOW) (* rrb " 9-MAR-82 14:33")
(* makes the fields of a window consistent with its
image.)
(PROG ((REGION (fetch REG of WINDOW))
(IMAGE (fetch SAVE of WINDOW)))
(replace (REGION LEFT) of REGION with 0)
(replace (REGION BOTTOM) of REGION with 0)
(replace (REGION WIDTH) of REGION with (fetch (BITMAP BITMAPWIDTH) of IMAGE))
(replace (REGION HEIGHT) of REGION with (fetch (BITMAP BITMAPHEIGHT) of IMAGE))
(replace WBORDER of WINDOW with 0])
)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
[PUTPROPS WINDOWWORLD MACRO (X (COND ((NULL X)
(QUOTE (type? WINDOW TOPW)))
(T (QUOTE IGNOREMACRO]
)
)
(* END EXPORTED DEFINITIONS)
(* Scrolling stuff)
(DEFINEQ
(SCROLLW
[LAMBDA (WINDOW DX DY CONTINUOUSFLG) (* 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) (* rrb " 2-May-85 10:00")
(* 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 WHOLEDISPLAY (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 WHOLEDISPLAY
(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) (* relative offsetting function.)
(DSPXOFFSET (IPLUS DX (DSPXOFFSET NIL DISPLAYSTREAM))
DISPLAYSTREAM])
(RELDSPYOFFSET
[LAMBDA (DY DISPLAYSTREAM) (* relative offsetting function.)
(DSPYOFFSET (IPLUS DY (DSPYOFFSET NIL DISPLAYSTREAM))
DISPLAYSTREAM])
(SCROLL.HANDLER
[LAMBDA (WINDOW) (* rrb " 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) (* rrb " 9-MAR-82 14:34")
(* updates the scroll region field of the WINDOW)
(COND
((fetch SCROLLFN of WINDOW)
(PROG ((IMAGEREG (fetch REG of WINDOW))) (* kill the cache for the scroll region.)
(COND
((fetch (WINDOW VERTSCROLLWINDOW) of WINDOW)
(CLOSEW (fetch (WINDOW VERTSCROLLWINDOW) of WINDOW))
(replace (WINDOW VERTSCROLLWINDOW) of WINDOW with NIL)))
(COND
((fetch (WINDOW HORIZSCROLLWINDOW) of WINDOW)
(CLOSEW (fetch (WINDOW HORIZSCROLLWINDOW) of WINDOW))
(replace (WINDOW HORIZSCROLLWINDOW) of WINDOW with NIL)))
[replace (WINDOW VERTSCROLLREG) of WINDOW
with (create REGION
LEFT ←(IMAX 0 (IDIFFERENCE (fetch (REGION LEFT) of IMAGEREG)
SCROLLBARWIDTH))
BOTTOM ←(fetch (REGION BOTTOM) of IMAGEREG)
WIDTH ← SCROLLBARWIDTH
HEIGHT ←(IPLUS (fetch (REGION HEIGHT) of IMAGEREG)
(COND
((fetch (WINDOW WTITLE) of WINDOW)
(DSPLINEFEED NIL WindowTitleDisplayStream))
(T 0]
(replace (WINDOW HORIZSCROLLREG) of WINDOW
with (create REGION
LEFT ←(fetch (REGION LEFT) of IMAGEREG)
BOTTOM ←(IMAX 0 (IDIFFERENCE (fetch (REGION BOTTOM) of IMAGEREG)
SCROLLBARWIDTH))
WIDTH ←(fetch (REGION WIDTH) of IMAGEREG)
HEIGHT ← SCROLLBARWIDTH])
(WTODSX
[LAMBDA (WX WINDOW) (* rrb " 9-MAR-82 14:32")
(* converts from the window natural coordinates which
have 0,0 at lower left corner of the window and the
displaystreams coordinates.)
(IPLUS WX (fetch (REGION LEFT) of (DSPCLIPPINGREGION NIL (fetch DSP of WINDOW])
(WTODSY
[LAMBDA (WY WINDOW) (* rrb " 9-MAR-82 14:23")
(* converts from the window natural coordinates which
have 0,0 at lower left corner of the window and the
displaystreams coordinates.)
(IPLUS WY (fetch (REGION BOTTOM) of (DSPCLIPPINGREGION NIL (fetch DSP of WINDOW])
(WXOFFSET
[LAMBDA (DX WINDOW) (* rmk: " 1-SEP-83 10:25")
(* offsets a displaystream by a given delta but leaves
its clipping region where it was.
Used for offsetting display streams under window.)
(PROG [CR (DS (OR (DISPLAYSTREAMP (\OUTSTREAMARG WINDOW))
(\ILLEGAL.ARG WINDOW]
(SETQ CR (DSPCLIPPINGREGION NIL DS))
(RETURN (PROG1 (fetch (REGION LEFT) of CR)
(COND
((NUMBERP DX)
(DSPXOFFSET (IPLUS DX (DSPXOFFSET NIL DS))
DS)
(add (fetch (REGION LEFT) of CR)
(IMINUS DX)) (* recall DSPCLIPPINGREGION to update dependent fields
in DS.)
(DSPCLIPPINGREGION CR DS])
(WYOFFSET
[LAMBDA (DY WINDOW) (* rmk: "31-AUG-83 16:44")
(* offsets a displaystream by a given delta but leaves
its clipping region where it was.
Used for offsetting display streams under window.)
(PROG [CR (DS (OR (DISPLAYSTREAMP (\OUTSTREAMARG WINDOW))
(\ILLEGAL.ARG WINDOW]
(SETQ CR (DSPCLIPPINGREGION NIL DS))
(RETURN (PROG1 (fetch (REGION BOTTOM) of CR)
(COND
((NUMBERP DY)
(DSPYOFFSET (IPLUS DY (DSPYOFFSET NIL DS))
DS)
(add (fetch (REGION BOTTOM) of CR)
(IMINUS DY)) (* recall DSPCLIPPINGREGION to update dependent fields
in DS.)
(DSPCLIPPINGREGION CR DS])
(BITMAPSCROLLFN
[LAMBDA (WINDOW XDELTA YDELTA) (* rrb "17-AUG-81 15:16")
(* scrolls a bitmap under a window)
(SCROLLBITMAP (WINDOWPROP WINDOW (QUOTE BITMAP))
WINDOW XDELTA YDELTA])
(SCROLLBITMAP
[LAMBDA (BITMAP WINDOW XDELTA YDELTA) (* rrb " 9-MAR-82 14:33")
(* scrolls a bitmap under a window.)
(PROG ((DSP (WINDOWPROP WINDOW (QUOTE DSP)))
REGION)
(COND
((NOT (type? BITMAP BITMAP))
(RETURN)))
(SETQ REGION (DSPCLIPPINGREGION NIL DSP)) (* determine the change in offsets caused by the
scroll.)
(WYOFFSET (IMAX (IMIN (fetch (REGION BOTTOM) of REGION)
YDELTA)
(IDIFFERENCE (fetch (REGION HEIGHT) of REGION)
(fetch (BITMAP BITMAPHEIGHT) of BITMAP)))
DSP)
(WXOFFSET (IMAX (IMIN (fetch (REGION LEFT) of REGION)
XDELTA)
(IDIFFERENCE (fetch (REGION WIDTH) of REGION)
(fetch (BITMAP BITMAPWIDTH) of BITMAP)))
DSP) (* stuff new image over old)
(BITBLT BITMAP 0 0 DSP])
(REDISPLAYBITMAP
[LAMBDA (BITMAP WINDOW) (* rrb " 9-MAR-82 14:32")
(* blts a bitmap into a window so that the lower left corner of the bitmap is in the lower left corner of the
window.)
(OR (type? BITMAP BITMAP)
(ERROR "ILLEGAL ARG" BITMAP))
(PROG ((DSP (WINDOWPROP WINDOW (QUOTE DSP)))
WREGION)
(SETQ WREGION (DSPCLIPPINGREGION NIL DSP))
(RETURN (BITBLT BITMAP 0 0 DSP (fetch (REGION LEFT) of WREGION)
(fetch (REGION BOTTOM) of WREGION])
(ULREDISPLAYBITMAP
[LAMBDA (BITMAP WNEW) (* rrb " 9-MAR-82 14:33")
(* blts a bitmap into a window so that the upper left corner of the bitmap is in the upper left corner of the
window.)
(OR (type? BITMAP BITMAP)
(ERROR "ILLEGAL ARG" BITMAP))
(PROG ((DSP (WINDOWPROP WNEW (QUOTE DSP)))
REGION)
(SETQ REGION (DSPCLIPPINGREGION NIL DSP))
(RETURN (BITBLT BITMAP 0 0 DSP (fetch (REGION LEFT) of REGION)
(IDIFFERENCE (IPLUS (fetch (REGION BOTTOM) of REGION)
(fetch (REGION HEIGHT) of REGION))
(fetch BITMAPHEIGHT of BITMAP])
(EXTENDEXTENT
[LAMBDA (WINDOW INCLUDEREGION) (* rrb "20-JAN-82 10:05")
(* destructively changes the EXTENT region of a WINDOW
to include INCLUDEREGION)
(PROG [(EXTENT (WINDOWPROP WINDOW (QUOTE EXTENT]
(RETURN (COND
(EXTENT (EXTENDREGION EXTENT INCLUDEREGION))
(T (WINDOWPROP WINDOW (QUOTE EXTENT)
(create REGION using INCLUDEREGION])
(WIDTHIFWINDOW
[LAMBDA (INTERIORWIDTH BORDER) (* rrb "28-JUN-83 14:17")
(* returns the exterior width of a window with interior
dimension INTERIORWIDTH)
(IPLUS INTERIORWIDTH (ITIMES 2 (OR BORDER WBorder])
(HEIGHTIFWINDOW
[LAMBDA (INTERIORHEIGHT TITLEFLG BORDER) (* rrb "28-JUN-83 14:18")
(* returns the exterior height of a window which has
interior height dimension INTERIORHEIGHT)
(IPLUS INTERIORHEIGHT (COND
(TITLEFLG (IMINUS (DSPLINEFEED NIL WindowTitleDisplayStream)))
(T 0))
(ITIMES 2 (OR BORDER WBorder])
)
(* this function should be on LLDISPLAY but Ron has it checked out. Move it later - rrb.)
(DEFINEQ
(\DSPUNTRANSFORMREGION
[LAMBDA (REGION DISPLAYDATA) (* rmk: "30-AUG-83 13:19")
(* translates a region from destination coordinates into
display stream coordinates.)
(CREATEREGION (\DSPUNTRANSFORMX (fetch (REGION LEFT) of REGION)
DISPLAYDATA)
(\DSPUNTRANSFORMY (fetch (REGION BOTTOM) of REGION)
DISPLAYDATA)
(fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION])
)
(* icon functions)
(DEFINEQ
(SHRINKW
[LAMBDA (WINDOW TOWHAT ICONPOSITION EXPANDFN) (* rrb " 3-Oct-85 10:38")
(* Create a small WINDOW which acts as an Icon of window. This "icon window" provides a popup menu which will open
the main WINDOW again, and run the function EXPANDFN. TOWHAT can be a BITMAP which will be used to make a WINDOW
image, an existing window, or a string which will be printed in TITLE only icon window, or can be an existing
window. If TOWHAT is NIL, the TITLE of the main WINDOW is used as the TOWHAT for the icon.)
(SETQ WINDOW (\INSUREWINDOW WINDOW))
(PROG (TITLE ICONW FN) (* get the icon specification from the window if none
is given.)
(COND
((NOT (OPENWP WINDOW)) (* if it is not currently active, don't do anything.
Maybe something should happen here but I don't
understand what -
rrb)
(RETURN NIL))
((WINDOWPROP WINDOW (QUOTE ICONFOR)) (* This is already an icon!)
(RETURN))
((EQ (DOUSERFNS (WINDOWPROP WINDOW (QUOTE SHRINKFN))
WINDOW T)
(QUOTE DON'T)) (* one of the shrinkfns disallowed the shrinkage.)
(RETURN NIL)))
[SETQ ICONW (COND
((type? BITMAP TOWHAT) (* use bitMap to create a WINDOW)
(* save the icon on the window so that next time it
will shrink to the same thing.)
(WINDOWPROP WINDOW (QUOTE ICON)
TOWHAT)
[WINDOWPROP WINDOW (QUOTE ICON)
(SETQ ICONW (CREATEWFROMIMAGE (BITMAPCOPY TOWHAT]
ICONW)
((WINDOWP TOWHAT) (* use given WINDOW as icon)
(OR (POSITIONP ICONPOSITION)
(SETQ ICONPOSITION (QUOTE SAME)))
(* save the icon on the window so that next time it
will shrink to the same thing.)
(WINDOWPROP WINDOW (QUOTE ICON)
TOWHAT)
TOWHAT)
((STRINGP TOWHAT)
(\MAKEICONWINDOW TOWHAT))
(T (* current call doesn't specify an icon window.
Look for something on the window.)
[SETQ TOWHAT (COND
[(SETQ FN (WINDOWPROP WINDOW (QUOTE ICONFN)))
(* User fn to create an icon.
Can return cached value)
(APPLY* FN WINDOW (WINDOWPROP WINDOW (QUOTE ICONWINDOW]
(T (WINDOWPROP WINDOW (QUOTE ICON]
(COND
((WINDOWP TOWHAT) (* use given WINDOW as icon)
(OR (POSITIONP ICONPOSITION)
(SETQ ICONPOSITION (QUOTE SAME)))
TOWHAT)
((type? BITMAP TOWHAT) (* use bitMap to create a WINDOW)
(CREATEWFROMIMAGE (BITMAPCOPY TOWHAT)))
(T (\MAKEICONWINDOW (OR TOWHAT (AND (SETQ TITLE (WINDOWPROP
WINDOW
(QUOTE TITLE)))
(NOT (EQUAL TITLE ""))
TITLE)
(CONCAT "Icon made " (DATE]
(WINDOWPROP WINDOW (QUOTE ICONWINDOW)
ICONW)
(WINDOWPROP ICONW (QUOTE ICONFOR)
WINDOW) (* set up so that if icon is closed, main window will
be also.)
(WINDOWADDFNPROP ICONW (QUOTE CLOSEFN)
(FUNCTION CLOSEMAINWINDOW))
[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 (LAMBDA (ICONW)
(COND
[(LASTMOUSESTATE MIDDLE)
(CURSOR (PROG1 (CURSOR WAITINGCURSOR)
(EXPANDW ICONW]
(T (MOVEW ICONW] (* set up so that if main window is opened, icon is
closed.)
(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))
[OR (EQ ICONPOSITION (QUOTE SAME))
(MOVEW ICONW
(COND
((POSITIONP ICONPOSITION)
(WINDOWPROP ICONW (QUOTE ICONPOSITION)
ICONPOSITION)
ICONPOSITION)
[(POSITIONP (WINDOWPROP WINDOW (QUOTE ICONPOSITION]
(T (* leave it in its current location.)
(PROG [(WREG (WINDOWPROP WINDOW (QUOTE REGION)))
(ICONREG (WINDOWPROP ICONW (QUOTE REGION]
(RETURN (create
POSITION
XCOORD ←[COND
((ILESSP (fetch (REGION LEFT) of WREG)
(IDIFFERENCE SCREENWIDTH
(fetch
(REGION PRIGHT)
of WREG)))
(IMAX 0 (fetch (REGION LEFT)
of WREG)))
(T (IDIFFERENCE (IMIN SCREENWIDTH
(fetch
(REGION PRIGHT)
of WREG))
(fetch (REGION WIDTH)
of ICONREG]
YCOORD ←(COND
((ILESSP (fetch (REGION BOTTOM)
of WREG)
(IDIFFERENCE SCREENHEIGHT
(fetch
(REGION PTOP)
of WREG)))
(IMAX 0 (fetch (REGION BOTTOM)
of WREG)))
(T (IDIFFERENCE (IMIN SCREENHEIGHT
(fetch
(REGION PTOP)
of WREG))
(fetch (REGION HEIGHT)
of ICONREG]
(\CLOSEW1 WINDOW)
(OPENW ICONW)
(RETURN ICONW])
(\MAKEICONWINDOW
[LAMBDA (ICONTEXT) (* rrb "30-Sep-85 15:51")
(* returns an icon window with the text ICONTEXT as its
label.)
(PROG ((W (CREATEW [create REGION
LEFT ← LASTMOUSEX
BOTTOM ← LASTMOUSEY
HEIGHT ←(IMINUS (DSPLINEFEED NIL WindowTitleDisplayStream))
WIDTH ←(IMAX MinWindowWidth (IPLUS 8 (STRINGWIDTH ICONTEXT
WindowTitleDisplayStream]
ICONTEXT NIL T)))
(WINDOWPROP W (QUOTE MINSIZE)
(FUNCTION \TITLEICONMINSIZE))
(RETURN W])
(\TITLEICONMINSIZE
[LAMBDA (WINDOW) (* rrb "17-Jan-84 13:56")
(* returns the minimum size the default icon can be.)
(CONS MinWindowWidth (IMINUS (DSPLINEFEED NIL WindowTitleDisplayStream])
(\NOTENEWICONPOSITION
[LAMBDA (ICONW NEWPOS) (* rrb "13-Jan-84 10:39")
(* saves the new position of the icon on the property
list so that the icon will come up there again.)
(AND (SETQ ICONW (WINDOWPROP ICONW (QUOTE ICONFOR)))
(WINDOWPROP ICONW (QUOTE ICONPOSITION)
NEWPOS))
NEWPOS])
(EXPANDW
[LAMBDA (ICONW) (* rrb " 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])
)
(RPAQQ IconMenuItems (Expand))
(RPAQ VertScrollCursor (CURSORCREATE (READBITMAP) 7 15))
(16 16
"@A@@"
"@CH@"
"@CH@"
"@GL@"
"@GL@"
"@ON@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@ON@"
"@GL@"
"@GL@"
"@CH@"
"@CH@"
"@A@@")(RPAQ ScrollUpCursor (CURSORCREATE (READBITMAP) 7 15))
(16 16
"@A@@"
"@CH@"
"@CH@"
"@GL@"
"@GL@"
"@ON@"
"@ON@"
"AOO@"
"AOO@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@")(RPAQ ScrollDownCursor (CURSORCREATE (READBITMAP) 7 15))
(16 16
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"AOO@"
"AOO@"
"@ON@"
"@ON@"
"@GL@"
"@GL@"
"@CH@"
"@CH@"
"@A@@")(RPAQ HorizScrollCursor (CURSORCREATE (READBITMAP) 7 5))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@HB@"
"AHC@"
"CHCH"
"GHCL"
"OOON"
"OOON"
"GHCL"
"CHCH"
"AHC@"
"@HB@")(RPAQ ScrollLeftCursor (CURSORCREATE (READBITMAP) 8 5))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@H@"
"@CH@"
"@OH@"
"COH@"
"OOOO"
"OOOO"
"COH@"
"@OH@"
"@CH@"
"@@H@")(RPAQ ScrollRightCursor (CURSORCREATE (READBITMAP) 7 5))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@A@@"
"@AL@"
"@AO@"
"@AOL"
"OOOO"
"OOOO"
"@AOL"
"@AO@"
"@AL@"
"@A@@")(RPAQ VertThumbCursor (CURSORCREATE (READBITMAP) 6 8))
(16 16
"@@@@"
"OH@@"
"@@@@"
"OO@@"
"@@@@"
"OON@"
"@@@@"
"OOOH"
"@@@@"
"OON@"
"@@@@"
"OO@@"
"@@@@"
"OH@@"
"@@@@"
"@@@@")(RPAQ HorizThumbCursor (CURSORCREATE (READBITMAP) 6 6))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@B@@"
"@B@@"
"@JH@"
"@JH@"
"@JH@"
"BJJ@"
"BJJ@"
"BJJ@"
"JJJH"
"JJJH"
"JJJH"
"JJJH"
"JJJH")(RPAQ WAITINGCURSOR (CURSORCREATE (READBITMAP) 7 8))
(16 16
"OOON"
"L@@F"
"F@AL"
"CMGH"
"AOO@"
"@ON@"
"@FL@"
"@CH@"
"@BH@"
"@FL@"
"@MF@"
"AIC@"
"CGMH"
"FGNL"
"OOON"
"OOON")(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \LastCursorPosition \LastInWindow WindowMenu BackgroundMenu BackgroundMenuCommands
\LastWindowButtons WWFNS WindowMenuCommands IconWindowMenu IconWindowMenuCommands
VertScrollCursor ScrollUpCursor ScrollDownCursor ScrollLeftCursor ScrollRightCursor
HorizScrollCursor WindowTitleDisplayStream WINDOWTITLEPRINTLEVEL WBorder \TOPWDS
WINDOWBACKGROUNDSHADE CURRENTBACKGROUNDSHADE BACKGROUNDFNS)
)
(DECLARE: EVAL@COMPILE
(RPAQQ MinWindowWidth 26)
(RPAQQ MinWindowHeight 16)
(CONSTANTS (MinWindowWidth 26)
(MinWindowHeight 16))
)
(* FOLLOWING DEFINITIONS EXPORTED)
[DECLARE: EVAL@COMPILE
(DATATYPE WINDOW (DSP NEXTW SAVE REG BUTTONEVENTFN RIGHTBUTTONFN CURSORINFN CURSOROUTFN
CURSORMOVEDFN REPAINTFN RESHAPEFN EXTENT USERDATA VERTSCROLLREG
HORIZSCROLLREG SCROLLFN VERTSCROLLWINDOW HORIZSCROLLWINDOW CLOSEFN MOVEFN
WTITLE NEWREGIONFN WBORDER PROCESS WINDOWENTRYFN SCREEN)
BUTTONEVENTFN ←(FUNCTION TOTOPW)
WBORDER ← WBorder WINDOWENTRYFN ←(FUNCTION GIVE.TTY.PROCESS))
]
(/DECLAREDATATYPE (QUOTE WINDOW)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
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))
(* END EXPORTED DEFINITIONS)
)
(DECLARE: EVAL@COMPILE
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TOPW WINDOWUSERFORMS ENDOFWINDOWUSERFORMS PROMPTWINDOW KNOWNWINDOWS)
)
(* END EXPORTED DEFINITIONS)
)
[ADDTOVAR SYSTEMRECLST
(DATATYPE WINDOW (DSP NEXTW SAVE REG BUTTONEVENTFN RIGHTBUTTONFN CURSORINFN CURSOROUTFN
CURSORMOVEDFN REPAINTFN RESHAPEFN EXTENT USERDATA VERTSCROLLREG
HORIZSCROLLREG SCROLLFN VERTSCROLLWINDOW HORIZSCROLLWINDOW CLOSEFN MOVEFN
WTITLE NEWREGIONFN WBORDER PROCESS WINDOWENTRYFN SCREEN))
]
(/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))
(RPAQ? WWFNS (QUOTE (\TOTOPWDS)))
(RPAQ? WindowTitleDisplayStream )
(RPAQ? WindowMenu )
(RPAQ? BackgroundMenu )
(RPAQ? TOPW )
(RPAQ? \LastCursorPosition (CREATEPOSITION))
(RPAQ? \LastInWindow )
(RPAQ? \LastWindowButtons 0)
(RPAQ? IconWindowMenu )
(RPAQ? KNOWNWINDOWS )
(RPAQ? WINDOWBACKGROUNDSHADE 34850)
(RPAQ? WBorder 4)
(RPAQ? SCROLLBARWIDTH 24)
(RPAQ? SCROLLWAITTIME 100)
(RPAQ? 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)
(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 IconWindowMenuCommands (Close (QUOTE CLOSEW)
"Closes the icon and its assciated window")
(Snap (QUOTE SNAPW)
"Saves a snapshot of a region of the screen.")
(Paint (QUOTE PAINTW)
"Starts a painting mode in which the mouse can
be used to draw pictures or make notes on windows.
Includes a HARDCOPY command.")
(Bury (QUOTE BURYW)
"Puts a window on the bottom.")
(Move (QUOTE MOVEW)
"Moves a window by a corner.")
(Shape (QUOTE SHAPEW)
"Gets a new region for a window.
Left button down marks fixed corner; sweep to other corner.
Middle button down moves closest corner.")
(Expand (QUOTE EXPANDW)
"Expands the window for which this is the ICON."))
(ADDTOVAR BackgroundMenuCommands (SaveVM (QUOTE (SAVEVM))
"Updates the virtual memory.")
(Snap (QUOTE (SNAPW))
"Saves a snapshot of a region of the screen.")
(Hardcopy (QUOTE (HARDCOPYW))
"Send hardcopy of screen region to printer."
(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
(WINDOWWORLD T)
(ADDTOVAR GLOBALVARS SCROLLBARWIDTH SCROLLWAITTIME SCROLLBARSHADE WAITBEFORESCROLLTIME
WAITBETWEENSCROLLTIME WAITINGCURSOR)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA PROMPTPRINT WINDOWPROP IMAGEOBJPROP WINDOWWORLD)
)
(PUTPROPS WINDOW COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (9892 13409 (WWRITEMODE 9902 . 10739) (\MAKE.CLOSED.WINDOW.WRITABLE 10741 . 12288) (
\RESTORE.CLOSED.WINDOW 12290 . 13407)) (13410 25877 (WINDOWWORLD 13420 . 18444) (WINDOWWORLDP 18446 .
18684) (CHANGEBACKGROUND 18686 . 18996) (CHANGEBACKGROUNDBORDER 18998 . 19356) (TILE 19358 . 19868) (
LOGOW 19870 . 21677) (\DRAWLOGOWINDOWIMAGE 21679 . 22258) (\TTY.CREATING.DISPLAYSTREAM 22260 . 22784)
(\CREATE.TTY.OUTCHARFN 22786 . 23509) (\CREATE.TTYDISPLAYSTREAM 23511 . 24872) (HASTTYWINDOWP 24874 .
25322) (TTYINFOSTREAM 25324 . 25875)) (26191 36470 (WINDOW.MOUSE.HANDLER 26201 . 33602) (
\PROTECTED.APPLY 33604 . 33858) (DOWINDOWCOM 33860 . 34841) (DOBACKGROUNDCOM 34843 . 35684) (
DEFAULT.BACKGROUND.COPYFN 35686 . 36468)) (36633 71333 (BURYW 36643 . 37765) (CLEARW 37767 . 38251) (
CLOSEW 38253 . 38841) (\CLOSEW1 38843 . 39879) (\OKTOCLOSEW 39881 . 40288) (OPENW 40290 . 41253) (
DOUSERFNS 41255 . 42174) (DOUSERFNS2 42176 . 42697) (\USERFNISDON'T 42699 . 43035) (\OPENW1 43037 .
44053) (CREATEW 44055 . 46834) (MOVEW 46836 . 54205) (\ONSCREENCLIPPINGREGION 54207 . 54673) (RELMOVEW
54675 . 55194) (PAINTW 55196 . 60946) (PAINTW.READMODE 60948 . 61516) (PAINTW.READBRUSHSHAPE 61518 .
61826) (PAINTW.READBRUSHSIZE 61828 . 62100) (SHAPEW 62102 . 64086) (SHAPEW1 64088 . 65791) (
RESHOWBORDER 65793 . 66279) (\RESHOWBORDER1 66281 . 68857) (TRACKW 68859 . 69747) (SNAPW 69749 . 70832
) (WINDOWREGION 70834 . 71331)) (71334 74144 (PAINTW.READBRUSHSHADE 71344 . 72496) (
PAINTW.READ.AND.SAVE.SHADE 72498 . 73087) (PAINTW.CACHE.SHADE 73089 . 73685) (PAINTW.SHADE.LABEL 73687
. 74142)) (74237 74905 (MINIMUMWINDOWSIZE 74247 . 74903)) (78332 90616 (COPYINSERT 78342 . 79412) (
IMAGEBOX 79414 . 79595) (IMAGEFNSCREATE 79597 . 80820) (IMAGEFNSP 80822 . 81052) (IMAGEOBJCREATE 81054
. 81515) (IMAGEOBJP 81517 . 81747) (IMAGEOBJPROP 81749 . 85596) (\IMAGEUSERPROP 85598 . 86132) (
HPRINT.IMAGEOBJ 86134 . 86780) (COPYIMAGEOBJ 86782 . 87407) (READIMAGEOBJ 87409 . 89398) (
WRITEIMAGEOBJ 89400 . 90614)) (90823 95175 (ENCAPSULATEDOBJ.BUTTONEVENTINFN 90833 . 91686) (
ENCAPSULATEDOBJ.DISPLAYFN 91688 . 93478) (ENCAPSULATEDOBJ.IMAGEBOXFN 93480 . 94274) (
ENCAPSULATEDOBJ.INIT 94276 . 95173)) (95299 110718 (ADVISEWDS 95309 . 99766) (SHOWWFRAME 99768 .
101156) (SHOWWTITLE 101158 . 103519) (\STRINGWIDTHGUESS 103521 . 104521) (RESHOWTITLE 104523 . 107595)
(TOTOPW 107597 . 108554) (\INTERNALTOTOPW 108556 . 109137) (\TTW1 109139 . 110317) (WHICHW 110319 .
110716)) (110841 113394 (SWITCHDEF 110851 . 111031) (WFROMDS 111033 . 112617) (NU\TOTOPWDS 112619 .
112933) (\COERCETODS 112935 . 113392)) (113824 124712 (WINDOWP 113834 . 113972) (WINDOWPROP 113974 .
114437) (WINDOWADDPROP 114439 . 115369) (WINDOWDELPROP 115371 . 115797) (GETWINDOWPROP 115799 . 117878
) (GETWINDOWUSERPROP 117880 . 118311) (PUTWINDOWPROP 118313 . 123255) (REMWINDOWPROP 123257 . 123954)
(WINDOWADDFNPROP 123956 . 124710)) (124903 130085 (CWINDOWPROP 124913 . 125846) (CGETWINDOWPROP 125848
. 128979) (\GETWINDOWHEIGHT 128981 . 129608) (\GETWINDOWWIDTH 129610 . 130083)) (130086 142494 (
OPENWP 130096 . 130410) (RESHAPEBYREPAINTFN 130412 . 138733) (\INBETWEENP 138735 . 139006) (
DECODE/WINDOW/OR/DISPLAYSTREAM 139008 . 140214) (GROW/REGION 140216 . 140757) (PPROMPT3 140759 .
141132) (CLRPROMPT 141134 . 141414) (PROMPTPRINT 141416 . 141682) (OPENWINDOWS 141684 . 142125) (
\INSUREWINDOW 142127 . 142492)) (142694 145195 (OVERLAPPINGWINDOWS 142704 . 144411) (WOVERLAPP 144413
. 144718) (ORDERFROMBOTTOMTOTOP 144720 . 145193)) (145240 149430 (\ONSCREENW 145250 . 145926) (
\PUTONSCREENW 145928 . 146445) (\UPDATECACHEDFIELDS 146447 . 146771) (\WWCHANGESCREENSIZE 146773 .
147960) (CREATEWFROMIMAGE 147962 . 148674) (UPDATEWFROMIMAGE 148676 . 149428)) (149709 187733 (SCROLLW
149719 . 150228) (SCROLLBYREPAINTFN 150230 . 159699) (ADJUSTOFFSETS 159701 . 160070) (
CREATESCROLLINGW 160072 . 160285) (IN/SCROLL/BAR? 160287 . 162305) (RELDSPXOFFSET 162307 . 162500) (
RELDSPYOFFSET 162502 . 162695) (SCROLL.HANDLER 162697 . 170065) (\SCROLL.HANDLER.DOIT 170067 . 172852)
(\DECODE.EXTENT.USE 172854 . 173201) (\UPDATE.EXTENT.IMAGE 173203 . 176833) (
EXTENDPASTHORIZBOUNDARIES 176835 . 177304) (EXTENDPASTVERTBOUNDARIES 177306 . 177785) (REDISPLAYW
177787 . 179262) (FILLWITHBACKGROUND 179264 . 179643) (UPDATE/SCROLL/REG 179645 . 181297) (WTODSX
181299 . 181735) (WTODSY 181737 . 182175) (WXOFFSET 182177 . 183016) (WYOFFSET 183018 . 183861) (
BITMAPSCROLLFN 183863 . 184162) (SCROLLBITMAP 184164 . 185195) (REDISPLAYBITMAP 185197 . 185767) (
ULREDISPLAYBITMAP 185769 . 186459) (EXTENDEXTENT 186461 . 186963) (WIDTHIFWINDOW 186965 . 187293) (
HEIGHTIFWINDOW 187295 . 187731)) (187832 188403 (\DSPUNTRANSFORMREGION 187842 . 188401)) (188431
200871 (SHRINKW 188441 . 194719) (\MAKEICONWINDOW 194721 . 195424) (\TITLEICONMINSIZE 195426 . 195735)
(\NOTENEWICONPOSITION 195737 . 196173) (EXPANDW 196175 . 197601) (DOICONWINDOWCOM 197603 . 198467) (
CLOSEMAINWINDOW 198469 . 199642) (CLOSEICONWINDOW 199644 . 200869)))))
STOP