CLIM mail archive


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:make-application-frame 'color-gui
				:parent *clim-root*
				:width 800 :height 860)))

Main Index | Thread Index