(FILECREATED " 3-Oct-86 18:08:24" {ERIS}<LISPCORE>SOURCES>LLDISPLAY.;114 212667 

      changes to:  (FNS BITBLT)

      previous date: "24-Sep-86 18:58:47" {ERIS}<LISPCORE>SOURCES>LLDISPLAY.;112)


(* "
Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT LLDISPLAYCOMS)

(RPAQQ LLDISPLAYCOMS 
       ((DECLARE: DONTCOPY (EXPORT (RECORDS PILOTBBT \DISPLAYDATA DISPLAYSTATE DISPLAYINFO)
                                  (MACROS \GETDISPLAYDATA)))
        (* User-visible records are on ADISPLAY - must be init'ed here)
        (INITRECORDS BITMAP PILOTBBT REGION \DISPLAYDATA)
        [COMS (* BITMASKS)
              (FNS \FBITMAPBIT \NEWPAGE.DISPLAY 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 BLTSHADE \BITBLTSUB \GETPILOTBBTSCRATCHBM BITMAPCOPY BITMAPCREATE BITMAPBIT 
                   BLTCHAR \BLTCHAR \CHANGECHARSET.DISPLAY \INDICATESTRING \SLOWBLTCHAR TEXTUREP 
                   INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH READBITMAP \INSUREBITSPERPIXEL 
                   MAXIMUMCOLOR OPPOSITECOLOR MAXIMUMSHADE OPPOSITESHADE)
              (CONSTANTS (MINIMUMCOLOR 0)
                     (MINIMUMSHADE 0))
              (P (MOVD (QUOTE BITMAPBIT)
                       (QUOTE \BITMAPBIT)))
              (DECLARE: DONTCOPY (MACROS \INVALIDATEDISPLAYCACHE))
              (OPTIMIZERS BITMAPBIT)
              (FNS BITMAPBIT.EXPANDER)
              (FNS \BITBLT.DISPLAY \BITBLT.BITMAP \BITBLT.MERGE \BLTSHADE.DISPLAY \BLTSHADE.BITMAP)
              (DECLARE: DONTCOPY (CONSTANTS (\DisplayWordAlign 16)
                                        (\MaxBitMapWidth 65535)
                                        (\MaxBitMapHeight 65535)
                                        (\MaxBitMapWords 131066))
                     (EXPORT (MACROS \DSPGETCHARWIDTH \DSPGETCHARIMAGEWIDTH \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 DSPSOURCETYPE DSPXOFFSET DSPYOFFSET)
              (FNS DSPCREATE DSPDESTINATION DSPTEXTURE \DISPLAYSTREAMINCRXPOSITION \SFFixDestination 
                   \SFFixClippingRegion \SFFixFont \SFFIXLINELENGTH \SFFixY)
              (FNS \DSPCLIPPINGREGION.DISPLAY \DSPFONT.DISPLAY \DISPLAY.PILOTBITBLT 
                   \DSPLINEFEED.DISPLAY \DSPLEFTMARGIN.DISPLAY \DSPOPERATION.DISPLAY 
                   \DSPRIGHTMARGIN.DISPLAY \DSPXPOSITION.DISPLAY \DSPYPOSITION.DISPLAY)
              (P (MOVD? (QUOTE \ILLEGAL.ARG)
                        (QUOTE \COERCETODS))
                 (MOVD? (QUOTE NILL)
                        (QUOTE WFROMDS))
                 (MOVD? (QUOTE NILL)
                        (QUOTE WINDOWP))
                 (MOVD? (QUOTE NILL)
                        (QUOTE INVERTW)))
              (INITVARS (PROMPTWINDOW T)
                     (\WINDOWWORLD NIL)
                     (\MAINSCREEN NIL)))
        [COMS (* Stub for window package)
              (INITVARS (\TOPWDS)
                     (\SCREENBITMAPS))
              (P (MOVD? (QUOTE NILL)
                        (QUOTE \TOTOPWDS)))
              (DECLARE: DONTCOPY EVAL@COMPILE (EXPORT (MACROS \INSURETOPWDS .WHILE.TOP.DS. 
                                                             .WHILE.CURSOR.DOWN.)
                                                     (ADDVARS (GLOBALVARS \TOPWDS]
        (COMS (* DisplayStream TTY functions)
              (FNS TTYDISPLAYSTREAM \REMOVEDRIBBLECHECK \ADDDRIBBLECHECK)
              (EXPORT (OPTIMIZERS TTYDISPLAYSTREAM))
              (FNS DSPSCROLL PAGEHEIGHT)
              (INITVARS (\CURRENTTTYDEVICE (QUOTE BCPLDISPLAY)))
              (FNS \DSPRESET.DISPLAY \DSPPRINTCHAR \DSPPRINTCR/LF)
              (FNS \TTYBACKGROUND)
              (FNS DSPBACKUP)
              (INITVARS (\CARET.UP))
              (DECLARE: DONTEVAL@LOAD DOCOPY (VARS (BELLCNT 2)
                                                   (BELLRATE 60)
                                                   (\DisplayStoppedForLogout)
                                                   (TtyDisplayStream)))
              (FNS COLORDISPLAYP)
              (FNS DISPLAYBEFOREEXIT DISPLAYAFTERENTRY)
              (EXPORT (GLOBALVARS BELLCNT BELLRATE TTYBACKGROUNDFNS \DisplayStoppedForLogout 
                             \CARET.UP)
                     (MACROS \CHECKCARET)))
        [COMS (* transformation related functions.)
              (FNS \DSPCLIPTRANSFORMX \DSPCLIPTRANSFORMY \DSPTRANSFORMREGION \DSPUNTRANSFORMY 
                   \DSPUNTRANSFORMX \OFFSETCLIPPINGREGION)
              (DECLARE: DONTCOPY (EXPORT (MACROS \DSPTRANSFORMX \DSPTRANSFORMY \OFFSETBOTTOM 
                                                \OFFSETLEFT]
        [COMS (* screen related functions)
              (FNS UPDATESCREENDIMENSIONS \CreateScreenBitMap)
              (DECLARE: DONTEVAL@LOAD DOCOPY (P (UPDATESCREENDIMENSIONS))
                     (INITVARS (SCREENHEIGHT 808)
                            (SCREENWIDTH 1024)
                            (\OLDSCREENHEIGHT 808)
                            (\OLDSCREENWIDTH 1024)
                            (\MaxScreenPage -1)
                            (ScreenBitMap (\CreateScreenBitMap SCREENWIDTH SCREENHEIGHT))
                            (ColorScreenBitMap NIL)))
              (GLOBALVARS \OLDSCREENHEIGHT \OLDSCREENWIDTH \MaxScreenPage ScreenBitMap)
              (DECLARE: DONTEVAL@LOAD DOCOPY (P (CURSOR.INIT]
        [COMS (* initialization)
              (INITVARS (\DISPLAYINFOALIST))
              (FNS \CoerceToDisplayDevice \CREATEDISPLAY DISPLAYSTREAMINIT \STARTDISPLAY 
                   \MOVE.WINDOWS.ONTO.SCREEN \UPDATE.PBT.RASTERWIDTHS \STOPDISPLAY \DEFINEDISPLAYINFO
                   )
              (DECLARE: EVAL@COMPILE DONTCOPY (ADDVARS (DONTCOMPILEFNS \UPDATE.PBT.RASTERWIDTHS)))
              (EXPORT (MACROS DISPLAYINITIALIZEDP DISPLAYSTARTEDP)
                     (GLOBALVARS \DisplayStarted \DisplayStreamsInitialized \DisplayInitialed 
                            WHOLEDISPLAY WHOLESCREEN SCREENWIDTH SCREENHEIGHT))
              (ADDVARS (GLOBALVARS WHOLESCREEN))
              (FNS INITIALIZEDISPLAYSTREAMS)
              (DECLARE: DOCOPY DONTEVAL@LOAD (VARS (\DisplayStarted NIL)
                                                   (\LastTTYLines 12))
                     (P (INITIALIZEDISPLAYSTREAMS)
                        (DISPLAYSTREAMINIT 1000]
        (PROP FILETYPE LLDISPLAY)))
(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)
                 (DDobsoletefield WORD)                      (* this used to be the DDtexture field 
                                                             and was left in so that world doesn't 
                                                             have to be recompiled)
                 (DDHELDFLG FLAG)
                 (XWINDOWHINT XPOINTER)
                 (DDPILOTBBT POINTER)
                 DDXSCALE DDYSCALE DDCHARIMAGEWIDTHS         (* array of image widths for each 
                                                             character)
                 DDEOLFN DDPAGEFULLFN DDTexture DDMICAXPOS DDMICAYPOS DDMICARIGHTMARGIN DDCHARSET
                 (DDCHARSETASCENT WORD)
                 (DDCHARSETDESCENT WORD)
                 DDCHARHEIGHTDELTA
                 (DDSPACEWIDTH WORD))
          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 DDTexture ← 0
          [ACCESSFNS ([DDFOREGROUNDCOLOR (OR (CAR (fetch (\DISPLAYDATA DDCOLOR) of DATUM))
                                             (MAXIMUMCOLOR (BITSPERPIXEL (fetch (\DISPLAYDATA 
                                                                                       DDDestination)
                                                                            of DATUM]
                      (DDBACKGROUNDCOLOR (OR (CDR (fetch (\DISPLAYDATA DDCOLOR) of DATUM))
                                             0]
          (SYSTEM))

(RECORD DISPLAYSTATE (ONOFF))

(RECORD DISPLAYINFO (DITYPE DIWIDTH DIHEIGHT DIBITSPERPIXEL DIWSOPS))
]
(/DECLAREDATATYPE (QUOTE PILOTBBT)
       (QUOTE (WORD WORD WORD SIGNEDWORD WORD WORD WORD SIGNEDWORD WORD WORD WORD WORD WORD WORD WORD 
                    WORD))
       [QUOTE ((PILOTBBT 0 (BITS . 15))
               (PILOTBBT 1 (BITS . 15))
               (PILOTBBT 2 (BITS . 15))
               (PILOTBBT 3 (SIGNEDBITS . 15))
               (PILOTBBT 4 (BITS . 15))
               (PILOTBBT 5 (BITS . 15))
               (PILOTBBT 6 (BITS . 15))
               (PILOTBBT 7 (SIGNEDBITS . 15))
               (PILOTBBT 8 (BITS . 15))
               (PILOTBBT 9 (BITS . 15))
               (PILOTBBT 10 (BITS . 15))
               (PILOTBBT 11 (BITS . 15))
               (PILOTBBT 12 (BITS . 15))
               (PILOTBBT 13 (BITS . 15))
               (PILOTBBT 14 (BITS . 15))
               (PILOTBBT 15 (BITS . 15]
       (QUOTE 16))
(/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 POINTER POINTER 
                     POINTER POINTER POINTER WORD WORD POINTER WORD))
       [QUOTE ((\DISPLAYDATA 0 POINTER)
               (\DISPLAYDATA 2 POINTER)
               (\DISPLAYDATA 4 POINTER)
               (\DISPLAYDATA 6 POINTER)
               (\DISPLAYDATA 8 POINTER)
               (\DISPLAYDATA 10 POINTER)
               (\DISPLAYDATA 12 POINTER)
               (\DISPLAYDATA 14 POINTER)
               (\DISPLAYDATA 16 POINTER)
               (\DISPLAYDATA 18 POINTER)
               (\DISPLAYDATA 20 POINTER)
               (\DISPLAYDATA 22 POINTER)
               (\DISPLAYDATA 24 POINTER)
               (\DISPLAYDATA 26 POINTER)
               (\DISPLAYDATA 28 POINTER)
               (\DISPLAYDATA 30 POINTER)
               (\DISPLAYDATA 32 POINTER)
               (\DISPLAYDATA 34 (BITS . 15))
               (\DISPLAYDATA 35 (BITS . 15))
               (\DISPLAYDATA 36 (BITS . 15))
               (\DISPLAYDATA 37 (BITS . 15))
               (\DISPLAYDATA 38 (BITS . 15))
               (\DISPLAYDATA 32 (FLAGBITS . 0))
               (\DISPLAYDATA 40 XPOINTER)
               (\DISPLAYDATA 42 POINTER)
               (\DISPLAYDATA 44 POINTER)
               (\DISPLAYDATA 46 POINTER)
               (\DISPLAYDATA 48 POINTER)
               (\DISPLAYDATA 50 POINTER)
               (\DISPLAYDATA 52 POINTER)
               (\DISPLAYDATA 54 POINTER)
               (\DISPLAYDATA 56 POINTER)
               (\DISPLAYDATA 58 POINTER)
               (\DISPLAYDATA 60 POINTER)
               (\DISPLAYDATA 62 POINTER)
               (\DISPLAYDATA 39 (BITS . 15))
               (\DISPLAYDATA 64 (BITS . 15))
               (\DISPLAYDATA 66 POINTER)
               (\DISPLAYDATA 65 (BITS . 15]
       (QUOTE 68))
(DECLARE: EVAL@COMPILE 

[PUTPROPS \GETDISPLAYDATA MACRO (ARGS (COND [(CADR ARGS)
                                             (SUBPAIR (QUOTE (STRM STRMVAR))
                                                    ARGS
                                                    (QUOTE (\DTEST (fetch (STREAM IMAGEDATA)
                                                                          of
                                                                          (SETQ STRMVAR (
                                                                                        \OUTSTREAMARG
                                                                                         STRM)))
                                                                  (QUOTE \DISPLAYDATA]
                                            (T (SUBST (CAR ARGS)
                                                      (QUOTE STRM)
                                                      (QUOTE (\DTEST (fetch (STREAM 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))
       [QUOTE ((BITMAP 0 POINTER)
               (BITMAP 2 (BITS . 15))
               (BITMAP 3 (BITS . 15))
               (BITMAP 4 (BITS . 15))
               (BITMAP 5 (BITS . 15]
       (QUOTE 6))
(/DECLAREDATATYPE (QUOTE PILOTBBT)
       (QUOTE (WORD WORD WORD SIGNEDWORD WORD WORD WORD SIGNEDWORD WORD WORD WORD WORD WORD WORD WORD 
                    WORD))
       [QUOTE ((PILOTBBT 0 (BITS . 15))
               (PILOTBBT 1 (BITS . 15))
               (PILOTBBT 2 (BITS . 15))
               (PILOTBBT 3 (SIGNEDBITS . 15))
               (PILOTBBT 4 (BITS . 15))
               (PILOTBBT 5 (BITS . 15))
               (PILOTBBT 6 (BITS . 15))
               (PILOTBBT 7 (SIGNEDBITS . 15))
               (PILOTBBT 8 (BITS . 15))
               (PILOTBBT 9 (BITS . 15))
               (PILOTBBT 10 (BITS . 15))
               (PILOTBBT 11 (BITS . 15))
               (PILOTBBT 12 (BITS . 15))
               (PILOTBBT 13 (BITS . 15))
               (PILOTBBT 14 (BITS . 15))
               (PILOTBBT 15 (BITS . 15]
       (QUOTE 16))
(/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 POINTER POINTER 
                     POINTER POINTER POINTER WORD WORD POINTER WORD))
       [QUOTE ((\DISPLAYDATA 0 POINTER)
               (\DISPLAYDATA 2 POINTER)
               (\DISPLAYDATA 4 POINTER)
               (\DISPLAYDATA 6 POINTER)
               (\DISPLAYDATA 8 POINTER)
               (\DISPLAYDATA 10 POINTER)
               (\DISPLAYDATA 12 POINTER)
               (\DISPLAYDATA 14 POINTER)
               (\DISPLAYDATA 16 POINTER)
               (\DISPLAYDATA 18 POINTER)
               (\DISPLAYDATA 20 POINTER)
               (\DISPLAYDATA 22 POINTER)
               (\DISPLAYDATA 24 POINTER)
               (\DISPLAYDATA 26 POINTER)
               (\DISPLAYDATA 28 POINTER)
               (\DISPLAYDATA 30 POINTER)
               (\DISPLAYDATA 32 POINTER)
               (\DISPLAYDATA 34 (BITS . 15))
               (\DISPLAYDATA 35 (BITS . 15))
               (\DISPLAYDATA 36 (BITS . 15))
               (\DISPLAYDATA 37 (BITS . 15))
               (\DISPLAYDATA 38 (BITS . 15))
               (\DISPLAYDATA 32 (FLAGBITS . 0))
               (\DISPLAYDATA 40 XPOINTER)
               (\DISPLAYDATA 42 POINTER)
               (\DISPLAYDATA 44 POINTER)
               (\DISPLAYDATA 46 POINTER)
               (\DISPLAYDATA 48 POINTER)
               (\DISPLAYDATA 50 POINTER)
               (\DISPLAYDATA 52 POINTER)
               (\DISPLAYDATA 54 POINTER)
               (\DISPLAYDATA 56 POINTER)
               (\DISPLAYDATA 58 POINTER)
               (\DISPLAYDATA 60 POINTER)
               (\DISPLAYDATA 62 POINTER)
               (\DISPLAYDATA 39 (BITS . 15))
               (\DISPLAYDATA 64 (BITS . 15))
               (\DISPLAYDATA 66 POINTER)
               (\DISPLAYDATA 65 (BITS . 15]
       (QUOTE 68))



(* 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))))))

(\NEWPAGE.DISPLAY
  (LAMBDA (STREAM)                                           (* hdj "10-Dec-84 12:31")
    (DSPRESET STREAM)))

(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

(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 ← 16
	      BITMAPHEIGHT ← 16
	      BITMAPBASE ← \EM.CURSORBITMAP)))
)
(DECLARE: DONTEVAL@LOAD DOCOPY 

(RPAQ CursorBitMap (\CreateCursorBitMap))
)



(* bitmap functions.)

(DEFINEQ

(BITBLT
  [LAMBDA (SOURCE SOURCELEFT SOURCEBOTTOM DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT 
                 SOURCETYPE OPERATION TEXTURE CLIPPINGREGION)(* rrb " 3-Oct-86 18:07")
    (DECLARE (LOCALVARS . T))
    (COND
       [(EQ SOURCETYPE (QUOTE TEXTURE))
        (COND
           ((type? BITMAP DESTINATION)
            (\BLTSHADE.BITMAP TEXTURE DESTINATION (OR DESTINATIONLEFT 0)
                   (OR DESTINATIONBOTTOM 0)
                   WIDTH HEIGHT OPERATION CLIPPINGREGION))
           (T (PROG ((STREAM (\OUTSTREAMARG DESTINATION)))
                    (RETURN (IMAGEOP (QUOTE IMBLTSHADE)
                                   STREAM TEXTURE STREAM (OR DESTINATIONLEFT 0)
                                   (OR DESTINATIONBOTTOM 0)
                                   WIDTH HEIGHT OPERATION CLIPPINGREGION]
       (T (PROG (SOURCEDD SOURCEBM CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM)
                [COND
                   [(type? BITMAP SOURCE)
                    (OR SOURCELEFT (SETQ SOURCELEFT 0))
                    (OR SOURCEBOTTOM (SETQ SOURCEBOTTOM 0))
                    (SETQ SOURCEBM SOURCE)
                    (SETQ CLIPPEDSOURCELEFT SOURCELEFT)
                    (SETQ CLIPPEDSOURCEBOTTOM SOURCEBOTTOM)  (* limit the WIDTH and HEIGHT to the 
                                                             source size.)
                    [SETQ WIDTH (COND
                                   (WIDTH (IMIN WIDTH (IDIFFERENCE (fetch (BITMAP BITMAPWIDTH)
                                                                      of SOURCE)
                                                             SOURCELEFT)))
                                   (T (fetch (BITMAP BITMAPWIDTH) of SOURCE]
                    (SETQ HEIGHT (COND
                                    (HEIGHT (IMIN HEIGHT (IDIFFERENCE (fetch (BITMAP BITMAPHEIGHT)
                                                                         of SOURCE)
                                                                SOURCEBOTTOM)))
                                    (T (fetch (BITMAP BITMAPHEIGHT) of SOURCE]
                   ((SETQ SOURCEDD (\GETDISPLAYDATA SOURCE))
                    [OR SOURCELEFT (SETQ SOURCELEFT (fetch (REGION LEFT) of (ffetch (\DISPLAYDATA
                                                                                     DDClippingRegion
                                                                                     ) of SOURCEDD]
                    [OR SOURCEBOTTOM (SETQ SOURCEBOTTOM (fetch (REGION BOTTOM)
                                                           of (ffetch (\DISPLAYDATA DDClippingRegion)
                                                                 of SOURCEDD]
                                                             (* do transformations coming out of 
                                                             source)
                    (SETQ SOURCEBM (fetch (\DISPLAYDATA DDDestination) of SOURCEDD))
                    (SETQ CLIPPEDSOURCELEFT (IMAX (SETQ SOURCELEFT (\DSPTRANSFORMX SOURCELEFT 
                                                                          SOURCEDD))
                                                  (fetch (\DISPLAYDATA DDClippingLeft) of SOURCEDD)))
                    (SETQ CLIPPEDSOURCEBOTTOM (IMAX (SETQ SOURCEBOTTOM (\DSPTRANSFORMY SOURCEBOTTOM 
                                                                              SOURCEDD))
                                                    (fetch (\DISPLAYDATA DDClippingBottom)
                                                       of SOURCEDD)))
                                                             (* limit the WIDTH and HEIGHT by the 
                                                             source dimensions.)
                    [SETQ WIDTH (COND
                                   (WIDTH (IMIN WIDTH (IDIFFERENCE (fetch (\DISPLAYDATA 
                                                                                 DDClippingRight)
                                                                      of SOURCEDD)
                                                             CLIPPEDSOURCELEFT)))
                                   (T (IDIFFERENCE (fetch (\DISPLAYDATA DDClippingRight) of SOURCEDD)
                                             CLIPPEDSOURCELEFT]
                    [SETQ HEIGHT (COND
                                    (HEIGHT (IMIN HEIGHT (IDIFFERENCE (fetch (\DISPLAYDATA 
                                                                                    DDClippingTop)
                                                                         of SOURCEDD)
                                                                CLIPPEDSOURCEBOTTOM)))
                                    (T (IDIFFERENCE (fetch (\DISPLAYDATA DDClippingTop) of SOURCEDD)
                                              CLIPPEDSOURCEBOTTOM]
                                                             (* if texture is not given, use the 
                                                             display stream's.)
                    (OR TEXTURE (SETQ TEXTURE (ffetch (\DISPLAYDATA DDTexture) of SOURCEDD]
                (RETURN (COND
                           [(type? BITMAP DESTINATION)
                            (COND
                               ((WINDOWP SOURCE)
          
          (* bring source window to the top. Note: this doesn't work if the user passes 
          in a display stream onto the screen instead of a window.)

                                (.WHILE.TOP.DS. (\OUTSTREAMARG SOURCE)
                                       (\BITBLT.BITMAP SOURCEBM SOURCELEFT SOURCEBOTTOM DESTINATION
                                              (OR DESTINATIONLEFT 0)
                                              (OR DESTINATIONBOTTOM 0)
                                              WIDTH HEIGHT SOURCETYPE OPERATION TEXTURE 
                                              CLIPPINGREGION CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM)))
                               (T (\BITBLT.BITMAP SOURCEBM SOURCELEFT SOURCEBOTTOM DESTINATION
                                         (OR DESTINATIONLEFT 0)
                                         (OR DESTINATIONBOTTOM 0)
                                         WIDTH HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION 
                                         CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM]
                           (T (PROG (STREAM)
                                    (SETQ STREAM (\OUTSTREAMARG DESTINATION))
                                    (COND
                                       ((WINDOWP SOURCE)
          
          (* both source and destination are windows, see if they overlap and use an 
          intermediate bitmap. Note: this doesn't work if the user passes in a display 
          stream onto the screen instead of a window.)

                                        [COND
                                           ((WINDOWP DESTINATION)
                                            (COND
                                               ((WOVERLAPP SOURCE DESTINATION)
                                                (RETURN (PROG (SCRATCHBM)
                                                              (.WHILE.TOP.DS. (\OUTSTREAMARG SOURCE)
                                                                     (BITBLT SOURCEBM SOURCELEFT 
                                                                            SOURCEBOTTOM
                                                                            (SETQ SCRATCHBM
                                                                             (BITMAPCREATE WIDTH 
                                                                                    HEIGHT))
                                                                            0 0 WIDTH HEIGHT
                                                                            (QUOTE INPUT)
                                                                            (QUOTE REPLACE)))
                                                              (RETURN (BITBLT SCRATCHBM 0 0 STREAM
                                                                             (OR DESTINATIONLEFT 0)
                                                                             (OR DESTINATIONBOTTOM 0)
                                                                             WIDTH HEIGHT SOURCETYPE 
                                                                             OPERATION TEXTURE 
                                                                             CLIPPINGREGION]
                                                             (* bring the source to the top.
                                                             this should be done uninterruptably 
                                                             but is better than nothing.)
                                        (TOTOPW SOURCE)))
                                    (IMAGEOP (QUOTE IMBITBLT)
                                           STREAM SOURCEBM SOURCELEFT SOURCEBOTTOM STREAM
                                           (OR DESTINATIONLEFT 0)
                                           (OR DESTINATIONBOTTOM 0)
                                           WIDTH HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION 
                                           CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM])

(BLTSHADE
  [LAMBDA (TEXTURE DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION 
                 CLIPPINGREGION)                                       (* rrb 
                                                                           " 7-Mar-86 11:26")
    (DECLARE (LOCALVARS . T))
    (COND
       ((type? BITMAP DESTINATION)
        (\BLTSHADE.BITMAP TEXTURE DESTINATION (OR DESTINATIONLEFT 0)
               (OR DESTINATIONBOTTOM 0)
               WIDTH HEIGHT OPERATION CLIPPINGREGION))
       (T (PROG ((STREAM (\OUTSTREAMARG DESTINATION)))
                (RETURN (IMAGEOP (QUOTE IMBLTSHADE)
                               STREAM TEXTURE STREAM (OR DESTINATIONLEFT 0)
                               (OR DESTINATIONBOTTOM 0)
                               WIDTH HEIGHT (OR OPERATION (DSPOPERATION NIL STREAM))
                               CLIPPINGREGION])

(\BITBLTSUB
  (LAMBDA (PILOTBBT SourceBitMap SLX STY DestinationBitMap DLX DTY HEIGHT SourceType Operation 
                 Texture WindowXOffset WindowYOffset)                  (* rrb 
                                                                           "13-Feb-86 14:42")
            
            (* rrb 13-Feb-86 Added WindowYOffset and WindowXOffset so that textures 
            could be aligned to the window rather than the underlying Screen bitmap.
            I only changed the calls in \BLTSHADE.1BITDISPLAY and 
            \BLTSHADE.COLORDISPLAY)

    (PROG (DBMR SBMR GRAY SOURCEADDR DESTADDR X)
          (SETQ DBMR (fetch (BITMAP BITMAPRASTERWIDTH) of DestinationBitMap))
          (replace (PILOTBBT PBTFLAGS) of PILOTBBT with 0)
          (replace (PILOTBBT PBTDESTBPL) of PILOTBBT with (UNFOLD DBMR BITSPERWORD))
          (SETQ DESTADDR (\ADDBASE (fetch (BITMAP BITMAPBASE) of DestinationBitMap)
                                (ITIMES DBMR DTY)))                        (* Combine 
                                                                           Destination base and 
                                                                           top Y into a single 
                                                                           Destination word offset)
          (replace (PILOTBBT PBTDESTBIT) of PILOTBBT with DLX)
          (SELECTQ SourceType
              (TEXTURE (replace (PILOTBBT PBTUSEGRAY) of PILOTBBT with T)
                       (replace (PILOTBBT PBTSOURCEBIT) of PILOTBBT
                          with (MOD (COND
                                           (WindowXOffset (IDIFFERENCE DLX WindowXOffset))
                                           (T 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 (PILOTBBT PBTSOURCEBPL) of PILOTBBT with 0)
                                                                           (* Zero out this word 
                                                                           first)
                       (COND
                          ((FIXP Texture)
                           (SETQ GRAY (fetch (BITMAP BITMAPBASE) of \SYSBBTEXTURE))
                           (replace (PILOTBBT PBTSOURCE) of PILOTBBT
                              with (\ADDBASE GRAY
                                              (COND
                                                 ((OR (EQ (SETQ Texture (LOGAND Texture WORDMASK))
                                                          0)
                                                      (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 (PILOTBBT PBTGRAYHEIGHTLESSONE)
                                                       of PILOTBBT with 3)
                                                    (replace (PILOTBBT PBTGRAYOFFSET)
                                                       of PILOTBBT
                                                       with (MOD (COND
                                                                        (WindowYOffset (PLUS DTY 
                                                                                        WindowYOffset
                                                                                             ))
                                                                        (T DTY))
                                                                     4)))))))
                          (T                                               (* A bitmap that is 
                                                                           16 bits wide.
                                                                           BITBLT verified this 
                                                                           back in interruptable 
                                                                           section)
                             (replace (PILOTBBT PBTGRAYHEIGHTLESSONE) of PILOTBBT
                                with (SUB1 (SETQ X (IMIN (ffetch (BITMAP BITMAPHEIGHT)
                                                                of (SETQ Texture
                                                                        (\DTEST Texture (QUOTE BITMAP
                                                                                               ))))
                                                             16))))
                             (replace (PILOTBBT PBTGRAYOFFSET) of PILOTBBT
                                with (SETQ X (COND
                                                    (WindowYOffset (MOD (PLUS DTY WindowYOffset)
                                                                        X))
                                                    (T (IREMAINDER DTY X)))))
                             (replace (PILOTBBT PBTSOURCE) of PILOTBBT
                                with (\ADDBASE (ffetch (BITMAP BITMAPBASE) of Texture)
                                                X)))))
              (MERGE (RETURN (RAID "Hard bitblt case")))
              (PROGN                                                       (* INPUT or INVERT)
                     (replace (PILOTBBT PBTUSEGRAY) of PILOTBBT with NIL)
                     (replace (PILOTBBT PBTSOURCEBPL) of PILOTBBT
                        with (UNFOLD (SETQ SBMR (fetch (BITMAP BITMAPRASTERWIDTH)
                                                       of SourceBitMap))
                                        BITSPERWORD))
                     (SETQ SOURCEADDR (\ADDBASE (fetch (BITMAP BITMAPBASE) of SourceBitMap)
                                             (ITIMES SBMR STY)))           (* Combine Source 
                                                                           base and top Y into a 
                                                                           single Source word 
                                                                           offset)
                     (replace (PILOTBBT PBTSOURCEBIT) of PILOTBBT with SLX)
                     (COND
                        ((NOT (EQ SourceBitMap DestinationBitMap))         (* Assume distinct 
                                                                           bitmaps do not overlap, 
                                                                           i.e. that we do not 
                                                                           have sub-bitmaps)
                         (replace (PILOTBBT 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 (PILOTBBT PBTDISJOINT) of PILOTBBT with T))
                            (T                                             (* Not disjoint, but 
                                                                           the items are disjoint)
                               (replace (PILOTBBT PBTDISJOINTITEMS) of PILOTBBT with
                                                                                        T))))
                        ((IGREATERP DTY (IPLUS STY HEIGHT))                (* Source ends before 
                                                                           dest starts, so is 
                                                                           completely disjoint)
                         (replace (PILOTBBT PBTDISJOINT) of PILOTBBT with T))
                        ((OR (NOT (EQ STY DTY))
                             (AND (ILESSP SLX DLX)
                                  (ILESSP DLX (IPLUS SLX (fetch (PILOTBBT 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 (PILOTBBT 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 (PILOTBBT PBTSOURCEBPL) of PILOTBBT
                            with (SETQ X (IMINUS (UNFOLD SBMR BITSPERWORD))))
                         (replace (PILOTBBT PBTDESTBPL) of PILOTBBT with X)
                         (COND
                            ((NOT (EQ STY DTY))                            (* At least the items 
                                                                           are disjoint)
                             (replace (PILOTBBT PBTDISJOINTITEMS) of PILOTBBT with T)))))
                     (replace (PILOTBBT PBTSOURCE) of PILOTBBT with SOURCEADDR)))
          (replace (PILOTBBT 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)                        (* kbr: " 2-Sep-85 18:50")
                                                             (* creates a bitmap data structure.)
    (PROG (RW)
	    (OR (AND (IGEQ WIDTH 0)
			 (ILEQ WIDTH \MaxBitMapWidth))
		  (\ILLEGAL.ARG WIDTH))
	    (OR (AND (IGEQ HEIGHT 0)
			 (ILEQ HEIGHT \MaxBitMapHeight))
		  (\ILLEGAL.ARG HEIGHT))
	    (SETQ BITSPERPIXEL (\INSUREBITSPERPIXEL BITSPERPIXEL))
	    (SETQ RW (FOLDHI (ITIMES WIDTH BITSPERPIXEL)
			       BITSPERWORD))
	    (RETURN (create BITMAP
				BITMAPRASTERWIDTH ← RW
				BITMAPWIDTH ← WIDTH
				BITMAPHEIGHT ← HEIGHT
				BITMAPBITSPERPIXEL ← BITSPERPIXEL
				BITMAPBASE ← (COND
				  ((IGREATERP (SETQ RW (ITIMES RW HEIGHT))
						\MaxBitMapWords)
				    (ERROR (ITIMES WIDTH HEIGHT BITSPERPIXEL)
					     "bits in BITMAP -- too big"))
				  (T (\ALLOCBLOCK (FOLDHI RW WORDSPERCELL)
						    NIL
						    (AND (NULL WINDFLG)
							   0)))))))))

(BITMAPBIT
  (LAMBDA (BITMAP X Y NEWVALUE)                                       (* kbr: 
                                                                          "13-Feb-86 20:20")
                                                                          (* 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 WORDX OLDVALUE oldword bitmapbase)
          (RETURN (COND
                     ((type? BITMAP BITMAP)
                      (SETQ NBITS (fetch (BITMAP BITMAPBITSPERPIXEL) of BITMAP))
                      (SETQ BITX (ITIMES X NBITS))
                      (SETQ WORDX (FOLDLO BITX BITSPERWORD))
                      (COND
                         ((OR (IGREATERP 0 X)
                              (IGEQ X (fetch (BITMAP BITMAPWIDTH) of BITMAP))
                              (IGREATERP 0 Y)
                              (IGEQ Y (fetch (BITMAP BITMAPHEIGHT) of BITMAP)))
                                                                          (* all bitmaps are 0 
                                                                          outside)
                          0)
                         (T (SETQ bitmapbase (\ADDBASE (fetch (BITMAP BITMAPBASE) of BITMAP)
                                                    (ITIMES (SUB1 (\SFInvert BITMAP Y))
                                                           (fetch (BITMAP BITMAPRASTERWIDTH)
                                                              of BITMAP))))
                            (COND
                               (NEWVALUE                                  (* check NEWVALUE 
                                                                          before going 
                                                                          uninterruptable.)
                                      (COND
                                         ((NOT (AND (IGEQ NEWVALUE MINIMUMCOLOR)
                                                    (ILEQ NEWVALUE (MAXIMUMCOLOR
                                                                    (fetch (BITMAP 
                                                                                   BITMAPBITSPERPIXEL
                                                                                      ) of BITMAP
                                                                           )))))
                                          (\ILLEGAL.ARG NEWVALUE)))))
                            (SELECTQ NBITS
                                (1 (COND
                                      ((EQ (LOGAND (SETQ oldword (\GETBASE bitmapbase WORDX))
                                                  (SETQ BITX (\BITMASK X)))
                                           0)                             (* old value was 0)
                                       (COND
                                          ((AND NEWVALUE (NOT (EQ NEWVALUE 0)))
                                                                          (* change value Since 
                                                                          old value is 0, ok to 
                                                                          OR.)
                                           (\PUTBASE bitmapbase WORDX (LOGOR oldword BITX))))
                                       0)
                                      (T                                  (* old value was 1)
                                         (COND
                                            ((AND NEWVALUE (EQ NEWVALUE 0))
                                                                          (* change, use XOR 
                                                                          since old value is 1)
                                             (\PUTBASE bitmapbase WORDX (LOGXOR oldword BITX))))
                                         1)))
                                (4 (SETQ oldword (\GETBASE bitmapbase WORDX))
                                   (SETQ OLDVALUE (LOGAND oldword (\4BITMASK X)))
                                   (COND
                                      (NEWVALUE (\PUTBASE bitmapbase WORDX
                                                       (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 (COND
                                      ((EQ (LOGAND X 1)
                                           0)                             (* left half of word)
                                       (SETQ oldword (\GETBASE bitmapbase WORDX))
                                       (SETQ OLDVALUE (LOGAND oldword 65280))
                                       (COND
                                          (NEWVALUE (\PUTBASE bitmapbase WORDX
                                                           (LOGOR (LOGXOR oldword OLDVALUE)
                                                                  (LLSH NEWVALUE 8)))))
                                       (SETQ OLDVALUE (LRSH OLDVALUE 8)))
                                      (T                                  (* right half of word)
                                         (SETQ oldword (\GETBASE bitmapbase WORDX))
                                         (SETQ OLDVALUE (LOGAND oldword 255))
                                         (COND
                                            (NEWVALUE (\PUTBASE bitmapbase WORDX
                                                             (LOGOR (LOGXOR oldword OLDVALUE)
                                                                    NEWVALUE))))))
                                   OLDVALUE)
                                (24 (SETQ OLDVALUE (\GETBASE24 bitmapbase X))
                                    (COND
                                       (NEWVALUE (\PUTBASE24 bitmapbase X NEWVALUE)))
                                    OLDVALUE)
                                (ERROR "unknown bits per pixel size." NBITS)))))
                     (T (PROG (TX TY DD)
                              (SETQ DD (\GETDISPLAYDATA BITMAP BITMAP))
                              (SETQ TX (\DSPCLIPTRANSFORMX X DD))
                              (SETQ TY (\DSPCLIPTRANSFORMY Y DD))
                              (RETURN (COND
                                         ((AND TX TY)
                                          (.WHILE.TOP.DS. BITMAP (SETQ TX (BITMAPBIT
                                                                           (fetch (\DISPLAYDATA
                                                                                       DDDestination)
                                                                              of DD)
                                                                           TX TY NEWVALUE)))
                                          TX)
                                         (T                               (* anything outside 
                                                                          the clipping region 
                                                                          returns 0.0)
                                            0))))))))))

(BLTCHAR
  (LAMBDA (CHARCODE DISPLAYSTREAM)                         (* rmk: " 4-Apr-85 11:45")
                                                             (* 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 (COND
		  ((\CHARCODEP CHARCODE)
		    CHARCODE)
		  (T (\ILLEGAL.ARG CHARCODE)))
		DISPLAYSTREAM
		(\GETDISPLAYDATA DISPLAYSTREAM))))

(\BLTCHAR
  (LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA)                        (* kbr: 
                                                                          "25-Feb-86 22:25")
            
            (* 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 CHAR8CODE)
          (SETQ CHAR8CODE (\CHAR8CODE CHARCODE))
      CRLP
          (COND
             ((NOT (EQ (ffetch (\DISPLAYDATA DDCHARSET) of DISPLAYDATA)
                       (\CHARSET CHARCODE)))
              (\CHANGECHARSET.DISPLAY DISPLAYDATA (\CHARSET CHARCODE))))
          (COND
             ((ffetch (\DISPLAYDATA DDSlowPrintingCase) of DISPLAYDATA)
              (RETURN (\SLOWBLTCHAR CHARCODE DISPLAYSTREAM))))
          (SETQ CURX (ffetch (\DISPLAYDATA DDXPOSITION) of DISPLAYDATA))
          (SETQ RIGHT (IPLUS CURX (\DSPGETCHARIMAGEWIDTH CHAR8CODE DISPLAYDATA)))
          (COND
             ((IGREATERP RIGHT (ffetch (\DISPLAYDATA DDRightMargin) of DISPLAYDATA))
                                                                          (* would go past right 
                                                                          margin, force a cr)
              (COND
                 ((IGREATERP CURX (ffetch (\DISPLAYDATA 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 (\DISPLAYDATA DDXPOSITION) of DISPLAYDATA with (IPLUS CURX
                                                                                      (
                                                                                     \DSPGETCHARWIDTH
                                                                                       CHAR8CODE 
                                                                                       DISPLAYDATA)))
                                                                          (* transforms an x 
                                                                          coordinate into the 
                                                                          destination coordinate.)
          (SETQ LOCAL1 (ffetch (\DISPLAYDATA DDXOFFSET) of DISPLAYDATA))
          (SETQ CURX (IPLUS CURX LOCAL1))
          (SETQ RIGHT (IPLUS RIGHT LOCAL1))
          (COND
             ((IGREATERP RIGHT (SETQ LOCAL1 (ffetch (\DISPLAYDATA DDClippingRight) of 
                                                                                          DISPLAYDATA
                                                   )))                    (* character overlaps 
                                                                          right edge of clipping 
                                                                          region.)
              (SETQ RIGHT LOCAL1)))
          (SETQ LEFT (COND
                        ((IGREATERP CURX (SETQ LOCAL1 (ffetch (\DISPLAYDATA DDClippingLeft)
                                                         of DISPLAYDATA)))
                         CURX)
                        (T LOCAL1)))
          (RETURN (COND
                     ((AND (ILESSP LEFT RIGHT)
                           (NOT (EQ (fetch (PILOTBBT PBTHEIGHT) of (SETQ LOCAL1
                                                                            (ffetch (\DISPLAYDATA
                                                                                         DDPILOTBBT)
                                                                               of DISPLAYDATA)))
                                    0)))
                      (.WHILE.TOP.DS. DISPLAYSTREAM (freplace (PILOTBBT PBTDESTBIT) of LOCAL1
                                                       with LEFT)
                             (freplace (PILOTBBT PBTWIDTH) of LOCAL1 with (IDIFFERENCE
                                                                                       RIGHT LEFT))
                             (freplace (PILOTBBT PBTSOURCEBIT) of LOCAL1
                                with (IDIFFERENCE (IPLUS (\DSPGETCHAROFFSET CHAR8CODE DISPLAYDATA
                                                                    )
                                                             LEFT)
                                                CURX))
                             (\PILOTBITBLT LOCAL1 0))
                      T))))))

(\CHANGECHARSET.DISPLAY
  (LAMBDA (DISPLAYDATA CHARSET)                              (* gbn "13-Sep-85 11:47")
                                                             (* Called when the character set information cached in
							     a display stream doesn't correspond to CHARSET)
    (PROG (BM (PBT (ffetch DDPILOTBBT of DISPLAYDATA))
		(CSINFO (\GETCHARSETINFO CHARSET (ffetch DDFONT of DISPLAYDATA))))

          (* Since we called \GETCHARSETINFO without the NOSLUG? flag, we presume we will get back a CSINFO , even if it is a
	  slug csinfo)


	    (UNINTERRUPTABLY
                (freplace DDWIDTHSCACHE of DISPLAYDATA with (ffetch (CHARSETINFO WIDTHS)
								     of CSINFO))
		(freplace DDOFFSETSCACHE of DISPLAYDATA with (ffetch (CHARSETINFO OFFSETS)
								      of CSINFO))
		(freplace DDCHARIMAGEWIDTHS of DISPLAYDATA with (ffetch (CHARSETINFO 
										      IMAGEWIDTHS)
									 of CSINFO))
		(freplace DDCHARSET of DISPLAYDATA with CHARSET)
		(SETQ BM (ffetch CHARSETBITMAP of CSINFO))
		(freplace PBTSOURCEBPL of PBT with (UNFOLD (ffetch BITMAPRASTERWIDTH
								    of BM)
								 BITSPERWORD))
		(COND
		  ((OR (NEQ (ffetch DDCHARSETASCENT of DISPLAYDATA)
				(ffetch CHARSETASCENT of CSINFO))
			 (NEQ (ffetch DDCHARSETDESCENT of DISPLAYDATA)
				(ffetch CHARSETDESCENT of CSINFO)))
		    (\SFFixY DISPLAYDATA CSINFO))
		  (T (freplace PBTSOURCE of PBT with (\ADDBASE (ffetch BITMAPBASE
									  of BM)
								       (ITIMES (ffetch 
										BITMAPRASTERWIDTH
										    of BM)
										 (ffetch 
										DDCHARHEIGHTDELTA
										    of DISPLAYDATA))
								       ))))))))

(\INDICATESTRING
  (LAMBDA (CHARCODE)                                       (* jds " 3-Oct-85 16:50")

          (* This returns the string of characters by which CHARCODE would be indicated on the display.
	  This could be fixed up to use a global resource passed in from the outside, but this should almost never be called 
	  so it doesn't matter (except perhaps when SEEing a compiled file))


    (COND
      ((IGREATERP CHARCODE \MAXTHINCHAR)                   (* An NS character)
	(RESETLST (RESETSAVE PRXFLT T)
		    (RESETSAVE (RADIX 8))
		    (CONCAT (QUOTE #)
			      (\CHARSET CHARCODE)
			      ","
			      (\CHAR8CODE CHARCODE))))
      (T (CONCAT (COND
		     ((IGREATERP CHARCODE 127)             (* An old META character)
		       (SETQ CHARCODE (LOGAND CHARCODE 127))
		       (QUOTE #))
		     (T ""))
		   (COND
		     ((ILESSP CHARCODE 32)                 (* CONTROL character)
		       (SETQ CHARCODE (LOGOR CHARCODE 64))
		       (QUOTE ↑))
		     (T ""))
		   (CHARACTER CHARCODE))))))

(\SLOWBLTCHAR
  (LAMBDA (CHARCODE DISPLAYSTREAM)                                    (* kbr: 
                                                                          "15-Feb-86 19:31")
            
            (* case of BLTCHAR where either font is rotated or destination is a 
            color bitmap. DISPLAYSTREAM is known to be a display stream, and its cache 
            fields have been updated for CHARCODE's charset)

    (PROG (ROTATION CHAR8CODE DD)
          (SETQ CHAR8CODE (\CHAR8CODE CHARCODE))
          (SETQ DD (ffetch (STREAM IMAGEDATA) of DISPLAYSTREAM))
          (SETQ ROTATION (ffetch (FONTDESCRIPTOR ROTATION) of (ffetch (\DISPLAYDATA
                                                                                   DDFONT)
                                                                         of DD)))
          (COND
             ((EQ 0 ROTATION)
              (PROG (NEWX LEFT RIGHT CURX PILOTBBT DESTBIT WIDTH SOURCEBIT)
                    (SETQ CURX (ffetch (\DISPLAYDATA DDXPOSITION) of DD))
                    (SETQ NEWX (IPLUS CURX (\DSPGETCHARWIDTH CHAR8CODE DD)))
                    (COND
                       ((IGREATERP NEWX (ffetch (\DISPLAYDATA DDRightMargin) of DD))
                                                                          (* past RIGHT margin, 
                                                                          force eol)
                        (\DSPPRINTCR/LF (CHARCODE EOL)
                               DISPLAYSTREAM)
                        (SETQ CURX (ffetch (\DISPLAYDATA DDXPOSITION) of DD))
                        (SETQ NEWX (IPLUS CURX (\DSPGETCHARWIDTH CHAR8CODE DD)))))
                                                                          (* update the x 
                                                                          position.)
                    (freplace (\DISPLAYDATA DDXPOSITION) of DD with NEWX)
                    (SETQ CURX (\DSPTRANSFORMX CURX DD))
                    (SETQ LEFT (IMAX (ffetch (\DISPLAYDATA DDClippingLeft) of DD)
                                     CURX))
                    (SETQ RIGHT (IMIN (ffetch (\DISPLAYDATA DDClippingRight) of DD)
                                      (\DSPTRANSFORMX NEWX DD)))
                    (SETQ PILOTBBT (ffetch (\DISPLAYDATA DDPILOTBBT) of DD))
                    (COND
                       ((AND (ILESSP LEFT RIGHT)
                             (NOT (EQ (ffetch (PILOTBBT PBTHEIGHT) of PILOTBBT)
                                      0)))
                        (SETQ DESTBIT LEFT)
                        (SETQ WIDTH (IDIFFERENCE RIGHT LEFT))
                        (SETQ SOURCEBIT (IDIFFERENCE (IPLUS (\DSPGETCHAROFFSET CHAR8CODE DD)
                                                            LEFT)
                                               CURX))
                        (SELECTQ (ffetch (BITMAP BITMAPBITSPERPIXEL) of (ffetch
                                                                                 (\DISPLAYDATA 
                                                                                        DDDestination
                                                                                        )
                                                                                   of DD))
                            (1)
                            (4 (SETQ DESTBIT (LLSH DESTBIT 2))
                               (SETQ WIDTH (LLSH WIDTH 2))
                               (SETQ SOURCEBIT (LLSH SOURCEBIT 2)))
                            (8 (SETQ DESTBIT (LLSH DESTBIT 3))
                               (SETQ WIDTH (LLSH WIDTH 3))
                               (SETQ SOURCEBIT (LLSH SOURCEBIT 3)))
                            (24 (SETQ DESTBIT (ITIMES 24 DESTBIT))
                                (SETQ WIDTH (ITIMES 24 WIDTH))
                                (SETQ SOURCEBIT (ITIMES 24 SOURCEBIT)))
                            (SHOULDNT))
                        (.WHILE.TOP.DS. DISPLAYSTREAM (freplace (PILOTBBT PBTDESTBIT)
                                                         of PILOTBBT with DESTBIT)
                               (freplace (PILOTBBT PBTWIDTH) of PILOTBBT with WIDTH)
                               (freplace (PILOTBBT PBTSOURCEBIT) of PILOTBBT with 
                                                                                           SOURCEBIT)
                               (\PILOTBITBLT PILOTBBT 0))
                        T))))
             (T                                                           (* handle rotated 
                                                                          fonts)
                (PROG (YPOS HEIGHTMOVED CSINFO)
                      (SETQ YPOS (ffetch (\DISPLAYDATA DDYPOSITION) of DD))
                      (SETQ HEIGHTMOVED (\DSPGETCHARWIDTH CHAR8CODE DD))
                      (SETQ CSINFO (\GETCHARSETINFO (\CHARSET CHARCODE)
                                          (ffetch (\DISPLAYDATA DDFONT) of DD)))
                      (COND
                         ((EQ ROTATION 90)                                (* don't force CR for 
                                                                          rotated fonts.)
                          (\DSPYPOSITION.DISPLAY DISPLAYSTREAM (IPLUS YPOS HEIGHTMOVED))
                                                                          (* update the display 
                                                                          stream x position.)
                          (BITBLT (ffetch (CHARSETINFO CHARSETBITMAP) of CSINFO)
                                 0
                                 (\DSPGETCHAROFFSET CHAR8CODE DD)
                                 DISPLAYSTREAM
                                 (ADD1 (IDIFFERENCE (ffetch (\DISPLAYDATA DDXPOSITION)
                                                       of DD)
                                              (ffetch (CHARSETINFO CHARSETASCENT) of CSINFO))
                                       )
                                 YPOS
                                 (IPLUS (ffetch (CHARSETINFO CHARSETASCENT) of CSINFO)
                                        (ffetch (CHARSETINFO CHARSETDESCENT) of CSINFO))
                                 HEIGHTMOVED))
                         ((EQ ROTATION 270)
                          (\DSPYPOSITION.DISPLAY DISPLAYSTREAM (IDIFFERENCE YPOS HEIGHTMOVED))
                          (BITBLT (ffetch (CHARSETINFO CHARSETBITMAP) of CSINFO)
                                 0
                                 (\DSPGETCHAROFFSET CHAR8CODE DD)
                                 DISPLAYSTREAM
                                 (IDIFFERENCE (ffetch (\DISPLAYDATA DDXPOSITION) of DD)
                                        (ffetch (CHARSETINFO CHARSETDESCENT) of CSINFO))
                                 (ffetch (\DISPLAYDATA DDYPOSITION) of DISPLAYSTREAM)
                                 (IPLUS (ffetch (CHARSETINFO CHARSETASCENT) of CSINFO)
                                        (ffetch (CHARSETINFO CHARSETDESCENT) of CSINFO))
                                 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 (BITMAP)                                           (* kbr: " 2-Sep-85 19:01")
                                                             (* returns the width of a bitmap in pixels)
    (COND
      ((type? BITMAP BITMAP)
	(ffetch (BITMAP BITMAPWIDTH) of BITMAP))
      ((type? WINDOW BITMAP)
	(WINDOWPROP BITMAP (QUOTE WIDTH)))
      (T (\ILLEGAL.ARG BITMAP)))))

(READBITMAP
  (LAMBDA (FILE)                                             (* rrb " 4-Oct-85 14:43")
                                                             (* reads the a bitmap from the input file.)
    (SKIPSEPRS FILE)
    (OR (EQ (READC FILE)
		(QUOTE %())
	  (ERROR "BAD FORMAT OF BITMAP IN FILE"))
    (PROG (BASE BM W BITSPERPIXEL (WIDTH (RATOM FILE))
		  (HEIGHT (RATOM FILE))
		  (STRM (GETSTREAM FILE (QUOTE INPUT))))
	    (SETQ BITSPERPIXEL (SELECTQ (SKIPSEPRS STRM)
					    ((%" %))
					      1)
					    (PROGN         (* after height can come the bits per pixel.)
						     (RATOM FILE))))
	    (SETQ W (FOLDHI (ITIMES BITSPERPIXEL WIDTH)
			      BITSPERWORD))
	    (SETQ BM (BITMAPCREATE WIDTH HEIGHT BITSPERPIXEL))
	    (SETQ BASE (fetch BITMAPBASE of BM))
	    (COND
	      ((EQ HEIGHT 0))
	      ((EQ (SKIPSEPRS STRM)
		     (QUOTE %"))
		(FRPTQ HEIGHT (SKIPSEPRS STRM)
			 (OR (EQ (\BIN STRM)
				     (CHARCODE %"))
			       (GO BAD))
			 (FRPTQ W (\PUTBASEBYTE BASE 0 (LOGOR
						      (LLSH (IDIFFERENCE (\BIN STRM)
									     (SUB1 (CHARCODE
										       A)))
							      4)
						      (IDIFFERENCE (\BIN STRM)
								     (SUB1 (CHARCODE A)))))
				  (\PUTBASEBYTE BASE 1 (LOGOR (LLSH (IDIFFERENCE
									    (\BIN STRM)
									    (SUB1 (CHARCODE
										      A)))
									  4)
								  (IDIFFERENCE (\BIN STRM)
										 (SUB1
										   (CHARCODE A)))))
				  (SETQ BASE (\ADDBASE BASE 1)))
			 (OR (EQ (\BIN STRM)
				     (CHARCODE %"))
			       (GO BAD))))
	      (T (GO BAD)))
	    (SKIPSEPRS STRM)
	    (OR (EQ (\BIN STRM)
			(CHARCODE %)))
		  (GO BAD))
	    (RETURN BM)
	BAD (ERROR "BAD FORMAT OF BITMAP IN FILE"))))

(\INSUREBITSPERPIXEL
  (LAMBDA (NBITS)                                            (* kbr: "10-Aug-85 15:49")
                                                             (* determines if NBITS is a legal color bits per 
							     pixel.)
    (SELECTQ NBITS
	       (NIL 1)
	       ((1 4 8 24)
		 NBITS)
	       (\ILLEGAL.ARG NBITS))))

(MAXIMUMCOLOR
  (LAMBDA (BITSPERPIXEL)                                   (* kbr: "29-Jan-86 12:12")
    (MASK.1'S 0 BITSPERPIXEL)))

(OPPOSITECOLOR
  (LAMBDA (COLOR BITSPERPIXEL)                               (* kbr: " 5-Jun-85 18:36")
    (IDIFFERENCE (MAXIMUMCOLOR BITSPERPIXEL)
		   COLOR)))

(MAXIMUMSHADE
  (LAMBDA (BITSPERPIXEL)                                   (* kbr: " 5-Jun-85 18:37")
    (COND
      ((EQ BITSPERPIXEL 1)
	BLACKSHADE)
      (T (MAXIMUMCOLOR BITSPERPIXEL)))))

(OPPOSITESHADE
  (LAMBDA (SHADE BITSPERPIXEL)                               (* kbr: " 5-Jun-85 18:39")
    (IDIFFERENCE (MAXIMUMSHADE BITSPERPIXEL)
		   SHADE)))
)
(DECLARE: EVAL@COMPILE 

(RPAQQ MINIMUMCOLOR 0)

(RPAQQ MINIMUMSHADE 0)

(CONSTANTS (MINIMUMCOLOR 0)
       (MINIMUMSHADE 0))
)
(MOVD (QUOTE BITMAPBIT)
      (QUOTE \BITMAPBIT))
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(PUTPROPS \INVALIDATEDISPLAYCACHE MACRO ((DISPLAYDATA)
                                         (* This marks the character-printing caches of the 
                                            displaystream as invalid. Needed when the font or Y 
                                            position changes)
                                         (freplace (\DISPLAYDATA DDCHARSET)
                                                of DISPLAYDATA with MAX.SMALLP)
                                         (freplace (\DISPLAYDATA DDCHARSETASCENT)
                                                of DISPLAYDATA with MAX.SMALLP)))
)
)
(DEFOPTIMIZER BITMAPBIT (&REST ARGS) (BITMAPBIT.EXPANDER ARGS))

(DEFINEQ

(BITMAPBIT.EXPANDER
  (LAMBDA (ARGS)                                             (* hdj "19-Mar-85 12:14")
    (PROG ((BM (CAR ARGS))
	     (X (CADR ARGS))
	     (Y (CADDR ARGS))
	     NEWVALUE)
	    (COND
	      ((EQ (LENGTH ARGS)
		     4)
		(SETQ NEWVALUE (CADDDR ARGS))))
	    (RETURN (BQUOTE ((OPCODES MISC4 6)
				 (\, BM)
				 (\, X)
				 (\, Y)
				 (\, NEWVALUE)))))))
)
(DEFINEQ

(\BITBLT.DISPLAY
  (LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTSTRM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH 
                 HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT 
                 CLIPPEDSOURCEBOTTOM)                                 (* kbr: 
                                                                          "20-Feb-86 19:04")
    (DECLARE (LOCALVARS . T))
    (PROG (stodx stody left top bottom right DESTDD DESTBITMAP DESTINATIONNBITS SOURCENBITS MAXSHADE)
          (SETQ DESTDD (fetch (STREAM IMAGEDATA) of DESTSTRM))
          (SETQ DESTBITMAP (fetch (\DISPLAYDATA DDDestination) of DESTDD))
            
            (* bring it to top so that its TOTOPFNs will get called before the 
            destination information is cached in case one of them moves, reshapes, 
            etc. the window)
            
            (* 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.)

          (\INSURETOPWDS DESTSTRM)
          (SETQ DESTINATIONLEFT (\DSPTRANSFORMX DESTINATIONLEFT DESTDD))
          (SETQ DESTINATIONBOTTOM (\DSPTRANSFORMY DESTINATIONBOTTOM DESTDD))
          (PROGN                                                          (* compute limits 
                                                                          based on clipping 
                                                                          regions.)
                 (SETQ left (fetch (\DISPLAYDATA DDClippingLeft) of DESTDD))
                 (SETQ bottom (fetch (\DISPLAYDATA DDClippingBottom) of DESTDD))
                 (SETQ right (fetch (\DISPLAYDATA DDClippingRight) of DESTDD))
                 (SETQ top (fetch (\DISPLAYDATA 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 (REGION LEFT)
                                                                        of CLIPPINGREGION)
                                                                     DESTDD))))
                                 (SETQ bottom (IMAX bottom (SETQ CRBOTTOM (\DSPTRANSFORMY
                                                                           (fetch (REGION BOTTOM)
                                                                              of CLIPPINGREGION)
                                                                           DESTDD))))
                                 (SETQ right (IMIN right (IPLUS CRLEFT (fetch (REGION WIDTH)
                                                                          of CLIPPINGREGION))))
                                 (SETQ top (IMIN top (IPLUS CRBOTTOM (fetch (REGION HEIGHT)
                                                                        of CLIPPINGREGION))))))))
          (SETQ DESTINATIONNBITS (fetch (BITMAP BITMAPBITSPERPIXEL) of DESTBITMAP))
          (SETQ SOURCENBITS (ffetch (BITMAP BITMAPBITSPERPIXEL) of SOURCEBITMAP))
          (COND
             ((NOT (EQ SOURCENBITS DESTINATIONNBITS))
              (COND
                 ((EQ SOURCENBITS 1)
                  (SETQ SOURCEBITMAP (COLORIZEBITMAP SOURCEBITMAP 0 (MAXIMUMCOLOR 
                                                                           DESTINATIONNBITS)
                                            DESTINATIONNBITS)))
                 ((EQ DESTINATIONNBITS 1)
                  (SETQ SOURCEBITMAP (UNCOLORIZEBITMAP SOURCEBITMAP (COLORMAP DESTINATIONNBITS))))
                 (T 
            
            (* Between two color bitmaps with different bpp.
            It seems that NOP is better than breaking.
            Eventually do some kind of output here, but don't error now.
            *)

                    (RETURN)))))                                          (* 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)))))                       (* Clip and translate 
                                                                          coordinates.)
          (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))                                   (* compute right 
                                                                          margin)
                 (SETQ right (IMIN (ffetch (BITMAP BITMAPWIDTH) of SOURCEBITMAP)
                                   (IDIFFERENCE right stodx)
                                   (IPLUS CLIPPEDSOURCELEFT WIDTH)))      (* compute top margin)
                 (SETQ top (IMIN (ffetch (BITMAP BITMAPHEIGHT) of SOURCEBITMAP)
                                 (IDIFFERENCE top stody)
                                 (IPLUS CLIPPEDSOURCEBOTTOM HEIGHT))))
          (COND
             ((OR (ILEQ right left)
                  (ILEQ top bottom))                                      (* there is nothing to 
                                                                          move.)
              (RETURN)))
          (OR OPERATION (SETQ OPERATION (ffetch (\DISPLAYDATA DDOPERATION) of DESTDD)))
          (SETQ MAXSHADE (MAXIMUMSHADE DESTINATIONNBITS))
          (SELECTQ SOURCETYPE
              (MERGE                                                      (* Need to use 
                                                                          complement of TEXTURE)
                     (COND
                        ((AND (LISTP TEXTURE)
                              (EQ DESTINATIONNBITS 1))                    (* either a color or a
                                                                          (texture color) filling.)
                         (SETQ TEXTURE (INSURE.B&W.TEXTURE TEXTURE))))
                     (SETQ TEXTURE (COND
                                      ((NULL TEXTURE)
                                       MAXSHADE)
                                      ((FIXP TEXTURE)
                                       (LOGXOR (LOGAND TEXTURE MAXSHADE)
                                              MAXSHADE))
                                      ((type? BITMAP TEXTURE)
                                       (INVERT.TEXTURE.BITMAP TEXTURE (OR \BBSCRATCHTEXTURE
                                                                              (SETQ \BBSCRATCHTEXTURE
                                                                               (BITMAPCREATE
                                                                                16 16)))))
                                      ((NOT (EQ DESTINATIONNBITS 1))
                                       (COLORNUMBERP TEXTURE DESTINATIONNBITS))
                                      (T (\ILLEGAL.ARG TEXTURE))))
                     (COND
                        ((NOT (EQ DESTINATIONNBITS 1))
                         (SETQ TEXTURE (COLORTEXTUREFROMCOLOR# TEXTURE DESTINATIONNBITS)))))
              (TEXTURE (COND
                          ((EQ DESTINATIONNBITS 1)                        (* either a color or a
                                                                          (texture color) filling.)
                           (SETQ TEXTURE (INSURE.B&W.TEXTURE TEXTURE)))))
              NIL)
          (COND
             ((NOT (EQ DESTINATIONNBITS 1))
              (SETQ left (ITIMES DESTINATIONNBITS left))
              (SETQ right (ITIMES DESTINATIONNBITS right))
              (SETQ stodx (ITIMES DESTINATIONNBITS stodx))))
          (.WHILE.TOP.DS. DESTSTRM
                 (PROG (HEIGHT WIDTH DTY DLX STY SLX)
                       (SETQ HEIGHT (IDIFFERENCE top bottom))
                       (SETQ WIDTH (IDIFFERENCE right left))
                       (SETQ DTY (\SFInvert DESTBITMAP (IPLUS top stody)))
                       (SETQ DLX (IPLUS left stodx))
                       (SETQ STY (\SFInvert SOURCEBITMAP top))
                       (SETQ SLX left)
                       (replace (PILOTBBT PBTWIDTH) of \SYSPILOTBBT with WIDTH)
                       (replace (PILOTBBT PBTHEIGHT) of \SYSPILOTBBT with HEIGHT)
                       (COND
                          ((EQ SOURCETYPE (QUOTE MERGE))
                           (\BITBLT.MERGE \SYSPILOTBBT SOURCEBITMAP SLX STY DESTBITMAP DLX DTY 
                                  WIDTH HEIGHT OPERATION TEXTURE))
                          (T (\BITBLTSUB \SYSPILOTBBT SOURCEBITMAP SLX STY DESTBITMAP DLX DTY 
                                    HEIGHT SOURCETYPE OPERATION TEXTURE)))))
          (RETURN T))))

(\BITBLT.BITMAP
  (LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTBITMAP DESTINATIONLEFT DESTINATIONBOTTOM WIDTH 
                 HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT 
                 CLIPPEDSOURCEBOTTOM)                                 (* kbr: 
                                                                          "15-Feb-86 20:21")
    (DECLARE (LOCALVARS . T))
    (PROG (stodx stody right top DESTINATIONNBITS left bottom SOURCENBITS)
          (SETQ top (fetch (BITMAP BITMAPHEIGHT) of DESTBITMAP))
          (SETQ DESTINATIONNBITS (fetch (BITMAP BITMAPBITSPERPIXEL) of DESTBITMAP))
          (SETQ left 0)
          (SETQ bottom 0)
          (SETQ SOURCENBITS (fetch (BITMAP BITMAPBITSPERPIXEL) of SOURCEBITMAP))
          (SETQ right (fetch (BITMAP BITMAPWIDTH) of DESTBITMAP))
          (COND
             (CLIPPINGREGION                                              (* adjust limits)
                    (SETQ left (IMAX left (fetch (REGION LEFT) of CLIPPINGREGION)))
                    (SETQ bottom (IMAX bottom (fetch (REGION BOTTOM) of CLIPPINGREGION)))
                    (SETQ right (IMIN right (IPLUS (fetch (REGION WIDTH) of CLIPPINGREGION)
                                                   (fetch (REGION LEFT) of CLIPPINGREGION))))
                    (SETQ top (IMIN top (IPLUS (fetch (REGION BOTTOM) of CLIPPINGREGION)
                                               (fetch (REGION HEIGHT) of CLIPPINGREGION))))))
                                                                          (* 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)))))                       (* Clip and translate 
                                                                          coordinates.)
          (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 0 (IDIFFERENCE left stodx)))
                                                                          (* compute bottom 
                                                                          margin)
                 (SETQ bottom (IMAX CLIPPEDSOURCEBOTTOM 0 (IDIFFERENCE bottom stody)))
                                                                          (* compute right 
                                                                          margin)
                 (SETQ right (IMIN (ffetch (BITMAP BITMAPWIDTH) of SOURCEBITMAP)
                                   (IDIFFERENCE right stodx)
                                   (IPLUS CLIPPEDSOURCELEFT WIDTH)))      (* compute top margin)
                 (SETQ top (IMIN (ffetch (BITMAP BITMAPHEIGHT) of SOURCEBITMAP)
                                 (IDIFFERENCE top stody)
                                 (IPLUS CLIPPEDSOURCEBOTTOM HEIGHT))))
          (COND
             ((OR (ILEQ right left)
                  (ILEQ top bottom))                                      (* there is nothing to 
                                                                          move.)
              (RETURN)))
          (SELECTQ SOURCETYPE
              (MERGE                                                      (* Need to use 
                                                                          complement of TEXTURE)
                                                                          (* MAY NOT WORK FOR 
                                                                          COLOR CASE.)
                     (SETQ TEXTURE (COND
                                      ((NULL TEXTURE)
                                       BLACKSHADE)
                                      ((FIXP TEXTURE)
                                       (LOGXOR (LOGAND TEXTURE BLACKSHADE)
                                              BLACKSHADE))
                                      ((AND (NOT (EQ DESTINATIONNBITS 1))
                                            (COLORNUMBERP TEXTURE DESTINATIONNBITS)))
                                      ((type? BITMAP TEXTURE)
                                       (INVERT.TEXTURE.BITMAP TEXTURE (OR \BBSCRATCHTEXTURE
                                                                              (SETQ \BBSCRATCHTEXTURE
                                                                               (BITMAPCREATE
                                                                                16 16)))))
                                      (T (\ILLEGAL.ARG TEXTURE)))))
              NIL)
          (COND
             ((EQ SOURCENBITS DESTINATIONNBITS)                           (* going from one to 
                                                                          another of the same 
                                                                          size.)
              (SELECTQ DESTINATIONNBITS
                  (4                                                      (* use UNFOLD with 
                                                                          constant value rather 
                                                                          than multiple because it 
                                                                          compiles into opcodes.)
                     (SETQ left (UNFOLD left 4))
                     (SETQ right (UNFOLD right 4))
                     (SETQ stodx (UNFOLD stodx 4))                        (* set texture if it 
                                                                          will ever get looked at.)
                     (AND (EQ SOURCETYPE (QUOTE MERGE))
                          (SETQ TEXTURE (COLORTEXTUREFROMCOLOR# TEXTURE DESTINATIONNBITS))))
                  (8 (SETQ left (UNFOLD left 8))
                     (SETQ right (UNFOLD right 8))
                     (SETQ stodx (UNFOLD stodx 8))
                     (AND (EQ SOURCETYPE (QUOTE MERGE))
                          (SETQ TEXTURE (COLORTEXTUREFROMCOLOR# TEXTURE DESTINATIONNBITS))))
                  (24 (SETQ left (ITIMES left 24))
                      (SETQ right (ITIMES right 24))
                      (SETQ stodx (ITIMES stodx 24))
                      (AND (EQ SOURCETYPE (QUOTE MERGE))
                           (SETQ TEXTURE (COLORTEXTUREFROMCOLOR# TEXTURE DESTINATIONNBITS))))
                  NIL)                                                    (* easy case of black 
                                                                          and white bitmap into 
                                                                          black and white or color 
                                                                          to color or texture 
                                                                          filling.)
              (UNINTERRUPTABLY
                  (PROG (HEIGHT WIDTH DTY DLX STY SLX)
                        (SETQ HEIGHT (IDIFFERENCE top bottom))
                        (SETQ WIDTH (IDIFFERENCE right left))
                        (SETQ DTY (\SFInvert DESTBITMAP (IPLUS top stody)))
                        (SETQ DLX (IPLUS left stodx))
                        (SETQ STY (\SFInvert SOURCEBITMAP top))
                        (SETQ SLX left)
                        (replace (PILOTBBT PBTWIDTH) of \SYSPILOTBBT with WIDTH)
                        (replace (PILOTBBT PBTHEIGHT) of \SYSPILOTBBT with HEIGHT)
                        (COND
                           ((EQ SOURCETYPE (QUOTE MERGE))
                            (\BITBLT.MERGE \SYSPILOTBBT SOURCEBITMAP SLX STY DESTBITMAP DLX DTY 
                                   WIDTH HEIGHT OPERATION TEXTURE))
                           (T (\BITBLTSUB \SYSPILOTBBT SOURCEBITMAP SLX STY DESTBITMAP DLX DTY 
                                     HEIGHT SOURCETYPE OPERATION TEXTURE))))))
             ((EQ SOURCENBITS 1)                                          (* going from a black 
                                                                          and white bitmap to a 
                                                                          color map)
              (AND SOURCETYPE (NOT (EQ SOURCETYPE (QUOTE INPUT)))
                   (ERROR "SourceType not implemented from B&W to color bitmaps." SOURCETYPE))
              (PROG (HEIGHT WIDTH DBOT DLFT)
                    (SETQ HEIGHT (IDIFFERENCE top bottom))
                    (SETQ WIDTH (IDIFFERENCE right left))
                    (SETQ DBOT (IPLUS bottom stody))
                    (SETQ DLFT (IPLUS left stodx))
                    (SELECTQ OPERATION
                        ((NIL REPLACE) 
                             (\BWTOCOLORBLT SOURCEBITMAP left bottom DESTBITMAP DLFT DBOT WIDTH 
                                    HEIGHT 0 (MAXIMUMCOLOR DESTINATIONNBITS)
                                    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))))

(\BITBLT.MERGE
  (LAMBDA (PILOTBBT SOURCEBITMAP SLX STY DESTBITMAP DLX DTY WIDTH HEIGHT OPERATION TEXTURE)
                                                             (* rmk: "21-Jun-84 23:10")

          (* Can't do MERGE 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 DESTBITMAP))               (* Don't need a scratch bitmap, just do two blts)
	(\BITBLTSUB PILOTBBT SOURCEBITMAP SLX STY DESTBITMAP DLX DTY HEIGHT (QUOTE INPUT)
		      (QUOTE REPLACE))                     (* Blt the source, then erase bits that aren't in 
							     TEXTURE)
	(\BITBLTSUB PILOTBBT NIL NIL NIL DESTBITMAP DLX DTY HEIGHT (QUOTE TEXTURE)
		      (QUOTE ERASE)
		      TEXTURE))
      (T (PROG (SCRATCH (SCRATCHLEFT (MOD DLX BITSPERWORD))
			  (SCRATCHTOP (MOD DTY 4)))
	         (SETQ SCRATCH (\GETPILOTBBTSCRATCHBM (IPLUS WIDTH SCRATCHLEFT)
							  (IPLUS HEIGHT SCRATCHTOP)))
                                                             (* 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)
                                                             (* Finally do original operation using the merged 
							     source)
	         (\BITBLTSUB PILOTBBT SCRATCH SCRATCHLEFT SCRATCHTOP DESTBITMAP DLX DTY HEIGHT
			       (QUOTE INPUT)
			       OPERATION))))))

(\BLTSHADE.DISPLAY
  (LAMBDA (TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION CLIPPINGREGION)
                                                                          (* kbr: 
                                                                          "24-Feb-86 11:56")
                                                                          (* BLTSHADE to a 
                                                                          display stream)
    (DECLARE (LOCALVARS . T))
    (PROG (left top bottom right DESTINATIONBITMAP DESTDD DESTINATIONNBITS)
          (SETQ DESTDD (fetch (STREAM IMAGEDATA) of STREAM))
            
            (* bring it to top so that its TOTOPFNs will get called before the 
            destination information is cached in case one of them moves, reshapes, 
            etc. the window)
            
            (* 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.)

          (\INSURETOPWDS STREAM)
          (SETQ DESTINATIONLEFT (\DSPTRANSFORMX DESTINATIONLEFT DESTDD))
          (SETQ DESTINATIONBOTTOM (\DSPTRANSFORMY DESTINATIONBOTTOM DESTDD))
          (PROGN                                                          (* compute limits 
                                                                          based on clipping 
                                                                          regions.)
                 (SETQ left (fetch (\DISPLAYDATA DDClippingLeft) of DESTDD))
                 (SETQ bottom (fetch (\DISPLAYDATA DDClippingBottom) of DESTDD))
                 (SETQ right (fetch (\DISPLAYDATA DDClippingRight) of DESTDD))
                 (SETQ top (fetch (\DISPLAYDATA 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 (REGION LEFT)
                                                                        of CLIPPINGREGION)
                                                                     DESTDD))))
                                 (SETQ bottom (IMAX bottom (SETQ CRBOTTOM (\DSPTRANSFORMY
                                                                           (fetch (REGION BOTTOM)
                                                                              of CLIPPINGREGION)
                                                                           DESTDD))))
                                 (SETQ right (IMIN right (IPLUS CRLEFT (fetch (REGION WIDTH)
                                                                          of CLIPPINGREGION))))
                                 (SETQ top (IMIN top (IPLUS CRBOTTOM (fetch (REGION HEIGHT)
                                                                        of CLIPPINGREGION))))))))
          (SETQ DESTINATIONBITMAP (fetch (\DISPLAYDATA DDDestination) of DESTDD))
          (SETQ DESTINATIONNBITS (fetch (BITMAP BITMAPBITSPERPIXEL) of DESTINATIONBITMAP))
                                                                          (* 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
             ((OR (ILEQ right left)
                  (ILEQ top bottom))                                      (* there is nothing to 
                                                                          move.)
              (RETURN)))
          (SETQ TEXTURE (SELECTQ (TYPENAME TEXTURE)
                            (LITATOM (COND
                                        ((NULL TEXTURE)                   (* NIL case.
                                                                          default texture to 
                                                                          background texture.)
                                         (ffetch (\DISPLAYDATA DDTexture) of DESTDD))
                                        ((NOT (EQ DESTINATIONNBITS 1))    (* should be a color 
                                                                          name)
                                         (OR (COLORNUMBERP TEXTURE DESTINATIONNBITS T)
                                             (\ILLEGAL.ARG TEXTURE)))
                                        (T (\ILLEGAL.ARG TEXTURE))))
                            ((SMALLP FIXP) 
                                 (LOGAND TEXTURE (MAXIMUMSHADE DESTINATIONNBITS)))
                            (BITMAP TEXTURE)
                            (LISTP                                        (* should be a list of 
                                                                          levels rgb or hls.)
                                   (OR (AND (NOT (EQ DESTINATIONNBITS 1))
                                            (COLORNUMBERP TEXTURE DESTINATIONNBITS))
                                       (\ILLEGAL.ARG TEXTURE)))
                            (\ILLEGAL.ARG TEXTURE)))
          (COND
             ((NOT (EQ DESTINATIONNBITS 1))
              (SETQ left (ITIMES DESTINATIONNBITS left))
              (SETQ right (ITIMES DESTINATIONNBITS right))
              (SETQ TEXTURE (COLORTEXTUREFROMCOLOR# TEXTURE DESTINATIONNBITS))))
          (.WHILE.TOP.DS. STREAM (PROG (HEIGHT)
                                       (SETQ HEIGHT (IDIFFERENCE top bottom))
                                       (replace (PILOTBBT PBTWIDTH) of \SYSPILOTBBT
                                          with (IDIFFERENCE right left))
                                       (replace (PILOTBBT PBTHEIGHT) of \SYSPILOTBBT
                                          with HEIGHT)
                                       (\BITBLTSUB \SYSPILOTBBT NIL left NIL DESTINATIONBITMAP 
                                              left (\SFInvert DESTINATIONBITMAP top)
                                              HEIGHT
                                              (QUOTE TEXTURE)
                                              (OR OPERATION (ffetch (\DISPLAYDATA DDOPERATION)
                                                               of DESTDD))
                                              TEXTURE
                                              (ITIMES DESTINATIONNBITS (fetch (\DISPLAYDATA
                                                                                   DDXOFFSET)
                                                                          of DESTDD))
                                              (fetch (\DISPLAYDATA DDYOFFSET) of DESTDD))))
          (RETURN T))))

(\BLTSHADE.BITMAP
  (LAMBDA (TEXTURE DESTINATIONBITMAP DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION 
                 CLIPPINGREGION)                                      (* kbr: 
                                                                          "29-Jan-86 17:33")
    (DECLARE (LOCALVARS . T))
    (PROG (left bottom top right DESTINATIONNBITS)
          (SETQ left 0)
          (SETQ bottom 0)
          (SETQ top (fetch (BITMAP BITMAPHEIGHT) of DESTINATIONBITMAP))
          (SETQ right (fetch (BITMAP BITMAPWIDTH) of DESTINATIONBITMAP))
          (SETQ DESTINATIONNBITS (fetch (BITMAP BITMAPBITSPERPIXEL) of DESTINATIONBITMAP))
          (COND
             ((EQ DESTINATIONNBITS 1)                                     (* DESTINATIONNBITS is 
                                                                          NIL for the case of 1 
                                                                          bit per pixel.)
              (SETQ DESTINATIONNBITS NIL)))
          (COND
             (CLIPPINGREGION                                              (* adjust limits)
                    (SETQ left (IMAX left (fetch (REGION LEFT) of CLIPPINGREGION)))
                    (SETQ bottom (IMAX bottom (fetch (REGION BOTTOM) of CLIPPINGREGION)))
                    (SETQ right (IMIN right (IPLUS (fetch (REGION WIDTH) of CLIPPINGREGION)
                                                   (fetch (REGION LEFT) of CLIPPINGREGION))))
                    (SETQ top (IMIN top (IPLUS (fetch (REGION BOTTOM) of CLIPPINGREGION)
                                               (fetch (REGION HEIGHT) of CLIPPINGREGION))))))
          (OR DESTINATIONLEFT (SETQ DESTINATIONLEFT 0))
          (OR DESTINATIONBOTTOM (SETQ DESTINATIONBOTTOM 0))               (* 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
             ((OR (ILEQ right left)
                  (ILEQ top bottom))                                      (* there is nothing to 
                                                                          move.)
              (RETURN)))
          (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)))
                                                             (T (MAXIMUMCOLOR DESTINATIONNBITS)))
                                               )
                                        (TEXTURE (\ILLEGAL.ARG TEXTURE))
                                        (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 (MAXIMUMCOLOR DESTINATIONNBITS))))
                                    (T (LOGAND TEXTURE BLACKSHADE))))
                            (BITMAP TEXTURE)
                            (LISTP                                        (* can be a list of
                                                                          (TEXTURE COLOR) or a 
                                                                          list of levels rgb or 
                                                                          hls.)
                                   (COND
                                      (DESTINATIONNBITS                   (* color case: If it 
                                                                          is a color, use it;
                                                                          if it is a list that 
                                                                          contains a color, use 
                                                                          that; otherwise, use the 
                                                                          texture)
                                             (COND
                                                ((COLORNUMBERP TEXTURE))
                                                ((COLORNUMBERP (CAR (LISTP (CDR TEXTURE)))))
                                                ((FIXP (CAR TEXTURE))
                                                 (LOGAND (CAR TEXTURE)
                                                        (MAXIMUMCOLOR DESTINATIONNBITS)))
                                                ((TEXTUREP (CAR TEXTURE)))
                                                (T (\ILLEGAL.ARG TEXTURE))))
                                      ((TEXTUREP (CAR TEXTURE)))
                                      ((COLORNUMBERP TEXTURE)
                                       (TEXTUREOFCOLOR TEXTURE))
                                      (T (\ILLEGAL.ARG TEXTURE))))
                            (\ILLEGAL.ARG TEXTURE)))                      (* filling an area 
                                                                          with a texture.)
          (COND
             (DESTINATIONNBITS (SETQ left (ITIMES DESTINATIONNBITS left))
                    (SETQ right (ITIMES DESTINATIONNBITS right))
                    (SETQ TEXTURE (COLORTEXTUREFROMCOLOR# TEXTURE DESTINATIONNBITS))))
                                                                          (* easy case of black 
                                                                          and white bitmap into 
                                                                          black and white or color 
                                                                          to color or texture 
                                                                          filling.)
          (UNINTERRUPTABLY
              (PROG (HEIGHT)
                    (SETQ HEIGHT (IDIFFERENCE top bottom))
                    (replace (PILOTBBT PBTWIDTH) of \SYSPILOTBBT with (IDIFFERENCE right 
                                                                                         left))
                    (replace (PILOTBBT PBTHEIGHT) of \SYSPILOTBBT with HEIGHT)
                    (\BITBLTSUB \SYSPILOTBBT NIL left NIL DESTINATIONBITMAP left (\SFInvert
                                                                                      
                                                                                    DESTINATIONBITMAP 
                                                                                      top)
                           HEIGHT
                           (QUOTE TEXTURE)
                           OPERATION TEXTURE)))
          (RETURN T))))
)
(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 (\DISPLAYDATA DDWIDTHSCACHE)
                                                     of DD)
                                         CHARCODE)))
(PUTPROPS \DSPGETCHARIMAGEWIDTH MACRO ((CHARCODE DD)
                                       (\FGETIMAGEWIDTH (ffetch (\DISPLAYDATA DDCHARIMAGEWIDTHS)
                                                               of DD)
                                              CHARCODE)))
(PUTPROPS \DSPGETCHAROFFSET MACRO ((CHARCODE DD)
                                   (\GETBASE (ffetch (\DISPLAYDATA DDOFFSETSCACHE)
                                                    of DD)
                                          CHARCODE)))
(PUTPROPS \CONVERTOP MACRO ((OP)
                            (* rrb "14-NOV-80 11:14")
                            (* Only for alto bitblt !!)
                            (SELECTQ OP (replace 0 of NIL with NIL)
                                   (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 (BITMAP 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 (BBT SourceType Operation)
                                       (PROGN (replace (PILOTBBT PBTOPERATION)
                                                     of BBT with (SELECTQ Operation (ERASE 1)
                                                                        (PAINT 2)
                                                                        (INVERT 3)
                                                                        0))
                                              (replace (PILOTBBT PBTSOURCETYPE)
                                                     of BBT 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

(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)                                                         (* kbr: 
                                                                          "15-Feb-86 22:01")
                                                                          (* Is X a 
                                                                          displaystream?)
    (AND (type? STREAM X)
         (FMEMB (fetch (IMAGEOPS IMAGETYPE) of (fetch (STREAM IMAGEOPS) of X))
                \DISPLAYSTREAMTYPES)
         X)))

(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: " 4-Apr-85 13:43")
    (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)
							(\INVALIDATEDISPLAYCACHE 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

(DSPCREATE
  [LAMBDA (DESTINATION)                                                    (* rrb 
                                                                           " 3-Feb-86 15:36")
                                                                           (* Creates a 
                                                                           stream-of-type-display 
                                                                           on the DESTINATION 
                                                                           bitmap or display 
                                                                           device)
    (PROG (DSTRM)
          [COND
             ((NULL DESTINATION)
              (SETQ DESTINATION ScreenBitMap))
             (T (\DTEST DESTINATION (QUOTE BITMAP]
          (SETQ DSTRM (create STREAM
                             USERCLOSEABLE ← NIL
                             OUTCHARFN ←(FUNCTION \DSPPRINTCHAR)
                             IMAGEDATA ←(create \DISPLAYDATA)
                             IMAGEOPS ← \DISPLAYIMAGEOPS
                             DEVICE ← DisplayFDEV
                             ACCESS ←(QUOTE OUTPUT)))                      (* initial x and y 
                                                                           positions are 0 when 
                                                                           the data is created.)
          (DSPFONT DEFAULTFONT DSTRM)                                      (* dspfont can win 
                                                                           since the (default) 
                                                                           display imageops are 
                                                                           filled in the stream)
          (DSPDESTINATION DESTINATION DSTRM)                               (* dspdestination calls 
                                                                           \SFFixFont, which 
                                                                           presumes there is a 
                                                                           font present.)
          (DSPFONT DEFAULTFONT DSTRM)
            
            (* the reference to SCREENWIDTH here is for historic reasons: until 
            3-feb-86 the default right margin was always SCREENWIDTH.
            It should be the width of the destination and for any destination larger 
            than the screen this is a serious bug and was fixed.
            The MAX of the right value and SCREENWIDTH was left in because existing 
            code might be assumine a large right margin for small bitmaps and auto-CR 
            in without it. rrb)

          (DSPRIGHTMARGIN (MAX SCREENWIDTH (fetch (BITMAP BITMAPWIDTH) of DESTINATION))
                 DSTRM)
          (DSPSOURCETYPE (QUOTE INPUT)
                 DSTRM)
          (DSPOPERATION (QUOTE REPLACE)
                 DSTRM)                                                    (* called to cause the 
                                                                           updating of the bitblt 
                                                                           table from the fields 
                                                                           initialized earlier.)
          (RETURN DSTRM])

(DSPDESTINATION
  (LAMBDA (DESTINATION DISPLAYSTREAM)                                     (* kbr: 
                                                                          " 6-Feb-86 17:32")
    (DECLARE (GLOBALVARS \DISPLAYIMAGEOPS \4DISPLAYIMAGEOPS \8DISPLAYIMAGEOPS \24DISPLAYIMAGEOPS))
    (PROG (DD)
          (SETQ DD (\GETDISPLAYDATA DISPLAYSTREAM DISPLAYSTREAM))
          (RETURN (PROG1 (ffetch (\DISPLAYDATA DDDestination) of DD)
                         (COND
                            (DESTINATION (SETQ DESTINATION (\DTEST DESTINATION (QUOTE BITMAP)))
                                   (UNINTERRUPTABLY
                                       (replace (STREAM DEVICE) of DISPLAYSTREAM
                                          with (SELECTQ (fetch (BITMAP BITMAPBITSPERPIXEL)
                                                           of DESTINATION)
                                                   (1 DisplayFDEV)
                                                   (4 \4DISPLAYFDEV)
                                                   (8 \8DISPLAYFDEV)
                                                   (24 \24DISPLAYFDEV)
                                                   (SHOULDNT)))
                                       (replace (STREAM IMAGEOPS) of DISPLAYSTREAM
                                          with (SELECTQ (fetch (BITMAP BITMAPBITSPERPIXEL)
                                                           of DESTINATION)
                                                   (1 \DISPLAYIMAGEOPS)
                                                   (4 \4DISPLAYIMAGEOPS)
                                                   (8 \8DISPLAYIMAGEOPS)
                                                   (24 \24DISPLAYIMAGEOPS)
                                                   (SHOULDNT)))
                                       (freplace (\DISPLAYDATA DDDestination) of DD with DESTINATION)
                                       (\SFFixDestination DD DISPLAYSTREAM)))))))))

(DSPTEXTURE
  (LAMBDA (TEXTURE DISPLAYSTREAM)                                     (* kbr: 
                                                                          "25-Feb-86 23:40")
    (PROG (DD BITSPERPIXEL)
          (SETQ DD (\GETDISPLAYDATA DISPLAYSTREAM))
          (RETURN (PROG1 (fetch (\DISPLAYDATA DDTexture) of DD)
                         (COND
                            ((NULL TEXTURE))
                            ((AND (BITMAPP TEXTURE)
                                  (EQ (fetch (BITMAP BITMAPRASTERWIDTH) of TEXTURE)
                                      1)
                                  (ILEQ (BITMAPHEIGHT TEXTURE)
                                        16))                              (* allow small bitmaps)
                             (freplace (\DISPLAYDATA DDTexture) of DD with TEXTURE))
                            ((FIXP TEXTURE)
                             (freplace (\DISPLAYDATA DDTexture) of DD with (LOGAND 
                                                                                              TEXTURE 
                                                                                             WORDMASK
                                                                                              )))
                            ((NOT (EQ (SETQ BITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL)
                                                            of (fetch (\DISPLAYDATA 
                                                                                     DDDestination)
                                                                      of DD)))
                                      1))
                             (freplace (\DISPLAYDATA DDTexture) of DD with (COLORNUMBERP
                                                                                        TEXTURE 
                                                                                        BITSPERPIXEL)
                                    ))
                            (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)                        (* kbr: "29-Jan-86 10:59")
                                                             (* fixes up those parts of the bitblt array which are 
							     dependent upon the destination)
    (PROG ((PBT (ffetch (\DISPLAYDATA DDPILOTBBT) of DISPLAYDATA))
	     (BM (ffetch (\DISPLAYDATA DDDestination) of DISPLAYDATA)))
	    (replace (PILOTBBT PBTDESTBPL) of PBT with (UNFOLD (ffetch (BITMAP 
										BITMAPRASTERWIDTH)
									of BM)
								     BITSPERWORD))
                                                             (* line width information will be updated by 
							     \SFFixFont)
	    (\SFFixClippingRegion DISPLAYDATA)
	    (\INVALIDATEDISPLAYCACHE DISPLAYDATA)
	    (\SFFixFont DISPLAYSTREAM DISPLAYDATA)
	    (RETURN))))

(\SFFixClippingRegion
  (LAMBDA (DISPLAYDATA)                                      (* kbr: "29-Jan-86 11:01")

          (* 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 (\DISPLAYDATA DDClippingRegion) of DISPLAYDATA))
	     (BM (ffetch (\DISPLAYDATA DDDestination) of DISPLAYDATA)))
	    (freplace (\DISPLAYDATA DDClippingRight) of DISPLAYDATA
	       with (IMAX 0 (IMIN (\DSPTRANSFORMX (IPLUS (ffetch (REGION LEFT)
								    of CLIPREG)
								 (ffetch (REGION WIDTH)
								    of CLIPREG))
							DISPLAYDATA)
					(ffetch (BITMAP BITMAPWIDTH) of BM))))
	    (freplace (\DISPLAYDATA DDClippingLeft) of DISPLAYDATA
	       with (IMIN (IMAX (\DSPTRANSFORMX (ffetch (REGION LEFT) of CLIPREG)
						      DISPLAYDATA)
				      0)
			      MAX.SMALL.INTEGER))
	    (freplace (\DISPLAYDATA DDClippingTop) of DISPLAYDATA
	       with (IMAX 0 (IMIN (\DSPTRANSFORMY (IPLUS (ffetch (REGION BOTTOM)
								    of CLIPREG)
								 (ffetch (REGION HEIGHT)
								    of CLIPREG))
							DISPLAYDATA)
					(ffetch (BITMAP BITMAPHEIGHT) of BM))))
	    (freplace (\DISPLAYDATA DDClippingBottom) of DISPLAYDATA
	       with (IMIN (IMAX (\DSPTRANSFORMY (ffetch (REGION BOTTOM) of CLIPREG)
						      DISPLAYDATA)
				      0)
			      MAX.SMALL.INTEGER)))))

(\SFFixFont
  (LAMBDA (DISPLAYSTREAM DISPLAYDATA)                        (* kbr: "29-Jan-86 11:03")
                                                             (* used to fix up those parts of the bitblt table 
							     which depend upon the FONT.
							     DISPLAYDATA is the IMAGEDATA for DISPLAYSTREAM, for 
							     convenience.)
    (PROG ((PILOTBBT (ffetch (\DISPLAYDATA DDPILOTBBT) of DISPLAYDATA))
	     (FONT (ffetch (\DISPLAYDATA DDFONT) of DISPLAYDATA))
	     (BITSPERPIXEL (ffetch (BITMAP BITMAPBITSPERPIXEL) of (ffetch (\DISPLAYDATA
										    DDDestination)
									   of DISPLAYDATA))))
	    (freplace (\DISPLAYDATA DDSlowPrintingCase) of DISPLAYDATA
	       with (OR (NOT (EQ BITSPERPIXEL 1))
			    (NOT (EQ (ffetch (FONTDESCRIPTOR ROTATION) of FONT)
					 0)))))
    (\INVALIDATEDISPLAYCACHE DISPLAYDATA)
    (\SFFIXLINELENGTH DISPLAYSTREAM)))

(\SFFIXLINELENGTH
  [LAMBDA (DISPLAYSTREAM)                                    (* gbn "30-Jan-86 18:42")

          (* 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 ((DD (fetch IMAGEDATA of DISPLAYSTREAM)))
	    (freplace (STREAM LINELENGTH) of DISPLAYSTREAM
	       with (IMIN MAX.SMALLP (IMAX 1 (IQUOTIENT (IDIFFERENCE (ffetch
										 (\DISPLAYDATA 
										    DDRightMargin)
										  of DD)
									       (ffetch
										 (\DISPLAYDATA 
										     DDLeftMargin)
										  of DD))
								(fetch FONTAVGCHARWIDTH
								   of (ffetch DDFONT
									   of DD])

(\SFFixY
  (LAMBDA (DISPLAYDATA CSINFO)                               (* rmk: " 4-Apr-85 13:50")

          (* makes that part of the bitblt table of a display stream which deals with the Y information consistent.
	  This is called from \BLTCHAR whenever a character is being printed and the charset/y-position caches are invalid)

                                                             (* assumes DISPLAYDATA has already been type checked.)
    (PROG ((PBT (ffetch DDPILOTBBT of DISPLAYDATA))
	     (Y (\DSPTRANSFORMY (ffetch DDYPOSITION of DISPLAYDATA)
				DISPLAYDATA))
	     TOP CHARTOP BM)
	    (SETQ CHARTOP (IPLUS Y (freplace DDCHARSETASCENT of DISPLAYDATA
					  with (ffetch CHARSETASCENT of CSINFO))))
	    (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 (CHARSETINFO 
										    CHARSETBITMAP)
									  of CSINFO)))
				  (ITIMES (ffetch BITMAPRASTERWIDTH of BM)
					    (freplace DDCHARHEIGHTDELTA of DISPLAYDATA
					       with (IMIN (IMAX (IDIFFERENCE CHARTOP TOP)
								      0)
							      MAX.SMALL.INTEGER)))))
	    (freplace PBTHEIGHT of PBT
	       with (IMAX (IDIFFERENCE TOP (IMAX (IDIFFERENCE Y
									(freplace DDCHARSETDESCENT
									   of DISPLAYDATA
									   with (ffetch 
										   CHARSETDESCENT
										     of CSINFO)))
							 (ffetch DDClippingBottom of DISPLAYDATA))
					     )
			      0)))))
)
(DEFINEQ

(\DSPCLIPPINGREGION.DISPLAY
  (LAMBDA (DISPLAYSTREAM REGION)                             (* rmk: " 4-Apr-85 13:44")
                                                             (* sets the clipping region of a display stream.)
    (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)
					     (\INVALIDATEDISPLAYCACHE DD)))))))))

(\DSPFONT.DISPLAY
  (LAMBDA (DISPLAYSTREAM FONT)                               (* kbr: " 9-Jun-85 16:53")
                                                             (* sets the font that a display stream uses to print 
							     characters. DISPLAYSTREAM is guaranteed to be a stream
							     of type display)
    (PROG (XFONT OLDFONT DD)
	    (SETQ DD (fetch (STREAM IMAGEDATA) of DISPLAYSTREAM))
                                                             (* save old value to return, smash new value and 
							     update the bitchar portion of the record.)
	    (RETURN (PROG1 (SETQ OLDFONT (fetch (\DISPLAYDATA DDFONT) of DD))
			       (COND
				 (FONT (SETQ XFONT (OR (\COERCEFONTDESC FONT DISPLAYSTREAM T)
							   (FONTCOPY (ffetch (\DISPLAYDATA DDFONT)
									  of DD)
								       FONT)))
                                                             (* updating font information is fairly expensive 
							     operation. Don't bother unless font has changed.)
				       (OR (EQ XFONT OLDFONT)
					     (UNINTERRUPTABLY
                                                 (freplace (\DISPLAYDATA DDFONT) of DD
						    with XFONT)
						 (freplace (\DISPLAYDATA DDLINEFEED) of DD
						    with (IMINUS (fetch (FONTDESCRIPTOR 
											\SFHeight)
									of XFONT)))
                                                             (* This will be difference when spacefactor is 
							     implemented for the display.
							     *)
						 (freplace (\DISPLAYDATA DDSPACEWIDTH)
						    of DD with (\FGETCHARWIDTH XFONT
										   (CHARCODE SPACE))
							     )
						 (\SFFixFont DISPLAYSTREAM DD))))))))))

(\DISPLAY.PILOTBITBLT
  (LAMBDA (PILOTBBT N)                                       (* kbr: "13-Jun-85 16:06")
    (\PILOTBITBLT PILOTBBT N)))

(\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)                          (* rrb " 3-Oct-85 09:28")
                                                             (* sets the xposition that a carriage return returns 
							     to.)
    (PROG ((DD (fetch IMAGEDATA of DISPLAYSTREAM)))
	    (RETURN (PROG1 (ffetch DDLeftMargin of DD)
			       (AND XPOSITION (COND
					((NUMBERP XPOSITION)
					  (UNINTERRUPTABLY
                                              (freplace DDLeftMargin of DD with XPOSITION)
					      (\SFFIXLINELENGTH DISPLAYSTREAM)))
					(T (\ILLEGAL.ARG XPOSITION)))))))))

(\DSPOPERATION.DISPLAY
  (LAMBDA (DISPLAYSTREAM OPERATION)                          (* rmk: "12-Sep-84 09:56")
                                                             (* 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)))))))))

(\DSPRIGHTMARGIN.DISPLAY
  (LAMBDA (DISPLAYSTREAM XPOSITION)                          (* rrb " 3-Oct-85 09:29")
                                                             (* 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))
	      ((NUMBERP XPOSITION)                         (* Avoid fixing linelength if right margin hasn't 
							     changed.)
		(OR (EQUAL 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: " 4-Apr-85 13:45")
    (PROG ((DD (fetch IMAGEDATA of DISPLAYSTREAM)))
	    (RETURN (PROG1 (ffetch DDYPOSITION of DD)
			       (COND
				 ((NULL YPOSITION))
				 ((NUMBERP YPOSITION)
				   (UNINTERRUPTABLY
                                       (freplace DDYPOSITION of DD with YPOSITION)
				       (\INVALIDATEDISPLAYCACHE DD)))
				 (T (\ILLEGAL.ARG YPOSITION))))))))
)
(MOVD? (QUOTE \ILLEGAL.ARG)
       (QUOTE \COERCETODS))
(MOVD? (QUOTE NILL)
       (QUOTE WFROMDS))
(MOVD? (QUOTE NILL)
       (QUOTE WINDOWP))
(MOVD? (QUOTE NILL)
       (QUOTE INVERTW))

(RPAQ? PROMPTWINDOW T)

(RPAQ? \WINDOWWORLD NIL)

(RPAQ? \MAINSCREEN NIL)



(* Stub for window package)


(RPAQ? \TOPWDS )

(RPAQ? \SCREENBITMAPS )
(MOVD? (QUOTE NILL)
       (QUOTE \TOTOPWDS))
(DECLARE: DONTCOPY EVAL@COMPILE 
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: EVAL@COMPILE 

[PROGN [PUTPROPS \INSURETOPWDS DMACRO (OPENLAMBDA (DS)
                                             (OR (EQ DS \TOPWDS)
                                                 (COND ((FMEMB (DSPDESTINATION NIL DS)
                                                               \SCREENBITMAPS)
                                                        (\TOTOPWDS DS]
       (PUTPROPS \INSURETOPWDS MACRO ((DS)
                                      (* For non-window implementations)
                                      (PROGN]
[PUTPROPS .WHILE.TOP.DS. MACRO ((FIRST . REST)
                                (PROG (DISPINTERRUPT SOFTCURSORUP)
                                      (* FIRST should be a displaystream and a variable. This macro 
                                         may also take a soft cursor down, similar to the way 
                                         .WHILE.CURSOR.DOWN. does, but only if FIRST's destination is 
                                         the same as the soft cursor's destination. *)
                                      [COND (\SOFTCURSORP (SETQ SOFTCURSORUP
                                                                (AND \SOFTCURSORUPP
                                                                     (EQ (DSPDESTINATION NIL FIRST)
                                                                         \CURSORDESTINATION)))
                                                   (COND (SOFTCURSORUP (SETQ DISPINTERRUPT
                                                                             (\GETBASE 
                                                                                    \EM.DISPINTERRUPT 
                                                                                    0))
                                                                (\PUTBASE \EM.DISPINTERRUPT 0 0)
                                                                (\SOFTCURSORDOWN]
                                      (\INSURETOPWDS FIRST)
                                      (PROGN . REST)
                                      (COND (SOFTCURSORUP (\SOFTCURSORUPCURRENT)
                                                   (\PUTBASE \EM.DISPINTERRUPT 0 DISPINTERRUPT]
[PUTPROPS .WHILE.CURSOR.DOWN. MACRO ((FIRST . REST)
                                     (PROG (DISPINTERRUPT SOFTCURSORUP)
                                           (* This macro should wrap around any code that draws or 
                                              bitblts directly from or to a screen bitmap. E.g. 
                                              DRAWGRAYBOX in HLDISPLAY which puts up a shadow box 
                                              during GETREGION. The purpose of this macro is that a 
                                              soft (e.g. color)
                                              cursor's bits not be taken to be screen bits while 
                                              FIRST & REST are done. *)
                                           [COND (\SOFTCURSORP (SETQ SOFTCURSORUP \SOFTCURSORUPP)
                                                        (COND (SOFTCURSORUP (SETQ DISPINTERRUPT
                                                                                  (\GETBASE 
                                                                                    \EM.DISPINTERRUPT 
                                                                                         0))
                                                                     (\PUTBASE \EM.DISPINTERRUPT 0 0)
                                                                     (\SOFTCURSORDOWN]
                                           (PROGN FIRST . REST)
                                           (COND (SOFTCURSORUP (\SOFTCURSORUPCURRENT)
                                                        (\PUTBASE \EM.DISPINTERRUPT 0 DISPINTERRUPT]
)

(ADDTOVAR GLOBALVARS \TOPWDS)


(* END EXPORTED DEFINITIONS)

)



(* DisplayStream TTY functions)

(DEFINEQ

(TTYDISPLAYSTREAM
  (LAMBDA (DISPLAYSTREAM)                                    (* hdj "19-Sep-86 18:09")
                                                  (* ;; "Makes DISPLAYSTREAM be the ttydisplaystream")
    (DECLARE (GLOBALVARS \DEFAULTTTYDISPLAYSTREAM))
    (PROG1 \TERM.OFD (SETQ DISPLAYSTREAM (\OUTSTREAMARG DISPLAYSTREAM))
           (UNINTERRUPTABLY
               (LET ((DRIBBLESTREAM (DRIBBLEFILE)))
                    (COND
                       ((NOT (EQ DISPLAYSTREAM \TERM.OFD))(* ;; "First remove the old one (if any)")
                        (COND
                           ((AND \TERM.OFD (NOT (EQ \TERM.OFD \DEFAULTTTYDISPLAYSTREAM)))
                                                  (* ;; 
                                            "make sure caret is off before changing display streams.")
                            (\CHECKCARET)         (* ;; 
                                          "If we were dribbling, turn it off in old ttydisplaystream")
                            (if DRIBBLESTREAM
                                then (\REMOVEDRIBBLECHECK DRIBBLESTREAM))
                            (LET ((WIN (WFROMDS \TERM.OFD T)))
                                 (AND WIN (WINDOWPROP WIN (QUOTE \LINEBUF.OFD)
                                                 \LINEBUF.OFD)))))
                                                             (* ;;; "")
                                                             (* ;;; "Now install the new one.")
                                                             (* ;;; "")
                        (if (AND DRIBBLESTREAM (NEQ DISPLAYSTREAM \DEFAULTTTYDISPLAYSTREAM))
                            then (\ADDDRIBBLECHECK DISPLAYSTREAM DRIBBLESTREAM))
                                                  (* ; 
                            "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)
                                                         (SETQ WIN (WFROMDS DISPLAYSTREAM T))
                                                         (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)
                                                    (* ; "just in case, for backward compatibility")
                        ))                        (* ; "change scroll mode of tty stream to scroll.")
                    (COND
                       ((FMEMB (IMAGESTREAMTYPE DISPLAYSTREAM)
                               \DISPLAYSTREAMTYPES)
                        (DSPSCROLL (QUOTE ON)
                               DISPLAYSTREAM)                (* ; "Reset page characteristics.")
                        (PROG (DD)
                              (SETQ DD (fetch (STREAM IMAGEDATA) of DISPLAYSTREAM))
                              (PAGEHEIGHT (IQUOTIENT (IDIFFERENCE (fetch (\DISPLAYDATA DDClippingTop)
                                                                     of DD)
                                                            (fetch (\DISPLAYDATA DDClippingBottom)
                                                               of DD))
                                                 (IABS (fetch (\DISPLAYDATA DDLINEFEED) of DD)))))))))
           )))

(\REMOVEDRIBBLECHECK
  (LAMBDA (DISPLAYSTREAM)                                    (* hdj "17-Sep-86 13:45")
                                                          (* ;; "stop DISPLAYSTREAM from dribbling")
    (LET ((OC (STREAMPROP DISPLAYSTREAM (QUOTE OLD-OUTCHARFN))))
         (if OC
             then (UNINTERRUPTABLY
                      (replace OUTCHARFN of DISPLAYSTREAM with OC)
                      (STREAMPROP DISPLAYSTREAM (QUOTE OLD-OUTCHARFN)
                             NIL)
                      (STREAMPROP DISPLAYSTREAM (QUOTE DRIBBLESTREAM)
                             NIL))))))

(\ADDDRIBBLECHECK
  (LAMBDA (DISPLAYSTREAM DRIBBLESTREAM)                      (* hdj "17-Sep-86 13:20")
                                                  (* ;; "Make DISPLAYSTREAM dribble to DRIBBLESTREAM")
    (LET ((MYOUTCHARFN (fetch (STREAM OUTCHARFN) of DISPLAYSTREAM)))
         (COND
            ((NOT (EQ MYOUTCHARFN (FUNCTION \TTYOUTCHARFN)))
                                                  (* ;; "Only add if hasn't been done. Can be in this state if you do a HARDRESET and EXEC had a dribble file")
             (UNINTERRUPTABLY
                 (PUTSTREAMPROP DISPLAYSTREAM (QUOTE OLD-OUTCHARFN)
                        MYOUTCHARFN)
                 (PUTSTREAMPROP DISPLAYSTREAM (QUOTE DRIBBLESTREAM)
                        DRIBBLESTREAM)
                 (replace (STREAM OUTCHARFN) of DISPLAYSTREAM with (FUNCTION \TTYOUTCHARFN))))))))
)
(* FOLLOWING DEFINITIONS EXPORTED)


(DEFOPTIMIZER TTYDISPLAYSTREAM (&REST X) (COND
                                            ((NULL (CAR X))
                                             (QUOTE \TERM.OFD))
                                            (T (QUOTE IGNOREMACRO))))



(* END EXPORTED DEFINITIONS)

(DEFINEQ

(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)))))))
    ))

(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))
(DEFINEQ

(\DSPRESET.DISPLAY
  [LAMBDA (DISPLAYSTREAM)                                    (* gbn "30-Jan-86 17:57")
    (DECLARE (GLOBALVARS \CURRENTDISPLAYLINE))           (* resets a display stream)
    (PROG [CREG FONT FONTASCENT (DD (\DTEST (fetch (STREAM IMAGEDATA) of (SETQ 
										   DISPLAYSTREAM
										   (\OUTSTREAMARG
										     DISPLAYSTREAM)))
						(QUOTE \DISPLAYDATA]
	    (SETQ CREG (ffetch (\DISPLAYDATA DDClippingRegion) of DD))
	    (SETQ FONT (fetch (\DISPLAYDATA DDFONT) of DD))
	    (SETQ FONTASCENT (FONTASCENT FONT))
	    (SELECTQ (fetch (FONTDESCRIPTOR ROTATION) of FONT)
		       [0 (\DSPXPOSITION.DISPLAY DISPLAYSTREAM (ffetch (\DISPLAYDATA DDLeftMargin)
								    of DD))
			  (\DSPYPOSITION.DISPLAY DISPLAYSTREAM (ADD1 (IDIFFERENCE
									   (fetch (REGION TOP)
									      of CREG)
									   FONTASCENT]
		       (90 (\DSPXPOSITION.DISPLAY DISPLAYSTREAM (IPLUS (fetch (REGION LEFT)
									      of CREG)
									   FONTASCENT))
			   (\DSPYPOSITION.DISPLAY DISPLAYSTREAM (fetch (REGION BOTTOM)
								     of CREG)))
		       (270 (\DSPXPOSITION.DISPLAY DISPLAYSTREAM (IDIFFERENCE
						       (fetch (REGION RIGHT) of CREG)
						       FONTASCENT))
			    (\DSPYPOSITION.DISPLAY DISPLAYSTREAM (fetch (REGION TOP)
								      of CREG)))
		       (ERROR "only supported rotations are 0, 90 and 270"))
	    (BITBLT NIL NIL NIL DISPLAYSTREAM (fetch (REGION LEFT) of CREG)
		      (fetch (REGION BOTTOM) of CREG)
		      (fetch (REGION WIDTH) of CREG)
		      (fetch (REGION HEIGHT) of CREG)
		      (QUOTE TEXTURE)
		      (QUOTE REPLACE)
		      (ffetch (\DISPLAYDATA DDTexture) of DD))
                                                             (* if this display stream is the tty display stream of
							     a process, reset the # of lines in that process.)
	    (PROG ((X (WFROMDS DISPLAYSTREAM)))
		    (COND
		      ((AND X (SETQ X (WINDOWPROP X (QUOTE PROCESS)))
			      (EQ (PROCESS.TTY X)
				    DISPLAYSTREAM))
			(PROCESS.EVAL X (QUOTE (SETQ \CURRENTDISPLAYLINE 0])

(\DSPPRINTCHAR
  [LAMBDA (STREAM CHARCODE)                                                (* rrb 
                                                                           " 3-Feb-86 15:42")
                                                                           (* Displays the 
                                                                           character and 
                                                                           increments the 
                                                                           Xposition. STREAM is 
                                                                           guaranteed to be of 
                                                                           type display.)
    (\CHECKCARET STREAM)
    (PROG ((DD (ffetch (STREAM IMAGEDATA) of STREAM)))
          (SELECTC (ffetch (TERMCODE CCECHO) of (\SYNCODE \PRIMTERMSA CHARCODE))
              (REAL.CCE                                                    (* All fat characters 
                                                                           are defined as REAL 
                                                                           according to \SYNCODE, 
                                                                           so we don't have worry 
                                                                           about any of the 
                                                                           special cases)
                        (SELECTC CHARCODE
                            ((CHARCODE (EOL CR LF)) 
                                 (\DSPPRINTCR/LF CHARCODE STREAM)
                                 (freplace (STREAM 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 (ffetch (STREAM CHARPOSITION) of STREAM)
                                        1))))
              (INDICATE.CCE                                                (* Make sure that all 
                                                                           the chars in the 
                                                                           indicate-string fit on 
                                                                           the line or wrap-around 
                                                                           together.)
                            (PROG (STR)
                                  (SETQ STR (\INDICATESTRING CHARCODE))    (* This isn't right for 
                                                                           rotated fonts.
                                                                           But then there should 
                                                                           probably be a separate 
                                                                           rotated outcharfn)
                                  [COND
                                     ((IGREATERP (\STRINGWIDTH.DISPLAY STREAM STR)
                                             (IDIFFERENCE (ffetch (\DISPLAYDATA DDRightMargin)
                                                             of DD)
                                                    (ffetch (\DISPLAYDATA DDXPOSITION) of DD)))
                                      (\DSPPRINTCR/LF (CHARCODE EOL)
                                             STREAM)
                                      (freplace (STREAM CHARPOSITION) of STREAM with (NCHARS STR)))
                                     (T (add (ffetch (STREAM CHARPOSITION) of STREAM)
                                             (NCHARS STR]
                                  (for I from 1 do (\BLTCHAR (OR (NTHCHARCODE STR I)
                                                                 (RETURN))
                                                          STREAM DD))))
              (SIMULATE.CCE (SELCHARQ CHARCODE
                                 ((EOL CR LF) 
                                      (\DSPPRINTCR/LF CHARCODE STREAM)
                                      (freplace (STREAM CHARPOSITION) of STREAM with 0))
                                 (ESCAPE (\BLTCHAR (CHARCODE $)
                                                STREAM DD)
                                         (add (ffetch (STREAM CHARPOSITION) of STREAM)
                                              1))
                                 (BELL                                     (* make switching of 
                                                                           bits uninterruptable 
                                                                           but allow interrupts 
                                                                           between flashes.)
                                       (SELECTQ (MACHINETYPE)
                                           ((DANDELION DOVE) 
                                                [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 (ffetch (\DISPLAYDATA
                                                                                     DDXPOSITION)
                                                                               of DD)
                                                                      (ffetch (\DISPLAYDATA 
                                                                                     DDLeftMargin)
                                                                         of DD))
                                                               TABWIDTH)))
                                                  DD)
                                                 (ffetch (\DISPLAYDATA DDRightMargin) of DD))
                                                                           (* tab was past 
                                                                           rightmargin, force cr.)
                                                (\DSPPRINTCR/LF (CHARCODE EOL)
                                                       STREAM)))           (* return the number of 
                                                                           spaces taken.)
                                            (add (ffetch (STREAM CHARPOSITION) of STREAM)
                                                 (IQUOTIENT TABWIDTH SPACEWIDTH))))
                                 (PROGN                                    (* this case was copied 
                                                                           from \DSCCOUT.)
                                        (\BLTCHAR CHARCODE STREAM DD)
                                        (add (ffetch (STREAM CHARPOSITION) of STREAM)
                                             1))))
              (IGNORE.CCE)
              (SHOULDNT])

(\DSPPRINTCR/LF
  (LAMBDA (CODE DS)                                          (* kbr: "29-Jan-86 11:26")
                                                             (* CODE is EOL, CR, or LF Assumes that DS has been 
							     checked by \DSPPRINTCHAR)

          (* changed to call DSPXPOSITION and DSPYPOSITION instead of \DSPxPOSITION.DISPLAY so that it could be used in the 
	  hardcopy display stream case as well. Could go back to other method if efficiency becomes an issue.)


    (COND
      ((EQ DS (TTYDISPLAYSTREAM))
	(\STOPSCROLL?)                                     (* \STOPSCROLL may have turned on the caret.)
	(\CHECKCARET DS)))
    (PROG (BTM AMOUNT/BELOW Y ROTATION FONT (DD (fetch (STREAM IMAGEDATA) of DS)))
	    (COND
	      ((AND (fetch (\DISPLAYDATA DDSlowPrintingCase) of DD)
		      (NEQ (SETQ ROTATION (fetch (FONTDESCRIPTOR ROTATION)
						 of (fetch (\DISPLAYDATA DDFONT) of DD)))
			     0))
		(PROG ((CLIPREG (ffetch (\DISPLAYDATA DDClippingRegion) of DD))
			 X)
		        (COND
			  ((EQ CODE (CHARCODE EOL))      (* on LF, no change in X)
			    (COND
			      ((SETQ Y (fetch (\DISPLAYDATA DDEOLFN) of DD))
                                                             (* call the eol function for ds.)
				(APPLY* Y DS)))
			    (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 (fetch (\DISPLAYDATA DDXPOSITION) of DD)
					   (SELECTQ ROTATION
						      (90 (IMINUS (ffetch (\DISPLAYDATA 
										       DDLINEFEED)
								       of DD)))
						      (270 (ffetch (\DISPLAYDATA DDLINEFEED)
							      of DD))
						      (ERROR 
						     "Only rotations supported are 0, 90 and 270"))))
		        (COND
			  ((AND (fetch (\DISPLAYDATA DDScroll) of DD)
				  (SELECTQ
				    ROTATION
				    (90 (IGREATERP (SETQ AMOUNT/BELOW
						       (IDIFFERENCE
							 (\DSPTRANSFORMX X DD)
							 (IDIFFERENCE (fetch (\DISPLAYDATA 
										  DDClippingRight)
									   of DD)
									(fetch (FONTDESCRIPTOR
										   \SFDescent)
									   of (fetch
										  (\DISPLAYDATA
										    DDFONT)
										   of DD)))))
						     0))
				    (270 (IGREATERP (SETQ AMOUNT/BELOW
							(IDIFFERENCE
							  (IPLUS (fetch (\DISPLAYDATA 
										   DDClippingLeft)
								      of DD)
								   (fetch (FONTDESCRIPTOR 
										       \SFDescent)
								      of (fetch (\DISPLAYDATA
										      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 WDTH BKGRND DBITMAP HGHT KEPTWIDTH)
				    (SETQ LFT (fetch (\DISPLAYDATA DDClippingLeft) of DD))
				    (SETQ DBITMAP (fetch (\DISPLAYDATA DDDestination)
						       of DD))
				    (SETQ BTM (fetch (\DISPLAYDATA DDClippingBottom)
						   of DD))
				    (SETQ HGHT (IDIFFERENCE (ffetch (\DISPLAYDATA DDClippingTop)
								   of DD)
								BTM))
				    (SETQ WDTH (IDIFFERENCE (fetch (\DISPLAYDATA 
										  DDClippingRight)
								   of DD)
								LFT))
				    (SETQ BKGRND (ffetch (\DISPLAYDATA 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 X DS)))
	      (T (COND
		   ((EQ CODE (CHARCODE EOL))             (* on LF, no change in X)
		     (COND
		       ((SETQ Y (fetch (\DISPLAYDATA DDEOLFN) of DD))
                                                             (* call the eol function for ds.)
			 (APPLY* Y DS)))
		     (DSPXPOSITION (ffetch (\DISPLAYDATA DDLeftMargin) of DD)
				     DS)))
		 (SETQ Y (IPLUS (ffetch (\DISPLAYDATA DDYPOSITION) of DD)
				    (ffetch (\DISPLAYDATA DDLINEFEED) of DD)))
		 (COND
		   ((AND (fetch (\DISPLAYDATA DDScroll) of DD)
			   (IGREATERP (SETQ AMOUNT/BELOW
					  (IDIFFERENCE (IPLUS (SETQ BTM (fetch (\DISPLAYDATA
											 
										 DDClippingBottom)
										 of DD))
								  (fetch (FONTDESCRIPTOR \SFDescent)
								     of (fetch (\DISPLAYDATA
										     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 WDTH BKGRND DBITMAP HGHT)
			     (SETQ LFT (fetch (\DISPLAYDATA DDClippingLeft) of DD))
			     (SETQ DBITMAP (fetch (\DISPLAYDATA DDDestination) of DD))
			     (SETQ HGHT (IDIFFERENCE (ffetch (\DISPLAYDATA DDClippingTop)
							    of DD)
							 BTM))
			     (SETQ WDTH (IDIFFERENCE (fetch (\DISPLAYDATA DDClippingRight)
							    of DD)
							 LFT))
			     (SETQ BKGRND (ffetch (\DISPLAYDATA 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 Y DS))))))
)
(DEFINEQ

(\TTYBACKGROUND
  (LAMBDA NIL                                                (* lmm "30-Dec-85 20:22")

          (* 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.))


    (COND
      ((EQ (fetch KEYBOARDSTREAM of \LINEBUF.OFD)
	     \KEYBOARD.STREAM)
	(OR (TTY.PROCESSP)
	      (WAIT.FOR.TTY))
	(for X in TTYBACKGROUNDFNS do (APPLY* X))))
    (\BACKGROUND)))
)
(DEFINEQ

(DSPBACKUP
  [LAMBDA (WIDTH DISPLAYSTREAM)                              (* "Pavel" "25-Apr-86 16:37")
    (COND
       [[OR (DISPLAYSTREAMP DISPLAYSTREAM)
            (DISPLAYSTREAMP (SETQ DISPLAYSTREAM (GETSTREAM DISPLAYSTREAM (QUOTE OUTPUT]
        (PROG (FONT ROTATION BLTWIDTH XPOS (DD (\GETDISPLAYDATA DISPLAYSTREAM DISPLAYSTREAM)))
              [SETQ BLTWIDTH (IMIN WIDTH (IDIFFERENCE (SETQ XPOS (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)                (* uses DSPXPOSITION so that it works 
                                                             on both display streams and hardcopy 
                                                             display streams.)
                              (DSPXPOSITION (IDIFFERENCE XPOS BLTWIDTH)
                                     DISPLAYSTREAM)
                              (BITBLT NIL 0 0 DISPLAYSTREAM (fetch DDXPOSITION of 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]
       (T (FRPTQ WIDTH (PROGN (BOUT DISPLAYSTREAM (CHARCODE BS))
                              (BOUT DISPLAYSTREAM (CHARCODE SPACE))
                              (BOUT DISPLAYSTREAM (CHARCODE BS])
)

(RPAQ? \CARET.UP )
(DECLARE: DONTEVAL@LOAD DOCOPY 

(RPAQQ BELLCNT 2)

(RPAQQ BELLRATE 60)

(RPAQQ \DisplayStoppedForLogout NIL)

(RPAQQ TtyDisplayStream NIL)
)
(DEFINEQ

(COLORDISPLAYP
  (LAMBDA NIL                                                (* gbn: "26-Jan-86 16:16")
                                                             (* is the color display on?)
    (NOT (NULL ColorScreenBitMap))))
)
(DEFINEQ

(DISPLAYBEFOREEXIT
  [LAMBDA (EXITFN)                                           (* lmm "25-Apr-86 15:46")
    (COND
       ((DISPLAYSTARTEDP)                                    (* save cursor and background border 
                                                             so that they can be restored by 
                                                             DISPLAYAFTERENTRY when this sysout is 
                                                             restarted.)
        (SETQ \DisplayStoppedForLogout (CONS (CURSOR)
                                             (CHANGEBACKGROUNDBORDER)))
        (SELECTQ EXITFN
            (LOGOUT                                          (* Shut off display during logout)
                    (SHOWDISPLAY))
            (MAKESYS                                         (* on MAKESYS, clear screen)
                     (DSPRESET (TTYDISPLAYSTREAM))
                     (COND
                        ((WINDOWP PROMPTWINDOW)
                         (DSPRESET PROMPTWINDOW))))
            (SYSOUT NIL)
            (SHOULDNT])

(DISPLAYAFTERENTRY
  (LAMBDA (ENTRYFN)                                          (* hdj " 5-Feb-85 17:33")
                                                             (* 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 (\STARTDISPLAY)            (* restore the cursor.)
				(CURSOR (CAR \DisplayStoppedForLogout))
                                                             (* restore the display border.
							     Only does anything on a DANDELION)
				(CHANGEBACKGROUNDBORDER (CDR \DisplayStoppedForLogout))
				(SETQ \DisplayStoppedForLogout NIL)))
                                                             (* reset the time that the caret will flash.)
    (COND
      ((GETD (QUOTE CARETRATE))                          (* the caret rate has some global state which depends 
							     on the machine dependent clock.
							     This resets the internal state)
	(CARETRATE (CARETRATE))))))
)
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS BELLCNT BELLRATE TTYBACKGROUNDFNS \DisplayStoppedForLogout \CARET.UP)
)
(DECLARE: EVAL@COMPILE 

[PUTPROPS \CHECKCARET MACRO ((X)
                             (AND \CARET.UP (\CARET.DOWN X]
)


(* 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)                                     (* bvm: "14-Feb-85 00:45")
                                                             (* 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 (EQ (fetch DDXOFFSET of DD)
				      0)
				(EQ (fetch DDYOFFSET of DD)
				      0))                    (* 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 (\DISPLAYDATA DDXOFFSET)
                                                of DD]
[PUTPROPS \DSPTRANSFORMY MACRO ((Y DD)
                                (* transforms an y coordinate into the destination coordinate.)
                                (IPLUS Y (fetch (\DISPLAYDATA DDYOFFSET)
                                                of DD]
(PUTPROPS \OFFSETBOTTOM MACRO ((X)
                               (* gives the destination coordinate address of the origin.)
                               (fetch (\DISPLAYDATA DDYOFFSET)
                                      of X)))
(PUTPROPS \OFFSETLEFT MACRO ((DD)
                             (* returns the x origin of display data destination coordinates.)
                             (fetch (\DISPLAYDATA DDXOFFSET)
                                    of DD)))
)


(* END EXPORTED DEFINITIONS)

)



(* screen related functions)

(DEFINEQ

(UPDATESCREENDIMENSIONS
  (LAMBDA NIL                                                (* bvm: "10-Aug-85 23:06")

          (* * Sets SCREENWIDTH and SCREENHEIGHT according to machine)


    (SELECTC \MACHINETYPE
	       ((LIST \DOLPHIN \DORADO \DANDELION)
		 (SETQ SCREENWIDTH 1024)
		 (SETQ SCREENHEIGHT 808))
	       (\DAYBREAK (SETQ SCREENWIDTH (\DoveDisplay.ScreenWidth))
			  (SETQ SCREENHEIGHT (\DoveDisplay.ScreenHeight)))
	       (SHOULDNT))))

(\CreateScreenBitMap
  (LAMBDA (WIDTH HEIGHT)                                     (* bvm: "10-Aug-85 23:24")
    (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.)


    (LET ((RASTERWIDTH (FOLDHI WIDTH 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#)))
           (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 
(UPDATESCREENDIMENSIONS)


(RPAQ? SCREENHEIGHT 808)

(RPAQ? SCREENWIDTH 1024)

(RPAQ? \OLDSCREENHEIGHT 808)

(RPAQ? \OLDSCREENWIDTH 1024)

(RPAQ? \MaxScreenPage -1)

(RPAQ? ScreenBitMap (\CreateScreenBitMap SCREENWIDTH SCREENHEIGHT))

(RPAQ? ColorScreenBitMap NIL)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \OLDSCREENHEIGHT \OLDSCREENWIDTH \MaxScreenPage ScreenBitMap)
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(CURSOR.INIT)
)



(* initialization)


(RPAQ? \DISPLAYINFOALIST )
(DEFINEQ

(\CoerceToDisplayDevice
  (LAMBDA (NameOrDevice)                                     (* hdj " 8-Mar-85 10:29")
    (DECLARE (GLOBALVARS LastCreatedDisplayDevice))
    (LET ((DEV (OR NameOrDevice LastCreatedDisplayDevice)))
           (COND
	     ((type? FDEV DEV)
	       DEV)
	     (T (OR (\GETDEVICEFROMNAME DEV T T)
		      (ERROR "No color drivers have been loaded")))))))

(\CREATEDISPLAY
  (LAMBDA (DISPLAYNAME)                                      (* kbr: " 1-Jul-85 15:23")

          (* * create a new display device. Mainly used by device-independent color code)


    (PROG (FDEV)
	    (SETQ FDEV
	      (create FDEV
			DEVICENAME ← DISPLAYNAME
			RESETABLE ← NIL
			RANDOMACCESSP ← NIL
			PAGEMAPPED ← NIL
			CLOSEFILE ← (FUNCTION NILL)
			DELETEFILE ← (FUNCTION NILL)
			GETFILEINFO ← (FUNCTION NILL)
			OPENFILE ← (FUNCTION (LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV)
			    NAME))
			READPAGES ← (FUNCTION \ILLEGAL.DEVICEOP)
			SETFILEINFO ← (FUNCTION NILL)
			GENERATEFILES ← (FUNCTION \GENERATENOFILES)
			TRUNCATEFILE ← (FUNCTION NILL)
			WRITEPAGES ← (FUNCTION \ILLEGAL.DEVICEOP)
			GETFILENAME ← (FUNCTION (LAMBDA (NAME RECOG FDEV)
			    NAME))
			REOPENFILE ← (FUNCTION (LAMBDA (NAME)
			    NAME))
			EVENTFN ← (FUNCTION NILL)
			DIRECTORYNAMEP ← (FUNCTION NILL)
			HOSTNAMEP ← (FUNCTION NILL)
			BIN ← (FUNCTION \ILLEGAL.DEVICEOP)
			BOUT ← (FUNCTION \DSPPRINTCHAR)
			PEEKBIN ← (FUNCTION \ILLEGAL.DEVICEOP)
			BACKFILEPTR ← (FUNCTION \PAGEDBACKFILEPTR)
			BLOCKIN ← (FUNCTION \ILLEGAL.DEVICEOP)
			BLOCKOUT ← (FUNCTION \NONPAGEDBOUTS)
			DEVICEINFO ← (create DISPLAYSTATE
					       ONOFF ← (QUOTE OFF))))
	    (\DEFINEDEVICE DISPLAYNAME FDEV)
	    (RETURN FDEV))))

(DISPLAYSTREAMINIT
  (LAMBDA (N)                                                         (* kbr: 
                                                                          "24-Feb-86 12:53")
    (DECLARE (GLOBALVARS \LastTTYLines \TopLevelTtyWindow))           (* starts display and 
                                                                          sets N lines for tty at 
                                                                          top)
    (\STARTDISPLAY)
    (SETQ TtyDisplayStream (DSPCREATE))
    (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.)
          (TERMINAL-OUTPUT (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                                                (* kbr: "19-Jan-86 14:52")
    (PROG (OLDWINDOWS)
	    (UPDATESCREENDIMENSIONS)
	    (COND
	      ((AND (OR (NOT (EQ SCREENWIDTH \OLDSCREENWIDTH))
			    (NOT (EQ SCREENHEIGHT \OLDSCREENHEIGHT)))
		      \WINDOWWORLD)                          (* Need to move windows around so that they remain on 
							     screen, and/or fix the display to account for new 
							     raster width)
		(SETQ OLDWINDOWS (REVERSE (OPENWINDOWS)))
                                                             (* Returns bottom window first)
		(COND
		  ((OR (LESSP SCREENWIDTH \OLDSCREENWIDTH)
			 (LESSP SCREENHEIGHT \OLDSCREENHEIGHT))
                                                             (* Screen shrank, movement needed)
		    (\MOVE.WINDOWS.ONTO.SCREEN OLDWINDOWS)))

          (* Finally, close the windows to save their images. Do this in separate pass from the moving, in case somebody's 
	  MOVEFN tried to do something with a window we had closed)


		(for W in OLDWINDOWS do (\CLOSEW1 W))
		(COND
		  ((AND NIL (NOT (EQ SCREENWIDTH \OLDSCREENWIDTH)))
		    (\UPDATE.PBT.RASTERWIDTHS)))))
	    (UNINTERRUPTABLY
                (SETQ ScreenBitMap (\CreateScreenBitMap SCREENWIDTH SCREENHEIGHT))
		(SHOWDISPLAY (fetch (BITMAP BITMAPBASE) of ScreenBitMap)
			       (fetch (BITMAP BITMAPRASTERWIDTH) of ScreenBitMap))
		(SETQ \DisplayStarted T))
	    (SETQ WHOLESCREEN
	      (SETQ WHOLEDISPLAY
		(create REGION
			  LEFT ← 0
			  BOTTOM ← 0
			  WIDTH ← SCREENWIDTH
			  HEIGHT ← SCREENHEIGHT)))
	    (COND
	      (\MAINSCREEN (replace (SCREEN SCDESTINATION) of \MAINSCREEN with ScreenBitMap)
			   (replace (SCREEN SCWIDTH) of \MAINSCREEN with SCREENWIDTH)
			   (replace (SCREEN SCHEIGHT) of \MAINSCREEN with SCREENHEIGHT)))
	    (SETQ \CURSORDESTINATION ScreenBitMap)
	    (SETQ \CURSORDESTWIDTH SCREENWIDTH)
	    (SETQ \CURSORDESTHEIGHT SCREENHEIGHT)
	    (SETQ \CURSORDESTRASTERWIDTH (fetch (BITMAP BITMAPRASTERWIDTH) of ScreenBitMap))
	    (COND
	      (OLDWINDOWS                                    (* Now that we've created ScreenBitMap with the right 
							     raster width, put the windows back up)
			  (CHANGEBACKGROUND WINDOWBACKGROUNDSHADE)
			  (for W in (REVERSE OLDWINDOWS) do (\OPENW1 W))))
	    (SETQ \OLDSCREENHEIGHT SCREENHEIGHT)
	    (SETQ \OLDSCREENWIDTH SCREENWIDTH))))

(\MOVE.WINDOWS.ONTO.SCREEN
  (LAMBDA (WINDOWS)                                          (* bvm: "15-Aug-85 15:08")
    (COND
      ((for W in WINDOWS thereis (LET ((REG (fetch (WINDOW REG) of W)))
					      (OR (GREATERP (fetch (REGION RIGHT) of REG)
								SCREENWIDTH)
						    (GREATERP (fetch (REGION TOP) of REG)
								SCREENHEIGHT))))
                                                             (* Move all windows some if any are off screen)
	(LET (XFACTOR YFACTOR REG)
	       (SETQ XFACTOR (FQUOTIENT SCREENWIDTH \OLDSCREENWIDTH))
	       (SETQ YFACTOR (FQUOTIENT SCREENHEIGHT \OLDSCREENHEIGHT))
	       (for W in WINDOWS unless (NEQ W (MAINWINDOW W))
		  do                                       (* In the case of attached windows, move only the main
							     one, so that attached windows are properly dragged 
							     along)
		       (MOVEW (SETQ W (MAINWINDOW W T))
				(IMAX 0 (IDIFFERENCE (FIXR (FTIMES
								   XFACTOR
								   (fetch (REGION RIGHT)
								      of (SETQ REG
									     (fetch (WINDOW REG)
										of W)))))
							 (fetch (REGION WIDTH) of REG)))
				(IMAX 0 (IDIFFERENCE (FIXR (FTIMES YFACTOR
									   (fetch (REGION TOP)
									      of REG)))
							 (fetch (REGION HEIGHT) of REG))))))))))

(\UPDATE.PBT.RASTERWIDTHS
  (LAMBDA NIL                                                (* bvm: "11-Aug-85 00:12")

          (* * Fix all the cached bitblt tables that think they know what the screen width is)


    (\MAPMDS (QUOTE PILOTBBT)
	       (FUNCTION (LAMBDA (PAGENO)
		   (to (FOLDLO \MDSIncrement 16) bind (PBT ← (create POINTER
									   PAGE# ← PAGENO))
		      do 

          (* * NOTE: We are depending on PILOTBBT structures being 16-word units, and that the first 32-bit field is NOT the 
	  one we are smashing. That's so we don't trash links in the free list. In fact, since PBTDESTLO and PBTDESTHI are in
	  the first 32-bit field, we are actually guaranteed by the AND below not to touch any free PILOTBBT structures)


			   (COND
			     ((AND (EQ (fetch (PILOTBBT PBTDESTHI) of PBT)
					   (FOLDLO \VP.DISPLAY PAGESPERSEGMENT))
				     (EQ (fetch (PILOTBBT PBTDESTLO) of PBT)
					   0))               (* Destination is screen)
			       (replace (PILOTBBT PBTDESTBPL) of PBT with SCREENWIDTH)))
			   (SETQ PBT (\ADDBASE PBT 16))))))))

(\STOPDISPLAY
  (LAMBDA NIL                                                (* lmm " 7-Jan-86 17:59")
    (DECLARE (GLOBALVARS \MaxScreenPage))                (* Turn off Lisp display, go back to bcpl display.
							     Exists only for emergency use)
    (UNINTERRUPTABLY
        (SHOWDISPLAY)
	(\UNLOCKPAGES (fetch BITMAPBASE of ScreenBitMap)
			(ADD1 \MaxScreenPage))
	(SETQ \MaxScreenPage -1)
	(SETQ \DisplayStarted NIL))
    (PAGEHEIGHT 58)))

(\DEFINEDISPLAYINFO
  (LAMBDA (DISPLAYINFO)                                      (* kbr: " 1-Jul-85 17:39")
    (PROG (BUCKET)
	    (SETQ BUCKET (ASSOC (CAR DISPLAYINFO)
				    \DISPLAYINFOALIST))
	    (COND
	      (BUCKET (DREMOVE BUCKET \DISPLAYINFOALIST)))
	    (push \DISPLAYINFOALIST DISPLAYINFO))))
)
(DECLARE: EVAL@COMPILE DONTCOPY 

(ADDTOVAR DONTCOMPILEFNS \UPDATE.PBT.RASTERWIDTHS)
)
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: EVAL@COMPILE 

(PUTPROPS DISPLAYINITIALIZEDP MACRO (NIL (* always initialized now)
                                         T))
(PUTPROPS DISPLAYSTARTEDP MACRO (NIL \DisplayStarted))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \DisplayStarted \DisplayStreamsInitialized \DisplayInitialed WHOLEDISPLAY WHOLESCREEN 
       SCREENWIDTH SCREENHEIGHT)
)


(* END EXPORTED DEFINITIONS)


(ADDTOVAR GLOBALVARS WHOLESCREEN)
(DEFINEQ

(INITIALIZEDISPLAYSTREAMS
  (LAMBDA NIL                                                (* lmm " 7-Jan-86 16:51")
    (SETQ WHOLEDISPLAY (create REGION))
    (SETQ \SYSPILOTBBT (create PILOTBBT))                (* For BITBLT)
    (SETQ \SYSBBTEXTURE (BITMAPCREATE 16 16))            (* For texture handling in \BITBLTSUB)
                                                             (* A guaranteed display font is initialized here after
							     pup, font, and bitmap code has been loaded.)
    (SETQ \GUARANTEEDDISPLAYFONT (FONTCREATE (QUOTE GACHA)
						 10 NIL NIL (QUOTE DISPLAY)))
    (SETQ DEFAULTFONT (FONTCLASS (QUOTE DEFAULTFONT)
				     (LIST 1 \GUARANTEEDDISPLAYFONT)))))
)
(DECLARE: DOCOPY DONTEVAL@LOAD 

(RPAQQ \DisplayStarted NIL)

(RPAQQ \LastTTYLines 12)

(INITIALIZEDISPLAYSTREAMS)
(DISPLAYSTREAMINIT 1000)
)

(PUTPROPS LLDISPLAY FILETYPE COMPILE-FILE)
(PUTPROPS LLDISPLAY COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (21414 23282 (\FBITMAPBIT 21424 . 22001) (\NEWPAGE.DISPLAY 22003 . 22143) (INITBITMASKS 
22145 . 23280)) (24132 24685 (\CreateCursorBitMap 24142 . 24683)) (24797 81426 (BITBLT 24807 . 34511) 
(BLTSHADE 34513 . 35419) (\BITBLTSUB 35421 . 47778) (\GETPILOTBBTSCRATCHBM 47780 . 48483) (BITMAPCOPY 
48485 . 49102) (BITMAPCREATE 49104 . 50188) (BITMAPBIT 50190 . 59025) (BLTCHAR 59027 . 59603) (
\BLTCHAR 59605 . 65589) (\CHANGECHARSET.DISPLAY 65591 . 67457) (\INDICATESTRING 67459 . 68586) (
\SLOWBLTCHAR 68588 . 76116) (TEXTUREP 76118 . 76372) (INVERT.TEXTURE 76374 . 76646) (
INVERT.TEXTURE.BITMAP 76648 . 77915) (BITMAPWIDTH 77917 . 78347) (READBITMAP 78349 . 80343) (
\INSUREBITSPERPIXEL 80345 . 80705) (MAXIMUMCOLOR 80707 . 80850) (OPPOSITECOLOR 80852 . 81029) (
MAXIMUMSHADE 81031 . 81245) (OPPOSITESHADE 81247 . 81424)) (82358 82799 (BITMAPBIT.EXPANDER 82368 . 
82797)) (82800 124465 (\BITBLT.DISPLAY 82810 . 93953) (\BITBLT.BITMAP 93955 . 105024) (\BITBLT.MERGE 
105026 . 107112) (\BLTSHADE.DISPLAY 107114 . 115522) (\BLTSHADE.BITMAP 115524 . 124463)) (128645 
131787 (DISPLAYSTREAMP 128655 . 129209) (DSPSOURCETYPE 129211 . 130086) (DSPXOFFSET 130088 . 130995) (
DSPYOFFSET 130997 . 131785)) (131788 146030 (DSPCREATE 131798 . 135176) (DSPDESTINATION 135178 . 
137176) (DSPTEXTURE 137178 . 139305) (\DISPLAYSTREAMINCRXPOSITION 139307 . 139651) (\SFFixDestination 
139653 . 140547) (\SFFixClippingRegion 140549 . 142222) (\SFFixFont 142224 . 143206) (\SFFIXLINELENGTH
 143208 . 144045) (\SFFixY 144047 . 146028)) (146031 153031 (\DSPCLIPPINGREGION.DISPLAY 146041 . 
146732) (\DSPFONT.DISPLAY 146734 . 148550) (\DISPLAY.PILOTBITBLT 148552 . 148701) (
\DSPLINEFEED.DISPLAY 148703 . 149261) (\DSPLEFTMARGIN.DISPLAY 149263 . 149940) (\DSPOPERATION.DISPLAY 
149942 . 150834) (\DSPRIGHTMARGIN.DISPLAY 150836 . 151682) (\DSPXPOSITION.DISPLAY 151684 . 152499) (
\DSPYPOSITION.DISPLAY 152501 . 153029)) (157538 163924 (TTYDISPLAYSTREAM 157548 . 162373) (
\REMOVEDRIBBLECHECK 162375 . 163019) (\ADDDRIBBLECHECK 163021 . 163922)) (164240 165197 (DSPSCROLL 
164250 . 164836) (PAGEHEIGHT 164838 . 165195)) (165249 183544 (\DSPRESET.DISPLAY 165259 . 167575) (
\DSPPRINTCHAR 167577 . 175688) (\DSPPRINTCR/LF 175690 . 183542)) (183545 184152 (\TTYBACKGROUND 183555
 . 184150)) (184153 187585 (DSPBACKUP 184163 . 187583)) (187768 188029 (COLORDISPLAYP 187778 . 188027)
) (188030 190389 (DISPLAYBEFOREEXIT 188040 . 189159) (DISPLAYAFTERENTRY 189161 . 190387)) (190744 
194562 (\DSPCLIPTRANSFORMX 190754 . 191292) (\DSPCLIPTRANSFORMY 191294 . 191900) (\DSPTRANSFORMREGION 
191902 . 192455) (\DSPUNTRANSFORMY 192457 . 192789) (\DSPUNTRANSFORMX 192791 . 193123) (
\OFFSETCLIPPINGREGION 193125 . 194560)) (195714 198011 (UPDATESCREENDIMENSIONS 195724 . 196223) (
\CreateScreenBitMap 196225 . 198009)) (198557 211022 (\CoerceToDisplayDevice 198567 . 198987) (
\CREATEDISPLAY 198989 . 200421) (DISPLAYSTREAMINIT 200423 . 204864) (\STARTDISPLAY 204866 . 207529) (
\MOVE.WINDOWS.ONTO.SCREEN 207531 . 208998) (\UPDATE.PBT.RASTERWIDTHS 209000 . 210172) (\STOPDISPLAY 
210174 . 210677) (\DEFINEDISPLAYINFO 210679 . 211020)) (211586 212364 (INITIALIZEDISPLAYSTREAMS 211596
 . 212362)))))
STOP