;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-
;;; Written 06/05/90 11:07:45 by ARMAC,
;;; Reason: When exposing a deexposed mX screen be sure the width of the old-screen-array
;;; created matches the width of the screen's buffer array.
;;; while running on MX5 from band ARMX
;;; With SYSTEM 6.36, GC 6.4, VIRTUAL-MEMORY 6.3, MICRONET 6.0, MICRONET-COMM 6.4,
;;;  DISK-IO 6.3, DISK-LABEL 6.0, BASIC-PATHNAME 6.5, MAC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.2,
;;;  BASIC-NAMESPACE 6.8, BASIC-FILE 6.13, RPC 6.2, NFS-MX 6.7, EH 6.8, MAKE-SYSTEM 6.3,
;;;  MEMORY-AUX 6.0, COMPILER 6.18, TV 6.25, NVRAM 6.3, UCL 6.0, INPUT-EDITOR 6.0,
;;;  MACTOOLBOX 2.21, METER 6.2, ZWEI 6.20, DEBUG-TOOLS 6.4, WINDOW-MX 6.10, PRINTER 6.7,
;;;  MAC-PRINTER-TYPES 6.2, CLIPBOARD 6.1, TI-CLOS 6.49, CLEH 6.5, NETWORK-PATHNAME 6.2,
;;;  NETWORK-NAMESPACE 6.1, DATALINK 6.0, CHAOSNET 6.8, NETWORK-SUPPORT 6.1, NETWORK-SERVICE 6.3,
;;;  DATALINK-DISPLAYS 6.0, MX-DATALINK 6.1, NAMESPACE-EDITOR 6.5, IP 3.65, NFS-MX-SERVER 6.0,
;;;  MX-SERIAL 6.1, PRINTER-TYPES 6.2, IMAGEN 6.1, MAIL-DAEMON 6.6, MAIL-READER 6.8,
;;;  TELNET 6.1, VT100 6.0, STREAMER-TAPE 6.6, DECNET 1.72, VISIDOC 6.7, PROFILE 6.3,
;;;  Experimental SNRL 4.0, Experimental SST-WINDOWS 1.0, Experimental SNRL-ADD-ONS 1.0,
;;;  Experimental CONFLICT-RESOLUTION 37.0, Experimental QUERY 1.0, Experimental ACTION-RUNTIME 2.0,
;;;  Experimental ARMAC 4.0,  microcode 138, Band Name: armac-mx 04/06/90

#!C
; From file SHEET.LISP#> WINDOW; Hotel:
#10R TV#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "TV"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: WINDOW; SHEET.#"


(DEFMETHOD (SCREEN :BEFORE :EXPOSE) (&REST IGNORE)
  (COND ((NOT EXPOSED-P)
	 (SETQ BUFFER-HALFWORD-ARRAY (MAKE-ARRAY
                                       (TRUNCATE
                                         (* WIDTH
                                            (OR HEIGHT 1)
                                            BITS-PER-PIXEL)
                                         16.)
                                       :TYPE ART-16B :DISPLACED-TO BUFFER))
	 (if (mac-screen-p self)
	     ;; Handle the old-screen-array of the Macintosh Screen...
	     (ADJUST-ARRAY old-screen-array
			   `(,height ,(array-dimension buffer 1))      ; LG 5/15/90
;;			   :element-type (ARRAY-ELEMENT-TYPE old-screen-array)
			   :displaced-to buffer
			   :displaced-index-offset (+ (* y-offset width) x-offset))
	     (ADJUST-ARRAY OLD-SCREEN-ARRAY
			   (LIST HEIGHT WIDTH)
			   :ELEMENT-TYPE (ARRAY-ELEMENT-TYPE OLD-SCREEN-ARRAY)
			   :DISPLACED-TO (+ BUFFER (TRUNCATE (* Y-OFFSET WIDTH) (COND ( (= bits-per-pixel 1) 32)
										      ( (= bits-per-pixel 8) 4)))))
	     (WHEN (mmon-p)
	       ;; Deexpose any exposed overlapping screens, so this screen will have a clean spot to put itself...
	       ;; Added for multiple-monitor support.  CJJ 06/03/88.
	       ;;; Added by KJF on 08/19/88 for CJJ during addition of Multiple Monitor (MMON) support.
	       (LOOP FOR screen IN (SEND self :overlapping-exposed-screens)
		     DOING
		     ;; Also erase the spot left by the screen being deexposed...
		     (SEND screen :deexpose :default :clean)))))))

))
