;;; -*- Mode:Common-Lisp; Package:USER; Base:10; Patch-file:T; Fonts:(COURIER HL12B HL12BI COURIER MEDFNB) -*-
;;; Written 11/28/88 00:17:53 by GRENINGER,
;;; Reason: Display the Mac's "watch" cursor during screen resizing.
;;; while running on MX23 from band NB22
;;; With SYSTEM 5.19, GC 5.3, VIRTUAL-MEMORY 5.5, MICRONET 5.5, MICRONET-COMM 5.13,
;;;  DISK-IO 5.9, BASIC-PATHNAME 5.2, MAC-PATHNAME 5.0, NETWORK-SUPPORT-COLD 5.1,
;;;  BASIC-NAMESPACE 5.6, BASIC-FILE 5.3, RPC 5.4, NFS 5.10, EH 5.3, MAKE-SYSTEM 5.2,
;;;  MEMORY-AUX 5.1, MACTOOLBOX 1.25, COMPILER 5.1, TV 5.21, NVRAM 5.1, UCL 5.0, INPUT-EDITOR 5.0,
;;;  METER 5.0, ZWEI 5.9, DEBUG-TOOLS 5.1, WINDOW-MX 5.29, PRINTER 5.11, MAC-PRINTER-TYPES 5.4,
;;;  NETWORK-PATHNAME 5.0, NETWORK-NAMESPACE 5.0, DATALINK 5.7, CHAOSNET 5.6, NETWORK-SUPPORT 5.0,
;;;  NETWORK-SERVICE 5.0, DATALINK-DISPLAYS 5.0, NAMESPACE-EDITOR 5.1, IP 3.33, NFS-SERVER 5.3,
;;;  PRINTER-TYPES 5.2, IMAGEN 5.1, MAIL-DAEMON 5.1, MAIL-READER 5.3, TELNET 5.1,
;;;  VT100 5.0, STREAMER-TAPE 5.6, DECNET 1.45, VISIDOC 5.4, PROFILE 5.1, DISK-LABEL 5.1,
;;;   microcode 96, Band Name: microExplorer Network (11/22)

