;;; -*- Mode:COMMON-LISP; Package:X11; Base:10.; Fonts:(MEDFNB hl12B hl12bi) -*- ;;; RESTRICTED RIGHTS LEGEND ;;;Use, duplication, or disclosure by the Government is subject to ;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in ;;;Technical Data and Computer Software clause at 52.227-7013. ;;; ;;; TEXAS INSTRUMENTS INCORPORATED. ;;; P.O. BOX 2909 ;;; AUSTIN, TEXAS 78769 ;;; MS 2151 ;;; ;;; Copyright (C) 1987, Texas Instruments Incorporated. All rights reserved. ;;; Change history: ;;; ;;; Date Author Description ;;; ------------------------------------------------------------------------------------- ;;; 03/29/89 WJB Patch 1.64; Rewrite CHANGE-BORDER-WIDTH to work. ;;; 02/21/89 DAN Patch 1.17; Fix bug in COPY-WINDOW-CONTENTS introduced by fix of 10/27/88. ;;; 02/09/89 WJB Patch 1.10: Correct expose events in RECOVER-OBSCURED-CONTENTS when ;;; window has no siblings. ;;; 02/07/89 WJB Patch 1.8: Correct expose events in SLIDE-AND-SIZE-WINDOW by calling ;;; expose-window-portion instead of expose-events. ;;; 02/07/89 WJB Patch 1.7: Correct expose events with moving/restacking windows (the right way) ;;; Changed CONFIGURE-WINDOW to pass "state" arg to reflect-stack-change ;;; Changed REFLECT-STACK-CHANGE to use EXPOSE-WINDOW-PORTION and RECOVER-OBSCURED-CONTENTS ;;; Changed COPY-WINDOW-CONTENTS to use EXPOSE-WINDOW-PORTION ;;; Changed RECOVER-OBSCURED-CONTENTS to only call expose-events when necessary ;;; and to update parent outside the main loop. ;;; 02/01/89 WJB Patch 1.4: Corrected expose event handling when restacking windows. ;;; Modified REFLECT-STACK-CHANGE and WINDOW-EXPOSURES. Eliminated ;;; MARK-SIBLINGS-BELOW-ME (moved to bone-yard). ;;; 01/13/89 DAN Fixed I-OVERLAP-ANY-WINDOW, ANY-WINDOW-OVERLAPS-ME, MARK-SIBLINGS- ;;; BELOW-ME, SLIDE-AND-SIZE-WINDOW, and RECOVER-OBSCURED-CONTENTS to ;;; check for INPUT-ONLY windows. ;;; 11/30/88 DAN Fixed WINDOW-EXPOSURES to loop through the occlusion-stack boxex. ;;; 11/02/88 DAN Fixed SLIDE-AND-SIZE-WINDOW to pass the correct deltas to ;;; REPOSITION-CHILDREN. ;;; 10/27/88 WJB Clip to destination boundries in COPY-WINDOW-CONTENTS -- not sure about ;;; the correctness of this, maybe the occlusion stack should be handling this. ;;; 10/26/88 WJB Force cursor removal in CONFIGURE-WINDOW. ;;; 10/118*/88 LGO 1In configure-window, don't barf on input-only windows* ;;; 10/114*/88 LGO 1Fix configure-window to get correct stacking order.* ;;; 10/114*/88 LGO 1Rewrite *REPOSITION-CHILDREN 1to correctly position children when a window is moved* ;;; 10/11/88 LGO 1When moving a window, ensure the occlusion stack is moved too.* ;;; 10/11/88 LGO Fix configure-window to handle negative window origins ;;; 9/22/88 LGO Keep MARK-SIBLINGS-BELOW-ME out of the error handler ;;; 9/12/88 LGO 1Use block and return-from instead of catch and throw in *CONFIGURE-WINDOW ;;; 9/07/88 LGO 1Remove redundent call to window-border from *RECOVER-OBSCURED-CONTENTS ;;; 6/14/88 TWE Fixed move-window to adjust the children too. ;;; 3/28/88 TWE Moved from window-hierarchy-requests to here. (DEFUN FFS (MASK) "Return index of least significant on bit." (IF (ZEROP MASK) 0 ;;ELSE (LET ((INDEX 1)) (LOOP (WHEN (LOGTEST 1 MASK) (RETURN NIL)) (SETQ MASK (ASH MASK -1)) (INCF INDEX)) INDEX))) (DEFUN MAKE-PARENT-RELATIVE-WINDOW-BOX (WINDOW) "Returns a box structure representing the window, including its borders. The coordinates are relative to the parent of WINDOW." (MAKE-BOX :LEFT (WINDOW.X WINDOW) :TOP (WINDOW.Y WINDOW) :WIDTH (WINDOW.OUTSIDE-WIDTH WINDOW) :HEIGHT (WINDOW.OUTSIDE-HEIGHT WINDOW))) (DEFREQ CONFIGURE-WINDOW ((WINDOW WINDOW) (VALUE-MASK (BITMASK ALL-CONFIGURE-WINDOW-MASKS CARD16)) (:LONG)) ;; Force cursor removal since may move window anywhere, etc. (PERFORM-GRAPHICS ((ROOT-FOR-WINDOW WINDOW)) (CONFIGURE-WINDOW WINDOW VALUE-MASK LONGS LONG-OFFSET WORDS WORD-OFFSET STATE))) (ZWEI:DEFINE-INDENTATION GET-INT16 (1 1)) (DEFUN CONFIGURE-WINDOW (WINDOW VALUE-MASK LONGS LONG-OFFSET WORDS WORD-OFFSET STATE) (DECLARE (TYPE WINDOW WINDOW) (TYPE INTEGER VALUE-MASK LONG-OFFSET WORD-OFFSET) (TYPE ARRAY LONGS WORDS) (TYPE STATE STATE)) ;; Move the word offset to the start of the values. The long-offset has already been ;; adjusted so we don't need to bother with that. (INCF WORD-OFFSET 6) (server-trace-value-mask value-mask longs long-offset '#(X Y Width Height Border-Width Sibling Stack-Mode)) (block RETURN-VALUE (LET ((SIBLING NIL) (WIDTH (WINDOW.WIDTH WINDOW)) (HEIGHT (WINDOW.HEIGHT WINDOW)) (BORDER-WIDTH (WINDOW.BWIDTH WINDOW)) (STACK-MODE STACK-ABOVE) ;; The following are constants. The compiler should do constant-folding so that ;; they will really be their values. (RESTACK-WIN 0) (MOVE-WIN 1) (RESIZE-WIN 2) (CHANGE-MASK (LOGIOR CW-X CW-Y CW-WIDTH CW-HEIGHT)) X Y BEFORE-X BEFORE-Y ACTION T-MASK INDEX) (DECLARE (TYPE INTEGER WIDTH HEIGHT BORDER-WIDTH RESTACK-WIN MOVE-WIN RESIZE-WIN CHANGE-MASK)) (macrolet ((GET-CARD16 () '(PROG1 (AREF WORDS WORD-OFFSET) (INCF WORD-OFFSET 2) (INCF LONG-OFFSET)))) (COND ((zerop value-mask) (return-from return-value nil)) #+comment ;1; configure window works for input-only windows too - LGO* ((and (eql (window.class window) Input-Only) (logtest value-mask (lognot (logior CW-X CW-Y CW-WIDTH CW-HEIGHT CW-BORDER-WIDTH)))) (BAD-MATCH)) ((AND (LOGTEST CW-SIBLING VALUE-MASK) (NOT (LOGTEST CW-STACK-MODE VALUE-MASK))) ;; User specified a sibling but didn't specify stack-mode. (BAD-MATCH)) (T ;; I'm not sure about these calculations since the C server has a different ;; meaning for the absolute X/Y corner. (SETQ X (WINDOW.X WINDOW) Y (WINDOW.Y WINDOW)) (server-trace "~%In change-w-a: x= ~d y= ~d" x y) (SETQ BEFORE-X X BEFORE-Y Y ACTION RESTACK-WIN) ;; Now we decide what kind of action we will perform. (COND ((AND (OR (LOGTEST CW-X VALUE-MASK) (LOGTEST CW-Y VALUE-MASK)) (NOT (LOGTEST CW-WIDTH VALUE-MASK)) (NOT (LOGTEST CW-HEIGHT VALUE-MASK))) (WHEN (LOGTEST CW-X VALUE-MASK) (SETQ X (card16->int16 (GET-CARD16)))) (WHEN (LOGTEST CW-Y VALUE-MASK) (SETQ Y (card16->int16 (GET-CARD16)))) (SETQ ACTION MOVE-WIN)) ((OR (LOGTEST CW-X VALUE-MASK) (LOGTEST CW-Y VALUE-MASK) (LOGTEST CW-WIDTH VALUE-MASK) (LOGTEST CW-HEIGHT VALUE-MASK)) (WHEN (LOGTEST CW-X VALUE-MASK) (SETQ X (card16->int16 (GET-CARD16)))) (WHEN (LOGTEST CW-Y VALUE-MASK) (SETQ Y (card16->int16 (GET-CARD16)))) (WHEN (LOGTEST CW-WIDTH VALUE-MASK) (SETQ WIDTH (GET-CARD16))) (WHEN (LOGTEST CW-HEIGHT VALUE-MASK) (SETQ HEIGHT (GET-CARD16))) (SETQ ACTION RESIZE-WIN))) (server-trace "~%In change-w-a after checking action: x= ~d y= ~d" x y) ;; Turn off the X/Y/WIDTH/HEIGHT bits in and put into T-MASK. (SETQ T-MASK (LOGAND VALUE-MASK (LOGNOT CHANGE-MASK))) (LOOP (WHEN (ZEROP T-MASK) (RETURN NIL)) (SETQ INDEX (ASH 1 (1- (FFS T-MASK))) T-MASK (LOGXOR INDEX T-MASK)) (COND ((= INDEX CW-BORDER-WIDTH) (SETQ BORDER-WIDTH (GET-CARD16))) ((= INDEX CW-SIBLING) (PROCESS-VALUES (VALUE-MASK LONGS LONG-OFFSET) () (((CW-SIBLING WINDOW SIBLING)))) (WHEN (OR (NOT (EQ (WINDOW.PARENT SIBLING) (WINDOW.PARENT WINDOW))) (EQ SIBLING WINDOW)) (BAD-MATCH) (RETURN-FROM RETURN-VALUE 0))) ((= INDEX CW-STACK-MODE) (PROCESS-VALUES (VALUE-MASK LONGS LONG-OFFSET) () (((CW-STACK-MODE (CARD8 STACK-ABOVE STACK-BELOW STACK-TOP-IF STACK-BOTTOM-IF STACK-OPPOSITE) STACK-MODE)))) (SERVER-TRACE "~%IN CONFIGURE-WINDOW, STACK-MODE=~D" STACK-MODE)) (T (BAD-MATCH) (RETURN-FROM RETURN-VALUE 0)))) ;; Root can't be reconfigured, so just return. (WHEN (NULL (WINDOW.PARENT WINDOW)) (RETURN-FROM RETURN-VALUE 1)) ;; Figure out if the window should be moved. Doesn't make ;; the changed to the window if event sent. (SETQ SIBLING (IF (LOGTEST CW-STACK-MODE VALUE-MASK) (WHERE-DO-I-GO-IN-THE-STACK WINDOW SIBLING X Y (WINDOW.OUTSIDE-WIDTH WINDOW) (WINDOW.OUTSIDE-HEIGHT WINDOW) STACK-MODE) ;;ELSE (WINDOW.NEXT-SIB WINDOW))) (WHEN (AND (NOT (WINDOW.OVERRIDE-REDIRECT WINDOW)) (LOGTEST SUBSTRUCTURE-REDIRECT-MASK (WINDOW.ALL-EVENT-MASKS (WINDOW.PARENT WINDOW)))) (LET ((EVENT (MAKE-EVENT-CONFIGURE-REQUEST :TYPE CONFIGURE-REQUEST-EVENT :WINDOW WINDOW :PARENT (WINDOW.PARENT WINDOW) :SIBLING (IF (LOGTEST CW-SIBLING VALUE-MASK) SIBLING NIL) :X X :Y Y :WIDTH WIDTH :HEIGHT HEIGHT :BORDER-WIDTH BORDER-WIDTH :VALUE-MASK VALUE-MASK))) (WHEN (= (MAYBE-DELIVER-EVENTS-TO-CLIENT (WINDOW.PARENT WINDOW) EVENT 1 SUBSTRUCTURE-REDIRECT-MASK STATE) 1) (RETURN-FROM RETURN-VALUE 1)))) (SERVER-TRACE "~%IN CONFIGURE-WINDOW, ACTION=~A" (COND ((= ACTION RESIZE-WIN) :RESIZE-WIN) ((= ACTION RESTACK-WIN) :RESTACK-WIN) ((= ACTION MOVE-WIN) :MOVE-WIN))) (WHEN (= ACTION RESIZE-WIN) (LET ((SIZE-CHANGE (OR (NOT (= (WINDOW.WIDTH WINDOW) WIDTH)) (NOT (= (WINDOW.HEIGHT WINDOW) HEIGHT))))) (DECLARE (TYPE BOOLEAN SIZE-CHANGE)) (WHEN (AND SIZE-CHANGE (LOGTEST RESIZE-REDIRECT-MASK (WINDOW.ALL-EVENT-MASKS WINDOW))) (LET ((EVENT (MAKE-EVENT-RESIZE-REQUEST :TYPE RESIZE-REQUEST-EVENT :WINDOW WINDOW :WIDTH WIDTH :HEIGHT HEIGHT))) (WHEN (= (MAYBE-DELIVER-EVENTS-TO-CLIENT WINDOW EVENT 1 RESIZE-REDIRECT-MASK STATE) 1) (SETQ WIDTH (WINDOW.WIDTH WINDOW) HEIGHT (WINDOW.HEIGHT WINDOW) SIZE-CHANGE NIL)))) (WHEN (NOT SIZE-CHANGE) (COND ((LOGTEST (LOGIOR CW-X CW-Y) VALUE-MASK) (SETQ ACTION MOVE-WIN)) ((LOGTEST (LOGIOR CW-STACK-MODE CW-BORDER-WIDTH) VALUE-MASK) (SETQ ACTION RESTACK-WIN)) (T ;; Really nothing to do. (RETURN-FROM RETURN-VALUE 1)))))) (when (or (= ACTION RESIZE-WIN) ;; We've already checked whether ther's really a size change. (AND (LOGTEST CW-X VALUE-MASK) (NOT (= X BEFORE-X))) (AND (LOGTEST CW-Y VALUE-MASK) (NOT (= Y BEFORE-Y))) (AND (LOGTEST CW-BORDER-WIDTH VALUE-MASK) (NOT (= BORDER-WIDTH (WINDOW.BWIDTH WINDOW)))) (AND (LOGTEST CW-STACK-MODE VALUE-MASK) (NOT (EQ SIBLING ;; In the C code, the next sibling for the last child is NIL. ;; In the Lisp code, the next sibling for the last child ;; is the first child. (IF (EQ (WINDOW.LAST-CHILD (WINDOW.PARENT WINDOW)) WINDOW) NIL ;;ELSE (WINDOW.NEXT-SIB WINDOW)))))) (LET ((EVENT (MAKE-EVENT-CONFIGURE-NOTIFY :TYPE CONFIGURE-NOTIFY-EVENT :WINDOW WINDOW :ABOVE-SIBLING (OR SIBLING NIL) :X X :Y Y :WIDTH WIDTH :HEIGHT HEIGHT :BORDER-WIDTH BORDER-WIDTH :OVERRIDE (WINDOW.OVERRIDE-REDIRECT WINDOW)))) (DELIVER-EVENTS WINDOW EVENT 1 NIL) (SERVER-TRACE "~%IN CONFIGURE-WINDOW, AFTER DELIVER-EVENTS") (WHEN (LOGTEST CW-BORDER-WIDTH VALUE-MASK) (IF (= ACTION RESTACK-WIN) (CHANGE-BORDER-WIDTH STATE WINDOW BORDER-WIDTH) ;;ELSE (SETF (WINDOW.BWIDTH WINDOW) BORDER-WIDTH))) (COND ((= ACTION MOVE-WIN) (SERVER-TRACE "~%IN CONFIGURE-WINDOW, moving window") (MOVE-WINDOW STATE WINDOW X Y SIBLING)) ((= ACTION RESIZE-WIN) (SERVER-TRACE "~%IN CONFIGURE-WINDOW, sliding and sizing window") (SLIDE-AND-SIZE-WINDOW STATE WINDOW X Y WIDTH HEIGHT SIBLING)) ((LOGTEST CW-STACK-MODE VALUE-MASK) (SERVER-TRACE "~%IN CONFIGURE-WINDOW, restacking window") (REFLECT-STACK-CHANGE STATE WINDOW SIBLING)))))))))) (SERVER-TRACE "~%LEAVING CONFIGURE-WINDOW")) ;;; WhereDoIGoInTheStack() ;;; Given pWin and pSib and the relationshipe smode, return ;;; the window that pWin should go ABOVE. ;;; If a pSib is specified: ;;; Above: pWin is placed just above pSib ;;; Below: pWin is placed just below pSib ;;; TopIf: if pSib occludes pWin, then pWin is placed ;;; at the top of the stack ;;; BottomIf: if pWin occludes pSib, then pWin is ;;; placed at the bottom of the stack ;;; Opposite: if pSib occludes pWin, then pWin is placed at the ;;; top of the stack, else if pWin occludes pSib, then ;;; pWin is placed at the bottom of the stack ;;; ;;; If pSib is NULL: ;;; Above: pWin is placed at the top of the stack ;;; Below: pWin is placed at the bottom of the stack ;;; TopIf: if any sibling occludes pWin, then pWin is placed at ;;; the top of the stack ;;; BottomIf: if pWin occludes any sibline, then pWin is placed at ;;; the bottom of the stack ;;; Opposite: if any sibling occludes pWin, then pWin is placed at ;;; the top of the stack, else if pWin occludes any ;;; sibling, then pWin is placed at the bottom of the stack (DEFUN WHERE-DO-I-GO-IN-THE-STACK (WINDOW SIBLING X Y OUTSIDE-WIDTH OUTSIDE-HEIGHT STACK-MODE) (DECLARE (TYPE WINDOW WINDOW) (TYPE (OR NULL WINDOW) SIBLING) (TYPE INTEGER X Y OUTSIDE-WIDTH OUTSIDE-HEIGHT STACK-MODE) (VALUES (OR NULL WINDOW))) (SERVER-TRACE "~%ENTERING WHERE-DO-I-GO-IN-THE-STACK, SIBLING=~A, WINDOW=~A" SIBLING WINDOW) (IF (AND (EQ WINDOW (WINDOW.FIRST-CHILD (WINDOW.PARENT WINDOW))) (EQ WINDOW (WINDOW.LAST-CHILD (WINDOW.PARENT WINDOW)))) ;; Only one sibling. NIL ;;ELSE (LET* ((WINDOW-BOX (MAKE-BOX :LEFT X :TOP Y :WIDTH OUTSIDE-WIDTH :HEIGHT OUTSIDE-HEIGHT)) (HEAD (REAL-CHILD-HEAD (WINDOW.PARENT WINDOW))) (FIRST (IF HEAD (WINDOW.NEXT-SIB HEAD) ;;ELSE (WINDOW.FIRST-CHILD (WINDOW.PARENT WINDOW))))) (DECLARE (TYPE BOX WINDOW-BOX) (TYPE (OR NULL WINDOW) HEAD) (TYPE WINDOW FIRST)) (SERVER-TRACE "~%IN WHERE-DO-I-GO-IN-THE-STACK, WINDOW-BOX=~A, HEAD=~A, FIRST=~A" WINDOW-BOX HEAD FIRST) (COND ((= STACK-MODE STACK-ABOVE) (COND (SIBLING SIBLING) ((EQ WINDOW FIRST) (WINDOW.NEXT-SIB WINDOW)) (T FIRST))) ((= STACK-MODE STACK-BELOW) (IF SIBLING (IF (NOT (EQ (WINDOW.NEXT-SIB SIBLING) WINDOW)) (WINDOW.C-NEXT-SIB SIBLING) ;;ELSE (WINDOW.NEXT-SIB WINDOW)) ;;ELSE NIL)) ((= STACK-MODE STACK-TOP-IF) (COND (SIBLING (SERVER-TRACE "~%IN WHERE-DO-I-GO-IN-THE-STACK, IS-SIBLING-ABOVE-ME=~D, ~ intersect-p=~A, Window box=~A" (IS-SIBLING-ABOVE-ME WINDOW SIBLING) (BOX-INTERSECT-P ;; Relative to the parent's origin (MAKE-PARENT-RELATIVE-WINDOW-BOX SIBLING) WINDOW-BOX) (MAKE-PARENT-RELATIVE-WINDOW-BOX SIBLING)) (IF (AND (= (IS-SIBLING-ABOVE-ME WINDOW SIBLING) STACK-ABOVE) (BOX-INTERSECT-P ;; Relative to the parent's origin (MAKE-PARENT-RELATIVE-WINDOW-BOX SIBLING) WINDOW-BOX)) FIRST ;;ELSE (WINDOW.C-NEXT-SIB WINDOW))) ((ANY-WINDOW-OVERLAPS-ME WINDOW WINDOW-BOX) FIRST) (T (WINDOW.NEXT-SIB WINDOW)))) ((= STACK-MODE STACK-BOTTOM-IF) (COND (SIBLING (IF (AND (= (IS-SIBLING-ABOVE-ME WINDOW SIBLING) STACK-BELOW) (BOX-INTERSECT-P ;; Relative to the parent's origin (MAKE-PARENT-RELATIVE-WINDOW-BOX SIBLING) WINDOW-BOX)) NIL ;;ELSE (WINDOW.C-NEXT-SIB WINDOW))) ((I-OVERLAP-ANY-WINDOW WINDOW WINDOW-BOX) NIL) (T (WINDOW.NEXT-SIB WINDOW)))) ((= STACK-MODE STACK-OPPOSITE) (COND (SIBLING (IF (BOX-INTERSECT-P ;; Relative to the parent's origin (MAKE-PARENT-RELATIVE-WINDOW-BOX SIBLING) WINDOW-BOX) (IF (= (IS-SIBLING-ABOVE-ME WINDOW SIBLING) STACK-ABOVE) FIRST ;;ELSE NIL) ;;ELSE (WINDOW.C-NEXT-SIB WINDOW))) ((ANY-WINDOW-OVERLAPS-ME WINDOW WINDOW-BOX) ;; If I'm occluded, I can't possibly be the first child FIRST) ((I-OVERLAP-ANY-WINDOW WINDOW WINDOW-BOX) NIL) (T (WINDOW.NEXT-SIB WINDOW)))) (T (ERROR "Internal error in ConfigureWindow, stack-mode is ~D" STACK-MODE)))))) (DEFUN I-OVERLAP-ANY-WINDOW (WINDOW BOX) (DECLARE (TYPE WINDOW WINDOW) (TYPE BOX BOX) (VALUES (OR NULL WINDOW))) (LET ((SIBLING (WINDOW.NEXT-SIB WINDOW)) (LAST-SIBLING (WINDOW.LAST-CHILD (WINDOW.PARENT WINDOW))) (RETURN-VALUE NIL)) (WHEN (NOT (EQ SIBLING WINDOW)) (LOOP (WHEN (AND (WINDOW.MAPPED-P SIBLING) (NOT (EQL (window.class sibling) input-only)) (INTERSECT-BOXES BOX (MAKE-WINDOW-BOX SIBLING))) (SETQ RETURN-VALUE SIBLING) (RETURN NIL)) (WHEN (EQ SIBLING LAST-SIBLING) (RETURN NIL)) (SETQ SIBLING (WINDOW.NEXT-SIB SIBLING)))) RETURN-VALUE)) (DEFUN ANY-WINDOW-OVERLAPS-ME (WINDOW BOX) (DECLARE (TYPE WINDOW WINDOW) (TYPE BOX BOX) (VALUES BOOLEAN)) (LET ((SIBLING (WINDOW.FIRST-CHILD (WINDOW.PARENT WINDOW)))) (LOOP (WHEN (EQ SIBLING WINDOW) (RETURN NIL)) (WHEN (AND (WINDOW.MAPPED-P SIBLING) (NOT (EQL (window.class sibling) input-only)) (INTERSECT-BOXES BOX (MAKE-WINDOW-BOX SIBLING))) (RETURN T)) (SETQ SIBLING (WINDOW.NEXT-SIB SIBLING))))) (DEFUN IS-SIBLING-ABOVE-ME (ME SIBLING) "Returns STACK-ABOVE if SIBLING above ME in stack or STACK-BELOW otherwise." (DECLARE (TYPE WINDOW ME SIBLING) (VALUES INTEGER)) (LET ((WINDOW (WINDOW.FIRST-CHILD (WINDOW.PARENT ME)))) (LOOP (WHEN (EQ WINDOW SIBLING) (RETURN STACK-ABOVE)) (WHEN (EQ WINDOW ME) (RETURN STACK-BELOW)) (SETQ WINDOW (WINDOW.NEXT-SIB WINDOW))))) (DEFUN REAL-CHILD-HEAD (WINDOW) (DECLARE (TYPE WINDOW WINDOW) (VALUES (OR NULL WINDOW))) (IF (and (NULL (WINDOW.PARENT WINDOW)) nil ;1; (screen-saver-enabled-p)* ) (WINDOW.FIRST-CHILD WINDOW) ;;ELSE NIL)) (DEFUN REFLECT-STACK-CHANGE (STATE WINDOW SIBLING) (DECLARE (TYPE WINDOW WINDOW) (TYPE (OR NULL WINDOW) SIBLING)) (SERVER-TRACE "~%ENTERING REFLECT-STACK-CHANGE, WINDOW=~A, SIBLING=~A" WINDOW SIBLING) (LET ((DO-VALIDATION (WINDOW.MAPPED-P WINDOW)) (PARENT (WINDOW.PARENT WINDOW)) OLD-OCCLUSION-STACK EXPOSED) (SERVER-TRACE "~%IN REFLECT-STACK-CHANGE, DO-VALIDATION=~A, PARENT=~A, LAST-CHILD=~A" DO-VALIDATION PARENT (WINDOW.LAST-CHILD PARENT)) (WHEN PARENT (MOVE-WINDOW-IN-STACK WINDOW SIBLING) (SERVER-TRACE "~%IN REFLECT-STACK-CHANGE, AFTER MOVE-WINDOW-IN-STACK, LAST-CHILD=~A" (WINDOW.LAST-CHILD PARENT)) (WHEN DO-VALIDATION (SETQ OLD-OCCLUSION-STACK (OCCLUSION-STACK-TO-LIST WINDOW (WINDOW.OCCLUSION-STACK WINDOW))) (GENERATE-ALL-INFERIORS-OCCLUSION-STACKS PARENT T) ;; Calculate newly exposed area of window (SETQ EXPOSED (SET-SUBTRACT-BOXES (OCCLUSION-STACK-TO-LIST WINDOW (WINDOW.OCCLUSION-STACK WINDOW)) OLD-OCCLUSION-STACK)) (WHEN EXPOSED (EXPOSE-WINDOW-PORTION WINDOW STATE EXPOSED T)) (RECOVER-OBSCURED-CONTENTS STATE WINDOW OLD-OCCLUSION-STACK) (DO-OBSCURES PARENT) ))) (SERVER-TRACE "~%LEAVING REFLECT-STACK-CHANGE")) ;;; This is no longer used nor should it be #+comment (DEFUN HANDLE-EXPOSURES (WINDOW) "Starting at pWin, draw background in any windows that have exposure regions, translate the regions, restore any backing store, and then send any regions stille xposed to the client." (DECLARE (TYPE WINDOW WINDOW)) ;; Implementation note: the order of painting and restoration needs ;; to be different, to avoid an extra repaint of the background. --rgd (WINDOW-EXPOSURES WINDOW) (LET ((SIBLING (WINDOW.FIRST-CHILD WINDOW)) (LAST-CHILD (WINDOW.LAST-CHILD WINDOW))) (WHEN SIBLING (LOOP (HANDLE-EXPOSURES SIBLING) (WHEN (EQ SIBLING LAST-CHILD) (RETURN NIL)) (SETQ SIBLING (WINDOW.NEXT-SIB SIBLING))))) (WHEN (WINDOW.OCCLUSION-STACK WINDOW) (DRAW-BORDERS WINDOW))) (DEFUN DO-OBSCURES (WINDOW) (DECLARE (TYPE WINDOW WINDOW)) (WHEN (NOT (= (WINDOW.BACKING-STORE-SUPPORT WINDOW) STORE-NOT-USEFUL)) (SERVER-TRACE "~%IN DO-OBSCURES, SAVING DOOMED AREA for ~s" window) (SAVE-DOOMED-AREAS WINDOW)) (LET ((SIBLING (WINDOW.FIRST-CHILD WINDOW)) (LAST-CHILD (WINDOW.LAST-CHILD WINDOW))) (WHEN SIBLING (LOOP (DO-OBSCURES SIBLING) (WHEN (EQ SIBLING LAST-CHILD) (RETURN NIL)) (SETQ SIBLING (WINDOW.NEXT-SIB SIBLING)))))) (DEFUN MOVE-WINDOW-IN-STACK (WINDOW NEXT-SIB) (DECLARE (TYPE WINDOW WINDOW) (TYPE (OR NULL WINDOW) NEXT-SIB) (VALUES WINDOW)) (SERVER-TRACE "~%ENTERING MOVE-WINDOW-IN-STACK, WINDOW=~A, NEXT-SIB=~A" WINDOW NEXT-SIB) (LET ((PARENT (WINDOW.PARENT WINDOW)) ;; Highest window where list changes. (FIRST-CHANGE WINDOW)) (WHEN (NOT (EQ (IF (EQ (WINDOW.LAST-CHILD PARENT) WINDOW) NIL ;;ELSE (WINDOW.NEXT-SIB WINDOW)) NEXT-SIB)) (COND ((NULL NEXT-SIB) (SERVER-TRACE "~%IN MOVE-WINDOW-IN-STACK, linking at bottom") ;; Link WINDOW in at the bottom of the occlusion stack. ;; Unlink from parent. (WHEN (EQ (WINDOW.FIRST-CHILD PARENT) WINDOW) (SETF (WINDOW.FIRST-CHILD PARENT) (WINDOW.NEXT-SIB WINDOW))) (SETQ FIRST-CHANGE (WINDOW.NEXT-SIB WINDOW)) ;; Unlink WINDOW from hierarchy. (SETF (WINDOW.PREV-SIB (WINDOW.NEXT-SIB WINDOW)) (WINDOW.PREV-SIB WINDOW)) (SETF (WINDOW.NEXT-SIB (WINDOW.PREV-SIB WINDOW)) (WINDOW.NEXT-SIB WINDOW)) ;; Link WINDOW to PREV of first child and NEXT of last child. (SETF (WINDOW.NEXT-SIB (WINDOW.LAST-CHILD PARENT)) WINDOW) (SETF (WINDOW.PREV-SIB (WINDOW.FIRST-CHILD PARENT)) WINDOW) ;; Link WINDOW's PREV and NEXT. (SETF (WINDOW.NEXT-SIB WINDOW) (WINDOW.FIRST-CHILD PARENT)) (SETF (WINDOW.PREV-SIB WINDOW) (WINDOW.LAST-CHILD PARENT)) ;; Relink back into parent. (SETF (WINDOW.LAST-CHILD PARENT) WINDOW)) ((EQ (WINDOW.FIRST-CHILD PARENT) NEXT-SIB) (SERVER-TRACE "~%IN MOVE-WINDOW-IN-STACK, linking at top") ;; Move to the top of the occlusion stack. (SETQ FIRST-CHANGE WINDOW) ;; Unlink from parent. (WHEN (EQ (WINDOW.LAST-CHILD PARENT) WINDOW) (SETF (WINDOW.LAST-CHILD PARENT) (WINDOW.PREV-SIB WINDOW))) ;; Unlink WINDOW from hierarchy. (SETF (WINDOW.PREV-SIB (WINDOW.NEXT-SIB WINDOW)) (WINDOW.PREV-SIB WINDOW)) (SETF (WINDOW.NEXT-SIB (WINDOW.PREV-SIB WINDOW)) (WINDOW.NEXT-SIB WINDOW)) ;; Link WINDOW to PREV of first child and NEXT of last child. (SETF (WINDOW.NEXT-SIB (WINDOW.LAST-CHILD PARENT)) WINDOW) (SETF (WINDOW.PREV-SIB (WINDOW.FIRST-CHILD PARENT)) WINDOW) ;; Link WINDOW's PREV and NEXT. (SETF (WINDOW.NEXT-SIB WINDOW) (WINDOW.FIRST-CHILD PARENT)) (SETF (WINDOW.PREV-SIB WINDOW) (WINDOW.LAST-CHILD PARENT)) ;; Relink back into parent. (SETF (WINDOW.FIRST-CHILD PARENT) WINDOW)) (T (SERVER-TRACE "~%IN MOVE-WINDOW-IN-STACK, linking in middle") ;; Move in middle of list. (LET ((OLD-NEXT (WINDOW.NEXT-SIB WINDOW))) (SETQ FIRST-CHANGE NIL) ;; Unlink from parent. (WHEN (EQ (WINDOW.FIRST-CHILD PARENT) WINDOW) (SETF (WINDOW.FIRST-CHILD PARENT) (WINDOW.NEXT-SIB WINDOW)) (SETQ FIRST-CHANGE (WINDOW.NEXT-SIB WINDOW))) ;; Unlink from parent. (WHEN (EQ (WINDOW.LAST-CHILD PARENT) WINDOW) (SETQ FIRST-CHANGE WINDOW) (SETF (WINDOW.LAST-CHILD PARENT) (WINDOW.PREV-SIB WINDOW))) ;; Unlink WINDOW from hierarchy. (SETF (WINDOW.PREV-SIB (WINDOW.NEXT-SIB WINDOW)) (WINDOW.PREV-SIB WINDOW)) (SETF (WINDOW.NEXT-SIB (WINDOW.PREV-SIB WINDOW)) (WINDOW.NEXT-SIB WINDOW)) ;; Link WINDOW back into hierarchy. (SETF (WINDOW.NEXT-SIB WINDOW) NEXT-SIB) (SETF (WINDOW.PREV-SIB WINDOW) (WINDOW.PREV-SIB NEXT-SIB)) ;; Update NEXT-SIB's pointers to point to WINDOW. (SETF (WINDOW.NEXT-SIB (WINDOW.PREV-SIB NEXT-SIB)) WINDOW) (SETF (WINDOW.PREV-SIB NEXT-SIB) WINDOW) (WHEN (NULL FIRST-CHANGE) ;; We don't know it yet. Search from the top. (SETQ FIRST-CHANGE (WINDOW.FIRST-CHILD PARENT)) (LOOP (WHEN (AND (NOT (EQ FIRST-CHANGE WINDOW)) (NOT (EQ FIRST-CHANGE OLD-NEXT))) (RETURN NIL)) (SETQ FIRST-CHANGE (WINDOW.NEXT-SIB FIRST-CHANGE)))))))) (SERVER-TRACE "~%LEAVING MOVE-WINDOW-IN-STACK") FIRST-CHANGE)) (DEFUN CHANGE-BORDER-WIDTH (STATE WINDOW WIDTH) (DECLARE (TYPE WINDOW WINDOW) (TYPE INTEGER WIDTH)) (LET* ((OLD-WIDTH (WINDOW.BWIDTH WINDOW)) (PARENT (WINDOW.PARENT WINDOW)) (DELTA-BORDER (- WIDTH OLD-WIDTH)) ;positive if border is growing (OLD-WINDOW-BOX (MAKE-WINDOW-BOX WINDOW)) (OLD-OCCLUSION-STACK (OCCLUSION-STACK-TO-LIST WINDOW (WINDOW.OCCLUSION-STACK WINDOW)))) (WHEN (NOT (= WIDTH OLD-WIDTH)) ;; Change the width and recalculate the new occlusion stack (SETF (WINDOW.BWIDTH WINDOW) WIDTH) (GENERATE-ALL-INFERIORS-OCCLUSION-STACKS PARENT) ;; Copy the interior of the window to the new location. ;; Note that copy-window-contents has an inverted sense of "delta" (COPY-WINDOW-CONTENTS STATE WINDOW OLD-OCCLUSION-STACK (- DELTA-BORDER) (- DELTA-BORDER)) (COND ((PLUSP DELTA-BORDER) ;; Borders grew: save newly obscured areas to backing store if necessary before drawing (DO-OBSCURES PARENT) (DRAW-BORDERS WINDOW)) (T ;; Borders shrank: draw the smaller borders and expose new areas. (DRAW-BORDERS WINDOW) (EXPOSE-WINDOW-PORTION PARENT STATE (SUBTRACT-BOX OLD-WINDOW-BOX (MAKE-WINDOW-BOX WINDOW)))))))) (DEFUN WINDOW-EXPOSURES (WINDOW) (DECLARE (TYPE WINDOW WINDOW)) (SERVER-TRACE "~%ENTERING WINDOW-EXPOSURES, WINDOW=~A" WINDOW) (LET ((EXPOSURES (WINDOW.EXPOSURES WINDOW))) (WHEN EXPOSURES (SETF (WINDOW.EXPOSURES WINDOW) NIL) ;; Restore from backing-store FIRST. Note that while the double ;; translation is somewhat expensive, it's not as expensive as ;; the double refresh. In addition, much of the time, pWin->exposed ;; will come back empty from RestoreAreas, so the second ;; translation won't happen. (IF (WINDOW.BACKING-STORE-VALID WINDOW) (PROGN (SERVER-TRACE "~%IN WINDOW-EXPOSURES, restoring areas: ~A" (WINDOW.OCCLUSION-STACK WINDOW)) (RESTORE-AREAS WINDOW) ) ;; ELSE - subtract children from exposed areas and report remainder to client (LOOP FOR CHILD BEING THE XWINDOW-CHILDREN OF WINDOW DO (SETQ EXPOSURES (SET-SUBTRACT-BOXES EXPOSURES (OCCLUSION-STACK-TO-LIST CHILD (WINDOW.OCCLUSION-STACK CHILD)))) WHILE EXPOSURES) (EXPOSE-EVENTS NIL WINDOW EXPOSURES)))) (SERVER-TRACE "~%LEAVING WINDOW-EXPOSURES")) (DEFUN SAVE-DOOMED-AREAS (WINDOW) "Saved the areas of the given window that are about to be obscured." (DECLARE (TYPE WINDOW WINDOW)) ;; If the window isn't realized, it's being unmapped, thus we don't ;; want to save anything if backingStore isn't Always. Note we only examine ;; the bottom 2 bits to account for the possibility of the save-under ;; mechanism in dix/window.c being in use. (WHEN (AND (eq (WINDOW.OCCLUSION-STACK WINDOW) t) (NOT (= (WINDOW.BACKING-STORE-SUPPORT WINDOW) STORE-NOT-USEFUL)) (not (window.backing-store-valid window))) (WHEN (NULL (WINDOW.BACKING-STORE WINDOW)) (SETF (WINDOW.BACKING-STORE WINDOW) (CREATE-PIXMAP WINDOW (WINDOW.WIDTH WINDOW) (WINDOW.HEIGHT WINDOW) (DRAWABLE-DEPTH WINDOW)))) ;; Translate the region to be window-relative, then copy the region from ;; the screen at the window's (old) position. Note that if the window ;; has moved, backStorage->obscured is expected to be at the new ;; location and backStorage->oldAbsCorner is expected to contain the ;; window's previous location so the correct areas of the screen may ;; be copied... (SAVE-AREAS WINDOW) )) (ZWEI:DEFINE-INDENTATION MOVE-ALL-INFERIORS (1 1)) (DEFUN MOVE-WINDOW (STATE WINDOW X Y NEXT-SIB) (DECLARE (TYPE STATE STATE) (TYPE WINDOW WINDOW) (TYPE WINDOW NEXT-SIB) (TYPE INTEGER X Y)) (SERVER-TRACE "~%ENTERING MOVE-WINDOW window= ~s x= ~d y= ~d" window x y) (LET ((WINDOW-TO-VALIDATE WINDOW) (WAS-MAPPED (WINDOW.MAPPED-P WINDOW)) (PARENT (WINDOW.PARENT WINDOW)) (WINDOW-OCCLUSION-STACK (WINDOW.OCCLUSION-STACK WINDOW)) OLD-OCCLUSION-STACK) (DECLARE (TYPE BOOLEAN WAS-MAPPED) (TYPE WINDOW WINDOW-TO-VALIDATE)) ;; If this is a root window, can't be moved. (WHEN PARENT (LET* (;; Positive moving <--, negative moving --> (DELTA-X (- (WINDOW.X WINDOW) X)) ;; Positive moving ^, negative moving v (DELTA-Y (- (WINDOW.Y WINDOW) Y))) (server-trace "~% window-x= ~d window-y= ~d delta-x= ~d delta-y= ~d" (WINDOW.X WINDOW) (WINDOW.Y WINDOW) delta-x delta-y) (WHEN WAS-MAPPED (SETQ OLD-OCCLUSION-STACK (COND ((EQ WINDOW-OCCLUSION-STACK T) (LIST (MAKE-WINDOW-BOX WINDOW))) ((NULL WINDOW-OCCLUSION-STACK) NIL) (T (MAPCAR 'COPY-STRUCTURE-OBJECT WINDOW-OCCLUSION-STACK))))) (server-trace "~%In MOVE-WINDOW: window= ~s initial-x= ~d initial-y= ~d x= ~d y= ~d" window (WINDOW.X WINDOW) (WINDOW.Y WINDOW) x y) (SETF (WINDOW.X WINDOW) X) (SETF (WINDOW.Y WINDOW) Y) (server-trace " final-x= ~d final-y= ~d" (WINDOW.X WINDOW) (WINDOW.Y WINDOW)) (LABELS ((MOVE-ALL-INFERIORS (WINDOW) "Move WINDOW and all of the inferiors of WINDOW." (LET ((LAST-CHILD (WINDOW.LAST-CHILD WINDOW)) (CHILD (WINDOW.FIRST-CHILD WINDOW)) (occlusions (window.occlusion-stack window))) (server-trace "~%In MOVE-ALL-INFERIORS initial-x= ~d initial-y= ~d" (WINDOW.ABSOLUTE-X-CORNER WINDOW) (WINDOW.ABSOLUTE-Y-CORNER WINDOW)) (DECF (WINDOW.ABSOLUTE-X-CORNER WINDOW) DELTA-X) (DECF (WINDOW.ABSOLUTE-Y-CORNER WINDOW) DELTA-Y) (server-trace " final-x= ~d final-y= ~d" (WINDOW.ABSOLUTE-X-CORNER WINDOW) (WINDOW.ABSOLUTE-Y-CORNER WINDOW)) ;1; Move the occlusion-stack too* (when (consp occlusions) (dolist (box occlusions) (decf (box.left box) delta-x) (decf (box.top box) delta-y) (decf (box.right box) delta-x) (decf (box.bottom box) delta-y))) ;1; Adjust the children of window too.* (WHEN CHILD (LOOP (MOVE-ALL-INFERIORS CHILD) (WHEN (EQ CHILD LAST-CHILD) (RETURN NIL)) (SETQ CHILD (WINDOW.NEXT-SIB CHILD))))))) (MOVE-ALL-INFERIORS WINDOW)) (SETQ WINDOW-TO-VALIDATE (MOVE-WINDOW-IN-STACK WINDOW NEXT-SIB)) (WHEN WAS-MAPPED (GENERATE-ALL-INFERIORS-OCCLUSION-STACKS PARENT) (COPY-WINDOW-CONTENTS STATE WINDOW OLD-OCCLUSION-STACK DELTA-X DELTA-Y) (DRAW-BORDERS WINDOW) (RECOVER-OBSCURED-CONTENTS STATE WINDOW OLD-OCCLUSION-STACK))))) (SERVER-TRACE "~%LEAVING MOVE-WINDOW")) (DEFUN GRAVITY-DELTAS (GRAVITY DELTA-WIDTH DELTA-HEIGHT) "Calculate the (X,Y) change according to the gravity specified. Returns deltas for X and Y, or NIL if the gravity was static." (DECLARE (TYPE GRAVITY-TYPE GRAVITY) (TYPE INTEGER DELTA-WIDTH DELTA-HEIGHT) (VALUES (OR NULL INTEGER) (OR NULL INTEGER))) (case-eval gravity ;; Forget throws the bits away. (FORGET-GRAVITY (VALUES 0 0)) (UNMAP-GRAVITY (VALUES 0 0)) (NORTH-WEST-GRAVITY (VALUES 0 0)) (NORTH-GRAVITY (VALUES (TRUNCATE DELTA-WIDTH 2) 0)) (NORTH-EAST-GRAVITY (VALUES DELTA-WIDTH 0)) (WEST-GRAVITY (VALUES 0 (TRUNCATE DELTA-HEIGHT 2))) (CENTER-GRAVITY (VALUES (TRUNCATE DELTA-WIDTH 2) (TRUNCATE DELTA-HEIGHT 2))) (EAST-GRAVITY (VALUES DELTA-WIDTH (TRUNCATE DELTA-HEIGHT 2))) (SOUTH-WEST-GRAVITY (VALUES 0 DELTA-HEIGHT)) (SOUTH-GRAVITY (VALUES (TRUNCATE DELTA-WIDTH 2) DELTA-HEIGHT)) (SOUTH-EAST-GRAVITY (VALUES DELTA-WIDTH DELTA-HEIGHT)) (otherwise (VALUES NIL NIL)))) (DEFUN SLIDE-AND-SIZE-WINDOW (STATE WINDOW X Y NEW-WIDTH NEW-HEIGHT SIBLING) (DECLARE (TYPE STATE STATE) (TYPE WINDOW WINDOW SIBLING) (TYPE INTEGER X Y NEW-WIDTH NEW-HEIGHT)) (SERVER-TRACE "~%ENTERING SLIDE-AND-SIZE-WINDOW: window= ~s x= ~d y= ~d" window x y) (SERVER-TRACE "~%IN SLIDE-AND-SIZE-WINDOW, bit gravity=~A" (WINDOW.BIT-GRAVITY WINDOW)) (LET* ((PARENT (WINDOW.PARENT WINDOW)) (WAS-MAPPED (WINDOW.MAPPED-P WINDOW)) (OLD-WIDTH (WINDOW.WIDTH WINDOW)) (OLD-HEIGHT (WINDOW.HEIGHT WINDOW)) ;; Positive moving 1<*--, negative moving --1>* (DELTA-X (- (WINDOW.X WINDOW) X)) ;; Positive moving 1^*, negative moving 1v* (DELTA-Y (- (WINDOW.Y WINDOW) Y)) (OLD-X (WINDOW.ABSOLUTE-X-CORNER WINDOW)) (OLD-Y (WINDOW.ABSOLUTE-Y-CORNER WINDOW)) (WINDOW-OCCLUSION-STACK (WINDOW.OCCLUSION-STACK WINDOW)) OLD-OCCLUSION-STACK OLD-OCCLUSION-STACK-INTERIOR DELTA-WIDTH DELTA-HEIGHT FIRST-CHANGE (LAST-CHILD (WINDOW.LAST-CHILD WINDOW)) (CHILD (WINDOW.FIRST-CHILD WINDOW)) ;; Used to copy the contents of children from their old position to the new position. (OLD-CHILD-OCCLUSION-STACK-INTERIORS NIL) ;; Used to recover what is underneath a child when it is moved. (OLD-CHILD-OCCLUSION-STACK-EXTERIORS NIL) (NEW-CHILD-OCCLUSION-STACK-EXTERIORS NIL) (DESTROYED-REGIONS NIL)) (DECLARE (TYPE (OR NULL WINDOW) PARENT) (TYPE BOOLEAN WAS-MAPPED) (TYPE INTEGER OLD-WIDTH OLD-HEIGHT OLD-X OLD-Y)) (SERVER-TRACE "~%In SLIDE-AND-SIZE-WINDOW: DELTA-X= ~d DELTA-Y= ~d OLD-X= ~d OLD-Y= ~d" DELTA-X DELTA-Y OLD-X OLD-Y) (WHEN PARENT (WHEN WAS-MAPPED (SETQ OLD-OCCLUSION-STACK (COND ((EQ WINDOW-OCCLUSION-STACK T) (LIST (MAKE-WINDOW-BOX WINDOW))) ((NULL WINDOW-OCCLUSION-STACK) NIL) (T (MAPCAR 'COPY-STRUCTURE-OBJECT WINDOW-OCCLUSION-STACK))) OLD-OCCLUSION-STACK-INTERIOR (SET-INTERSECT-BOXES OLD-OCCLUSION-STACK (MAKE-WINDOW-BOX-INTERIOR WINDOW)))) (server-trace "~%IN SLIDE-AND-SIZE-WINDOW, OLD-OCCLUSION-STACK= ~s OLD-OCCLUSION-STACK-INTERIOR= ~s" OLD-OCCLUSION-STACK OLD-OCCLUSION-STACK-INTERIOR) (WHEN CHILD (LOOP FOR CHILD-OS = (OCCLUSION-STACK-TO-LIST CHILD (WINDOW.OCCLUSION-STACK CHILD)) DO (PROGN (PUSH-END (SET-INTERSECT-BOXES CHILD-OS (MAKE-WINDOW-BOX-INTERIOR CHILD)) OLD-CHILD-OCCLUSION-STACK-INTERIORS) (PUSH-END CHILD-OS OLD-CHILD-OCCLUSION-STACK-EXTERIORS) (SERVER-TRACE "~%IN SLIDE-AND-SIZE-WINDOW, child= ~s child-os= ~s OLD-CHILD-OCCLUSION-STACK-INTERIORS=~D" child child-os OLD-CHILD-OCCLUSION-STACK-INTERIORS) (WHEN (EQ CHILD LAST-CHILD) (RETURN NIL)) (SETQ CHILD (WINDOW.NEXT-SIB CHILD))))) (server-trace "~%In SLIDE-AND-SIZE-WINDOW window= ~s initial-pos-relative=(~d,~d) initial-pos-absolute=(~d,~d) x= ~d y= ~d" window (WINDOW.X WINDOW) (WINDOW.Y WINDOW) (WINDOW.ABSOLUTE-X-CORNER WINDOW) (WINDOW.ABSOLUTE-Y-CORNER WINDOW) x y) (SETF (WINDOW.X WINDOW) X) (SETF (WINDOW.Y WINDOW) Y) (SETF (WINDOW.HEIGHT WINDOW) NEW-HEIGHT) (SETF (WINDOW.WIDTH WINDOW) NEW-WIDTH) (SETF (WINDOW.ABSOLUTE-X-CORNER WINDOW) (+ (WINDOW.ABSOLUTE-INSIDE-X PARENT) X)) (SETF (WINDOW.ABSOLUTE-Y-CORNER WINDOW) (+ (WINDOW.ABSOLUTE-INSIDE-Y PARENT) Y)) (server-trace " final-pos-relative=(~d,~d) final-pos-absolute=(~d,~d)" (WINDOW.X WINDOW) (WINDOW.Y WINDOW) (WINDOW.ABSOLUTE-X-CORNER WINDOW) (WINDOW.ABSOLUTE-Y-CORNER WINDOW)) (SETQ DELTA-WIDTH (- NEW-WIDTH OLD-WIDTH) DELTA-HEIGHT (- NEW-HEIGHT OLD-HEIGHT)) ;; Collect the occlusion stack interiors for the children so we can copy ;; them from their old screen position to the new screen position. (REPOSITION-CHILDREN WINDOW (- delta-x) (- delta-y) DELTA-WIDTH DELTA-HEIGHT) (SETQ FIRST-CHANGE (MOVE-WINDOW-IN-STACK WINDOW SIBLING)) (WHEN WAS-MAPPED (IF (= (WINDOW.BIT-GRAVITY WINDOW) FORGET-GRAVITY) (PROGN (GENERATE-ALL-INFERIORS-OCCLUSION-STACKS PARENT) (EXPOSE-WINDOW-PORTION WINDOW STATE (OCCLUSION-STACK-TO-LIST WINDOW (WINDOW.OCCLUSION-STACK WINDOW)) T) (DRAW-BORDERS WINDOW) (RECOVER-OBSCURED-CONTENTS STATE WINDOW OLD-OCCLUSION-STACK)) ;;ELSE (LET ((BIT-GRAVITY (WINDOW.BIT-GRAVITY WINDOW))) (MULTIPLE-VALUE-BIND (X-CHANGE Y-CHANGE) ;1; why not call *CALCULATE-WINDOW-GRAVITY1?* (GRAVITY-DELTAS BIT-GRAVITY DELTA-WIDTH DELTA-HEIGHT) (WHEN (NULL X-CHANGE) ;; Gravity deltas doesn't calculate static gravities. (SETQ X-CHANGE DELTA-X Y-CHANGE DELTA-Y)) (GENERATE-INFERIOR-OCCLUSION-STACKS PARENT) (SETQ CHILD (WINDOW.FIRST-CHILD WINDOW)) (WHEN CHILD ;; The children have changed position too (well, they might have). (GENERATE-ALL-INFERIORS-OCCLUSION-STACKS WINDOW) ;; Copy the contents of each child from its old position to the new position. (LOOP FOR OLD-CHILD-OCCLUSION-STACK IN OLD-CHILD-OCCLUSION-STACK-INTERIORS DO (PROGN (server-trace "~%In slide-and-size-window: OLD-CHILD-OCCLUSION-STACK= ~s" OLD-CHILD-OCCLUSION-STACK) (WHEN (AND (WINDOW.MAPPED-P CHILD) (NOT (EQL (window.class child) input-only))) (MULTIPLE-VALUE-BIND (X-CHANGE Y-CHANGE) (CALCULATE-WINDOW-GRAVITY CHILD (- X OLD-X) (- Y OLD-Y) DELTA-WIDTH DELTA-HEIGHT) ;; Save a list of those regions that we have destroyed by ;; copying a child's contents there. (SETQ DESTROYED-REGIONS (APPEND DESTROYED-REGIONS ;; Copy the contents of the child ;; from its old position to its new ;; position, taking note of those ;; parts that are `no good' from ;; previous copying operations. (COPY-WINDOW-CONTENTS STATE CHILD OLD-CHILD-OCCLUSION-STACK (- X-CHANGE) (- Y-CHANGE) 0 0 0 0 DESTROYED-REGIONS))))) (SETQ NEW-CHILD-OCCLUSION-STACK-EXTERIORS (APPEND NEW-CHILD-OCCLUSION-STACK-EXTERIORS (OCCLUSION-STACK-TO-LIST CHILD (WINDOW.OCCLUSION-STACK CHILD)))) (WHEN (EQ CHILD LAST-CHILD) (RETURN NIL)) (SETQ CHILD (WINDOW.NEXT-SIB CHILD))))) ;; Execute the bit-gravity part for WINDOW. (COPY-WINDOW-CONTENTS STATE WINDOW ;; Don't copy the old or new child contents. (SET-SUBTRACT-BOXES (SET-SUBTRACT-BOXES OLD-OCCLUSION-STACK-INTERIOR (LOOP FOR OS IN OLD-CHILD-OCCLUSION-STACK-EXTERIORS APPENDING OS)) NEW-CHILD-OCCLUSION-STACK-EXTERIORS) DELTA-X DELTA-Y ;;; (- X-CHANGE) (- Y-CHANGE) DELTA-WIDTH DELTA-HEIGHT X-CHANGE Y-CHANGE DELTA-WIDTH DELTA-HEIGHT DESTROYED-REGIONS) (SETQ CHILD (WINDOW.FIRST-CHILD WINDOW)) ;; Draw the borders for the children. We do this after copying the window's ;; contents in case there are some bits of the old window that would be ;; overwritten by a child's borders. (WHEN CHILD (LOOP FOR OLD-CHILD-OCCLUSION-STACK IN OLD-CHILD-OCCLUSION-STACK-EXTERIORS DO (PROGN (DRAW-BORDERS CHILD) (RECOVER-OBSCURED-CONTENTS STATE CHILD OLD-CHILD-OCCLUSION-STACK) (WHEN (EQ CHILD LAST-CHILD) (RETURN NIL)) (SETQ CHILD (WINDOW.NEXT-SIB CHILD)))))) (DRAW-BORDERS WINDOW) (RECOVER-OBSCURED-CONTENTS STATE WINDOW OLD-OCCLUSION-STACK)))))) (SERVER-TRACE "~%EXITING SLIDE-AND-SIZE-WINDOW")) (DEFUN COPY-WINDOW-CONTENTS (STATE WINDOW OLD-OCCLUSION-STACK DELTA-X DELTA-Y &OPTIONAL (BIT-GRAVITY-X 0) (BIT-GRAVITY-Y 0) (DELTA-WIDTH 0) (DELTA-HEIGHT 0) (DESTROYED-REGIONS NIL)) "Copy the contents of WINDOW from one place on the screen to another. Returns the new interior part of WINDOW which has been affected." (DECLARE (TYPE STATE STATE) (TYPE WINDOW WINDOW) (TYPE LIST OLD-OCCLUSION-STACK) (TYPE INTEGER DELTA-X DELTA-Y) (TYPE INTEGER BIT-GRAVITY-X BIT-GRAVITY-Y DELTA-WIDTH DELTA-HEIGHT) (VALUES LIST)) (SERVER-TRACE "~%ENTERING COPY-WINDOW-CONTENTS, WINDOW=~A~% OLD-OCCLUSION-STACK=~A~% ~ DELTA-X=~D, DELTA-Y=~D, BIT-GRAVITY-X=~D, BIT-GRAVITY-Y=~D, ~ DELTA-WIDTH=~D, DELTA-HEIGHT=~D~% DESTROYED-REGIONS=~A" WINDOW OLD-OCCLUSION-STACK DELTA-X DELTA-Y BIT-GRAVITY-X BIT-GRAVITY-Y DELTA-WIDTH DELTA-HEIGHT DESTROYED-REGIONS) (refresh-from-backing-store window) ;1; Update screen from backing store (just in case)* (LET* ((SOURCE-SCREEN-ARRAY (DEVICE-PRIVATE-WINDOW-ARRAY WINDOW)) (DEST-SCREEN-ARRAY (DEVICE-PRIVATE-WINDOW-ARRAY WINDOW)) (BACKING-STORE (and (WINDOW.BACKING-STORE-valid WINDOW) (WINDOW.BACKING-STORE WINDOW))) (BORDER-WIDTH (WINDOW.BWIDTH WINDOW)) ;; Border adjust is kind of a hack for the case where the window contents comes ;; from the backing store. In that case, the backing store really doesn't have ;; borders, but the region operations assume that it does. So, the borders are ;; added into the dummy region describing the backing store, and then subtracted ;; out when the copying is done. (BORDER-ADJUST 0) (NEW-X (WINDOW.ABSOLUTE-X-CORNER WINDOW)) (NEW-Y (WINDOW.ABSOLUTE-Y-CORNER WINDOW)) (NEW-WIDTH (WINDOW.WIDTH WINDOW)) (NEW-HEIGHT (WINDOW.HEIGHT WINDOW)) ;; This is the new occlusion stack for the interior of the window. (NEW-OCCLUSION-BOXES (SET-INTERSECT-BOXES (OCCLUSION-STACK-TO-LIST WINDOW (WINDOW.OCCLUSION-STACK WINDOW)) (MAKE-WINDOW-BOX-INTERIOR WINDOW))) (OLD-X (+ NEW-X DELTA-X)) (OLD-Y (+ NEW-Y DELTA-Y)) (OLD-WIDTH (- NEW-WIDTH DELTA-WIDTH)) (OLD-HEIGHT (- NEW-HEIGHT DELTA-HEIGHT)) B1 OWPS COMMON-BOXES) (IF BACKING-STORE (PROGN (SERVER-TRACE "~%IN COPY-WINDOW-CONTENTS, from backing store") ;; For the backing store case, we fake out the rest of the code by claiming that ;; the backing store is really the window on the screen. The Old Window PartS is ;; that part of the backing store that we are going to copy to the new window. (SETQ OWPS (LIST ;; We intersect a box for the backing store with a box of `stuff to copy' ;; to make sure that we don't define a box which is outside of the ;; backing store. (INTERSECT-BOXES (MAKE-BOX :LEFT BORDER-WIDTH :TOP BORDER-WIDTH :WIDTH OLD-WIDTH ;(+ OLD-WIDTH BORDER-WIDTH) :HEIGHT OLD-HEIGHT ;(+ OLD-HEIGHT BORDER-WIDTH) ) (MAKE-BOX :LEFT (+ BORDER-WIDTH (MAX 0 (- BIT-GRAVITY-X))) :TOP (+ BORDER-WIDTH (MAX 0 (- BIT-GRAVITY-Y))) :WIDTH OLD-WIDTH :HEIGHT OLD-HEIGHT))) SOURCE-SCREEN-ARRAY (PIXMAP.ARRAY BACKING-STORE) BORDER-ADJUST (- BORDER-WIDTH) DELTA-X (- NEW-X) DELTA-Y (- NEW-Y)) ;; If the old window parts is NIL, then really make it just that. (WHEN (AND (= (LENGTH OWPS) 1) (NULL (CAR OWPS))) (SETQ OWPS NIL))) ;;ELSE (PROGN (SETQ ;; Create a box for the old window that defines the region being copied. ;; Call this region B1. If either bit-gravity (X,Y) is positive, then ;; use 0 instead. Make B1 be relative to the old window. B1 (MAKE-BOX :LEFT (+ OLD-X BORDER-WIDTH (MAX 0 (- BIT-GRAVITY-X))) :TOP (+ OLD-Y BORDER-WIDTH (MAX 0 (- BIT-GRAVITY-Y))) :RIGHT (+ OLD-X BORDER-WIDTH OLD-WIDTH) :BOTTOM (+ OLD-Y BORDER-WIDTH OLD-HEIGHT)) ;; Intersect B1 and the old window's occlusion stack to get those parts of ;; the old window that are to be copied to the new window. Call this ;; region OWPS (Old Window PartS). OWPS (SET-INTERSECT-BOXES OLD-OCCLUSION-STACK B1)) (SERVER-TRACE "~%IN COPY-WINDOW-CONTENTS, B1=~A" B1) (SERVER-TRACE "~%IN COPY-WINDOW-CONTENTS, before destroyed-regions old window parts=~A" OWPS) ;; We need to take into account those parts of the screen that we have ;; destroyed from previous copy operations (from siblings or children of this ;; window). We only need to do this for the non-backing store case, since if ;; we have a backing store we will always have pixels to copy to the new ;; destination. (SETQ OWPS (SET-SUBTRACT-BOXES OWPS DESTROYED-REGIONS)))) (SERVER-TRACE "~%IN COPY-WINDOW-CONTENTS, old window parts=~A" OWPS) ;; Translate the boxes we are going to copy from the old window to the ;; place we are going to copy to in the new window. The bit-gravity-(x,y) ;; will translate back to the old window's upper left coordinate and the ;; delta-(x,y) will translate that to the new window's coordinate. (LOOP FOR BOX IN OWPS DO (PROGN (INCF (BOX.LEFT BOX) (- BIT-GRAVITY-X DELTA-X)) (INCF (BOX.RIGHT BOX) (- BIT-GRAVITY-X DELTA-X)) (INCF (BOX.TOP BOX) (- BIT-GRAVITY-Y DELTA-Y)) (INCF (BOX.BOTTOM BOX) (- BIT-GRAVITY-Y DELTA-Y)))) (SERVER-TRACE "~%IN COPY-WINDOW-CONTENTS, adjusted old window parts=~A" OWPS) ;; Generate the list of boxes which are common between the old occlusion ;; stack and the new. These boxes indicate which parts of the old window ;; can really be copied to the new window. (SETQ COMMON-BOXES (SET-INTERSECT-BOX-SETS OWPS NEW-OCCLUSION-BOXES)) (SERVER-TRACE "~%IN COPY-WINDOW-CONTENTS, common boxes=~A" COMMON-BOXES) ;; We need to take into account those parts of the screen that we have ;; destroyed from previous copy operations (from siblings or children of this ;; window). Here, we don't want to write onto those parts of the screen ;; we have already written to. (SETQ COMMON-BOXES (SET-SUBTRACT-BOXES COMMON-BOXES DESTROYED-REGIONS)) (LET ((PLUSP-REGION-DELTA-X (NOT (MINUSP (- BIT-GRAVITY-X DELTA-X)))) (PLUSP-REGION-DELTA-Y (NOT (MINUSP (- BIT-GRAVITY-Y DELTA-Y))))) (SETQ COMMON-BOXES (SORT COMMON-BOXES #'(LAMBDA (BOX1 BOX2) (LET ((BOX1-LEFT (BOX.LEFT BOX1)) (BOX2-LEFT (BOX.LEFT BOX2)) (BOX1-TOP (BOX.TOP BOX1)) (BOX2-TOP (BOX.TOP BOX2))) (COND ((AND PLUSP-REGION-DELTA-X PLUSP-REGION-DELTA-Y) (IF (= BOX1-LEFT BOX2-LEFT) (> BOX1-TOP BOX2-TOP) ;;ELSE (> BOX1-LEFT BOX2-LEFT))) ((AND (NOT PLUSP-REGION-DELTA-X) PLUSP-REGION-DELTA-Y) (IF (= BOX1-LEFT BOX2-LEFT) (> BOX1-TOP BOX2-TOP) ;;ELSE (< BOX1-LEFT BOX2-LEFT))) ((AND PLUSP-REGION-DELTA-X (NOT PLUSP-REGION-DELTA-Y)) (IF (= BOX1-LEFT BOX2-LEFT) (< BOX1-TOP BOX2-TOP) ;;ELSE (> BOX1-LEFT BOX2-LEFT))) ((AND (NOT PLUSP-REGION-DELTA-X) (NOT PLUSP-REGION-DELTA-Y)) (IF (= BOX1-LEFT BOX2-LEFT) (< BOX1-TOP BOX2-TOP) ;;ELSE (< BOX1-LEFT BOX2-LEFT)))))))) (SERVER-TRACE "~%IN COPY-WINDOW-CONTENTS, sorted common boxes=~A" COMMON-BOXES)) ;; Loop through each common box and copy from the old window to the new window. (LOOP ;; 1DOCUMENTATION ALERT!!* ;; It took me a while to code this so I'll take the time to explain what is ;; going on. The problem being addressed with this call to sort is to order ;; the boxes so that we don't have a case where the source contents of a box ;; is destroyed before it is copied to its new location. For example, if we ;; had the following pixel region movement and resizing case: ;; ;; ;; Case A: ;; ;; Old location ;; .--------------------. ;; | | ;; | New location | ;; | .----------------+---. ;; | | | | ;; | | | | ;; | | X | | ;; | | | | ;; | | | | ;; | | Y | | ;; | | | | ;; `---+----------------' | ;; | | ;; | | ;; `--------------------' ;; ;; we have two text outputs `X' and `Y' shown in their location in the ;; region's old location. The problem here is that the destination of the ;; text output `X' the region's new location corresponds with the location ;; of the text output `Y' in the region's old location. If we had two ;; boxes, one for `X' and another for `Y', then if we copied the box for `X' ;; from where it is in the region's old location to where it would be in the ;; region's new location, it would write on top of where `Y' is in the ;; region's old location. When we then try to copy the box for `Y' from the ;; region's old location to where it would be in the region's new location, ;; we are really copying the pixels of the `X' box, since `Y's pixels were ;; destroyed. The idea of this call to sort is to order the boxes so that ;; we copy a box with higher (x,y) coordinate before a box with a lower ;; (x,y) coordinate. This means that we would copy the box for `Y' before ;; the box for `X', and avoid the problem of destroying existing pixel ;; values. ;; ;; This problem happens in the other three orientations of old/new region ;; locations: ;; ;; Case B: Case C: ;; ;; New location New location ;; .--------------------. .--------------------. ;; | | | | ;; | Old location | Old|location | ;; | .----------------+---. .---+----------------. | ;; | | | | | | | | ;; | | | | | | | | ;; | | Y | | | | Y | | ;; | | | | | | | | ;; | | | | | | X | | ;; | | X | | | | | | ;; | | | | | | | | ;; `---+----------------' | | `----------------+---' ;; | | | | ;; | | | | ;; `--------------------' `--------------------' ;; ;; ;; ;; Case D: ;; ;; Old location ;; .--------------------. ;; | | ;; New|location | ;; .---+----------------. | ;; | | | | ;; | | | | ;; | | X | | ;; | | | | ;; | | Y | | ;; | | | | ;; | | | | ;; | `----------------+---' ;; | | ;; | | ;; `--------------------' ;; ;; In each of these three cases, if the box for `X' is copied before the box ;; for `Y', then it will destroy the pixels that make up the image for `Y'. ;; A different kind of box sorting is required for these three cases to make ;; sure that pixels are not destroyed. In case B, we need to sort so that ;; the (x,y) coordinates of boxes are ascending, the exact opposite of case ;; A. In case C, we need to have the x coordinates descending (like case A) ;; and the y coordinates ascending (like case B). Note that for case C, the ;; x direction of movement of the region is the same as in case A (to the ;; right) and the y direction of movement is the same as in case B (upward). ;; The box sorting for case D is the opposite of that for case C. ;; ;; You may have noticed that we never talked about windows in this ;; discussion - we talked about regions instead. This was intentional. ;; With configure-window one can move a window and its contents ;; independently. For example, we could move a window down a little and ;; move its contents up, with a net-zero change in motion. We could also ;; resize a window to be shorter but not change the position of its orgin ;; and have its contents move up. This means that we need to combine the ;; motion of a window and its contents to determine the region being moved. ;; WITH PLUSP-REGION-DELTA-X = (NOT (MINUSP (- BIT-GRAVITY-X DELTA-X))) WITH PLUSP-REGION-DELTA-Y = (NOT (MINUSP (- BIT-GRAVITY-Y DELTA-Y))) FOR BOX IN COMMON-BOXES FOR BOX-WIDTH = (BOX.WIDTH BOX) FOR BOX-HEIGHT = (BOX.HEIGHT BOX) FOR BOX-X = (BOX.LEFT BOX) FOR BOX-Y = (BOX.TOP BOX) ;; We need to be careful in copying since we may be writing on top of ourselves. DO (PROGN (SERVER-TRACE "~%IN COPY-WINDOW-CONTENTS, Copying ~D by ~D from (~D,~D) to (~D,~D) ~ bit-gravity=(~D,~D), delta=(~D,~D), plusp-region=(~A,~A)" (IF PLUSP-REGION-DELTA-X (- BOX-WIDTH) BOX-WIDTH) (IF PLUSP-REGION-DELTA-Y (- BOX-HEIGHT) BOX-HEIGHT) (+ BOX-X DELTA-X BORDER-ADJUST (- BIT-GRAVITY-X)) (+ BOX-Y DELTA-Y BORDER-ADJUST (- BIT-GRAVITY-Y)) BOX-X BOX-Y BIT-GRAVITY-X BIT-GRAVITY-Y DELTA-X DELTA-Y PLUSP-REGION-DELTA-X PLUSP-REGION-DELTA-Y) ;; 1DOCUMENTATION ALERT!!* ;; The idea here is that we are copying the contents of a region ;; from its old place on the screen to its new place. If the two ;; places overlap then it is necessary to determine whether we ;; are copying left-->right, right-->left, top-->bottom or ;; bottom-->top. It is easier to always copy properly than it is ;; to check for overlap and then copy properly, since the copying ;; for BITBLT has the same CPU expense no matter which of the ;; four possibilities we pick. The following diagrams illustrate ;; why we need to check for the left/right/top/bottom copying ;; direction. ;; ;; New Region ;; .------------------------. ;; | | ;; | 123456789012345678901234 ;; | Old Region | ;; | .------------------+-----. ;; | |*--> | | ;; | || | | ;; | || | | ;; | |v | | ;; | | | | ;; | | | | ;; | | | | ;; | | | | ;; | | | | ;; `-----+------------------' | ;; | | ;; | | ;; | | ;; `------------------------' ;; ;; In this diagram we have an old region which is being shifted ;; up and to the left to its new position and it still overlaps ;; with the old region. What we need to do to copy is to start ;; at the upper left corner of the old region and copy from ;; left-->right and top-->bottom to copy the contents of the old ;; region to its new position. For example, if we started at the ;; upper right corner and columns were copied (we don't can ;; assume that the copying could be done either by columns or ;; rows) then the first column copied (the rightmost) would write ;; on top of a column that we haven't copied yet. In other ;; words, column 24 of the old region is being copied to column ;; 24 of the new region, but that column corresponds to column 18 ;; of the old region, which we haven't copied yet. This means ;; that we must copy from left-->right if we want to preserve the ;; region's contents. The same analysis works for rows and ;; starting at the bottom left corner. ;; ;; Now lets assume the situation shown in the following diagram. ;; In this case we have an old region which is being shifted down ;; and to the right to its new position, still overlapping with ;; the old region. Here we need to copy starting at the lower ;; right corner and copy from bottom-->top and right-->left. If ;; we didn't do that, but instead started at the upper left ;; corner, as in the previous case, copying column 1 of the old ;; region to column 1 of the new region would wipe out column 7 ;; of the old region which we haven't copied yet. Likewise for ;; copying rows. ;; ;; Old Region ;; .------------------------. ;; | | ;; | | ;; | New Region | ;; | .------------------+-----. ;; | | | | ;; | | | | ;; | | | | ;; | | | | ;; | | | | ;; | | ^| | ;; | | || | ;; | | || | ;; | | <--*| | ;; `-----+------------------' | ;; 123456789012345678901234 | ;; | | ;; | | ;; `------------------------' ;; ;; Summarizing: ;; IF new-y < old-y THEN copy top-->bottom (first case) ;; IF new-y > old-y THEN copy bottom-->top (second case) ;; ;; IF new-x < old-x THEN copy left-->right (first case) ;; IF new-x > old-x THEN copy right-->left (second case) ;; ;; The way we specify the direction of copying is via the sign of ;; the width and height arguments to BITBLT. If the sign of the ;; width argument is positive then BITBLT copies starting with the ;; first column and ends copying the last column. Likewise for a ;; positive height argument and rows. If these are negative, then ;; the copying starts at the last column (for a negative width) or ;; last row (for a negative height) and ends copying the first ;; column or first row. In all cases the absolute values of the ;; width and height are used to determine how much is being copied. ;; ;; Read the last paragraph of the previous documentation alert to ;; find out why we talk about regions here instead of windows. ;; ;; 1END OF DOCUMENTATION ALERT.* ;; Do some simple clipping. Note that we can not use COPY-ARRAY-CLIPPED ;; because that function does not treat negative width/height arguments ;; like bitblt does. (LET ((SOURCE-ARRAY-WIDTH (ARRAY-WIDTH SOURCE-SCREEN-ARRAY)) (SOURCE-ARRAY-HEIGHT (ARRAY-HEIGHT SOURCE-SCREEN-ARRAY)) (DEST-ARRAY-WIDTH (ARRAY-WIDTH DEST-SCREEN-ARRAY)) (DEST-ARRAY-HEIGHT (ARRAY-HEIGHT DEST-SCREEN-ARRAY)) (SOURCE-X (+ BOX-X DELTA-X BORDER-ADJUST (- BIT-GRAVITY-X))) (SOURCE-Y (+ BOX-Y DELTA-Y BORDER-ADJUST (- BIT-GRAVITY-Y)))) (COND ((> SOURCE-X SOURCE-ARRAY-WIDTH) (SETQ BOX-WIDTH NIL)) ((> (+ SOURCE-X BOX-WIDTH) SOURCE-ARRAY-WIDTH) ;; Copying ends after the end of the source array. In this case we will ;; have a tiled effect with BITBLT, which we do not want. (SETQ BOX-WIDTH (- SOURCE-ARRAY-WIDTH SOURCE-X)))) (COND ((> SOURCE-Y SOURCE-ARRAY-HEIGHT) (SETQ BOX-WIDTH NIL)) ((> (+ SOURCE-Y BOX-HEIGHT) SOURCE-ARRAY-HEIGHT) ;; Copying ends after the end of the source array. In this case we will ;; have a tiled effect with BITBLT, which we do not want. (SETQ BOX-HEIGHT (- SOURCE-ARRAY-HEIGHT SOURCE-Y)))) ;; Check bounds of destination -- not sure if this is the correct solution - \/\/ (COND ((> BOX-X DEST-ARRAY-WIDTH) (SETQ BOX-WIDTH NIL)) ;1;Not sure of this but fixes immediate problem - DAN* ((AND box-width (> (+ BOX-X BOX-WIDTH) DEST-ARRAY-WIDTH)) (SETQ BOX-WIDTH (- DEST-ARRAY-WIDTH BOX-X)))) (COND ((> BOX-Y DEST-ARRAY-HEIGHT) (SETQ BOX-WIDTH NIL)) ((> (+ BOX-Y BOX-HEIGHT) DEST-ARRAY-HEIGHT) (SETQ BOX-HEIGHT (- DEST-ARRAY-HEIGHT BOX-Y)))) (WHEN BOX-WIDTH (X-BITBLT GX-COPY (IF PLUSP-REGION-DELTA-X (- BOX-WIDTH) BOX-WIDTH) (IF PLUSP-REGION-DELTA-Y (- BOX-HEIGHT) BOX-HEIGHT) SOURCE-SCREEN-ARRAY SOURCE-X SOURCE-Y DEST-SCREEN-ARRAY BOX-X BOX-Y))))) ;; Now we need to generate exposure events for those parts in the new window that ;; are in its occlusion stack but have no corresponding parts in the old window. ;; Note also that we must not generate exposure events on those regions we have ;; destroyed since they were part of an earlier copy operation. (LET ((BARE-BOXES (SET-SUBTRACT-BOXES (SET-SUBTRACT-BOXES NEW-OCCLUSION-BOXES COMMON-BOXES) DESTROYED-REGIONS))) (server-trace "~%In COPY-WINDOW-CONTENTS: NEW-OCCLUSION-BOXES= ~s COMMON-BOXES= ~s DESTROYED-REGIONS= ~s BARE-BOXES= ~s" NEW-OCCLUSION-BOXES COMMON-BOXES DESTROYED-REGIONS BARE-BOXES) (WHEN BARE-BOXES (EXPOSE-WINDOW-PORTION WINDOW STATE BARE-BOXES T))) (SERVER-TRACE "~%LEAVING COPY-WINDOW-CONTENTS") NEW-OCCLUSION-BOXES)) (ZWEI:DEFINE-INDENTATION RENDER-CHILD (1 1)) (DEFUN RECOVER-OBSCURED-CONTENTS (STATE WINDOW OLD-OCCLUSION-STACK) "A window has been moved to a new position. Reexpose, if possible, those parts of other windows which are now visible." (DECLARE (TYPE STATE STATE) (TYPE WINDOW WINDOW) ;; Note that the OLD-OCCLUSION-STACK argument isn't really an occlusion stack, ;; but is really a list of boxes which represent the occlusion stack. (TYPE LIST OLD-OCCLUSION-STACK)) ;; DOCUMENTATION ALERT!! This function has a case which is rather complex, so the pseudo-code ;; is located here to help in understanding what it really going on. The idea of this ;; function is that we have moved a window from one place on the screen to another and ;; that there may be other windows (siblings of the window which was moved) which need to ;; have their contents displayed. The simple case is where WINDOW's parent has no ;; other children except this one. A more complex case is where WINDOW has siblings, but ;; none of them have any children. The most complex case is where WINDOW has siblings and ;; some of them have children -- recursion is used to help with this case. ;; ALGORITHM ALERT!! ;; (OLD-WINDOW-PARTS is those parts screen which contains the old window which ;; are not taken up by the new window. That it, it is those parts of the old ;; window which do not overlap with the new window.) ;; set OLD-WINDOW-PARTS to be the old occlusion stack minus the new occlusion stack ;; IF parent has no other children THEN ;; IF parent has backing store THEN ;; Copy parent's backing store to OLD-WINDOW-PARTS ;; ELSE ;; Generate expose events on OLD-WINDOW-PARTS ;; ENDIF ;; ELSE (the parent has other children) ;; (REMAINING-PARTS at the end of the loop will be those parts of ;; OLD-WINDOW-PARTS which have no children in them.) ;;>>>set REMAINING-PARTS to be OLD-WINDOW-PARTS ;; LOOP for each other child of parent that intersects with REMAINING-PARTS ;; (INITIAL-CHILD-PARTS is those parts of child which need to be updated.) ;; set INITIAL-CHILD-PARTS to be REMAINING-PARTS intersected with ;; the child's occlusion stack ;; IF child has children THEN ;; recurse starting at >>> ending at <<< ;; passing INITIAL-CHILD-PARTS as OLD-WINDOW-PARTS ;; put result of recursion into CHILD-PARTS ;; ELSE ;; set CHILD-PARTS to be INITIAL-CHILD-PARTS ;; ENDIF ;; draw the part of child's borders that are now visible. ;; IF the child has a backing store THEN ;; Copy child's backing store to the CHILD-PARTS ;; ELSE ;; Generate expose events on the CHILD-PARTS ;; ENDIF ;; (We now calculate what is left by subtracting out what is taken up by ;; this child.) ;; set REMAINING-PARTS to be the REMAINING-PARTS minus INITIAL-CHILD-PARTS ;; ENDLOOP ;; IF the parent has backing store THEN ;; Copy parent's backing store to the REMAINING-PARTS ;; ELSE ;; Generate expose events on the REMAINING-PARTS ;; ENDIF ;;<<