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 @@
The ICCCM-compliant selection handling in demo/clipboard.lisp is now
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 ---
A port to ECL has been merged (Juan Jose Garcia Ripoll)
......
......@@ -3,7 +3,7 @@
;;; Title: The X Render Extension
;;; Created: 2002-08-03
;;; 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
......@@ -47,6 +47,38 @@
;; - 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)
;; Beginning to collect the external interface for documentation.
......@@ -111,34 +143,56 @@
(define-extension "RENDER")
(progn
(defconstant +X-RenderQueryVersion+ 0) ;done
(defconstant +X-RenderQueryPictFormats+ 1)
(defconstant +X-RenderQueryPictIndexValues+ 2)
(defconstant +X-RenderQueryDithers+ 3)
(defconstant +X-RenderCreatePicture+ 4) ;done
(defconstant +X-RenderChangePicture+ 5) ;done
(defconstant +X-RenderSetPictureClipRectangles+ 6) ;done
(defconstant +X-RenderFreePicture+ 7) ;done
(defconstant +X-RenderComposite+ 8) ;we need better arglist
(defconstant +X-RenderScale+ 9)
(defconstant +X-RenderTrapezoids+ 10)
(defconstant +X-RenderTriangles+ 11)
(defconstant +X-RenderTriStrip+ 12)
(defconstant +X-RenderTriFan+ 13)
(defconstant +X-RenderColorTrapezoids+ 14)
(defconstant +X-RenderColorTriangles+ 15)
(defconstant +X-RenderTransform+ 16)
(defconstant +X-RenderCreateGlyphSet+ 17) ;done
(defconstant +X-RenderReferenceGlyphSet+ 18) ;done
(defconstant +X-RenderFreeGlyphSet+ 19) ;done
(defconstant +X-RenderAddGlyphs+ 20)
(defconstant +X-RenderAddGlyphsFromPicture+ 21)
(defconstant +X-RenderFreeGlyphs+ 22)
(defconstant +X-RenderCompositeGlyphs8+ 23) ;done
(defconstant +X-RenderCompositeGlyphs16+ 24)
(defconstant +X-RenderCompositeGlyphs32+ 25)
(defconstant +X-RenderFillRectangles+ 26))
;;;; Request constants
;; Note: Although version numbers are given render.h where the request
;; numbers are defined, render-query-version returns 0.0 all displays
;; i tested. --GB 2004-07-21
(defconstant +X-RenderQueryVersion+ 0) ;done
(defconstant +X-RenderQueryPictFormats+ 1)
(defconstant +X-RenderQueryPictIndexValues+ 2) ;0.7
(defconstant +X-RenderQueryDithers+ 3)
(defconstant +X-RenderCreatePicture+ 4) ;done
(defconstant +X-RenderChangePicture+ 5) ;done
(defconstant +X-RenderSetPictureClipRectangles+ 6) ;done
(defconstant +X-RenderFreePicture+ 7) ;done
(defconstant +X-RenderComposite+ 8) ;we need better arglist
(defconstant +X-RenderScale+ 9)
(defconstant +X-RenderTrapezoids+ 10) ;low-level done
(defconstant +X-RenderTriangles+ 11) ;low-level done
(defconstant +X-RenderTriStrip+ 12)
(defconstant +X-RenderTriFan+ 13)
(defconstant +X-RenderColorTrapezoids+ 14) ;nyi in X server, not mentioned in renderproto.h
(defconstant +X-RenderColorTriangles+ 15) ;nyi in X server, not mentioned in renderproto.h
(defconstant +X-RenderTransform+ 16) ;commented out in render.h
(defconstant +X-RenderCreateGlyphSet+ 17) ;done
(defconstant +X-RenderReferenceGlyphSet+ 18) ;done
(defconstant +X-RenderFreeGlyphSet+ 19) ;done
(defconstant +X-RenderAddGlyphs+ 20) ;done, untested
(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:
......@@ -224,6 +278,7 @@ by every function, which attempts to generate RENDER requests."
(maphash (lambda (k f)
(declare (ignore k))
(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)
(visual-info-red-mask vi))
(eql (dpb -1 (picture-format-green-byte f) 0)
......@@ -272,8 +327,10 @@ by every function, which attempts to generate RENDER requests."
(unless (zerop (byte-size (cdr k)))
(format bag " ~A~D" (car k) (byte-size (cdr k)))))))))
(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-colormap object)
(picture-format-depth object)
(picture-format-type object) abbrev))))
(eval-when (:compile-toplevel :load-toplevel :execute)
......@@ -294,8 +351,7 @@ by every function, which attempts to generate RENDER requests."
;; provides no provision to actually query a picture object's values.
;; *sigh*
(def-clx-class (picture (:copier nil)
)
(def-clx-class (picture (:copier nil))
(id 0 :type resource-id)
(display nil :type (or null display))
(plist nil :type list) ; Extension hook
......@@ -446,17 +502,18 @@ by every function, which attempts to generate RENDER requests."
(card32 0)
(card32 1))
(values
(card16-get 8)
(card16-get 10)
)))
(card32-get 8)
(card32-get 12) )))
(defun render-query-picture-formats (display)
(with-buffer-request-and-reply (display (extension-opcode display "RENDER") nil)
((data +X-RenderQueryPictFormats+))
(let ((n-picture-formats (card32-get 8))
(n-screens (card32-get 12))
(off 32))
(declare (ignore n-screens off))
(n-depths (card32-get 16))
(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
collect
(let ((off (+ (* 8 4)
......@@ -493,6 +550,152 @@ by every function, which attempts to generate RENDER requests."
;; 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
source mask dest
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."
||#
;;;; 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