(FILECREATED "13-Dec-84 13:31:25" {ROSEBOWL}<BIRD>NEW>TMP>BACKGROUND.;14 15560
changes to: (FNS BACKGROUNDDESTINATION DESTINATION.RELEASE)
(VARS BACKGROUNDCOMS)
(MACROS \BG.DEST.POP \BG.DEST.PUSH)
previous date: "29-Oct-84 18:43:52" {ROSEBOWL}<BIRD>NEW>TMP>BACKGROUND.;11)
(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT BACKGROUNDCOMS)
(RPAQQ BACKGROUNDCOMS ((FILES BOUNDARY)
(FNS BACKGROUNDDESTINATION BITBLTTOBACKGROUND BITBLTTODESTINATION
DESTINATION.RELEASE \BG.TEXTURESHIFT \BG.DETERMINEBOUNDARIES)
[DECLARE: DOEVAL@LOAD DONTEVAL@COMPILE DONTCOPY (P (IMPORTFILE (QUOTE WINDOW]
(RECORDS \BG.DEST)
(VARS (\BG.TEXTURE.BITMAP (BITMAPCREATE 4 4))
(\BG.DEST.FREELIST NIL))
(PROP GLOBALVAR \BG.TEXTURE.BITMAP)
(MACROS \BG.DEST.POP \BG.DEST.PUSH)))
(FILESLOAD BOUNDARY)
(DEFINEQ
(BACKGROUNDDESTINATION
[LAMBDA (DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT CLIPPINGREGION)
(* mgb: "13-Dec-84 13:30")
(DECLARE (LOCALVARS . T))
(PROG (TEXXORG TEXYORG DESTINATIONRIGHT DESTINATIONTOP BORDER LL RR TT BB DR DL DB XOFFSET
YOFFSET)
(COND
((NULL DESTINATIONLEFT)
(SETQ DESTINATIONLEFT 0)))
(COND
((NULL DESTINATIONBOTTOM)
(SETQ DESTINATIONBOTTOM 0)))
(SETQ XOFFSET (IMINUS DESTINATIONLEFT))
(SETQ YOFFSET (IMINUS DESTINATIONBOTTOM))
(COND
[(WINDOWP DESTINATION)
(SETQ BORDER (fetch WBORDER of DESTINATION))
(SETQ DR (fetch REG of DESTINATION))
(SETQ DL (fetch LEFT of DR))
(SETQ DB (fetch BOTTOM of DR))
(SETQ DESTINATIONRIGHT (WINDOWPROP DESTINATION (QUOTE WIDTH)))
(SETQ DESTINATIONTOP (WINDOWPROP DESTINATION (QUOTE HEIGHT)))
(SETQ TEXXORG (IMINUS (IPLUS DL BORDER)))
(SETQ TEXYORG (IMINUS (IPLUS DB BORDER DESTINATIONTOP]
(T [SETQ DESTINATIONRIGHT (CONSTANT (fetch BITMAPWIDTH of (SCREENBITMAP]
[SETQ DESTINATIONTOP (CONSTANT (fetch BITMAPHEIGHT of (SCREENBITMAP]
(SETQ TEXXORG 0)
(SETQ TEXYORG 0)))
(COND
((AND WIDTH (ILESSP (SETQ RR (IPLUS DESTINATIONLEFT WIDTH))
DESTINATIONRIGHT))
(SETQ DESTINATIONRIGHT RR)))
(COND
((AND HEIGHT (ILESSP (SETQ TT (IPLUS DESTINATIONBOTTOM HEIGHT))
DESTINATIONTOP))
(SETQ DESTINATIONTOP TT)))
[COND
(CLIPPINGREGION (SETQ LL (fetch LEFT of CLIPPINGREGION))
(SETQ RR (IPLUS LL (fetch WIDTH of CLIPPINGREGION)))
(SETQ BB (fetch BOTTOM of CLIPPINGREGION))
(SETQ TT (IPLUS BB (fetch HEIGHT of CLIPPINGREGION)))
(COND
((IGREATERP LL DESTINATIONLEFT)
(SETQ DESTINATIONLEFT LL)))
(COND
((ILESSP RR DESTINATIONRIGHT)
(SETQ DESTINATIONRIGHT RR)))
(COND
((IGREATERP BB DESTINATIONBOTTOM)
(SETQ DESTINATIONBOTTOM BB)))
(COND
((ILESSP TT DESTINATIONTOP)
(SETQ DESTINATIONTOP TT]
(COND
((ILESSP DESTINATIONLEFT 0)
(SETQ DESTINATIONLEFT 0)))
(COND
((ILESSP DESTINATIONBOTTOM 0)
(SETQ DESTINATIONBOTTOM 0)))
[COND
((WINDOWP DESTINATION)
(SETQ RR (IPLUS BORDER DL))
(SETQ TT (IPLUS BORDER DB))
(add DESTINATIONLEFT RR)
(add DESTINATIONRIGHT RR)
(add DESTINATIONBOTTOM TT)
(add DESTINATIONTOP TT)
(SETQ XOFFSET (IDIFFERENCE XOFFSET RR))
(SETQ YOFFSET (IDIFFERENCE YOFFSET TT]
(RETURN (AND (ILESSP DESTINATIONLEFT DESTINATIONRIGHT)
(ILESSP DESTINATIONBOTTOM DESTINATIONTOP)
(PROG ((BNDS (\BG.DETERMINEBOUNDARIES (BOUNDARY.CREATE DESTINATIONLEFT
DESTINATIONBOTTOM
DESTINATIONRIGHT
DESTINATIONTOP)
DESTINATION)))
(RETURN (COND
(\BG.DEST.FREELIST (create \BG.DEST
XSHIFT ← XOFFSET
YSHIFT ← YOFFSET
XTEX ← TEXXORG
YTEX ← TEXYORG
BBNDS ←(CAR BNDS)
WBNDS ←(CDR BNDS)
smashing (\BG.DEST.POP \BG.DEST.FREELIST)
))
(T (create \BG.DEST
XSHIFT ← XOFFSET
YSHIFT ← YOFFSET
XTEX ← TEXXORG
YTEX ← TEXYORG
BBNDS ←(CAR BNDS)
WBNDS ←(CDR BNDS])
(BITBLTTOBACKGROUND
[LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH
HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION)
(* mgb: "24-Oct-84 19:54")
(DECLARE (LOCALVARS . T))
(BITBLTTODESTINATION SOURCEBITMAP SOURCELEFT SOURCEBOTTOM (BACKGROUNDDESTINATION DESTINATION
DESTINATIONLEFT
DESTINATIONBOTTOM
WIDTH HEIGHT
CLIPPINGREGION)
NIL NIL NIL NIL SOURCETYPE OPERATION TEXTURE T])
(BITBLTTODESTINATION
[LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH
HEIGHT SOURCETYPE OPERATION TEXTURE RELEASEBOUNDARIES)
(* edited: "29-Oct-84 18:39")
(DECLARE (LOCALVARS . T))
(COND
(DESTINATION
(PROG ((XTEX (fetch XTEX of DESTINATION))
(YTEX (fetch YTEX of DESTINATION))
(XOFFSET (IDIFFERENCE (OR DESTINATIONLEFT 0)
(fetch XSHIFT of DESTINATION)))
(YOFFSET (IDIFFERENCE (OR DESTINATIONBOTTOM 0)
(fetch YSHIFT of DESTINATION)))
RIGHT TOP SOURCEWIDTH SOURCEHEIGHT SOURCEREGION RESULT)
(SETQ TEXTURE (SELECTQ SOURCETYPE
[(TEXTURE MERGE)
(COND
((FIXP TEXTURE))
((BITMAPP TEXTURE)
(CREATETEXTUREFROMBITMAP TEXTURE))
(T (BITBLT NIL NIL NIL \BG.TEXTURE.BITMAP NIL NIL NIL NIL
(QUOTE TEXTURE)
(QUOTE REPLACE)
TEXTURE)
(CREATETEXTUREFROMBITMAP \BG.TEXTURE.BITMAP]
((INPUT INVERT)
NIL)
(\ILLEGAL.ARG SOURCETYPE)))
(SETQ RIGHT (COND
(WIDTH (IPLUS WIDTH XOFFSET))
(T 32768)))
(SETQ TOP (COND
(HEIGHT (IPLUS HEIGHT YOFFSET))
(T 32768)))
[COND
((NEQ SOURCETYPE (QUOTE TEXTURE))
(SETQ SOURCELEFT (IDIFFERENCE (OR SOURCELEFT 0)
XOFFSET))
(SETQ SOURCEBOTTOM (IDIFFERENCE (OR SOURCEBOTTOM 0)
YOFFSET))
(COND
((BITMAPP SOURCEBITMAP)
(SETQ SOURCEWIDTH (ffetch BITMAPWIDTH of SOURCEBITMAP))
(SETQ SOURCEHEIGHT (ffetch BITMAPHEIGHT of SOURCEBITMAP)))
[(WINDOWP SOURCEBITMAP)
(SETQ SOURCEWIDTH (WINDOWPROP SOURCEBITMAP (QUOTE WIDTH)))
(SETQ SOURCEHEIGHT (WINDOWPROP SOURCEBITMAP (QUOTE HEIGHT]
((DISPLAYSTREAMP SOURCEBITMAP)
(SETQ SOURCEREGION (DSPCLIPPINGREGION SOURCEBITMAP))
(SETQ SOURCEWIDTH (fetch WIDTH of SOURCEREGION))
(SETQ SOURCEHEIGHT (fetch HEIGHT of SOURCEREGION)))
(T (\ILLEGAL.ARG SOURCEBITMAP]
[for (BOUNDARY ←(fetch BBNDS of DESTINATION)) by (fetch NEXT.BOUND of BOUNDARY)
while BOUNDARY bind BL BB BW BH SL SB SHIFTEX
do (COND
((AND (IGREATERP [SETQ BW (IDIFFERENCE (IMIN (fetch RIGHT.BOUND of BOUNDARY)
RIGHT)
(SETQ BL (IMAX (ffetch LEFT.BOUND
of BOUNDARY)
XOFFSET]
0)
(IGREATERP BL (IMINUS BW))
[OR (NULL SOURCEWIDTH)
(AND (ILESSP (SETQ SL (IPLUS SOURCELEFT BL))
SOURCEWIDTH)
(IGREATERP SL (IMINUS BW]
(IGREATERP [SETQ BH (IDIFFERENCE (IMIN (ffetch TOP.BOUND of BOUNDARY)
TOP)
(SETQ BB (IMAX (ffetch BOTTOM.BOUND
of BOUNDARY)
YOFFSET]
0)
(IGREATERP BB (IMINUS BH))
[OR (NULL SOURCEHEIGHT)
(AND (ILESSP (SETQ SB (IPLUS SOURCEBOTTOM BB))
SOURCEHEIGHT)
(IGREATERP SB (IMINUS BH]
(OR [BITBLT SOURCEBITMAP SL SB (SCREENBITMAP)
BL BB BW BH SOURCETYPE OPERATION
(AND TEXTURE (OR SHIFTEX (SETQ SHIFTEX (\BG.TEXTURESHIFT
TEXTURE XTEX YTEX]
(SHOULDNT "BITBLT to screen bitmap didn't move anything")))
(SETQ RESULT T)))
finally (COND
(RELEASEBOUNDARIES (BOUNDARY.RELEASE (fetch BBNDS of DESTINATION]
[for X in (fetch WBNDS of DESTINATION) bind W WR L B SLL SBB
do (SETQ W (CAR X))
(SETQ WR (fetch REG of W))
(SETQ L (fetch LEFT of WR))
(SETQ B (fetch BOTTOM of WR))
[COND
(SOURCEWIDTH (SETQ SLL (IPLUS SOURCELEFT L]
[COND
(SOURCEHEIGHT (SETQ SBB (IPLUS SOURCEBOTTOM B]
(for (BOUNDARY ←(CDR X)) by (fetch NEXT.BOUND of BOUNDARY) while BOUNDARY
bind BL BB BW BH SL SB SHIFTEX
do (COND
((AND (IGREATERP [SETQ BW (IDIFFERENCE (IMIN (fetch RIGHT.BOUND
of BOUNDARY)
RIGHT)
(SETQ BL
(IMAX (ffetch LEFT.BOUND
of BOUNDARY)
XOFFSET]
0)
(IGREATERP (add BL (IMINUS L))
(IMINUS BW))
[OR (NULL SOURCEWIDTH)
(AND (ILESSP (SETQ SL (IPLUS SLL BL))
SOURCEWIDTH)
(IGREATERP SL (IMINUS BW]
(IGREATERP [SETQ BH (IDIFFERENCE (IMIN (ffetch TOP.BOUND
of BOUNDARY)
TOP)
(SETQ BB
(IMAX (ffetch BOTTOM.BOUND
of BOUNDARY)
YOFFSET]
0)
(IGREATERP (add BB (IMINUS B))
(IMINUS BH))
[OR (NULL SOURCEHEIGHT)
(AND (ILESSP (SETQ SB (IPLUS SBB BB))
SOURCEHEIGHT)
(IGREATERP SB (IMINUS BH]
(OR [BITBLT SOURCEBITMAP SL SB (fetch SAVE of W)
BL BB BW BH SOURCETYPE OPERATION
(AND TEXTURE
(OR SHIFTEX (SETQ SHIFTEX
(\BG.TEXTURESHIFT TEXTURE (IPLUS L XTEX)
(IPLUS B
(fetch HEIGHT
of WR)
YTEX]
(SHOULDNT "BITBLT to window bitmap didn't move anything")))
(SETQ RESULT T)))
finally (COND
(RELEASEBOUNDARIES (BOUNDARY.RELEASE (CDR X]
(RETURN RESULT])
(DESTINATION.RELEASE
[LAMBDA (DST) (* mgb: "13-Dec-84 12:33")
(DECLARE (LOCALVARS . T))
(BOUNDARY.RELEASE (fetch BBNDS of DST))
(for X in (fetch WBNDS of DST) do (BOUNDARY.RELEASE (CDR X)))
(\BG.DEST.PUSH \BG.DEST.FREELIST DST])
(\BG.TEXTURESHIFT
[LAMBDA (TEXTURE LEFT BOTTOM) (* mgb: "23-Oct-84 16:04")
(DECLARE (LOCALVARS . T))
(SETQ LEFT (IMOD LEFT 4))
(SETQ BOTTOM (IMOD BOTTOM 4))
(COND
((OR (NOT (ZEROP LEFT))
(NOT (ZEROP BOTTOM)))
(bind (RESULT ← 0)
(Y ← 12)
(MY ←(ITIMES (IDIFFERENCE 3 BOTTOM)
4))
[MX ←(COND
((ZEROP LEFT)
3)
(T (SUB1 LEFT]
(Z ← 15) do [when (BITTEST TEXTURE (ELT BITMASKARRAY (IPLUS MX MY)))
do (SETQ RESULT (BITSET RESULT (ELT BITMASKARRAY Z)))
repeatwhile (PROG1 (NEQ Z Y)
(SETQ Z (SUB1 Z))
(SETQ MX (COND
((ZEROP MX)
3)
(T (SUB1 MX]
repeatwhile (COND
((NOT (ZEROP Y))
(SETQ Y (IDIFFERENCE Y 4))
[SETQ MY (COND
((ZEROP MY)
12)
(T (IDIFFERENCE MY 4]
T))
finally (RETURN RESULT)))
(T TEXTURE])
(\BG.DETERMINEBOUNDARIES
[LAMBDA (BOUNDARY DEST) (* edited: "26-Oct-84 17:11")
(DECLARE (LOCALVARS . T))
(PROG (WINDOWS WINS (BBNDS BOUNDARY))
(for (W ← TOPW) by (fetch NEXTW of W) while (NEQ W DEST)
do (COND
((NULL W)
(\ILLEGAL.ARG DEST)))
(push WINDOWS W))
[for W in WINDOWS while BBNDS bind WBNDS WREG WL WB WR WT B IB DB MERGE
do (SETQ WREG (fetch REG of W))
(SETQ WL (fetch LEFT of WREG))
(SETQ WB (fetch BOTTOM of WREG))
(SETQ WR (IPLUS WL (fetch WIDTH of WREG)))
(SETQ WT (IPLUS WB (fetch HEIGHT of WREG)))
(* * Handle (LENGTH BBNDS) =1 specially for performance)
[COND
[(fetch NEXT.BOUND of BBNDS)
(for old (B ← BBNDS) by NEXT while B bind NEXT
first (SETQ WBNDS NIL)
(SETQ BBNDS NIL)
do (SETQ NEXT (fetch NEXT.BOUND of B))
(freplace NEXT.BOUND of B with NIL)
(COND
((SETQ IB (BOUNDARY.INTERSECTION* B WL WB WR WT))
(COND
((SETQ DB (BOUNDARY.DIFFERENCE B IB))
(SETQ BBNDS (BOUNDARY.MERGE BBNDS DB))
(SETQ MERGE T)))
(SETQ WBNDS (BOUNDARY.MERGE WBNDS IB))
(BOUNDARY.RELEASE B))
(MERGE (SETQ BBNDS (BOUNDARY.MERGE BBNDS B)))
(T (BOUNDARY.PUSH BBNDS B]
(T (SETQ B BBNDS)
(COND
((SETQ IB (BOUNDARY.INTERSECTION* B WL WB WR WT))
(SETQ WBNDS IB)
(SETQ BBNDS (BOUNDARY.DIFFERENCE B IB))
(BOUNDARY.RELEASE B))
(T (SETQ WBNDS NIL]
(COND
(WBNDS (push WINS (CONS W WBNDS]
(RETURN (CONS BBNDS WINS])
)
(DECLARE: DOEVAL@LOAD DONTEVAL@COMPILE DONTCOPY
(IMPORTFILE (QUOTE WINDOW))
)
[DECLARE: EVAL@COMPILE
(RECORD \BG.DEST (XSHIFT YSHIFT XTEX YTEX BBNDS WBNDS))
]
(RPAQ \BG.TEXTURE.BITMAP (BITMAPCREATE 4 4))
(RPAQQ \BG.DEST.FREELIST NIL)
(PUTPROPS \BG.TEXTURE.BITMAP GLOBALVAR T)
(DECLARE: EVAL@COMPILE
(PUTPROPS \BG.DEST.POP MACRO [(STACK)
(PROG1 STACK (change STACK (fetch XSHIFT of STACK])
(PUTPROPS \BG.DEST.PUSH MACRO ((STACK ITEM)
(replace XSHIFT of ITEM with STACK)
(change STACK ITEM)))
)
(PUTPROPS BACKGROUND COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (913 14892 (BACKGROUNDDESTINATION 923 . 4881) (BITBLTTOBACKGROUND 4883 . 5467) (
BITBLTTODESTINATION 5469 . 11503) (DESTINATION.RELEASE 11505 . 11852) (\BG.TEXTURESHIFT 11854 . 12977)
(\BG.DETERMINEBOUNDARIES 12979 . 14890)))))
STOP