From dab5caf67ced388767d42de7299313317aa78a24 Mon Sep 17 00:00:00 2001
From: Neil Toronto <ntoronto@racket-lang.org>
Date: Tue, 1 Nov 2011 14:15:52 -0600
Subject: [PATCH] Expanded numbered colors to 128

---
 collects/plot/common/draw.rkt         | 89 ++++++++++++++++++++++++++-
 collects/plot/common/math.rkt         |  8 ++-
 collects/plot/plot2d/plot.rkt         |  2 +-
 collects/plot/plot3d/plot.rkt         |  2 +-
 collects/plot/scribblings/intro.scrbl | 14 +++--
 collects/plot/scribblings/todo.scrbl  |  2 -
 collects/plot/scribblings/utils.scrbl |  4 +-
 collects/plot/tests/pen-brush-hsv.rkt | 71 +++++++++++----------
 collects/unstable/latent-contract.rkt | 16 ++---
 9 files changed, 155 insertions(+), 53 deletions(-)

diff --git a/collects/plot/common/draw.rkt b/collects/plot/common/draw.rkt
index d2e4e2b590..5450434b9c 100644
--- a/collects/plot/common/draw.rkt
+++ b/collects/plot/common/draw.rkt
@@ -2,7 +2,8 @@
 
 ;; Extra drawing, font, color and style functions.
 
-(require racket/draw racket/class racket/match racket/list racket/contract
+(require racket/draw racket/class racket/match racket/list racket/contract racket/math
+         "math.rkt"
          "contract.rkt"
          "contract-doc.rkt"
          "sample.rkt")
@@ -72,6 +73,87 @@
   (match-define (list r g b) c)
   (make-object color% (real->color-byte r) (real->color-byte g) (real->color-byte b)))
 
+(define (rgb->hsv rgb)
+  (match-define (list r g b) (map (λ (x) (/ x 255)) rgb))
+  (define mx (max r g b))
+  (define mn (min r g b))
+  (define c (- mx mn))
+  (define h (* 60 (cond [(zero? c)  0]
+                        [(= mx r)   (/ (- g b) c)]
+                        [(= mx g)   (+ (/ (- b r) c) 2)]
+                        [(= mx b)   (+ (/ (- r g) c) 4)])))
+  (list (if (h . < . 0) (+ h 360) h)
+        (if (zero? mx) 0 (/ c mx))
+        mx))
+
+(define (hsv->rgb hsv)
+  (match-define (list h s v) hsv)
+  (define c (* v s))
+  (let ([h  (/ (real-modulo h 360) 60)])
+    (define x (* c (- 1 (abs (- (real-modulo h 2) 1)))))
+    (define-values (r g b)
+      (cond [(and (0 . <= . h) (h . < . 1))  (values c x 0)]
+            [(and (1 . <= . h) (h . < . 2))  (values x c 0)]
+            [(and (2 . <= . h) (h . < . 3))  (values 0 c x)]
+            [(and (3 . <= . h) (h . < . 4))  (values 0 x c)]
+            [(and (4 . <= . h) (h . < . 5))  (values x 0 c)]
+            [(and (5 . <= . h) (h . < . 6))  (values c 0 x)]))
+    (define m (- v c))
+    (list (* 255 (+ r m))
+          (* 255 (+ g m))
+          (* 255 (+ b m)))))
+
+(define (integer->hue n)
+  (let ([n  (abs n)])
+    (define i (+ (case (remainder n 6) [(0) 0] [(1) 2] [(2) 4] [(3) 1] [(4) 3] [(5) 5])
+                 (* 6 3 (quotient n 6))))
+    (remainder (* i 59) 360)))
+
+(define (integer->gray-value n)
+  (* 1/7 (remainder (abs n) 8)))
+
+(define (integer->pen-color n)
+  (define h (integer->hue n))
+  (hsv->rgb (list (- h (* 25 (sin (* (/ h 360) (* 3 pi)))))
+                  1
+                  (+ 1/2 (* 1/6 (sin (* (/ h 360) (* 3 pi))))))))
+
+(define (integer->brush-color n)
+  (define h (integer->hue n))
+  (hsv->rgb (list (let ([y  (* (/ (- (sqrt (+ (/ h 60) 2)) (sqrt 2))
+                                  (- (sqrt 8) (sqrt 2)))
+                               6)])
+                    (- h (* 15 (sin (* (/ y 6) (* 3 pi))))))
+                  (+ 3/16 (* 3/32 (sin (* (/ h 360) (* 2 pi)))))
+                  1)))
+
+(define (integer->gray-pen-color i)
+  (make-list 3 (* 128 (expt (integer->gray-value i) 3/4))))
+
+(define (integer->gray-brush-color i)
+  (make-list 3 (+ 127 (* 128 (expt (- 1 (integer->gray-value i)) 3/4)))))
+
+(define pen-colors
+  (for/vector ([color  (in-list (append (list (integer->gray-pen-color 0))
+                                        (build-list 120 integer->pen-color)
+                                        (build-list 7 (λ (n) (integer->gray-pen-color (- 7 n))))))])
+    (map real->color-byte color)))
+
+(define brush-colors
+  (for/vector ([color  (in-list (append (list (integer->gray-brush-color 0))
+                                        (build-list 120 integer->brush-color)
+                                        (build-list 7 (λ (n) (integer->gray-brush-color (- 7 n))))))])
+    (map real->color-byte color)))
+
+(defproc (->pen-color [c plot-color/c]) (list/c real? real? real?)
+  (cond [(exact-integer? c)  (vector-ref pen-colors (modulo c 128))]
+        [else                (->color c)]))
+
+(defproc (->brush-color [c plot-color/c]) (list/c real? real? real?)
+  (cond [(exact-integer? c)  (vector-ref brush-colors (modulo c 128))]
+        [else                (->color c)]))
+
+#|
 (define pen-colors
   '#((0 0 0)          ; black
      (128 0 0)        ; red
@@ -83,7 +165,7 @@
      (160 160 160)))  ; gray
 
 (defproc (->pen-color [c plot-color/c]) (list/c real? real? real?)
-  (cond [(exact-integer? c)  (vector-ref pen-colors (remainder (abs c) 8))]
+  (cond [(exact-integer? c)  (vector-ref pen-colors (modulo c 8))]
         [else                (->color c)]))
 
 (define brush-colors
@@ -97,8 +179,9 @@
      (212 212 212)))  ; gray
 
 (defproc (->brush-color [c plot-color/c]) (list/c real? real? real?)
-  (cond [(exact-integer? c)  (vector-ref brush-colors (remainder (abs c) 8))]
+  (cond [(exact-integer? c)  (vector-ref brush-colors (modulo c 8))]
         [else                (->color c)]))
+|#
 
 (defproc (->pen-style [s plot-pen-style/c]) symbol?
   (cond [(exact-integer? s)  (case (remainder (abs s) 5)
diff --git a/collects/plot/common/math.rkt b/collects/plot/common/math.rkt
index a1db54bfe0..48154ab08b 100644
--- a/collects/plot/common/math.rkt
+++ b/collects/plot/common/math.rkt
@@ -166,7 +166,13 @@
   (cond [(not (and (exact-integer? b) (b . >= . 2)))  (raise-type-error 'floor-log/base
                                                                         "exact integer >= 2" 0 b x)]
         [(not (and (real? x) (x . > . 0)))  (raise-type-error 'floor-log/base "real > 0" 1 b x)]
-        [else  (inexact->exact (ceiling (/ (log (abs x)) (log b))))]))
+        [else  (define y (inexact->exact (ceiling (/ (log x) (log b)))))
+               (cond [(exact? x)
+                      (let loop ([y y] [x  (/ x (expt b y))])
+                        (cond [(x . > . 1)         (loop (add1 y) (/ x b))]
+                              [(x . <= . (/ 1 b))  (loop (sub1 y) (* x b))]
+                              [else  y]))]
+                     [else  y])]))
 
 (defproc (polar->cartesian [θ real?] [r real?]) (vector/c real? real?)
   (cond [(not (real? θ))  (raise-type-error 'polar->cartesian "real number" 0 θ r)]
diff --git a/collects/plot/plot2d/plot.rkt b/collects/plot/plot2d/plot.rkt
index 99ec9cecb6..6b0913fd5c 100644
--- a/collects/plot/plot2d/plot.rkt
+++ b/collects/plot/plot2d/plot.rkt
@@ -19,7 +19,7 @@
 ;;   cannot instantiate `racket/gui/base' a second time in the same process
 (lazy-require ["../common/gui.rkt" (make-snip-frame)])
 
-(provide (except-out (all-defined-out) make-snip-frame))
+(provide (all-defined-out))
 
 ;; ===================================================================================================
 ;; Plot to a given device context
diff --git a/collects/plot/plot3d/plot.rkt b/collects/plot/plot3d/plot.rkt
index ad0a341843..99cabb57ce 100644
--- a/collects/plot/plot3d/plot.rkt
+++ b/collects/plot/plot3d/plot.rkt
@@ -20,7 +20,7 @@
 (lazy-require ["snip.rkt" (make-3d-plot-snip)]
               ["../common/gui.rkt" (make-snip-frame)])
 
-(provide (except-out (all-defined-out) make-3d-plot-snip make-snip-frame))
+(provide (all-defined-out))
 
 ;; ===================================================================================================
 ;; Plot to a given device context
diff --git a/collects/plot/scribblings/intro.scrbl b/collects/plot/scribblings/intro.scrbl
index b70faccbe7..7eeb8c1072 100644
--- a/collects/plot/scribblings/intro.scrbl
+++ b/collects/plot/scribblings/intro.scrbl
@@ -152,15 +152,21 @@ When used as area or surface colors, numbers are interpreted as light, desaturat
 @interaction[#:eval plot-eval
                     (parameterize ([interval-line1-width  3]
                                    [interval-line2-width  3])
-                      (plot (for/list ([i  (in-range 8)])
+                      (plot (for/list ([i  (in-range -7 13)])
                               (function-interval
-                               (λ (x) (* i 1.2)) (λ (x) (+ 1 (* i 1.2)))
+                               (λ (x) (* i 1.3)) (λ (x) (+ 1 (* i 1.3)))
                                #:color i #:line1-color i #:line2-color i))
                             #:x-min -8 #:x-max 8))]
 
-The colors repeat after @(racket 7); i.e. colors @(racket 8)..@(racket 15) are identical to colors @(racket 0)..@(racket 7).
+Color @(racket 0) is black for lines and white for areas.
+Colors @(racket 1)..@(racket 120) are generated by rotating hues and adjusting to make neighbors more visually dissimilar.
+Colors @(racket 121)..@(racket 127) are grayscale.
 
-If the paper will be published in black and white, use styles as well.
+Colors @(racket -7)..@(racket -1) are also grayscale because before @(racket 0), colors repeat.
+That is, colors @(racket -128)..@(racket -1) are identical to colors @(racket 0)..@(racket 127).
+Colors also repeat after @(racket 127).
+
+If the paper will be published in black and white, use styles as well as, or instead of, colors.
 There are @(racket 5) numbered pen styles and @(racket 7) numbered brush styles, which also repeat.
 
 @interaction[#:eval plot-eval
diff --git a/collects/plot/scribblings/todo.scrbl b/collects/plot/scribblings/todo.scrbl
index cedf8fa05e..face15048e 100644
--- a/collects/plot/scribblings/todo.scrbl
+++ b/collects/plot/scribblings/todo.scrbl
@@ -30,11 +30,9 @@
        @itemlist[
         @item{Better depth sorting (possibly split intersecting polygons; look into BSP tree)}
         @item{Legend entries have minimum sizes}
-        @item{Log-scale tick functions (i.e. major ticks are 10^0, 10^1, 10^2, ...)}
         @item{Label contour heights on the contour lines}
         @item{3D support for exact rational functions (i.e. polynomial at [big..big+ε])}
         @item{Join 2D contour lines}
-        @item{More appearance options (i.e. draw 2D tick labels on right/top)}
         @item{Manually exclude discontinuous points from function renderers: allow values @(racket (hole p1 p2)), @(racket (left-hole p1 p2)), @(racket (right-hole p1 p2))}
         @item{@(racket histogram-list) to plot multiple histograms without manually calculating @(racket #:x-min)}
         ]
diff --git a/collects/plot/scribblings/utils.scrbl b/collects/plot/scribblings/utils.scrbl
index 1c8be6f783..06e41ca7a3 100644
--- a/collects/plot/scribblings/utils.scrbl
+++ b/collects/plot/scribblings/utils.scrbl
@@ -112,7 +112,7 @@ Converts a @italic{line} color to an RGB triplet. This function interprets integ
 
 Non-integer colors are converted using @(racket ->color).
 Integer colors are chosen for good pairwise contrast, especially between neighbors.
-Integer colors repeat starting with @(racket 8).
+Integer colors repeat starting with @(racket 128).
 
 @examples[#:eval plot-eval
                  (equal? (->pen-color 0) (->pen-color 8))
@@ -127,7 +127,7 @@ Converts a @italic{fill} color to an RGB triplet. This function interprets integ
 
 Non-integer colors are converted using @(racket ->color).
 Integer colors are chosen for good pairwise contrast, especially between neighbors.
-Integer colors repeat starting with @(racket 8).
+Integer colors repeat starting with @(racket 128).
 
 @examples[#:eval plot-eval
                  (equal? (->brush-color 0) (->brush-color 8))
diff --git a/collects/plot/tests/pen-brush-hsv.rkt b/collects/plot/tests/pen-brush-hsv.rkt
index e72df799d8..f8150a6481 100644
--- a/collects/plot/tests/pen-brush-hsv.rkt
+++ b/collects/plot/tests/pen-brush-hsv.rkt
@@ -71,7 +71,7 @@
 (define (integer->hue n)
   (let ([n  (abs n)])
     (define i (+ (case (remainder n 6) [(0) 0] [(1) 2] [(2) 4] [(3) 1] [(4) 3] [(5) 5])
-                 (* 6 (quotient n 6))))
+                 (* 6 3 (quotient n 6))))
     (remainder (* i 59) 360)))
 
 (define (pen-color n)
@@ -117,16 +117,48 @@
 (define (brush-color n)
   (define h (integer->hue n))
   (hsv->rgb (list (brush-hue-transform h) (brush-saturation-transform h) (brush-value-transform h))))
-#|
+
+(define (integer->value n)
+  (* 1/7 (remainder (abs n) 8)))
+
+(define (pen-intensity-transform i)
+  (* 128 (expt (integer->value i) 3/4)))
+
+(define (brush-intensity-transform i)
+  (+ 127 (* 128 (expt (- 1 (integer->value i)) 3/4))))
+
+(define (gray-pen-color i)
+  (make-list 3 (pen-intensity-transform i)))
+
+(define (gray-brush-color i)
+  (make-list 3 (brush-intensity-transform i)))
+
+(plot (for/list ([n  (in-range 8)])
+        (function-interval sin (λ (x) (+ 1 (sin x))) n (+ 1 n)
+                           #:color (gray-brush-color n)
+                           #:line1-color (gray-pen-color n)
+                           #:line2-color (gray-pen-color n)
+                           #:line1-width 2 #:line2-width 2 #:alpha 1)))
+
+(define new-brush-colors
+  (append (list (gray-brush-color 0))
+          (build-list 120 brush-color)
+          (build-list 7 (λ (n) (gray-brush-color (- 7 n))))))
+
+(define new-pen-colors
+  (append (list (gray-brush-color 0))
+          (build-list 120 brush-color)
+          (build-list 7 (λ (n) (gray-brush-color (- 7 n))))))
+
 (plot (for/list ([n  (in-range 60)])
         (lines (list (vector 0 n) (vector 1 n))
                #:color (brush-color n)
                #:width 6)))
 
-(plot (for*/list ([i  (in-range 6)] [j  (in-range 60)])
+(plot (for*/list ([i  (in-range 6)] [j  (in-range 20)])
         (define n (+ i (* j 6)))
         (rectangles (list (vector (ivl (+ i 0.05) (+ i 0.95))
-                                  (ivl (+ j 0.3) (+ j 0.7))))
+                                  (ivl (+ j 0.05) (+ j 0.95))))
                     #:color (brush-color n)
                     #:line-color (pen-color n)
                     #:line-width 3))
@@ -146,10 +178,10 @@
                           #:line-width 3)))
       #:height 200)
 
-(plot (for/list ([n  (in-range 6)])
-        (function-interval (λ (x) (* 1/2 (sin (+ x n))))
-                           (λ (x) (+ 1/2 (sin (+ x n))))
-                           -4 4 #:color (brush-color n)
+(plot (for/list ([n  (in-range 12)])
+        (function-interval (λ (x) (* 1/2 (sqr (+ x (* 2 n)))))
+                           (λ (x) (+ 1/2 (sqr (+ x (* 2 n)))))
+                           0 12 #:color (brush-color n)
                            #:line1-color (pen-color n)
                            #:line2-color (pen-color n)
                            #:line1-width 2 #:line2-width 2)))
@@ -161,26 +193,3 @@
                            #:line1-color (->pen-color (+ n 1))
                            #:line2-color (->pen-color (+ n 1))
                            #:line1-width 2 #:line2-width 2)))
-|#
-
-(define (integer->value n)
-  (* 1/3 (case (remainder (abs n) 4) [(0) 0] [(1) 2] [(2) 1] [(3) 3])))
-
-(define (pen-intensity-transform i)
-  (* 95 (expt (integer->value i) 3/4)))
-
-(define (brush-intensity-transform i)
-  (+ 160 (* 95 (- 1 (integer->value i)))))
-
-(define (gray-pen-color i)
-  (make-list 3 (pen-intensity-transform i)))
-
-(define (gray-brush-color i)
-  (make-list 3 (brush-intensity-transform i)))
-
-(plot (for/list ([n  (in-range 8)])
-        (function-interval sin (λ (x) (+ 1 (sin x))) n (+ 1 n)
-                           #:color (gray-brush-color n)
-                           #:line1-color (gray-pen-color n)
-                           #:line2-color (gray-pen-color n)
-                           #:line1-width 2 #:line2-width 2 #:alpha 1)))
diff --git a/collects/unstable/latent-contract.rkt b/collects/unstable/latent-contract.rkt
index 11e2697d70..d5514bb61a 100644
--- a/collects/unstable/latent-contract.rkt
+++ b/collects/unstable/latent-contract.rkt
@@ -45,29 +45,29 @@
 
 (define-syntax activate-contract-out/end
   (make-provide-pre-transformer
-   (λ (stx modes)
+   (λ (stx metas)
      (syntax-case stx ()
        [(_ id ...)  (with-syntax ([(item ...)  (for/list ([id  (in-list (syntax->list #'(id ...)))])
                                                  (activate->contract-out stx id))])
                       (pre-expand-export
                        (syntax-protect
                         (syntax/loc stx (contract-out item ...)))
-                       modes))]))))
+                       metas))]))))
 
-(define-for-syntax (modes->abs-modes modes)
-  (map (λ (mode) (and mode (+ mode (syntax-local-phase-level))))
-       (if (null? modes) '(0) modes)))
+(define-for-syntax (metas->abs-metas metas)
+  (map (λ (meta) (and meta (+ meta (syntax-local-phase-level))))
+       (if (null? metas) '(0) metas)))
 
 (define-for-syntax (make-lifting-provide-pre-transformer target-id)
   (make-provide-pre-transformer
-   (λ (stx modes)
+   (λ (stx metas)
      (syntax-case stx ()
        [(_ args ...)  (let ()
-                        (for ([mode  (in-list (modes->abs-modes modes))])
+                        (for ([meta  (in-list (metas->abs-metas metas))])
                           (syntax-local-lift-module-end-declaration
                            (syntax-protect
                             (quasisyntax/loc stx
-                              (provide (for-meta #,mode (#,target-id args ...)))))))
+                              (provide (for-meta #,meta (#,target-id args ...)))))))
                         (syntax/loc stx (combine-out)))]))))
 
 (define-syntax activate-contract-out