;;;
;;; wire-types.lisp
;;;
;;; X Protocol wire type definitions
;;;
;;; Copyright (C) 2005, Alastair Bridgewater
;;;

(in-package :clxs)


;; base wire types

(define-wire-type :u8 :u8)
(define-wire-type :s8 :s8)
(define-wire-type :u16 :u16)
(define-wire-type :s16 :s16)
(define-wire-type :u32 :u32)
(define-wire-type :s32 :s32)


;; more complex wire types

(define-wire-type :opcode :u8
  :error :implementation)

(define-wire-type :length :u16
  :error :length)

;; BOOL can't be an enum, as the encoding requires a NIL in the 0
;; slot, which :ENUM interprets as the value range starting from 1.
(define-wire-type :bool :u8
  :binding-form #'(lambda (gensym) `(not (zerop ,gensym)))
  :validator #'(lambda (slot gensym)
		 (declare (ignore slot))
		 `(<= 0 ,gensym 1)))

(define-wire-type :atom :u32
  :error :atom
  :validator #'(lambda (slot gensym)
		 (declare (ignore gensym))
		 `(is-valid-atom ,slot)))

(define-wire-type :atom-or-zero :u32
  :error :atom
  :validator #'(lambda (slot gensym)
		 (declare (ignore gensym))
		 `(or (zerop ,slot) (is-valid-atom ,slot))))

(macrolet
    ((define-resource-type (name &key (error name))
       `(define-wire-type ,name :u32
	  :error ,error
	  :binding-form #'(lambda (gensym) `(x-resource ,gensym))
	  :validator #'(lambda (slot gensym)
			 (declare (ignore gensym))
			 `(typep ,slot ',',(intern (format nil "~A-RESOURCE"
							   name)
						   *package*))))))
  (define-resource-type :window)
  (define-resource-type :pixmap)
  (define-resource-type :cursor)
  (define-resource-type :font)
  (define-resource-type :gcontext)
  (define-resource-type :colormap)
  (define-resource-type :drawable)
  (define-resource-type :fontable :error :font))

(define-wire-type :new-resource-id :u32
  :error :idchoice
  :validator #'(lambda (slot gensym)
		 (declare (ignore gensym))
		 `(and (= (client-state-resource-id-base client)
			(logand ,slot
			 (logxor #xffffffff
				 (client-state-resource-id-mask client))))
		   (not (x-resource ,slot)))))

(define-wire-type :set-of-event :u32
  :error :value
  :validator #'(lambda (slot gensym)
		 (declare (ignore gensym))
		 `(zerop (logand #xfe000000 ,slot))))

(define-wire-type :set-of-pointer-event :u16
  :error :value
  :validator #'(lambda (slot gensym)
		 (declare (ignore gensym))
		 `(zerop (logand #xffff8003 ,slot))))

(define-wire-type :set-of-device-event :u16
  :error :value
  :validator #'(lambda (slot gensym)
		 (declare (ignore gensym))
		 `(zerop (logand #xffffc0b0 ,slot))))

;; FIXME: Add the rest of the wire types.

(define-wire-type :bit-gravity (:enum :u8 (:forget :northwest :north :northeast :west :center :east :southwest :south :southeast :static)))

(define-wire-type :win-gravity (:enum :u8 (:unmap :northwest :north :northeast :west :center :east :southwest :south :southeast :static)))

;;; EOF