scsh-conservatory
/
scx
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fixed make-color bug. added comments.

This commit is contained in:
frese 2001-07-16 13:08:08 +00:00
parent d198d95710
commit d91d4b3d74
1 changed files with 20 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
scheme/xlib/color.scm
View File

@ -1,18 +1,27 @@
;; Author: David Frese
;; r,g,b should be values between 0.0 to 1.0 inclusive.
;; make-color creates a color with the given r,g,b values, which should be
;; values between 0.0 to 1.0 inclusive.
(define (my-floor v)
(if (exact? v)
(floor v)
(my-floor (inexact->exact v))))
(define (make-color r g b)
(create-color (floor (* r 65535))
(floor (* g 65535))
(floor (* b 65535))))
(create-color (my-floor (* r 65535))
(my-floor (* g 65535))
(my-floor (* b 65535))))
;; color-rgb-values returns a list of the rgb-values (see make-color).
(define (color-rgb-values color)
(map (lambda (x)
(/ x 65535)) ;; exact<->inexact?
(extract-rgb-values color)))
;; ...
;; query-color returns the color of the given pixel in the given colormap.
;; See XQueryColor.
(define (query-color colormap pixel)
(apply create-color
@ -23,7 +32,8 @@
(import-lambda-definition %query-color (Xcolormap Xpixel Xdisplay)
"Query_Color")
;; ...
;; query-colors does the same as query-color but on vectors of pixels and
;; colors. See XQueryColors.
(define (query-colors colormap pixels)
(let ((res (%query-colors (colormap-Xcolormap colormap)
@ -35,7 +45,10 @@
(import-lambda-definition %query-colors (Xcolormap Xpixels Xdisplay)
"Query_Colors")
;; ...
;; lookup-color takes the name of a color (a string or symbol) looks it up in
;; the colormap and returns a pair of colors: the exact color and the closest
;; color provided by the screen associated to the colormap. If the color-name
;; can't be found an error is raised. See XLookupColor.
(define (lookup-color colormap color-name)
(let ((r (%lookup-color (colormap-Xcolormap colormap)