commit 2a0944988498c940340728add9f71601ea3e5343
parent a5653bf9bbb4796cc9387c0fac008f8652c5540a
Author: Robby Findler <robby@racket-lang.org>
Date: Tue, 4 Sep 2012 20:56:16 +0200
fixed color sorting algorithm
Diffstat:
3 files changed, 46 insertions(+), 28 deletions(-)
diff --git a/find.rkt b/find.rkt
@@ -1,7 +1,8 @@
#lang racket
(require racket/system
racket/draw
- racket/runtime-path)
+ racket/runtime-path
+ "orig-colors.rkt")
(define (get-language i)
(and (or (regexp-match #rx"scrbl$" (path->string i))
@@ -218,20 +219,6 @@
(hash-set! colors lang new-color)
new-color)
-(define orig-colors
- #hash((blue . ((0 0 255) (0 0 240) (0 0 220) (0 0 205) (0 0 190) (0 0 160)
- (50 50 255) (80 80 255) (100 100 255) (0 0 130) (0 0 100) (0 0 70)
- "slateblue"))
- (green . ((0 255 0) (0 230 0) (0 200 0) (0 175 0) (0 150 0) (0 125 0) (0 100 0)))
- (red . ((255 0 0) (230 0 0) (200 0 0) (175 0 0) (150 0 0) (125 0 0) (100 0 0)))
- (yellow . ((255 255 0)))
- (orange . ("orange" "darkorange" "gold"))
- (gray . ((240 240 240) (220 220 220) (200 200 200) (180 180 180) (160 160 160) (130 130 130) (100 100 100) (70 70 70) (50 50 50) (30 30 30)))
- (pink . ("pink" "lightpink" "fuchsia"))
- (purple . ("orchid" "purple" "darkviolet"))
- (cyan . ((0 255 255) (150 255 255)))
- (brown . ("brown"))))
-
(define colors-table (hash-copy orig-colors))
(define (next-color lang key)
diff --git a/lang-slide.ss b/lang-slide.ss
@@ -3,29 +3,45 @@
langs-in-tree
langs-with-colors)
(require "draw-plain.ss"
+ "orig-colors.rkt"
slideshow slideshow/code
- scheme/runtime-path)
+ scheme/runtime-path
+ racket/gui/base)
(define-runtime-path lang-colors.rkt "lang-colors.rkt")
(define (color->name c)
- (let-values ([(r g b) (split-out-color c)])
- (cond
- [(and (= r 0) (= g 0) (= b 0)) 'black]
- [(and (= r g) (= r b)) 'gray]
- [(and (= 255 b) (= r g)) 'blue]
- [(and (= r 0) (= g 0)) 'blue]
- [(and (= r 0) (= b 0)) 'green]
- [(and (= g 0) (= b 0)) 'red]
- [else 'other])))
+ (define-values (r g b) (split-out-color c))
+ (cond
+ [(and (equal? r 0) (equal? g 0) (equal? b 0))
+ 'black]
+ [else
+ (define res
+ (for/or ([(k v) (in-hash orig-colors)])
+ (for/or ([c (in-list v)])
+ (define rgb (cond
+ [(string? c)
+ (define clr (send the-color-database find-color c))
+ (list (send clr red) (send clr green) (send clr blue))]
+ [else
+ c]))
+ (and (equal? rgb (list r g b))
+ k))))
+ (unless res (error 'color->name "unable to find color name for ~s" c))
+ res]))
(define (color-name->index c)
(case c
[(blue) 0]
[(red) 1]
+ [(orange) 1.5]
[(green) 2]
[(gray) 3]
- [(other) 4]
- [(black) 5]
+ [(pink) 4]
+ [(cyan) 5]
+ [(purple) 5.5]
+ [(yellow) 7]
+ [(brown) 8]
+ [(black) 100]
[else (error 'color-name->index "unk ~s" c)]))
(define (split-out-color c)
@@ -33,7 +49,7 @@
(string->number (substring c 1 3) 16)
(string->number (substring c 3 5) 16)
(string->number (substring c 5 7) 16)))
-
+
(define (color<=? c1 c2)
(let ([n1 (color->name c1)]
[n2 (color->name c2)])
diff --git a/orig-colors.rkt b/orig-colors.rkt
@@ -0,0 +1,15 @@
+#lang racket/base
+(provide orig-colors)
+(define orig-colors
+ #hash((blue . ((0 0 255) (0 0 240) (0 0 220) (0 0 205) (0 0 190) (0 0 160)
+ (50 50 255) (80 80 255) (100 100 255) (0 0 130) (0 0 100) (0 0 70)
+ "slateblue"))
+ (green . ((0 255 0) (0 230 0) (0 200 0) (0 175 0) (0 150 0) (0 125 0) (0 100 0)))
+ (red . ((255 0 0) (230 0 0) (200 0 0) (175 0 0) (150 0 0) (125 0 0) (100 0 0)))
+ (yellow . ((255 255 0)))
+ (orange . ("orange" "darkorange" "gold"))
+ (gray . ((240 240 240) (220 220 220) (200 200 200) (180 180 180) (160 160 160) (130 130 130) (100 100 100) (70 70 70) (50 50 50) (30 30 30)))
+ (pink . ("pink" "lightpink" "fuchsia"))
+ (purple . ("orchid" "purple" "darkviolet"))
+ (cyan . ((0 255 255) (150 255 255)))
+ (brown . ("brown"))))
