;;; xlib-xshape.el --- Shape extension support.

;; Copyright (C) 2003 by Free Software Foundation, Inc.

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: Mon Nov 17 19:23:03 MSK 2003
;; Keywords: xlib, xwem
;; X-CVS: $Id: xlib-xshape.el,v 1.5 2005/01/01 04:40:17 youngs Exp $

;; This file is part of XWEM.

;; XWEM is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XWEM is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
;; License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not in FSF

;;; Commentary:

;; 

;;; Code:

(require 'xlib-xlib)

(defconst X-XShape-op-QueryVersion		0)
(defconst X-XShape-op-Rectangles		1)
(defconst X-XShape-op-Mask			2)
(defconst X-XShape-op-Combine			3)
(defconst X-XShape-op-Offset			4)
(defconst X-XShape-op-QueryExtents		5)
(defconst X-XShape-op-SelectInput		6)
(defconst X-XShape-op-InputSelected		7)
(defconst X-XShape-op-GetRectangles		8)

;; ops
(defconst X-XShapeSet 0)
(defconst X-XShapeUnion 1)
(defconst X-XShapeIntersect 2)
(defconst X-XShapeSubtract 3)
(defconst X-XShapeInvert 4)

;; kinds
(defconst X-XShape-Bounding 0)
(defconst X-XShape-Clip 1)

;; events
(defconst X-ShapeNotify 0)		; actuallly (0 + extension event base)

(defun X-XShapeQueryVersion (xdpy)
  "On display XDPY query for version of Shape extension."
  (X-Dpy-p xdpy 'X-XRecordQueryVersion)

  (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
	 (ListOfFields
	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
		[1 X-XShape-op-QueryVersion]
		[2 1]			; length
		))
	 (msg (X-Create-message ListOfFields))
	 (ReceiveFields
	  (list [1 success]		;success field
		nil
		(list [1 nil]		;not used
		      [2 integerp]	;sequence number
		      [4 nil]		;length
		      [2 integerp]	;major version
		      [2 integerp]	;minor version
		      [20 nil]))))	;pad
    (X-Dpy-send-read xdpy msg ReceiveFields)))

