add arrows and arrows3d renderers (#67)

The `arrows` and `arrows3d` renderers allow drawing connected arrows,
specified either as a list of points or as a point + magnitude vector, with
both 2D and 3D variants available.

Two new parameters are introduced for controlling the arrow head length and
opening angle.

Co-authored-by: pbpf <[email protected]>
Co-authored-by: Alex Harsanyi <[email protected]>

Author: 3 people

plot-doc/plot/scribblings/params.scrbl

@@ -268,7 +268,7 @@ Used as default keyword arguments of @racket[point-label], @racket[function-labe
 @racket[inverse-label], @racket[parametric-label], @racket[polar-label] and @racket[point-label3d].
 }
 
-@section{Vector Fields}
+@section{Vector Fields & Arrows}
 
 @deftogether[((defparam vector-field-samples n exact-positive-integer? #:value 20)
               (defparam vector-field3d-samples n exact-positive-integer? #:value 9))]{
@@ -283,6 +283,22 @@ The default number of samples @racket[vector-field] and @racket[vector-field3d]
 The default pen color, pen width, pen style, scaling factor, and opacity used by
 @racket[vector-field] and @racket[vector-field3d].
 }
+@deftogether[((defparam arrows-color color plot-color/c #:value 1)
+              (defparam arrows-line-width width (>=/c 0) #:value 2/3)
+              (defparam arrows-line-style style plot-pen-style/c #:value 'solid)
+              (defparam arrows-alpha alpha (real-in 0 1) #:value 1))]{
+The default pen color, pen width, pen style, and opacity used by
+@racket[arrows] and @racket[arrows3d].
+@history[#:added "7.9"]
+}
+
+@deftogether[((defparam arrow-head-size-or-scale size (or/c (>=/c 0) (list/c '= (>=/c 0))) #:value 2/5)
+              (defparam arrow-head-angle alpha (>=/c 0) #:value (/ pi 6)))]{
+The default size and angle of the arrow head in @racket[vector-field], @racket[vector-field3d], @racket[arrows] and @racket[arrows3d].
+When the @racket[arrow-head-size-or-scale] is a number, it is interpreted as a proportion of the arrow length , and will be bigger for longer arrows. When it is in the form @racket[(list '= size)], it is interpreted as the size of the arrow head in drawing units (pixels).
+@history[#:added "7.9"]
+}
+
 
 @section{Error Bars}
 

plot-doc/plot/scribblings/renderer2d.scrbl

@@ -145,12 +145,14 @@ If @(racket scale) is a real number, arrow lengths are multiplied by @(racket sc
 If @(racket 'auto), the scale is calculated in a way that keeps arrows from overlapping.
 If @(racket 'normalized), each arrow is made the same length: the maximum length that would have been allowed by @(racket 'auto).
 
+The shape of the arrow-head can be controlled with @racket[arrow-head-size-or-scale] and @racket[arrow-head-angle].
+
 An example of automatic scaling:
 @interaction[#:eval plot-eval
                     (plot (vector-field (λ (x y) (vector (+ x y) (- x y)))
                                         -2 2 -2 2))]
 
-@history[#:changed "7.9" "Added support for pictures for #:label"]
+@history[#:changed "7.9" "Added support for pictures for #:label and controlling the arrowhead"]
 }
 
 @defproc[(error-bars
@@ -346,6 +348,40 @@ For example, to plot an estimated density of the triangle distribution:
 @history[#:changed "7.9" "Added support for pictures for #:label"]
 }
 
+
+@defproc[(arrows [vs  (or/c (listof (sequence/c #:min-count 2 real?))
+                            (vectorof (vector/c (sequence/c #:min-count 2 real?)
+                                                (sequence/c #:min-count 2 real?))))]
+                 [#:x-min x-min (or/c rational? #f) #f] [#:x-max x-max (or/c rational? #f) #f]
+                 [#:y-min y-min (or/c rational? #f) #f] [#:y-max y-max (or/c rational? #f) #f]
+                 [#:color color plot-color/c (arrows-color)]
+                 [#:width width (>=/c 0) (arrows-line-width)]
+                 [#:style style plot-pen-style/c (arrows-line-style)]
+                 [#:alpha alpha (real-in 0 1) (arrows-alpha)]
+                 [#:arrow-head-size-or-scale size (or/c (list/c '= (>=/c 0)) (>=/c 0)) (arrow-head-size-or-scale)]
+                 [#:arrow-head-angle angle (>=/c 0) (arrow-head-angle)]
+                 [#:label label (or/c string? pict? #f) #f]
+                 ) renderer2d?]{
+Returns a renderer which draws arrows. Arrows can be specified either as sequences of 2D points,
+in this case they will be drawn as connected arrows between each two adjacent points,
+or they can be specified as an origin point and a rectangular magnitude vector, in which case each arrow
+is drawn individually. See example below.
+
+In @racket[vs] list and vector are interchangeable. Arrow-heads are only drawn when the endpoint is inside the drawing area.
+ @interaction[#:eval plot-eval
+              (plot (list
+                     (arrows
+                      `((0 0) (2 1) (3 3) (0 0))
+                      #:arrow-head-size-or-scale '(= 20)
+                      #:arrow-head-angle .2
+                      #:color 6 #:label "a+b+c=0")
+                     (arrows
+                      `(((2 0) (0 1)) ((3 0) (-1 1)))
+                      #:arrow-head-size-or-scale .2
+                      #:color 2 #:label "d")))]
+@history[#:added "7.9"]
+}
+
 @defproc[(hrule [y real?]
                 [x-min (or/c rational? #f) #f] [x-max (or/c rational? #f) #f]
                 [#:color color plot-color/c (line-color)]

plot-doc/plot/scribblings/renderer3d.scrbl

@@ -21,7 +21,7 @@ See @secref["renderer2d-function-arguments"] for a detailed example.
 @section{3D Point Renderers}
 
 @defproc[(points3d
-          [vs  (sequence/c (sequence/c #:min-count 3 real?))]
+          [vs (sequence/c (sequence/c #:min-count 3 real?))]
           [#:x-min x-min (or/c rational? #f) #f] [#:x-max x-max (or/c rational? #f) #f]
           [#:y-min y-min (or/c rational? #f) #f] [#:y-max y-max (or/c rational? #f) #f]
           [#:z-min z-min (or/c rational? #f) #f] [#:z-max z-max (or/c rational? #f) #f]
@@ -86,7 +86,7 @@ The arguments are interpreted identically to the corresponding arguments to @rac
                  (plot3d (vector-field3d (λ (x y z) (vector x z y))
                                          -2 2 -2 2 -2 2))]
 
-@history[#:changed "7.9" "Added support for pictures for #:label"]
+@history[#:changed "7.9" "Added support for pictures for #:label and controlling the arrowhead"]
 }
 
 @section{3D Line Renderers}
@@ -131,6 +131,28 @@ Returns a renderer that plots a vector-valued function of time. For example,
 @history[#:changed "7.9" "Added support for pictures for #:label"]
 }
 
+@defproc[(arrows3d
+          [vs (or/c (listof (sequence/c #:min-count 3 real?))
+                    (vectorof (vector/c (sequence/c #:min-count 3 real?)
+                                        (sequence/c #:min-count 3 real?))))]
+          [#:x-min x-min (or/c rational? #f) #f] [#:x-max x-max (or/c rational? #f) #f]
+          [#:y-min y-min (or/c rational? #f) #f] [#:y-max y-max (or/c rational? #f) #f]
+          [#:z-min z-min (or/c rational? #f) #f] [#:z-max z-max (or/c rational? #f) #f]
+          [#:color color plot-color/c (arrows-color)]
+          [#:width width (>=/c 0) (arrows-line-width)]
+          [#:style style plot-pen-style/c (arrows-line-style)]
+          [#:alpha alpha (real-in 0 1) (arrows-alpha)]
+          [#:arrow-head-size-or-scale size (or/c (list/c '= (>=/c 0)) (>=/c 0)) (arrow-head-size-or-scale)]
+          [#:arrow-head-angle angle (>=/c 0) (arrow-head-angle)]
+          [#:label label (or/c string? pict? #f) #f]
+          ) renderer3d?]{
+Returns a renderer that draws arrows. The arguments and arrow-head parameters are interpreted identically as in @racket[arrows].
+@interaction[#:eval plot-eval
+             (plot3d (arrows3d `((0 0 0) (1 1 1) (2 2 2) (3 2 1)))
+                       #:altitude 25)]
+@history[#:added "7.9"]
+}
+
 @section{3D Surface Renderers}
 
 @defproc[(surface3d

plot-lib/plot/no-gui.rkt

@@ -55,6 +55,10 @@
 (provide
  color-field)
 
+(require "private/plot2d/arrows.rkt")
+(provide
+ arrows)
+
 (require "private/plot2d/line.rkt")
 (provide
  lines
@@ -134,6 +138,10 @@
  contours3d
  contour-intervals3d)
 
+(require "private/plot3d/arrows.rkt")
+(provide
+ arrows3d)
+
 (require "private/plot3d/line.rkt")
 (provide
  lines3d

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

@@ -3,14 +3,14 @@
 (module untyped-defs racket/base
   (require "parameters.rkt"
            "parameter-group.rkt")
-  
+
   (provide (all-defined-out))
-  
+
   (define-parameter-group plot-axes?
     (plot-x-axis? plot-x-far-axis?
                   plot-y-axis? plot-y-far-axis?
                   plot-z-axis? plot-z-far-axis?))
-  
+
   (define-parameter-group plot-tick-labels
     (plot-x-tick-labels?
      plot-x-tick-label-anchor
@@ -24,7 +24,7 @@
      plot-y-far-tick-labels?
      plot-y-far-tick-label-anchor
      plot-y-far-tick-label-angle))
-  
+
   (define-parameter-group plot-appearance
     (plot-width
      plot-height
@@ -38,29 +38,31 @@
      plot-decorations?
      plot-animating?
      plot-pen-color-map
-     plot-brush-color-map))
-  
+     plot-brush-color-map
+     arrow-head-size-or-scale
+     arrow-head-angle))
+
   (define-parameter-group plot3d-appearance
     (plot3d-samples
      plot3d-angle
      plot3d-altitude
      plot3d-ambient-light
      plot3d-diffuse-light?
      plot3d-specular-light?))
-  
+
   (define-parameter-group plot-output
     (plot-new-window? plot-jpeg-quality plot-ps/pdf-interactive? plot-ps-setup))
-  
+
   (define-parameter-group plot-labels
     (plot-title
      plot-x-label plot-y-label plot-z-label
      plot-x-far-label plot-y-far-label plot-z-far-label))
-  
+
   (define-parameter-group plot-x-axis (plot-x-transform plot-x-ticks plot-x-far-ticks))
   (define-parameter-group plot-y-axis (plot-y-transform plot-y-ticks plot-y-far-ticks))
   (define-parameter-group plot-z-axis (plot-z-transform plot-z-ticks plot-z-far-ticks))
   (define-parameter-group plot-axes (plot-x-axis plot-y-axis plot-z-axis plot-d-ticks plot-r-ticks))
-  
+
   (define-parameter-group plot-parameters
     (plot-appearance
      plot3d-appearance
@@ -77,11 +79,12 @@
            "types.rkt"
            "axis-transform.rkt"
            "ticks.rkt")
-  
+
   (provide Plot-Parameters)
-  
+
   (deftype Plot-Parameters
     (List
+     ;; plot-appearance
      (List
       Positive-Integer
       Positive-Integer
@@ -104,8 +107,12 @@
       Boolean
       Boolean
       (U Symbol #f)
-      (U Symbol #f))
+      (U Symbol #f)
+      (U (List '= Nonnegative-Real) Nonnegative-Real)
+      Nonnegative-Real)
+     ;;plot3d-appearance
      (List Positive-Integer Real Real Nonnegative-Real Boolean Boolean)
+     ;;plot-labels
      (List
       (U False String pict)
       (U False String pict)
@@ -114,14 +121,16 @@
       (U False String pict)
       (U False String pict)
       (U False String pict))
+     ;;plot-output
      (List Boolean Nonnegative-Integer Boolean (Instance PS-Setup%))
+     ;;plot-axes
      (List
       (List Axis-Transform ticks ticks)
       (List Axis-Transform ticks ticks)
       (List Axis-Transform ticks ticks)
       ticks
       ticks)))
-  
+
   (define (test) (ann (plot-parameters) Plot-Parameters)))
 
 (require 'untyped-defs

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

@@ -212,6 +212,16 @@
 (defparam2 vector-field-alpha Real Nonnegative-Real 1 (unit-ivl 'vector-field-alpha))
 (defparam vector-field3d-samples Positive-Integer 9)
 
+;;arrow
+
+(defparam  arrows-color Plot-Color 1)
+(defparam2 arrows-line-width Real Nonnegative-Real 2/3
+  (nonnegative-rational 'arrows-line-width))
+(defparam  arrows-line-style Plot-Pen-Style 'solid)
+(defparam2 arrows-alpha Real Nonnegative-Real 1 (unit-ivl 'arrows-alpha))
+(defparam  arrow-head-size-or-scale (U Nonnegative-Real (List '= Nonnegative-Real)) 2/5)
+(defparam  arrow-head-angle Nonnegative-Real 0.5235987755982988);=pi/6=30°
+
 ;; Error bars
 
 (defparam2 error-bar-width Real Nonnegative-Real 6 (nonnegative-rational 'error-bar-width))

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

@@ -306,6 +306,21 @@
     (define/public (set-text-foreground color)
       (send dc set-text-foreground (color->color% (->pen-color color))))
 
+
+    ;; -----------------------------------------------------------------------------------------------
+    ;; Arrows
+
+    (: pd-arrow-head-size-or-scale (U (List '= Nonnegative-Real) Nonnegative-Real))
+    (: pd-arrow-head-angle Nonnegative-Real)
+    (define pd-arrow-head-size-or-scale (arrow-head-size-or-scale))
+    (define pd-arrow-head-angle (arrow-head-angle))
+
+    ;; Sets the arrow-head shape (for draw-arrow)
+    (define/public (set-arrow-head size-or-scale angle)
+      (set! pd-arrow-head-size-or-scale size-or-scale)
+      (set! pd-arrow-head-angle angle))
+
+
     ;; -----------------------------------------------------------------------------------------------
     ;; Clipping
 
@@ -410,12 +425,15 @@
         (define dy (- y2 y1))
         (define angle (if (and (zero? dy) (zero? dx)) 0 (atan dy dx)))
         (define dist (sqrt (+ (sqr dx) (sqr dy))))
-        (define head-r (* 2/5 dist))
-        (define head-angle (* 1/6 pi))
-        (define dx1 (* (cos (+ angle head-angle)) head-r))
-        (define dy1 (* (sin (+ angle head-angle)) head-r))
-        (define dx2 (* (cos (- angle head-angle)) head-r))
-        (define dy2 (* (sin (- angle head-angle)) head-r))
+        (define head-r
+          (let ([size-or-scale pd-arrow-head-size-or-scale])
+            (if (list? size-or-scale)
+                (cadr size-or-scale)
+                (* size-or-scale dist))))
+        (define dx1 (* (cos (+ angle pd-arrow-head-angle)) head-r))
+        (define dy1 (* (sin (+ angle pd-arrow-head-angle)) head-r))
+        (define dx2 (* (cos (- angle pd-arrow-head-angle)) head-r))
+        (define dy2 (* (sin (- angle pd-arrow-head-angle)) head-r))
         (send dc draw-line x1 y1 x2 y2)
         (send dc draw-line x2 y2 (- x2 dx1) (- y2 dy1))
         (send dc draw-line x2 y2 (- x2 dx2) (- y2 dy2))))

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

@@ -27,7 +27,7 @@
 (deftype Plot-Color
   (U Integer Color))
 
-(deftype Color-Map (Vectorof (List Byte Byte Byte))) 
+(deftype Color-Map (Vectorof (List Byte Byte Byte)))
 
 (deftype Plot-Pen-Style-Sym
   (U 'transparent 'solid    'dot 'long-dash
@@ -84,8 +84,8 @@
 (deftype Contour-Levels (U 'auto Positive-Integer (Listof Real)))
 
 (define-type Image-File-Format
-  (U 'png 'jpeg 
-     'xbm 'xpm 'bmp 
+  (U 'png 'jpeg
+     'xbm 'xpm 'bmp
      'ps 'pdf 'svg))
 
 (deftype Legend-Draw-Proc (-> (Instance Plot-Device%) Real Real Void))
@@ -116,6 +116,7 @@
    [get-text-extent (-> (U String pict) (Values Exact-Rational Exact-Rational Exact-Rational Exact-Rational))]
    [get-text-width (-> (U String pict) Exact-Rational)]
    [set-text-foreground (-> Plot-Color Void)]
+   [set-arrow-head (-> (U (List '= Nonnegative-Real) Nonnegative-Real) Nonnegative-Real Void)]
    [set-clipping-rect (-> Rect Void)]
    [clear-clipping-rect (-> Void)]
    [clear (-> Void)]