#!C
; From file MAC-INITIATED-COMMANDS.LISP#> WINDOW-MX; SYS:
#10R MACINTOSH#:
(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-INITIATED-COMMANDS.É#É"


(DEFUN Ï4resize-screenÏ* (screen-id new-screen-height new-screen-width
		    &optional debug-p old-screen-height old-screen-width)
  (LET* (screen inferiors blinkability-states true-mouse-cursor
	 old-right old-bottom left top right bottom windows-to-resize
	 h-expansion-factor w-expansion-factor error (errors 0))

    (WHEN (SETF screen (the-screen (AREF *mac-resident-explorer-screens* screen-id)))
      (SETF inferiors (SEND screen :inferiors))
      (UNLESS old-screen-height
	(SETF old-screen-height (SEND screen :height)))
      (UNLESS old-screen-width
	(SETF old-screen-width (SEND screen :width)))
      (SETF new-screen-width (* 32 (CEILING new-screen-width 32)))
      
      (SETF h-expansion-factor (/ new-screen-height old-screen-height)
	    w-expansion-factor (/ new-screen-width old-screen-width))

      ;Ï1;  Ask the Mac whether the new screen size will fit.  Don't try if it won't...Ï*
      (IF (NOT (can-this-screen-be-resized
		 screen-id new-screen-width new-screen-height))
	  (pop-up-format-at-origin "Ï3~
Insufficient space in Mac's screen/window image
cache to accomodate the requested resizing.Ï*")
	;Ï1; else...
              Ï*;Ï1;  Change the Mac's mouse cursor to the watch while we thrash bitmaps...Ï*
	(SETF true-mouse-cursor tv:mouse-blinker)
	(SEND *mac* :set-mouse-blinker (- 4 mac-mouse-cursor-offset))

	(tv:without-screen-management
	  (SETF blinkability-states
		(collect-and-turn-off-sheets-blinker-states screen))
	  (resize-a-Mac-resident-Explorer-screen
	    screen-id screen new-screen-height new-screen-width nil)
	  (LOOP for window in inferiors
		do
		(MULTIPLE-VALUE-SETQ (left top right bottom)
		  (SEND window :edges))
		(SETF old-right right old-bottom bottom)
		
		;Ï1;  If the screen is growing, expand the window proportionally...Ï*
		(WHEN (> w-expansion-factor 1)
		  (SETF right
			(+ left (ROUND (* w-expansion-factor (- right left))))))
		(WHEN (> h-expansion-factor 1)
		  (SETF bottom
			(+ top (ROUND (* h-expansion-factor (- bottom top))))))
		
		;Ï1;  Shrink the window to fit if it won't after the screen changes size...Ï*
		(WHEN (> right new-screen-width)
		  (SETF right new-screen-width))
		(WHEN (> bottom new-screen-height)
		  (SETF bottom new-screen-height))
		
		;Ï1; If the window needs to be resized and can be resized to this newÏ*
		;Ï1; size, then add it to the list of windows to be resized.  If it needsÏ*
		;Ï1; to be resized but cannot be, stop trying and tell the Mac we failed...Ï*
		(WHEN (OR (/= right old-right) (/= bottom old-bottom))
		  (IF (MULTIPLE-VALUE-SETQ (nil error)
			(SEND window :set-edges left top right bottom :verify))
		      (PUSH (LIST window left top right bottom) windows-to-resize)
		      ;Ï1; else...Ï*
		      ;Ï1; just tell user, truck on, if unresized window fits on resized screen...Ï*
		      (IF (AND (> new-screen-width right) (> new-screen-height bottom))
			  (pop-up-format-at-origin "Ï3~
Window ~S
could not resize because ~A
but still can fit on the resized ~dx~d screen.Ï*"
						   window error
						   new-screen-height new-screen-width)
			  ;Ï1; else...Ï*
			  ;Ï1; count as a serious resize error, window won't fit on resized screen..Ï*
			  (INCF errors)
			  (pop-up-format-at-origin "Ï3~
Window ~S
prevented resizing this screen from ~dx~d to ~dx~d
because ~A.Ï*"
						   window
						   old-screen-height old-screen-width
						   new-screen-height new-screen-width
						   error)))))
	  
	  ;Ï1;  Really change the windows-to-resize of the windows that needed it...Ï*
	  (IF (NOT (OR (ZEROP errors) debug-p))
	      (PROGN
		(resize-a-Mac-resident-Explorer-screen
		  screen-id screen old-screen-height old-screen-width nil)
		(SEND screen :refresh))
	    ;Ï1; else...Ï*
	    (resize-a-Mac-resident-Explorer-screen
	      screen-id screen new-screen-height new-screen-width t)
	    (LOOP for (window left top right bottom) in
		  windows-to-resize
		  do
		  (SEND window :set-edges left top right bottom))
	    ;Ï1;  Make sure all  windows get rebuilt correctly...Ï*
	    (DOLIST (i (w:sheet-inferiors screen))
	      (PROCESS-RUN-FUNCTION "Ï3RefreshÏ*"
				    #'(lambda (sheet)
					(WITHOUT-INTERRUPTS 
					  (AND (w:sheet-can-get-lock sheet)
					       (SEND sheet :refresh)))) i))
	    ))
	(reestablish-sheets-blinker-states blinkability-states)
	;Ï1;  Having done everything with screen management disabled, fix things up...Ï*
	(SEND screen :screen-manage)
	(w:who-line-clobbered)

	;Ï1;  Restore the Mac's mouse cursor to what the Explorer thinks it is...Ï*
	(SEND true-mouse-cursor :create-Mac-image-of-Explorer-mouse-cursor nil nil)))))
))
