Re: system folders, screen sizes and mactcp questions

[bill@cambridge.apple.com]

>I was wondering if anyone out there can help me with the following
>problems...
>
>I have written a system that needs to know where the system folder is. I
>have done this for system 7 machines (using gestalt) but I need to do it
>on 6.0.X machines as well. Can someone show me how to do this? Also how
>do I check for the current system version?

The following will work for both system 6 & 7 (though I haven't tested it
under System 6):

(defun system-folder ()
  (rlet ((env :SysEnvRec)
         (env-ptr :pointer))
    (%setf-macptr env-ptr env)
    (#_SysEnvirons :check-error 1 env-ptr)
    (rlet ((pb :HparamBlockRec
               :ioNamePtr (%null-ptr)
               :ioVRefNum (rref env :SysEnvRec.sysVRefNum)
               :ioDirID 0))
      (ccl::%path-from-iopb pb))))

You can probably find a string somewhere telling the system version, but
you're really supposed to check for the precise service that you want
to use. Gestalt is good for that.

>
>I need to find out the sizes of the screens attached to the Mac running
>my application (all screens if more than one).

Here is source code for a bunch of functions that are already in
MCL 2.0. None of them are exported, so you'll need a "CCL::" package
prefix on all the symbols:

----------------------------------------------------------------------

(defun screen-attribute (screen attribute)
  (#_TestDeviceAttribute  screen attribute))

(defun screen-active-p (screen)
  (and (screen-attribute screen $screenDevice)
       (screen-attribute screen $screenActive)))

(defun screen-color-p (screen)
  (screen-attribute screen $gdDevType))

(defun screen-bits (screen)
  (rref (rref screen :GDevice.gdPMap) :PixMap.PixelSize))

(defun screen-position (screen)
  (rref screen :GDevice.gdRect.topleft))

(defun screen-size (screen)
  (subtract-points
   (rref screen :GDevice.gdRect.bottomright)
   (screen-position screen)))

(defmacro do-screens ((s &optional (active-only? t)) &body body)
  `(with-macptrs ((,s (require-trap #_GetDeviceList :ptr)))
     (loop
       (if (%null-ptr-p ,s) (return))
       (when ,(if active-only? `(screen-active-p ,s) t)
         ,@body)
       (%setf-macptr ,s (require-trap #_GetNextDevice :ptr ,s :ptr)))))

(unless (assq 'do-screens *fred-special-indent-alist*)
  (push '(do-screens . 1) *fred-special-indent-alist*))

; Return two values, the position and size of the best color screen
; that is near mouse-position.
; If the mouse is on any color screen and most-bits? is nil, return that screen.
; If most-bits? is true, return the color screen with the most bits using
; mouse-position only to break ties.
(defun find-best-color-screen (&key (mouse-position (view-mouse-position nil))
                                    (most-bits? t) screen)
  (if *color-available*
    (rlet ((rect :rect :topleft mouse-position :bottomright (add-points mouse-position #@(1 1))))
      (with-macptrs ((maxScreen (#_GetMaxDevice rect)))
        (let* ((got-max? (not (%null-ptr-p maxScreen)))
               (max-color? (and got-max? (screen-color-p maxScreen)))
               (max-bits (if got-max? (screen-bits maxScreen) 0)))
          (unless (and max-color? (not most-bits?))
            (do-screens (screen)
              (let ((color? (screen-color-p screen))
                    (bits (screen-bits screen)))
                (when (or (%null-ptr-p maxScreen)
                          (and color? (not max-color?))
                          (and (eq color? max-color?)
                               (> bits max-bits)))
                  (setq max-bits bits
                        max-color? color?)
                  (%setf-macptr maxScreen screen))))))
        (if screen
          (%setf-macptr screen maxScreen))
        (values (screen-position maxScreen) (screen-size maxScreen))))
    (progn
      (if screen (%setf-macptr screen (%null-ptr)))
      (values #@(0 0) (make-point *screen-width* *screen-height*)))))

(defun find-screen (point &optional return-screen)
  (when return-screen
    (%setf-macptr return-screen (%null-ptr)))
  (if *color-available*
    (do-screens (screen)
      (let* ((pos (screen-position screen))
             (pos-h (point-h pos))
             (pos-v (point-v pos))
             (size (screen-size screen))
             (h (point-h point))
             (v (point-v point)))
        (declare (fixnum pos-h pos-v h v))
        (when
          (and (<= pos-h h)
               (<= h (the fixnum (+ pos-h (the fixnum (point-h size)))))
               (<= pos-v v)
               (<= v (the fixnum (+ pos-v (the fixnum (point-v size))))))
          (when return-screen (%setf-macptr return-screen screen))
          (return (values pos size)))))
    (let ((size (make-point *screen-width* *screen-height*)))
      (and (point<= #@(0 0) point size)
           (values #@(0 0) size)))))
        
----------------------------------------------------------------------

>
>I am using MacTCP (version 1.1) and the fixed MacTCP.lisp interface. 
>After I open and close about 10 tcp streams I get the following error:
>
>> Error: Error #-23048
>> While executing: CCL::TCP-HOST-ADDRESS
>> Type Command-. to abort.
>See the RestartsI menu item for further choices.

'fraid I can't help you with that one.

-----
Bill St. Clair
bill@cambridge.apple.com