;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-

;;; Reason: Wrap source-array y-coordinate in MAC:SEND-BITBLT when the
;;; source array is too big to blt all at once and loops.

;;;                           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 149149, M/S 2151             
;;;   AUSTIN, TEXAS 78714-9149                 
;;;
;;; Copyright (C) 1989 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Written 10/05/90 10:07:53 by MARKY,
;;; while running on MX5 from band N928
;;; With SYSTEM 6.42, GC 6.8, VIRTUAL-MEMORY 6.3, MICRONET 6.0, MICRONET-COMM 6.4,
;;;  DISK-IO 6.4, DISK-LABEL 6.1, BASIC-PATHNAME 6.5, MAC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.2,
;;;  BASIC-NAMESPACE 6.8, BASIC-FILE 6.15, RPC 6.2, NFS-MX 6.9, EH 6.8, MAKE-SYSTEM 6.5,
;;;  MEMORY-AUX 6.0, COMPILER 6.18, TV 6.32, NVRAM 6.4, UCL 6.1, INPUT-EDITOR 6.1,
;;;  MACTOOLBOX 2.32, METER 6.2, ZWEI 6.28, DEBUG-TOOLS 6.5, WINDOW-MX 6.14, PRINTER 6.9,
;;;  MAC-PRINTER-TYPES 6.2, CLIPBOARD 6.1, TI-CLOS 6.54, CLEH 6.5, NETWORK-PATHNAME 6.2,
;;;  NETWORK-NAMESPACE 6.1, DATALINK 6.0, CHAOSNET 6.9, NETWORK-SUPPORT 6.1, NETWORK-SERVICE 6.3,
;;;  DATALINK-DISPLAYS 6.0, MX-DATALINK 6.1, NAMESPACE-EDITOR 6.7, IP 3.67, NFS-MX-SERVER 6.0,
;;;  MX-SERIAL 6.2, PRINTER-TYPES 6.2, IMAGEN 6.1, MAIL-DAEMON 6.6, MAIL-READER 6.9,
;;;  TELNET 6.1, VT100 6.0, STREAMER-TAPE 6.8, DECNET 1.72, VISIDOC 6.7, PROFILE 6.3,
;;;  Experimental BUG 11.21,  microcode 195, Band Name: microExplorer Network (9/28)

;; spr 11083 when bitblting large array from explorer to mac
;; don't forget to check when the source array runs off edge
;; - use MOD to wrap back to start of source array.

#!C
; From file MAC-MESSAGES.LISP#> WINDOW-MX; Hotel:
#10R MACINTOSH#:
(lisp:COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "MACINTOSH"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: WINDOW-MX; MAC-MESSAGES.É#É"


(DEFUN send-bitblt (alu width height
		      from-window-id-or-array from-x from-y
		      to-window-id-or-array to-x to-y
		      &optional source-array
		      (source-from-x from-x) (source-from-y from-y)
		      restoration-p		       ; T iff a restoration of a bit array to Mac.
		      &aux source-height source-width replication)
  "Called iff the source and/or destination is on the Mac.  Mac sources and destinations
are ALWAYS the bitmaps of the windows associated with the window-ids, NEVER the
windows' graphPorts, i.e., screen-arrays.  All indirection is resolved before calling this
routine."
  (UNLESS (OR *ignore-commands-for-the-mac* (ZEROP width) (ZEROP height))
    (LET* ((inhibit-scheduling-flag t)    ; Protect big multi-copy copybits.
	   )
      (dump-draw-char-cache)
      (SETF width (ABS width)
	    height (ABS height)
	    source-width width
	    source-height height)
      
      ;; find size of source to determine actual size for exp/mac transfer
      ;; if we have a source-array then we came from si:bitblt otherwise it
      ;; must be a bitarray cache handling problem
      (WHEN source-array
	(SETF source-height (ARRAY-DIMENSION source-array 0))
	(IF (FIXNUMP from-window-id-or-array)	       ; Mac-resident source
	    (SETF source-width (tv:sheet-width (AREF *all-windows-and-screens*
						     from-window-id-or-array))) 
	  (SETF source-width (ARRAY-DIMENSION source-array 1))))
      
           ;; If bitblt is not mac-to-mac, then we need to check the size of the bitblt to insure
           ;; that it is not larger than our largest acb
      (UNLESS (AND (NUMBERP from-window-id-or-array)
		   (NUMBERP to-window-id-or-array))
	(LET (max-lines lines)
	  
	  (IF (OR (< (- source-height source-from-y) height) (< (- source-width source-from-x) width))
	      (SETF replication t)
	    ;; else
	    (SETF source-height (MIN (- source-height source-from-y) height)
		  source-width (MIN (- source-width source-from-x) width)))
	  
	  (SETF max-lines (TRUNCATE (/ (- *bitblt-max-size* (* copybits-parms 2) 32)
				       (* (CEILING source-width 32.) 4))))
	  
	  
	  (WHEN (> source-height max-lines)
	    (LOOP
	      until (< height max-lines)
	      do
	      (SETF lines (MIN max-lines height))
	      (SEND *mac* :copybits
		    alu width lines
		    from-window-id-or-array from-x from-y
		    to-window-id-or-array to-x to-y
		    width lines nil (> (- height lines) 0)
		    restoration-p)
	      ;; may/lg/rda 10/05/90
	      ;; Add MOD to make sure we're still in the source array
	      ;;(SETF from-y (+ from-y lines))
	      (SETF from-y (MOD (+ from-y lines) SOURCE-HEIGHT)) ;; may/lg/rda
	      (SETF to-y (+ to-y lines))
	      (SETF height (- height lines)))
	    ;; now set source width, height so we don't scale the damn thing
	    (SETF source-width width)
	    (SETF source-height height))))
           
      (IF (> height 0)
	  (SEND *mac* :copybits
		alu width height
		from-window-id-or-array from-x from-y
		to-window-id-or-array to-x to-y
		source-width source-height replication nil
		restoration-p)))))
))
