added a discloser that shows the rgb values of the color.

This commit is contained in:
frese 2001-08-21 14:46:52 +00:00
parent 4eb658e8a9
commit f1db98896b
1 changed files with 7 additions and 1 deletions

View File

@ -6,6 +6,12 @@
(tag color-tag color-set-tag!) (tag color-tag color-set-tag!)
(Xcolor color-Xcolor color-set-Xcolor!)) (Xcolor color-Xcolor color-set-Xcolor!))
(define-record-discloser :color
(lambda (c)
(let ((rgb (extract-rgb-values c)))
`(Color ,(/ (car rgb) 65535) ,(/ (cadr rgb) 65535)
,(/ (caddr rgb) 65535)))))
(define (internal-make-color Xcolor) (define (internal-make-color Xcolor)
(let ((maybe-color (color-list-find Xcolor))) (let ((maybe-color (color-list-find Xcolor)))
(if maybe-color (if maybe-color
@ -25,7 +31,7 @@
(import-lambda-definition %create-color (r g b) (import-lambda-definition %create-color (r g b)
"scx_Create_Color") "scx_Create_Color")
;; returns a list of r,g,b as integers ;; returns a list of r,g,b as integers from 0 - 2^16
(define (extract-rgb-values color) (define (extract-rgb-values color)
(%extract-rgb-values (color-Xcolor color))) (%extract-rgb-values (color-Xcolor color)))