No-compute screensaver

[pjackson@rcsuna.gmr.com (Philip Jackson )]

FYI, here's my latest iteration on a screensaver that does not use any
compute cycles. This one avoids displaying any stuff in the menubar, 
thanks to code provided by David Bright. As several people pointed out,
having the grow icon shown for the black window is not a problem, since
the window can be dragged so that the icon is just outside the screen.
The mouse cursor can also be positioned just outside the screen. Result
is that the screen is totally black, with no compute cycles being used by
a conventional screensaver.  At any time, I can grab the black window and
resize it, to see what's happening in the Lisp Listener, then resize it
to cover the screen again.

Thanks again to everyone who provided suggestions for this--

Phil Jackson

;;; -*- Syntax:Common-LISP; Mode:LISP; Package: Common-Lisp-User; Base:10. -*-

; history

; PCJ 3/26/94  created file, to make a simple, no compute screensaver.
;              code for hiding menubar was provided by David S. Bright, 
;              bright@enh.nist.gov.

(defvar *screensaver*)

(defclass screensaver (window)
  ()
  (:default-initargs 
    :window-type :document-with-grow
    :window-title ""
    ))

(defun init-screensaver ()
  (let (window)
    (setf window
          (make-instance 'screensaver
            :view-position #@(0 0)
            :view-size (make-point *screen-width* *screen-height*)
            :window-show nil
            ))
    (set-fore-color window *black-color*)
    (set-back-color window *black-color* t)
    (set-part-color window :frame *black-color*)
    (set-part-color window :text *black-color*)
    (set-part-color window :hilite *black-color*)
    (set-part-color window :title-bar *black-color*)
    window
    ))

(defun save-screen ()
  (let ()
    (menubar-hide)
    (setf *screensaver* (init-screensaver))
    (window-show *screensaver*)
    ))

(defun ss () (save-screen))

(defun restore-screen ()
  (setf *screensaver* (window-close *screensaver*))
  (menubar-show)
  )

(defun rs () (restore-screen))

(defvar *menubar-height* (#_GetMBarHeight)
  "The height of the menubar.")

(defun set-menubar-height (int)
  "int
  Sets the height of the menubar to int."
  (%put-word (%int-to-ptr #x0BAA) int))

(defun menubar-hide ()
  "Hides the menubar and sets *menubar-hidden-p* to t.
   Destructively modifies the system handle GrayRgn."
  (let* ((menubar-region (#_NewRgn))
         (gray-region (%get-ptr (%int-to-ptr #$GrayRgn)))
         (front (front-window))
         (win-ptr (when front (wptr front))))
    (set-menubar-height 0)
    (#_SetRectRgn menubar-region 0 0 *screen-width* *menubar-height*)
    (#_UnionRgn menubar-region gray-region gray-region)
    (when win-ptr
      (#_PaintOne win-ptr menubar-region)
      (#_PaintBehind win-ptr menubar-region)
      (#_CalcVis win-ptr)
      (#_CalcVisBehind win-ptr menubar-region))
    (#_DisposHandle menubar-region)))

(defun menubar-show ()
  "Shows the menubar and sets *menubar-hidden-p* to nil.
   Destructively modifies (restores) the system handle GrayRgn."
  (let* ((menubar-region (#_NewRgn))
         (gray-region (%get-ptr (%int-to-ptr #$GrayRgn)))
         (front (front-window))
         (win-ptr (when front (wptr front))))
    (set-menubar-height *menubar-height*)
    (#_SetRectRgn menubar-region 0 0 *screen-width* *menubar-height*)
    (#_DiffRgn gray-region menubar-region gray-region)
    (when win-ptr
      (#_CalcVis win-ptr)
      (#_CalcVisBehind win-ptr menubar-region))
    (#_HiliteMenu 0)
    (#_DrawMenuBar)
    (#_DisposHandle menubar-region)))