(FILECREATED "14-AUG-83 16:58:04" {PHYLUM}<LISPCORE>SOURCES>LLDISPLAY.;98 117374
changes to: (FNS \FLASHCARET? \TTYBACKGROUND)
(VARS LLDISPLAYCOMS)
previous date: "23-JUL-83 22:49:23" {PHYLUM}<LISPCORE>SOURCES>LLDISPLAY.;97)
(* Copyright (c) 1981, 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT LLDISPLAYCOMS)
(RPAQQ LLDISPLAYCOMS [(* records are on ADISPLAY - must be init'ed here)
(INITRECORDS REGION BITMAP DISPLAYSTREAM PILOTBBT)
[COMS (* BITMASKS)
(FNS DSPXOFFSET \FBITMAPBIT INITBITMASKS)
[EXPORT (DECLARE: DONTCOPY (MACROS \BITMASK \4BITMASK \NOTBITMASK
\NOT4BITMASK)
(GLOBALVARS BITMASKARRAY NOTBITMASKARRAY 4BITMASKARRAY
NOT4BITMASKARRAY)
(CONSTANTS (WORDMASK 65535]
(DECLARE: DONTEVAL@LOAD DOCOPY (P (INITBITMASKS]
[COMS (* init cursor)
(FNS \CreateCursorBitMap)
(DECLARE: DONTEVAL@LOAD DOCOPY (VARS (CursorBitMap (\CreateCursorBitMap]
[COMS (* bitmap functions.)
(FNS BITBLT \BITBLTSUB \GETPILOTBBTSCRATCHBM BITMAPCOPY BITMAPCREATE
BITMAPBIT BLTCHAR \SLOWBLTCHAR TEXTUREP INVERT.TEXTURE
INVERT.TEXTURE.BITMAP)
(DECLARE: DONTCOPY (CONSTANTS (\DisplayWordAlign 16)
(\MaxBitMapWidth 65535)
(\MaxBitMapHeight 65535)
(\MaxBitMapWords 131066))
(EXPORT (MACROS \DSPGETCHARWIDTH \DSPGETCHAROFFSET \CONVERTOP
\SFInvert \SFReplicate \SETPBTFUNCTION \BITBLT1)
)
(GLOBALVARS \SYSBBTEXTURE \BBSCRATCHTEXTURE \SYSPILOTBBT
\PILOTBBTSCRATCHBM))
(VARS (\BBSCRATCHTEXTURE)
(\PILOTBBTSCRATCHBM))
[DECLARE: DONTEVAL@LOAD DOCOPY (P (MOVD? (QUOTE BITBLT)
(QUOTE BKBITBLT]
(* macro for this file so that BITBLT can be broken by users)
(EXPORT (DECLARE: DONTCOPY DONTEVAL@LOAD DOEVAL@COMPILE
(P (PUTPROP (QUOTE BITBLT)
(QUOTE MACRO)
(QUOTE (= . BKBITBLT]
(COMS (* Ufn for Pilot BitBlt using Alto BitBlt)
(FNS \PILOTBITBLT)
(VARS (\SCRATCHPBT)
(\SCRATCHBBT))
(GLOBALVARS \SCRATCHPBT \SCRATCHBBT))
[COMS (* display stream functions)
(FNS DISPLAYSTREAMP DSPOPERATION DSPSOURCETYPE DSPXPOSITION DSPYPOSITION
DSPYOFFSET)
(FNS DSPCLIPPINGREGION DSPCREATE DSPDESTINATION DSPFONT DSPTEXTURE
\DISPLAYSTREAMINCRXPOSITION \SFFixDestination \SFFixClippingRegion
\SFFixFont \SFFIXLINELENGTH \SFFixY)
(DECLARE: DONTCOPY (EXPORT (RECORDS STREAMOFDISPLAYSTREAM)))
(EXPORT (MACROS \SFInsureDisplayStream \GETDISPLAYSTREAMFROMSTREAM
\SFMARKUNFONTED \SFHASFONT))
(P (MOVD? (QUOTE \ILLEGAL.ARG)
(QUOTE \COERCETODS))
(MOVD? (QUOTE NILL)
(QUOTE WFROMDS]
[COMS (* Stub for window package)
[DECLARE: DOCOPY (DECLARE: EVAL@LOADWHEN (EQ (SYSTEMTYPE)
(QUOTE D))
(DECLARE: EVAL@LOADWHEN
(OR (NOT (GETD (QUOTE WINDOWWORLD)))
(NOT (WINDOWWORLD)))
(VARS (\TOPWDS)))
(P (MOVD? (QUOTE NILL)
(QUOTE \TOTOPWDS]
(DECLARE: DONTCOPY EVAL@COMPILE (EXPORT (MACROS \INSURETOPWDS
.WHILE.TOP.DS.
.WHILE.TOP.IF.DS.
\PIXELOFBITADDRESS)
(ADDVARS (GLOBALVARS \TOPWDS]
(COMS (* DisplayStream TTY functions)
(FNS TTYDISPLAYSTREAM)
(EXPORT (MACROS TTYDISPLAYSTREAM))
(FNS DSPLINEFEED DSPLEFTMARGIN DSPRIGHTMARGIN DSPRESET DSPSCROLL
CHANGETTYDEVICE OUTPUTDSP PAGEHEIGHT)
(INITVARS (\CURRENTTTYDEVICE (QUOTE BCPLDISPLAY))
(SystemColorMap))
(FNS \DSPPRINTCHAR \DSPPRINTCR/LF)
(FNS \FLASHCARET? \TTYBACKGROUND)
(FNS DSPBACKUP)
(ADDVARS (TTYBACKGROUNDFNS \FLASHCARET?))
(DECLARE: DONTEVAL@LOAD DOCOPY (VARS (BELLCNT 2)
(BELLRATE 60)
(\CARET)
(\CARETFLG)
(\DisplayStoppedForLogout)
(TtyDisplayStream)))
(FNS COLORDISPLAYP)
(FNS DISPLAYBEFOREEXIT DISPLAYAFTERENTRY)
(EXPORT (GLOBALVARS \CARET \CARETDOWN \CARETFLG \CARETFLASHTIME BELLCNT
BELLRATE TTYBACKGROUNDFNS \CARETRATE
\DisplayStoppedForLogout SystemColorMap)))
[COMS (* transformation related functions.)
(FNS \DSPCLIPTRANSFORMX \DSPCLIPTRANSFORMY \DSPTRANSFORMREGION
\DSPUNTRANSFORMY \DSPUNTRANSFORMX \OFFSETCLIPPINGREGION)
(DECLARE: DONTCOPY (EXPORT (MACROS \DSPTRANSFORMX \DSPTRANSFORMY
\OFFSETBOTTOM \OFFSETLEFT]
[COMS (* screen related functions)
(FNS UPDATESCREENWIDTH SCREENRASTERWIDTH \CreateScreenBitMap)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (UPDATESCREENWIDTH))
(VARS (SCREENHEIGHT 808)
(\MaxScreenPage -1)
(ScreenBitMap (\CreateScreenBitMap SCREENWIDTH
SCREENHEIGHT]
(COMS (* initialization)
(FNS DISPLAYSTREAMINIT \STARTDISPLAY \STOPDISPLAY)
(EXPORT (GLOBALVARS \DisplayStarted \DisplayStreamsInitialized
\DisplayInitialed WHOLEDISPLAY WHOLESCREEN))
(ADDVARS (GLOBALVARS WHOLESCREEN))
(DECLARE: DONTEVAL@LOAD DOCOPY (VARS (\DisplayStarted NIL)
(\LastTTYLines 12)))
(EXPORT (MACROS DISPLAYINITIALIZEDP DISPLAYSTARTEDP))
(FNS INITIALIZEDISPLAYSTREAMS)
(DECLARE: DOCOPY DONTEVAL@LOAD (P (INITIALIZEDISPLAYSTREAMS)
(DISPLAYSTREAMINIT 1000])
(* records are on ADISPLAY - must be init'ed here)
(/DECLAREDATATYPE (QUOTE BITMAP)
(QUOTE (POINTER WORD WORD WORD WORD)))
(/DECLAREDATATYPE (QUOTE DISPLAYSTREAM)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER WORD WORD WORD WORD WORD FLAG XPOINTER POINTER POINTER
POINTER POINTER POINTER POINTER)))
(/DECLAREDATATYPE (QUOTE PILOTBBT)
(QUOTE (WORD WORD WORD SIGNEDWORD WORD WORD WORD SIGNEDWORD WORD WORD WORD WORD
WORD WORD WORD WORD)))
(* BITMASKS)
(DEFINEQ
(DSPXOFFSET
[LAMBDA (XOFFSET DISPLAYSTREAM) (* rrb "29-JUN-83 15:55")
(* coordinate position is stored in 15 bits in the range
-2↑15 to +2↑15.)
(COND
[DISPLAYSTREAM (PROG ((DS (\SFInsureDisplayStream DISPLAYSTREAM)))
(RETURN (PROG1 (fetch \SFXOFFSET of DS)
(COND
((NULL XOFFSET))
((NUMBERP XOFFSET)
(UNINTERRUPTABLY
(freplace \SFXOFFSET of DS with XOFFSET)
(\SFFixClippingRegion DS)))
(T (\ILLEGAL.ARG XOFFSET]
(T (* check done specially for NIL so that it won't default
to primary output file.)
(\ILLEGAL.ARG DISPLAYSTREAM])
(\FBITMAPBIT
[LAMBDA (BASE X Y OPERATION HEIGHTMINUS1 RASTERWIDTH) (* rmk: " 2-APR-82 00:09")
(* fast version of stuffing a bit into a bitmap.)
(change [fetch (BITMAPWORD BITS) of (\ADDBASE BASE (IPLUS (ITIMES (IDIFFERENCE HEIGHTMINUS1 Y)
RASTERWIDTH)
(LRSH X 4]
(SELECTQ OPERATION
(INVERT (LOGXOR DATUM (\BITMASK X)))
(ERASE (LOGAND DATUM (\NOTBITMASK X)))
(LOGOR DATUM (\BITMASK X])
(INITBITMASKS
[LAMBDA NIL (* rrb "24-SEP-82 15:13")
(* initialization of bit masks for line drawing routines. BITMASK is an array of single bit masks;
NOTBITMASK is an array of masks for getting everything except the nth bit.)
(SETQ BITMASKARRAY (ARRAY 16 (QUOTE SMALLPOSP)
0 0))
(SETQ NOTBITMASKARRAY (ARRAY 16 (QUOTE SMALLPOSP)
0 0))
(for I from 0 to 15 bind (MASK ←(CONSTANT (EXPT 2 15))) do (SETA BITMASKARRAY I MASK)
(SETA NOTBITMASKARRAY I
(LOGXOR MASK WORDMASK))
(SETQ MASK (LRSH MASK 1)))
(SETQ 4BITMASKARRAY (ARRAY 4 (QUOTE SMALLPOSP)
0 0))
(SETQ NOT4BITMASKARRAY (ARRAY 4 (QUOTE SMALLPOSP)
0 0))
(for I from 0 to 3 bind [MASK ←(CONSTANT (IDIFFERENCE (EXPT 2 16)
(EXPT 2 12]
do (SETA 4BITMASKARRAY I MASK)
(SETA NOT4BITMASKARRAY I (LOGXOR MASK WORDMASK))
(SETQ MASK (LRSH MASK 4])
)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS \BITMASK MACRO ((N)
(\WORDELT BITMASKARRAY (LOGAND N 15))))
(PUTPROPS \4BITMASK MACRO ((N)
(\WORDELT 4BITMASKARRAY (LOGAND N 3))))
(PUTPROPS \NOTBITMASK MACRO ((N)
(DECLARE (GLOBALVARS NOTBITMASKARRAY))
(\WORDELT NOTBITMASKARRAY (LOGAND N 15))))
(PUTPROPS \NOT4BITMASK MACRO ((N)
(\WORDELT NOT4BITMASKARRAY (LOGAND N 3))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS BITMASKARRAY NOTBITMASKARRAY 4BITMASKARRAY NOT4BITMASKARRAY)
)
(DECLARE: EVAL@COMPILE
(RPAQQ WORDMASK 65535)
(CONSTANTS (WORDMASK 65535))
)
)
(* END EXPORTED DEFINITIONS)
(DECLARE: DONTEVAL@LOAD DOCOPY
(INITBITMASKS)
)
(* init cursor)
(DEFINEQ
(\CreateCursorBitMap
[LAMBDA NIL (* lmm "13-MAY-82 00:24")
(* creates a BITMAP which points at the cursor bits.)
(* pointer to cursor is stored using hiloc and loloc rather that BITMAPBASE so that it won't be reference counted.
It is on an odd boundary.)
(create BITMAP
BITMAPRASTERWIDTH ← 1
BITMAPWIDTH ← 20Q
BITMAPHEIGHT ← 20Q
BITMAPBASE ← \EM.CURSORBITMAP])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(RPAQ CursorBitMap (\CreateCursorBitMap))
)
(* bitmap functions.)
(DEFINEQ
(BITBLT
[LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTINATIONBITMAP DESTINATIONLEFT DESTINATIONBOTTOM
WIDTH HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION)
(* rrb "16-JUN-83 14:36")
(DECLARE (LOCALVARS . T))
(PROG ((TEXTURE TEXTURE)
stodx stody left top bottom right DS DESTINATIONNBITS SOURCENBITS TEMP CLIPPEDSOURCEBOTTOM
CLIPPEDSOURCELEFT) (* changes value of arguments and shouldn't)
[COND
((type? BITMAP DESTINATIONBITMAP)
(SETQ right (fetch BITMAPWIDTH of DESTINATIONBITMAP))
[COND
((EQ (SETQ DESTINATIONNBITS (fetch (BITMAP BITMAPBITSPERPIXEL) of DESTINATIONBITMAP))
1) (* DESTINATIONNBITS is NIL for the case of 1 bit per
pixel.)
(SETQ DESTINATIONNBITS NIL))
(T (* keep track of how many bits per pixel)
(SETQ right (\PIXELOFBITADDRESS DESTINATIONNBITS right]
(SETQ left 0)
(SETQ bottom 0)
(SETQ top (fetch BITMAPHEIGHT of DESTINATIONBITMAP))
[COND
(CLIPPINGREGION (* adjust limits)
(SETQ left (IMAX left (fetch LEFT of CLIPPINGREGION)))
(SETQ bottom (IMAX bottom (fetch BOTTOM of CLIPPINGREGION)))
[SETQ right (IMIN right (IPLUS (fetch WIDTH of CLIPPINGREGION)
(fetch LEFT of CLIPPINGREGION]
(SETQ top (IMIN top (IPLUS (fetch BOTTOM of CLIPPINGREGION)
(fetch HEIGHT of CLIPPINGREGION]
(OR DESTINATIONLEFT (SETQ DESTINATIONLEFT 0))
(OR DESTINATIONBOTTOM (SETQ DESTINATIONBOTTOM 0)))
((SETQ DESTINATIONBITMAP (\SFInsureDisplayStream DESTINATIONBITMAP))
(SETQ DS DESTINATIONBITMAP)
(SETQ DESTINATIONLEFT (\DSPTRANSFORMX (OR DESTINATIONLEFT 0)
DESTINATIONBITMAP))
(SETQ DESTINATIONBOTTOM (\DSPTRANSFORMY (OR DESTINATIONBOTTOM 0)
DESTINATIONBITMAP))
[PROGN (* compute limits based on clipping regions.)
(SETQ left (fetch \SFClippingLeft of DESTINATIONBITMAP))
(SETQ bottom (fetch \SFClippingBottom of DESTINATIONBITMAP))
(SETQ right (fetch \SFClippingRight of DESTINATIONBITMAP))
(SETQ top (fetch \SFClippingTop of DESTINATIONBITMAP))
(COND
(CLIPPINGREGION (* hard case, two destination clipping regions: do
calculations to merge them.)
(PROG (CRLEFT CRBOTTOM)
[SETQ left (IMAX left (SETQ CRLEFT
(\DSPTRANSFORMX (fetch LEFT
of CLIPPINGREGION)
DESTINATIONBITMAP]
[SETQ bottom (IMAX bottom
(SETQ CRBOTTOM
(\DSPTRANSFORMY (fetch BOTTOM
of
CLIPPINGREGION)
DESTINATIONBITMAP]
[SETQ right (IMIN right (IPLUS CRLEFT
(fetch WIDTH
of CLIPPINGREGION]
(SETQ top (IMIN top (IPLUS CRBOTTOM
(fetch HEIGHT of
CLIPPINGREGION]
(COND
((EQ [SETQ DESTINATIONNBITS (fetch (BITMAP BITMAPBITSPERPIXEL)
of (SETQ DESTINATIONBITMAP (fetch \SFDestination
of DESTINATIONBITMAP]
1)
(SETQ DESTINATIONNBITS NIL]
(* left, right top and bottom are the limits in destination taking into account Clipping Regions.
Clip to region in the arguments of this call.)
[PROGN (SETQ left (IMAX DESTINATIONLEFT left))
(SETQ bottom (IMAX DESTINATIONBOTTOM bottom))
[COND
(WIDTH (* WIDTH is optional)
(SETQ right (IMIN (IPLUS DESTINATIONLEFT WIDTH)
right]
(COND
(HEIGHT (* HEIGHT is optional)
(SETQ top (IMIN (IPLUS DESTINATIONBOTTOM HEIGHT)
top]
[COND
((EQ SOURCETYPE (QUOTE TEXTURE)) (* set coordinate transformations to null.)
(SETQ stodx 0)
(SETQ stody 0))
(T (* if sourcetype is TEXTURE, ignore the source;
otherwise clip and translate coordinates.)
[COND
[(type? BITMAP SOURCEBITMAP)
(SETQ TEMP (fetch BITMAPWIDTH of SOURCEBITMAP))
[COND
((EQ (SETQ SOURCENBITS (fetch (BITMAP BITMAPBITSPERPIXEL) of SOURCEBITMAP))
1)
(SETQ SOURCENBITS NIL))
(T (SETQ TEMP (\PIXELOFBITADDRESS SOURCENBITS TEMP]
(SETQ CLIPPEDSOURCELEFT (OR SOURCELEFT (SETQ SOURCELEFT 0)))
(SETQ CLIPPEDSOURCEBOTTOM (OR SOURCEBOTTOM (SETQ SOURCEBOTTOM 0)))
(* limit the WIDTH and HEIGHT to the source size.)
(SETQ WIDTH (COND
(WIDTH (IMIN WIDTH (IDIFFERENCE TEMP SOURCELEFT)))
(T TEMP)))
(SETQ HEIGHT (COND
(HEIGHT (IMIN HEIGHT (IDIFFERENCE (fetch BITMAPHEIGHT of SOURCEBITMAP)
SOURCEBOTTOM)))
(T (fetch BITMAPHEIGHT of SOURCEBITMAP]
((SETQ SOURCEBITMAP (\SFInsureDisplayStream SOURCEBITMAP))
(* do transformations coming out of source)
(SETQ CLIPPEDSOURCELEFT (IMAX (SETQ SOURCELEFT (\DSPTRANSFORMX (OR SOURCELEFT 0)
SOURCEBITMAP))
(fetch \SFClippingLeft of SOURCEBITMAP)))
(SETQ CLIPPEDSOURCEBOTTOM (IMAX (SETQ SOURCEBOTTOM (\DSPTRANSFORMY (OR
SOURCEBOTTOM 0)
SOURCEBITMAP))
(fetch \SFClippingBottom of SOURCEBITMAP)))
(* limit the WIDTH and HEIGHT by the source dimensions.)
[SETQ WIDTH (COND
(WIDTH (IMIN WIDTH (IDIFFERENCE (fetch \SFClippingRight of SOURCEBITMAP)
CLIPPEDSOURCELEFT)))
(T (IDIFFERENCE (fetch \SFClippingRight of SOURCEBITMAP)
CLIPPEDSOURCELEFT]
[SETQ HEIGHT (COND
(HEIGHT (IMIN HEIGHT (IDIFFERENCE (fetch \SFClippingTop of SOURCEBITMAP)
CLIPPEDSOURCEBOTTOM)))
(T (IDIFFERENCE (fetch \SFClippingTop of SOURCEBITMAP)
CLIPPEDSOURCEBOTTOM]
(* if texture is not given, use the display stream's.)
(OR TEXTURE (SETQ TEXTURE (DSPTEXTURE NIL SOURCEBITMAP)))
(COND
((EQ [SETQ SOURCENBITS (fetch (BITMAP BITMAPBITSPERPIXEL)
of (SETQ SOURCEBITMAP (fetch \SFDestination
of SOURCEBITMAP]
1) (* keep track of how many bits per pixel.
SOURCENBITS is NIL for the special case of 1 bit per
pixel. NIL)
(SETQ SOURCENBITS NIL]
(SETQ stodx (IDIFFERENCE DESTINATIONLEFT SOURCELEFT))
(SETQ stody (IDIFFERENCE DESTINATIONBOTTOM SOURCEBOTTOM))
(* compute the source dimensions (left right bottom top) by intersecting the source bit map, the source area to be
moved with the limits of the region to be moved in the destination coordinates.)
(PROGN (* compute left margin)
(SETQ left (IMAX CLIPPEDSOURCELEFT (IDIFFERENCE left stodx)
0)) (* compute bottom margin)
(SETQ bottom (IMAX CLIPPEDSOURCEBOTTOM (IDIFFERENCE bottom stody)
0))
[PROGN (* compute right margin)
(SETQ TEMP (ffetch BITMAPWIDTH of SOURCEBITMAP))
(SETQ right (IMIN (COND
(SOURCENBITS
(* source is color, reduce the source WIDTH the pixel
coordinates.)
(\PIXELOFBITADDRESS SOURCENBITS TEMP))
(T TEMP))
(IDIFFERENCE right stodx)
(IPLUS CLIPPEDSOURCELEFT WIDTH]
(PROGN (* compute top margin)
(SETQ top (IMIN (ffetch BITMAPHEIGHT of SOURCEBITMAP)
(IDIFFERENCE top stody)
(IPLUS CLIPPEDSOURCEBOTTOM HEIGHT]
(COND
((AND (IGREATERP right left)
(IGREATERP top bottom)))
(T (* there is nothing to move.)
(RETURN)))
[COND
(DS (\INSURETOPWDS DS)
(OR OPERATION (SETQ OPERATION (ffetch (DISPLAYSTREAM \SFOPERATION) of DS]
(* We'd rather handle the slow case when we are interruptable, so we do it here as a heuristic.
But we might get interrupted before we go interruptable, so we do it there too.)
(SELECTQ SOURCETYPE
[TEXTURE (SETQ TEXTURE
(SELECTQ (TYPENAME TEXTURE)
(LITATOM (* includes NIL case)
(COND
(DESTINATIONNBITS (COND
(TEXTURE
(* should be a color name)
(OR (COLORNUMBERP
TEXTURE
DESTINATIONNBITS T)
(\ILLEGAL.ARG
TEXTURE)))
(DS
(* default texture to background color.)
(DSPBACKCOLOR NIL DS))
(T BLACKCOLOR)))
(TEXTURE (\ILLEGAL.ARG TEXTURE))
(DS (* default texture to background texture.)
(ffetch (DISPLAYSTREAM \SFTexture)
of DS))
(T WHITESHADE)))
[(SMALLP FIXP)
(COND
[DESTINATIONNBITS
(* if fixp use the low order bits as a color number.
This picks up the case of BLACKSHADE being used to
INVERT.)
(OR (COLORNUMBERP TEXTURE
DESTINATIONNBITS T)
(LOGAND TEXTURE (COND
((EQ DESTINATIONNBITS 4)
15)
(T 255]
(T (LOGAND TEXTURE BLACKSHADE]
(BITMAP TEXTURE)
[LISTP (* should be a list of levels rgb or hls.)
(COND
(DESTINATIONNBITS (OR (COLORNUMBERP TEXTURE)
(\ILLEGAL.ARG TEXTURE)))
(T (\ILLEGAL.ARG TEXTURE]
(\ILLEGAL.ARG TEXTURE]
[MERGE (* Need to use complement of TEXTURE)
(* MAY NOT WORK FOR COLOR CASE.)
(SETQ TEXTURE (COND
((NOT TEXTURE)
BLACKSHADE)
((FIXP TEXTURE)
(LOGXOR (LOGAND TEXTURE BLACKSHADE)
BLACKSHADE))
((AND DESTINATIONNBITS (COLORNUMBERP TEXTURE)))
(T (SELECTQ (TYPENAME TEXTURE)
[BITMAP (INVERT.TEXTURE.BITMAP TEXTURE
(OR \BBSCRATCHTEXTURE
(SETQ \BBSCRATCHTEXTURE
(BITMAPCREATE 16 16]
(COND
((AND DESTINATIONNBITS (COLORNUMBERP TEXTURE)))
(T (\ILLEGAL.ARG TEXTURE]
NIL)
(COND
[(OR (AND (NULL DESTINATIONNBITS)
(NULL SOURCENBITS))
(COND
((EQ SOURCETYPE (QUOTE TEXTURE)) (* filling an area with a texture.)
(SETQ left (ITIMES DESTINATIONNBITS left))
(SETQ right (ITIMES DESTINATIONNBITS right))
(SETQ TEXTURE (COLORTEXTUREFROMCOLOR# TEXTURE DESTINATIONNBITS))
T)
((EQ SOURCENBITS DESTINATIONNBITS) (* going from one to another of the same size.)
(* use LLSH with constant value rather than multiple
because it compiles into opcodes.)
[COND
((EQ DESTINATIONNBITS 4)
(SETQ left (LLSH left 2))
(SETQ right (LLSH right 2))
(SETQ stodx (LLSH stodx 2)))
(T (SETQ left (LLSH left 3))
(SETQ right (LLSH right 3))
(SETQ stodx (LLSH stodx 3] (* set texture if it will ever get looked at.)
(AND (EQ SOURCETYPE (QUOTE MERGE))
(SETQ TEXTURE (COLORTEXTUREFROMCOLOR# TEXTURE DESTINATIONNBITS)))
T))) (* easy case of black and white bitmap into black and
white or color to color or texture filling.)
(.WHILE.TOP.IF.DS. DS DESTINATIONNBITS (* Just in case the user got in and screwed our window)
(PROG ([PILOTBBT (COND
((type? PILOTBBT \SYSPILOTBBT)
\SYSPILOTBBT)
(T (SETQ \SYSPILOTBBT (create PILOTBBT]
(HEIGHT (IDIFFERENCE top bottom))
(WIDTH (IDIFFERENCE right left))
(DTY (\SFInvert DESTINATIONBITMAP (IPLUS top stody)))
(DLX (IPLUS left stodx))
(STY (AND (NEQ SOURCETYPE (QUOTE TEXTURE))
(\SFInvert SOURCEBITMAP top)))
(SLX left)
SCRATCH SCRATCHLEFT SCRATCHTOP)
(replace PBTWIDTH of PILOTBBT with WIDTH)
(replace PBTHEIGHT of PILOTBBT with HEIGHT)
(COND
((NEQ SOURCETYPE (QUOTE MERGE))
(\BITBLTSUB PILOTBBT SOURCEBITMAP SLX STY
DESTINATIONBITMAP DLX DTY HEIGHT SOURCETYPE
OPERATION TEXTURE))
(T
(* Can't do in Pilot bitblt, so simulate by blting source to scratch bitmap, erasing bits not in Texture, then
blting scratch to ultimate destination. Note that TEXTURE has already been complemented above in preparation for
this)
(COND
((AND (EQ OPERATION (QUOTE REPLACE))
(NEQ SOURCEBITMAP DESTINATIONBITMAP))
(* Don't need a scratch bitmap, just do two blts)
(\BITBLTSUB PILOTBBT SOURCEBITMAP SLX STY
DESTINATIONBITMAP DLX DTY HEIGHT
(QUOTE INPUT)
(QUOTE REPLACE))
(* Blt the source, then erase bits that aren't in
TEXTURE)
(\BITBLTSUB PILOTBBT NIL NIL NIL DESTINATIONBITMAP
DLX DTY HEIGHT (QUOTE TEXTURE)
(QUOTE ERASE)
TEXTURE))
(T [SETQ SCRATCH (\GETPILOTBBTSCRATCHBM
(IPLUS WIDTH (SETQ SCRATCHLEFT (MOD DLX
BITSPERWORD)))
(IPLUS HEIGHT (SETQ SCRATCHTOP (MOD DTY 4]
(* Get scratch bm, slightly larger than WIDTH and HEIGHT
to allow texture to align)
(\BITBLTSUB PILOTBBT SOURCEBITMAP SLX STY SCRATCH
SCRATCHLEFT SCRATCHTOP HEIGHT
(QUOTE INPUT)
(QUOTE REPLACE))
(* Blt source into scratch)
(\BITBLTSUB PILOTBBT NIL NIL NIL SCRATCH SCRATCHLEFT
SCRATCHTOP HEIGHT (QUOTE TEXTURE)
(QUOTE ERASE)
TEXTURE)
(* Erase what isn't in TEXTURE)
(\BITBLTSUB PILOTBBT SCRATCH SCRATCHLEFT SCRATCHTOP
DESTINATIONBITMAP DLX DTY HEIGHT
(QUOTE INPUT)
OPERATION)
(* Finally do original operation using the merged
source)
]
[(AND (NULL SOURCENBITS)
DESTINATIONNBITS) (* going from a black and white bitmap to a color map)
(AND SOURCETYPE (NEQ SOURCETYPE (QUOTE INPUT))
(ERROR "SourceType not implemented from B&W to color bitmaps." SOURCETYPE))
(PROG ((HEIGHT (IDIFFERENCE top bottom))
(WIDTH (IDIFFERENCE right left))
(DBOT (IPLUS bottom stody))
(DLFT (IPLUS left stodx)))
(SELECTQ OPERATION
((NIL REPLACE)
(\BWTOCOLORBLT SOURCEBITMAP left bottom DESTINATIONBITMAP DLFT DBOT
WIDTH HEIGHT (COND
(DS (COLORNUMBERP (fetch (DISPLAYSTREAM
\SFBACKGROUNDCOLOR)
of DS)))
(T WHITECOLOR))
(COND
(DS (COLORNUMBERP (fetch (DISPLAYSTREAM
\SFFOREGROUNDCOLOR)
of DS)))
(T BLACKCOLOR))
DESTINATIONNBITS))
(PAINT)
(INVERT)
(ERASE)
(SHOULDNT]
(T (* going from color map into black and white map.)
(ERROR "not implemented to blt between bitmaps of different pixel size.")))
(RETURN T])
(\BITBLTSUB
[LAMBDA (PILOTBBT SourceBitMap SLX STY DestinationBitMap DLX DTY HEIGHT SourceType Operation
Texture) (* lmm " 8-OCT-82 10:58")
(PROG ((DBMR (fetch BITMAPRASTERWIDTH of DestinationBitMap))
SBMR GRAY SOURCEADDR DESTADDR X)
(replace PBTFLAGS of PILOTBBT with 0)
(replace PBTDESTBPL of PILOTBBT with (UNFOLD DBMR BITSPERWORD))
(SETQ DESTADDR (\ADDBASE (fetch BITMAPBASE of DestinationBitMap)
(ITIMES DBMR DTY))) (* Combine Destination base and top Y into a single
Destination word offset)
(replace PBTDESTBIT of PILOTBBT with DLX)
(SELECTQ SourceType
[TEXTURE (replace PBTUSEGRAY of PILOTBBT with T)
(replace PBTSOURCEBIT of PILOTBBT with (MOD DLX BITSPERWORD))
(* Source is offset in a gray block where we want to start. Microcode finds the start of the gray block by
subtracting PBTGRAYOFFSET from it)
(replace PBTSOURCEBPL of PILOTBBT with 0)
(* Zero out this word first)
(COND
[(FIXP Texture)
(SETQ GRAY (fetch BITMAPBASE of \SYSBBTEXTURE))
(replace PBTSOURCE of PILOTBBT
with (\ADDBASE GRAY
(COND
((OR (ZEROP (SETQ Texture (LOGAND Texture
WORDMASK)))
(EQ Texture BLACKSHADE))
(* special cases of solid texture occur often)
(\PUTBASE GRAY 0 Texture)
(* PBTGRAYHEIGHTLESSONE and PBTGRAYOFFSET are both 0 in
this case)
0)
(T (\PUTBASE GRAY 0 (\SFReplicate (LRSH Texture
12)))
[\PUTBASE GRAY 1
(\SFReplicate (LOGAND 15
(LRSH Texture
8]
[\PUTBASE GRAY 2
(\SFReplicate (LOGAND 15
(LRSH Texture
4]
(\PUTBASE GRAY 3 (\SFReplicate (LOGAND 15
Texture)))
(replace PBTGRAYHEIGHTLESSONE of PILOTBBT
with 3)
(replace PBTGRAYOFFSET of PILOTBBT
with (MOD DTY 4]
(T (* A bitmap that is 16 bits wide.
BITBLT verified this back in interruptable section)
[replace PBTGRAYHEIGHTLESSONE of PILOTBBT
with (SUB1 (SETQ X (IMIN [ffetch BITMAPHEIGHT
of (SETQ Texture (\DTEST
Texture
(QUOTE BITMAP]
16]
(replace PBTGRAYOFFSET of PILOTBBT with (SETQ X (IREMAINDER DTY X)))
(replace PBTSOURCE of PILOTBBT with (\ADDBASE (ffetch BITMAPBASE
of Texture)
X]
(MERGE (RETURN (RAID "Hard bitblt case")))
(PROGN (* INPUT or INVERT)
(replace PBTUSEGRAY of PILOTBBT with NIL)
(replace PBTSOURCEBPL of PILOTBBT with (UNFOLD (SETQ SBMR
(fetch BITMAPRASTERWIDTH
of SourceBitMap))
BITSPERWORD))
(SETQ SOURCEADDR (\ADDBASE (fetch BITMAPBASE of SourceBitMap)
(ITIMES SBMR STY)))
(* Combine Source base and top Y into a single Source
word offset)
(replace PBTSOURCEBIT of PILOTBBT with SLX)
[COND
((NEQ SourceBitMap DestinationBitMap)
(* Assume distinct bitmaps do not overlap, i.e. that we
do not have sub-bitmaps)
(replace PBTDISJOINT of PILOTBBT with T))
[(IGREATERP STY DTY) (* Source > Dest means we can go top to bottom always)
(COND
((IGREATERP STY (IPLUS DTY HEIGHT))
(* Dest ends before source starts, so is completely
disjoint)
(replace PBTDISJOINT of PILOTBBT with T))
(T (* Not disjoint, but the items are disjoint)
(replace PBTDISJOINTITEMS of PILOTBBT with T]
((IGREATERP DTY (IPLUS STY HEIGHT))
(* Source ends before dest starts, so is completely
disjoint)
(replace PBTDISJOINT of PILOTBBT with T))
([OR (NEQ STY DTY)
(AND (ILESSP SLX DLX)
(ILESSP DLX (IPLUS SLX (fetch PBTWIDTH of PILOTBBT]
(* Not disjoint, with source above dest (bottom to top) or source and dest the same line with source to left of
dest (right to left))
(replace PBTBACKWARD of PILOTBBT with T)
(* What's more, the source and dest addresses are to be
of the LAST item, and bpl is negative)
(* note SBMR = DBMR if we have gotten this far)
[SETQ SOURCEADDR (\ADDBASE SOURCEADDR (SETQ X (ITIMES SBMR
(SUB1 HEIGHT]
(SETQ DESTADDR (\ADDBASE DESTADDR X))
[replace PBTSOURCEBPL of PILOTBBT with (SETQ X (IMINUS (UNFOLD SBMR
BITSPERWORD]
(replace PBTDESTBPL of PILOTBBT with X)
(COND
((NEQ STY DTY) (* At least the items are disjoint)
(replace PBTDISJOINTITEMS of PILOTBBT with T]
(replace PBTSOURCE of PILOTBBT with SOURCEADDR)))
(replace PBTDEST of PILOTBBT with DESTADDR)
(\SETPBTFUNCTION PILOTBBT SourceType Operation)
(RETURN (\PILOTBITBLT PILOTBBT 0])
(\GETPILOTBBTSCRATCHBM
[LAMBDA (WIDTH HEIGHT)
(DECLARE (GLOBALVARS \PILOTBBTSCRATCHBM)) (* bvm: "24-MAY-82 12:46")
(* Return a scratch bitmap at least WIDTH by HEIGHT.
Called only under uninterruptable bitblt, so don't worry
about global resource conflicts)
(COND
((AND (type? BITMAP \PILOTBBTSCRATCHBM)
(ILEQ WIDTH (fetch BITMAPWIDTH of \PILOTBBTSCRATCHBM))
(ILEQ HEIGHT (fetch BITMAPHEIGHT of \PILOTBBTSCRATCHBM)))
\PILOTBBTSCRATCHBM)
(T (SETQ \PILOTBBTSCRATCHBM (BITMAPCREATE WIDTH HEIGHT])
(BITMAPCOPY
[LAMBDA (BITMAP) (* rrb "22-DEC-82 11:09")
(* makes a copy of an existing BitMap)
(PROG (NEWBITMAP)
(BITBLT (SETQ BITMAP (\DTEST BITMAP (QUOTE BITMAP)))
0 0 (SETQ NEWBITMAP (BITMAPCREATE (BITMAPWIDTH BITMAP)
(ffetch BITMAPHEIGHT of BITMAP)
(ffetch BITMAPBITSPERPIXEL of BITMAP)))
0 0 NIL NIL (QUOTE INPUT)
(QUOTE REPLACE)
0)
(RETURN NEWBITMAP])
(BITMAPCREATE
[LAMBDA (WIDTH HEIGHT BITSPERPIXEL) (* rrb "21-DEC-82 17:12")
(* creates a bitmap data structure.)
(OR (AND (IGEQ WIDTH 0)
(ILEQ WIDTH \MaxBitMapWidth))
(\ILLEGAL.ARG WIDTH))
(OR (AND (IGEQ HEIGHT 0)
(ILEQ HEIGHT \MaxBitMapHeight))
(\ILLEGAL.ARG HEIGHT))
(SELECTQ BITSPERPIXEL
((NIL 4 8 1))
(\ILLEGAL.ARG BITSPERPIXEL))
(PROG ((BPP (OR BITSPERPIXEL 1))
RW BITWIDTH)
(SETQ BITWIDTH (ITIMES WIDTH BPP))
(SETQ RW (FOLDHI BITWIDTH BITSPERWORD))
(RETURN (create BITMAP
BITMAPRASTERWIDTH ← RW
BITMAPWIDTH ← BITWIDTH
BITMAPHEIGHT ← HEIGHT
BITMAPBITSPERPIXEL ← BPP
BITMAPBASE ←(COND
((IGREATERP (SETQ RW (ITIMES RW HEIGHT))
\MaxBitMapWords)
(ERROR (ITIMES WIDTH HEIGHT)
"bits in BITMAP -- too big"))
(T (\ALLOCBLOCK (FOLDHI RW WORDSPERCELL)
NIL
(AND (NULL WINDFLG)
0])
(BITMAPBIT
[LAMBDA (BITMAP X Y NEWVALUE) (* rrb "21-MAR-83 13:11")
(* reads and optionally sets a bit in a bitmap.
If bitmap is a displaystream, it works on the
destination through the coordinate transformations.)
(* version of BITMAPBIT that works for multiple bit per
pixel bitmaps.)
(PROG (NBITS BITX OLDVALUE oldword bitmapbase)
(RETURN
(COND
[(type? BITMAP BITMAP)
(SETQ NBITS (fetch (BITMAP BITMAPBITSPERPIXEL) of BITMAP))
(COND
((OR (IGREATERP 0 X)
(IGEQ (SETQ BITX (ITIMES X NBITS))
(ffetch BITMAPWIDTH of BITMAP))
(IGREATERP 0 Y)
(IGEQ Y (ffetch BITMAPHEIGHT of BITMAP)))
(* all bitmaps are 0 outside)
0)
(T [SETQ bitmapbase (\ADDBASE (ffetch BITMAPBASE of BITMAP)
(IPLUS (ITIMES (SUB1 (\SFInvert BITMAP Y))
(ffetch BITMAPRASTERWIDTH
of BITMAP))
(FOLDLO BITX BITSPERWORD]
(SELECTQ
NBITS
(1 (COND
([ZEROP (LOGAND (SETQ oldword (\GETBASE bitmapbase 0))
(SETQ BITX (\BITMASK X]
(* old value was 0)
[COND
((AND NEWVALUE (NOT (ZEROP NEWVALUE)))
(* change value Since old value is 0, ok to OR.)
(PUTBASE bitmapbase 0 (LOGOR oldword BITX]
0)
(T (* old value was 1)
[COND
((AND NEWVALUE (ZEROP NEWVALUE))
(* change, use XOR since old value is 1)
(PUTBASE bitmapbase 0 (LOGXOR oldword BITX]
1)))
[4 (* take the color cursor down before the old word value
is fetched. NIL)
[.WHILE.TOP.IF.DS.
NIL T (SETQ OLDVALUE (LOGAND (SETQ oldword (\GETBASE bitmapbase 0))
(\4BITMASK X)))
(AND NEWVALUE (COND
[(AND (SMALLPOSP NEWVALUE)
(ILESSP NEWVALUE 16))
(PUTBASE bitmapbase 0
(LOGOR (LOGXOR oldword OLDVALUE)
(LLSH NEWVALUE (ITIMES 4
(IDIFFERENCE
3
(LOGAND X 3]
(T (\ILLEGAL.ARG NEWVALUE]
(* move the 4 bit current value to the right most bits.)
(LRSH OLDVALUE (ITIMES 4 (IDIFFERENCE 3 (LOGAND X 3]
(8 (* take down cursor before returning the value of the
bit.)
[.WHILE.TOP.IF.DS. NIL T (COND
((ZEROP (LOGAND X 1))
(* left half of word)
(SETQ OLDVALUE (LOGAND (SETQ oldword
(\GETBASE bitmapbase 0))
65280))
[AND NEWVALUE (PUTBASE bitmapbase 0
(LOGOR (LOGXOR oldword
OLDVALUE)
(LLSH NEWVALUE 8]
(SETQ OLDVALUE (LRSH OLDVALUE 8)))
(T (* right half of word)
(SETQ OLDVALUE (LOGAND (SETQ oldword
(\GETBASE bitmapbase 0))
255))
(AND NEWVALUE (PUTBASE bitmapbase 0
(LOGOR (LOGXOR oldword
OLDVALUE)
NEWVALUE]
OLDVALUE)
(ERROR "unknown bits per pixel size." NBITS]
(T (SETQ BITMAP (\SFInsureDisplayStream BITMAP))
(PROG ((TX (\DSPCLIPTRANSFORMX X BITMAP))
(TY (\DSPCLIPTRANSFORMY Y BITMAP)))
(RETURN (COND
((AND TX TY)
(\INSURETOPWDS BITMAP)
(* We try to handle the slow case while we are still interruptable, but we do it again just in case the user got
us.)
(.WHILE.TOP.DS. BITMAP (SETQ TX (BITMAPBIT (fetch \SFDestination
of BITMAP)
TX TY NEWVALUE)))
TX)
(T (* anything outside the clipping region returns 0.0)
0])
(BLTCHAR
[LAMBDA (CHARCODE DISPLAYSTREAM) (* rrb "21-DEC-82 11:17")
(* puts a character on a display stream. Much of the information needed by the BitBlt microcode is prestored by
the routines that change it. This is kept in the BitBltTable.)
(* knows about the representation of a DisplayStream.
\SFSlowPrintingCase)
(DECLARE (LOCALVARS . T))
(SETQ DISPLAYSTREAM (\SFInsureDisplayStream DISPLAYSTREAM))
(COND
((fetch (DISPLAYSTREAM \SFSlowPrintingCase) of DISPLAYSTREAM)
(\SLOWBLTCHAR CHARCODE DISPLAYSTREAM))
(T (PROG (NEWX LEFT RIGHT (CURX (ffetch \SFXPOSITION of DISPLAYSTREAM)))
[COND
((IGREATERP (SETQ NEWX (IPLUS CURX (\DSPGETCHARWIDTH CHARCODE DISPLAYSTREAM)))
(ffetch \SFRightMargin of DISPLAYSTREAM))
(* past RIGHT margin, force eol)
(\DSPPRINTCR/LF (CHARCODE EOL)
DISPLAYSTREAM)
(SETQ CURX (ffetch \SFXPOSITION of DISPLAYSTREAM))
(SETQ NEWX (IPLUS CURX (\DSPGETCHARWIDTH CHARCODE DISPLAYSTREAM]
(* update the display stream x position.)
(freplace \SFXPOSITION of DISPLAYSTREAM with NEWX)
(SETQ CURX (\DSPTRANSFORMX CURX DISPLAYSTREAM))
(SETQ LEFT (IMAX (ffetch \SFClippingLeft of DISPLAYSTREAM)
CURX))
(SETQ RIGHT (IMIN (ffetch \SFClippingRight of DISPLAYSTREAM)
(\DSPTRANSFORMX NEWX DISPLAYSTREAM)))
(RETURN (COND
((AND (ILESSP LEFT RIGHT)
(NEQ (fetch PBTHEIGHT of (SETQ NEWX (ffetch \SFPILOTBBT of
DISPLAYSTREAM)))
0))
(.WHILE.TOP.DS. DISPLAYSTREAM (freplace PBTDESTBIT of NEWX with LEFT)
(freplace PBTWIDTH of NEWX with (IDIFFERENCE RIGHT LEFT))
(freplace PBTSOURCEBIT of NEWX
with (IDIFFERENCE (IPLUS (\DSPGETCHAROFFSET CHARCODE
DISPLAYSTREAM)
LEFT)
CURX))
(\PILOTBITBLT NEWX 0))
T])
(\SLOWBLTCHAR
[LAMBDA (CHARCODE DISPLAYSTREAM) (* rrb "28-APR-83 15:34")
(* case of BLTCHAR where either font is rotated or
destination is a color bitmap.)
(PROG [(ROTATION (fetch (FONTDESCRIPTOR ROTATION) of (fetch (DISPLAYSTREAM \SFFONT) of
DISPLAYSTREAM]
(RETURN
(COND
[(EQ 0 ROTATION)
(PROG (NEWX LEFT RIGHT (CURX (ffetch \SFXPOSITION of DISPLAYSTREAM)))
[COND
((IGREATERP (SETQ NEWX (IPLUS CURX (\DSPGETCHARWIDTH CHARCODE DISPLAYSTREAM)))
(ffetch \SFRightMargin of DISPLAYSTREAM))
(* past RIGHT margin, force eol)
(\DSPPRINTCR/LF (CHARCODE EOL)
DISPLAYSTREAM)
(SETQ CURX (ffetch \SFXPOSITION of DISPLAYSTREAM))
(SETQ NEWX (IPLUS CURX (\DSPGETCHARWIDTH CHARCODE DISPLAYSTREAM]
(* update the display stream x position.)
(freplace \SFXPOSITION of DISPLAYSTREAM with NEWX)
(SETQ CURX (\DSPTRANSFORMX CURX DISPLAYSTREAM))
(SETQ LEFT (IMAX (ffetch \SFClippingLeft of DISPLAYSTREAM)
CURX))
(SETQ RIGHT (IMIN (ffetch \SFClippingRight of DISPLAYSTREAM)
(\DSPTRANSFORMX NEWX DISPLAYSTREAM)))
(RETURN (COND
((AND (ILESSP LEFT RIGHT)
(NEQ (fetch PBTHEIGHT of (SETQ NEWX (ffetch \SFPILOTBBT
of DISPLAYSTREAM)))
0))
(SELECTQ (fetch (BITMAP BITMAPBITSPERPIXEL)
of (ffetch (DISPLAYSTREAM \SFDestination) of
DISPLAYSTREAM))
(1 (.WHILE.TOP.DS. DISPLAYSTREAM
(freplace PBTDESTBIT of NEWX
with LEFT)
(freplace PBTWIDTH of NEWX
with (IDIFFERENCE RIGHT LEFT))
(freplace PBTSOURCEBIT of NEWX
with (IDIFFERENCE
(IPLUS (\DSPGETCHAROFFSET
CHARCODE
DISPLAYSTREAM)
LEFT)
CURX))
(\PILOTBITBLT NEWX 0)))
(4 (OR (\SFHASFONT DISPLAYSTREAM)
(\SFSETCOLORFONT DISPLAYSTREAM))
(.WHILE.TOP.DS.
DISPLAYSTREAM
(freplace PBTDESTBIT of NEWX
with (SETQ LEFT (LLSH LEFT 2)))
(freplace PBTWIDTH of NEWX
with (IDIFFERENCE (LLSH RIGHT 2)
LEFT))
(freplace PBTSOURCEBIT of NEWX
with (IDIFFERENCE (IPLUS (LLSH (\DSPGETCHAROFFSET
CHARCODE
DISPLAYSTREAM)
2)
LEFT)
(LLSH CURX 2)))
(\PILOTBITBLT NEWX 0)))
(8 (OR (\SFHASFONT DISPLAYSTREAM)
(\SFSETCOLORFONT DISPLAYSTREAM))
(.WHILE.TOP.DS.
DISPLAYSTREAM
(freplace PBTDESTBIT of NEWX
with (SETQ LEFT (LLSH LEFT 3)))
(freplace PBTWIDTH of NEWX
with (IDIFFERENCE (LLSH RIGHT 3)
LEFT))
(freplace PBTSOURCEBIT of NEWX
with (IDIFFERENCE (IPLUS (LLSH (\DSPGETCHAROFFSET
CHARCODE
DISPLAYSTREAM)
3)
LEFT)
(LLSH CURX 3)))
(\PILOTBITBLT NEWX 0)))
(SHOULDNT))
T]
(T (* handle rotated fonts)
(PROG ((YPOS (ffetch \SFYPOSITION of DISPLAYSTREAM))
(HEIGHTMOVED (\DSPGETCHARWIDTH CHARCODE DISPLAYSTREAM))
(FONT (ffetch \SFFONT of DISPLAYSTREAM)))
(RETURN (COND
((EQ ROTATION 90) (* don't force CR for rotated fonts.)
(DSPYPOSITION (IPLUS YPOS HEIGHTMOVED)
DISPLAYSTREAM)
(* update the display stream x position.)
(BITBLT (fetch (FONTDESCRIPTOR CHARACTERBITMAP) of FONT)
0
(\DSPGETCHAROFFSET CHARCODE DISPLAYSTREAM)
DISPLAYSTREAM
(ADD1 (IDIFFERENCE (DSPXPOSITION NIL DISPLAYSTREAM)
(FONTASCENT FONT)))
YPOS
(FONTHEIGHT FONT)
HEIGHTMOVED))
((EQ ROTATION 270)
(DSPYPOSITION (IDIFFERENCE YPOS HEIGHTMOVED)
DISPLAYSTREAM)
(BITBLT (fetch (FONTDESCRIPTOR CHARACTERBITMAP) of FONT)
0
(\DSPGETCHAROFFSET CHARCODE DISPLAYSTREAM)
DISPLAYSTREAM
(IDIFFERENCE (DSPXPOSITION NIL DISPLAYSTREAM)
(FONTDESCENT FONT))
(ffetch \SFYPOSITION of DISPLAYSTREAM)
(FONTHEIGHT FONT)
HEIGHTMOVED))
(T (ERROR "Not implemented to rotate by other than 0, 90 or 270"])
(TEXTUREP
[LAMBDA (OBJECT) (* bvm: "26-MAY-82 17:51")
(OR (FIXP OBJECT)
(AND (type? BITMAP OBJECT)
(EQ (fetch BITMAPRASTERWIDTH of OBJECT)
1)
OBJECT])
(INVERT.TEXTURE
[LAMBDA (TEXTURE SCRATCHBM) (* bvm: "31-MAY-82 14:41")
(COND
((FIXP TEXTURE)
(LOGXOR (LOGAND TEXTURE BLACKSHADE)
BLACKSHADE))
(T (INVERT.TEXTURE.BITMAP TEXTURE SCRATCHBM])
(INVERT.TEXTURE.BITMAP
[LAMBDA (BM SCRATCHBM) (* edited: "15-SEP-82 09:17")
(* Returns a bitmap that is the complement of BM. If SCRATCHBM is supplied, then does it to SCRATCHBM, else
creates and returns a new bitmap)
(COND
((NEQ (fetch BITMAPRASTERWIDTH of BM)
1)
(\ILLEGAL.ARG BM)))
(PROG [(NEWBM (COND
((type? BITMAP SCRATCHBM)
(COND
((OR (NEQ (fetch BITMAPRASTERWIDTH of SCRATCHBM)
1)
(IGREATERP (fetch BITMAPHEIGHT of BM)
(fetch BITMAPHEIGHT of SCRATCHBM)))
(\ILLEGAL.ARG SCRATCHBM)))
SCRATCHBM)
(T (BITMAPCREATE BITSPERWORD (fetch BITMAPHEIGHT of BM]
(bind (BASE1 ←(fetch BITMAPBASE of BM))
(LASTBASE ←(\ADDBASE (fetch BITMAPBASE of NEWBM)
(fetch BITMAPHEIGHT of BM)))
for (BASE2 ←(fetch BITMAPBASE of NEWBM)) by (\ADDBASE BASE2 1) until (EQ BASE2 LASTBASE)
do (\PUTBASE BASE2 0 (LOGXOR (\GETBASE BASE1 0)
WORDMASK))
(SETQ BASE1 (\ADDBASE BASE1 1)))
(RETURN NEWBM])
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ \DisplayWordAlign 16)
(RPAQQ \MaxBitMapWidth 65535)
(RPAQQ \MaxBitMapHeight 65535)
(RPAQQ \MaxBitMapWords 131066)
(CONSTANTS (\DisplayWordAlign 16)
(\MaxBitMapWidth 65535)
(\MaxBitMapHeight 65535)
(\MaxBitMapWords 131066))
)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS \DSPGETCHARWIDTH MACRO ((CHARCODE DS)
(\GETBASE (ffetch \SFWIDTHSCACHE of DS)
CHARCODE)))
(PUTPROPS \DSPGETCHAROFFSET MACRO ((CHARCODE DS)
(\GETBASE (ffetch \SFOFFSETSCACHE of DS)
CHARCODE)))
(PUTPROPS \CONVERTOP MACRO ((OP) (* rrb "14-NOV-80 11:14")
(* Only for alto bitblt !!)
(SELECTQ OP
(REPLACE 0)
(PAINT 1)
(INVERT 2)
(ERASE 3)
0)))
(PUTPROPS \SFInvert MACRO ((BitMap y)
(* corrects for the fact that alto bitmaps are stored with 0,0 as upper left while lisp bitmaps have 0,0 as lower
left. The correction is actually off by one (greater) because a majority of the places that it is called actually
need one more than corrected Y value.)
(IDIFFERENCE (fetch BITMAPHEIGHT of BitMap)
y)))
(PUTPROPS \SFReplicate MACRO [LAMBDA (pattern)
(LOGOR pattern (LLSH pattern 8)
(SETQ pattern (LLSH pattern 4))
(LLSH pattern 8])
(PUTPROPS \SETPBTFUNCTION MACRO [OPENLAMBDA (PILOTBBT SourceType Operation)
(PROGN (replace PBTOPERATION of PILOTBBT
with (SELECTQ Operation
(ERASE 1)
(PAINT 2)
(INVERT 3)
0))
(replace PBTSOURCETYPE of PILOTBBT
with (COND
((EQ (EQ SourceType (QUOTE INVERT))
(EQ Operation (QUOTE ERASE)))
0)
(T 1])
(PUTPROPS \BITBLT1 MACRO ((bbt)
(BitBltSUBR bbt)))
)
(* END EXPORTED DEFINITIONS)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \SYSBBTEXTURE \BBSCRATCHTEXTURE \SYSPILOTBBT \PILOTBBTSCRATCHBM)
)
)
(RPAQQ \BBSCRATCHTEXTURE NIL)
(RPAQQ \PILOTBBTSCRATCHBM NIL)
(DECLARE: DONTEVAL@LOAD DOCOPY
(MOVD? (QUOTE BITBLT)
(QUOTE BKBITBLT))
)
(* macro for this file so that BITBLT can be broken by users)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: DONTCOPY DONTEVAL@LOAD DOEVAL@COMPILE
(PUTPROP (QUOTE BITBLT)
(QUOTE MACRO)
(QUOTE (= . BKBITBLT)))
)
(* END EXPORTED DEFINITIONS)
(* Ufn for Pilot BitBlt using Alto BitBlt)
(DEFINEQ
(\PILOTBITBLT
[LAMBDA (PILOTBBT DUMMY \INTERRUPTABLE) (* bvm: " 9-AUG-82 16:16")
(* Perform a pilot bitblt using Alto bitblt)
(PROG ([ALTOBBT (COND
((type? BitBltTable \SCRATCHBBT)
\SCRATCHBBT)
(T (SETQ \SCRATCHBBT (create BitBltTable]
(DESTADDR (fetch PBTDEST of PILOTBBT))
(SOURCETYPE (fetch PBTSOURCETYPE of PILOTBBT))
SOURCEADDR GRAY GRAYSIZE YOFF SBMR DBMR DIF HEIGHT)
(replace BBTFunction of ALTOBBT with 0) (* Clear flag word first)
(replace BBTDW of ALTOBBT with (fetch PBTWIDTH of PILOTBBT))
(replace BBTDH of ALTOBBT with (SETQ HEIGHT (fetch PBTHEIGHT of PILOTBBT)))
(* Fill in width and height fields directly)
(replace BBTOPERATION of ALTOBBT with (SELECTQ (fetch PBTOPERATION of PILOTBBT)
(0
(* REPLACE)
0)
(1
(* ERASE. Pilot bitblt implements as AND with inverted
source)
(SETQ SOURCETYPE (LOGXOR SOURCETYPE 1))
3)
(2
(* PAINT)
1)
2))
(replace BBTDBMR of ALTOBBT with (SETQ DBMR (FOLDLO (IABS (fetch PBTDESTBPL of PILOTBBT))
BITSPERWORD)))
(replace BBTDTY of ALTOBBT with 0)
(replace BBTDLX of ALTOBBT with (fetch PBTDESTBIT of PILOTBBT))
(COND
[(fetch PBTUSEGRAY of PILOTBBT) (* If gray bigger than 4, tough)
(replace BBTSOURCETYPE of ALTOBBT with 3) (* TEXTURE)
(replace BBTSTY of ALTOBBT with 0) (* Logically irrelevant, but ucode compares STY and DTY
to decide direction, so better make it top to bottom)
[SETQ GRAY (\ADDBASE (fetch PBTSOURCE of PILOTBBT)
(IMINUS (SETQ YOFF (fetch PBTGRAYOFFSET of PILOTBBT]
(* Point at gray block)
(SETQ GRAYSIZE (ADD1 (fetch PBTGRAYHEIGHTLESSONE of PILOTBBT)))
(* Number of lines in gray block)
[SELECTQ GRAYSIZE
(1 (SETQ GRAY (\GETBASE GRAY 0))
(replace BBTGray0 of ALTOBBT with GRAY)
(replace BBTGray1 of ALTOBBT with GRAY)
(replace BBTGray2 of ALTOBBT with GRAY)
(replace BBTGray3 of ALTOBBT with GRAY))
[(2 3) (* Half-size brick or peculiar size handled
suboptimally)
(* 0 or 1, where GRAY starts)
(replace BBTGray0 of ALTOBBT with (replace BBTGray2 of ALTOBBT
with (\GETBASE GRAY YOFF)))
(replace BBTGray1 of ALTOBBT with (replace BBTGray3 of ALTOBBT
with (\GETBASE GRAY
(MOD (ADD1 YOFF)
2]
(PROGN (* Normal case for us is 4; handle size > 4 less than
optimally)
(* Where GRAY starts. Need to synchronize)
(replace BBTGray0 of ALTOBBT with (\GETBASE GRAY YOFF))
(replace BBTGray1 of ALTOBBT with (\GETBASE GRAY (MOD (ADD1 YOFF)
4)))
(replace BBTGray2 of ALTOBBT with (\GETBASE GRAY
(MOD (IPLUS YOFF 2)
4)))
(replace BBTGray3 of ALTOBBT with (\GETBASE GRAY
(MOD (IPLUS YOFF 3)
4]
(COND
((NEQ SOURCETYPE 0) (* Complemented source as well.
In this case, means complement the gray)
(change (fetch BBTGray0 of ALTOBBT)
(LOGXOR DATUM 177777Q))
(change (fetch BBTGray1 of ALTOBBT)
(LOGXOR DATUM 177777Q))
(change (fetch BBTGray2 of ALTOBBT)
(LOGXOR DATUM 177777Q))
(change (fetch BBTGray3 of ALTOBBT)
(LOGXOR DATUM 177777Q]
(T (replace BBTSOURCETYPE of ALTOBBT with SOURCETYPE)
(* 0 or 1)
(replace BBTSLX of ALTOBBT with (fetch PBTSOURCEBIT of PILOTBBT))
(replace BBTSTY of ALTOBBT with 0)
(replace BBTSBMR of ALTOBBT with (SETQ SBMR (FOLDLO (IABS (fetch PBTSOURCEBPL
of PILOTBBT))
BITSPERWORD)))
(SETQ SOURCEADDR (fetch PBTSOURCE of PILOTBBT))
[COND
((fetch PBTBACKWARD of PILOTBBT)
[SETQ DESTADDR (\ADDBASE DESTADDR (IMINUS (ITIMES DBMR (SUB1 HEIGHT]
(SETQ SOURCEADDR (\ADDBASE SOURCEADDR (IMINUS (ITIMES SBMR (SUB1 HEIGHT]
[COND
((AND (NOT (fetch PBTDISJOINT of PILOTBBT))
(EQ SBMR DBMR))
(* If items are disjoint or rasters are different (which should have implied disjointedness anyway), we're
through. Otherwise, there is overlap, and alto needs SBCA = DBCA and SBMR = DBMR in order to be able to tell what
direction to go)
[SETQ DIF (IPLUS (UNFOLD (IDIFFERENCE (\HILOC SOURCEADDR)
(\HILOC DESTADDR))
WORDSPERSEGMENT)
(\LOLOC SOURCEADDR)
(IMINUS (\LOLOC DESTADDR]
(* how far from source to dest base, maybe negative. Note: the UNFOLD is a LLSH, but that's okay for negative
numbers, too (although it's done in macro code))
(COND
((IGEQ DIF 0) (* Source beyond dest, so source ← dest)
(replace BBTSTY of ALTOBBT with (IQUOTIENT DIF DBMR))
(* How many lines down from DESTADDR the source starts)
(replace BBTSLX of ALTOBBT with (IPLUS (UNFOLD (IREMAINDER DIF DBMR)
BITSPERWORD)
(fetch PBTSOURCEBIT of PILOTBBT)))
(* How far over in line)
(SETQ SOURCEADDR DESTADDR))
(T (SETQ DIF (IMINUS DIF)) (* Dest beyond source)
(replace BBTDTY of ALTOBBT with (IQUOTIENT DIF DBMR))
(* How many lines down from SOURCEADDR the destination
starts)
(replace BBTDLX of ALTOBBT with (IPLUS (UNFOLD (IREMAINDER DIF DBMR)
BITSPERWORD)
(fetch PBTDESTBIT of PILOTBBT)))
(* How far over in line)
(SETQ DESTADDR SOURCEADDR]
(replace BBTSOURCE of ALTOBBT with SOURCEADDR)))
(replace BBTLONG of ALTOBBT with T)
(replace BBTDEST of ALTOBBT with DESTADDR)
(RETURN (\BITBLT1 ALTOBBT])
)
(RPAQQ \SCRATCHPBT NIL)
(RPAQQ \SCRATCHBBT NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \SCRATCHPBT \SCRATCHBBT)
)
(* display stream functions)
(DEFINEQ
(DISPLAYSTREAMP
[LAMBDA (X) (* Is X a displaystream?)
(AND (TYPENAMEP X (QUOTE DISPLAYSTREAM))
X])
(DSPOPERATION
[LAMBDA (OPERATION DISPLAYSTREAM) (* bvm: "18-JUL-82 21:33")
(* sets the operation field of a display stream)
(PROG ((DS (\SFInsureDisplayStream DISPLAYSTREAM)))
(RETURN (PROG1 (fetch \SFOPERATION of DS)
(COND
(OPERATION (OR (FMEMB OPERATION (QUOTE (PAINT REPLACE INVERT ERASE)))
(LISPERROR "ILLEGAL ARG" OPERATION))
(UNINTERRUPTABLY
(freplace \SFOPERATION of DS with OPERATION)
(* update other fields that depend on operation.)
(\SETPBTFUNCTION (fetch \SFPILOTBBT of DS)
(fetch \SFSOURCETYPE of DS)
OPERATION))])
(DSPSOURCETYPE
[LAMBDA (SOURCETYPE DISPLAYSTREAM) (* bvm: "28-JAN-83 14:52")
(* sets the operation field of a display stream)
(PROG ((DS (\SFInsureDisplayStream DISPLAYSTREAM)))
(RETURN (PROG1 (fetch \SFSOURCETYPE of DS)
(COND
(SOURCETYPE (OR (FMEMB SOURCETYPE (QUOTE (INPUT INVERT)))
(LISPERROR "ILLEGAL ARG" SOURCETYPE))
(UNINTERRUPTABLY
(freplace \SFSOURCETYPE of DS with SOURCETYPE)
(* update other fields that depend on operation.)
(\SETPBTFUNCTION (fetch \SFPILOTBBT of DS)
SOURCETYPE
(fetch \SFOPERATION of DS)))])
(DSPXPOSITION
[LAMBDA (XPOSITION DISPLAYSTREAM) (* rrb "12-NOV-81 08:23")
(* coordinate position is stored in 15 bits in the range
-2↑15 to +2↑15.)
(PROG ((DS (\SFInsureDisplayStream DISPLAYSTREAM)))
(RETURN (PROG1 (fetch \SFXPOSITION of DS)
(COND
((NULL XPOSITION))
((NUMBERP XPOSITION)
(freplace \SFXPOSITION of DS with XPOSITION)
(* if this display stream has an OFD, reset the position
field so that PRINT etc. won't put out eols.)
(AND (SETQ DS (fetch \SFOFD of DS))
(freplace XPOSITION of DS with 0)))
(T (\ILLEGAL.ARG XPOSITION])
(DSPYPOSITION
[LAMBDA (YPOSITION DISPLAYSTREAM) (* rrb "30-DEC-81 08:45")
(PROG ((DS (\SFInsureDisplayStream DISPLAYSTREAM)))
(RETURN (PROG1 (ffetch \SFYPOSITION of DS)
(COND
((NULL YPOSITION))
((NUMBERP YPOSITION)
(UNINTERRUPTABLY
(freplace \SFYPOSITION of DS with YPOSITION)
(\SFFixY DS)))
(T (\ILLEGAL.ARG YPOSITION])
(DSPYOFFSET
[LAMBDA (YOFFSET DISPLAYSTREAM) (* rrb "29-JUN-83 15:54")
(COND
[DISPLAYSTREAM (PROG ((DS (\SFInsureDisplayStream DISPLAYSTREAM)))
(RETURN (PROG1 (ffetch \SFYOFFSET of DS)
(COND
((NULL YOFFSET))
((NUMBERP YOFFSET)
(UNINTERRUPTABLY
(freplace \SFYOFFSET of DS with YOFFSET)
(\SFFixClippingRegion DS)
(\SFFixY DS)))
(T (\ILLEGAL.ARG YOFFSET]
(T (* check done specially for NIL so that it won't default
to primary output file.)
(\ILLEGAL.ARG DISPLAYSTREAM])
)
(DEFINEQ
(DSPCLIPPINGREGION
[LAMBDA (REGION DISPLAYSTREAM) (* rrb "29-JUN-83 15:57")
(* sets the clipping region of a display stream.)
(COND
[DISPLAYSTREAM (* special check done for NIL to stop default to primary
output file.)
(PROG ((DS (\SFInsureDisplayStream DISPLAYSTREAM)))
(RETURN (PROG1 (ffetch \SFClippingRegion of DS)
(COND
(REGION (OR (type? REGION REGION)
(ERROR REGION " is not a REGION."))
(UNINTERRUPTABLY
(freplace \SFClippingRegion of DS
with REGION)
(\SFFixClippingRegion DS)
(\SFFixY DS))]
(T (\ILLEGAL.ARG DISPLAYSTREAM])
(DSPCREATE
[LAMBDA (DESTINATION) (* rrb "21-APR-83 14:04")
(PROG ((DS (create DISPLAYSTREAM))) (* create the bcpl interface array)
(freplace \SFPILOTBBT of DS with (create PILOTBBT
PBTDISJOINT ← T))
(* initial x and y positions are 0 when the data is
created.)
(DSPFONT (DEFAULTFONT (QUOTE DISPLAY))
DS)
(* initialize the core fields that effect the relatively constant fields in the DisplayStream structure then call
the function DSPFONT which will update that information in the right format.)
(DSPSOURCETYPE (QUOTE INPUT)
DS)
(DSPOPERATION (QUOTE REPLACE)
DS) (* called to cause the updating of the bcpl array from
the fields initialized earlier.)
(DSPDESTINATION (OR DESTINATION (SCREENBITMAP))
DS)
(RETURN DS])
(DSPDESTINATION
[LAMBDA (DESTINATION DISPLAYSTREAM) (* rrb "21-DEC-82 11:18")
(PROG ((DS (\SFInsureDisplayStream DISPLAYSTREAM)))
(RETURN (PROG1 (ffetch \SFDestination of DS)
(COND
(DESTINATION (SETQ DESTINATION (\DTEST DESTINATION (QUOTE BITMAP)))
(UNINTERRUPTABLY
(freplace \SFDestination of DS with DESTINATION)
(\SFFixDestination DS))])
(DSPFONT
[LAMBDA (FONT DISPLAYSTREAM) (* rrb "29-JUN-83 16:05")
(* sets the font that a display stream uses to print
characters.)
(PROG (XFONT OLDFONT NBITS (DS (\SFInsureDisplayStream DISPLAYSTREAM)))
(* save old value to return, smash new value and update
the bitchar portion of the record.)
(RETURN (PROG1 (SETQ OLDFONT (fetch \SFFONT of DS))
(COND
(FONT [OR [NLSETQ (SETQ XFONT (OR (\GETFONTDESC FONT (QUOTE DISPLAY)
T)
(FONTCOPY (ffetch \SFFONT of DS)
FONT]
(COND
((EQ 47 (ERRORN)) (* The user typed ctl-E)
(ERROR!))
(T (ERROR "Illegal font specification" FONT]
(* updating font information is fairly expensive
operation. Don't bother unless font has changed.)
[COND
((NEQ (SETQ NBITS (ffetch (BITMAP BITMAPBITSPERPIXEL)
of (ffetch (DISPLAYSTREAM \SFDestination)
of DS)))
1) (* color case, create a font with the current foreground
and background colors.)
(SETQ XFONT (\GETCOLORFONT FONT (DSPCOLOR NIL DS)
(DSPBACKCOLOR NIL DS)
NBITS]
(OR (EQ XFONT OLDFONT)
(UNINTERRUPTABLY
(freplace \SFFONT of DS with XFONT)
(freplace \SFLINEFEED of DS
with (IMINUS (fetch \SFHeight of XFONT)))
(\SFFixFont DS))])
(DSPTEXTURE
[LAMBDA (TEXTURE DISPLAYSTREAM) (* bvm: "24-MAY-82 22:18")
(PROG ((DS (\SFInsureDisplayStream DISPLAYSTREAM)))
(RETURN (PROG1 (fetch \SFTexture of DS)
(COND
((NULL TEXTURE))
((FIXP TEXTURE)
(freplace \SFTexture of DS with (LOGAND TEXTURE WORDMASK)))
(T (\ILLEGAL.ARG TEXTURE])
(\DISPLAYSTREAMINCRXPOSITION
[LAMBDA (N DS) (* rrb " 2-DEC-80 14:16")
(* increases the x position by N.
This is used internally. Returns the new value.)
(add (fetch \SFXPOSITION of DS)
N])
(\SFFixDestination
[LAMBDA (DISPLAYSTREAM) (* rrb "21-DEC-82 11:25")
(* fixes up those parts of the bitblt array which are
dependent upon the destination)
(PROG ((PBT (ffetch \SFPILOTBBT of DISPLAYSTREAM))
(BM (ffetch \SFDestination of DISPLAYSTREAM)))
(replace PBTDESTBPL of PBT with (UNFOLD (ffetch BITMAPRASTERWIDTH of BM)
BITSPERWORD))
(* line width information will be updated by \SFFixFont)
(* ({also needs to be updated to include merger of bitmaps and colorbitmaps}) This change should be put in but it
has ramifications to people that create bitmaps that are as wide as a string and then PRIN1 instead of PRIN3 so I
am taking it out for the Dec release. (freplace (DISPLAYSTREAM \SFRightMargin) of DISPLAYSTREAM with
(COND (COLOR? (IQUOTIENT (ffetch BITMAPWIDTH of BM) (ffetch (COLORBITMAP COLORBITSPERPIXEL) of COLOR?)))
(T (ffetch (BITMAP BITMAPWIDTH) of BM)))))
(\SFFixClippingRegion DISPLAYSTREAM)
(\SFFixY DISPLAYSTREAM) (* if destination from a black and white to a color
bitmap the font will have to change also.)
(\SFFixFont DISPLAYSTREAM)
(RETURN])
(\SFFixClippingRegion
[LAMBDA (DS) (* rrb "21-DEC-82 14:29")
(* compute the top, bottom, left and right edges of the clipping region in destination coordinates to save
computation every BltChar and coordinate transformation taking into account the size of the bit map as well as the
clipping region.)
(PROG ((CLIPREG (ffetch \SFClippingRegion of DS))
(BM (ffetch \SFDestination of DS)))
[freplace \SFClippingRight of DS with (IMAX 0 (IMIN (\DSPTRANSFORMX (IPLUS (ffetch LEFT
of CLIPREG)
(ffetch WIDTH
of CLIPREG))
DS)
(IQUOTIENT (ffetch (BITMAP BITMAPWIDTH)
of BM)
(fetch (BITMAP
BITMAPBITSPERPIXEL)
of BM]
(freplace \SFClippingLeft of DS with (IMIN (IMAX (\DSPTRANSFORMX (ffetch LEFT of CLIPREG)
DS)
0)
MAX.SMALL.INTEGER))
[freplace \SFClippingTop of DS with (IMAX 0 (IMIN (\DSPTRANSFORMY (IPLUS (ffetch BOTTOM
of CLIPREG)
(ffetch HEIGHT
of CLIPREG))
DS)
(ffetch BITMAPHEIGHT of BM]
(freplace \SFClippingBottom of DS with (IMIN (IMAX (\DSPTRANSFORMY (ffetch BOTTOM
of CLIPREG)
DS)
0)
MAX.SMALL.INTEGER])
(\SFFixFont
[LAMBDA (DISPLAYSTREAM) (* rrb "28-APR-83 14:23")
(* used to fix up those parts of the bitblt array which
depend upon the FONT)
[PROG [(PBT (ffetch \SFPILOTBBT of DISPLAYSTREAM))
(FONT (ffetch \SFFONT of DISPLAYSTREAM))
FONTBITMAP
(NBITS (fetch (BITMAP BITMAPBITSPERPIXEL) of (fetch \SFDestination of DISPLAYSTREAM]
(SETQ FONTBITMAP (fetch CHARACTERBITMAP of FONT))
(replace \SFWIDTHSCACHE of DISPLAYSTREAM with (fetch (ARRAYP BASE)
of (fetch \SFWidths of FONT)))
(* cache the widths and offsets so that charcter
printing will be faster.)
[COND
((NEQ NBITS 1)
(* mark the displaystream as not having a calculated font yet. It will be put in by BLTCHAR the first time it is
printed too. This avoids creating color fonts for streams that are not printed to.)
(\SFMARKUNFONTED DISPLAYSTREAM))
(T (replace \SFOFFSETSCACHE of DISPLAYSTREAM with (fetch (ARRAYP BASE)
of (fetch \SFOffsets of FONT)))
(replace PBTSOURCEBPL of PBT with (UNFOLD (fetch BITMAPRASTERWIDTH of FONTBITMAP)
BITSPERWORD]
(replace (DISPLAYSTREAM \SFSlowPrintingCase) of DISPLAYSTREAM
with (OR (NEQ NBITS 1)
(NEQ (fetch (FONTDESCRIPTOR ROTATION) of FONT)
0]
(\SFFixY DISPLAYSTREAM)
(\SFFIXLINELENGTH DISPLAYSTREAM])
(\SFFIXLINELENGTH
[LAMBDA (DISPLAYSTREAM) (* rrb "17-DEC-82 10:06")
(* CALLED BY RIGHTMARGIN LEFTMARGIN AND \SFFIXFONT TO UPDATE THE LINELENGTH FIELD IN THE DISPLAYSTREAM'S STREAM IF
IT HAS ONE. ALSO CALLED WHEN THE DISPLAYSTREAM INITIALLY GETS AN OFD.)
(PROG ((DSOFD (fetch (DISPLAYSTREAM \SFOFD) of DISPLAYSTREAM))
LLEN)
(COND
(DSOFD (replace (STREAM LINELENGTH) of DSOFD
with (COND
((IGREATERP (SETQ LLEN (IQUOTIENT (IDIFFERENCE (fetch (DISPLAYSTREAM
\SFRightMargin)
of DISPLAYSTREAM)
(fetch (DISPLAYSTREAM
\SFLeftMargin)
of DISPLAYSTREAM))
(CHARWIDTH (CHARCODE A)
DISPLAYSTREAM)))
1)
LLEN)
(T 10])
(\SFFixY
[LAMBDA (DISPLAYSTREAM) (* rrb "18-APR-83 20:35")
(* makes that part of the bitblt array of a display stream which deals with the Y information consistent.
This is called whenever any of the information which effects it changes by the DSPFn eg DSPPosition.
If the change affected the clipping region, \SFFixClippingRegion should be called before \SFFixY)
(* assumes DISPLAYSTREAM has already been type checked.)
(PROG ((PBT (ffetch \SFPILOTBBT of DISPLAYSTREAM))
(FONT (ffetch \SFFONT of DISPLAYSTREAM))
(Y (\DSPTRANSFORMY (DSPYPOSITION NIL DISPLAYSTREAM)
DISPLAYSTREAM))
TOP CHARTOP BM)
(SETQ CHARTOP (IPLUS Y (ffetch \SFAscent of FONT)))
[freplace PBTDEST of PBT with (\ADDBASE (fetch BITMAPBASE of (SETQ BM
(ffetch \SFDestination
of DISPLAYSTREAM)))
(ITIMES (ffetch BITMAPRASTERWIDTH of BM)
(\SFInvert BM
(SETQ TOP
(IMAX (IMIN (ffetch
\SFClippingTop
of
DISPLAYSTREAM)
CHARTOP)
0]
[freplace PBTSOURCE of PBT with (\ADDBASE (ffetch BITMAPBASE
of (SETQ BM (ffetch CHARACTERBITMAP
of FONT)))
(ITIMES (ffetch BITMAPRASTERWIDTH of BM)
(IMIN (IMAX (IDIFFERENCE CHARTOP TOP)
0)
MAX.SMALL.INTEGER]
(freplace PBTHEIGHT of PBT with (IMAX (IDIFFERENCE TOP (IMAX (IDIFFERENCE Y
(ffetch
\SFDescent
of FONT))
(ffetch \SFClippingBottom
of DISPLAYSTREAM)))
0])
)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
[DECLARE: EVAL@COMPILE
(RECORD STREAMOFDISPLAYSTREAM STREAM (SUBRECORD STREAM)
[ACCESSFNS ((DISPLAYSTREAM (fetch (STREAM F1) of DATUM)
(replace (STREAM F1) of DATUM
with NEWVALUE])
]
(* END EXPORTED DEFINITIONS)
)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS \SFInsureDisplayStream MACRO ((X)
(\DTEST X (QUOTE DISPLAYSTREAM))))
(PUTPROPS \GETDISPLAYSTREAMFROMSTREAM MACRO ((STRM) (* fetches the DISPLAYSTREAM from a STRM and makes sure
STRM is the ofd of DS)
([LAMBDA (DS)
(DECLARE (LOCALVARS . T))
(COND
((EQ (ffetch (DISPLAYSTREAM \SFOFD) of DS)
STRM))
(T (freplace (DISPLAYSTREAM \SFOFD) of DS
with STRM)))
DS]
(ffetch DISPLAYSTREAM of STRM))))
(PUTPROPS \SFMARKUNFONTED MACRO ((DS)
(freplace (DISPLAYSTREAM \SFOFFSETSCACHE) of DS with NIL)))
(PUTPROPS \SFHASFONT MACRO ((DS)
(FFETCH (DISPLAYSTREAM \SFOFFSETSCACHE) of DS)))
)
(* END EXPORTED DEFINITIONS)
(MOVD? (QUOTE \ILLEGAL.ARG)
(QUOTE \COERCETODS))
(MOVD? (QUOTE NILL)
(QUOTE WFROMDS))
(* Stub for window package)
(DECLARE: DOCOPY
(DECLARE: EVAL@LOADWHEN (EQ (SYSTEMTYPE)
(QUOTE D))
(DECLARE: EVAL@LOADWHEN (OR (NOT (GETD (QUOTE WINDOWWORLD)))
(NOT (WINDOWWORLD)))
(RPAQQ \TOPWDS NIL)
)
(MOVD? (QUOTE NILL)
(QUOTE \TOTOPWDS))
)
)
(DECLARE: DONTCOPY EVAL@COMPILE
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS \INSURETOPWDS DMACRO (OPENLAMBDA (DS)
(OR (EQ DS \TOPWDS)
(\TOTOPWDS DS))))
(PUTPROPS \INSURETOPWDS MACRO ((DS) (* For non-window implementations)
(PROGN)))
(PUTPROPS .WHILE.TOP.DS. MACRO [(FIRST . REST) (* FIRST should be a displaystream and a variable.)
(UNINTERRUPTABLY
(AND \COLORCURSORBM (\IFCOLORDS\TAKEDOWNCOLORCURSOR FIRST))
(\INSURETOPWDS FIRST)
(PROGN . REST)
(AND \COLORCURSORDOWN (\PUTUPCOLORCURSOR)))])
(PUTPROPS .WHILE.TOP.IF.DS. MACRO [(FIRST COLOR? . REST) (* FIRST should be a displaystream and a variable.)
(UNINTERRUPTABLY
(COND
(FIRST (\INSURETOPWDS FIRST)))
[COND
(COLOR? (* this actually takes down the cursor whenever a bitblt
is done to any color bitmap. Not optimal but works.)
(AND \COLORCURSORBM (\TAKEDOWNCOLORCURSOR]
(PROGN . REST)
(AND \COLORCURSORDOWN (\PUTUPCOLORCURSOR)))])
(PUTPROPS \PIXELOFBITADDRESS MACRO (OPENLAMBDA (BITSPERPIXEL BITADDRESS)
(SELECTQ BITSPERPIXEL
(1 BITADDRESS)
(4 (LRSH BITADDRESS 2))
(LRSH BITADDRESS 3))))
)
(ADDTOVAR GLOBALVARS \TOPWDS)
(* END EXPORTED DEFINITIONS)
)
(* DisplayStream TTY functions)
(DEFINEQ
(TTYDISPLAYSTREAM
[LAMBDA (DISPLAYSTREAM) (* bvm: "23-JUL-83 22:47")
(* Makes DISPLAYSTREAM be the ttydisplaystream)
(DECLARE (GLOBALVARS \DEFAULTTTYDISPLAYSTREAM))
(COND
((NULL DISPLAYSTREAM) (* this case normally macros out)
TtyDisplayStream)
(T
(* removed special check for new one being the same as old so that this function could be used to update the page
size and line length after changing the displaystream.)
(PROG (WIN)
(COND
((type? DISPLAYSTREAM DISPLAYSTREAM)
DISPLAYSTREAM)
((type? WINDOW DISPLAYSTREAM) (* window is saved because WFROMDS only works on OPEN
windows so this allows the NUTTYDISPLAYSTREAM to be
moved to a closed one.)
(SETQ WIN DISPLAYSTREAM)
(SETQ DISPLAYSTREAM (ffetch (WINDOW DSP) of DISPLAYSTREAM)))
(T (\ILLEGAL.ARG DISPLAYSTREAM)))
(RETURN (PROG1 TtyDisplayStream
(UNINTERRUPTABLY
[COND
((NEQ DISPLAYSTREAM TtyDisplayStream)
(* * First remove the old one (if any))
[COND
((AND TtyDisplayStream (NEQ TtyDisplayStream
\DEFAULTTTYDISPLAYSTREAM))
(\CHECKCARET TtyDisplayStream)
(* make sure caret is off before changing display
streams.)
(\CLEAROFD) (* \TERM.OFD is guaranteed to be the stream of
TtyDisplayStream)
(* change the full file name back to the display stream
from T which it was set to when it became the terminal
device.)
(replace FULLFILENAME of \TERM.OFD with TtyDisplayStream)
(replace OUTCHARFN of \TERM.OFD
with (FUNCTION \DSPPRINTCHAR))
(* Change the outcharfn back to an ordinary display)
(PROG ((TEM (WFROMDS TtyDisplayStream)))
(AND TEM (WINDOWPROP TEM (QUOTE \LINEBUF.OFD)
\LINEBUF.OFD]
(* * Now install the new one.)
(PROG ((TEM (\GETOFD DISPLAYSTREAM)))
(replace FULLFILENAME of TEM with T)
[COND
((NEQ DISPLAYSTREAM \DEFAULTTTYDISPLAYSTREAM)
(replace OUTCHARFN of TEM
with (FUNCTION \TTYOUTCHARFN]
(* if old T was the primary output, change it to the new
ttydisplaystream.)
(COND
((EQ \PRIMOUT.OFD \TERM.OFD)
(SETQ \PRIMOUT.OFD TEM)))
(SETQ \TERM.OFD TEM)
(* save and restore line buffer from the displaystream
window if any.)
(COND
([EQ \PRIMIN.OFD
(PROG1 \LINEBUF.OFD
(SETQ \LINEBUF.OFD
(OR [COND
((SETQ TEM (OR WIN (WFROMDS
DISPLAYSTREAM)))
(WINDOWPROP TEM (QUOTE PROCESS)
(THIS.PROCESS))
(* For the PROC world to worry about tty moving)
(WINDOWPROP TEM (QUOTE
\LINEBUF.OFD]
(\CREATELINEBUFFER]
(* primary input is line buffer, switch it too.)
(SETQ \PRIMIN.OFD \LINEBUF.OFD)))
(SETQ TtyDisplayStream DISPLAYSTREAM]
(* change scroll mode of tty stream to scroll.)
(DSPSCROLL (QUOTE ON)
DISPLAYSTREAM)
(* Reset page characteristics.)
[PAGEHEIGHT (IQUOTIENT (IDIFFERENCE (fetch \SFClippingTop
of DISPLAYSTREAM)
(fetch \SFClippingBottom
of DISPLAYSTREAM))
(IABS (DSPLINEFEED NIL DISPLAYSTREAM])])
)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS TTYDISPLAYSTREAM MACRO [X (COND
((NULL (CAR X))
(QUOTE TtyDisplayStream))
(T (QUOTE IGNOREMACRO])
)
(* END EXPORTED DEFINITIONS)
(DEFINEQ
(DSPLINEFEED
[LAMBDA (DELTAY DISPLAYSTREAM) (* rrb "16-NOV-81 08:15")
(* sets the amount that a line feed increases the y
coordinate by.)
(PROG1 (ffetch (DISPLAYSTREAM \SFLINEFEED) of (SETQ DISPLAYSTREAM (\SFInsureDisplayStream
DISPLAYSTREAM)))
(AND DELTAY (COND
((NUMBERP DELTAY)
(freplace (DISPLAYSTREAM \SFLINEFEED) of DISPLAYSTREAM with DELTAY))
(T (\ILLEGAL.ARG DELTAY])
(DSPLEFTMARGIN
[LAMBDA (XPOSITION DISPLAYSTREAM) (* rrb "30-DEC-81 08:52")
(* sets the xposition that a carriage return returns
to.)
(PROG1 (ffetch (DISPLAYSTREAM \SFLeftMargin) of (SETQ DISPLAYSTREAM (\SFInsureDisplayStream
DISPLAYSTREAM)))
(AND XPOSITION (COND
((AND (SMALLP XPOSITION)
(IGREATERP XPOSITION -1))
(UNINTERRUPTABLY
(freplace (DISPLAYSTREAM \SFLeftMargin) of DISPLAYSTREAM with XPOSITION)
(\SFFIXLINELENGTH DISPLAYSTREAM)))
(T (\ILLEGAL.ARG XPOSITION])
(DSPRIGHTMARGIN
[LAMBDA (XPOSITION DISPLAYSTREAM) (* rrb "30-DEC-81 08:57")
(* Sets the right margin that determines when a cr is
inserted by print.)
(PROG (OLDRM)
(RETURN (PROG1 [SETQ OLDRM (ffetch (DISPLAYSTREAM \SFRightMargin) of (SETQ DISPLAYSTREAM
(
\SFInsureDisplayStream DISPLAYSTREAM]
(COND
((NULL XPOSITION))
[(AND (SMALLP XPOSITION)
(IGREATERP XPOSITION -1))
(* Avoid fixing linelength if right margin hasn't
changed.)
(OR (EQ XPOSITION OLDRM)
(UNINTERRUPTABLY
(freplace (DISPLAYSTREAM \SFRightMargin) of DISPLAYSTREAM
with XPOSITION)
(\SFFIXLINELENGTH DISPLAYSTREAM))]
(T (\ILLEGAL.ARG XPOSITION])
(DSPRESET
[LAMBDA (DISPLAYSTREAM) (* rrb "28-APR-83 16:06")
(DECLARE (GLOBALVARS \CURRENTDISPLAYLINE)) (* resets a display stream)
(SETQ DISPLAYSTREAM (\SFInsureDisplayStream DISPLAYSTREAM))
(PROG ((CREG (DSPCLIPPINGREGION NIL DISPLAYSTREAM))
(FONT (DSPFONT NIL DISPLAYSTREAM))
FONTASCENT)
(SETQ FONTASCENT (FONTASCENT FONT))
(SELECTQ (fetch (FONTDESCRIPTOR ROTATION) of FONT)
(0 (DSPXPOSITION (DSPLEFTMARGIN NIL DISPLAYSTREAM)
DISPLAYSTREAM)
(DSPYPOSITION (ADD1 (IDIFFERENCE (fetch TOP of CREG)
FONTASCENT))
DISPLAYSTREAM))
(90 (DSPXPOSITION (IPLUS (fetch LEFT of CREG)
FONTASCENT)
DISPLAYSTREAM)
(DSPYPOSITION (fetch BOTTOM of CREG)
DISPLAYSTREAM))
(270 (DSPXPOSITION (IDIFFERENCE (fetch RIGHT of CREG)
FONTASCENT)
DISPLAYSTREAM)
(DSPYPOSITION (fetch TOP of CREG)
DISPLAYSTREAM))
(ERROR "only supported rotations are 0, 90 and 270"))
(BITBLT NIL NIL NIL DISPLAYSTREAM (fetch LEFT of CREG)
(fetch BOTTOM of CREG)
(fetch WIDTH of CREG)
(fetch HEIGHT of CREG)
(QUOTE TEXTURE)
(QUOTE REPLACE)
(ffetch \SFTexture of DISPLAYSTREAM))
(COND
((EQ (TTYDISPLAYSTREAM)
DISPLAYSTREAM)
(SETQ \CURRENTDISPLAYLINE 0])
(DSPSCROLL
[LAMBDA (SWITCHSETTING DISPLAYSTREAM) (* rrb "29-JUN-83 16:07")
(* sets the SCROLL characteristics of the font in a display stream. If SWITCHSETTING in ON, when bottom of screen
is reached, contents will be blted DSPLineFeed bits.)
(PROG ((ds (\SFInsureDisplayStream DISPLAYSTREAM)))
(RETURN (PROG1 (OR (ffetch \SFScroll of ds)
(QUOTE OFF))
(AND SWITCHSETTING (freplace \SFScroll of ds with (NEQ SWITCHSETTING
(QUOTE OFF])
(CHANGETTYDEVICE
[LAMBDA (NEWTTYDEVICE) (* rrb "20-JUL-83 17:28")
(* resetform format functions to change the channel T to
be a display stream or the bcpl text buffer.)
(DECLARE (GLOBALVARS \TERM.OFD.SAV \STOPSCROLLMESSAGE TtyDisplayStream.SAVE \CURRENTTTYDEVICE
\DEFAULTTTYDISPLAYSTREAM))
(SELECTQ NEWTTYDEVICE
(NIL (SETQQ NEWTTYDEVICE BCPLDISPLAY))
(T (SETQQ NEWTTYDEVICE LISPDISPLAY))
NIL)
(\CLEAROFD)
(COND
[(EQ NEWTTYDEVICE (QUOTE BCPLDISPLAY)) (* restore terminal to BCPL device)
(COND
((NEQ \CURRENTTTYDEVICE (QUOTE BCPLDISPLAY)) (* T was changed to a display stream.
change it back and return the display stream as value.)
(PROG1 (fetch DISPLAYSTREAM of \TERM.OFD)
(COND
((EQ TtyDisplayStream \DEFAULTTTYDISPLAYSTREAM)
(* don't think this should ever happen but if it did we
don't want it to continue.)
(HELP)))
(UNINTERRUPTABLY
(SETQQ \CURRENTTTYDEVICE BCPLDISPLAY)
(replace FULLFILENAME of \TERM.OFD with (fetch DISPLAYSTREAM of \TERM.OFD))
(replace OUTCHARFN of \TERM.OFD with (FUNCTION \DSPPRINTCHAR))
(COND
((EQ \PRIMOUT.OFD \TERM.OFD) (* if primary output is to T, change it as well.)
(SETQ \PRIMOUT.OFD \TERM.OFD.SAV)))
(SETQ TtyDisplayStream.SAVE TtyDisplayStream)
(SETQ TtyDisplayStream NIL)
(SETQ \TERM.OFD \TERM.OFD.SAV)
(replace OUTCHARFN of \TERM.OFD with (FUNCTION \TTYOUTCHARFN)))
(SETQ \STOPSCROLLMESSAGE "------TYPE ANY CHARACTER TO CONTINUE------"]
[(type? DISPLAYSTREAM (OR (AND (EQ NEWTTYDEVICE (QUOTE LISPDISPLAY))
(SETQ NEWTTYDEVICE (OR TtyDisplayStream TtyDisplayStream.SAVE)))
NEWTTYDEVICE)) (* make the terminal be the same as the
ttydisplaystream)
(UNINTERRUPTABLY
(COND
((NEQ \CURRENTTTYDEVICE (QUOTE LISPDISPLAY))
(SETQQ \CURRENTTTYDEVICE LISPDISPLAY)
(SETQ \STOPSCROLLMESSAGE "")))
(SETQ TtyDisplayStream.SAVE NIL)
(OR (TTYDISPLAYSTREAM NEWTTYDEVICE)
(QUOTE BCPLDISPLAY)))]
(T (\ILLEGAL.ARG NEWTTYDEVICE])
(OUTPUTDSP
[LAMBDA (FILE) (* rmk: " 8-AUG-82 23:14")
(* Returns displaystream of FILE, coercing NIL to OUTPUT, not current displaystream. Called from CHANGFONT.
This probably should be included in \COERCETODS, when CURRENTDISPLAYSTREAM is eliminated.)
(PROG [(STREAM (\GETOFD FILE (QUOTE OUTPUT]
(COND
((type? DISPLAYSTREAM (SETQ STREAM (fetch (STREAMOFDISPLAYSTREAM DISPLAYSTREAM)
of STREAM)))
(RETURN STREAM])
(PAGEHEIGHT
[LAMBDA (N) (* rrb "23-JUL-83 15:08")
(* sets the page height in lines of the screen.)
(PROG1 \#DISPLAYLINES (COND
((NUMBERP N)
(SETQ \#DISPLAYLINES N)
(SETQ \CURRENTDISPLAYLINE 0])
)
(RPAQ? \CURRENTTTYDEVICE (QUOTE BCPLDISPLAY))
(RPAQ? SystemColorMap )
(DEFINEQ
(\DSPPRINTCHAR
[LAMBDA (STREAM CHARCODE) (* rrb "23-JUL-83 15:08")
(* Displays the character and increments the Xposition.
STREAM is guaranteed to be the stream corresponding to a
display stream.)
(PROG ((DS (\GETDISPLAYSTREAMFROMSTREAM STREAM)))
(\CHECKCARET DS)
(SELECTC (fetch CCECHO of (\SYNCODE \PRIMTERMSA CHARCODE))
[INDICATE.CCE (PROG ((CC CHARCODE))
(add (fetch XPOSITION of STREAM)
(IPLUS (COND
((IGREATERP CC 127)
(* META character)
(BLTCHAR (CHARCODE #)
DS)
(SETQ CC (LOGAND CC 127))
1)
(T 0))
(COND
((ILESSP CC 32)
(* CONTROL character)
(BLTCHAR (CHARCODE ↑)
DS)
(SETQ CC (LOGOR CC 64))
1)
(T 0))
(PROGN (BLTCHAR CC DS)
1]
[SIMULATE.CCE
(SELCHARQ CHARCODE
((EOL CR LF)
(\DSPPRINTCR/LF CHARCODE DS)
(replace XPOSITION of STREAM with 0))
(ESCAPE (BLTCHAR (CHARCODE $)
DS)
(add (fetch XPOSITION of STREAM)
1))
(BELL (* make switching of bits uninterruptable but allow
interrupts between flashes.)
(FRPTQ BELLCNT
(UNINTERRUPTABLY
(BITBLT NIL NIL NIL DS NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE)
(DISMISS BELLRATE)
(BITBLT NIL NIL NIL DS NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE))
(DISMISS BELLRATE)))
[TAB (PROG (TABWIDTH (SPACEWIDTH (CHARWIDTH (CHARCODE SPACE)
DS)))
(SETQ TABWIDTH (UNFOLD SPACEWIDTH 8))
(COND
((IGREATERP (\DISPLAYSTREAMINCRXPOSITION
(SETQ TABWIDTH
(IDIFFERENCE TABWIDTH
(MOD (IDIFFERENCE
(DSPXPOSITION NIL DS)
(DSPLEFTMARGIN NIL DS)
)
TABWIDTH)))
DS)
(ffetch \SFRightMargin of DS))
(* tab was past rightmargin, force cr.)
(\DSPPRINTCR/LF (CHARCODE EOL)
DS)))
(* return the number of spaces taken.)
(add (fetch XPOSITION of STREAM)
(IQUOTIENT TABWIDTH SPACEWIDTH]
(PROGN (* this case was copied from \DSCCOUT.)
(BLTCHAR CHARCODE DS)
(add (fetch XPOSITION of STREAM)
1]
[REAL.CCE (SELECTC CHARCODE
((CHARCODE (EOL CR LF))
(\DSPPRINTCR/LF CHARCODE DS)
(replace XPOSITION of STREAM with 0))
(ERASECHARCODE (DSPBACKUP (CHARWIDTH (CHARCODE A)
DS)
DS)
(* line buffering routines have already taken care of
backing up the position)
0)
(PROGN (BLTCHAR CHARCODE DS)
(add (fetch XPOSITION of STREAM)
1]
(IGNORE.CCE)
(SHOULDNT])
(\DSPPRINTCR/LF
[LAMBDA (CHARCODE DS) (* rrb "22-JUN-83 16:54")
(* CHARCODE is EOL, CR, or LF Assumes that DS has been
checked by \DSPPRINTCHAR)
(COND
((EQ DS (TTYDISPLAYSTREAM))
(\STOPSCROLL?) (* \STOPSCROLL may have turned on the caret.)
(\CHECKCARET DS)))
(PROG [BTM AMOUNT/BELOW Y (ROTATION (COND
((fetch (DISPLAYSTREAM \SFSlowPrintingCase) of DS)
(fetch (FONTDESCRIPTOR ROTATION)
of (fetch (DISPLAYSTREAM \SFFONT) of DS)))
(T 0]
(COND
((EQ ROTATION 0)
(COND
((EQ CHARCODE (CHARCODE EOL)) (* on LF, no change in X)
(DSPXPOSITION (DSPLEFTMARGIN NIL DS)
DS)))
(SETQ Y (IPLUS (DSPYPOSITION NIL DS)
(DSPLINEFEED NIL DS)))
[COND
((AND (fetch \SFScroll of DS)
(IGREATERP (SETQ AMOUNT/BELOW (IDIFFERENCE (IPLUS (SETQ BTM
(fetch \SFClippingBottom
of DS))
(fetch \SFDescent
of (fetch \SFFONT
of DS)))
(\DSPTRANSFORMY Y DS)))
0))
(* automatically scroll up enough to make the entire next character visible. Descent check is so that the bottoms
of characters will be printed also.)
[PROG ((LFT (fetch \SFClippingLeft of DS))
WDTH BKGRND (DBITMAP (fetch \SFDestination of DS))
(HGHT (IDIFFERENCE (ffetch (DISPLAYSTREAM \SFClippingTop) of DS)
BTM)))
(SETQ WDTH (IDIFFERENCE (fetch \SFClippingRight of DS)
LFT))
[SETQ BKGRND (COND
((NEQ (fetch (BITMAP BITMAPBITSPERPIXEL) of DBITMAP)
1) (* this is a color case.)
(DSPBACKCOLOR NIL DS))
(T (ffetch (DISPLAYSTREAM \SFTexture) of DS]
(.WHILE.TOP.DS. DS (COND
((IGREATERP AMOUNT/BELOW HGHT)
(* scrolling more than the window size, use different
method.)
(* clear the window with background.)
(BITBLT NIL 0 0 DBITMAP LFT BTM WDTH HGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
BKGRND))
(T (BITBLT DBITMAP LFT BTM DBITMAP LFT (IPLUS BTM
AMOUNT/BELOW)
WDTH
(IDIFFERENCE HGHT AMOUNT/BELOW)
(QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT NIL 0 0 DBITMAP LFT BTM WDTH AMOUNT/BELOW
(QUOTE TEXTURE)
(QUOTE REPLACE)
BKGRND]
(SETQ Y (IPLUS Y AMOUNT/BELOW]
(DSPYPOSITION Y DS))
(T (PROG ((CLIPREG (DSPCLIPPINGREGION NIL DS))
X)
(COND
((EQ CHARCODE (CHARCODE EOL)) (* on LF, no change in X)
(DSPYPOSITION (SELECTQ ROTATION
(90 (fetch (REGION BOTTOM) of CLIPREG))
(270 (fetch (REGION TOP) of CLIPREG))
(ERROR "Only rotations supported are 0, 90 and 270"))
DS)))
[SETQ X (IPLUS (DSPXPOSITION NIL DS)
(SELECTQ ROTATION
(90 (IMINUS (DSPLINEFEED NIL DS)))
(270 (DSPLINEFEED NIL DS))
(ERROR "Only rotations supported are 0, 90 and 270"]
[COND
((AND (fetch \SFScroll of DS)
(SELECTQ ROTATION
(90 (IGREATERP [SETQ AMOUNT/BELOW
(IDIFFERENCE (\DSPTRANSFORMX X DS)
(IDIFFERENCE (fetch
\SFClippingRight
of DS)
(fetch \SFDescent
of (fetch \SFFONT
of DS]
0))
(270 (IGREATERP (SETQ AMOUNT/BELOW
(IDIFFERENCE (IPLUS (fetch \SFClippingLeft
of DS)
(fetch \SFDescent
of (fetch \SFFONT
of DS)))
(\DSPTRANSFORMX X DS)))
0))
(SHOULDNT)))
(* automatically scroll up enough to make the entire next character visible. Descent check is so that the bottoms
of characters will be printed also.)
[PROG ((LFT (fetch \SFClippingLeft of DS))
WDTH BKGRND (DBITMAP (fetch \SFDestination of DS))
HGHT KEPTWIDTH)
(SETQ BTM (fetch \SFClippingBottom of DS))
(SETQ HGHT (IDIFFERENCE (ffetch (DISPLAYSTREAM \SFClippingTop)
of DS)
BTM))
(SETQ WDTH (IDIFFERENCE (fetch \SFClippingRight of DS)
LFT))
[SETQ BKGRND (COND
((NEQ (fetch (BITMAP BITMAPBITSPERPIXEL) of DBITMAP)
1) (* this is a color case.)
(DSPBACKCOLOR NIL DS))
(T (ffetch (DISPLAYSTREAM \SFTexture) of DS]
(.WHILE.TOP.DS. DS
(COND
((IGREATERP AMOUNT/BELOW WDTH)
(* scrolling more than the window size, use different
method.)
(* clear the window with background.)
(BITBLT NIL 0 0 DBITMAP LFT BTM WDTH HGHT
(QUOTE TEXTURE)
(QUOTE REPLACE)
BKGRND))
((EQ ROTATION 90)
(BITBLT DBITMAP (IPLUS LFT AMOUNT/BELOW)
BTM DBITMAP LFT BTM (SETQ KEPTWIDTH
(IDIFFERENCE WDTH AMOUNT/BELOW))
HGHT
(QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT NIL 0 0 DBITMAP (IPLUS LFT KEPTWIDTH)
BTM AMOUNT/BELOW HGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
BKGRND))
(T (BITBLT DBITMAP LFT BTM DBITMAP (IPLUS LFT
AMOUNT/BELOW)
BTM
(IDIFFERENCE WDTH AMOUNT/BELOW)
HGHT
(QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT NIL 0 0 DBITMAP LFT BTM AMOUNT/BELOW HGHT
(QUOTE TEXTURE)
(QUOTE REPLACE)
BKGRND]
(SETQ X (SELECTQ ROTATION
(90 (IDIFFERENCE X AMOUNT/BELOW))
(IPLUS X AMOUNT/BELOW]
(DSPXPOSITION X DS])
)
(DEFINEQ
(\FLASHCARET?
[LAMBDA (DS) (* lmm "14-AUG-83 16:40")
(* checks to see if the caret needs to be flipped.
\CARETDOWN is T if the caret has been taken down for any
reason.)
(AND \DisplayStarted \CARET (OR \CARETDOWN (TIMEREXPIRED? \CARETFLASHTIME))
(\SHOWCARET (OR DS (TTYDISPLAYSTREAM])
(\TTYBACKGROUND
[LAMBDA NIL (* lmm "14-AUG-83 16:42")
(* called each time through a tty keyboard wait loop. First executes the TTYBACKGROUNDFNS which do things like
flashing the caret (and SAVEVM) and then allows other background things to run (including other processes.))
(OR (TTY.PROCESSP)
(\WAIT.FOR.TTY))
(for X in TTYBACKGROUNDFNS do (APPLY* X))
(\BACKGROUND])
)
(DEFINEQ
(DSPBACKUP
[LAMBDA (WIDTH DISPLAYSTREAM) (* rrb "22-JUN-83 17:24")
(OR DISPLAYSTREAM (SETQ DISPLAYSTREAM (TTYDISPLAYSTREAM)))
(PROG [FONTDESCRIPTOR [BLTWIDTH (IMIN WIDTH (IDIFFERENCE (DSPXPOSITION NIL DISPLAYSTREAM)
(DSPLEFTMARGIN NIL DISPLAYSTREAM]
(ROTATION (COND
((fetch (DISPLAYSTREAM \SFSlowPrintingCase) of DISPLAYSTREAM)
(fetch (FONTDESCRIPTOR ROTATION) of (fetch (DISPLAYSTREAM
\SFFONT)
of DISPLAYSTREAM)))
(T 0] (* turn caret off if necessary)
(RETURN (COND
((IGREATERP BLTWIDTH 0)
(\CHECKCARET DISPLAYSTREAM)
[COND
((EQ ROTATION 0)
(BITBLT NIL 0 0 DISPLAYSTREAM (\DISPLAYSTREAMINCRXPOSITION (IMINUS BLTWIDTH)
DISPLAYSTREAM)
[IDIFFERENCE (DSPYPOSITION NIL DISPLAYSTREAM)
(FONTDESCENT (SETQ FONTDESCRIPTOR (DSPFONT NIL
DISPLAYSTREAM]
BLTWIDTH
(FONTHEIGHT FONTDESCRIPTOR)
(QUOTE TEXTURE)
(QUOTE REPLACE)))
((EQ ROTATION 90)
(BITBLT NIL 0 0 DISPLAYSTREAM [IDIFFERENCE (DSPXPOSITION NIL DISPLAYSTREAM)
(FONTASCENT (SETQ FONTDESCRIPTOR
(DSPFONT NIL
DISPLAYSTREAM]
(add (fetch \SFYPOSITION of DISPLAYSTREAM)
(IMINUS BLTWIDTH))
(FONTHEIGHT FONTDESCRIPTOR)
BLTWIDTH
(QUOTE TEXTURE)
(QUOTE REPLACE)))
((EQ ROTATION 270)
(BITBLT NIL 0 0 DISPLAYSTREAM [IDIFFERENCE (DSPXPOSITION NIL DISPLAYSTREAM)
(FONTDESCENT (SETQ
FONTDESCRIPTOR
(DSPFONT NIL
DISPLAYSTREAM]
(add (fetch \SFYPOSITION of DISPLAYSTREAM)
BLTWIDTH)
(FONTHEIGHT FONTDESCRIPTOR)
BLTWIDTH
(QUOTE TEXTURE)
(QUOTE REPLACE]
T])
)
(ADDTOVAR TTYBACKGROUNDFNS \FLASHCARET?)
(DECLARE: DONTEVAL@LOAD DOCOPY
(RPAQQ BELLCNT 2)
(RPAQQ BELLRATE 60)
(RPAQQ \CARET NIL)
(RPAQQ \CARETFLG NIL)
(RPAQQ \DisplayStoppedForLogout NIL)
(RPAQQ TtyDisplayStream NIL)
)
(DEFINEQ
(COLORDISPLAYP
[LAMBDA NIL (* is the color display on?)
SystemColorMap])
)
(DEFINEQ
(DISPLAYBEFOREEXIT
[LAMBDA (EXITFN) (* rrb "21-APR-83 13:11")
(COND
((DISPLAYSTARTEDP)
(SELECTQ EXITFN
(LOGOUT (AND (COLORDISPLAYP)
(COLORDISPLAY NIL)) (* Shut off display during logout)
(SHOWDISPLAY))
(MAKESYS (* on MAKESYS, clear screen)
(DSPRESET (TTYDISPLAYSTREAM))
(AND (WINDOWWORLDP)
(DSPRESET PROMPTWINDOW)))
(SYSOUT NIL)
(SHOULDNT)) (* set flag so that display will be restarted when this
sysout is restarted.)
(SETQ \DisplayStoppedForLogout (CURSOR])
(DISPLAYAFTERENTRY
[LAMBDA (ENTRYFN) (* rrb " 4-DEC-82 15:23")
(* set address of Cursor bitmap every time because it
changes from machine to machine and StartDisplay is a
convenient place to reset it.)
(replace BITMAPBASE of CursorBitMap with \EM.CURSORBITMAP)
(COND
(\DisplayStoppedForLogout [PROG ((OLDWIDTH SCREENWIDTH))
(UPDATESCREENWIDTH)
(COND
((EQ OLDWIDTH SCREENWIDTH)
(\STARTDISPLAY))
(T (* moved to a different sized screen;)
(COND
((WINDOWWORLDP)
(\WWCHANGESCREENSIZE))
(T (DISPLAYSTREAMINIT]
(CURSOR \DisplayStoppedForLogout)
(SETQ \DisplayStoppedForLogout NIL)))
(* handles color display after entry from exec.)
(SELECTQ ENTRYFN
((LOGOUT SYSOUT)
(COND
(SystemColorMap (* colordisplay was on.)
(* turn it off. User may have moved to machine without color display or may now want more or less bits per pixel.
Display is not automatically turned on because it chews up many pages.)
(SETQ LastSystemColorMap SystemColorMap)
(SETQ SystemColorMap NIL)
(SETQ \COLORCURSORBM NIL)))
(* if color is loaded, set the functions that depend on
the type of machine.)
(AND (GETD (QUOTE \SETMACHINEDEPENDENTCOLORFNS))
(\SETMACHINEDEPENDENTCOLORFNS)))
NIL])
)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \CARET \CARETDOWN \CARETFLG \CARETFLASHTIME BELLCNT BELLRATE TTYBACKGROUNDFNS
\CARETRATE \DisplayStoppedForLogout SystemColorMap)
)
(* END EXPORTED DEFINITIONS)
(* transformation related functions.)
(DEFINEQ
(\DSPCLIPTRANSFORMX
[LAMBDA (X DS) (* rrb " 3-DEC-80 18:10")
(* returns the transformed coordinate value of X in the system of the destination. It also clips according to the
clipping region and returns NIL if it falls outside.)
(PROG ((TX (\DSPTRANSFORMX X DS)))
(RETURN (AND (NOT (IGREATERP (fetch \SFClippingLeft of DS)
TX))
(IGREATERP (fetch \SFClippingRight of DS)
TX)
TX])
(\DSPCLIPTRANSFORMY
[LAMBDA (Y DS) (* rrb " 3-DEC-80 18:11")
(* returns the transformed coordinate value of Y in the system of the destination. It also clips according to the
clipping region and returns NIL if it falls outside.)
(PROG ((TY (\DSPTRANSFORMY Y DS))) (* ClippingTop points past the top edge.)
(RETURN (AND (NOT (IGREATERP (fetch \SFClippingBottom of DS)
TY))
(IGREATERP (fetch \SFClippingTop of DS)
TY)
TY])
(\DSPTRANSFORMREGION
[LAMBDA (REGION DS) (* rrb " 3-DEC-80 18:11")
(* transforms a region into the destination coordinates
of the display stream.)
(create REGION
LEFT ←(\DSPTRANSFORMX (fetch LEFT of REGION)
DS)
BOTTOM ←(\DSPTRANSFORMY (fetch BOTTOM of REGION)
DS)
WIDTH ←(fetch WIDTH of REGION)
HEIGHT ←(fetch HEIGHT of REGION])
(\DSPUNTRANSFORMY
[LAMBDA (Y DS) (* rrb "16-DEC-80 19:05")
(* transforms a y coordinate from destination coords
into the display streams)
(IDIFFERENCE Y (fetch \SFYOFFSET of DS])
(\DSPUNTRANSFORMX
[LAMBDA (X DS) (* rrb "11-JUN-81 09:18")
(* transforms a x coordinate from destination coords
into the display streams)
(IDIFFERENCE X (fetch \SFXOFFSET of DS])
(\OFFSETCLIPPINGREGION
[LAMBDA (DS OLDREGION) (* rmk: "21-OCT-81 22:18")
(* calculates the clipping region of a display stream in
destination coordinates. if OLDREGION is given, it is
reused.)
(PROG ((CREG (fetch \SFClippingRegion of DS)))
(RETURN (COND
(OLDREGION (replace LEFT of OLDREGION with (\DSPTRANSFORMX (fetch LEFT
of CREG)
DS))
(replace BOTTOM of OLDREGION with (\DSPTRANSFORMY (fetch BOTTOM
of CREG)
DS))
(replace WIDTH of OLDREGION with (fetch WIDTH of CREG))
(replace HEIGHT of OLDREGION with (fetch HEIGHT of CREG))
OLDREGION)
((AND (ZEROP (fetch \SFXOFFSET of DS))
(ZEROP (fetch \SFYOFFSET of DS)))
(* special case of no offset to avoid storage creation.)
CREG)
(T (create REGION
LEFT ←(\DSPTRANSFORMX (fetch LEFT of CREG)
DS)
BOTTOM ←(\DSPTRANSFORMY (fetch BOTTOM of CREG)
DS)
WIDTH ←(fetch WIDTH of CREG)
HEIGHT ←(fetch HEIGHT of CREG])
)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS \DSPTRANSFORMX MACRO ((X DS) (* transforms an x coordinate into the destination
coordinate.)
(IPLUS X (fetch \SFXOFFSET of DS))))
(PUTPROPS \DSPTRANSFORMY MACRO ((Y DS) (* transforms an y coordinate into the destination
coordinate.)
(IPLUS Y (fetch \SFYOFFSET of DS))))
(PUTPROPS \OFFSETBOTTOM MACRO ((X) (* gives the destination coordinate address of the
origin.)
(fetch \SFYOFFSET of X)))
(PUTPROPS \OFFSETLEFT MACRO ((X) (* returns the x origin of in destination coordinates.)
(fetch \SFXOFFSET of X)))
)
(* END EXPORTED DEFINITIONS)
)
(* screen related functions)
(DEFINEQ
(UPDATESCREENWIDTH
[LAMBDA NIL (* sets the vaariable SCREENWIDTH from the interface
page that gives the hardware width.)
(SETQ SCREENWIDTH (ITIMES BITSPERWORD (SCREENRASTERWIDTH])
(SCREENRASTERWIDTH
[LAMBDA NIL (* bas: " 7-APR-81 00:28")
(fetch ScreenWidth of \InterfacePage])
(\CreateScreenBitMap
[LAMBDA (WIDTH HEIGHT) (* bvm: "25-MAR-83 11:12")
(DECLARE (GLOBALVARS \MaxScreenPage))
(* creates and locks the pages for the display bit map. Returns a BITMAP descriptor for it.
Uses the first words of the segment \DISPLAYREGION.)
(PROG ((RASTERWIDTH (FOLDHI (CEIL WIDTH (UNFOLD \DisplayWordAlign BITSPERWORD))
BITSPERWORD))
MAXPAGE#) (* the display microcode needs to have the display fall
on \DisplayWordAlign word boundaries.)
(COND
((IGREATERP (SETQ MAXPAGE# (SUB1 (FOLDHI (ITIMES RASTERWIDTH HEIGHT)
WORDSPERPAGE)))
\MaxScreenPage)
(* new screen size is larger, allocate more pages. All pages are locked. NOERROR is true in \NEWPAGE call in case
pages are already there, e.g. DLBOOT allocated them.)
(for I from (ADD1 \MaxScreenPage) to MAXPAGE# do (\NEWPAGE (\ADDBASE \DISPLAYREGION
(UNFOLD I
WORDSPERPAGE))
T T))
(SETQ \MaxScreenPage MAXPAGE#)))
(RETURN (COND
((BITMAPP ScreenBitMap) (* reuse the same BITMAP ptr so that it will stay EQ to
the one in user datastructures.)
(replace BITMAPBASE of ScreenBitMap with \DISPLAYREGION)
(replace BITMAPWIDTH of ScreenBitMap with WIDTH)
(replace BITMAPRASTERWIDTH of ScreenBitMap with RASTERWIDTH)
(replace BITMAPHEIGHT of ScreenBitMap with HEIGHT)
ScreenBitMap)
(T (create BITMAP
BITMAPBASE ← \DISPLAYREGION
BITMAPRASTERWIDTH ← RASTERWIDTH
BITMAPWIDTH ← WIDTH
BITMAPHEIGHT ← HEIGHT])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(UPDATESCREENWIDTH)
(RPAQQ SCREENHEIGHT 808)
(RPAQQ \MaxScreenPage -1)
(RPAQ ScreenBitMap (\CreateScreenBitMap SCREENWIDTH SCREENHEIGHT))
)
(* initialization)
(DEFINEQ
(DISPLAYSTREAMINIT
[LAMBDA (N) (* bvm: "23-JUL-83 22:47")
(DECLARE (GLOBALVARS \LastTTYLines \TopLevelTtyWindow))
(* starts display and sets N lines for tty at top)
(\STARTDISPLAY)
(PROG [TTYHEIGHT (TTYFONTHEIGHT (FONTHEIGHT (DSPFONT NIL TtyDisplayStream]
(DSPDESTINATION (SCREENBITMAP)
TtyDisplayStream) (* this is done here so that processes that are created
before window world is turned on have an acceptable
binding for their tty.)
(SETQ \TopLevelTtyWindow (SETQ \DEFAULTTTYDISPLAYSTREAM TtyDisplayStream))
(RETURN (PROG1 \LastTTYLines (SETQ TTYHEIGHT (ITIMES (COND
[(NUMBERP N)
(SETQ \LastTTYLines
(COND
((IGREATERP (ITIMES N
TTYFONTHEIGHT)
SCREENHEIGHT)
(* too many lines, reduce to fit leaving two lines
bottom margin.)
(IDIFFERENCE (IQUOTIENT
SCREENHEIGHT
TTYFONTHEIGHT)
2))
(T N]
(T \LastTTYLines))
TTYFONTHEIGHT))
(* put TTY region on top)
(DSPYOFFSET (IDIFFERENCE SCREENHEIGHT TTYHEIGHT)
TtyDisplayStream)
(DSPYPOSITION (FONTDESCENT (DSPFONT NIL TtyDisplayStream))
TtyDisplayStream)
(DSPXOFFSET 0 TtyDisplayStream)
(DSPCLIPPINGREGION (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← SCREENWIDTH
HEIGHT ← TTYHEIGHT)
TtyDisplayStream)
(* called after clipping region for TTYDISPLAYSTREAM has
been set so that \#DISPLAYLINES will get set correctly.)
(DSPRIGHTMARGIN SCREENWIDTH TtyDisplayStream])
(\STARTDISPLAY
[LAMBDA NIL (* bvm: "25-MAR-83 11:15")
(DECLARE (GLOBALVARS \MouseEnabled \MouseEventQueue))
(UPDATESCREENWIDTH)
(SETQ ScreenBitMap (\CreateScreenBitMap SCREENWIDTH SCREENHEIGHT))
(UNINTERRUPTABLY
(SHOWDISPLAY (fetch BITMAPBASE of ScreenBitMap)
(fetch BITMAPRASTERWIDTH of ScreenBitMap))
(CHANGETTYDEVICE (QUOTE LISPDISPLAY))
[COND
(\MouseEnabled (* reenable mouse if it was enabled before Logout.)
(\LOCKPAGES \MouseEventQueue 1)
(ENABLEMOUSE (CAR \MouseEnabled)
(CDR \MouseEnabled]
(SETQ \DisplayStarted T))
(SETQ WHOLESCREEN (SETQ WHOLEDISPLAY
(create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← SCREENWIDTH
HEIGHT ← SCREENHEIGHT])
(\STOPDISPLAY
[LAMBDA NIL (* bvm: "25-MAR-83 11:18")
(DECLARE (GLOBALVARS \MaxScreenPage)) (* Turn off Lisp display, go back to bcpl display.
Exists only for emergency use)
(UNINTERRUPTABLY
(SHOWDISPLAY)
(CHANGETTYDEVICE (QUOTE BCPLDISPLAY))
(\UNLOCKPAGES (fetch BITMAPBASE of ScreenBitMap)
(ADD1 \MaxScreenPage))
(SETQ \MaxScreenPage -1)
(SETQ \DisplayStarted NIL))
(PAGEHEIGHT 58])
)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \DisplayStarted \DisplayStreamsInitialized \DisplayInitialed WHOLEDISPLAY
WHOLESCREEN)
)
(* END EXPORTED DEFINITIONS)
(ADDTOVAR GLOBALVARS WHOLESCREEN)
(DECLARE: DONTEVAL@LOAD DOCOPY
(RPAQQ \DisplayStarted NIL)
(RPAQQ \LastTTYLines 12)
)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS DISPLAYINITIALIZEDP MACRO (NIL (* always initialized now)
T))
(PUTPROPS DISPLAYSTARTEDP MACRO (NIL \DisplayStarted))
)
(* END EXPORTED DEFINITIONS)
(DEFINEQ
(INITIALIZEDISPLAYSTREAMS
[LAMBDA NIL
(DECLARE (GLOBALVARS TtyDisplayStream.SAVE)) (* rrb "27-APR-83 15:32")
(SETQ WHOLEDISPLAY (create REGION))
(SETQ \SYSPILOTBBT (create PILOTBBT)) (* For BITBLT)
(SETQ \SYSBBTEXTURE (BITMAPCREATE 16 16)) (* For texture handling in \BITBLTSUB)
(* default font is initialzed here after pup, font, and
bitmap code has been loaded.)
(DEFAULTFONT (QUOTE DISPLAY)
(QUOTE (GACHA 10))
(QUOTE NEW))
(SETQ TtyDisplayStream.SAVE (DSPCREATE])
)
(DECLARE: DOCOPY DONTEVAL@LOAD
(INITIALIZEDISPLAYSTREAMS)
(DISPLAYSTREAMINIT 1000)
)
(PUTPROPS LLDISPLAY COPYRIGHT ("Xerox Corporation" 1981 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (6031 8478 (DSPXOFFSET 6041 . 6914) (\FBITMAPBIT 6916 . 7447) (INITBITMASKS 7449 . 8476)
) (9267 9761 (\CreateCursorBitMap 9277 . 9759)) (9873 47751 (BITBLT 9883 . 26495) (\BITBLTSUB 26497 .
32537) (\GETPILOTBBTSCRATCHBM 32539 . 33213) (BITMAPCOPY 33215 . 33772) (BITMAPCREATE 33774 . 34813) (
BITMAPBIT 34815 . 39060) (BLTCHAR 39062 . 41296) (\SLOWBLTCHAR 41298 . 46089) (TEXTUREP 46091 . 46325)
(INVERT.TEXTURE 46327 . 46578) (INVERT.TEXTURE.BITMAP 46580 . 47749)) (50404 57815 (\PILOTBITBLT
50414 . 57813)) (57994 61882 (DISPLAYSTREAMP 58004 . 58165) (DSPOPERATION 58167 . 59005) (
DSPSOURCETYPE 59007 . 59844) (DSPXPOSITION 59846 . 60672) (DSPYPOSITION 60674 . 61134) (DSPYOFFSET
61136 . 61880)) (61883 74285 (DSPCLIPPINGREGION 61893 . 62768) (DSPCREATE 62770 . 63844) (
DSPDESTINATION 63846 . 64325) (DSPFONT 64327 . 66069) (DSPTEXTURE 66071 . 66460) (
\DISPLAYSTREAMINCRXPOSITION 66462 . 66800) (\SFFixDestination 66802 . 68271) (\SFFixClippingRegion
68273 . 69818) (\SFFixFont 69820 . 71526) (\SFFIXLINELENGTH 71528 . 72397) (\SFFixY 72399 . 74283)) (
77389 81620 (TTYDISPLAYSTREAM 77399 . 81618)) (81854 89430 (DSPLINEFEED 81864 . 82413) (DSPLEFTMARGIN
82415 . 83079) (DSPRIGHTMARGIN 83081 . 84023) (DSPRESET 84025 . 85551) (DSPSCROLL 85553 . 86098) (
CHANGETTYDEVICE 86100 . 88549) (OUTPUTDSP 88551 . 89085) (PAGEHEIGHT 89087 . 89428)) (89511 99363 (
\DSPPRINTCHAR 89521 . 93063) (\DSPPRINTCR/LF 93065 . 99361)) (99364 100298 (\FLASHCARET? 99374 . 99821
) (\TTYBACKGROUND 99823 . 100296)) (100299 102250 (DSPBACKUP 100309 . 102248)) (102506 102651 (
COLORDISPLAYP 102516 . 102649)) (102652 105063 (DISPLAYBEFOREEXIT 102662 . 103353) (DISPLAYAFTERENTRY
103355 . 105061)) (105371 109078 (\DSPCLIPTRANSFORMX 105381 . 105902) (\DSPCLIPTRANSFORMY 105904 .
106492) (\DSPTRANSFORMREGION 106494 . 107024) (\DSPUNTRANSFORMY 107026 . 107349) (\DSPUNTRANSFORMX
107351 . 107674) (\OFFSETCLIPPINGREGION 107676 . 109076)) (109992 112253 (UPDATESCREENWIDTH 110002 .
110261) (SCREENRASTERWIDTH 110263 . 110427) (\CreateScreenBitMap 110429 . 112251)) (112469 115907 (
DISPLAYSTREAMINIT 112479 . 114529) (\STARTDISPLAY 114531 . 115372) (\STOPDISPLAY 115374 . 115905)) (
116524 117198 (INITIALIZEDISPLAYSTREAMS 116534 . 117196)))))
STOP