;;; -*- 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
;;; ---------------------------------------------------------------------------
;;; 03/29/89	WJB	Patch 1.60; Removed X-SCREEN-WIDTH and X-SCREEN-HEIGHT and added INITIAL-SCREEN-SIZE.
;;; 12/06/88	DLS	Moved old time functions to bone yard and updated comments.
;;; 11/15/88	DLS	Changed timestamp calculation to be faster and more correct.
;;; 10/117*/88	1LGO*	1Ensure pixmap resources aren't initialized twice.  Use array-initialize instead of fill.*
;;; 10/117*/88	1LGO*	1Move the pixmap resource to SERVER-DEFS, after pixmaps are defined.*
;;; 10/13/88	WJB	Added PIXMAP resource.
;;;  8/15/88	WJB	Added PIXMAP-ARRAY resource.  Especially for use by BITBLT-UNDER-MASK.
;;;  7/01/88    DAN	Added new instance variables to X-SERVER-WINDOW-FLAVOR.
;;;  6/16/88    WJB	File created to contain data definitions from SYSDEPENDENT.

(DEFPARAMETER X-ENABLED NIL
  "Flag which indicates which window system is enabled.
non-NIL - X is enabled,
NIL - Explorer window system is enabled.")

;; No longer used -- refer to INITIAL-SCREEN-SIZE
;;(DEFCONSTANT X-SCREEN-WIDTH 1024.)
;;(DEFCONSTANT X-SCREEN-HEIGHT (w:sheet-height w:default-screen))

(DEFUN INITIAL-SCREEN-SIZE (SCREEN-NUMBER)
  (DECLARE (IGNORE SCREEN-NUMBER))
  (VALUES (W:SHEET-WIDTH W:DEFAULT-SCREEN)
	  (W:SHEET-HEIGHT W:DEFAULT-SCREEN)))

(DEFPARAMETER X-SCREEN-BUFFER-ADDRESS          SYS:IO-SPACE-VIRTUAL-ADDRESS)
(DEFPARAMETER X-SCREEN-BUFFER-ADDRESS-TEXT     SYS:IO-SPACE-VIRTUAL-ADDRESS)
(DEFPARAMETER X-SCREEN-BUFFER-ADDRESS-GRAPHICS SYS:IO-SPACE-VIRTUAL-ADDRESS)
(DEFPARAMETER X-SCREEN-CONTROL-ADDRESS         131056.)
(DEFPARAMETER X-SCREEN-BUFFER-LENGTH           32768.)

(DEFPARAMETER ALL-X-SCREENS NIL)

(DEFFLAVOR X-SERVER-WINDOW-FLAVOR
  (
   ;; Used to use the AVAILABLE instance variable to allow one to have
   ;; more than one screen.  At some future time we may want to
   ;; use it again, but for now, it is pretty much ignored.
   (AVAILABLE T)
   (explorer-mouse-x 0)
   (explorer-mouse-y 0)
   (x-mouse-x        0)
   (x-mouse-y        0)
   (screen-array-pixmap nil))
  (W:WINDOW)
  :GETTABLE-INSTANCE-VARIABLES
  :SETTABLE-INSTANCE-VARIABLES
  (:DEFAULT-INIT-PLIST :DEEXPOSED-TYPEOUT-ACTION :PERMIT
    :LABEL NIL
    :SAVE-BITS T
    :BORDERS NIL
    :BLINKER-P NIL))

(DEFMACRO ARRAY-WIDTH (ARRAY)
  `(ARRAY-DIMENSION ,ARRAY 1))

(DEFMACRO ARRAY-HEIGHT (ARRAY)
  `(ARRAY-DIMENSION ,ARRAY 0))


(DEFUN CREATE-PIXMAP-ARRAY (WIDTH HEIGHT DEPTH &OPTIONAL (INITIAL-ELEMENT 0))
  ;; Make the width a multiple of 32.
  (MAKE-ARRAY `(,HEIGHT ,(LOGANDC2 (+ WIDTH (1- 32)) (1- 32)))
              :ELEMENT-TYPE `(UNSIGNED-BYTE ,DEPTH)
              :INITIAL-ELEMENT (and initial-element
				    (LOGAND (1- (EXPT 2 depth)) INITIAL-ELEMENT))))

(defvar *time-at-last-server-reset* (get-internal-real-time))

;;; Return the number of milliseconds since the last server reset.  This can
;;; become a bignum.
(DEFUN GET-TIME-IN-MILLIS ()
  (truncate (* (- (get-internal-real-time)
		  *time-at-last-server-reset*)
	       internal-time-units-per-second)
	    100.))


;;; Event queues are used by the low-level event gatherers to store information.
;;; The current implementation is built upon the Explorer Window System's io-buffers.
;;; Each event is stored as 4 separate pieces of entries in the io-buffer.  These
;;; entries are:
;;;   Detail - contains the current depression state of the mouse buttons.
;;;   Time - millisecond time for this event.
;;;   X - root-relative X position of the mouse.
;;;   Y	- root-relative Y position of the mouse.
;;; Accessors are defined to make it easier to store and retrieve these values.
;;; The main idea of defining this layer of abstraction is to make it easy to change
;;; the implementation details without altering their use.  In addition, 

(DEFTYPE EVENT-QUEUE ()
  '(W:IO-BUFFER))

(DEFMACRO EVENT-QUEUE-EMPTY-P (EVENT-QUEUE)
  `(= (W:IO-BUFFER-INPUT-POINTER  ,EVENT-QUEUE)
      (W:IO-BUFFER-OUTPUT-POINTER ,EVENT-QUEUE)))

(DEFMACRO PENDING-EVENT-COUNT (EVENT-QUEUE)
  `(TRUNCATE (LET ((DIFF (- (W:IO-BUFFER-INPUT-POINTER ,EVENT-QUEUE)
                            (W:IO-BUFFER-OUTPUT-POINTER ,EVENT-QUEUE))))
               (IF (< DIFF 0)
                   (+ DIFF (W:IO-BUFFER-SIZE ,EVENT-QUEUE))
                   ;1;ELSE*
                   DIFF))
             4))

(DEFMACRO READ-EVENTS (QUEUE)
  (DECLARE (VALUES DETAIL TIME MOUSE-X MOUSE-Y))
  `(VALUES (W:IO-BUFFER-GET ,QUEUE T)
           (W:IO-BUFFER-GET ,QUEUE T)
           (W:IO-BUFFER-GET ,QUEUE T)
           (W:IO-BUFFER-GET ,QUEUE T)))

(DEFMACRO WRITE-EVENTS (QUEUE DETAIL TIME MOUSE-X MOUSE-Y)
  `(PROGN
    (W:IO-BUFFER-PUT ,QUEUE ,DETAIL  T)
    (W:IO-BUFFER-PUT ,QUEUE ,TIME    T)
    (W:IO-BUFFER-PUT ,QUEUE ,MOUSE-X T)
    (W:IO-BUFFER-PUT ,QUEUE ,MOUSE-Y T)))

(DEFUN MAKE-EVENT-QUEUE (SIZE)
  (LET* (
         ;; There are 4 entries in each event.
         (REAL-SIZE (* SIZE 4))
         ;; The io-buffer record keeps a history of previously read events.
         (TV:IO-BUFFER-RECORD-LENGTH REAL-SIZE)
         (EVENT-QUEUE (W:MAKE-IO-BUFFER REAL-SIZE)))
    ;; The following SETF fixes a bug.  The record pointer points to the last element
    ;; stored into.  Since we haven't stored anything yet, we point to the element
    ;; before the first one, so when we store the first element, this pointer will be
    ;; zero.
    (SETF (W:IO-BUFFER-RECORD-POINTER (W:IO-BUFFER-RECORD EVENT-QUEUE)) -1)
    EVENT-QUEUE))

(DEFUN CLEAR-EVENT-QUEUE (EVENT-QUEUE)
  (W:IO-BUFFER-CLEAR EVENT-QUEUE)
  ;; Clear out the history too.
  (SETF (W:IO-BUFFER-RECORD-POINTER (W:IO-BUFFER-RECORD EVENT-QUEUE)) -1))

;;; We need to have accessors for the history buffer too (the io-buffer-record).
(DEFUN GET-EVENT-QUEUE-HISTORY (EVENT-QUEUE)
  (W:IO-BUFFER-RECORD EVENT-QUEUE))

(DEFUN EVENT-QUEUE-HISTORY-LENGTH (HISTORY-BUFFER)
  (IF (MINUSP (W:IO-BUFFER-RECORD-POINTER HISTORY-BUFFER))
      ;; We haven't stored anything here yet.
      0
      ;;ELSE
      ;; Go through the history buffer backwards until and stop when we hit a NIL entry.
      (LOOP WITH HIST-LENGTH = (LENGTH HISTORY-BUFFER)
            FOR INDEX FIRST (MOD (- (W:IO-BUFFER-RECORD-POINTER HISTORY-BUFFER) 3) HIST-LENGTH)
                      THEN (MOD (- INDEX 4) HIST-LENGTH)
            FOR COUNTER FROM 0 BELOW (TRUNCATE HIST-LENGTH 4)
            WHILE (AREF HISTORY-BUFFER INDEX)
            FINALLY (RETURN COUNTER))))

(DEFUN READ-HISTORY-EVENTS (HISTORY-BUFFER)
  "Returns a list which contains items of the form (time mouse-x mouse-y)"
  (IF (MINUSP (W:IO-BUFFER-RECORD-POINTER HISTORY-BUFFER))
      ;; Nothing to read
      NIL
      ;;ELSE
      (LOOP WITH HIST-LENGTH = (LENGTH HISTORY-BUFFER)
            FOR COUNTER FROM 0 BELOW (EVENT-QUEUE-HISTORY-LENGTH HISTORY-BUFFER)
            FOR INDEX FIRST (MOD (- (W:IO-BUFFER-RECORD-POINTER HISTORY-BUFFER) 3) HIST-LENGTH)
                      THEN (MOD (- INDEX 4) HIST-LENGTH)
            COLLECTING `(
                         ,(AREF HISTORY-BUFFER (+ INDEX 1))    ; Time
                         ,(AREF HISTORY-BUFFER (+ INDEX 2))    ; Mouse X
                         ,(AREF HISTORY-BUFFER (+ INDEX 3))    ; Mouse Y
                         ))))

