From 7a85867b018120f61f43721309795fd6a8f8897b Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 30 Dec 1997 01:57:13 +0000
Subject: [PATCH] Install new X11 gray-map code that understands about
high-color displays.
---
v7/src/6001/picture.scm | 32 +++++++++++++++++++++++++++-----
1 file changed, 27 insertions(+), 5 deletions(-)
diff --git a/v7/src/6001/picture.scm b/v7/src/6001/picture.scm
index 3f710f25e..ef9ab368a 100644
--- a/v7/src/6001/picture.scm
+++ b/v7/src/6001/picture.scm
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Id: picture.scm,v 1.24 1997/12/30 01:53:33 cph Exp $
+$Id: picture.scm,v 1.25 1997/12/30 01:57:13 cph Exp $
Copyright (c) 1991-95 Massachusetts Institute of Technology
@@ -248,6 +248,11 @@ MIT in each case. |#
(else
(error "ALLOCATE-GRAYS: not known display type" window))))))
+(define use-color? #f)
+(define 2pi (* 8 (atan 1 1)))
+(define color-saturation 1)
+(define minimum-color-intensity .5)
+
(define (make-spectrum-palette n-levels encode-color)
(make-initialized-vector n-levels
(let ((step (/ (* 2/3 2pi) (- n-levels 2))))
@@ -263,10 +268,27 @@ MIT in each case. |#
(/ index (- n-levels 1))))))
encode-color))))))
-(define use-color? #f)
-(define 2pi (* 8 (atan 1 1)))
-(define color-saturation 1)
-(define minimum-color-intensity .5)
+(define (hsv->rgb h s v)
+ ;; H is in radians, S and V are in [0, 1].
+ ;; Returns three values, RGB, all in [0, 1].
+ (if (= 0 s)
+ (values v v v)
+ (let ((h
+ (let ((2pi (* 8 (atan 1 1))))
+ (let ((h/2pi (/ h 2pi)))
+ (* (- h/2pi (floor h/2pi)) 6)))))
+ (let ((i (floor->exact h)))
+ (let ((f (- h i)))
+ (let ((p (* v (- 1 s)))
+ (q (* v (- 1 (* s f))))
+ (t (* v (- 1 (* s (- 1 f))))))
+ (case i
+ ((0) (values v t p))
+ ((1) (values q v p))
+ ((2) (values p v t))
+ ((3) (values p q v))
+ ((4) (values t p v))
+ ((5) (values v p q)))))))))
(define (linear-binner min-value max-value n-bins)
(let ((min-value (exact->inexact min-value))
--
2.25.1