;;; but WITHOUT ANY WARRANTY; without even the implied warranty of

 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 (in-package "XLIB")

 ;;; No new events or errors are defined by this extension.  (Big

 ;;;;  any purpose of the information in this document.  This documentation is

 ;;;;  provided ``as is'' without express or implied warranty.

   (:use :common-lisp)

   (:import-from :xlib

                 "DEFINE-EXTENSION"

            "DPMS-FORCE-LEVEL"

            "DPMS-INFO"))

 (define-extension "DPMS")

   (:use :common-lisp :xlib)

                 "*CURRENT-CONTEXT*"

                 "CONTEXT"

                 "CONTEXT-P"

            ))

   value)

 #+sbcl

 (defun aset-float64 (value array index)

   (declare (type double-float value)

   value)

 (eval-when (:compile-toplevel :load-toplevel :execute)

 (defun byte-width (type)

   (ecase type

                                   #.+convolution-width+

                                   #.+convolution-height+

                                   #.+max-convolution-width+

                                  1)

                                 ((#.+convolution-filter-scale+

                                   #.+convolution-filter-bias+)

                                 #.+convolution-width+

                                 #.+convolution-height+

                                 #.+max-convolution-width+

                                1)

                               ((#.+convolution-filter-scale+

                                 #.+convolution-filter-bias+)

   (:use :common-lisp :xlib)

   (:import-from :xlib

                 "DEFINE-ACCESSOR"

            ))

 (define-extension "GLX"

     :events (:glx-pbuffer-clobber)

   (let* ((ctx *current-context*)

          (display (context-display ctx)))

     ;; Make sure all rendering commands are sent away.

     (with-buffer-request (display (extension-opcode display "GLX"))

       (data +swap-buffers+)

       ;; *** GLX_CONTEXT_TAG

 ;;; Use xc/doc/hardcopy/Xext/shape.PS.gz obtainable from e.g.

 ;;  ftp://ftp.xfree86.org/pub/XFree86/current/untarred/xc/hardcopy/Xext/shape.PS.gz

 (in-package :xlib)

 (export '(shape-query-version

 ;;; This is an implementation of the XINERAMA extension. It does not

 ;;; include the obsolete PanoramiX calls.

   (:use "COMMON-LISP" "XLIB")

   (:nicknames "XINERAMA")

   (:import-from "XLIB"

            "XINERAMA-QUERY-VERSION"

            "XINERAMA-IS-ACTIVE"

            "XINERAMA-QUERY-SCREENS"))

 (define-extension "XINERAMA")

 ;;;     Title: The X Render Extension

 ;;;   Created: 2002-08-03

 ;;;    Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>

 ;;; ---------------------------------------------------------------------------

 ;;;

 ;;; (c) copyright 2002, 2003 by Gilbert Baumann

           render-query-version

           ;; render-query-picture-formats

           render-fill-rectangle

           render-composite

           render-create-glyph-set

           render-reference-glyph-set

 ;; We do away with the distinction between pict-format and

 ;; picture-format-info. That is we cache picture-format-infos.

 (defstruct render-info

   major-version

   minor-version

 ;;; picture format

 (defmethod print-object ((object picture-format) stream)

   (let ((abbrev

          (with-output-to-string (bag)

   (let ((display (picture-display picture)))

     (with-buffer-request (display (extension-opcode display "RENDER"))

       (data +X-RenderFreePicture+)

 (defun render-free-glyph-set (glyph-set)

   (let ((display (glyph-set-display glyph-set)))

     (with-buffer-request (display (extension-opcode display "RENDER"))

       (data +X-RenderFreeGlyphSet+)

 (defun render-query-version (display)

   (with-buffer-request-and-reply (display (extension-opcode display "RENDER") nil)

     (synchronise-picture-state picture)

     (with-buffer-request (display (extension-opcode display "RENDER"))

       (data +X-RenderFillRectangles+)

       (resource-id (picture-id picture))

       (card16 (elt color 0)) (card16 (elt color 1)) (card16 (elt color 2)) (card16 (elt color 3))

       (int16 x1) (int16 y1) (card16 w) (card16 h))))

 ;; fill rectangles, colors.

   ;; For performance reasons we do a special typecase on (simple-array

   ;; (unsigned-byte 32) (*)), so that it'll be possible to have high

   ;; performance rasters.

                '(let ((display (picture-display picture)))

                  (synchronise-picture-state picture)

                  (synchronise-picture-state source)

     (typecase coord-sequence

       ((simple-array (unsigned-byte 32) (*))

        (locally

       (data +X-RenderSetPictureFilter+)

       (resource-id (picture-id picture))

       (card16 (length filter))

       ((sequence :format card8) (map 'vector #'char-code filter)))))

   )

 ||#

   ;; coord-sequence is  top bottom

   ;;

   (let ((display (picture-display picture)))

     (synchronise-picture-state picture)

     (synchronise-picture-state source)

 (defun render-composite (op

                          source mask dest

     (synchronise-picture-state dest)

     (with-buffer-request (display (extension-opcode display "RENDER"))

       (data +X-RenderComposite+)

       (resource-id (picture-id source))

       (resource-id (if mask (picture-id mask) 0))

       (resource-id (picture-id dest))

       (card16 width)

       (card16 height))))

 (defun render-create-glyph-set (format &key glyph-set)

   (let ((display (picture-format-display format)))

     (let* ((glyph-set (or glyph-set (make-glyph-set :display display)))

     (with-buffer-request (display (extension-opcode display "RENDER"))

       (data +X-RenderCompositeGlyphs8+)

       (render-op alu)

       (picture source)

       (picture dest)

       ((or (member :none) picture-format) mask-format)

       (glyph-set glyph-set)

       (int16 src-x) (int16 src-y)

       (card8 (- end start)) ;length of glyph elt

       (int16 dest-x) (int16 dest-y)             ;dx, dy

       ((sequence :format card8) sequence))))

 	   (data ,opcode)

 	   (length request-length)

 	   (render-op ,alu)

 	   (picture ,source)

 	   (picture ,dest)

 	   ((or (member :none) picture-format) ,mask-format)

            (unit (bitmap-format-unit bitmap-format))

            (byte-lsb-first-p (display-image-lsb-first-p display))

            (bit-lsb-first-p  (bitmap-format-lsb-first-p bitmap-format)))

         (with-buffer-request (display (extension-opcode display "RENDER"))

           (data +X-RenderAddGlyphs+)

           (glyph-set glyph-set)

           (card16 w)

           (card16 h)

           (int16 x-origin)

             (setf (buffer-boffset display) (advance-buffer-offset 28))

             (let ((im (create-image :width w :height h :depth 8 :data data)))

               (write-image-z display im 0 0 w h

                              unit byte-lsb-first-p bit-lsb-first-p)) ))) )))

 (defun render-add-glyph-from-picture (glyph-set picture

         (card16 x)

         (card16 y))

       cursor)))

 ;;; * Implement XTestSetVisualIDOfVisual and XTestDiscard

 ;;; * Add the missing (declare (type ...

   (:use :common-lisp :xlib)

   (:import-from :xlib

                 #:data

    #:fake-key-event

    #:grab-control))

 (define-extension "XTEST")

 ;;; constructed as well as to indentify any obsolete/wrong 

 ;;; functions I made.

 (in-package :xlib)

 (export '(mode-info

 	(error "screen ~A not found in display ~A" screen display)

 	position)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ;;;;                                                                       ;;;;

 ;;;;              public XFree86-VidMode Extension routines                ;;;;

 		   (setf (svref v (incf index)) w1

 			 (svref v (incf index)) w2))))

       v)))