;;; -*- Mode: Common-Lisp; Package: PRINTER; Base: 10.; Patch-File: T -*- ;;; Reason: Changes to QUEUE-SCREEN-BITMAP and ZAP-SCREEN-AND-WHOLINE to allow ;;; screen printing from color screen in dual-monitor mode. ;;; RESTRICTED RIGHTS LEGEND ;;; ;;; Use, duplication, or disclosure by the Government is subject to ;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in ;;; Technical Data and Computer Software clause at 52.227-7013. ;;; ;;; TEXAS INSTRUMENTS INCORPORATED ;;; P.O. BOX 2909, M/S 2151 ;;; AUSTIN, TEXAS 78769 ;;; ;;; Copyright (C) 1989 Texas Instruments Incorporated. ;;; All rights reserved. ;;; Written 06/30/89 11:48:18 by MARKY, ;;; while running on LIBRA from band LODA ;;; With SYSTEM 6.9, VIRTUAL-MEMORY 6.1, EH 6.3, MAKE-SYSTEM 6.0, MICRONET 6.0, LOCAL-FILE 6.0, ;;; BASIC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.0, BASIC-NAMESPACE 6.1, NETWORK-NAMESPACE 6.0, ;;; DISK-IO 6.0, DISK-LABEL 6.0, BASIC-FILE 6.2, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0, ;;; COMPILER 6.6, TV 6.11, DATALINK 6.0, CHAOSNET 6.0, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.1, ;;; SYSLOG 6.1, STREAMER-TAPE 6.3, UCL 6.0, INPUT-EDITOR 6.0, METER 6.0, ZWEI 6.3, ;;; Experimental DEBUG-TOOLS 6.3, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.1, DATALINK-DISPLAYS 6.0, ;;; FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.1, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.0, ;;; IMAGEN 6.0, SUGGESTIONS 6.0, MAIL-DAEMON 6.2, MAIL-READER 6.0, TELNET 6.0, VT100 6.0, ;;; NAMESPACE-EDITOR 6.0, PROFILE 6.1, VISIDOC 6.2, TI-CLOS 6.9, CLEH 6.4, IP 3.47, ;;; Experimental BUG 11.10, Experimental CLX 6.1, CLUE 6.5, X11M 6.1, MMON 7.0, Experimental SLAP 3.15, ;;; microcode 429, Band Name: 6/5,mmon,patches,label ;;; SPR 10058 10060 Enable screen printing from color screen in dual monitor mode. ;;; may 06/30/89 #!C ; From file SCREEN-IMAGE.LISP#> PRINTER; SYS: #10R PRINTER#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "PRINTER")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* SYS:COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: PRINTER; SCREEN-IMAGE.#" ;; may 06/30/89 Added for dual monitor support (DEFPARAMETER PLANE-MASK-ARRAY-7F (MAKE-ARRAY '(1 32) :ELEMENT-TYPE '(UNSIGNED-BYTE 8.) :INITIAL-VALUE #X7F) "Used by BITBLT-MASKED to remove a plane from an array in dual-monitor-p mode.") ;; may 06/30/89 Added for dual monitor support (DEFUN BITBLT-MASKED (ALU WIDTH HEIGHT FROM-ARRAY FROM-X FROM-Y TO-ARRAY TO-X TO-Y &optional (MASK (tv:SHEET-PLANE-MASK w:DEFAULT-SCREEN)) (SKIP-INITIAL-BITBLT-P NIL)) "Just like BITBLT except If array is an 8-bit array and the plane mask is tv:*default-dual-monitor-color-plane-mask* then the destination array contents are ANDED with the plane mask by a second BITBLT from the TO-ARRAY to itself. If SKIP-INITIAL-BITBLT-P is non-nil then the initial bitblt is skipped." (OR SKIP-INITIAL-BITBLT-P (BITBLT ALU WIDTH HEIGHT FROM-ARRAY FROM-X FROM-Y TO-ARRAY TO-X TO-Y)) (WHEN (AND (EQ (ARRAY-TYPE TO-ARRAY) 'ART-8B) (= MASK tv:*default-dual-monitor-color-plane-mask*)) (BITBLT w:ALU-AND WIDTH HEIGHT PLANE-MASK-ARRAY-7F 0 0 TO-ARRAY TO-X TO-Y))) (DEFUN ZAP-SCREEN-AND-WHOLINE () "Zap a copy of the screen and who-line bitmap arrays" (make-full-screen-array) ;ab 9/27/88 ;; First clear array... (BITBLT W::ALU-SETZ *FULL-SCREEN-WIDTH* *FULL-SCREEN-HEIGHT* *FULL-SCREEN-ARRAY* 0 0 *FULL-SCREEN-ARRAY* 0 0) ;; Turn on all blinkers in the default screen to make sure we capture them, first saving ;; their original visibility... (LET ((BLINKER-VISIBILITY-LIST (W::GET-VISIBILITY-OF-ALL-SHEETS-BLINKERS W:DEFAULT-SCREEN))) (DOLIST (A-BLINKER (W:SHEET-BLINKER-LIST W:DEFAULT-SCREEN)) (IF (EQ (tv:BLINKER-VISIBILITY A-BLINKER) :BLINK) (SEND A-BLINKER :SET-VISIBILITY :ON))) ;; Grab the screen with blinkers before knowing what the user really wants... (BITBLT-masked W:ALU-SETA (W:SHEET-WIDTH W:DEFAULT-SCREEN) (W:SHEET-HEIGHT W:DEFAULT-SCREEN) ;; may 06/30/89 (W:SHEET-SCREEN-ARRAY W:DEFAULT-SCREEN) 0 0 *FULL-SCREEN-ARRAY* 0 0) ;; Restore all blinkers to their original visibility... (W::SET-VISIBILITY-OF-ALL-SHEETS-BLINKERS W:DEFAULT-SCREEN BLINKER-VISIBILITY-LIST)) ;; Now get the who-line screen, too... (when (W:SHEET-SCREEN-ARRAY W:WHO-LINE-SCREEN) (BITBLT-masked W:ALU-SETA (W:SHEET-WIDTH W:WHO-LINE-SCREEN) (W:SHEET-HEIGHT W:WHO-LINE-SCREEN) ;; may 06/30/89 (W:SHEET-SCREEN-ARRAY W:WHO-LINE-SCREEN) 0 0 *FULL-SCREEN-ARRAY* 0 (W:SHEET-HEIGHT W:DEFAULT-SCREEN))) ) (DEFUN QUEUE-SCREEN-BITMAP (WINDOW-NAME WIDTH HEIGHT FROM-X FROM-Y BLINKERP PRINTER-NAME PRINTER-DEFAULTS &AUX SAVE-ARRAY) "Enqueue a print request for the specified portion of the screen." ;;ab 9/27/88. Assumes ZAP-SCREEN-AND-WHOLINE has already been called once by our caller so that *FULL-SCREEN-ARRAY* is ;;The right size on entry. (DECLARE (SPECIAL *FULL-SCREEN-ARRAY*)) ;; Create a separate array for this request, clear it, and ;; then save relevant portion of image in it... (SETQ SAVE-ARRAY (ALLOCATE-RESOURCE 'SCREEN-IMAGE-BIT-ARRAY WIDTH HEIGHT)) (BITBLT W::ALU-SETZ (array-dimension SAVE-ARRAY 1) (array-dimension SAVE-ARRAY 0) SAVE-ARRAY 0 0 SAVE-ARRAY 0 0) ;; If no blinkers requested, get the screen-and-who-line again, this time sans blinkers... (WHEN (NOT BLINKERP) ;;Turn blinkers off, suspend interrupts while we... (W:PREPARE-SHEET (W:DEFAULT-SCREEN) ;; Grab the screen without blinkers... (BITBLT-masked W:ALU-SETA (W:SHEET-WIDTH W:DEFAULT-SCREEN) ;; may 06/30/89 (W:SHEET-HEIGHT W:DEFAULT-SCREEN) (W:SHEET-SCREEN-ARRAY W:DEFAULT-SCREEN) 0 0 *FULL-SCREEN-ARRAY* 0 0)) ;; Now get the who-line screen, too... ; (bitblt w:alu-seta ; (w:sheet-width w:who-line-screen) ; (w:sheet-height w:who-line-screen) ; (w:sheet-screen-array w:who-line-screen) 0 0 ; *Full-Screen-Array* 0 (w:sheet-height w:default-screen)) ) ;; Save the requested portion of the screen in the SAVE-ARRAY... (if (typep *full-screen-array* '(array bit)) (BITBLT W:ALU-SETA WIDTH HEIGHT *FULL-SCREEN-ARRAY* FROM-X FROM-Y SAVE-ARRAY 0 0) (progn (bitblt-masked W:ALU-SETA WIDTH HEIGHT *FULL-SCREEN-ARRAY* FROM-X FROM-Y SAVE-ARRAY 0 0 ;; may 06/27/89 (tv:sheet-plane-mask w:default-screen) t) ;; may 06/27/89 (translate-color-array *full-screen-array* save-array (tv:sheet-foreground-color w:default-screen) (tv:sheet-background-color w:default-screen) from-x from-y 0 0 (+ from-x height -1)(+ from-y width -1) ))) ;; If printer options are OK, queue this array-print request... (FS:FORCE-USER-TO-LOGIN) (MULTIPLE-VALUE-BIND (PRINTER-OPTIONS-OK ERROR-MESSAGE) (CHECK-PRINTER-OPTIONS PRINTER-NAME) (COND (PRINTER-OPTIONS-OK (APPLY #'INSERT-ARRAY-IN-QUEUE WINDOW-NAME PRINTER-NAME SAVE-ARRAY WIDTH HEIGHT 0 0 :USER USER-ID PRINTER-DEFAULTS) ) (T (W::MOUSE-CONFIRM (FORMAT () "Error: ~A" ERROR-MESSAGE) "Click mouse here to confirm."))))) ))