Allow controlling line ending caps for plots (#6) (#123)

* Add `line-cap` and `plot-line-cap` parameters (#6)

... they control the line endings for plotted elements (`line-cap`) and the
plot decorations, such as axis ticks (`plot-line-cap`).

Previously all line endings were round, creating a "crayon" style effect,
visible for lines whose width is greater than 1.

Also fixed a bug with `hrule`, `vrule` renderers, which attempted to use
`'butt` style: since pens were cached, if `vrule` created a pen, all
subsequent uses of that pen (same color and width) would use `'butt` line
endings, OTOH, if `vrule` reused a pen, because a pen if the same color and
width was previously used, the `vrule` line ending would be `'round`

Author: alex-hhh

plot-doc/plot/scribblings/contracts.scrbl

@@ -101,6 +101,15 @@ The contract for @(racket #:style) arguments when they refer to lines, and param
 For the meaning of integer pen styles, see @(racket ->pen-style).
 }
 
+@defthing[plot-pen-cap/c contract? #:value (one-of/c 'round 'projecting 'butt)]{
+
+  The contract for caps, or line endings, for lines drawn on the plot.  Used
+  by the @racket[plot-line-cap] and @racket[line-cap] parameters.
+
+  @history[#:added "8.10"]
+
+}
+
 @defthing[plot-brush-style/c contract? #:value (or/c exact-integer?
                                                      (one-of/c 'transparent      'solid
                                                                'bdiagonal-hatch  'fdiagonal-hatch 'crossdiag-hatch

plot-doc/plot/scribblings/params.scrbl

@@ -108,6 +108,15 @@ Amount of ambient light, and whether 3D plots are rendered with diffuse and spec
   @racket[lines], is controlled by the @racket[line-width] parameter.
 }
 
+@defparam[plot-line-cap cap plot-pen-cap/c #:value 'round]{
+  
+  The cap of the lines used to draw plot axes and other non-renderer elements.
+  See also @racket[line-cap].
+
+  @history[#:added "8.10"]
+
+}
+
 @deftogether[((defparam plot-foreground color plot-color/c #:value 0)
               (defparam plot-background color plot-color/c #:value 0))]{
 The plot foreground and background color.
@@ -254,11 +263,21 @@ Used as a default keyword argument in @racket[function], @racket[inverse], @rack
 @deftogether[((defparam line-color color plot-color/c #:value 1)
               (defparam line-width width (>=/c 0) #:value 1)
               (defparam line-style style plot-pen-style/c #:value 'solid)
+              (defparam line-cap cap plot-pen-cap/c #:value 'round)
               (defparam line-alpha alpha (real-in 0 1) #:value 1))]{
-The pen color, pen width, pen style and opacity of lines in plots.
-Used as default keyword arguments of @racket[function], @racket[inverse], @racket[lines],
-@racket[parametric], @racket[polar], @racket[density], @racket[isoline], @racket[lines3d],
-@racket[parametric3d] and @racket[isoline3d].
+  
+  The pen color, pen width, pen style, pen cap and opacity of lines in plots.
+
+  Except for @racket[line-cap], all other parameters are used as default
+  keyword arguments of @racket[function], @racket[inverse], @racket[lines],
+  @racket[parametric], @racket[polar], @racket[density], @racket[isoline],
+  @racket[lines3d], @racket[parametric3d] and @racket[isoline3d].
+
+  The @racket[line-cap] parameter applies to lines drawn by renderers in a
+  plot.  See also @racket[plot-line-cap].
+
+  @history[#:added "8.10"]
+
 }
 
 @section{Intervals}

plot-lib/plot/private/common/contract.rkt

@@ -53,6 +53,8 @@
                                (one-of/c 'transparent 'solid    'dot 'long-dash
                                          'short-dash  'dot-dash)))
 
+(define plot-pen-cap/c (one-of/c 'round 'butt 'projecting))
+
 (define plot-brush-style/c (or/c exact-integer?
                                  (one-of/c 'transparent      'solid
                                            'bdiagonal-hatch  'fdiagonal-hatch 'crossdiag-hatch

plot-lib/plot/private/common/parameter-groups.rkt

@@ -40,7 +40,9 @@
      plot-pen-color-map
      plot-brush-color-map
      arrow-head-size-or-scale
-     arrow-head-angle))
+     arrow-head-angle
+     plot-line-cap
+     line-cap))
 
   (define-parameter-group plot3d-appearance
     (plot3d-samples
@@ -110,7 +112,9 @@
       (U Symbol #f)
       (U Symbol #f)
       (U (List '= Nonnegative-Real) Nonnegative-Real)
-      Nonnegative-Real)
+      Nonnegative-Real
+      Plot-Pen-Cap
+      Plot-Pen-Cap)
      ;;plot3d-appearance
      (List Positive-Integer Real Real Nonnegative-Real Boolean Boolean)
      ;;plot-labels

plot-lib/plot/private/common/parameters.rkt

@@ -68,6 +68,7 @@
 (defparam2 plot-foreground-alpha alpha Real Nonnegative-Real 1 (unit-ivl 'plot-foreground-alpha))
 (defparam2 plot-background-alpha alpha Real Nonnegative-Real 1 (unit-ivl 'plot-background-alpha))
 (defparam2 plot-line-width width Real Nonnegative-Real 1 (nonnegative-rational 'plot-line-width))
+(defparam plot-line-cap Plot-Pen-Cap 'round)
 (defparam2 plot-tick-size size Real Nonnegative-Real 10 (nonnegative-rational 'plot-tick-size))
 (defparam2 plot-font-size size Real Nonnegative-Real 11 (nonnegative-rational 'plot-font-size))
 (defparam plot-font-face face (U String #f) #f)
@@ -179,6 +180,7 @@
 (defparam line-color Plot-Color 1)
 (defparam2 line-width Real Nonnegative-Real 1 (nonnegative-rational 'line-width))
 (defparam line-style Plot-Pen-Style 'solid)
+(defparam line-cap Plot-Pen-Cap 'round)
 (defparam2 line-alpha Real Nonnegative-Real 1 (unit-ivl 'line-alpha))
 
 ;; Intervals

plot-lib/plot/private/common/plot-device.rkt

@@ -172,7 +172,7 @@
     ;; -----------------------------------------------------------------------------------------------
     ;; Pen, brush, alpha parameters
 
-    (define pen-hash ((inst make-hash (Vector Integer Integer Integer Real) (Instance Pen%))))
+    (define pen-hash ((inst make-hash (Vector Integer Integer Integer Real Symbol) (Instance Pen%))))
     (define transparent-pen (make-pen% 0 0 0 1 'transparent 'round))
 
     (: pen-color (List Real Real Real))
@@ -185,7 +185,7 @@
     ;; Sets the pen, using a hash table to avoid making duplicate objects. At time of writing (and for
     ;; the forseeable future) this is much faster than using a pen-list%, because it doesn't have to
     ;; synchronize access. It's also not thread-safe.
-    (define/public (set-pen color width style [cap 'round])
+    (define/public (set-pen color width style [cap (line-cap)])
       (set! pen-style (->pen-style style))
       (cond [(eq? pen-style 'transparent)
              (set! pen-color '(0 0 0))
@@ -198,16 +198,16 @@
                                  (app real->color-byte g)
                                  (app real->color-byte b))
                pen-color)
-             (send dc set-pen (hash-ref! pen-hash (vector r g b width)
+             (send dc set-pen (hash-ref! pen-hash (vector r g b width cap)
                                          (λ () (make-pen% r g b width 'solid cap))))]))
 
     ;; Sets the pen used to draw major ticks.
     (define/public (set-major-pen [style 'solid])
-      (set-pen (plot-foreground) (plot-line-width) style))
+      (set-pen (plot-foreground) (plot-line-width) style (plot-line-cap)))
 
     ;; Sets the pen used to draw minor ticks.
     (define/public (set-minor-pen [style 'solid])
-      (set-pen (plot-foreground) (* 1/2 (plot-line-width)) style))
+      (set-pen (plot-foreground) (* 1/2 (plot-line-width)) style (plot-line-cap)))
 
     (define brush-hash ((inst make-hash (Vector Integer Integer Integer Symbol) (Instance Brush%))))
     (define transparent-brush (make-brush% 0 0 0 'transparent))

plot-lib/plot/private/common/types.rkt

@@ -37,6 +37,9 @@
 (deftype Plot-Pen-Style
   (U Integer Plot-Pen-Style-Sym))
 
+(deftype Plot-Pen-Cap
+  (U 'round 'projecting 'butt))
+
 (deftype Plot-Brush-Style-Sym
   (U 'transparent      'solid
      'bdiagonal-hatch  'fdiagonal-hatch 'crossdiag-hatch
@@ -164,4 +167,4 @@
    [draw-legend (-> (Listof legend-entry) Rect Void)]))
 
 (require "plotmetrics.rkt")
-(provide Plot-Metrics<%> Plot-Pict Plot-Metrics-Functions)
+(provide Plot-Metrics<%> Plot-Pict Plot-Metrics-Functions)

plot-lib/plot/private/plot2d/line.rkt

@@ -230,7 +230,7 @@
            (ivl->plot-label (ivl x-min x-max)) (ivl->plot-label (ivl y-min y-max))))
 
   (send area put-alpha alpha)
-  (send area put-pen color width style 'butt)
+  (send area put-pen color width style)
   (case h/v
     [(h) (send area put-line (vector (or v-min x-min) v) (vector (or v-max x-max) v))]
     [(v) (send area put-line (vector v (or v-min y-min)) (vector v (or v-max y-max)))]))

plot-lib/plot/private/plot2d/plot-area.rkt

@@ -803,7 +803,7 @@
 
     (define/public (put-alpha alpha) (send pd set-alpha alpha))
 
-    (define/public (put-pen color width style [cap 'round]) (send pd set-pen color width style cap))
+    (define/public (put-pen color width style [cap (line-cap)]) (send pd set-pen color width style cap))
     (define/public (put-major-pen [style 'solid]) (send pd set-major-pen style))
     (define/public (put-minor-pen [style 'solid]) (send pd set-minor-pen style))
 

plot-lib/plot/private/utils-and-no-gui.rkt

@@ -7,6 +7,7 @@
  Anchor
  Plot-Color
  Plot-Pen-Style
+ Plot-Pen-Cap
  Plot-Brush-Style
  Point-Sym
  List-Generator
@@ -93,6 +94,7 @@
  plot-background
  plot-background-alpha
  plot-line-width
+ plot-line-cap
  plot-tick-size
  plot-font-size
  plot-font-face
@@ -141,6 +143,7 @@
  line-color
  line-width
  line-style
+ line-cap
  line-alpha
  interval-color
  interval-style

plot-test/plot/tests/PRs/6.rkt

@@ -0,0 +1,41 @@
+#lang racket
+
+(require rackunit
+         plot racket/runtime-path
+         "../helpers.rkt")
+
+;; See https://github.com/racket/plot/issues/6 and associated discution.
+
+(define-runtime-path pr6-data-round "./test-data/pr6-round.dat")
+(define-runtime-path pr6-data-butt "./test-data/pr6-butt.dat")
+(define-runtime-path pr6-data-projecting "./test-data/pr6-projecting.dat")
+
+(define (do-plot-pr6 output-fn)
+  (parameterize
+      ([plot-line-width 10]
+       [line-width 10]
+       [plot-pen-color-map 'set1])
+    (output-fn
+     (list
+      (function sin -5 5 #:color 1 #:label "sin(x)")
+      (function cos -5 5 #:color 2 #:label "cos(x)")))))
+
+(define pr6-test-suite
+  (test-suite
+   "PR#6: Add plot-line-cap and line-cap parameters"
+   (test-case "pr6-round"
+     (parameterize ([plot-line-cap 'round]
+                    [line-cap 'round])
+       (check-draw-steps do-plot-pr6 pr6-data-round)))
+   (test-case "pr6-butt"
+     (parameterize ([plot-line-cap 'butt]
+                    [line-cap 'butt])
+       (check-draw-steps do-plot-pr6 pr6-data-butt)))
+   (test-case "pr6-projecting"
+     (parameterize ([plot-line-cap 'projecting]
+                    [line-cap 'projecting])
+       (check-draw-steps do-plot-pr6 pr6-data-projecting)))))
+
+(module+ test
+  (require rackunit/text-ui)
+  (run-tests pr6-test-suite))