xrender CompositeGlyphs

--=-=-=

Hi,

There's a non-obvious mistake in RENDER-COMPOSITE-GLYPHS (it's
non-obvious because the protocol documentation doesn't really discuss
any of this; I had to look at the X server source to work out what was
going on).  Essentially, the RenderCompositeGlyphs{8,16,32} requests
can encode glyphs to compositely render in batches of 254 at a time;
the length field is one byte long, and 255 is interpreted as a request
to change glyphset.

The API to those protocol requests should probably have a TRANSLATE
argument, much as the core CLX API to polytext has, which would allow
the user to specify changing glyphset (analogous to changing font).
However, in the meantime, I have patched up %RENDER-COMPOSITE-GLYPHS
to allow rendering of strings of more than 254 characters in length.

I'm not utterly convinced that I've done this the best way; if there
are any people familiar with CLX code around, I'd appreciate comments.

(The way I triggered this bug was to hold down the #\a key at a
clim-listener with mcclim-freetype enabled.  If anyone wants to write
a minimal test case for this, though, that would also be appreciated.)


--=-=-=
Content-Disposition: attachment; filename=xrender.diff
Content-Description: fix %render-composite-glyphs

--- old-clx/xrender.lisp	2007-01-02 21:33:11.000000000 +0000
+++ new-clx/xrender.lisp	2007-01-02 21:33:11.000000000 +0000
@@ -789,21 +789,59 @@
       ((sequence :format card8) sequence))))
 
 (defmacro %render-composite-glyphs
-    (opcode type transform
-          display dest glyph-set source dest-x dest-y sequence alu src-x src-y mask-format start end)
-  `(with-buffer-request (,display (extension-opcode ,display "RENDER"))
-    (data ,opcode)
-    (render-op ,alu)
-    (card8 0) (card16 0)                        ;padding
-    (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
-    (card8 0) (card16 0)                        ;padding? really?
-    (int16 ,dest-x) (int16 ,dest-y)           ;dx, dy
-    ((sequence :format ,type :start ,start :end ,end :transform ,transform) ,sequence)))
+    (opcode type transform display dest glyph-set source dest-x dest-y sequence
+     alu src-x src-y mask-format start end)
+  (let ((size (ecase type (card8 1) (card16 2) (card32 4)))
+	;; FIXME: the last chunk for CARD8 can be 254.
+	(chunksize (ecase type (card8 252) (card16 254) (card32 254))))
+    `(multiple-value-bind (nchunks leftover)
+         (floor (- end start) ,chunksize)
+       (let* ((payloadsize (+ (* nchunks (+ 8 (* ,chunksize ,size)))
+			      (if (> leftover 0)
+				  (+ 8 (* 4 (ceiling (* leftover ,size) 4)))
+				  0)))
+	      (request-length (+ 7 (/ payloadsize 4))))
+	 (declare (integer request-length))
+	 (with-buffer-request (,display (extension-opcode ,display "RENDER") :length request-length)
+	   (data ,opcode)
+	   (length request-length)
+	   (render-op ,alu)
+	   (card8 0) (card16 0)                        ;padding
+	   (picture ,source)
+	   (picture ,dest)
+	   ((or (member :none) picture-format) ,mask-format)
+	   (glyph-set ,glyph-set)
+	   (int16 ,src-x) (int16 ,src-y)
+	   (progn
+	     (let ((boffset (+ buffer-boffset 28))
+		   (start ,start)
+		   (end ,end)
+		   (dest-x ,dest-x)
+		   (dest-y ,dest-y))
+	       (dotimes (i nchunks)
+		 (set-buffer-offset boffset)
+		 (put-items (0)
+		   (card8 ,chunksize)
+		   (card8 0)
+		   (card16 0)
+		   (int16 dest-x)
+		   (int16 dest-y)
+		   ((sequence :start start :end (+ start ,chunksize) :format ,type :transform ,transform :appending t) ,sequence))
+		 (setq dest-x 0 dest-y 0)
+		 (incf boffset (+ 8 (* ,chunksize ,size)))
+		 (incf start ,chunksize))
+	       (when (> leftover 0)
+		 (set-buffer-offset boffset)
+		 (put-items (0)
+		   (card8 leftover)
+		   (card8 0)
+		   (card16 0)
+		   (int16 dest-x)
+		   (int16 dest-y)
+		   ((sequence :start start :end end :format ,type :transform ,transform :appending t) ,sequence))
+		 ;; padding?
+		 (incf boffset (+ 8 (* 4 (ceiling (* leftover ,size) 4)))))
+	       (setf (buffer-boffset ,display) boffset))))))))
 
 (defun render-composite-glyphs (dest glyph-set source dest-x dest-y sequence
                                 &key (op :over)


--=-=-=


Cheers,

Christophe

--=-=-=--

_______________________________________________
Portable-clx mailing list
[email protected]
http://lists.metacircles.com/cgi-bin/mailman/listinfo/portable-clx
See http://www.cliki.net/clx for darcs URL(s)