Commit 2ff22e3e authored by csr21's avatar csr21
Browse files

RENDER enhancements from Gilbert Baumann (on free-clim)

darcs-hash:20041206114857-ed5a3-202f0758017bc94a61c1dc54d1de5c259b4ea18f.gz
parent eb29cb6a
...@@ -5,6 +5,9 @@ ...@@ -5,6 +5,9 @@
The ICCCM-compliant selection handling in demo/clipboard.lisp is now The ICCCM-compliant selection handling in demo/clipboard.lisp is now
more ICCCM-compliant. more ICCCM-compliant.
The implementation of the RENDER client protocol has been
enhanced. (Gilbert Baumann)
--- Changes in SBCL CLX 0.6, Tue Nov 16 2004 --- --- Changes in SBCL CLX 0.6, Tue Nov 16 2004 ---
A port to ECL has been merged (Juan Jose Garcia Ripoll) A port to ECL has been merged (Juan Jose Garcia Ripoll)
......
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
;;; Title: The X Render Extension ;;; Title: The X Render Extension
;;; Created: 2002-08-03 ;;; Created: 2002-08-03
;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de> ;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
;;; $Id: xrender.lisp,v 1.4 2004/08/20 21:38:22 dan Exp $ ;;; $Id: xrender.lisp,v 1.5 2004/12/06 11:48:57 csr21 Exp $
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
;;; ;;;
;;; (c) copyright 2002, 2003 by Gilbert Baumann ;;; (c) copyright 2002, 2003 by Gilbert Baumann
...@@ -47,6 +47,38 @@ ...@@ -47,6 +47,38 @@
;; - Write tests. ;; - Write tests.
;;;; API issues
;; - On one hand we want convenience functions like RENDER-TRIANGLE or
;; WITH-UNIFORM-COLOR-PICTURE. On the other hand if you are up to
;; write a full rasterization library you obviously want high
;; performance entry points as RENDER-TRIANGLES-1.
;; - We want to extend XLIB:COLOR into something with alpha channel.
;; How to name it?
;; - WITH-UNIFORM-COLOR-PICTURE (var picture r g b &optional alpha) &body body
;;
;; Example:
;; (WITH-UNIFORM-COLOR-PICTURE (color dest 1.0 1.0 0.0)
;; (RENDER-TRIANGLE dest color ...))
;; - Pose the filter and the transform slots of a picture.
;; - Also introduce a PICTURE-DEFAULT-MASK-FORMAT?
;; - COPY-PICTURE?
;; - WITH-PICTURE-OPTIONS ?
;;
;; (WITH-PICTURE-OPTIONS (pic :repeat :on) ...)
;; - WITH-PICTURE ?
;;
;; (WITH-PICTURE (picture drawable ...) ...)
;;
(in-package :xlib) (in-package :xlib)
;; Beginning to collect the external interface for documentation. ;; Beginning to collect the external interface for documentation.
...@@ -111,34 +143,56 @@ ...@@ -111,34 +143,56 @@
(define-extension "RENDER") (define-extension "RENDER")
(progn ;;;; Request constants
(defconstant +X-RenderQueryVersion+ 0) ;done
(defconstant +X-RenderQueryPictFormats+ 1) ;; Note: Although version numbers are given render.h where the request
(defconstant +X-RenderQueryPictIndexValues+ 2) ;; numbers are defined, render-query-version returns 0.0 all displays
(defconstant +X-RenderQueryDithers+ 3) ;; i tested. --GB 2004-07-21
(defconstant +X-RenderCreatePicture+ 4) ;done
(defconstant +X-RenderChangePicture+ 5) ;done (defconstant +X-RenderQueryVersion+ 0) ;done
(defconstant +X-RenderSetPictureClipRectangles+ 6) ;done (defconstant +X-RenderQueryPictFormats+ 1)
(defconstant +X-RenderFreePicture+ 7) ;done (defconstant +X-RenderQueryPictIndexValues+ 2) ;0.7
(defconstant +X-RenderComposite+ 8) ;we need better arglist (defconstant +X-RenderQueryDithers+ 3)
(defconstant +X-RenderScale+ 9) (defconstant +X-RenderCreatePicture+ 4) ;done
(defconstant +X-RenderTrapezoids+ 10) (defconstant +X-RenderChangePicture+ 5) ;done
(defconstant +X-RenderTriangles+ 11) (defconstant +X-RenderSetPictureClipRectangles+ 6) ;done
(defconstant +X-RenderTriStrip+ 12) (defconstant +X-RenderFreePicture+ 7) ;done
(defconstant +X-RenderTriFan+ 13) (defconstant +X-RenderComposite+ 8) ;we need better arglist
(defconstant +X-RenderColorTrapezoids+ 14) (defconstant +X-RenderScale+ 9)
(defconstant +X-RenderColorTriangles+ 15) (defconstant +X-RenderTrapezoids+ 10) ;low-level done
(defconstant +X-RenderTransform+ 16) (defconstant +X-RenderTriangles+ 11) ;low-level done
(defconstant +X-RenderCreateGlyphSet+ 17) ;done (defconstant +X-RenderTriStrip+ 12)
(defconstant +X-RenderReferenceGlyphSet+ 18) ;done (defconstant +X-RenderTriFan+ 13)
(defconstant +X-RenderFreeGlyphSet+ 19) ;done (defconstant +X-RenderColorTrapezoids+ 14) ;nyi in X server, not mentioned in renderproto.h
(defconstant +X-RenderAddGlyphs+ 20) (defconstant +X-RenderColorTriangles+ 15) ;nyi in X server, not mentioned in renderproto.h
(defconstant +X-RenderAddGlyphsFromPicture+ 21) (defconstant +X-RenderTransform+ 16) ;commented out in render.h
(defconstant +X-RenderFreeGlyphs+ 22) (defconstant +X-RenderCreateGlyphSet+ 17) ;done
(defconstant +X-RenderCompositeGlyphs8+ 23) ;done (defconstant +X-RenderReferenceGlyphSet+ 18) ;done
(defconstant +X-RenderCompositeGlyphs16+ 24) (defconstant +X-RenderFreeGlyphSet+ 19) ;done
(defconstant +X-RenderCompositeGlyphs32+ 25) (defconstant +X-RenderAddGlyphs+ 20) ;done, untested
(defconstant +X-RenderFillRectangles+ 26)) (defconstant +X-RenderAddGlyphsFromPicture+ 21) ;done, untested
(defconstant +X-RenderFreeGlyphs+ 22) ;done, untested
(defconstant +X-RenderCompositeGlyphs8+ 23) ;done
(defconstant +X-RenderCompositeGlyphs16+ 24) ;done
(defconstant +X-RenderCompositeGlyphs32+ 25) ;done
;; >= 0.1
(defconstant +X-RenderFillRectangles+ 26) ;single rectangle version done
;; >= 0.5
(defconstant +X-RenderCreateCursor+ 27)
;; >= 0.6
(defconstant +X-RenderSetPictureTransform+ 28) ;I don't understand what this one should do.
(defconstant +X-RenderQueryFilters+ 29) ;seems to be there on server side
; some guts of its implementation there.
(defconstant +X-RenderSetPictureFilter+ 30)
(defconstant +X-RenderCreateAnimCursor+ 31) ;What has render to do with cursors?
;;;;
;; Sanity measures: ;; Sanity measures:
...@@ -224,6 +278,7 @@ by every function, which attempts to generate RENDER requests." ...@@ -224,6 +278,7 @@ by every function, which attempts to generate RENDER requests."
(maphash (lambda (k f) (maphash (lambda (k f)
(declare (ignore k)) (declare (ignore k))
(when (and (eql (picture-format-type f) :direct) (when (and (eql (picture-format-type f) :direct)
(eql (picture-format-depth f) (drawable-depth window))
(eql (dpb -1 (picture-format-red-byte f) 0) (eql (dpb -1 (picture-format-red-byte f) 0)
(visual-info-red-mask vi)) (visual-info-red-mask vi))
(eql (dpb -1 (picture-format-green-byte f) 0) (eql (dpb -1 (picture-format-green-byte f) 0)
...@@ -272,8 +327,10 @@ by every function, which attempts to generate RENDER requests." ...@@ -272,8 +327,10 @@ by every function, which attempts to generate RENDER requests."
(unless (zerop (byte-size (cdr k))) (unless (zerop (byte-size (cdr k)))
(format bag " ~A~D" (car k) (byte-size (cdr k))))))))) (format bag " ~A~D" (car k) (byte-size (cdr k)))))))))
(print-unreadable-object (object stream :type t :identity nil) (print-unreadable-object (object stream :type t :identity nil)
(format stream "~D ~S~A" (format stream "~D ~S ~S ~S~A"
(picture-format-id object) (picture-format-id object)
(picture-format-colormap object)
(picture-format-depth object)
(picture-format-type object) abbrev)))) (picture-format-type object) abbrev))))
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
...@@ -294,8 +351,7 @@ by every function, which attempts to generate RENDER requests." ...@@ -294,8 +351,7 @@ by every function, which attempts to generate RENDER requests."
;; provides no provision to actually query a picture object's values. ;; provides no provision to actually query a picture object's values.
;; *sigh* ;; *sigh*
(def-clx-class (picture (:copier nil) (def-clx-class (picture (:copier nil))
)
(id 0 :type resource-id) (id 0 :type resource-id)
(display nil :type (or null display)) (display nil :type (or null display))
(plist nil :type list) ; Extension hook (plist nil :type list) ; Extension hook
...@@ -446,17 +502,18 @@ by every function, which attempts to generate RENDER requests." ...@@ -446,17 +502,18 @@ by every function, which attempts to generate RENDER requests."
(card32 0) (card32 0)
(card32 1)) (card32 1))
(values (values
(card16-get 8) (card32-get 8)
(card16-get 10) (card32-get 12) )))
)))
(defun render-query-picture-formats (display) (defun render-query-picture-formats (display)
(with-buffer-request-and-reply (display (extension-opcode display "RENDER") nil) (with-buffer-request-and-reply (display (extension-opcode display "RENDER") nil)
((data +X-RenderQueryPictFormats+)) ((data +X-RenderQueryPictFormats+))
(let ((n-picture-formats (card32-get 8)) (let ((n-picture-formats (card32-get 8))
(n-screens (card32-get 12)) (n-screens (card32-get 12))
(off 32)) (n-depths (card32-get 16))
(declare (ignore n-screens off)) (n-visuals (card32-get 20))
(n-subpixel (card32-get 24)))
(declare (ignore n-screens n-depths n-visuals n-subpixel))
(loop for i below n-picture-formats (loop for i below n-picture-formats
collect collect
(let ((off (+ (* 8 4) (let ((off (+ (* 8 4)
...@@ -493,6 +550,152 @@ by every function, which attempts to generate RENDER requests." ...@@ -493,6 +550,152 @@ by every function, which attempts to generate RENDER requests."
;; fill rectangles, colors. ;; fill rectangles, colors.
(defun render-triangles-1 (picture op source src-x src-y format coord-sequence)
;; 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.
(macrolet ((guts ()
'(let ((display (picture-display picture)))
(synchronise-picture-state picture)
(synchronise-picture-state source)
(with-buffer-request (display (extension-opcode display "RENDER"))
(data +X-RenderTriangles+)
(render-op op) ;op
(card8 0) ;pad
(card16 0) ;pad
(resource-id (picture-id source))
(resource-id (picture-id picture))
(picture-format format)
(int16 src-x)
(int16 src-y)
((sequence :format int32) coord-sequence) ))))
(typecase coord-sequence
((simple-array (unsigned-byte 32) (*))
(locally
(declare (type (simple-array (unsigned-byte 32) (*)) coord-sequence))
(guts)))
(t
(guts)))))
#||
(defun render-set-picture-transform (picture mxx mxy dx mxy myy dy &optional (mwx 0) (mwy 0) (dw 1))
...)
||#
(defun render-set-picture-transform (picture a b c d e f p q r)
(let ((display (picture-display picture)))
(ensure-render-initialized display)
(synchronise-picture-state picture)
(with-buffer-request (display (extension-opcode display "RENDER"))
(data +X-RenderSetPictureTransform+)
#|
(card8 0) ;; render-op op) ;op
(card8 0) ;pad
(card16 0) ;pad
|#
(resource-id (picture-id picture))
(card32 a)
(card32 b)
(card32 c)
(card32 d)
(card32 e)
(card32 f)
(card32 p)
(card32 q)
(card32 r))))
(defun render-query-filters (drawable)
(let ((display (drawable-display drawable)))
(with-buffer-request-and-reply (display (extension-opcode display "RENDER") nil)
((data +X-RenderQueryFilters+)
(drawable drawable))
(let* ((len (card32-get 4))
(n-aliases (card32-get 8))
(n-filters (card32-get 12))
(off (+ (* 8 4) (* 4 (ceiling (* 2 n-aliases) 4)))))
(print (list :aliases
(loop for i below n-aliases collect (card16-get (+ (* 8 4) (* i 2))))))
(print (list :foo len n-aliases n-filters
(loop for i below len
collect (card8-get (+ off 0 (* 4 i)))
collect (card8-get (+ off 1 (* 4 i)))
collect (card8-get (+ off 2 (* 4 i)))
collect (card8-get (+ off 3 (* 4 i))))))
(print
(labels ((grab-string (j)
(let ((n (card8-get j)))
(incf j)
(values
(map 'string #'code-char (loop repeat n collect (card8-get j) do (incf j)))
j))))
(loop repeat n-filters collect
(multiple-value-bind (s j) (grab-string off)
(setf off j)
(intern (string-upcase s) :keyword)))))
#+NIL
(loop for i below n-picture-formats
collect
(let ((off (+ (* 8 4)
(* i 28)))) ;size of picture-format-info
(make-picture-format
:display display
:id (card32-get (+ off 0))
:type (member8-get (+ off 4) :indexed :direct)
:depth (card8-get (+ off 5))
:red-byte (byte (integer-length (card16-get (+ off 10)))
(card16-get (+ off 8)))
:green-byte (byte (integer-length (card16-get (+ off 14)))
(card16-get (+ off 12)))
:blue-byte (byte (integer-length (card16-get (+ off 18)))
(card16-get (+ off 16)))
:alpha-byte (byte (integer-length (card16-get (+ off 22)))
(card16-get (+ off 20)))
:colormap (let ((cmid (card32-get (+ off 24))))
(unless (zerop cmid)
(lookup-colormap display cmid))))))))))
(defun render-set-filter (picture filter)
(let ((display (picture-display picture)))
(ensure-render-initialized display)
(synchronise-picture-state picture)
(with-buffer-request (display (extension-opcode display "RENDER"))
(data +X-RenderSetPictureFilter+)
(resource-id (picture-id picture))
(card16 (length filter))
(card16 0) ;pad
((sequence :format card8) (map 'vector #'char-code filter)))))
#||
(defun render-triangle (destination source x1 y1 x2 y2 x3 y3 &key (src-x 0) (src-y 0) (format nil) (op :over))
(render-triangles-1 destination op source ...)
)
||#
(defun render-trapezoids-1 (picture op source src-x src-y format coord-sequence)
;; coord-sequence is top bottom
;; line-1-x1 line-1-y1 line-1-x2 line-1-y2
;; line-2-x1 line-2-y1 line-2-x2 line-2-y2 ...
;;
(let ((display (picture-display picture)))
(synchronise-picture-state picture)
(synchronise-picture-state source)
(with-buffer-request (display (extension-opcode display "RENDER"))
(data +X-RenderTrapezoids+)
(render-op op) ;op
(card8 0) ;pad
(card16 0) ;pad
(resource-id (picture-id source))
(resource-id (picture-id picture))
(picture-format format)
(int16 src-x)
(int16 src-y)
((sequence :format int32) coord-sequence) )))
(defun render-composite (op (defun render-composite (op
source mask dest source mask dest
src-x src-y mask-x mask-y dst-x dst-y src-x src-y mask-x mask-y dst-x dst-y
...@@ -868,3 +1071,19 @@ by every function, which attempts to generate RENDER requests." ...@@ -868,3 +1071,19 @@ by every function, which attempts to generate RENDER requests."
||# ||#
;;;; Cursors
(defun render-create-cursor (picture &optional (x 0) (y 0))
(let ((display (picture-display picture)))
(ensure-render-initialized display)
(synchronise-picture-state picture)
(let* ((cursor (make-cursor :display display))
(cid (allocate-resource-id display cursor 'cursor)))
(setf (cursor-id cursor) cid)
(with-buffer-request (display (extension-opcode display "RENDER"))
(data +X-RenderCreateCursor+)
(resource-id cid)
(resource-id (picture-id picture))
(card16 x)
(card16 y))
cursor)))
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment