CLIM mail archive
[Prev][Next][Index][Thread]
Re: color definitions
Clint Hyde asks:
...wondering if anyone has a file of interesting color definitions, a la
(make-rgb-color x y z)
and would be willing to give it away...
-- clint
I don't have that, but I do have a way of looking at the
built-in clim color constants:
;;; -*- Mode:Lisp; Syntax:Common-Lisp; Package:User; -*-
(in-package :user)
(defparameter *clim-colors*
(with-collection ()
(do-external-symbols (s 'clim)
(when (and (boundp s)
(typep (symbol-value s) 'clim-utils:rgb-color))
(collect s)))))
;; Color names are of the form clim:+color+ Good colors (my personal opinion):
;; firebrick, red, orange-red, deep-pink, tomato, orchid
;; dark-green, medium-sea-green, medium-blue, blue, dodger-blue
(clim:define-application-frame color-gui ()
()
(:panes ((main :application :display-function 'put-up-colors
:end-of-page-action :allow)))
(:layout ((default (:column 1 (main :rest))))))
(defun put-up-colors (frame stream)
"Display a palette of colors."
(clim:window-clear stream)
(flet ((cell (color)
(when color
(clim:with-drawing-options (stream :ink (symbol-value color))
(format stream (format nil "~25A" color)))))
(color-total (color)
(multiple-value-bind (r g b) (clim:color-rgb (symbol-value color))
(+ r g b))))
(let ((reds nil) (greens nil) (blues nil))
;; Partition the colors into mostly red, green, and blue
(dolist (color *clim-colors*)
(multiple-value-bind (r g b) (clim:color-rgb (symbol-value color))
(cond ((>= g (max r b)) (push color greens))
((>= b (max g r)) (push color blues))
((>= r (max g b)) (push color reds)))))
;; Sort them by total color
(setf reds (sort reds #'< :key #'color-total))
(setf greens (sort greens #'< :key #'color-total))
(setf blues (sort blues #'< :key #'color-total))
;; Display them in three columns: reds, greens, blues
(format stream "~25A~25A~25A~%" "Reds:" "Greens:" "Blues:")
(loop while (or reds greens blues)
do (cell (pop reds)) (cell (pop greens)) (cell (pop blues))
do (terpri stream)))))
(defun color-gui ()
(clim:run-frame-top-level
(clim:make-application-frame 'color-gui
:parent *clim-root*
:width 800 :height 860)))
Main Index |
Thread Index