;;; -*- Mode:Common-Lisp; Package:X11; Fonts:(MEDFNB HL12B HL12BI); Base:10 -*-

;;;			      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
;;;			      AUSTIN, TEXAS 78769
;;;				    MS 2151
;;;
;;; Copyright (C) 1988 Texas Instruments Incorporated. All rights reserved.

;;;
;;; Change history:
;;;
;;;  Date      Author	Description
;;; ---------------------------------------------------------------------------
;;;  9/29/88    DAN     Ensure OCCLUSION-STACK-TO-LIST returns a list.
;;;  9/29/88    LGO	Ensure OCCLUSION-STACK-TO-LIST returns a list
;;;  9/23/88    LGO	Simplify OCCLUSION-STACK-TO-LIST 
;;;  6/16/88    WJB	New file; moved functions from SERVER-DEFS to here.


(defun cons-response (&optional (length Response-Length))
  (let ((bytes (make-array length :element-type '(unsigned-byte 8))))
    (make-response :bytes bytes
		   :words (make-array (truncate length 2)
				      :element-type '(unsigned-byte 16)
				      :displaced-to bytes)
		   :longs (make-array (truncate length 4)
				      :element-type '(unsigned-byte 32)
				      :displaced-to bytes))))

(DEFUN ALLOCATE-CONNECTION-NUMBER ()
  "Allocate a connection for a client."
  ;; We start with an index of 1 because 0 is reserved for atoms.
  (LOOP FOR INDEX FROM 1 BELOW (LENGTH *CONNECTIONS-LIST*)
        WHEN (ZEROP (AREF *CONNECTIONS-LIST* INDEX))
        DO (PROGN
             (SETF (AREF *CONNECTIONS-LIST* INDEX) 1)
             (RETURN INDEX))
        FINALLY (RETURN NIL)))

(DEFUN CONNECTION-NUMBER-TO-ID-MASK (CONNECTION)
  "Map a connection number to a resource id mask."
  (ASH CONNECTION .RESOURCE-ID-BIT-COUNT.))

(DEFUN ID-MASK-TO-CONNECTION-NUMBER (MASK)
  "Map a resource id mask to a connection number."
  (ASH MASK (- .RESOURCE-ID-BIT-COUNT.)))

(DEFUN DEALLOCATE-CONNECTION-NUMBER (CONNECTION-NUMBER)
  "Make a connection number available for allocation."
  ;; Don't deallocate it if isn't already allocated.
  (WHEN (PLUSP (AREF *CONNECTIONS-LIST* CONNECTION-NUMBER))
    (SETF (AREF *CONNECTIONS-LIST* CONNECTION-NUMBER) 0)))


(DEFUN OCCLUSION-STACK-TO-LIST (WINDOW OCCLUSION-STACK)
  "Convert an occlusion stack to a list of boxes."
  (DECLARE (TYPE WINDOW WINDOW)
           (TYPE (OR ATOM LIST) OCCLUSION-STACK)
           (VALUES LIST))
  (if (EQ OCCLUSION-STACK T)
      (list (MAKE-WINDOW-BOX WINDOW))
    (IF (LISTP OCCLUSION-STACK)
        OCCLUSION-STACK
        (LIST OCCLUSION-STACK))))


(DEFUN SCREEN-ROOT-WINDOW (SCREEN)
  "Return the root window for this screen."
  ;; Use NEW-SCREEN to find out where the it is located in the SCREENS list
  ;; in SCREEN-INFO.  Use that index to obtain a root window instance in
  ;; the WINDOWS list in SCREEN-INFO.  These two lists are parallel.
  (NTH (POSITION SCREEN (SCREEN-INFO.SCREENS SCREEN-INFO)
                 :TEST #'(LAMBDA (X Y) (= (SCREEN.ID X) (SCREEN.ID Y))))
       (SCREEN-INFO.WINDOWS SCREEN-INFO)))

(DEFUN ROOT-FOR-WINDOW (WINDOW)
  (DECLARE (TYPE WINDOW WINDOW)
           (VALUES WINDOW))
  (LOOP FOR PARENT FIRST WINDOW THEN (WINDOW.PARENT PARENT)
        WHILE (WINDOW.PARENT PARENT)
        FINALLY (RETURN PARENT)))

(DEFUN SCREEN-FOR-WINDOW (WINDOW)
  (DECLARE (TYPE WINDOW WINDOW)
           (VALUES WINDOW))
  ;; Get the window's root.  Use that to find out where the root is located
  ;; in the WINDOWS list in SCREEN-INFO.  Use that index to obtain a SCREEN
  ;; instance in the SCREENS list in SCREEN-INFO.  These two lists are parallel.
  ;; Get the window's screen.
  (NTH (POSITION (LOOP FOR PARENT FIRST WINDOW THEN (WINDOW.PARENT PARENT)
                       WHILE (WINDOW.PARENT PARENT)
                       FINALLY (RETURN PARENT))
                 (SCREEN-INFO.WINDOWS SCREEN-INFO)
                 :TEST #'(LAMBDA (X Y) (= (SCREEN.ID X) (SCREEN.ID Y))))
       (SCREEN-INFO.SCREENS SCREEN-INFO)))