Try another patch

This commit is contained in:
Tom Willemse 2013-05-16 20:15:08 +02:00
parent b508c40f18
commit f4ebc8aebb

View file

@ -1,12 +1,14 @@
diff --git a/color.lisp b/color.lisp diff --git a/color.lisp b/color.lisp
index 30396bc..57cebf1 100644 index 2085fbc..5ada58a 100644
--- a/color.lisp --- a/color.lisp
+++ b/color.lisp +++ b/color.lisp
@@ -66,29 +66,38 @@ then call (update-color-map).") @@ -66,31 +66,38 @@ then call (update-color-map).")
(xlib:alloc-color (xlib:screen-default-colormap (screen-number screen)) color)) (xlib:alloc-color (xlib:screen-default-colormap (screen-number screen)) color))
(defun lookup-color (screen color) (defun lookup-color (screen color)
- (xlib:lookup-color (xlib:screen-default-colormap (screen-number screen)) color)) - (cond
- ((typep color 'xlib:color) color)
- (t (xlib:lookup-color (xlib:screen-default-colormap (screen-number screen)) color))))
+ (flet ((hex () + (flet ((hex ()
+ (apply #'xlib:make-color + (apply #'xlib:make-color
+ (loop for (x y) in '((:red 16) (:green 8) (:blue 0)) + (loop for (x y) in '((:red 16) (:green 8) (:blue 0))
@ -23,7 +25,7 @@ index 30396bc..57cebf1 100644
- (let ((scm (xlib:screen-default-colormap (screen-number screen)))) - (let ((scm (xlib:screen-default-colormap (screen-number screen))))
- (labels ((map-colors (amt) - (labels ((map-colors (amt)
- (loop for c in *colors* - (loop for c in *colors*
- as color = (xlib:lookup-color scm c) - as color = (lookup-color screen c)
- do (adjust-color color amt) - do (adjust-color color amt)
- collect (xlib:alloc-color scm color)))) - collect (xlib:alloc-color scm color))))
- (setf (screen-color-map-normal screen) (apply #'vector (map-colors -0.25)) - (setf (screen-color-map-normal screen) (apply #'vector (map-colors -0.25))