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