(defun X-XShapeRectangles (xdpy dest-win dest-kind op x-off y-off rectangles &optional ordering)
  "This request specifies an array of rectangles, relative to the
origin of the window DEST-WIN plus the specified offset \\(X-OFF and
y-OFF\\) that together define a region.  This region is combined \\(as
specified by the operator OP\\) with the existing client region
\\(specified by KIND\) of the destination window DEST-WIN, and the
result is stored as the specified client region of the destination
window.  Note that the list of rectangles can be empty, specifying an
empty region; this is not the same as passing `X-None' to
`X-XShapeMask'. If known by the client, ordering relations on the
rectangles can be specified with the ordering argument.  This may
provide faster operation by the server.  The meanings of the ordering
values are the same as in the core protocol `XSetClipRectangles'
request.  If an incorrect ordering is specified, the server may
generate a Match error, but it is not required to do so.  If no error
is generated, the graphics results are undefined. Except for
`X-UnSorted', the rectangles should be nonintersecting, or the
resulting region will be undefined.  `X-UnSorted' means that the
rectangles are in arbitrary order.  `X-YSorted' means that the
rectangles are nondecreasing in their Y origin.  `X-YXSorted'
additionally constrains `X-YSorted' order in that all rectangles with
an equal Y origin are nondecreasing in their X origin.  `X-YXBanded'
additionally constrains `X-YXSorted' by requiring that, for every
possible Y scanline, all rectangles that include that scanline have
identical Y origins and Y extents."
  (X-Dpy-p xdpy 'X-XShapeRectangles)
  (X-Win-p dest-win 'X-XShapeRectangles)

  (unless ordering
    (setq ordering X-UnSorted))

  (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
	 (ListOfFields
	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
		[1 X-XShape-op-Rectangles]
		[2 (+ 4 (* 2 (length rectangles)))]
		[1 op]			; operation
		[1 dest-kind]		; destination kind
		[1 ordering]		;
		[1 nil]			; unused
		[4 (X-Win-id dest-win)]	; destination window
		[2 x-off]
		[2 y-off]))
	 (msg (concat (X-Create-message ListOfFields) (X-Generate-message-for-list rectangles 'X-Rect-message))))
    (X-Dpy-send xdpy msg)))

(defun X-XShapeMask (xdpy dest-win dest-kind op x-off y-off src)
  "The SRC in this request is a 1-bit deep pixmap, or `X-None'.  If
SRC is `X-None', the specified client region is removed from the
window, causing the effective region to revert to the default region.
The `X-ShapeNotify' event generated by this request and subsequent
ShapeQueryExtents will report that a client shape has not been
specified.  If a valid pixmap is specified, it is converted to a
region, with bits set to one included in the region and bits set to
zero excluded, and an offset from the window origin as specified by
X-OFF and Y-OFF.  The resulting region is then combined \\(as
specified by the operator OP\\) with the existing client region
\\(indicated by DEST-KIND\\) of the destination window, and the result
is stored as the specified client region of the destination window.
The source pixmap and destination window must have been created on the
same screen, or else a Match error results."
  (X-Dpy-p xdpy 'X-XShapeMask)
  (X-Win-p dest-win 'X-XShapeMask)

  (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
	 (ListOfFields
	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
		[1 X-XShape-op-Mask]
		[2 5]
		[1 op]			; operation
		[1 dest-kind]		; destination kind
		[2 nil]			; unused
		[4 (X-Win-id dest-win)]	; destination window
		[2 x-off]
		[2 y-off]
		[4 (if (X-Drawable-p src) (X-Drawable-id src) src)]))
	 (msg (X-Create-message ListOfFields)))
    (X-Dpy-send xdpy msg)))

(defun X-XShapeCombine (xdpy dest-win dest-kind op x-off y-off src src-kind)
  "The client region, indicated by SRC-KIND, of the source window SRC
is offset from the window DEST-WIN origin by X-OFF and Y-OFF and
combined with the client region, indicated by DEST-KIND, of the
destination window DEST-WIN.  The result is stored as the specified
client region of the destination window.  The source and destination
windows must be on the same screen, or else a Match error results."
  (X-Dpy-p xdpy 'X-XShapeCombine)
  (X-Drawable-p dest-win 'X-XShapeCombine)
  (X-Drawable-p src 'X-XShapeCombine)

  (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
 	 (ListOfFields
 	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
		[1 X-XShape-op-Combine]
 		[2 5]
 		[1 op]			; operation
		[1 dest-kind]		; destination kind
		[1 src-kind]
		[1 nil]			; unused
		[4 (X-Win-id dest-win)] ; destination window
 		[2 x-off]
 		[2 y-off]
		[4 (X-Drawable-id src)]))
 	 (msg (X-Create-message ListOfFields)))
    (X-Dpy-send xdpy msg)))

(defun X-XShapeOffset (xdpy dest-win dest-kind x-off y-off)
  "The client region, indicated by DEST-KIND, is moved relative
to its current position by the amounts X-OFF and Y-OFF."
  (X-Dpy-p xdpy 'X-XShapeOffset)
  (X-Win-p dest-win 'X-XShapeOffset)

  (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
 	 (ListOfFields
 	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
		[1 X-XShape-op-Offset]
 		[2 4]
		[1 dest-kind]		; destination kind
		[3 nil]			; unused
		[4 (X-Win-id dest-win)]	; destination window
 		[2 x-off]
 		[2 y-off]))
	 (msg (X-Create-message ListOfFields)))
    (X-Dpy-send xdpy msg)))

(defun X-XShapeQueryExtents (xdpy dest-win)
  "The boundingShaped and clipShaped results are True if the
corresponding client regions have been specified, else they
are False.  The x, y, width, and height values define the
extents of the client regions, when a client region has not
been specified, the extents of the corresponding default
region are reported."
  (X-Dpy-p xdpy 'X-XShapeQueryExtents)

  )

(defun X-XShapeSelectInput (xdpy dest-win enable)
  "Specifying enable as T causes the server to send the requesting
client a `X-ShapeNotify' event whenever the bounding or clip region of
the specified window is altered by any client.  Specifying enable as
NIL causes the server to stop sending such events."
  (X-Dpy-p xdpy 'X-XShapeSelectInput)
  (X-Win-p dest-win 'X-XShapeSelectInput)
  
  (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
 	 (ListOfFields
 	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
		[1 X-XShape-op-SelectInput]
 		[2 3]
		[4 (X-Win-id dest-win)]	; destination window
		[1 enable]
		[3 nil]))
	 (msg (X-Create-message ListOfFields)))
    (X-Dpy-send xdpy msg)))

(defun X-XShapeInputSelected (xdpy dest-win)
  "Return non-nil if on display XDPY DEST-WIN is enabled to receive
`X-ShapeNotify' events."
  (X-Dpy-p xdpy 'X-XShapeInputSelected)
  (X-Win-p dest-win 'X-XShapeInputSelected)
  
  (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
	 (ListOfFields
	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
		[1 X-XShape-op-InputSelected]
		[2 2]			; length
		[4 (X-Win-id dest-win)]))
	 (msg (X-Create-message ListOfFields))
	 (ReceiveFields
	  (list [1 success]		;success field
		nil
		(list [1 booleanp]	; enabled
		      [2 integerp]	; sequence number
		      [4 nil]		; length
		      [24 nil])))	;pad
	 (r (X-Dpy-send-read xdpy msg ReceiveFields)))
    (and (car r) (nth 1 r))))

(defun X-XShapeGetRectangles (xdpy dest-win dest-kind)
  "A list of rectangles describing the region indicated by DEST-KIND,
and the ordering of those rectangles, is returned.  The meaning of the
ordering values is the same as in the `X-XShapeRectangles' request."
  (X-Dpy-p xdpy 'X-XShapeInputSelected)
  (X-Win-p dest-win 'X-XShapeInputSelected)
  
  (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
	 (ListOfFields
	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
		[1 X-XShape-op-GetRectangles]
		[2 3]			; length
		[4 (X-Win-id dest-win)]
		[1 dest-kind]
		[3 nil]))
	 (msg (X-Create-message ListOfFields))
	 (ReceiveFields
	  (list [1 success]		;success field
		nil
		(list [1 integerp]	; ordering
		      [2 integerp]	; sequence number
		      [4 length-1]	; length
		      [20 nil]
		      [length-1
		       ([2 integerp]
			[2 integerp]
			[2 integerp]
			[2 integerp])]))))

    ;; TODO: maybe convert to X-Rect ?
    (X-Dpy-send-read xdpy msg ReceiveFields)))

(provide 'xlib-xshape)

;;; xlib-xshape.el ends here
