From 529757af89f68a451de2e62c062efbacea3cde72 Mon Sep 17 00:00:00 2001
From: Kevin Tew <kevin.tew@gmail.com>
Date: Sun, 22 Jan 2023 21:49:58 -0700
Subject: [PATCH] Add raw-lines that doesn't subdivide when a non-identity axis
 transform is used

---
 plot-lib/plot/no-gui.rkt                   |  1 +
 plot-lib/plot/private/plot2d/line.rkt      | 49 ++++++++++++++++++++++
 plot-lib/plot/private/plot2d/plot-area.rkt | 16 +++++++
 3 files changed, 66 insertions(+)

diff --git a/plot-lib/plot/no-gui.rkt b/plot-lib/plot/no-gui.rkt
index 1a9cdc47..cfb4ca64 100644
--- a/plot-lib/plot/no-gui.rkt
+++ b/plot-lib/plot/no-gui.rkt
@@ -64,6 +64,7 @@
 
 (require "private/plot2d/line.rkt")
 (provide
+ raw-lines
  lines
  parametric
  polar
diff --git a/plot-lib/plot/private/plot2d/line.rkt b/plot-lib/plot/private/plot2d/line.rkt
index 1337492e..3de77b2d 100644
--- a/plot-lib/plot/private/plot2d/line.rkt
+++ b/plot-lib/plot/private/plot2d/line.rkt
@@ -63,6 +63,55 @@
                             (and label (λ (_) (line-legend-entry label color width style)))
                             (lines-render-proc vs color width style alpha)))]))]))
 
+(: raw-lines-render-proc (-> (Listof (Vectorof Real))
+                         Plot-Color Nonnegative-Real Plot-Pen-Style
+                         Nonnegative-Real
+                         2D-Render-Proc))
+(define ((raw-lines-render-proc vs color width style alpha) area)
+  (send area put-alpha alpha)
+  (send area put-pen color width style)
+  (send area put-raw-lines vs))
+
+(:: raw-lines
+    (->* [(Sequenceof (Sequenceof Real))]
+         [#:x-min (U Real #f) #:x-max (U Real #f)
+          #:y-min (U Real #f) #:y-max (U Real #f)
+          #:color Plot-Color
+          #:width Nonnegative-Real
+          #:style Plot-Pen-Style
+          #:alpha Nonnegative-Real
+          #:label (U String pict #f)]
+         renderer2d))
+(define (raw-lines vs
+               #:x-min [x-min #f] #:x-max [x-max #f]
+               #:y-min [y-min #f] #:y-max [y-max #f]
+               #:color [color (line-color)]
+               #:width [width (line-width)]
+               #:style [style (line-style)]
+               #:alpha [alpha (line-alpha)]
+               #:label [label #f])
+  (define fail/kw (make-raise-keyword-error 'raw-lines))
+  (cond
+    [(and x-min (not (rational? x-min)))  (fail/kw "#f or rational" '#:x-min x-min)]
+    [(and x-max (not (rational? x-max)))  (fail/kw "#f or rational" '#:x-max x-max)]
+    [(and y-min (not (rational? y-min)))  (fail/kw "#f or rational" '#:y-min y-min)]
+    [(and y-max (not (rational? y-max)))  (fail/kw "#f or rational" '#:y-max y-max)]
+    [(not (rational? width))  (fail/kw "rational?" '#:width width)]
+    [(or (> alpha 1) (not (rational? alpha)))  (fail/kw "real in [0,1]" '#:alpha alpha)]
+    [else
+     (let ([vs  (sequence->listof-vector 'raw-lines vs 2)])
+       (define rvs (filter vrational? vs))
+       (cond [(empty? rvs)  empty-renderer2d]
+             [else
+              (match-define (list (vector #{rxs : (Listof Real)} #{rys : (Listof Real)}) ...) rvs)
+              (let ([x-min  (if x-min x-min (apply min* rxs))]
+                    [x-max  (if x-max x-max (apply max* rxs))]
+                    [y-min  (if y-min y-min (apply min* rys))]
+                    [y-max  (if y-max y-max (apply max* rys))])
+                (renderer2d (vector (ivl x-min x-max) (ivl y-min y-max)) #f default-ticks-fun
+                            (and label (λ (_) (line-legend-entry label color width style)))
+                            (raw-lines-render-proc vs color width style alpha)))]))]))
+
 (:: parametric
     (->* [(-> Real (Sequenceof Real)) Real Real]
          [#:x-min (U Real #f) #:x-max (U Real #f)
diff --git a/plot-lib/plot/private/plot2d/plot-area.rkt b/plot-lib/plot/private/plot2d/plot-area.rkt
index 35d5c7bb..b5478fe7 100644
--- a/plot-lib/plot/private/plot2d/plot-area.rkt
+++ b/plot-lib/plot/private/plot2d/plot-area.rkt
@@ -62,6 +62,7 @@
          [reset-drawing-params (-> Void)]
          [put-arrow-head (-> (U (List '= Nonnegative-Real) Nonnegative-Real) Nonnegative-Real Void)]
          [put-lines (-> (Listof (Vectorof Real)) Void)]
+         [put-raw-lines (-> (Listof (Vectorof Real)) Void)]
          [put-line (-> (Vectorof Real) (Vectorof Real) Void)]
          [put-polygon (-> (Listof (Vectorof Real)) Void)]
          [put-rect (-> Rect Void)]
@@ -844,6 +845,21 @@
                                vs)])
                 (send pd draw-lines vs)))))))
 
+    (define/public (put-raw-lines vs)
+      (for ([vs  (in-list (exact-vector2d-sublists vs))])
+        (let ([vss  (if clipping?
+                        (clip-lines/bounds vs
+                                           clip-x-min clip-x-max
+                                           clip-y-min clip-y-max)
+                        (list vs))])
+          (for ([vs  (in-list vss)])
+            (unless (empty? vs)
+              (let* (
+                     [vs  (map (λ ([v : (Vectorof Real)])
+                                 (plot->dc v))
+                               vs)])
+                (send pd draw-lines vs)))))))
+
     (define/public (put-line v1 v2)
       (let ([v1  (exact-vector2d v1)]
             [v2  (exact-vector2d v2)])