Parametric surface3d

plot-doc/plot/scribblings/renderer3d.scrbl

@@ -182,6 +182,73 @@ Combining polar function renderers allows faking latitudes or longitudes in larg
                                              #:line-style 'transparent #:alpha 2/3))))]
 }
 
+@defproc[(parametric-surface3d
+          [f (real? real? . -> . (sequence/c real?))]
+          [s-min rational?][s-max rational?]
+          [t-min rational?][t-max rational?]
+          [#: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]
+          [#:samples samples (and/c exact-integer? (>=/c 2)) (plot3d-samples)]
+          [#:s-samples s-samples (and/c exact-integer? (>=/c 2)) samples]
+          [#:t-samples t-samples (and/c exact-integer? (>=/c 2)) samples]
+          [#:color color plot-color/c (surface-color)]
+          [#:style style plot-brush-style/c (surface-style)]
+          [#:line-color line-color plot-color/c (surface-line-color)]
+          [#:line-width line-width (>=/c 0) (surface-line-width)]
+          [#:line-style line-style plot-pen-style/c (surface-line-style)]
+          [#:alpha alpha (real-in 0 1) (surface-alpha)]
+          [#:label label (or/c string? #f) #f]
+          ) renderer3d?]{
+Returns a renderer that plots a two-input, one-output function. @racket[(f s t)] → @racket['(x y z)]
+
+For example,
+  @interaction[#:eval plot-eval
+               (plot3d (list
+                        (parametric-surface3d
+                         (λ (θ ϕ)
+                           (list (* (+ 5 (sin ϕ)) (sin θ))
+                                 (* (+ 5 (sin ϕ)) (cos θ))
+                                 (+ 0 (cos ϕ))))
+                         0 (* 2 pi) #:s-samples 50
+                         0 (* 2 pi)
+                         #:label "torus1")
+                        (parametric-surface3d
+                         (λ (θ ϕ)
+                           (list (+ 4 (* (+ 3 (sin ϕ)) (sin θ)))
+                                 (+ 0 (cos ϕ))
+                                 (* (+ 3 (sin ϕ)) (cos θ))))
+                         0 (* 2 pi) #:s-samples 30
+                         0 (* 2 pi)
+                         #:color 4
+                         #:label "torus2"))
+                       #:z-min -6 #:z-max 6
+                       #:altitude 22)]
+}
+
+@defproc[(polygons3d
+          [vs (sequence/c (sequence/c (sequence/c 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 (surface-color)]
+          [#:style style plot-brush-style/c (surface-style)]
+          [#:line-color line-color plot-color/c (surface-line-color)]
+          [#:line-width line-width (>=/c 0) (surface-line-width)]
+          [#:line-style line-style plot-pen-style/c (surface-line-style)]
+          [#:alpha alpha (real-in 0 1) (surface-alpha)]
+          [#:label label (or/c string? #f) #f]
+          ) renderer3d?]{
+Returns a renderer that draws polygons.
+The @racket[parametric-surface3d] function is defined in terms of this one.
+ @interaction[#:eval plot-eval (plot3d
+                                (polygons3d (list (list (list 1 0 0)(list 0 0 1)(list 0 1 0)(list 1 1 1))
+                                                  (list (list 0 0 0)(list 0 0 1)(list 0 1 0))
+                                                  (list (list 1 0 0)(list 0 1 0)(list 0 0 0))))
+                                #:angle 355
+                                #:altitude 30)]
+}
+
 @section{3D Contour (Isoline) Renderers}
 
 @defproc[(isoline3d

plot-lib/plot/no-gui.rkt

@@ -146,6 +146,11 @@
  isosurfaces3d
  polar3d)
 
+(require "private/plot3d/param-surf.rkt")
+(provide
+ polygons3d
+ parametric-surface3d)
+
 (require "private/plot3d/rectangle.rkt")
 (provide
  rectangles3d

plot-lib/plot/private/plot3d/param-surf.rkt

@@ -0,0 +1,187 @@
+#lang typed/racket/base
+
+(require typed/racket/class racket/match racket/list
+         plot/utils
+         "../common/type-doc.rkt"
+         "../common/utils.rkt")
+
+(provide (all-defined-out))
+
+;; ===================================================================================================
+(: polygons3d-render-proc (-> (-> (Listof (Listof (Vectorof Real))))
+                             Plot-Color Plot-Brush-Style
+                             Plot-Color Nonnegative-Real Plot-Pen-Style
+                             Nonnegative-Real
+                             (U #f String)
+                             3D-Render-Proc))
+(define ((polygons3d-render-proc vs-fun color style line-color line-width line-style alpha label)
+         area)
+  (send area put-alpha alpha)
+  (send area put-brush color style)
+  (send area put-pen line-color line-width line-style)
+  (for ([v (in-list (vs-fun))])
+    (send area put-polygon v))
+
+  (cond [label  (rectangle-legend-entry label color style line-color line-width line-style)]
+        [else   empty]))
+
+(: polygons3d-renderer (-> (-> (Listof (Listof (Vectorof Real))))
+                           (U #f Real) (U #f Real) (U #f Real) (U #f Real) (U #f Real) (U #f Real)
+                           Plot-Color Plot-Brush-Style
+                           Plot-Color Nonnegative-Real Plot-Pen-Style
+                           Nonnegative-Real
+                           (U #f String)
+                           renderer3d))
+(define (polygons3d-renderer vs-thnk x-min x-max y-min y-max z-min z-max
+                             color style line-color line-width line-style alpha label)
+  (define rvs (filter vrational? (apply append (vs-thnk))))
+  (cond
+    [(empty? rvs) (renderer3d #f #f #f #f)]
+    [else
+     (match-define (list (vector #{rxs : (Listof Real)}
+                                 #{rys : (Listof Real)}
+                                 #{rzs : (Listof Real)})
+                         ...)
+       rvs)
+     (let ([x-min (or x-min (apply min* rxs))]
+           [x-max (or x-max (apply max* rxs))]
+           [y-min (or y-min (apply min* rys))]
+           [y-max (or y-max (apply max* rys))]
+           [z-min (or z-min (apply min* rzs))]
+           [z-max (or z-max (apply max* rzs))])
+       (renderer3d (vector (ivl x-min x-max)(ivl y-min y-max)(ivl z-min z-max))
+                   #f ;surface3d-bounds-fun
+                   default-ticks-fun
+                   (polygons3d-render-proc vs-thnk
+                                           color style line-color line-width line-style alpha label)))]))
+(:: polygons3d
+    (->* [(Sequenceof (Sequenceof (Sequenceof Real)))]
+         [#:x-min (U #f Real) #:x-max (U #f Real)
+          #:y-min (U #f Real) #:y-max (U #f Real)
+          #:z-min (U #f Real) #:z-max (U #f Real)
+          #:color Plot-Color
+          #:style Plot-Brush-Style
+          #:line-color Plot-Color
+          #:line-width Nonnegative-Real
+          #:line-style Plot-Pen-Style
+          #:alpha Nonnegative-Real
+          #:label (U #f String)]
+         renderer3d))
+(define (polygons3d vs
+                    #:x-min [x-min #f] #:x-max [x-max #f]
+                    #:y-min [y-min #f] #:y-max [y-max #f]
+                    #:z-min [z-min #f] #:z-max [z-max #f]
+                    #:color [color (surface-color)]
+                    #:style [style (surface-style)]
+                    #:line-color [line-color (surface-line-color)]
+                    #:line-width [line-width (surface-line-width)]
+                    #:line-style [line-style (surface-line-style)]
+                    #:alpha [alpha (surface-alpha)]
+                    #:label [label #f])
+  (define fail/kw (make-raise-keyword-error 'polygons3d))
+  (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)]
+    [(and z-min (not (rational? z-min)))  (fail/kw "#f or rational" '#:z-min z-min)]
+    [(and z-max (not (rational? z-max)))  (fail/kw "#f or rational" '#:z-max z-max)]
+    [(or (> alpha 1) (not (rational? alpha)))  (fail/kw "real in [0,1]" '#:alpha alpha)]
+    [else
+     (let ([vs (for/list : (Listof (Listof (Vectorof Real)))
+                 ([v vs])
+                 (sequence->listof-vector 'polygons3d v 3))])
+       (polygons3d-renderer (λ () vs)
+                            x-min x-max y-min y-max z-min z-max
+                            color style line-color line-width line-style alpha label))]))
+
+#;(module+ test
+  (require plot)
+  (plot3d
+   (polygons3d (list (list (list 1 0 0)(list 0 0 1)(list 0 1 0))
+                     (list (list 0 0 0)(list 0 0 1)(list 0 1 0))
+                     (list (list 1 0 0)(list 0 0 1)(list 0 0 0))))))
+
+(:: parametric-surface3d
+    (->* [(-> Real Real (Sequenceof Real)) (U #f Real) (U #f Real) (U #f Real) (U #f Real)]
+         [#:x-min (U #f Real) #:x-max (U #f Real)
+          #:y-min (U #f Real) #:y-max (U #f Real)
+          #:z-min (U #f Real) #:z-max (U #f Real)
+          #:samples Positive-Integer
+          #:s-samples Positive-Integer
+          #:t-samples Positive-Integer
+          #:color Plot-Color
+          #:style Plot-Brush-Style
+          #:line-color Plot-Color
+          #:line-width Nonnegative-Real
+          #:line-style Plot-Pen-Style
+          #:alpha Nonnegative-Real
+          #:label (U #f String)]
+         renderer3d))
+(define (parametric-surface3d f s-min s-max t-min t-max
+                              #:x-min [x-min #f] #:x-max [x-max #f]
+                              #:y-min [y-min #f] #:y-max [y-max #f]
+                              #:z-min [z-min #f] #:z-max [z-max #f]
+                   #:samples [samples (plot3d-samples)]
+                   #:s-samples [s-samples samples]
+                   #:t-samples [t-samples samples]
+                   #:color [color (surface-color)]
+                   #:style [style (surface-style)]
+                   #:line-color [line-color (surface-line-color)]
+                   #:line-width [line-width (surface-line-width)]
+                   #:line-style [line-style (surface-line-style)]
+                   #:alpha [alpha (surface-alpha)]
+                   #:label [label #f])
+  (define fail/pos (make-raise-argument-error 'parametric-surface3d f x-min x-max y-min y-max))
+  (define fail/kw (make-raise-keyword-error 'parametric-surface3d))
+  (cond
+    [(not (rational? t-min))  (fail/pos "rational?" 1)]
+    [(not (rational? t-max))  (fail/pos "rational?" 2)]
+    [(not (rational? s-min))  (fail/pos "rational?" 3)]
+    [(not (rational? s-max))  (fail/pos "rational?" 4)]
+    [(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)]
+    [(and z-min (not (rational? z-min)))  (fail/kw "#f or rational" '#:z-min z-min)]
+    [(and z-max (not (rational? z-max)))  (fail/kw "#f or rational" '#:z-max z-max)]
+    [(< samples 2)  (fail/kw "integer >= 2" '#:samples samples)]
+    [(< s-samples 2)  (fail/kw "integer >= 2" '#:s-samples s-samples)]
+    [(< t-samples 2)  (fail/kw "integer >= 2" '#:t-samples t-samples)]
+    [(or (> alpha 1) (not (rational? alpha)))  (fail/kw "real in [0,1]" '#:alpha alpha)]
+    [else
+     (define vs (for/list : (Listof (Listof (Vectorof Real)))
+                  ([s (in-list (linear-seq s-min s-max s-samples))])
+                  (for/list : (Listof (Vectorof Real))
+                    ([t (in-list (linear-seq t-min t-max t-samples))])
+                    (sequence-head-vector 'parametric-surface3d (f s t) 3))))
+     (define vs+
+       (apply
+        append
+        (for/list : (Listof (Listof (Listof (Vectorof Real))))
+          ([s0 (in-list vs)]
+           [s1 (in-list (cdr vs))])
+          (for/list : (Listof (Listof (Vectorof Real)))
+            ([t0 (in-list s0)]
+             [t1 (in-list s1)]
+             [t2 (in-list (cdr s0))]
+             [t3 (in-list (cdr s1))])
+            (list t0 t1 t3 t2)))))
+     (polygons3d-renderer
+      (λ () vs+)
+      x-min x-max y-min y-max z-min z-max
+      color style line-color line-width line-style alpha label)]))
+
+#;(module+ test
+  (require plot)
+  (time
+   (plot3d
+    (parametric-surface3d (λ ([ϕ : Real] [γ : Real])
+                            (list (* (cos ϕ)(cos γ))
+                                  (* (sin ϕ)(cos γ))
+                                  (sin γ)))
+                          0 (* 2 (angle -1)) #:s-samples 80
+                          (- (/ (angle -1) 2)) (/ (angle -1) 2) #:t-samples 40
+                          )))
+  (time
+   (plot3d (polar3d (λ (ϕ γ)1)))))