;; -*- Mode:LISP; Package:(BOXER GLOBAL 1000); Base: 8.; Fonts:cptfont -*- #| Copyright 1985 Massachusetts Institute of Technology Permission to use, copy, modify, distribute, and sell this software and its documentation for any purpose is hereby granted without fee, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of M.I.T. not be used in advertising or publicity pertaining to distribution of the software without specific, written prior permission. M.I.T. makes no representations about the suitability of this software for any purpose. It is provided "as is" without express or implied warranty. +-Data--+ This file is part of the | BOXER | system +-------+ This file contains the low level code for the connection/disconnection of screen objects. The file INFSUP has the analogous methods for editor objects |# ;;; LOW-LEVEL methods to handle connection and disconnection of screen- ;;; objs. These methods take care of all adding/removal of screen-chas ;;; to/from screen-rows, and all adding/removal of screen-rows to/from ;;; screen-boxes. ;;; Like all the other methods which are concerned with inferior/superior ;;; relations between screen-objs the connection/disconnection methods ;;; have specific names for the specific screen-objs involved, and also ;;; have abtract names which deal with the abstract superior/inferior ;;; relation between those screen-objs. The abstract names are aliases ;;; for the specific names. ;;; :INSERT-SCREEN-CHA ;;; :INSERT-SCREEN-ROW ;;; :INSERT-SCREEN-OBJ ;;; These methods all cause the screen-obj which receives the message ;;; to insert in their screen inferiors just before ;;; . For convenience, if is ;;; null, is appended to the existing inferiors. ;;; These methods also all have variants which take a list of screen- ;;; objs as their first argument, and insert the entire list before ;;; their second argument. (DEFMETHOD (SCREEN-ROW :INSERT-SCREEN-CHA-AT-CHA-NO) (NEW-SCREEN-CHA CHA-NO) (SPLICE-ITEM-INTO-LIST-AT SCREEN-CHAS NEW-SCREEN-CHA CHA-NO) (WHEN (SCREEN-BOX? NEW-SCREEN-CHA) (TELL NEW-SCREEN-CHA :SET-SCREEN-ROW SELF))) (DEFMETHOD (SCREEN-ROW :INSERT-SCREEN-CHAS-AT-CHA-NO) (NEW-SCREEN-CHAS CHA-NO) (SPLICE-LIST-INTO-LIST-AT SCREEN-CHAS NEW-SCREEN-CHAS CHA-NO) (DOLIST (NEW-SCREEN-CHA NEW-SCREEN-CHAS) (WHEN (SCREEN-BOX? NEW-SCREEN-CHA) (TELL NEW-SCREEN-CHA :SET-SCREEN-ROW SELF)))) (DEFMETHOD (SCREEN-ROW :INSERT-SCREEN-CHA) (NEW-SCREEN-CHA BEFORE-SCREEN-CHA) (CHECK-SCREEN-CHA-ARG NEW-SCREEN-CHA) (COND ((NULL (TELL NEW-SCREEN-CHA :SCREEN-ROW)) (TELL NEW-SCREEN-CHA :SET-SCREEN-ROW SELF) (IF (NOT-NULL BEFORE-SCREEN-CHA) (SPLICE-ITEM-INTO-LIST SCREEN-CHAS NEW-SCREEN-CHA BEFORE-SCREEN-CHA) (SPLICE-ITEM-ONTO-LIST SCREEN-CHAS NEW-SCREEN-CHA))) (T ;; Oops.. (BARF 'BOXER-REDISPLAY-ERROR ':FORMAT-CTL "The screen-cha ~S is already part of ~S" ':FORMAT-ARG `(,NEW-SCREEN-CHA ,(TELL NEW-SCREEN-CHA :SCREEN-ROW)))))) (DEFMETHOD (SCREEN-ROW :INSERT-SCREEN-CHAS) (NEW-SCREEN-CHAS BEFORE-SCREEN-CHA) (CHECK-SCREEN-CHA-ARG (CAR NEW-SCREEN-CHAS)) (COND ((NULL (TELL (CAR NEW-SCREEN-CHAS) :SCREEN-ROW)) (DOLIST (NEW-SCREEN-CHA NEW-SCREEN-CHAS) (TELL NEW-SCREEN-CHA :SET-SCREEN-ROW SELF)) (IF (NOT-NULL BEFORE-SCREEN-CHA) (SPLICE-LIST-INTO-LIST SCREEN-CHAS NEW-SCREEN-CHAS BEFORE-SCREEN-CHA) (SPLICE-LIST-ONTO-LIST SCREEN-CHAS NEW-SCREEN-CHAS))) (T ;; Oops.. (BARF 'BOXER-REDISPLAY-ERROR ':FORMAT-CTL "I have only checked the first one, but the screen-chas ~S~%~ seem to already be part of ~S" ':FORMAT-ARG `(,NEW-SCREEN-CHAS ,(TELL (CAR NEW-SCREEN-CHAS) :SCREEN-ROW)))))) (DEFMETHOD (SCREEN-BOX :INSERT-SCREEN-ROW) (NEW-SCREEN-ROW BEFORE-SCREEN-ROW) (CHECK-SCREEN-ROW-ARG NEW-SCREEN-ROW) (COND ((NULL (TELL NEW-SCREEN-ROW :SCREEN-BOX)) (TELL NEW-SCREEN-ROW :SET-SCREEN-BOX SELF) (IF (NOT-NULL BEFORE-SCREEN-ROW) (SPLICE-ITEM-INTO-LIST SCREEN-ROWS NEW-SCREEN-ROW BEFORE-SCREEN-ROW) (SPLICE-ITEM-ONTO-LIST SCREEN-ROWS NEW-SCREEN-ROW))) (T (BARF 'BOXER-REDISPLAY-ERROR ':FORMAT-CTL "The screen-row ~S is already part of ~S" ':FORMAT-ARG `(,NEW-SCREEN-ROW ,(TELL NEW-SCREEN-ROW :SCREEN-ROW)))))) (DEFMETHOD (SCREEN-BOX :INSERT-SCREEN-ROWS) (NEW-SCREEN-ROWS BEFORE-SCREEN-ROW) (CHECK-SCREEN-ROW-ARG (CAR NEW-SCREEN-ROWS)) (COND ((NULL (TELL (CAR NEW-SCREEN-ROWS) :SCREEN-BOX)) (DOLIST (NEW-SCREEN-ROW NEW-SCREEN-ROWS) (TELL NEW-SCREEN-ROW :SET-SCREEN-BOX SELF)) (IF (NOT-NULL BEFORE-SCREEN-ROW) (SPLICE-LIST-INTO-LIST SCREEN-ROWS NEW-SCREEN-ROWS BEFORE-SCREEN-ROW) (SPLICE-LIST-ONTO-LIST SCREEN-ROWS NEW-SCREEN-ROWS))) (T (BARF 'BOXER-REDISPLAY-ERROR ':FORMAT-CTL "I have only checked the first one, but the screen-rows ~S~%~ seem to already be part of ~S" ':FORMAT-ARG `(,NEW-SCREEN-ROWS ,(TELL (CAR NEW-SCREEN-ROWS) :SCREEN-ROW)))))) ;;; Alias for the abstract :INSERT-SCREEN-OBJs methods. (DEFMETHOD-ALIAS (SCREEN-ROW :INSERT-SCREEN-OBJ) :INSERT-SCREEN-CHA) (DEFMETHOD-ALIAS (SCREEN-BOX :INSERT-SCREEN-OBJ) :INSERT-SCREEN-ROW) (DEFMETHOD-ALIAS (SCREEN-ROW :INSERT-SCREEN-OBJS) :INSERT-SCREEN-CHAS) (DEFMETHOD-ALIAS (SCREEN-BOX :INSERT-SCREEN-OBJS) :INSERT-SCREEN-ROWS) ;;; :APPEND-SCREEN-CHA ;;; :APPEND-SCREEN-ROW ;;; :APPEND-SCREEN-OBJ ;;; These methods all cause the screen-obj which receives the message ;;; to append to their existing screen inferiors. ;;; Note that this is just like :insert-screen-obj with a null second ;;; argument. Just like :insert-screen-obj methods, :append-screen-obj ;;; methods have variants that take a list of new-screen-objs and append ;;; the entire list to the existing screen inferiors. (DEFMETHOD (SCREEN-ROW :APPEND-SCREEN-CHA) (NEW-SCREEN-CHA) (SPLICE-ITEM-ONTO-LIST SCREEN-CHAS NEW-SCREEN-CHA) (WHEN (SCREEN-BOX? NEW-SCREEN-CHA) (TELL NEW-SCREEN-CHA :SET-SCREEN-ROW SELF))) (DEFMETHOD (SCREEN-ROW :APPEND-SCREEN-CHAS) (NEW-SCREEN-CHAS) (SPLICE-LIST-ONTO-LIST SCREEN-CHAS NEW-SCREEN-CHAS) (DOLIST (NEW-SCREEN-CHA NEW-SCREEN-CHAS) (WHEN (SCREEN-BOX? NEW-SCREEN-CHA) (TELL NEW-SCREEN-CHA :SET-SCREEN-ROW SELF)))) (DEFMETHOD (SCREEN-BOX :APPEND-SCREEN-ROW) (NEW-SCREEN-ROW) (CHECK-SCREEN-ROW-ARG NEW-SCREEN-ROW) (COND ((NULL (TELL NEW-SCREEN-ROW :SCREEN-BOX)) (TELL NEW-SCREEN-ROW :SET-SCREEN-BOX SELF) (SPLICE-ITEM-ONTO-LIST SCREEN-ROWS NEW-SCREEN-ROW)) (T ;; Oops.. (BARF 'BOXER-REDISPLAY-ERROR ':FORMAT-CTL "The screen row ~s is already part of ~S" ':FORMAT-ARG `(,NEW-SCREEN-ROW ,(TELL NEW-SCREEN-ROW :SCREEN-BOX)))))) (DEFMETHOD (SCREEN-BOX :APPEND-SCREEN-ROWS) (NEW-SCREEN-ROWS) (CHECK-SCREEN-ROW-ARG (CAR NEW-SCREEN-ROWS)) (COND ((NULL (TELL (CAR NEW-SCREEN-ROWS) :SCREEN-BOX)) (DOLIST (NEW-SCREEN-ROW NEW-SCREEN-ROWS) (TELL NEW-SCREEN-ROW :SET-SCREEN-BOX SELF)) (SPLICE-LIST-ONTO-LIST SCREEN-ROWS NEW-SCREEN-ROWS)) (T ;; Oops (BARF 'BOXER-REDISPLAY-ERROR ':FORMAT-CTL "I have only checked the first one, but the screen-rows ~S~%~ seem to already be part of ~S" ':FORMAT-ARG `(,NEW-SCREEN-ROWS ,(TELL (CAR NEW-SCREEN-ROWS) :SCREEN-BOX)))))) ;;; Alias for the abstract :APPEND-SCREEN-OBJs methods. (DEFMETHOD-ALIAS (SCREEN-ROW :APPEND-SCREEN-OBJ) :APPEND-SCREEN-CHA) (DEFMETHOD-ALIAS (SCREEN-BOX :APPEND-SCREEN-OBJ) :APPEND-SCREEN-ROW) (DEFMETHOD-ALIAS (SCREEN-ROW :APPEND-SCREEN-OBJS) :APPEND-SCREEN-CHAS) (DEFMETHOD-ALIAS (SCREEN-BOX :APPEND-SCREEN-OBJS) :APPEND-SCREEN-ROWS) ;;; :DELETE-SCREEN-CHA ;;; :DELETE-SCREEN-ROW ;;; :DELETE-SCREEN-OBJ ;;; These methods all cause the screen-obj which receives the message ;;; to delete from their screen inferiors. To help with ;;; deleting multiple inferior screen objs, these methods have variants ;;; (called :delete-between-screen-objs ;;; which delete all the inferior screen-objs between ;;; (inclusive) and (exclusive). (DEFMETHOD (SCREEN-ROW :DELETE-SCREEN-CHA-AT-CHA-NO) (CHA-NO) (LET ((CHA-TO-DELETE (NTH CHA-NO SCREEN-CHAS))) (SPLICE-ITEM-OUT-OF-LIST-AT SCREEN-CHAS CHA-NO) (WHEN (SCREEN-BOX? CHA-TO-DELETE) (TELL CHA-TO-DELETE :SET-SCREEN-ROW NIL)))) (DEFMETHOD (SCREEN-ROW :DELETE-SCREEN-CHAS-FROM-TO) (FROM-CHA-NO TO-CHA-NO) (LET ((CHAS-TO-DELETE (ITEMS-SPLICED-FROM-TO-FROM-LIST SCREEN-CHAS FROM-CHA-NO TO-CHA-NO))) (SPLICE-ITEMS-FROM-TO-OUT-OF-LIST SCREEN-CHAS FROM-CHA-NO TO-CHA-NO) (DOLIST (CHA-TO-DELETE CHAS-TO-DELETE) (WHEN (SCREEN-BOX? CHA-TO-DELETE) (TELL CHA-TO-DELETE :SET-SCREEN-ROW NIL))))) (DEFMETHOD (SCREEN-ROW :DELETE-SCREEN-CHA) (SCREEN-CHA-TO-DELETE) (CHECK-SCREEN-CHA-ARG SCREEN-CHA-TO-DELETE) (COND ((EQ (TELL SCREEN-CHA-TO-DELETE :SCREEN-ROW) SELF) (TELL SCREEN-CHA-TO-DELETE :SET-SCREEN-ROW NIL) (SPLICE-ITEM-OUT-OF-LIST SCREEN-CHAS SCREEN-CHA-TO-DELETE)) (T ;; Oops.. (BARF 'BOXER-REDISPLAY-ERROR "The screen-cha ~S is not part of the screen-row ~S" SCREEN-CHA-TO-DELETE SELF)))) (DEFMETHOD (SCREEN-ROW :DELETE-BETWEEN-SCREEN-CHAS) (FROM-SCREEN-CHA TO-SCREEN-CHA) (CHECK-SCREEN-CHA-ARG FROM-SCREEN-CHA) (CHECK-SCREEN-CHA-ARG TO-SCREEN-CHA) (COND ((AND (EQ (TELL FROM-SCREEN-CHA :SCREEN-ROW) SELF) (EQ (TELL TO-SCREEN-CHA :SCREEN-ROW) SELF)) (LET ((DELETED-SCREEN-CHAS (TELL FROM-SCREEN-CHA :SELF-AND-NEXT-SCREEN-CHAS))) (SPLICE-BETWEEN-ITEMS-OUT-OF-LIST SCREEN-CHAS FROM-SCREEN-CHA TO-SCREEN-CHA) (DOLIST (DELETED-SCREEN-CHA DELETED-SCREEN-CHAS) (TELL DELETED-SCREEN-CHA :SET-SCREEN-ROW NIL)))) (T ;; Oops.. (BARF 'BOXER-REDISPLAY-ERROR ':FORMAT-CTL "The screen-chas ~S and ~S are not both part of the screen row ~S" ':FORMAT-ARG `(FROM-SCREEN-CHA ,TO-SCREEN-CHA ,SELF))))) (DEFMETHOD (SCREEN-BOX :DELETE-SCREEN-ROW) (SCREEN-ROW-TO-DELETE) (CHECK-SCREEN-ROW-ARG SCREEN-ROW-TO-DELETE) (COND ((EQ (TELL SCREEN-ROW-TO-DELETE :SCREEN-BOX) SELF) (TELL SCREEN-ROW-TO-DELETE :SET-SCREEN-BOX NIL) (SPLICE-ITEM-OUT-OF-LIST SCREEN-ROWS SCREEN-ROW-TO-DELETE)) (T ;; Oops.. (BARF 'BOXER-REDISPLAY-ERROR ':FORMAT-CTL "The screen-row ~S is not part of the screen-box ~S" ':FORMAT-ARG `(,SCREEN-ROW-TO-DELETE ,SELF))))) (DEFMETHOD (SCREEN-BOX :DELETE-BETWEEN-SCREEN-ROWS) (FROM-SCREEN-ROW TO-SCREEN-ROW) (CHECK-SCREEN-ROW-ARG FROM-SCREEN-ROW) (CHECK-SCREEN-ROW-ARG TO-SCREEN-ROW) (COND ((AND (EQ (TELL FROM-SCREEN-ROW :SCREEN-BOX) SELF) (EQ (TELL TO-SCREEN-ROW :SCREEN-BOX) SELF)) (LET ((DELETED-SCREEN-ROWS (TELL FROM-SCREEN-ROW :SELF-AND-NEXT-SCREEN-ROWS))) (SPLICE-BETWEEN-ITEMS-OUT-OF-LIST SCREEN-ROWS FROM-SCREEN-ROW TO-SCREEN-ROW) (DOLIST (DELETED-SCREEN-ROW DELETED-SCREEN-ROWS) (TELL DELETED-SCREEN-ROW :SET-SCREEN-BOX NIL)))) (T ;; Oops.. (BARF 'BOXER-REDISPLAY-ERROR "The screen-rows ~S and ~S are not both part of the screen box ~S" FROM-SCREEN-ROW TO-SCREEN-ROW SELF)))) ;;; Alias for the abstract :DELETE-SCREEN-OBJ methods. (DEFMETHOD-ALIAS (SCREEN-ROW :DELETE-SCREEN-OBJ) :DELETE-SCREEN-CHA) (DEFMETHOD-ALIAS (SCREEN-BOX :DELETE-SCREEN-OBJ) :DELETE-SCREEN-ROW) (DEFMETHOD-ALIAS (SCREEN-ROW :DELETE-BETWEEN-SCREEN-OBJS) :DELETE-BETWEEN-SCREEN-CHAS) (DEFMETHOD-ALIAS (SCREEN-BOX :DELETE-BETWEEN-SCREEN-OBJS) :DELETE-BETWEEN-SCREEN-ROWS) ;;; :KILL-SCREEN-CHA ;;; :KILL-SCREEN-ROW ;;; :KILL-SCREEN-OBJ ;;; These methods all cause the screen-obj which receives the message ;;; to delete and all the inferior screen-objs which ;;; follow from their screen inferiors. (DEFMETHOD (SCREEN-ROW :KILL-SCREEN-CHAS-FROM) (NO-OF-FIRST-OBJ-TO-KILL) (LET ((KILLED-SCREEN-CHAS (NTHCDR NO-OF-FIRST-OBJ-TO-KILL SCREEN-CHAS))) (SPLICE-ITEM-AND-TAIL-OUT-OF-LIST-FROM SCREEN-CHAS NO-OF-FIRST-OBJ-TO-KILL) (DOLIST (KILLED-SCREEN-CHA KILLED-SCREEN-CHAS) (WHEN (SCREEN-BOX? KILLED-SCREEN-CHA) (TELL KILLED-SCREEN-CHA :SET-SCREEN-ROW NIL))))) (DEFMETHOD (SCREEN-ROW :KILL-SCREEN-CHA) (SCREEN-CHA-TO-KILL) (CHECK-SCREEN-CHA-ARG SCREEN-CHA-TO-KILL) (COND ((EQ (TELL SCREEN-CHA-TO-KILL :SCREEN-ROW) SELF) (LET ((KILLED-SCREEN-CHAS (MEMQ SCREEN-CHA-TO-KILL SCREEN-CHAS))) (DOLIST (KILLED-SCREEN-CHA KILLED-SCREEN-CHAS) (WHEN (SCREEN-BOX? KILLED-SCREEN-CHA) (TELL KILLED-SCREEN-CHA :SET-SCREEN-ROW NIL))) (SPLICE-ITEM-AND-TAIL-OUT-OF-LIST SCREEN-CHAS SCREEN-CHA-TO-KILL))) (T ;; Oops.. (BARF 'BOXER-REDISPLAY-ERROR ':FORMAT-CTL "The screen cha ~S is not part of the screen row ~S" ':FORMAT-ARG `(,SCREEN-CHA-TO-KILL ,SELF))))) (DEFMETHOD (SCREEN-BOX :KILL-SCREEN-ROW) (SCREEN-ROW-TO-KILL) (CHECK-SCREEN-ROW-ARG SCREEN-ROW-TO-KILL) (COND ((EQ (TELL SCREEN-ROW-TO-KILL :SCREEN-BOX) SELF) (LET ((KILLED-SCREEN-ROWS (MEMQ SCREEN-ROW-TO-KILL SCREEN-ROWS))) (DOLIST (KILLED-SCREEN-ROW KILLED-SCREEN-ROWS) (TELL KILLED-SCREEN-ROW :SET-SCREEN-BOX NIL)) (SPLICE-ITEM-AND-TAIL-OUT-OF-LIST SCREEN-ROWS SCREEN-ROW-TO-KILL))) (T ;; Oops.. (BARF 'BOXER-REDISPLAY-ERROR ':FORMAT-CTL "The screen row ~S is not part of the screen box ~S" ':FORMAT-ARG `(,SCREEN-ROW-TO-KILL ,SELF))))) ;;; Alis for the abstract :KILL-SCREEN-OBJ methods. (DEFMETHOD-ALIAS (SCREEN-ROW :KILL-SCREEN-OBJ) :KILL-SCREEN-CHA) (DEFMETHOD-ALIAS (SCREEN-BOX :KILL-SCREEN-OBJ) :KILL-SCREEN-ROW) ;;; LOW-LEVEL screen-obj accessors. All of these do the obvious thing. (DEFMETHOD (SCREEN-ROW :SCREEN-OBJS-AT-AND-AFTER) (NO-OF-FIRST-OBJ) (NTHCDR NO-OF-FIRST-OBJ SCREEN-CHAS)) (DEFMETHOD (SCREEN-ROW :SCREEN-CHA-AT-CHA-NO) (CHA-NO) (NTH CHA-NO SCREEN-CHAS)) (DEFMETHOD (SCREEN-ROW :SCREEN-OBJS-AFTER) (NO-OF-FIRST-OBJ) (NTHCDR (+ 1 NO-OF-FIRST-OBJ) SCREEN-CHAS)) (DEFMETHOD (SCREEN-ROW :FIRST-SCREEN-CHA) () (FIRST SCREEN-CHAS)) (DEFMETHOD (SCREEN-BOX :FIRST-SCREEN-ROW) () (FIRST SCREEN-ROWS)) ;;; Graphics-screen-box accessors ;;; since graphics boxes have NO rows we use the SCREEN-ROWS instance variable which should be ;;; renamed immediate inferiors or some such to reflect the fact that it can contain SHEETS (DEFMETHOD (GRAPHICS-SCREEN-BOX :SCREEN-SHEET) () SCREEN-ROWS) (DEFMETHOD (GRAPHICS-SCREEN-BOX :SET-SCREEN-SHEET) (NEW-SHEET) (SETQ SCREEN-ROWS NEW-SHEET) (SETF (GRAPHICS-SCREEN-SHEET-SCREEN-BOX NEW-SHEET) SELF)) ;;;obselete no one should be calling these;;;;;;;;;;;;;;;; (DEFMETHOD (SCREEN-CHA :NEXT-SCREEN-CHA) () (CADR (TELL SELF :SELF-AND-NEXT-SCREEN-CHAS))) (DEFMETHOD (SCREEN-CHA :NEXT-SCREEN-CHAS) () (CDR (TELL SELF :SELF-AND-NEXT-SCREEN-CHAS))) (DEFMETHOD (SCREEN-CHA :SELF-AND-NEXT-SCREEN-CHAS) () (MEMQ SELF (TELL SCREEN-ROW :SCREEN-CHAS))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (DEFMETHOD (SCREEN-ROW :NEXT-SCREEN-ROW) () (CADR (TELL SELF :SELF-AND-NEXT-SCREEN-ROWS))) (DEFMETHOD (SCREEN-ROW :NEXT-SCREEN-ROWS) () (CDR (TELL SELF :SELF-AND-NEXT-SCREEN-ROWS))) (DEFMETHOD (SCREEN-ROW :SELF-AND-NEXT-SCREEN-ROWS) () (MEMQ SELF (TELL SCREEN-BOX :SCREEN-ROWS))) (DEFMETHOD (SCREEN-CHA :INFERIORS) () NIL) (DEFMETHOD-ALIAS (SCREEN-ROW :INFERIORS) :SCREEN-CHAS) (DEFMETHOD-ALIAS (SCREEN-BOX :INFERIORS) :SCREEN-ROWS) (DEFMETHOD-ALIAS (SCREEN-CHA :SUPERIOR) :SCREEN-ROW) (DEFMETHOD-ALIAS (SCREEN-ROW :SUPERIOR) :SCREEN-BOX) (DEFMETHOD-ALIAS (SCREEN-ROW :FIRST-SCREEN-OBJ) :FIRST-SCREEN-CHA) (DEFMETHOD-ALIAS (SCREEN-BOX :FIRST-SCREEN-OBJ) :FIRST-SCREEN-ROW) (DEFMETHOD-ALIAS (SCREEN-CHA :NEXT-SCREEN-OBJ) :NEXT-SCREEN-CHA) (DEFMETHOD-ALIAS (SCREEN-ROW :NEXT-SCREEN-OBJ) :NEXT-SCREEN-ROW) (DEFMETHOD-ALIAS (SCREEN-CHA :NEXT-SCREEN-OBJS) :NEXT-SCREEN-CHAS) (DEFMETHOD-ALIAS (SCREEN-ROW :NEXT-SCREEN-OBJS) :NEXT-SCREEN-ROWS) (DEFMETHOD-ALIAS (SCREEN-CHA :SELF-AND-NEXT-SCREEN-OBJS) :SELF-AND-NEXT-SCREEN-CHAS) (DEFMETHOD-ALIAS (SCREEN-ROW :SELF-AND-NEXT-SCREEN-OBJS) :SELF-AND-NEXT-SCREEN-ROWS) (DEFMETHOD (SCREEN-CHA :SCREEN-BOX) () (IF (SCREEN-ROW? SCREEN-ROW) (TELL SCREEN-ROW :SCREEN-BOX) SCREEN-ROW)) (DEFMETHOD (SCREEN-ROW :SCREEN-BOX) () SCREEN-BOX) (DEFMETHOD (SCREEN-BOX :SCREEN-BOX) () SUPERIOR-SCREEN-BOX) (DEFMETHOD (SCREEN-BOX :SUPERIOR-SCREEN-BOX) () (TELL SELF :SCREEN-BOX)) (DEFMETHOD (SCREEN-CHA :LOWEST-SCREEN-BOX) () (TELL SCREEN-ROW :LOWEST-SCREEN-BOX)) (DEFMETHOD (SCREEN-ROW :LOWEST-SCREEN-BOX) () SCREEN-BOX) (DEFMETHOD (SCREEN-BOX :LOWEST-SCREEN-BOX) () SELF) (DEFMETHOD (SCREEN-OBJ :OFFSETS) () (VALUES X-OFFSET Y-OFFSET)) (DEFMETHOD (SCREEN-OBJ :SET-OFFSETS) (NEW-X-OFFSET NEW-Y-OFFSET) (SETQ X-OFFSET NEW-X-OFFSET Y-OFFSET NEW-Y-OFFSET)) ;;; Changing from/to SCREEN-BOXES and GRAPHICS-SCREEN-BOXES (DEFMETHOD (SCREEN-BOX :BEFORE :SET-FLAVOR) (IGNORE) (DOLIST (SCR-ROW SCREEN-ROWS) (TELL SCR-ROW :SET-SCREEN-BOX NIL) (TELL SCR-ROW :DEALLOCATE-SELF) (SETQ SCREEN-ROWS NIL))) (DEFMETHOD (GRAPHICS-SCREEN-BOX :BEFORE :SET-FLAVOR) (IGNORE) (LET ((GRAPHICS-SHEET (AND SCREEN-ROWS (GRAPHICS-SCREEN-SHEET-ACTUAL-OBJ SCREEN-ROWS)))) (UNLESS (NULL GRAPHICS-SHEET) (SETF (GRAPHICS-SHEET-SCREEN-OBJS GRAPHICS-SHEET) (DELQ (ASSQ SELF (GRAPHICS-SHEET-SCREEN-OBJS GRAPHICS-SHEET)) (GRAPHICS-SHEET-SCREEN-OBJS GRAPHICS-SHEET)))) (SETQ SCREEN-ROWS NIL))) ;;; Methods that support the interaction between BP's and SCREEN BOXEs (DEFMETHOD (SCREEN-BOX :SET-BPS) (NEW-VALUE) (CHECK-ARG NEW-VALUE #+ti '(LAMBDA (X) (AND (LISTP X) (EVERY X 'BP?))) #-ti #'(LAMBDA (X) (AND (LISTP X) (EVERY X 'BP?))) "A list of Boxer BP's") (SETQ BPS NEW-VALUE)) (DEFMETHOD (SCREEN-BOX :ADD-BP) (NEW-BP) (CHECK-BP-ARG NEW-BP) (PUSH NEW-BP BPS)) (DEFMETHOD (SCREEN-BOX :DELETE-BP) (BP) (CHECK-BP-ARG BP) (SETQ BPS (DELETE BP BPS)))