diff options
author | Thomas Bushnell, BSG <tb@debian.org> | 2005-11-02 14:55:21 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:32 -0800 |
commit | 34c54a22ff7818bb8b38ef4d9c87dbbcb221ba73 (patch) | |
tree | 1189d06a81277bcf8539b0260a69a19f6038effb /colorspc.scm | |
parent | 611b3db17894e5fdc0db3d49eaf6743d27b44233 (diff) | |
parent | 5145dd3aa0c02c9fc496d1432fc4410674206e1d (diff) | |
download | slib-34c54a22ff7818bb8b38ef4d9c87dbbcb221ba73.tar.gz slib-34c54a22ff7818bb8b38ef4d9c87dbbcb221ba73.zip |
Import Debian changes 3a2-1debian/3a2-1
slib (3a2-1) unstable; urgency=low
* New upstream release.
* Acknowledge NMU. (Closes: #281809)
* Makefile: Don't hack Makefile; use rules instead.
* debian/rules: Set on make invocations: prefix, htmldir, TEXI2HTML.
* debian/rules (clean): Clean more stuff here.
* Makefile: Comment out old rule for $(htmldir)slib_toc.html. Instead,
specify directly that the texi2html invocation produces that file.
* debian/rules (binary-indep): Find web files in slib subdir.
* debian/control (Build-Depends-Indep): Go back to using scm.
Diffstat (limited to 'colorspc.scm')
-rw-r--r-- | colorspc.scm | 43 |
1 files changed, 27 insertions, 16 deletions
diff --git a/colorspc.scm b/colorspc.scm index 3a88767..814149b 100644 --- a/colorspc.scm +++ b/colorspc.scm @@ -345,13 +345,6 @@ (or (color:process-params parametric-factors) '(2 1 1))))))) (map sqrt (map * lch1 lch2)))) -;@ -(define (XYZ:normalize-colors lst) - (define sum (apply max (map (lambda (XYZ) (apply + XYZ)) lst))) - (map (lambda (XYZ) (map (lambda (x) (/ x sum)) XYZ)) lst)) -;@ -(define (XYZ:normalize XYZ) - (car (XYZ:normalize-colors (list XYZ)))) ;;; Chromaticity ;@ @@ -440,6 +433,29 @@ (vector-set! cie:y-bar idx (read iprt)) (vector-set! cie:z-bar idx (read iprt)))))))) ;@ +(define (read-cie-illuminant path) + (define siv (make-vector 107)) + (call-with-input-file path + (lambda (iprt) + (do ((idx 0 (+ 1 idx))) + ((>= idx 107) siv) + (vector-set! siv idx (read iprt)))))) +;@ +(define (read-normalized-illuminant path) + (define siv (read-cie-illuminant path)) + (let ((yw (/ (cadr (spectrum->XYZ siv 300e-9 830e-9))))) + (illuminant-map (lambda (w x) (* x yw)) siv))) +;@ +(define (illuminant-map proc siv) + (define prod (make-vector 107)) + (do ((idx 106 (+ -1 idx)) + (w 830e-9 (+ -5e-9 w))) + ((negative? idx) prod) + (vector-set! prod idx (proc w (vector-ref siv idx))))) +;@ +(define (illuminant-map->XYZ proc siv) + (spectrum->XYZ (illuminant-map proc siv) 300e-9 830e-9)) +;@ (define (wavelength->XYZ wl) (if (not cie:y-bar) (require 'ciexyz)) (set! wl (- (/ wl 5.e-9) 380/5)) @@ -453,8 +469,6 @@ (interpolate cie:y-bar wlf res) (interpolate cie:z-bar wlf res))) (slib:error 'wavelength->XYZ 'out-of-range wl))) -(define (wavelength->CIEXYZ wl) - (XYZ:normalize (wavelength->XYZ wl))) (define (wavelength->chromaticity wl) (XYZ->chromaticity (wavelength->XYZ wl))) ;@ @@ -509,8 +523,6 @@ (set! y (+ y (* (vector-ref cie:y-bar kdx) inten))) (set! z (+ z (* (vector-ref cie:z-bar kdx) inten)))))))) (else (slib:error 'spectrum->XYZ 'wna args)))) -(define (spectrum->CIEXYZ . args) - (XYZ:normalize (apply spectrum->XYZ args))) (define (spectrum->chromaticity . args) (XYZ->chromaticity (apply spectrum->XYZ args))) ;@ @@ -522,15 +534,14 @@ (pi*2*h*c*c (* 2 pi h*c c))) (lambda (temp . span) (define h*c/kT (/ h*c k temp)) - (define pi*2*h*c*c*span (* pi*2*h*c*c (if (null? span) 1.e-9 (car span)))) + (define pi*2*h*c*c*span + (* pi*2*h*c*c (if (null? span) 1.e-9 (car span)))) (lambda (x) (/ pi*2*h*c*c*span (expt x 5) (- (exp (/ h*c/kT x)) 1)))))) ;@ -(define (temperature->XYZ temp) - (spectrum->XYZ (blackbody-spectrum temp 5.e-9))) -(define (temperature->CIEXYZ temp) - (XYZ:normalize (temperature->XYZ temp))) +(define (temperature->XYZ temp . span) + (spectrum->XYZ (apply blackbody-spectrum temp span))) ;was .5e-9 (define (temperature->chromaticity temp) (XYZ->chromaticity (temperature->XYZ temp))) |