[mcclim-cvs] CVS mcclim

[ahefner]

Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv5009

Modified Files:
	design.lisp 
Log Message:

Added highlight-shade helper function.



--- /project/mcclim/cvsroot/mcclim/design.lisp	2006/03/10 21:58:12	1.25
+++ /project/mcclim/cvsroot/mcclim/design.lisp	2007/02/05 02:54:20	1.26
@@ -856,3 +856,29 @@
       (and (= r1 r2)
 	   (= g1 g2)
 	   (= b1 b2)))))
+
+;;; Color utilities
+
+(defgeneric highlight-shade (ink)
+  (:documentation
+  "Produce an alternate shade of the given ink for the purpose of highlighting.
+   Typically the ink will be brightened, but very light inks may be darkened."))
+
+(defmethod highlight-shade (ink) ink)
+
+(defmethod highlight-shade ((ink (eql +background-ink+)))
+  +foreground-ink+)
+
+(defmethod highlight-shade ((ink (eql +foreground-ink+)))
+  +background-ink+)
+
+(defmethod highlight-shade ((ink standard-color))
+  (let ((brighten-factor 0.5)
+        (darken-factor 0.15))
+  (multiple-value-bind (r g b) (color-rgb ink)
+    (multiple-value-bind (blend-ink factor)
+        (if (> (- 3.0 r g b) 0.2)
+            (values +white+ brighten-factor)
+            (values +black+ darken-factor))
+      (compose-over (compose-in blend-ink (make-opacity factor))
+                    ink)))))