;; Author: David Frese

;; alloc-color returns the pixel closest to the specified color supported by the
;; hardware. See XAllocColor.

(define (alloc-color colormap color)
  (let ((Xpixel (%alloc-color (colormap-Xcolormap colormap)
			      (color-Xcolor color)
			      (display-Xdisplay (colormap-display colormap)))))
    (if Xpixel
	(make-pixel Xpixel)
	Xpixel)))

(import-lambda-definition %alloc-color (Xcolormap Xcolor Xdisplay)
  "Alloc_Color")

;; alloc-named-color looks up the named color with respect to the screen that 
;; is associated with the specified colormap. It returns both the exact database
;; definition and the closest color supported by the screen (as a pair).
;; See XAllocNamedColor. 

(define (alloc-named-color colormap color-name)
  (let ((Xres (%alloc-named-color (colormap-Xcolormap colormap)
				  (if (symbol? color-name)
				      (symbol->string color-name)
				      color-name)
				  (display-Xdisplay 
				   (colormap-display colormap)))))
    (if Xres
	(list (make-pixel (car Xres))
	      (apply create-color (cadr Xres))
	      (apply create-color (caddr Xres)))
	Xres)))

(import-lambda-definition %alloc-named-color (Xcolormap name Xdisplay)
  "Alloc_Named_Color")