;;;
;;; 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 :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))))

(define-wire-type :gcontext :u32
  :error :gcontext
  :binding-form #'(lambda (gensym) `(x-resource ,gensym))
  :validator #'(lambda (slot gensym)
		 (declare (ignore gensym))
		 `(typep ,slot 'gcontext-resource)))

(define-wire-type :drawable :u32
  :error :drawable
  :binding-form #'(lambda (gensym) `(x-resource ,gensym))
  :validator #'(lambda (slot gensym)
		 (declare (ignore gensym))
		 `(typep ,slot 'drawable-resource)))

(define-wire-type :window :u32
  :error :window
  :binding-form #'(lambda (gensym) `(x-resource ,gensym))
  :validator #'(lambda (slot gensym)
		 (declare (ignore gensym))
		 `(typep ,slot 'window-resource)))

(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)))))

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

(defparameter +bit-gravities+
  '(:forget :northwest :north :northeast :west :center
    :east :southwest :south :southeast :static))

(define-wire-type :bit-gravity :u8
  :binding-form #'(lambda (gensym) `(and (< ,gensym (length +bit-gravities+))
				     (elt +bit-gravities+ ,gensym)))
  :validator #'(lambda (slot gensym)
		 (declare (ignore gensym))
		 slot))

;;; EOF
