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))
