From tpapp at common-lisp.net  Sun Jun 29 09:00:01 2008
From: tpapp at common-lisp.net (tpapp at common-lisp.net)
Date: Sun, 29 Jun 2008 05:00:01 -0400 (EDT)
Subject: [cl-colors-cvs] r3 - 
Message-ID: <20080629090001.B935F8317F@common-lisp.net>

Author: tpapp
Date: Sun Jun 29 04:59:58 2008
New Revision: 3

Modified:
   cl-colors.asd
   colors.lisp
   package.lisp
Log:
Added convex combination for RGBA colors by Johann Korndoerfer.

Cosmetic changes to ASD definition.



Modified: cl-colors.asd
==============================================================================
--- cl-colors.asd	(original)
+++ cl-colors.asd	Sun Jun 29 04:59:58 2008
@@ -1,4 +1,9 @@
-(defsystem cl-colors
+(defpackage #:cl-colors-asd
+  (:use :cl :asdf))
+
+(in-package :cl-colors-asd)
+
+(defsystem #:cl-colors
   :description "Simple color library for Common Lisp"
   :version "0.1"
   :author "Tamas K Papp"

Modified: colors.lisp
==============================================================================
--- colors.lisp	(original)
+++ colors.lisp	Sun Jun 29 04:59:58 2008
@@ -29,6 +29,17 @@
     (with-slots (red green blue alpha) obj
       (format stream "red: ~a  green: ~a  blue: ~a  alpha: ~a"
 	      red green blue alpha))))
+
+(defgeneric add-alpha (color alpha)
+  (:documentation "Add an alpha channel to a given color."))
+
+(defmethod add-alpha ((color rgb) alpha)
+  (make-instance 'rgba
+		 :red (red color)
+		 :green (green color)
+		 :blue (blue color)
+		 :alpha alpha))
+
 ;;;;
 ;;;; hsv
 ;;;;
@@ -161,7 +172,14 @@
   (with-convex-combination (cc rgb1 rgb2 alpha)
     (make-instance 'rgb :red (cc #'red) :green (cc #'green) :blue (cc #'blue))))
 
-(defun hsv-combination (hsv1 hsv2 alpha positivep)
+(defun rgba-combination (rgba1 rgba2 alpha)
+  "Convex combination in RGBA space."
+  (with-convex-combination (cc rgba1 rgba2 alpha)
+    (make-instance 'rgba :red (cc #'red) 
+		   :green (cc #'green) :blue (cc #'blue)
+		   :alpha (cc #'alpha))))
+
+(defun hsv-combination (hsv1 hsv2 alpha &optional (positivep t))
   (with-convex-combination (cc hsv1 hsv2 alpha)
     (make-instance 'hsv
      :hue (hue-combination (hue hsv1) (hue hsv2) alpha positivep)

Modified: package.lisp
==============================================================================
--- package.lisp	(original)
+++ package.lisp	Sun Jun 29 04:59:58 2008
@@ -1,7 +1,8 @@
 (defpackage :cl-colors
   (:use :common-lisp :cl-utilities)
   (:export rgb red green blue
-	   rgba alpha 
+	   rgba alpha add-alpha
 	   hsv hue saturation value
 	   rgb->hsv hsv->rgb ->hsv ->rgb
-	   convex-combination hue-combination rgb-combination hsv-combination))
+	   convex-combination hue-combination rgb-combination 
+	   rgba-combination hsv-combination))