;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CLUEI; Base: 10; -*-

;;; 10/28/1991 (Matthias) 
;;;
;;; convert to color now accepts rationals or reals between 0 and 1 
;;; defining the degree of blackness (0 = white, .3 = lightgrey, 1 = black)
;;; convert to pixel caches these values like stringable values
  
(in-package :cluei)

(defmethod convert (contact value (type (eql 'pixel)))
  (typecase value
    (pixel value)        ; this case should come before (rational 0 1) etc.
    ((or stringable (rational 0 1) (float 0.0 1.0))
     (when (symbolp value) (setq value (symbol-name value)))
     (let ((screen (contact-screen contact)))
       (cond
	 ((equalp value "WHITE")
	  (screen-white-pixel screen))
	 
	 ((equalp value "BLACK")
	  (screen-black-pixel screen))
	 
	 (t
	  (let ((cache (getf (screen-plist screen) :color-cache)))
	    ;; Pixel already found for this color name?
	    (or
	      ;; Yes, return cached pixel.
	      (rest (assoc value cache :test #'equalp))
	      
	      ;; No, allocate pixel for color name.
	      (let*
		((color (convert contact value 'color))
		 (pixel (when color (convert contact color 'pixel))))

		(when pixel
		  ;; Add pixel to color name cache.
		  (setf (getf (screen-plist screen) :color-cache)
			(cons (cons value pixel) cache))
		  pixel))))))))
    (color
     (ignore-errors
       (alloc-color (screen-default-colormap (contact-screen contact)) value)))
    (otherwise nil)))

(defmethod convert (contact value (type (eql 'color)))
  (typecase value
    (stringable
     (ignore-errors
       (lookup-color (screen-default-colormap (contact-screen contact)) value)))
    ((or (rational 0 1) (float 0.0 1.0))
     (let ((brightness (- 1 value)))
     (if (xit::color-display-p (contact-display contact))
	 (make-color :red brightness :blue brightness :green brightness)
       nil)))
    (color value)
    (otherwise nil)))
