(require :clx)

(define-object *namespace-X11*
  (name nil "X11" t)
  (traits t *traits-namespace*))

(defmacro define-xtraits (basic-name &rest parents)
  (let*
      ((un (string-upcase basic-name))
       (traits-sym (intern (format nil "*TRAITS-~A*" un)))
       (proto-sym (intern (format nil "*PRIMITIVE-~A*" un)))
       (parent-slots
	(if parents
	    (loop for parent in parents
	      collect `(,(intern (string-upcase parent)) t
			,(intern (format nil "*TRAITS-~A*" (string-upcase parent))) t))
	  '((oddball t *traits-oddball* t)))))
    `(progn
       (define-traits ,traits-sym
	 (name nil ,basic-name t)
	 ,@parent-slots)
       (define-object ,proto-sym
	 (traits t ,traits-sym))
       (add-named ,proto-sym *namespace-X11*))))

(define-xtraits "Display")
(define-xtraits "Screen")
(define-xtraits "Drawable")
(define-xtraits "Window" "Drawable")
(define-xtraits "Pixmap" "Drawable")
(define-xtraits "Cursor")
(define-xtraits "Color")

#+nil
(defmacro define-accessor (name arguments &body body)
  (let ((mut-args ()))
    `(progn
       (define-method (name arguments ,@body))
       (define-method (,(intern (concatenate 'string (string name) ":"))
		       arguments)
	 ,@body))))

;Display

(define-method "newForHost:device:protocol:" ((display *traits-display*)
					      (host *traits-string*)
					      (device *traits-integer*)
					      (protocol *traits-integer*))
  (xlib:open-display host :display device :protocol protocol))

(define-method "authorizationData" ((display *traits-display*))
  (xlib:display-authorization-data display))

(define-method "authorizationProtocol" ((display *traits-display*))
  (xlib:display-authorization-name display))

(define-method "bitmapFormat" ((display *traits-display*))
  (xlib:display-bitmap-format display))

(define-method "byteOrder" ((display *traits-display*))
  (if (eq (display-byte-order display) :lsbfirst) '|little| '|big|))

(define-method "number" ((display *traits-display*))
  (if (eq (xlib:display-byte-order display) :lsbfirst) '|little| '|big|))

(define-method "defaultHandler" ((display *traits-display*))
  (xlib:display-error-handler display))

(define-method "defaultHandler:" ((display *traits-display*)
				  (handler *traits-method*))
  (setf (xlib:display-error-handler display) handler))

(define-method "defaultHandler:" ((display *traits-display*)
				  (handler *traits-array*))
  (setf (xlib:display-error-handler display) handler))

(define-method "requestLength" ((display *traits-display*))
  (xlib:display-max-request-length display))

(define-method "screens" ((display *traits-display*))
  (coerce (xlib:display-roots display) 'vector))

(define-method "flush" ((display *traits-display*))
  (xlib:display-force-output display))

(define-method "flushAndFinish" ((display *traits-display*))
  (xlib:display-finish-output display))

(define-method "close" ((display *traits-display*))
  (xlib:close-display display))

;Screen

(define-method "height" ((screen *traits-screen*))
  (xlib:screen-height screen))

(define-method "width" ((screen *traits-screen*))
  (xlib:screen-width screen))

(define-method "depth" ((screen *traits-screen*))
  (xlib:screen-depth screen))

(define-method "rootDepth" ((screen *traits-screen*))
  (xlib:screen-root-depth screen))

;Drawable

(define-method "display" ((drawable *traits-drawable*))
  (xlib:drawable-display drawable))

(define-method "root" ((drawable *traits-drawable*))
  (xlib:drawable-root drawable))

(define-method "rootAndNeighbors" ((drawable *traits-drawable*))
  (xlib:query-tree drawable :result-type 'vector))

(define-method "=" ((drawable1 *traits-drawable*)
		    (drawable2 *traits-drawable*))
  (xlib:drawable-equal drawable1 drawable2))

(define-method "id" ((drawable *traits-drawable*))
  (xlib:drawable-id drawable))

(define-method "depth" ((drawable *traits-drawable*))
  (xlib:drawable-depth drawable))

(define-method "width" ((drawable *traits-drawable*))
  (xlib:drawable-width drawable))

(define-method "height" ((drawable *traits-drawable*))
  (xlib:drawable-height drawable))

(define-method "x" ((drawable *traits-drawable*))
  (xlib:drawable-x drawable))

(define-method "y" ((drawable *traits-drawable*))
  (xlib:drawable-y drawable))

(define-method "width:" ((drawable *traits-drawable*))
  (setf (xlib:drawable-width drawable)))

(define-method "height:" ((drawable *traits-drawable*))
  (setf (xlib:drawable-height drawable)))

(define-method "x:" ((drawable *traits-drawable*))
  (setf (xlib:drawable-x drawable)))

(define-method "y:" ((drawable *traits-drawable*))
  (setf (xlib:drawable-y drawable)))

;Window

(define-method "newOn:x:y:width:height:" ((window *traits-window*)
					  (screen *traits-screen*)
					  x y width height)
  (xlib:create-window :parent screen :x x :y y :width width :height height))

(define-method "reparentTo:x:y:" ((window *traits-window*)
				  (newparent *traits-window*) x y)
  (xlib:reparent-window window newparent x y))

(define-method "translateFrom:x:y:to:" ((source *traits-window*) x y
					(target *traits-window*))
  (xlib:translate-coordinates source x y target))

(define-method "destroy" ((window *traits-window*))
  (xlib:destroy-window window))

(define-method "destroyChildren" ((window *traits-window*))
  (xlib:destroy-subwindows window))

(define-method "map" ((window *traits-window*))
  (xlib:map-window window))

(define-method "unmap" ((window *traits-window*))
  (xlib:unmap-window window))

(define-method "mapChildren" ((window *traits-window*))
  (xlib:map-subwindows window))

(define-method "unmapChildren" ((window *traits-window*))
  (xlib:unmap-subwindows window))

(define-method "display" ((window *traits-window*))
  (xlib:window-display window))

(define-method "=" ((window1 *traits-window*)
		    (window2 *traits-window*))
  (xlib:window-equal window1 window2))

(define-method "id" ((window *traits-window*))
  (xlib:window-id window))

(define-method "raise" ((window *traits-window*))
  (xlib:circulate-window-up window))

(define-method "lower" ((window *traits-window*))
  (xlib:circulate-window-down window))

;Pixmap

(define-method "newOn:width:height:depth:" ((pixmap *traits-pixmap*)
					    (drawable *traits-drawable*)
					    width height depth)
  (xlib:create-pixmap :width width :height height :depth depth
		      :drawable drawable))

(define-method "free" ((pixmap *traits-pixmap*))
  (xlib:free-pixmap pixmap))

(define-method "display" ((pixmap *traits-pixmap*))
  (xlib:pixmap-display pixmap))

(define-method "=" ((pixmap1 *traits-pixmap*)
		    (pixmap2 *traits-pixmap*))
  (xlib:pixmap-equal pixmap1 pixmap2))

(define-method "id" ((pixmap *traits-pixmap*))
  (xlib:pixmap-id pixmap))

;Context

;Drawing

(define-method "clear" ((window *traits-window*))
  (xlib:clear-area window))

(define-method "clearX:y:width:height:" ((window *traits-window*)
					 x y width height)
  (xlib:clear-area window :x x :y y :width width :height height))

(define-method "drawPointX:y:" ((drawable *traits-drawable*) x y)
  (xlib:draw-point drawable context x y))

(define-method "drawLineFromX:y:ToX:y:" ((drawable *traits-drawable*)
					 x1 y1 x2 y2)
  (xlib:draw-line drawable context x1 y1 x2 y2))

(define-method "drawRectX:y:width:height:" ((drawable *traits-drawable*)
					    x y width height)
  (xlib:draw-rectangle drawable context x y width height))

(define-method "draw:x:y:" ((drawable *traits-drawable*)
			    (char *traits-character*) x y)
  (xlib:draw-glyph drawable context x y char))

(define-method "draw:x:y:from:to:" ((drawable *traits-drawable*)
			    (string *traits-string*) x y start end)
  (xlib:draw-glyphs drawable context x y string :start start :end end))

(define-method "draw:x:y:" ((drawable *traits-drawable*)
			    (string *traits-string*) x y)
  (xlib:draw-glyphs drawable context x y string))

;Color

(define-method "r:g:b:" ((color *traits-color*) r g b)
  (xlib:make-color :red r :green g :blue b))

(define-method "red" ((color *traits-color*))
  (xlib:color-red color))

(define-method "green" ((color *traits-color*))
  (xlib:color-green color))

(define-method "blue" ((color *traits-color*))
  (xlib:color-blue color))

;Colormap