[mcclim-cvs] CVS mcclim/Backends/CLX - mcclim-cvs@common-lisp.net - mailman3.common-lisp.net

19 Dec 2006

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX
In directory clnet:/tmp/cvs-serv836
Modified Files:
    medium.lisp 
Log Message:
Resolve indirect inks to their current values before computing indexed
palette.

--- /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp	2006/12/17 19:53:52	1.75
+++ /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp	2006/12/19 02:16:38	1.76
@@ -456,7 +456,15 @@
(defmethod design-gcontext ((medium clx-medium) (ink climi::indexed-pattern))
   (let* ((array (slot-value ink 'climi::array))
-         (inks  (slot-value ink 'climi::designs))
+         (inks  (map 'vector
+                     (lambda (ink)
+                       (cond
+                         ((eql ink +foreground-ink+) (medium-foreground medium))
+                         ((eql ink +background-ink+) (medium-background medium))
+                         ((eql ink +flipping-ink+)
+                          (error "Flipping ink within patterns is not supported."))
+                         (t ink)))
+                     (slot-value ink 'climi::designs)))
          (w     (array-dimension array 1))
          (h     (array-dimension array 0)))
     (assert (not (zerop w)))

    