Commit 191f96cd authored by David Byers's avatar David Byers
Browse files

Implemented color model conversions that can be used to calculate highilght

colors for arbitrary backgrounds. Seems to work for every single combination
of foreground and background I know that people use in LysKOM.
parent f274a6c4
2002-05-07 David Byers <david.byers@swipnet.se>
Every KOM client needs color model conversion code:
* utilities.el (lyskom-string-to-rgb): New function.
(lyskom-rgb-to-hls): New function.
(lyskom-hls-to-rgb): New function.
(lyskom-hls-to-rgb-value): New function.
(lyskom-get-color-highlight): New function.
(lyskom-string-to-rgb): New function.
2002-05-06 David Byers <david.byers@swipnet.se>
* utilities.el (lyskom-unicase): Get the length from the converted
......
......@@ -1422,3 +1422,183 @@ in the 20th century")
nil
nil)))
;;; ================================================================
;;; Color model manipulations
;;;
;;; (Of COURSE you need this in a KOM client!)
;;;
(defun lyskom-get-color-highlight (color distance)
"Create a highlight color for COLOR that is DISTANCE away.
COLOR is a string naming the color and DISTANCE is a non-negative
integer no larger than 255, that in some way specifies how far
away from the original color the new color should be."
(let* ((hls (lyskom-rgb-to-hls (lyskom-string-to-rgb color)))
(l (elt hls 1)))
(if (> l 0.6)
(setq l (- l (/ distance 255.0)))
(setq l (+ l (/ distance 255.0))))
(cond ((> l 1.0) (setq l 1.0))
((< l 0.0) (setq l 0.0)))
(aset hls 1 l)
(apply 'format "#%02x%02x%02x"
(mapcar (lambda (c) (round (* 255 c)))
(lyskom-hls-to-rgb hls)))))
(defun lyskom-string-to-rgb (color)
"Convert the name of a color to RGB values."
(mapcar (lambda (x) (/ x 65535.0)) (lyskom-color-values color)))
(defun lyskom-rgb-to-hls (rgb)
"Convert a point in RGB color space to a point in HLS color space.
Input value is a vector [R G B], where R, G and B represent red, green
and blue components, respectively. Each value is a non-negative
floating-point value no larger than 1.0.
Output is a vector [H L S], where H, L and S represend hue, lightness
and saturation, respectively. H is in the range 0..360, L and S are
non-negative floating-point numbers no higher than 1.0. If the input
color is a shade of gray (all components are equal), then H in the
output is nil.
Algorithm adapted from Foley, \"Computer Graphics\"."
(let* ((r (elt rgb 0))
(g (elt rgb 1))
(b (elt rgb 2))
(rgbmin (min r g b))
(rgbmax (max r g b))
(h nil)
(l (/ (+ rgbmax rgbmin) 2.0))
(s nil)
(delta (- rgbmax rgbmin)))
(if (zerop delta)
(setq s 0.0)
(if (<= l 0.5)
(setq s (/ delta (+ rgbmax rgbmin)))
(setq s (/ delta (- 2.0 rgbmax rgbmin))))
(cond ((= r rgbmax)
(setq h (/ (- g b) delta)))
((= g rgbmax)
(setq h (+ 2.0 (/ (- b r) delta))))
((= b rgbmax)
(setq h (+ 4.0 (/ (- r g) delta)))))
(setq h (* h 60.0))
(if (< h 0)
(setq h (+ 360.0 h))))
(vector h l s)))
(defun lyskom-hls-to-rgb-value (n1 n2 h)
"Helper function for lyskom-hls-to-rgb"
(cond ((> h 360) (setq h (- h 360.0)))
((< h 0) (setq h (+ h 360.0))))
(cond ((< h 60) (+ n1 (* (- n2 n1) (/ h 60.0))))
((< h 180) n2)
((< h 240) (+ n1 (* (- n2 n1) (/ (- 240.0 h) 60.0))))
(t n1)))
(defun lyskom-hls-to-rgb (hls)
"Convert a point in HLS color space to a point in RGB color space.
Input HLS is a vector [H L S], where H, L and S represend hue,
lightness and saturation, respectively. H is in the range 0..360, L
and S are non-negative floating-point numbers no higher than 1.0. If
the input color is a shade of gray (all components are equal), then S
in the input is ignored and may be anything.
Output value is a vector [R G B], where R, G and B represent red,
green and blue components, respectively. Each value is in the range
1..1.0.
This algorithm is adapted from Foley, \"Computer Graphics\" (and
has the bug in that algorithm fixed)."
(let* ((h (elt hls 0))
(l (elt hls 1))
(s (elt hls 2))
(m2 (if (<= l 0.5)
(* l (+ 1.0 s))
(+ l (* s (- 1 l)))))
(m1 (- (* 2 l) m2)))
(if (zerop s)
(vector l l l)
(vector (lyskom-hls-to-rgb-value m1 m2 (+ h 120))
(lyskom-hls-to-rgb-value m1 m2 h)
(lyskom-hls-to-rgb-value m1 m2 (- h 120))))))
;;; ================================================================
;;; Automatically test that RGB->X and X->RGB color model conversions
;;; really are the inverse of each other.
;;;
;;; (defun lyskom-test-color-model ()
;;; (let ((r 0.0)
;;; (g 0.0)
;;; (b 0.0)
;;; (step 0.05))
;;; (while (<= r 1.0)
;;; (setq g 0.0)
;;; (while (<= g 1.0)
;;; (setq b 0.0)
;;; (while (<= b 1.0)
;;; (let ((tmp (lyskom-hls-to-rgb
;;; (lyskom-rgb-to-hls (vector r g b)))))
;;; (unless (and (< (- r (elt tmp 0)) 0.000000001)
;;; (< (- g (elt tmp 1)) 0.000000001)
;;; (< (- b (elt tmp 2)) 0.000000001))
;;; (message "Mismatch %1.2f,%1.2f,%1.2f gave %S/%S" r g b (lyskom-rgb-to-hls (vector r g b)) tmp)))
;;; (setq b (+ b step)))
;;; (setq g (+ g step)))
;;; (setq r (+ r step)))))
;;; (defun lyskom-test-auto-colors ()
;;; (make-face 'test-1)
;;; (make-face 'test-2)
;;; (make-face 'test-default)
;;; (while t
;;; (let ((foreground (read-from-minibuffer "Foreground: "))
;;; (background (read-from-minibuffer "Background: ")))
;;; (pop-to-buffer (get-buffer-create "*kom*-test"))
;;; (erase-buffer)
;;; (set-face-foreground 'test-default foreground)
;;; (set-face-background 'test-default background)
;;; (set-face-background 'test-1 (lyskom-get-color-highlight background 16))
;;; (set-face-background 'test-2 (lyskom-get-color-highlight background 8))
;;; (let ((lyskom-buffer (current-buffer)))
;;; (lyskom-format-insert "\
;;; %#3@Lsa nsta fotnot...
;;; 8408827 idag 00:40 /1 rad/ Lunkwill/CH ( Auf das Universum! )
;;; Fotnot till text 8408825 av Lunkwill/CH ( Auf das Universum! )
;;; Mottagare: Ntverk, Internet, LysNET, Sunet... <30873>
;;; Mottagare: SUBnet (Stngstadens och LiU:s) studentbostadsnt <12152>
;;; Mottagare: Lunkwill/CH ( Auf das Universum! ) <2092>
;;; rende: Vrmtet
;;; %[%#1$------------------------------------------------------------
;;; %]%[%#2$Och tack s mycket fr frklaringarna! =)
;;; %]%[%#1$(8408827) /Lunkwill/CH ( Auf das Universum! )/------
;;; %]G till nsta mte...
;;; SUN erfarenhetsutbyte - 1 olst
;;; Lsa nsta text...
;;; 8408823 idag 00:39 /4 rader/ Erik Persson, Lysato(r)
;;; Kommentar till text 8407161 av Dejan (ngot desperat)
;;; Mottagare: SUN erfarenhetsutbyte <23622>
;;; rende: Skapa partitionstabell
;;; %[%#1$------------------------------------------------------------
;;; %]%[%#2$Om du nu vill spela Fibre Channel med IDE-RAID s gr du ver n efter
;;; vatten. Det finns redan IDE-RAID med FC-interface. Dock har jag inte
;;; sett ngon som stdjer ngot annat n FC-AL vilket r lite
;;; begrnsande.
;;; %]%[%#1$(8408823) ------------------------------------------
;;; %]G till nsta mte...
;;;
;;;
;;;
;;; "
;;; '(face test-1)
;;; '(face test-2)
;;; '(face test-default))))))
;;;
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment