From 639ec151258c95a9b3cc85324d7299f1d1d92b47 Mon Sep 17 00:00:00 2001
From: Neil Toronto <ntoronto@racket-lang.org>
Date: Wed, 2 Nov 2011 10:16:27 -0600
Subject: [PATCH] Added 'isoline' and 'isoline*' aliases for contour functions.
 Added #:family argument to 2D label functions. Various little fixes.

---
 collects/plot/common/contract.rkt           |  51 +++++-----
 collects/plot/common/math.rkt               |  14 +--
 collects/plot/common/parameters.rkt         |   2 +-
 collects/plot/deprecated/renderers.rkt      |   2 +-
 collects/plot/main.rkt                      |   6 +-
 collects/plot/plot2d/area.rkt               |   7 ++
 collects/plot/plot2d/contour.rkt            |  60 ++++++++++--
 collects/plot/plot2d/decoration.rkt         |  19 ++--
 collects/plot/plot3d/contour.rkt            |  55 ++++++++++-
 collects/plot/scribblings/contracts.scrbl   |   8 --
 collects/plot/scribblings/renderer2d.scrbl  |  20 +++-
 collects/plot/scribblings/renderer3d.scrbl  |  18 +++-
 collects/plot/tests/contour-labels-test.rkt | 103 ++++++++++++++++++++
 13 files changed, 307 insertions(+), 58 deletions(-)
 create mode 100644 collects/plot/tests/contour-labels-test.rkt

diff --git a/collects/plot/common/contract.rkt b/collects/plot/common/contract.rkt
index bed2f1bf7e..e88210ad09 100644
--- a/collects/plot/common/contract.rkt
+++ b/collects/plot/common/contract.rkt
@@ -15,8 +15,8 @@
 ;; ===================================================================================================
 ;; Plot-specific contracts
 
