(FILECREATED "17-Feb-84 11:54:08" {PHYLUM}<LISPCORE>SOURCES>LLDISPLAY.;121 114167
changes to: (VARS LLDISPLAYCOMS)
previous date: "16-Feb-84 18:54:00" {PHYLUM}<LISPCORE>SOURCES>LLDISPLAY.;120)
(* Copyright (c) 1981, 1982, 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT LLDISPLAYCOMS)
(RPAQQ LLDISPLAYCOMS [(DECLARE: DONTCOPY (EXPORT (RECORDS PILOTBBT \DISPLAYDATA)
(MACROS \GETDISPLAYDATA)))
(* User-visible records are on ADISPLAY - must be init'ed here)
(INITRECORDS BITMAP PILOTBBT REGION \DISPLAYDATA)
[COMS (* BITMASKS)
(FNS \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
\BLTCHAR \SLOWBLTCHAR TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH)
(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 (* display stream functions)
(FNS DISPLAYSTREAMP DSPOPERATION DSPSOURCETYPE DSPXOFFSET DSPYOFFSET)
(FNS DSPCLIPPINGREGION DSPCREATE DSPDESTINATION DSPTEXTURE \DISPLAYSTREAMINCRXPOSITION
\SFFixDestination \SFFixClippingRegion \SFFixFont \SFFIXLINELENGTH \SFFixY)
(FNS \DSPFONT.DISPLAY \DSPLINEFEED.DISPLAY \DSPLEFTMARGIN.DISPLAY
\DSPRIGHTMARGIN.DISPLAY \DSPXPOSITION.DISPLAY \DSPYPOSITION.DISPLAY)
(EXPORT (MACROS \DDMARKUNFONTED \DDHASFONT))
(P (MOVD? (QUOTE \ILLEGAL.ARG)
(QUOTE \COERCETODS))
(MOVD? (QUOTE NILL)
(QUOTE WFROMDS))
(MOVD? (QUOTE NILL)
(QUOTE WINDOWP))
(MOVD? (QUOTE NILL)
(QUOTE INVERTW]
[COMS (* Stub for window package)
[DECLARE: DOCOPY (DECLARE: EVAL@LOADWHEN (EQ (SYSTEMTYPE)
(QUOTE D))
(INITVARS (\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 \REMOVEDRIBBLECHECK \ADDDRIBBLECHECK)
(EXPORT (MACROS TTYDISPLAYSTREAM))
(FNS 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])
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
[DECLARE: EVAL@COMPILE
(DATATYPE PILOTBBT ((PBTDESTLO WORD)
(PBTDESTHI WORD)
(PBTDESTBIT WORD) (* Destination bit address)
(PBTDESTBPL SIGNEDWORD) (* Destination bits per line -- distance in bits to move
between items)
(PBTSOURCELO WORD)
(PBTSOURCEHI WORD)
(PBTSOURCEBIT WORD) (* Source bit address)
(PBTSOURCEBPL SIGNEDWORD) (* Source bits per line)
(PBTWIDTH WORD) (* Width of an item in bits)
(PBTHEIGHT WORD) (* Number of items -- height in scanlines)
(PBTFLAGS WORD)
(NIL 5 WORD) (* Unused, needed to make 16-alignment)
)
(BLOCKRECORD PILOTBBT ((NIL 7 WORD)
(NIL BITS 4) (* Overlay on PBTSOURCEBPL when PBTUSEGRAY)
(PBTGRAYOFFSET BITS 4) (* Offset in gray block where BITBLT should start)
(PBTGRAYWIDTHLESSONE BITS 4)
(* Width-1 of gray block in words)
(PBTGRAYHEIGHTLESSONE BITS 4)
(* Height-1 of gray block)
(NIL 2 WORD) (* Overlay on PBTFLAGS ...)
(PBTBACKWARD FLAG)
(PBTDISJOINT FLAG)
(PBTDISJOINTITEMS FLAG)
(PBTUSEGRAY FLAG)
(PBTSOURCETYPE BITS 1)
(PBTOPERATION BITS 2)
(NIL BITS 9)))
[ACCESSFNS PILOTBBT ([PBTSOURCE (\VAG2 (fetch PBTSOURCEHI of DATUM)
(fetch PBTSOURCELO of DATUM))
(PROGN (replace PBTSOURCEHI of DATUM
with (\HILOC NEWVALUE))
(replace PBTSOURCELO of DATUM
with (\LOLOC NEWVALUE]
(PBTDEST (\VAG2 (fetch PBTDESTHI of DATUM)
(fetch PBTDESTLO of DATUM))
(PROGN (replace PBTDESTHI of DATUM with (\HILOC NEWVALUE))
(replace PBTDESTLO of DATUM with (\LOLOC NEWVALUE]
(SYSTEM))
(DATATYPE \DISPLAYDATA (DDXPOSITION DDYPOSITION DDXOFFSET DDYOFFSET DDDestination DDClippingRegion
DDFONT DDSlowPrintingCase DDWIDTHSCACHE
(* array of the distance to be moved in X when each
character is printed.)
DDOFFSETSCACHE DDCOLOR DDLINEFEED DDRightMargin DDLeftMargin
DDScroll DDOPERATION DDSOURCETYPE (DDClippingLeft WORD)
(DDClippingRight WORD)
(DDClippingBottom WORD)
(DDClippingTop WORD)
(DDTexture WORD)
(DDHELDFLG FLAG)
(XWINDOWHINT XPOINTER)
(DDPILOTBBT POINTER)
DDXSCALE DDYSCALE DDCHARIMAGEWIDTHS
(* array of image widths for each character)
DDEOLFN DDPAGEFULLFN)
DDPILOTBBT ←(create PILOTBBT
PBTDISJOINT ← T)
DDLeftMargin ← 0 DDRightMargin ← SCREENWIDTH DDXPOSITION ← 0 DDYPOSITION ← 0
DDXOFFSET ← 0 DDYOFFSET ← 0 DDClippingRegion ←(create REGION)
DDDestination ←(SCREENBITMAP)
DDXSCALE ← 1 DDYSCALE ← 1 [ACCESSFNS
((DDFOREGROUNDCOLOR (OR (CAR (fetch (\DISPLAYDATA DDCOLOR) of DATUM))
BLACKCOLOR))
(DDBACKGROUNDCOLOR (OR (CDR (fetch (\DISPLAYDATA DDCOLOR) of DATUM))
WHITECOLOR]
(SYSTEM))
]
(/DECLAREDATATYPE (QUOTE PILOTBBT)
(QUOTE (WORD WORD WORD SIGNEDWORD WORD WORD WORD SIGNEDWORD WORD WORD WORD WORD
WORD WORD WORD WORD)))
(/DECLAREDATATYPE (QUOTE \DISPLAYDATA)
(QUOTE (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)))
(DECLARE: EVAL@COMPILE
(PUTPROPS \GETDISPLAYDATA MACRO [ARGS (COND
[(CADR ARGS)
(SUBPAIR (QUOTE (STRM STRMVAR))
ARGS
(QUOTE (\DTEST (fetch IMAGEDATA
of (SETQ STRMVAR (\OUTSTREAMARG
STRM)))
(QUOTE \DISPLAYDATA]
(T (SUBST (CAR ARGS)
(QUOTE STRM)
(QUOTE (\DTEST (fetch IMAGEDATA
of (\OUTSTREAMARG STRM))
(QUOTE \DISPLAYDATA])
)
(* END EXPORTED DEFINITIONS)
)
(* User-visible records are on ADISPLAY - must be init'ed here)
(/DECLAREDATATYPE (QUOTE BITMAP)
(QUOTE (POINTER WORD WORD WORD WORD)))
(/DECLAREDATATYPE (QUOTE PILOTBBT)
(QUOTE (WORD WORD WORD SIGNEDWORD WORD WORD WORD SIGNEDWORD WORD WORD WORD WORD
WORD WORD WORD WORD)))
(/DECLAREDATATYPE (QUOTE \DISPLAYDATA)
(QUOTE (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)))
(* BITMASKS)
(DEFINEQ
(\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)
(* rmk: "31-AUG-83 11:54")
(DECLARE (LOCALVARS . T))
(PROG ((TEXTURE TEXTURE)
stodx stody left top bottom right DESTDD DESTSTRM SOURCEDD 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 DESTDD (\GETDISPLAYDATA DESTINATIONBITMAP DESTSTRM))
(SETQ DESTINATIONLEFT (\DSPTRANSFORMX (OR DESTINATIONLEFT 0)
DESTDD))
(SETQ DESTINATIONBOTTOM (\DSPTRANSFORMY (OR DESTINATIONBOTTOM 0)
DESTDD))
[PROGN (* compute limits based on clipping regions.)
(SETQ left (fetch DDClippingLeft of DESTDD))
(SETQ bottom (fetch DDClippingBottom of DESTDD))
(SETQ right (fetch DDClippingRight of DESTDD))
(SETQ top (fetch DDClippingTop of DESTDD))
(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)
DESTDD]
[SETQ bottom (IMAX bottom
(SETQ CRBOTTOM
(\DSPTRANSFORMY (fetch BOTTOM
of
CLIPPINGREGION)
DESTDD]
[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 DDDestination
of DESTDD]
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 SOURCEDD (\GETDISPLAYDATA SOURCEBITMAP))
(* do transformations coming out of source)
(SETQ CLIPPEDSOURCELEFT (IMAX (SETQ SOURCELEFT (\DSPTRANSFORMX (OR SOURCELEFT 0)
SOURCEDD))
(fetch DDClippingLeft of SOURCEDD)))
(SETQ CLIPPEDSOURCEBOTTOM (IMAX (SETQ SOURCEBOTTOM (\DSPTRANSFORMY (OR
SOURCEBOTTOM 0)
SOURCEDD))
(fetch DDClippingBottom of SOURCEDD)))
(* limit the WIDTH and HEIGHT by the source dimensions.)
[SETQ WIDTH (COND
(WIDTH (IMIN WIDTH (IDIFFERENCE (fetch DDClippingRight of SOURCEDD)
CLIPPEDSOURCELEFT)))
(T (IDIFFERENCE (fetch DDClippingRight of SOURCEDD)
CLIPPEDSOURCELEFT]
[SETQ HEIGHT (COND
(HEIGHT (IMIN HEIGHT (IDIFFERENCE (fetch DDClippingTop of SOURCEDD)
CLIPPEDSOURCEBOTTOM)))
(T (IDIFFERENCE (fetch DDClippingTop of SOURCEDD)
CLIPPEDSOURCEBOTTOM]
(* if texture is not given, use the display stream's.)
(OR TEXTURE (SETQ TEXTURE (ffetch DDTexture of SOURCEDD)))
(COND
((EQ [SETQ SOURCENBITS (fetch (BITMAP BITMAPBITSPERPIXEL)
of (SETQ SOURCEBITMAP (fetch DDDestination
of SOURCEDD]
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
(DESTSTRM (\INSURETOPWDS DESTSTRM)
(OR OPERATION (SETQ OPERATION (ffetch (\DISPLAYDATA DDOPERATION) of DESTDD]
(* 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)))
(DESTSTRM
(* default texture to background color.)
(DSPBACKCOLOR NIL
DESTSTRM))
(T BLACKCOLOR)))
(TEXTURE (\ILLEGAL.ARG TEXTURE))
(DESTDD (* default texture to background texture.)
(ffetch (\DISPLAYDATA DDTexture)
of DESTDD))
(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. DESTSTRM 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
(DESTSTRM (COLORNUMBERP (fetch (\DISPLAYDATA
DDBACKGROUNDCOLOR)
of DESTDD)))
(T WHITECOLOR))
(COND
(DESTSTRM (COLORNUMBERP (fetch (\DISPLAYDATA
DDFOREGROUNDCOLOR)
of DESTDD)))
(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 "25-Dec-83 15:06")
(* 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)
[COND
(NEWVALUE (* check NEWVALUE before going uninterruptable.)
(COND
((NOT (AND (SMALLPOSP NEWVALUE)
(ILESSP NEWVALUE 16)))
(\ILLEGAL.ARG NEWVALUE]
[.WHILE.TOP.IF.DS.
NIL T (SETQ OLDVALUE (LOGAND (SETQ oldword (\GETBASE bitmapbase 0))
(\4BITMASK X)))
(AND NEWVALUE (\PUTBASE bitmapbase 0
(LOGOR (LOGXOR oldword OLDVALUE)
(LLSH NEWVALUE
(ITIMES 4
(IDIFFERENCE
3
(LOGAND X 3]
(* 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.)
[COND
(NEWVALUE (* check NEWVALUE before going uninterruptable.)
(COND
((NOT (AND (SMALLPOSP NEWVALUE)
(ILESSP NEWVALUE 256)))
(\ILLEGAL.ARG NEWVALUE]
[.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 (PROG (TX TY (DD (\GETDISPLAYDATA BITMAP BITMAP)))
(SETQ TX (\DSPCLIPTRANSFORMX X DD))
(SETQ TY (\DSPCLIPTRANSFORMY Y DD))
(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 DDDestination
of DD)
TX TY NEWVALUE)))
TX)
(T (* anything outside the clipping region returns 0.0)
0])
(BLTCHAR
[LAMBDA (CHARCODE DISPLAYSTREAM) (* rrb " 4-NOV-83 10:44")
(* user entry -
seldom used)
(* 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.)
(\BLTCHAR CHARCODE DISPLAYSTREAM (\GETDISPLAYDATA DISPLAYSTREAM])
(\BLTCHAR
[LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* rrb " 9-Jan-84 19: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.)
(DECLARE (LOCALVARS . T))
(PROG (LOCAL1 RIGHT LEFT CURX)
[COND
((ffetch (\DISPLAYDATA DDSlowPrintingCase) of DISPLAYDATA)
(RETURN (\SLOWBLTCHAR CHARCODE DISPLAYSTREAM]
CRLP[COND
((IGREATERP (SETQ RIGHT (IPLUS (SETQ CURX (ffetch DDXPOSITION of DISPLAYDATA))
(\DSPGETCHARWIDTH CHARCODE DISPLAYDATA)))
(ffetch DDRightMargin of DISPLAYDATA))
(* would go past right margin, force a cr)
(COND
((IGREATERP CURX (ffetch DDLeftMargin of DISPLAYDATA))
(* don't bother CR if position is at left margin anyway.
This also serves to break the loop.)
(\DSPPRINTCR/LF (CHARCODE EOL)
DISPLAYSTREAM) (* reuse the code in the test of this conditional rather
than repeat it here.)
(GO CRLP] (* update the display stream x position.)
(freplace DDXPOSITION of DISPLAYDATA with RIGHT) (* transforms an x coordinate into the destination
coordinate.)
[SETQ CURX (IPLUS CURX (SETQ LOCAL1 (ffetch DDXOFFSET of DISPLAYDATA]
(SETQ RIGHT (IPLUS RIGHT LOCAL1))
(COND
((IGREATERP RIGHT (SETQ LOCAL1 (ffetch DDClippingRight of DISPLAYDATA)))
(* character overlaps right edge of clipping region.)
(SETQ RIGHT LOCAL1)))
(SETQ LEFT (COND
((IGREATERP CURX (SETQ LOCAL1 (ffetch DDClippingLeft of DISPLAYDATA)))
CURX)
(T LOCAL1)))
(RETURN (COND
((AND (ILESSP LEFT RIGHT)
(NEQ (fetch PBTHEIGHT of (SETQ LOCAL1 (ffetch DDPILOTBBT of DISPLAYDATA)))
0))
(.WHILE.TOP.DS. DISPLAYSTREAM (freplace PBTDESTBIT of LOCAL1 with LEFT)
(freplace PBTWIDTH of LOCAL1 with (IDIFFERENCE RIGHT LEFT))
(freplace PBTSOURCEBIT of LOCAL1
with (IDIFFERENCE (IPLUS (\DSPGETCHAROFFSET CHARCODE
DISPLAYDATA)
LEFT)
CURX))
(\PILOTBITBLT LOCAL1 0))
T])
(\SLOWBLTCHAR
[LAMBDA (CHARCODE DISPLAYSTREAM) (* rrb "24-Dec-83 10:56")
(* case of BLTCHAR where either font is rotated or
destination is a color bitmap.
DISPLAYSTREAM is known to be a display stream.)
(PROG (ROTATION (DD (fetch IMAGEDATA of DISPLAYSTREAM)))
(SETQ ROTATION (fetch (FONTDESCRIPTOR ROTATION) of (fetch DDFONT of DD)))
(RETURN
(COND
[(EQ 0 ROTATION)
(PROG (NEWX LEFT RIGHT (CURX (ffetch DDXPOSITION of DD)))
[COND
((IGREATERP (SETQ NEWX (IPLUS CURX (\DSPGETCHARWIDTH CHARCODE DD)))
(ffetch DDRightMargin of DD))
(* past RIGHT margin, force eol)
(\DSPPRINTCR/LF (CHARCODE EOL)
DISPLAYSTREAM)
(SETQ CURX (ffetch DDXPOSITION of DD))
(SETQ NEWX (IPLUS CURX (\DSPGETCHARWIDTH CHARCODE DD]
(* update the x position.)
(freplace DDXPOSITION of DD with NEWX)
(SETQ CURX (\DSPTRANSFORMX CURX DD))
(SETQ LEFT (IMAX (ffetch DDClippingLeft of DD)
CURX))
(SETQ RIGHT (IMIN (ffetch DDClippingRight of DD)
(\DSPTRANSFORMX NEWX DD)))
(RETURN (COND
((AND (ILESSP LEFT RIGHT)
(NEQ (fetch PBTHEIGHT of (SETQ NEWX (ffetch DDPILOTBBT
of DD)))
0))
(SELECTQ (fetch (BITMAP BITMAPBITSPERPIXEL)
of (ffetch (\DISPLAYDATA DDDestination) of DD))
(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 DD)
LEFT)
CURX))
(\PILOTBITBLT NEWX 0)))
(4 (OR (\DDHASFONT DD)
(\DDSETCOLORFONT 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 DD)
2)
LEFT)
(LLSH CURX 2)))
(\PILOTBITBLT NEWX 0)))
(8 (OR (\DDHASFONT DD)
(\DDSETCOLORFONT 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 DD)
3)
LEFT)
(LLSH CURX 3)))
(\PILOTBITBLT NEWX 0)))
(SHOULDNT))
T]
(T (* handle rotated fonts)
(PROG ((YPOS (ffetch DDYPOSITION of DD))
(HEIGHTMOVED (\DSPGETCHARWIDTH CHARCODE DD))
(FONT (ffetch DDFONT of DD)))
(RETURN (COND
((EQ ROTATION 90) (* don't force CR for rotated fonts.)
(\DSPYPOSITION.DISPLAY DISPLAYSTREAM (IPLUS YPOS HEIGHTMOVED))
(* update the display stream x position.)
(BITBLT (fetch (FONTDESCRIPTOR CHARACTERBITMAP) of FONT)
0
(\DSPGETCHAROFFSET CHARCODE DD)
DISPLAYSTREAM
(ADD1 (IDIFFERENCE (ffetch DDXPOSITION of DD)
(FONTASCENT FONT)))
YPOS
(FONTHEIGHT FONT)
HEIGHTMOVED))
((EQ ROTATION 270)
(\DSPYPOSITION.DISPLAY DISPLAYSTREAM (IDIFFERENCE YPOS HEIGHTMOVED)
)
(BITBLT (fetch (FONTDESCRIPTOR CHARACTERBITMAP) of FONT)
0
(\DSPGETCHAROFFSET CHARCODE DD)
DISPLAYSTREAM
(IDIFFERENCE (ffetch DDXPOSITION of DD)
(FONTDESCENT FONT))
(ffetch DDYPOSITION 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])
(BITMAPWIDTH
[LAMBDA (BM) (* rrb "24-Dec-83 12:08")
(* returns the width of a bitmap in pixels)
(COND
((type? BITMAP BM)
(SELECTQ (fetch (BITMAP BITMAPBITSPERPIXEL) of BM)
(1 (ffetch (BITMAP BITMAPWIDTH) of BM))
(4 (LRSH (ffetch (BITMAP BITMAPWIDTH) of BM)
2))
(8 (LRSH (ffetch (BITMAP BITMAPWIDTH) of BM)
3))
(SHOULDNT)))
((WINDOWP BM) (* if it is a window, return the width of its interior.)
(WINDOWPROP BM (QUOTE WIDTH)))
(T (\ILLEGAL.ARG BM])
)
(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 DD)
(\FGETWIDTH (ffetch DDWIDTHSCACHE of DD)
CHARCODE)))
(PUTPROPS \DSPGETCHAROFFSET MACRO ((CHARCODE DD)
(\GETBASE (ffetch DDOFFSETSCACHE of DD)
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)
(* display stream functions)
(DEFINEQ
(DISPLAYSTREAMP
[LAMBDA (X) (* rmk: "31-AUG-83 22:37")
(* Is X a displaystream?)
(AND (type? STREAM X)
(EQMEMB (QUOTE DISPLAY)
(fetch (IMAGEOPS IMAGETYPE) of (fetch (STREAM IMAGEOPS) of X)))
X])
(DSPOPERATION
[LAMBDA (OPERATION DISPLAYSTREAM) (* rmk: "21-AUG-83 22:35")
(* sets the operation field of a display stream)
(PROG ((DD (\GETDISPLAYDATA DISPLAYSTREAM)))
(RETURN (PROG1 (fetch DDOPERATION of DD)
(COND
(OPERATION (OR (FMEMB OPERATION (QUOTE (PAINT REPLACE INVERT ERASE)))
(LISPERROR "ILLEGAL ARG" OPERATION))
(UNINTERRUPTABLY
(freplace DDOPERATION of DD with OPERATION)
(* update other fields that depend on operation.)
(\SETPBTFUNCTION (fetch DDPILOTBBT of DD)
(fetch DDSOURCETYPE of DD)
OPERATION))])
(DSPSOURCETYPE
[LAMBDA (SOURCETYPE DISPLAYSTREAM) (* rmk: "21-AUG-83 22:34")
(* sets the operation field of a display stream)
(PROG ((DD (\GETDISPLAYDATA DISPLAYSTREAM)))
(RETURN (PROG1 (fetch DDSOURCETYPE of DD)
(COND
(SOURCETYPE (OR (FMEMB SOURCETYPE (QUOTE (INPUT INVERT)))
(LISPERROR "ILLEGAL ARG" SOURCETYPE))
(UNINTERRUPTABLY
(freplace DDSOURCETYPE of DD with SOURCETYPE)
(* update other fields that depend on operation.)
(\SETPBTFUNCTION (fetch DDPILOTBBT of DD)
SOURCETYPE
(fetch DDOPERATION of DD)))])
(DSPXOFFSET
[LAMBDA (XOFFSET DISPLAYSTREAM) (* rmk: "22-AUG-83 23:01")
(* coordinate position is stored in 15 bits in the range
-2↑15 to +2↑15.)
(COND
[DISPLAYSTREAM (PROG ((DD (\GETDISPLAYDATA DISPLAYSTREAM)))
(RETURN (PROG1 (fetch DDXOFFSET of DD)
(COND
((NULL XOFFSET))
((NUMBERP XOFFSET)
(UNINTERRUPTABLY
(freplace DDXOFFSET of DD with XOFFSET)
(\SFFixClippingRegion DD)))
(T (\ILLEGAL.ARG XOFFSET]
(T (* check done specially for NIL so that it won't default
to primary output file.)
(\ILLEGAL.ARG DISPLAYSTREAM])
(DSPYOFFSET
[LAMBDA (YOFFSET DISPLAYSTREAM) (* rmk: "21-AUG-83 23:50")
(COND
[DISPLAYSTREAM (PROG ((DD (\GETDISPLAYDATA DISPLAYSTREAM)))
(RETURN (PROG1 (ffetch DDYOFFSET of DD)
(COND
((NULL YOFFSET))
((NUMBERP YOFFSET)
(UNINTERRUPTABLY
(freplace DDYOFFSET of DD with YOFFSET)
(\SFFixClippingRegion DD)
(\SFFixY DD)))
(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) (* rmk: "21-AUG-83 23:57")
(* sets the clipping region of a display stream.)
(COND
[DISPLAYSTREAM (* special check done for NIL to stop default to primary
output file.)
(PROG ((DD (\GETDISPLAYDATA DISPLAYSTREAM)))
(RETURN (PROG1 (ffetch DDClippingRegion of DD)
(COND
(REGION (OR (type? REGION REGION)
(ERROR REGION " is not a REGION."))
(UNINTERRUPTABLY
(freplace DDClippingRegion of DD
with REGION)
(\SFFixClippingRegion DD)
(\SFFixY DD))]
(T (\ILLEGAL.ARG DISPLAYSTREAM])
(DSPCREATE
[LAMBDA (DESTINATION) (* rmk: " 2-SEP-83 11:10")
(* Creates a stream-of-type-display on the DESTINATION
bitmap)
(DECLARE (GLOBALVARS \DISPLAYIMAGEOPS DisplayFDEV))
(PROG [(DSTRM (create STREAM
DEVICE ← DisplayFDEV
ACCESS ←(QUOTE OUTPUT)
OUTCHARFN ←(FUNCTION \DSPPRINTCHAR)
IMAGEOPS ← \DISPLAYIMAGEOPS
IMAGEDATA ←(create \DISPLAYDATA] (* initial x and y positions are 0 when the data is
created.)
(\DSPFONT.DISPLAY DSTRM (DEFAULTFONT (QUOTE DISPLAY)))
(* initialize the core fields that affect the relatively constant fields in the \DISPLAYDATA structure then call
the function DSPFONT which will update that information in the right format.)
(DSPSOURCETYPE (QUOTE INPUT)
DSTRM)
(DSPOPERATION (QUOTE REPLACE)
DSTRM) (* called to cause the updating of the bitblt table from
the fields initialized earlier.)
(DSPDESTINATION (OR DESTINATION (SCREENBITMAP))
DSTRM)
(RETURN DSTRM])
(DSPDESTINATION
[LAMBDA (DESTINATION DISPLAYSTREAM) (* rmk: "25-AUG-83 11:08")
(PROG ((DD (\GETDISPLAYDATA DISPLAYSTREAM DISPLAYSTREAM)))
(RETURN (PROG1 (ffetch DDDestination of DD)
(COND
(DESTINATION (SETQ DESTINATION (\DTEST DESTINATION (QUOTE BITMAP)))
(UNINTERRUPTABLY
(freplace DDDestination of DD with DESTINATION)
(\SFFixDestination DD DISPLAYSTREAM))])
(DSPTEXTURE
[LAMBDA (TEXTURE DISPLAYSTREAM) (* rmk: "23-AUG-83 11:45")
(PROG ((DD (\GETDISPLAYDATA DISPLAYSTREAM)))
(RETURN (PROG1 (fetch DDTexture of DD)
(COND
((NULL TEXTURE))
((FIXP TEXTURE)
(freplace DDTexture of DD with (LOGAND TEXTURE WORDMASK)))
(T (\ILLEGAL.ARG TEXTURE])
(\DISPLAYSTREAMINCRXPOSITION
[LAMBDA (N DD) (* rmk: "23-AUG-83 14:12")
(* increases the x position by N.
This is used internally. Returns the new value.)
(add (fetch DDXPOSITION of DD)
N])
(\SFFixDestination
[LAMBDA (DISPLAYDATA DISPLAYSTREAM) (* rmk: "25-AUG-83 12:35")
(* fixes up those parts of the bitblt array which are
dependent upon the destination)
(PROG ((PBT (ffetch DDPILOTBBT of DISPLAYDATA))
(BM (ffetch DDDestination of DISPLAYDATA)))
(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 (DISPLAYDATA DDRightMargin) of DISPLAYDATA with
(COND (COLOR? (IQUOTIENT (ffetch BITMAPWIDTH of BM) (ffetch (COLORBITMAP COLORBITSPERPIXEL) of COLOR?)))
(T (ffetch (BITMAP BITMAPWIDTH) of BM)))))
(\SFFixClippingRegion DISPLAYDATA)
(\SFFixY DISPLAYDATA) (* if destination from a black and white to a color
bitmap the font will have to change also.)
(\SFFixFont DISPLAYSTREAM DISPLAYDATA)
(RETURN])
(\SFFixClippingRegion
[LAMBDA (DISPLAYDATA) (* rmk: "21-AUG-83 23:58")
(* 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 DDClippingRegion of DISPLAYDATA))
(BM (ffetch DDDestination of DISPLAYDATA)))
[freplace DDClippingRight of DISPLAYDATA
with (IMAX 0 (IMIN (\DSPTRANSFORMX (IPLUS (ffetch LEFT of CLIPREG)
(ffetch WIDTH of CLIPREG))
DISPLAYDATA)
(IQUOTIENT (ffetch (BITMAP BITMAPWIDTH) of BM)
(fetch (BITMAP BITMAPBITSPERPIXEL) of BM]
(freplace DDClippingLeft of DISPLAYDATA with (IMIN (IMAX (\DSPTRANSFORMX (ffetch LEFT
of CLIPREG)
DISPLAYDATA)
0)
MAX.SMALL.INTEGER))
[freplace DDClippingTop of DISPLAYDATA
with (IMAX 0 (IMIN (\DSPTRANSFORMY (IPLUS (ffetch BOTTOM of CLIPREG)
(ffetch HEIGHT of CLIPREG))
DISPLAYDATA)
(ffetch BITMAPHEIGHT of BM]
(freplace DDClippingBottom of DISPLAYDATA
with (IMIN (IMAX (\DSPTRANSFORMY (ffetch BOTTOM of CLIPREG)
DISPLAYDATA)
0)
MAX.SMALL.INTEGER])
(\SFFixFont
[LAMBDA (DISPLAYSTREAM DISPLAYDATA) (* rmk: "24-AUG-83 10:31")
(* used to fix up those parts of the bitblt table which
depend upon the FONT. DISPLAYDATA is the IMAGEDATA for
DISPLAYSTREAM, for convenience.)
[PROG [(PBT (ffetch DDPILOTBBT of DISPLAYDATA))
(FONT (ffetch DDFONT of DISPLAYDATA))
FONTBITMAP
(NBITS (fetch (BITMAP BITMAPBITSPERPIXEL) of (fetch DDDestination of DISPLAYDATA]
(SETQ FONTBITMAP (fetch CHARACTERBITMAP of FONT))
(replace DDWIDTHSCACHE of DISPLAYDATA 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.)
(\DDMARKUNFONTED DISPLAYDATA))
(T (replace DDOFFSETSCACHE of DISPLAYDATA with (fetch (ARRAYP BASE)
of (fetch \SFOffsets of FONT)))
(replace PBTSOURCEBPL of PBT with (UNFOLD (fetch BITMAPRASTERWIDTH of FONTBITMAP)
BITSPERWORD]
(replace DDSlowPrintingCase of DISPLAYDATA with (OR (NEQ NBITS 1)
(NEQ (fetch (FONTDESCRIPTOR ROTATION)
of FONT)
0]
(\SFFixY DISPLAYDATA)
(\SFFIXLINELENGTH DISPLAYSTREAM])
(\SFFIXLINELENGTH
[LAMBDA (DISPLAYSTREAM) (* rmk: "23-AUG-83 11:55")
(* DISPLAYSTREAM is known to be a stream of type display. Called by RIGHTMARGIN LEFTMARGIN and \SFFIXFONT to
update the LINELENGTH field in the stream. also called when the display stream is created.)
(PROG (LLEN (DD (fetch IMAGEDATA of DISPLAYSTREAM)))
(replace (STREAM LINELENGTH) of DISPLAYSTREAM
with (COND
((IGREATERP (SETQ LLEN (IQUOTIENT (IDIFFERENCE (fetch (\DISPLAYDATA DDRightMargin)
of DD)
(fetch (\DISPLAYDATA DDLeftMargin)
of DD))
(CHARWIDTH (CHARCODE A)
DISPLAYSTREAM)))
1)
LLEN)
(T 10])
(\SFFixY
[LAMBDA (DISPLAYDATA) (* rmk: "21-AUG-83 23:48")
(* makes that part of the bitblt table 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 DISPLAYDATA has already been type checked.)
(PROG ((PBT (ffetch DDPILOTBBT of DISPLAYDATA))
(FONT (ffetch DDFONT of DISPLAYDATA))
(Y (\DSPTRANSFORMY (ffetch DDYPOSITION of DISPLAYDATA)
DISPLAYDATA))
TOP CHARTOP BM)
(SETQ CHARTOP (IPLUS Y (ffetch \SFAscent of FONT)))
[freplace PBTDEST of PBT with (\ADDBASE (fetch BITMAPBASE of (SETQ BM
(ffetch DDDestination
of DISPLAYDATA)))
(ITIMES (ffetch BITMAPRASTERWIDTH of BM)
(\SFInvert BM
(SETQ TOP
(IMAX (IMIN (ffetch
DDClippingTop
of DISPLAYDATA)
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 DDClippingBottom
of DISPLAYDATA)))
0])
)
(DEFINEQ
(\DSPFONT.DISPLAY
[LAMBDA (DISPLAYSTREAM FONT) (* rrb " 5-Dec-83 12:57")
(* sets the font that a display stream uses to print
characters. DISPLAYSTREAM is guaranteed to be a stream
of type display)
(PROG (XFONT OLDFONT NBITS (DD (fetch IMAGEDATA of DISPLAYSTREAM)))
(* save old value to return, smash new value and update
the bitchar portion of the record.)
(RETURN (PROG1 (SETQ OLDFONT (fetch DDFONT of DD))
(COND
(FONT (SETQ XFONT (OR (\GETFONTDESC FONT (QUOTE DISPLAY)
T)
(FONTCOPY (ffetch DDFONT of DD)
FONT)))
(* updating font information is fairly expensive
operation. Don't bother unless font has changed.)
[COND
((NEQ (SETQ NBITS (ffetch (BITMAP BITMAPBITSPERPIXEL)
of (ffetch (\DISPLAYDATA DDDestination)
of DD)))
1) (* color case, create a font with the current foreground
and background colors.)
(SETQ XFONT (\GETCOLORFONT XFONT (DSPCOLOR NIL DISPLAYSTREAM)
(DSPBACKCOLOR NIL DISPLAYSTREAM)
NBITS]
(OR (EQ XFONT OLDFONT)
(UNINTERRUPTABLY
(freplace DDFONT of DD with XFONT)
(freplace DDLINEFEED of DD
with (IMINUS (fetch \SFHeight of XFONT)))
(\SFFixFont DISPLAYSTREAM DD))])
(\DSPLINEFEED.DISPLAY
[LAMBDA (DISPLAYSTREAM DELTAY) (* rmk: " 2-SEP-83 10:56")
(* sets the amount that a line feed increases the y
coordinate by.)
(PROG ((DD (fetch IMAGEDATA of DISPLAYSTREAM)))
(RETURN (PROG1 (ffetch DDLINEFEED of DD)
(AND DELTAY (COND
((NUMBERP DELTAY)
(freplace DDLINEFEED of DD with DELTAY))
(T (\ILLEGAL.ARG DELTAY])
(\DSPLEFTMARGIN.DISPLAY
[LAMBDA (DISPLAYSTREAM XPOSITION) (* rmk: " 2-SEP-83 10:56")
(* sets the xposition that a carriage return returns
to.)
(PROG ((DD (fetch IMAGEDATA of DISPLAYSTREAM)))
(RETURN (PROG1 (ffetch DDLeftMargin of DD)
(AND XPOSITION (COND
((AND (SMALLP XPOSITION)
(IGREATERP XPOSITION -1))
(UNINTERRUPTABLY
(freplace DDLeftMargin of DD with XPOSITION)
(\SFFIXLINELENGTH DISPLAYSTREAM)))
(T (\ILLEGAL.ARG XPOSITION])
(\DSPRIGHTMARGIN.DISPLAY
[LAMBDA (DISPLAYSTREAM XPOSITION) (* rmk: " 2-SEP-83 10:56")
(* Sets the right margin that determines when a cr is
inserted by print.)
(PROG (OLDRM (DD (fetch IMAGEDATA of DISPLAYSTREAM)))
(SETQ OLDRM (ffetch DDRightMargin of DD))
(COND
((NULL XPOSITION))
[(AND (SMALLP XPOSITION)
(IGREATERP XPOSITION -1)) (* Avoid fixing linelength if right margin hasn't
changed.)
(OR (EQ XPOSITION OLDRM)
(UNINTERRUPTABLY
(freplace DDRightMargin of DD with XPOSITION)
(\SFFIXLINELENGTH DISPLAYSTREAM))]
(T (\ILLEGAL.ARG XPOSITION)))
(RETURN OLDRM])
(\DSPXPOSITION.DISPLAY
[LAMBDA (DISPLAYSTREAM XPOSITION) (* rmk: " 2-SEP-83 10:56")
(* coordinate position is stored in 15 bits in the range
-2↑15 to +2↑15.)
(PROG ((DD (fetch IMAGEDATA of DISPLAYSTREAM)))
(RETURN (PROG1 (fetch DDXPOSITION of DD)
(COND
((NULL XPOSITION))
((NUMBERP XPOSITION)
(freplace DDXPOSITION of DD with XPOSITION)
(* reset the charposition field so that PRINT etc. won't
put out eols.)
(freplace (STREAM CHARPOSITION) of DISPLAYSTREAM with 0))
(T (\ILLEGAL.ARG XPOSITION])
(\DSPYPOSITION.DISPLAY
[LAMBDA (DISPLAYSTREAM YPOSITION) (* rmk: " 2-SEP-83 10:57")
(PROG ((DD (fetch IMAGEDATA of DISPLAYSTREAM)))
(RETURN (PROG1 (ffetch DDYPOSITION of DD)
(COND
((NULL YPOSITION))
((NUMBERP YPOSITION)
(UNINTERRUPTABLY
(freplace DDYPOSITION of DD with YPOSITION)
(\SFFixY DD)))
(T (\ILLEGAL.ARG YPOSITION])
)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS \DDMARKUNFONTED MACRO ((DD)
(freplace (\DISPLAYDATA DDOFFSETSCACHE) of DD with NIL)))
(PUTPROPS \DDHASFONT MACRO ((DD)
(ffetch (\DISPLAYDATA DDOFFSETSCACHE) of DD)))
)
(* END EXPORTED DEFINITIONS)
(MOVD? (QUOTE \ILLEGAL.ARG)
(QUOTE \COERCETODS))
(MOVD? (QUOTE NILL)
(QUOTE WFROMDS))
(MOVD? (QUOTE NILL)
(QUOTE WINDOWP))
(MOVD? (QUOTE NILL)
(QUOTE INVERTW))
(* Stub for window package)
(DECLARE: DOCOPY
(DECLARE: EVAL@LOADWHEN (EQ (SYSTEMTYPE)
(QUOTE D))
(RPAQ? \TOPWDS )
(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) (* lmm " 5-OCT-83 18:08")
(* Makes DISPLAYSTREAM be the ttydisplaystream)
(DECLARE (GLOBALVARS \DEFAULTTTYDISPLAYSTREAM))
(COND
((NULL DISPLAYSTREAM) (* this case normally macros out)
TtyDisplayStream)
(T (SETQ DISPLAYSTREAM (OR (DISPLAYSTREAMP (\OUTSTREAMARG DISPLAYSTREAM))
(\ILLEGAL.ARG DISPLAYSTREAM)))
(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 NIL)
(\REMOVEDRIBBLECHECK \TERM.OFD)
(* Change the outcharfn back to an ordinary display)
(PROG ((WIN (WFROMDS TtyDisplayStream)))
(AND WIN (WINDOWPROP WIN (QUOTE \LINEBUF.OFD)
\LINEBUF.OFD]
(* * Now install the new one.)
(replace FULLFILENAME of DISPLAYSTREAM with T)
[COND
((NEQ DISPLAYSTREAM \DEFAULTTTYDISPLAYSTREAM)
(COND
(\DRIBBLE.OFD (\ADDDRIBBLECHECK DISPLAYSTREAM]
(* if old T was the primary output, change it to the new
ttydisplaystream.)
(COND
((EQ \PRIMOUT.OFD \TERM.OFD)
(SETQ \PRIMOUT.OFD DISPLAYSTREAM)))
(SETQ \TERM.OFD DISPLAYSTREAM) (* save and restore line buffer from the displaystream
window if any.)
(COND
([EQ \PRIMIN.OFD (PROG1 \LINEBUF.OFD
(PROG ((WIN (WFROMDS DISPLAYSTREAM)))
(SETQ \LINEBUF.OFD
(OR [COND
(WIN (WINDOWPROP WIN (QUOTE PROCESS)
(THIS.PROCESS))
(* For the PROC world to worry about tty moving)
(WINDOWPROP WIN (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.)
[PROG ((DD (fetch IMAGEDATA of DISPLAYSTREAM)))
(PAGEHEIGHT (IQUOTIENT (IDIFFERENCE (fetch DDClippingTop of DD)
(fetch DDClippingBottom of DD))
(IABS (ffetch DDLINEFEED of DD])])
(\REMOVEDRIBBLECHECK
[LAMBDA (DISPLAYSTREAM) (* rmk: " 8-NOV-83 19:44")
(PROG [(OC (LISTGET (fetch OTHERPROPS of DISPLAYSTREAM)
(QUOTE \OUTCHAR]
(COND
(OC (replace OUTCHARFN of DISPLAYSTREAM with OC)
(replace OTHERPROPS of DISPLAYSTREAM with (LISTPUT (fetch OTHERPROPS of DISPLAYSTREAM)
(QUOTE \OUTCHAR)
NIL])
(\ADDDRIBBLECHECK
[LAMBDA (DISPLAYSTREAM) (* rmk: " 8-NOV-83 19:41")
(push (fetch OTHERPROPS of DISPLAYSTREAM)
(QUOTE \OUTCHAR)
(fetch OUTCHARFN of DISPLAYSTREAM))
(replace OUTCHARFN of DISPLAYSTREAM with (FUNCTION \TTYOUTCHARFN])
)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS TTYDISPLAYSTREAM MACRO [X (COND
((NULL (CAR X))
(QUOTE TtyDisplayStream))
(T (QUOTE IGNOREMACRO])
)
(* END EXPORTED DEFINITIONS)
(DEFINEQ
(DSPRESET
[LAMBDA (DISPLAYSTREAM) (* edited: " 2-SEP-83 14:19")
(DECLARE (GLOBALVARS \CURRENTDISPLAYLINE)) (* resets a display stream)
(PROG [CREG FONT FONTASCENT (DD (\DTEST (fetch IMAGEDATA of (SETQ DISPLAYSTREAM (\OUTSTREAMARG
DISPLAYSTREAM)))
(QUOTE \DISPLAYDATA]
(SETQ CREG (ffetch DDClippingRegion of DD))
(SETQ FONT (fetch DDFONT of DD))
(SETQ FONTASCENT (FONTASCENT FONT))
(SELECTQ (fetch (FONTDESCRIPTOR ROTATION) of FONT)
[0 (\DSPXPOSITION.DISPLAY DISPLAYSTREAM (ffetch DDLeftMargin of DD))
(\DSPYPOSITION.DISPLAY DISPLAYSTREAM (ADD1 (IDIFFERENCE (fetch TOP
of CREG)
FONTASCENT]
(90 (\DSPXPOSITION.DISPLAY DISPLAYSTREAM (IPLUS (fetch LEFT of CREG)
FONTASCENT))
(\DSPYPOSITION.DISPLAY DISPLAYSTREAM (fetch BOTTOM of CREG)))
(270 (\DSPXPOSITION.DISPLAY DISPLAYSTREAM (IDIFFERENCE (fetch RIGHT of CREG)
FONTASCENT))
(\DSPYPOSITION.DISPLAY DISPLAYSTREAM (fetch TOP of CREG)))
(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 DDTexture of DD))
(COND
((EQ (TTYDISPLAYSTREAM)
DISPLAYSTREAM)
(SETQ \CURRENTDISPLAYLINE 0])
(DSPSCROLL
[LAMBDA (SWITCHSETTING DISPLAYSTREAM) (* rmk: "23-AUG-83 13:02")
(* 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 ((DD (\GETDISPLAYDATA DISPLAYSTREAM)))
(RETURN (PROG1 (OR (ffetch DDScroll of DD)
(QUOTE OFF))
(AND SWITCHSETTING (freplace DDScroll of DD with (NEQ SWITCHSETTING
(QUOTE OFF])
(CHANGETTYDEVICE
[LAMBDA (NEWTTYDEVICE) (* rmk: "23-AUG-83 13:04")
(* 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 \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 NIL)
(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------"]
[(DISPLAYSTREAMP (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: "31-AUG-83 16:27")
(* 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.)
(DISPLAYSTREAMP (\OUTSTREAMARG FILE])
(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 " 4-NOV-83 10:56")
(* Displays the character and increments the Xposition.
STREAM is guaranteed to be of type display.)
(\CHECKCARET STREAM)
(PROG ((DD (fetch IMAGEDATA of STREAM)))
(SELECTC (fetch CCECHO of (\SYNCODE \PRIMTERMSA CHARCODE))
[INDICATE.CCE (PROG ((CC CHARCODE))
(add (fetch CHARPOSITION of STREAM)
(IPLUS (COND
((IGREATERP CC 127)
(* META character)
(\BLTCHAR (CHARCODE #)
STREAM DD)
(SETQ CC (LOGAND CC 127))
1)
(T 0))
(COND
((ILESSP CC 32)
(* CONTROL character)
(\BLTCHAR (CHARCODE ↑)
STREAM DD)
(SETQ CC (LOGOR CC 64))
1)
(T 0))
(PROGN (\BLTCHAR CC STREAM DD)
1]
[SIMULATE.CCE
(SELCHARQ CHARCODE
((EOL CR LF)
(\DSPPRINTCR/LF CHARCODE STREAM)
(replace CHARPOSITION of STREAM with 0))
(ESCAPE (\BLTCHAR (CHARCODE $)
STREAM DD)
(add (fetch CHARPOSITION of STREAM)
1))
[BELL (* make switching of bits uninterruptable but allow
interrupts between flashes.)
(SELECTQ (MACHINETYPE)
[DANDELION (PLAYTUNE (QUOTE ((880 . 2500]
(FLASHWINDOW (WFROMDS STREAM]
[TAB (PROG (TABWIDTH (SPACEWIDTH (CHARWIDTH (CHARCODE SPACE)
STREAM)))
(SETQ TABWIDTH (UNFOLD SPACEWIDTH 8))
(COND
((IGREATERP (\DISPLAYSTREAMINCRXPOSITION
(SETQ TABWIDTH
(IDIFFERENCE TABWIDTH
(MOD (IDIFFERENCE
(fetch DDXPOSITION
of DD)
(ffetch DDLeftMargin
of DD))
TABWIDTH)))
DD)
(ffetch DDRightMargin of DD))
(* tab was past rightmargin, force cr.)
(\DSPPRINTCR/LF (CHARCODE EOL)
STREAM)))
(* return the number of spaces taken.)
(add (fetch CHARPOSITION of STREAM)
(IQUOTIENT TABWIDTH SPACEWIDTH]
(PROGN (* this case was copied from \DSCCOUT.)
(\BLTCHAR CHARCODE STREAM DD)
(add (fetch CHARPOSITION of STREAM)
1]
[REAL.CCE (SELECTC CHARCODE
((CHARCODE (EOL CR LF))
(\DSPPRINTCR/LF CHARCODE STREAM)
(replace CHARPOSITION of STREAM with 0))
(ERASECHARCODE (DSPBACKUP (CHARWIDTH (CHARCODE A)
STREAM)
STREAM)
(* line buffering routines have already taken care of
backing up the position)
0)
(PROGN (\BLTCHAR CHARCODE STREAM DD)
(add (fetch CHARPOSITION of STREAM)
1]
(IGNORE.CCE)
(SHOULDNT])
(\DSPPRINTCR/LF
[LAMBDA (CHARCODE DS) (* edited: " 2-SEP-83 14:21")
(* 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 FONT (DD (fetch IMAGEDATA of DS)))
(SETQ ROTATION (COND
((fetch DDSlowPrintingCase of DD)
(fetch (FONTDESCRIPTOR ROTATION) of (fetch DDFONT of DD)))
(T 0)))
(COND
((EQ ROTATION 0)
[COND
((EQ CHARCODE (CHARCODE EOL)) (* on LF, no change in X)
(\DSPXPOSITION.DISPLAY DS (ffetch DDLeftMargin of DD]
(SETQ Y (IPLUS (ffetch DDYPOSITION of DD)
(ffetch DDLINEFEED of DD)))
[COND
((AND (fetch DDScroll of DD)
(IGREATERP (SETQ AMOUNT/BELOW (IDIFFERENCE (IPLUS (SETQ BTM
(fetch DDClippingBottom
of DD))
(fetch \SFDescent
of (fetch DDFONT
of DD)))
(\DSPTRANSFORMY Y DD)))
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 DDClippingLeft of DD))
WDTH BKGRND (DBITMAP (fetch DDDestination of DD))
(HGHT (IDIFFERENCE (ffetch DDClippingTop of DD)
BTM)))
(SETQ WDTH (IDIFFERENCE (fetch DDClippingRight of DD)
LFT))
[SETQ BKGRND (COND
((NEQ (fetch (BITMAP BITMAPBITSPERPIXEL) of DBITMAP)
1) (* this is a color case.)
(DSPBACKCOLOR NIL DS))
(T (ffetch DDTexture of DD]
(.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.DISPLAY DS Y))
(T (PROG ((CLIPREG (ffetch DDClippingRegion of DD))
X)
[COND
((EQ CHARCODE (CHARCODE EOL)) (* on LF, no change in X)
(\DSPYPOSITION.DISPLAY DS (SELECTQ ROTATION
(90 (fetch (REGION BOTTOM) of CLIPREG))
(270 (fetch (REGION TOP) of CLIPREG))
(ERROR
"Only rotations supported are 0, 90 and 270"]
[SETQ X (IPLUS (fetch DDXPOSITION of DD)
(SELECTQ ROTATION
(90 (IMINUS (ffetch DDLINEFEED of DD)))
(270 (ffetch DDLINEFEED of DD))
(ERROR "Only rotations supported are 0, 90 and 270"]
[COND
((AND (fetch DDScroll of DD)
(SELECTQ ROTATION
(90 (IGREATERP [SETQ AMOUNT/BELOW
(IDIFFERENCE (\DSPTRANSFORMX X DD)
(IDIFFERENCE (fetch
DDClippingRight
of DD)
(fetch \SFDescent
of (fetch DDFONT
of DD]
0))
(270 (IGREATERP (SETQ AMOUNT/BELOW
(IDIFFERENCE (IPLUS (fetch DDClippingLeft
of DD)
(fetch \SFDescent
of (fetch DDFONT
of DD)))
(\DSPTRANSFORMX X DD)))
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 DDClippingLeft of DD))
WDTH BKGRND (DBITMAP (fetch DDDestination of DD))
HGHT KEPTWIDTH)
(SETQ BTM (fetch DDClippingBottom of DS))
(SETQ HGHT (IDIFFERENCE (ffetch DDClippingTop of DD)
BTM))
(SETQ WDTH (IDIFFERENCE (fetch DDClippingRight of DD)
LFT))
[SETQ BKGRND (COND
((NEQ (fetch (BITMAP BITMAPBITSPERPIXEL) of DBITMAP)
1) (* this is a color case.)
(DSPBACKCOLOR NIL DS))
(T (ffetch DDTexture of DD]
(.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.DISPLAY DS X])
)
(DEFINEQ
(\FLASHCARET?
[LAMBDA (DS) (* rrb "14-OCT-83 15:51")
(* 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))
T])
(\TTYBACKGROUND
[LAMBDA NIL (* bvm: "24-OCT-83 17:27")
(* 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)
(PROCESS.PREPARE.FOR.INPUT))
(for X in TTYBACKGROUNDFNS do (APPLY* X))
(\BACKGROUND])
)
(DEFINEQ
(DSPBACKUP
[LAMBDA (WIDTH DISPLAYSTREAM) (* rmk: "30-AUG-83 10:34")
(PROG (FONT ROTATION BLTWIDTH (DD (\GETDISPLAYDATA DISPLAYSTREAM DISPLAYSTREAM)))
(* turn caret off if necessary)
[SETQ BLTWIDTH (IMIN WIDTH (IDIFFERENCE (fetch DDXPOSITION of DD)
(ffetch DDLeftMargin of DD]
(SETQ FONT (fetch DDFONT of DD))
(SETQ ROTATION (COND
((fetch DDSlowPrintingCase of DD)
(fetch (FONTDESCRIPTOR ROTATION) of FONT))
(T 0)))
(RETURN (COND
((IGREATERP BLTWIDTH 0)
(\CHECKCARET DISPLAYSTREAM)
[COND
((EQ ROTATION 0)
(BITBLT NIL 0 0 DISPLAYSTREAM (\DISPLAYSTREAMINCRXPOSITION (IMINUS BLTWIDTH)
DD)
(IDIFFERENCE (ffetch DDYPOSITION of DD)
(FONTDESCENT FONT))
BLTWIDTH
(FONTHEIGHT FONT)
(QUOTE TEXTURE)
(QUOTE REPLACE)))
((EQ ROTATION 90)
(BITBLT NIL 0 0 DISPLAYSTREAM (IDIFFERENCE (fetch DDXPOSITION of DD)
(FONTASCENT FONT))
(add (fetch DDYPOSITION of DD)
(IMINUS BLTWIDTH))
(FONTHEIGHT FONT)
BLTWIDTH
(QUOTE TEXTURE)
(QUOTE REPLACE)))
((EQ ROTATION 270)
(BITBLT NIL 0 0 DISPLAYSTREAM (IDIFFERENCE (fetch DDXPOSITION of DD)
(FONTDESCENT FONT))
(add (fetch DDYPOSITION of DD)
BLTWIDTH)
(FONTHEIGHT FONT)
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 (* rrb "16-Feb-84 18:50")
(* 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 DD) (* rmk: "23-AUG-83 15:03")
(* 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 DD)))
(RETURN (AND (NOT (IGREATERP (fetch DDClippingLeft of DD)
TX))
(IGREATERP (fetch DDClippingRight of DD)
TX)
TX])
(\DSPCLIPTRANSFORMY
[LAMBDA (Y DD) (* rmk: "23-AUG-83 15:09")
(* 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 DD))) (* ClippingTop points past the top edge.)
(RETURN (AND (NOT (IGREATERP (fetch DDClippingBottom of DD)
TY))
(IGREATERP (fetch DDClippingTop of DD)
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 DD) (* rmk: "23-AUG-83 14:34")
(* transforms a y coordinate from destination coords
into the display streams)
(IDIFFERENCE Y (fetch DDYOFFSET of DD])
(\DSPUNTRANSFORMX
[LAMBDA (X DD) (* rmk: "23-AUG-83 14:25")
(* transforms a x coordinate from destination coords
into the display streams)
(IDIFFERENCE X (fetch DDXOFFSET of DD])
(\OFFSETCLIPPINGREGION
[LAMBDA (DD OLDREGION) (* rmk: "23-AUG-83 14:32")
(* calculates the clipping region from the displaydata
of a display stream in destination coordinates.
if OLDREGION is given, it is reused.)
(PROG ((CREG (fetch DDClippingRegion of DD)))
(RETURN (COND
(OLDREGION (replace LEFT of OLDREGION with (\DSPTRANSFORMX (fetch LEFT
of CREG)
DD))
(replace BOTTOM of OLDREGION with (\DSPTRANSFORMY (fetch BOTTOM
of CREG)
DD))
(replace WIDTH of OLDREGION with (fetch WIDTH of CREG))
(replace HEIGHT of OLDREGION with (fetch HEIGHT of CREG))
OLDREGION)
((AND (ZEROP (fetch DDXOFFSET of DD))
(ZEROP (fetch DDYOFFSET of DD))) (* special case of no offset to avoid storage creation.)
CREG)
(T (create REGION
LEFT ←(\DSPTRANSFORMX (fetch LEFT of CREG)
DD)
BOTTOM ←(\DSPTRANSFORMY (fetch BOTTOM of CREG)
DD)
WIDTH ←(fetch WIDTH of CREG)
HEIGHT ←(fetch HEIGHT of CREG])
)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS \DSPTRANSFORMX MACRO ((X DD) (* transforms an x coordinate into the destination
coordinate.)
(IPLUS X (fetch DDXOFFSET of DD))))
(PUTPROPS \DSPTRANSFORMY MACRO ((Y DD) (* transforms an y coordinate into the destination
coordinate.)
(IPLUS Y (fetch DDYOFFSET of DD))))
(PUTPROPS \OFFSETBOTTOM MACRO ((X) (* gives the destination coordinate address of the
origin.)
(fetch DDYOFFSET of X)))
(PUTPROPS \OFFSETLEFT MACRO ((DD) (* returns the x origin of display data destination
coordinates.)
(fetch DDXOFFSET of DD)))
)
(* 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) (* rmk: "23-AUG-83 22:22")
(DECLARE (GLOBALVARS \LastTTYLines \TopLevelTtyWindow))
(* starts display and sets N lines for tty at top)
(\STARTDISPLAY)
(PROG (TTYHEIGHT TTYFONTHEIGHT (TTYFONT (DSPFONT NIL TtyDisplayStream)))
(SETQ TTYFONTHEIGHT (FONTHEIGHT TTYFONT))
(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 TTYFONT)
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 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (10099 11671 (\FBITMAPBIT 10109 . 10640) (INITBITMASKS 10642 . 11669)) (12460 12954 (
\CreateCursorBitMap 12470 . 12952)) (13066 52697 (BITBLT 13076 . 29598) (\BITBLTSUB 29600 . 35640) (
\GETPILOTBBTSCRATCHBM 35642 . 36316) (BITMAPCOPY 36318 . 36875) (BITMAPCREATE 36877 . 37916) (
BITMAPBIT 37918 . 42574) (BLTCHAR 42576 . 43063) (\BLTCHAR 43065 . 45779) (\SLOWBLTCHAR 45781 . 50339)
(TEXTUREP 50341 . 50575) (INVERT.TEXTURE 50577 . 50828) (INVERT.TEXTURE.BITMAP 50830 . 51999) (
BITMAPWIDTH 52001 . 52695)) (55338 58950 (DISPLAYSTREAMP 55348 . 55695) (DSPOPERATION 55697 . 56521) (
DSPSOURCETYPE 56523 . 57346) (DSPXOFFSET 57348 . 58213) (DSPYOFFSET 58215 . 58948)) (58951 69685 (
DSPCLIPPINGREGION 58961 . 59824) (DSPCREATE 59826 . 61062) (DSPDESTINATION 61064 . 61563) (DSPTEXTURE
61565 . 61945) (\DISPLAYSTREAMINCRXPOSITION 61947 . 62288) (\SFFixDestination 62290 . 63759) (
\SFFixClippingRegion 63761 . 65269) (\SFFixFont 65271 . 67042) (\SFFIXLINELENGTH 67044 . 67824) (
\SFFixY 67826 . 69683)) (69686 74690 (\DSPFONT.DISPLAY 69696 . 71391) (\DSPLINEFEED.DISPLAY 71393 .
71912) (\DSPLEFTMARGIN.DISPLAY 71914 . 72584) (\DSPRIGHTMARGIN.DISPLAY 72586 . 73427) (
\DSPXPOSITION.DISPLAY 73429 . 74213) (\DSPYPOSITION.DISPLAY 74215 . 74688)) (76903 81018 (
TTYDISPLAYSTREAM 76913 . 80251) (\REMOVEDRIBBLECHECK 80253 . 80693) (\ADDDRIBBLECHECK 80695 . 81016))
(81252 86527 (DSPRESET 81262 . 82888) (DSPSCROLL 82890 . 83433) (CHANGETTYDEVICE 83435 . 85805) (
OUTPUTDSP 85807 . 86182) (PAGEHEIGHT 86184 . 86525)) (86609 96338 (\DSPPRINTCHAR 86619 . 90006) (
\DSPPRINTCR/LF 90008 . 96336)) (96339 97297 (\FLASHCARET? 96349 . 96807) (\TTYBACKGROUND 96809 . 97295
)) (97298 98939 (DSPBACKUP 97308 . 98937)) (99195 99432 (COLORDISPLAYP 99205 . 99430)) (99433 101844 (
DISPLAYBEFOREEXIT 99443 . 100134) (DISPLAYAFTERENTRY 100136 . 101842)) (102153 105831 (
\DSPCLIPTRANSFORMX 102163 . 102684) (\DSPCLIPTRANSFORMY 102686 . 103275) (\DSPTRANSFORMREGION 103277
. 103807) (\DSPUNTRANSFORMY 103809 . 104135) (\DSPUNTRANSFORMX 104137 . 104463) (
\OFFSETCLIPPINGREGION 104465 . 105829)) (106769 109030 (UPDATESCREENWIDTH 106779 . 107038) (
SCREENRASTERWIDTH 107040 . 107204) (\CreateScreenBitMap 107206 . 109028)) (109246 112695 (
DISPLAYSTREAMINIT 109256 . 111317) (\STARTDISPLAY 111319 . 112160) (\STOPDISPLAY 112162 . 112693)) (
113312 113986 (INITIALIZEDISPLAYSTREAMS 113322 . 113984)))))
STOP