;; Author: David Frese

;; r,g,b should be values between 0.0 to 1.0 inclusive.

(define (make-color r g b)
  (create-color (floor (* r 65535)) 
		(floor (* g 65535))
		(floor (* b 65535))))

(define (color-rgb-values color)
  (map (lambda (x)
	 (/ x 65535)) ;; exact<->inexact?
       (extract-rgb-values color)))

;; ...

(define (query-color colormap pixel)
  (apply create-color
	 (%query-color (colormap-Xcolormap colormap)
		       (pixel-Xpixel pixel)
		       (display-Xdisplay (colormap-display colormap)))))

(import-lambda-definition %query-color (Xcolormap Xpixel Xdisplay)
  "Query_Color")

;; ...

(define (query-colors colormap pixels)
  (let ((res (%query-colors (colormap-Xcolormap colormap)
			    (vector-map! pixel-Xpixel pixels))))
    (vector-map! (lambda (r-g-b)
		   (apply make-color r-g-b))
		 res)))

(import-lambda-definition %query-colors (Xcolormap Xpixels Xdisplay)
  "Query_Colors")

;; ...

(define (lookup-color colormap color-name)
  (let ((r (%lookup-color (colormap-Xcolormap colormap)
			  (display-Xdisplay (colormap-display colormap))
			  (if (symbol? color-name)
			      (symbol->string color-name)
			      color-name))))
    (if r
	(cons (apply create-color (car r))
	      (apply create-color (cdr r)))
	(error "no such color:" color-name))))

(import-lambda-definition %lookup-color (Xcolormap Xdisplay)
  "Lookup_Color")