-(defcontract anchor/c (one-of/c 'top-left 'top 'top-right
-                                'left 'center 'right
+(defcontract anchor/c (one-of/c 'top-left    'top    'top-right
+                                'left        'center 'right
                                 'bottom-left 'bottom 'bottom-right))
 
 (defcontract color/c (or/c (list/c real? real? real?)
@@ -26,31 +26,38 @@
 (defcontract plot-color/c (or/c exact-integer? color/c))
 
 (defcontract plot-pen-style/c (or/c exact-integer?
-                                    (one-of/c 'transparent 'solid 'dot 'long-dash
-                                              'short-dash 'dot-dash)))
+                                    (one-of/c 'transparent 'solid    'dot 'long-dash
+                                              'short-dash  'dot-dash)))
 
 (defcontract plot-brush-style/c (or/c exact-integer?
-                                      (one-of/c 'transparent 'solid
-                                                'bdiagonal-hatch 'fdiagonal-hatch 'crossdiag-hatch
-                                                'horizontal-hatch 'vertical-hatch 'cross-hatch)))
+                                      (one-of/c 'transparent      'solid
+                                                'bdiagonal-hatch  'fdiagonal-hatch 'crossdiag-hatch
+                                                'horizontal-hatch 'vertical-hatch  'cross-hatch)))
 
-(defcontract font-family/c (one-of/c 'default 'decorative 'roman 'script 'swiss
-                                     'modern 'symbol 'system))
+(defcontract font-family/c (one-of/c 'default 'decorative 'roman  'script 'swiss
+                                     'modern  'symbol     'system))
 
 (defthing known-point-symbols (listof symbol?) #:document-value
-  '(dot point pixel
-        plus times asterisk 5asterisk
-        odot oplus otimes oasterisk o5asterisk
-        circle square diamond triangle
-        fullcircle fullsquare fulldiamond fulltriangle
-        triangleup triangledown triangleleft triangleright
-        fulltriangleup fulltriangledown fulltriangleleft fulltriangleright
-        rightarrow leftarrow uparrow downarrow
-        4star 5star 6star 7star 8star
-        full4star full5star full6star full7star full8star
-        circle1 circle2 circle3 circle4 circle5 circle6 circle7 circle8
-        bullet fullcircle1 fullcircle2 fullcircle3 fullcircle4
-        fullcircle5 fullcircle6 fullcircle7 fullcircle8))
+  (list 'dot               'point            'pixel
+        'plus              'times            'asterisk
+        '5asterisk         'odot             'oplus
+        'otimes            'oasterisk        'o5asterisk
+        'circle            'square           'diamond
+        'triangle          'fullcircle       'fullsquare
+        'fulldiamond       'fulltriangle     'triangleup
+        'triangledown      'triangleleft     'triangleright
+        'fulltriangleup    'fulltriangledown 'fulltriangleleft
+        'fulltriangleright 'rightarrow       'leftarrow
+        'uparrow           'downarrow        '4star
+        '5star             '6star            '7star
+        '8star             'full4star        'full5star
+        'full6star         'full7star        'full8star
+        'circle1           'circle2          'circle3
+        'circle4           'circle5          'circle6
+        'circle7           'circle8          'bullet
+        'fullcircle1       'fullcircle2      'fullcircle3
+        'fullcircle4       'fullcircle5      'fullcircle6
+        'fullcircle7       'fullcircle8))
 
 (defcontract point-sym/c (or/c char? string? integer? (apply one-of/c known-point-symbols)))
 
diff --git a/collects/plot/common/math.rkt b/collects/plot/common/math.rkt
index 48154ab08b..d264554773 100644
--- a/collects/plot/common/math.rkt
+++ b/collects/plot/common/math.rkt
@@ -42,16 +42,16 @@
 (define fldistance
   (case-lambda
     [()   0]
-    [(x)  (if (flonum? x) (abs x) (raise-type-error 'distance "flonum" x))]
-    [(x y)  (cond [(not (flonum? x))  (raise-type-error 'distance "flonum" 0 x y)]
-                  [(not (flonum? y))  (raise-type-error 'distance "flonum" 1 x y)]
+    [(x)  (if (flonum? x) (abs x) (raise-type-error 'fldistance "flonum" x))]
+    [(x y)  (cond [(not (flonum? x))  (raise-type-error 'fldistance "flonum" 0 x y)]
+                  [(not (flonum? y))  (raise-type-error 'fldistance "flonum" 1 x y)]
                   [else  (unsafe-flsqrt (unsafe-fl+ (unsafe-fl* x x) (unsafe-fl* y y)))])]
-    [(x y z)  (cond [(not (flonum? x))  (raise-type-error 'distance "flonum" 0 x y z)]
-                    [(not (flonum? y))  (raise-type-error 'distance "flonum" 1 x y z)]
-                    [(not (flonum? z))  (raise-type-error 'distance "flonum" 2 x y z)]
+    [(x y z)  (cond [(not (flonum? x))  (raise-type-error 'fldistance "flonum" 0 x y z)]
+                    [(not (flonum? y))  (raise-type-error 'fldistance "flonum" 1 x y z)]
+                    [(not (flonum? z))  (raise-type-error 'fldistance "flonum" 2 x y z)]
                     [else  (unsafe-flsqrt (unsafe-fl+ (unsafe-fl+ (unsafe-fl* x x) (unsafe-fl* y y))
                                                       (unsafe-fl* z z)))])]
-    [xs  (cond [(not (andmap flonum? xs))  (raise-type-error 'distance "flonums" xs)]
+    [xs  (cond [(not (andmap flonum? xs))  (raise-type-error 'fldistance "flonums" xs)]
                [else  (unsafe-flsqrt (flsum (λ (x) (unsafe-fl* x x)) xs))])]))
 
 ;; ===================================================================================================
diff --git a/collects/plot/common/parameters.rkt b/collects/plot/common/parameters.rkt
index d9a58a4d02..b2a65975dd 100644
--- a/collects/plot/common/parameters.rkt
+++ b/collects/plot/common/parameters.rkt
@@ -28,7 +28,7 @@
 (defparam plot-tick-size (>=/c 0) 10)
 (defparam plot-font-size size (>=/c 0) 11)
 (defparam plot-font-family family font-family/c 'roman)
-(defparam plot-legend-anchor anchor anchor/c 'top-right)
+(defparam plot-legend-anchor anchor anchor/c 'top-left)
 (defparam plot-legend-box-alpha alpha (real-in 0 1) 2/3)
 (defparam plot-animating? boolean? #f)
 
diff --git a/collects/plot/deprecated/renderers.rkt b/collects/plot/deprecated/renderers.rkt
index c81c46825b..1e6ffff87e 100644
--- a/collects/plot/deprecated/renderers.rkt
+++ b/collects/plot/deprecated/renderers.rkt
@@ -30,7 +30,7 @@
                                  #:samples samples #:width width #:color color)])]))
 
 (define (contour-renderer f samples width color levels)
-  (contours f #:samples samples #:levels (if (exact-integer? levels) (sub1 levels) levels)
+  (isolines f #:samples samples #:levels (if (exact-integer? levels) (sub1 levels) levels)
             #:colors (list color) #:widths (list width) #:styles '(solid)))
 
 (define (shade-fill-colors zs)
diff --git a/collects/plot/main.rkt b/collects/plot/main.rkt
index c1d721b0f2..5899fce7f2 100644
--- a/collects/plot/main.rkt
+++ b/collects/plot/main.rkt
@@ -44,7 +44,8 @@
           lines-interval parametric-interval polar-interval function-interval inverse-interval))
 
 (require "plot2d/contour.rkt")
-(provide (activate-contract-out contours contour-intervals))
+(provide (activate-contract-out         contours contour-intervals
+                                isoline isolines isoline-intervals))
 
 (require "plot2d/rectangle.rkt")
 (provide (activate-contract-out rectangles area-histogram discrete-histogram))
@@ -69,7 +70,8 @@
 (provide (activate-contract-out surface3d))
 
 (require "plot3d/contour.rkt")
-(provide (activate-contract-out contours3d contour-intervals3d))
+(provide (activate-contract-out contour3d contours3d contour-intervals3d
+                                isoline3d isolines3d isoline-intervals3d))
 
 (require "plot3d/line.rkt")
 (provide (activate-contract-out lines3d parametric3d))
diff --git a/collects/plot/plot2d/area.rkt b/collects/plot/plot2d/area.rkt
index 337b221ca9..4820ea48e9 100644
--- a/collects/plot/plot2d/area.rkt
+++ b/collects/plot/plot2d/area.rkt
@@ -42,6 +42,9 @@
     (define x-size (- x-max x-min))
     (define y-size (- y-max y-min))
     
+    (define x-mid (* 1/2 (+ x-min x-max)))
+    (define y-mid (* 1/2 (+ y-min y-max)))
+    
     (define clipping? #f)
     (define clip-x-min x-min)
     (define clip-x-max x-max)
@@ -98,6 +101,10 @@
     (define view->dc #f)
     (define/public (plot->dc v) (view->dc (plot->view v)))
     
+    (define/public (plot-line->dc-angle v1 v2)
+      (match-define (vector dx dy) (v- (plot->dc v1) (plot->dc v2)))
+      (- (atan2 (- dy) dx)))
+    
     (define (make-view->dc left right top bottom)
       (define corners (list (vector x-min y-min) (vector x-min y-max)
                             (vector x-max y-min) (vector x-max y-max)))
diff --git a/collects/plot/plot2d/contour.rkt b/collects/plot/plot2d/contour.rkt
index a5b57b77b2..8cc62ea26d 100644
--- a/collects/plot/plot2d/contour.rkt
+++ b/collects/plot/plot2d/contour.rkt
@@ -2,19 +2,66 @@
 
 ;; Renderers for contour lines and contour intervals
 
-(require racket/contract racket/class racket/match racket/list racket/flonum racket/vector
+(require racket/contract racket/class racket/match racket/list racket/flonum racket/vector racket/math
          plot/utils
          "../common/contract-doc.rkt")
 
-(provide (all-defined-out))
+(provide (all-defined-out)
+         (rename-out [contours isolines]
+                     [contour-intervals isoline-intervals]))
+
+;; ===================================================================================================
+;; One contour line
+
+(define ((isoline-render-proc f z samples color width style alpha label) area)
+  (define-values (x-min x-max y-min y-max) (send area get-bounds))
+  (match-define (list xs ys zss) (f x-min x-max samples y-min y-max samples))
+  (define zs (2d-sample->list zss))
+  (define z-min (apply min* zs))
+  (define z-max (apply max* zs))
+  
+  (when (<= z-min z z-max)
+    (send area set-alpha alpha)
+    (send area set-pen color width style)
+    (for ([ya  (in-list ys)]
+          [yb  (in-list (rest ys))]
+          [zs0  (in-vector zss)]
+          [zs1  (in-vector zss 1)]
+          #:when #t
+          [xa  (in-list xs)]
+          [xb  (in-list (rest xs))]
+          [z1  (in-vector zs0)]
+          [z2  (in-vector zs0 1)]
+          [z3  (in-vector zs1 1)]
+          [z4  (in-vector zs1)])
+      (for/list ([line  (in-list (heights->lines xa xb ya yb z z1 z2 z3 z4))])
+        (send/apply area put-line (map (λ (v) (vector-take v 2)) line)))))
+  
+  (cond [label  (line-legend-entry label color width style)]
+        [else   empty]))
+
+(defproc (isoline
+          [f (real? real? . -> . real?)] [z real?]
+          [x-min (or/c real? #f) #f] [x-max (or/c real? #f) #f]
+          [y-min (or/c real? #f) #f] [y-max (or/c real? #f) #f]
+          [#:samples samples (and/c exact-integer? (>=/c 2)) (contour-samples)]
+          [#:color color plot-color/c (line-color)]
+          [#:width width (>=/c 0) (line-width)]
+          [#:style style plot-pen-style/c (line-style)]
+          [#:alpha alpha (real-in 0 1) (line-alpha)]
+          [#:label label (or/c string? #f) #f]
+          ) renderer2d?
+  (define g (2d-function->sampler f))
+  (renderer2d (vector (ivl x-min x-max) (ivl y-min y-max)) #f default-ticks-fun
+              (isoline-render-proc g z samples color width style alpha label)))
 
 ;; ===================================================================================================
 ;; Contour lines
 
-(define ((contours-render-proc f levels samples colors widths styles alphas label) area)
+(define ((contours-render-proc f g levels samples colors widths styles alphas label) area)
   (let/ec return
     (define-values (x-min x-max y-min y-max) (send area get-bounds))
-    (match-define (list xs ys zss) (f x-min x-max samples y-min y-max samples))
+    (match-define (list xs ys zss) (g x-min x-max samples y-min y-max samples))
     
     (define-values (z-min z-max)
       (let ([zs  (filter regular? (2d-sample->list zss))])
@@ -47,7 +94,8 @@
             [z3  (in-vector zs1 1)]
             [z4  (in-vector zs1)])
         (for/list ([line  (in-list (heights->lines xa xb ya yb z z1 z2 z3 z4))])
-          (send/apply area put-line (map (λ (v) (vector-take v 2)) line)))))
+          (match-define (list v1 v2) (map (λ (v) (vector-take v 2)) line))
+          (send area put-line v1 v2))))
     
     (cond [label  (line-legend-entries label zs labels colors widths styles)]
           [else   empty])))
@@ -66,7 +114,7 @@
           ) renderer2d?
   (define g (2d-function->sampler f))
   (renderer2d (vector (ivl x-min x-max) (ivl y-min y-max)) #f default-ticks-fun
-              (contours-render-proc g levels samples colors widths styles alphas label)))
+              (contours-render-proc f g levels samples colors widths styles alphas label)))
 
 ;; ===================================================================================================
 ;; Contour intervals
diff --git a/collects/plot/plot2d/decoration.rkt b/collects/plot/plot2d/decoration.rkt
index cde6c98d56..2c8f87dfba 100644
--- a/collects/plot/plot2d/decoration.rkt
+++ b/collects/plot/plot2d/decoration.rkt
@@ -9,7 +9,6 @@
          "line.rkt"
          "interval.rkt"
          "point.rkt"
-         "contour.rkt"
          "clip.rkt")
 
 (provide (all-defined-out))
@@ -220,12 +219,13 @@
   (match-define (vector x y) v)
   (format "(~a,~a)" (format-x-coordinate x area) (format-y-coordinate y area)))
 
-(define ((label-render-proc label v color size anchor angle point-size alpha) area)
+(define ((label-render-proc label v color size family anchor angle point-size alpha) area)
   (let ([label  (if label label (format-coordinate v area))])
     (send area set-alpha alpha)
     ; label
     (send area set-text-foreground color)
     (send area set-font-size size)
+    (send area set-font-family family)
     (send area put-text (string-append " " label " ") v anchor angle #:outline? #t)
     ; point
     (send area set-pen color 1 'solid)
@@ -237,6 +237,7 @@
           [v (vector/c real? real?)] [label (or/c string? #f) #f]
           [#:color color plot-color/c (plot-foreground)]
           [#:size size (>=/c 0) (plot-font-size)]
+          [#:family family font-family/c (plot-font-family)]
           [#:anchor anchor anchor/c (label-anchor)]
           [#:angle angle real? (label-angle)]
           [#:point-size point-size (>=/c 0) (label-point-size)]
@@ -244,13 +245,14 @@
           ) renderer2d?
   (match-define (vector x y) v)
   (renderer2d (vector (ivl x x) (ivl y y)) #f #f
-              (label-render-proc label v color size anchor angle point-size alpha)))
+              (label-render-proc label v color size family anchor angle point-size alpha)))
 
 (defproc (parametric-label
           [f (real? . -> . (vector/c real? real?))]
           [t real?] [label (or/c string? #f) #f]
           [#:color color plot-color/c (plot-foreground)]
           [#:size size (>=/c 0) (plot-font-size)]
+          [#:family family font-family/c (plot-font-family)]
           [#:anchor anchor anchor/c (label-anchor)]
           [#:angle angle real? (label-angle)]
           [#:point-size point-size (>=/c 0) (label-point-size)]
@@ -259,44 +261,47 @@
   (point-label (match f
                  [(vector fx fy)  (vector (fx t) (fy t))]
                  [(? procedure?)  (f t)])
-               label #:color color #:size size #:anchor anchor #:angle angle
+               label #:color color #:size size #:family family #:anchor anchor #:angle angle
                #:point-size point-size #:alpha alpha))
 
 (defproc (polar-label
           [f (real? . -> . real?)] [θ real?] [label (or/c string? #f) #f]
           [#:color color plot-color/c (plot-foreground)]
           [#:size size (>=/c 0) (plot-font-size)]
+          [#:family family font-family/c (plot-font-family)]
           [#:anchor anchor anchor/c (label-anchor)]
           [#:angle angle real? (label-angle)]
           [#:point-size point-size (>=/c 0) (label-point-size)]
           [#:alpha alpha (real-in 0 1) (label-alpha)]
           ) renderer2d?
   (point-label (polar->cartesian θ (f θ)) label
-               #:color color #:size size #:anchor anchor #:angle angle
+               #:color color #:size size #:family family #:anchor anchor #:angle angle
                #:point-size point-size #:alpha alpha))
 
 (defproc (function-label
           [f  (real? . -> . real?)] [x real?] [label (or/c string? #f) #f]
           [#:color color plot-color/c (plot-foreground)]
           [#:size size (>=/c 0) (plot-font-size)]
+          [#:family family font-family/c (plot-font-family)]
           [#:anchor anchor anchor/c (label-anchor)]
           [#:angle angle real? (label-angle)]
           [#:point-size point-size (>=/c 0) (label-point-size)]
           [#:alpha alpha (real-in 0 1) (label-alpha)]
           ) renderer2d?
   (point-label (vector x (f x)) label
-               #:color color #:size size #:anchor anchor #:angle angle
+               #:color color #:size size #:family family #:anchor anchor #:angle angle
                #:point-size point-size #:alpha alpha))
 
 (defproc (inverse-label
           [f  (real? . -> . real?)] [y real?] [label (or/c string? #f) #f]
           [#:color color plot-color/c (plot-foreground)]
           [#:size size (>=/c 0) (plot-font-size)]
+          [#:family family font-family/c (plot-font-family)]
           [#:anchor anchor anchor/c (label-anchor)]
           [#:angle angle real? (label-angle)]
           [#:point-size point-size (>=/c 0) (label-point-size)]
           [#:alpha alpha (real-in 0 1) (label-alpha)]
           ) renderer2d?
   (point-label (vector (f y) y) label
-               #:color color #:size size #:anchor anchor #:angle angle
+               #:color color #:size size #:family family #:anchor anchor #:angle angle
                #:point-size point-size #:alpha alpha))
diff --git a/collects/plot/plot3d/contour.rkt b/collects/plot/plot3d/contour.rkt
index 98bfd72ba8..774577bcff 100644
--- a/collects/plot/plot3d/contour.rkt
+++ b/collects/plot/plot3d/contour.rkt
@@ -4,7 +4,60 @@
          plot/utils
          "../common/contract-doc.rkt")
 
-(provide (all-defined-out))
+(provide (all-defined-out)
+         (rename-out [contour3d isoline3d]
+                     [contours3d isolines3d]
+                     [contour-intervals3d isoline-intervals3d]))
+
+;; ===================================================================================================
+;; One contour line in 3D (using marching squares)
+
+(define ((contour3d-render-proc f z samples color width style alpha label) area)
+  (define-values (x-min x-max y-min y-max z-min z-max) (send area get-bounds))
+  (match-define (list xs ys zss) (f x-min x-max (animated-samples samples)
+                                    y-min y-max (animated-samples samples)))
+  
+  (when (<= z-min z z-max)
+    (send area put-alpha alpha)
+    (send area put-pen color width style)
+    (for ([ya  (in-list ys)]
+          [yb  (in-list (rest ys))]
+          [zs0  (in-vector zss)]
+          [zs1  (in-vector zss 1)]
+          #:when #t
+          [xa  (in-list xs)]
+          [xb  (in-list (rest xs))]
+          [z1  (in-vector zs0)]
+          [z2  (in-vector zs0 1)]
+          [z3  (in-vector zs1 1)]
+          [z4  (in-vector zs1)])
+      (for ([line  (in-list (heights->lines xa xb ya yb z z1 z2 z3 z4))])
+        (match-define (list v1 v2) line)
+        (define center (vector (* 1/2 (+ xa xb)) (* 1/2 (+ ya yb))
+                               (* 1/2 (+ (min z1 z2 z3 z4) (max z1 z2 z3 z4)))))
+        (send area put-line v1 v2 center))))
+  
+  (cond [label  (line-legend-entry label color width style)]
+        [else   empty]))
+
+(defproc (contour3d
+          [f (real? real? . -> . real?)] [z real?]
+          [x-min (or/c real? #f) #f] [x-max (or/c real? #f) #f]
+          [y-min (or/c real? #f) #f] [y-max (or/c real? #f) #f]
+          [#:z-min z-min (or/c real? #f) #f] [#:z-max z-max (or/c real? #f) #f]
+          [#:samples samples (and/c exact-integer? (>=/c 2)) (plot3d-samples)]
+          [#:color color plot-color/c (line-color)]
+          [#:width width (>=/c 0) (line-width)]
+          [#:style style plot-pen-style/c (line-style)]
+          [#:alpha alpha (real-in 0 1) (line-alpha)]
+          [#:label label (or/c string? #f) #f]
+          ) renderer3d?
+  (define g (2d-function->sampler f))
+  (let ([z-min  (if z-min z-min z)]
+        [z-max  (if z-max z-max z)])
+    (renderer3d (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
+                #f default-ticks-fun
+                (contour3d-render-proc g z samples color width style alpha label))))
 
 ;; ===================================================================================================
 ;; Contour lines in 3D (using marching squares)
diff --git a/collects/plot/scribblings/contracts.scrbl b/collects/plot/scribblings/contracts.scrbl
index e2b50f16f7..c55d501d79 100644
--- a/collects/plot/scribblings/contracts.scrbl
+++ b/collects/plot/scribblings/contracts.scrbl
@@ -45,14 +45,6 @@ The contract for the @(racket #:sym) arguments in @(racket points) and @(racket
 
 @doc-apply[known-point-symbols]{
 A list containing the symbols that are valid @(racket points) symbols.
-
-@interaction[#:eval plot-eval
-                    (require (only-in srfi/13 string-pad-right))
-                    (for ([sym  (in-list known-point-symbols)]
-                          [n    (in-cycle (in-range 3))])
-                      (display (string-pad-right (format "~v" sym) 22))
-                      (when (= n 2) (newline)))
-                    (length known-point-symbols)]
 }
 
 @section{Appearance Argument Sequence Contracts}
diff --git a/collects/plot/scribblings/renderer2d.scrbl b/collects/plot/scribblings/renderer2d.scrbl
index c4592606c0..9ef0b83f6b 100644
--- a/collects/plot/scribblings/renderer2d.scrbl
+++ b/collects/plot/scribblings/renderer2d.scrbl
@@ -210,10 +210,18 @@ Corresponds with @(racket polar).
                                   (polar-interval f1 f2 #:label "[f1,f2]"))))]
 }
 
-@section{2D Contour Renderers}
+@section{2D Contour (Isoline) Renderers}
+
+@doc-apply[isoline]{
+Returns a renderer that plots a contour line, or a line of constant value (height).
+A circle of radius @(racket r), for example, is the line of constant value @(racket r) for the distance function:
+@interaction[#:eval plot-eval (plot (isoline (λ (x y) (sqrt (+ (sqr x) (sqr y)))) 1.5
+                                             -2 2 -2 2 #:label "z"))]
+}
+In this case, @(racket r) = @(racket 1.5).
 
 @doc-apply[contours]{
-Returns a renderer that plots contour lines, or lines of constant height.
+Returns a renderer that plots contour lines, or lines of constant value (height).
 
 When @(racket levels) is @(racket 'auto), the number of contour lines and their values are chosen the same way as axis tick positions; i.e. they are chosen to be simple.
 When @(racket levels) is a number, @(racket contours) chooses that number of values, evenly spaced, within the output range of @(racket f).
@@ -235,6 +243,10 @@ For example,
                                               #:styles '(solid dot)))]
 }
 
+@defproc[(isolines ...) renderer2d?]{
+A synonym of @(racket contours).
+}
+
 @doc-apply[contour-intervals]{
 Returns a renderer that fills the area between contour lines, and additionally draws contour lines.
 
@@ -246,6 +258,10 @@ For example, the canonical saddle, with its gradient field superimposed:
                                               #:color "black" #:label "Gradient")))]
 }
 
+@defproc[(isoline-intervals ...) renderer2d?]{
+A synonym of @(racket contour-intervals).
+}
+
 @section{2D Rectangle Renderers}
 
 @defstruct[ivl ([min real?] [max real?])]{
diff --git a/collects/plot/scribblings/renderer3d.scrbl b/collects/plot/scribblings/renderer3d.scrbl
index e704c5002f..668023368a 100644
--- a/collects/plot/scribblings/renderer3d.scrbl
+++ b/collects/plot/scribblings/renderer3d.scrbl
@@ -96,7 +96,15 @@ Combining polar function renderers allows faking latitudes or longitudes in larg
                               #:title "A Seashell" #:x-label #f #:y-label #f))]
 }
 
-@section{3D Contour Renderers}
+@section{3D Contour (Isoline) Renderers}
+
+@doc-apply[contour3d]{
+Returns a renderer that plots a single contour line on the surface of a function.
+}
+
+@defproc[(isoline3d ...) renderer3d?]{
+A synonym of @(racket contour3d).
+}
 
 @doc-apply[contours3d]{
 Returns a renderer that plots contour lines on the surface of a function.
@@ -110,6 +118,10 @@ For example,
                                       #:legend-anchor 'top-left)]
 }
 
+@defproc[(isolines3d ...) renderer3d?]{
+A synonym of @(racket contours3d).
+}
+
 @doc-apply[contour-intervals3d]{
 Returns a renderer that plots contour intervals and contour lines on the surface of a function.
 The appearance keyword arguments are interpreted identically to the appearance keyword arguments to @(racket contour-intervals).
@@ -121,6 +133,10 @@ For example,
                                       #:legend-anchor 'top-left)]
 }
 
+@defproc[(isoline-intervals3d ...) renderer3d?]{
+A synonym of @(racket contour-intervals3d).
+}
+
 @section{3D Isosurface Renderers}
 
 @doc-apply[isosurface3d]{
diff --git a/collects/plot/tests/contour-labels-test.rkt b/collects/plot/tests/contour-labels-test.rkt
new file mode 100644
index 0000000000..c4a86348ee
--- /dev/null
+++ b/collects/plot/tests/contour-labels-test.rkt
@@ -0,0 +1,103 @@
+#lang racket
+
+(require plot plot/utils plot/common/contract-doc)
+
+(struct label-params (score z z-ivl str v) #:transparent)
+
+(define (dnorm x m s^2)
+  (* (/ 1 (sqrt (* 2 pi s^2))) (exp (* -1/2 (/ (sqr (- x m)) s^2)))))
+
+(define ((contour-labels-render-proc f g levels samples color size family alpha) area)
+  (let/ec return
+    (define-values (x-min x-max y-min y-max) (send area get-bounds))
+    (match-define (list xs ys zss) (g x-min x-max samples y-min y-max samples))
+    
+    (define-values (z-min z-max)
+      (let ([zs  (filter regular? (2d-sample->list zss))])
+        (when (empty? zs) (return empty))
+        (values (apply min* zs) (apply max* zs))))
+    
+    (define z-ticks (contour-ticks z-min z-max levels #f))
+    (define zs (map pre-tick-value z-ticks))
+    
+    (send area set-text-foreground color)
+    (send area set-font size family)
+    (send area set-alpha alpha)
+    (define labels
+      (append*
+       (for/list ([z-tick  (in-list z-ticks)])
+        (match-define (tick z major? label) z-tick)
+        (for/list ([ya  (in-list ys)]
+                   [yb  (in-list (rest ys))]
+                   [zs0  (in-vector zss)]
+                   [zs1  (in-vector zss 1)]
+                   #:when #t
+                   [xa  (in-list xs)]
+                   [xb  (in-list (rest xs))]
+                   [z1  (in-vector zs0)]
+                   [z2  (in-vector zs0 1)]
+                   [z3  (in-vector zs1 1)]
+                   [z4  (in-vector zs1)]
+                   #:when #t
+                   [line  (in-list (heights->lines xa xb ya yb z z1 z2 z3 z4))])
+          (match-define (vector x y _) (vcenter line))
+          (label-params 0 z
+                        (ivl (min* z1 z2 z3 z4) (max* z1 z2 z3 z4))
+                        label (send area plot->dc (vector x y)))))))
+    
+    (match-define (vector dc-x-min dc-y-min) (send area plot->dc (vector x-min y-min)))
+    (match-define (vector dc-x-max dc-y-max) (send area plot->dc (vector x-max y-max)))
+    
+    (define x-sigma (/ (plot-width) samples))
+    (define y-sigma (/ (plot-height) samples))
+    (define z-sigma (/ (- z-max z-min) (length z-ticks)))
+    
+    (define new-labels
+      (for/fold ([labels labels]) ([keep  (in-list (list 4))])
+        (define new-labels
+          (for/list ([l1  (in-list labels)])
+            (match-define (label-params s1 z1 (ivl z1-min z1-max) str1 (vector x1 y1)) l1)
+            (define new-score
+              (apply + (for/list ([l2  (in-list labels)])
+                         (match-define (label-params s2 z2 _ str2 (vector x2 y2)) l2)
+                         (* (exp (* -1/2 (sqr (/ (- s1 s2) 1))))
+                            (exp (* -1/2 (sqr (/ (- x1 x2) x-sigma))))
+                            (exp (* -1/2 (sqr (/ (- y1 y2) y-sigma))))
+                            (exp (* -1/2 (sqr (/ (- z1 z2) z-sigma))))
+                            ))))
+            (label-params new-score z1 (ivl z1-min z1-max) str1 (vector x1 y1))))
+        (append*
+         (for/list ([z  (in-list zs)])
+           (define z-labels (sort (filter (λ (l) (= z (label-params-z l))) new-labels)
+                                  > #:key label-params-score))
+           #;(define keep (min 4 (length z-labels) (round (* 1/8 (length z-labels)))))
+           (take z-labels (min keep (length z-labels)))))))
+    
+    (for ([label  (in-list new-labels)])
+      (match-define (label-params score z _ str (vector x y)) label)
+      (send area draw-text #;(real->plot-label score 3) str (vector x y) 'center 0 #:outline? #t))
+    
+    empty))
+
+(defproc (contour-labels
+          [f (real? real? . -> . real?)]
+          [x-min (or/c real? #f) #f] [x-max (or/c real? #f) #f]
+          [y-min (or/c real? #f) #f] [y-max (or/c real? #f) #f]
+          [#:levels levels (or/c 'auto exact-positive-integer? (listof real?)) (contour-levels)]
+          [#:samples samples (and/c exact-integer? (>=/c 2)) (contour-samples)]
+          [#:color color plot-color/c (plot-foreground)]
+          [#:size size (>=/c 0) (plot-font-size)]
+          [#:family family font-family/c (plot-font-family)]
+          [#:alpha alpha (real-in 0 1) (label-alpha)]
+          ) renderer2d?
+  (define g (2d-function->sampler f))
+  (renderer2d (vector (ivl x-min x-max) (ivl y-min y-max)) #f #f
+              (contour-labels-render-proc f g levels samples color size family alpha)))
+
+;(contour-samples 11)
+;(plot-z-max-ticks 50)
+#;
+(parameterize (#;[plot-x-transform  log-transform]
+               #;[plot-y-transform  log-transform])
+  (plot (list (contours (λ (x y) (sqrt (+ (sqr x) (sqr y)))) -1 4 -1 4)
+              (contour-labels (λ (x y) (sqrt (+ (sqr x) (sqr y))))))))