Added `point-label3d', notion of layers (back, area, front) to 3D plots
This commit is contained in:
parent
bbe1cc9ab6
commit
876995d52c
|
@ -33,4 +33,8 @@
|
|||
(activate-contract-out default-ticks-fun
|
||||
function-bounds-fun function-interval-bounds-fun
|
||||
inverse-bounds-fun inverse-interval-bounds-fun
|
||||
surface3d-bounds-fun))
|
||||
surface3d-bounds-fun)
|
||||
plot3d-back-layer
|
||||
plot3d-area-layer
|
||||
plot3d-front-layer
|
||||
)
|
||||
|
|
|
@ -67,7 +67,8 @@
|
|||
"plot3d/line.rkt"
|
||||
"plot3d/point.rkt"
|
||||
"plot3d/isosurface.rkt"
|
||||
"plot3d/rectangle.rkt")
|
||||
"plot3d/rectangle.rkt"
|
||||
"plot3d/decoration.rkt")
|
||||
|
||||
(provide (only-doc-out
|
||||
(combine-out (all-from-out "plot3d/plot.rkt")
|
||||
|
@ -76,7 +77,8 @@
|
|||
(all-from-out "plot3d/line.rkt")
|
||||
(all-from-out "plot3d/point.rkt")
|
||||
(all-from-out "plot3d/isosurface.rkt")
|
||||
(all-from-out "plot3d/rectangle.rkt"))))
|
||||
(all-from-out "plot3d/rectangle.rkt")
|
||||
(all-from-out "plot3d/decoration.rkt"))))
|
||||
|
||||
;; ===================================================================================================
|
||||
;; Deprecated functions
|
||||
|
|
|
@ -78,6 +78,9 @@
|
|||
(require "plot3d/rectangle.rkt")
|
||||
(provide (activate-contract-out rectangles3d discrete-histogram3d stacked-histogram3d))
|
||||
|
||||
(require "plot3d/decoration.rkt")
|
||||
(provide (activate-contract-out point-label3d))
|
||||
|
||||
;; ===================================================================================================
|
||||
;; Deprecated functions
|
||||
|
||||
|
|
66
pkgs/plot/plot3d/decoration.rkt
Normal file
66
pkgs/plot/plot3d/decoration.rkt
Normal file
|
@ -0,0 +1,66 @@
|
|||
#lang racket/base
|
||||
|
||||
;; Renderers for plot decorations: labeled points only so far
|
||||
|
||||
(require racket/contract racket/class racket/match racket/list
|
||||
unstable/latent-contract/defthing
|
||||
unstable/contract
|
||||
plot/utils
|
||||
"../common/utils.rkt"
|
||||
)
|
||||
|
||||
(provide (all-defined-out))
|
||||
|
||||
;; ===================================================================================================
|
||||
;; Labeled points
|
||||
|
||||
(define (format-coordinate3d v area)
|
||||
(match-define (vector x y z) v)
|
||||
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
|
||||
(send area get-bounds-rect))
|
||||
(match-define (list x-str) (format-tick-labels (plot-x-ticks) x-min x-max (list x)))
|
||||
(match-define (list y-str) (format-tick-labels (plot-y-ticks) y-min y-max (list y)))
|
||||
(match-define (list z-str) (format-tick-labels (plot-z-ticks) z-min z-max (list z)))
|
||||
(format "(~a,~a,~a)" x-str y-str z-str))
|
||||
|
||||
(define ((label3d-render-proc label v color size family anchor angle
|
||||
point-color point-fill-color point-size point-line-width point-sym
|
||||
alpha)
|
||||
area)
|
||||
(let ([label (if label label (format-coordinate3d v area))])
|
||||
(send area put-alpha alpha)
|
||||
; label
|
||||
(send area put-text-foreground color)
|
||||
(send area put-font size family)
|
||||
(send area put-text (string-append " " label " ") v anchor angle (* 1/2 point-size)
|
||||
#:outline? #t #:layer plot3d-front-layer)
|
||||
; point
|
||||
(send area put-pen point-color point-line-width 'solid)
|
||||
(send area put-brush point-fill-color 'solid)
|
||||
(send area put-glyphs (list v) point-sym point-size #:layer plot3d-front-layer))
|
||||
|
||||
empty)
|
||||
|
||||
(defproc (point-label3d
|
||||
[v (sequence/c 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-color point-color plot-color/c (point-color)]
|
||||
[#:point-fill-color point-fill-color (or/c plot-color/c 'auto) 'auto]
|
||||
[#:point-size point-size (>=/c 0) (label-point-size)]
|
||||
[#:point-line-width point-line-width (>=/c 0) (point-line-width)]
|
||||
[#:point-sym point-sym point-sym/c 'fullcircle]
|
||||
[#:alpha alpha (real-in 0 1) (label-alpha)]
|
||||
) renderer3d?
|
||||
(let ([v (sequence-head-vector 'point-label3d v 3)])
|
||||
(match-define (vector x y z) v)
|
||||
(renderer3d (vector (ivl x x) (ivl y y) (ivl z z)) #f #f
|
||||
(label3d-render-proc
|
||||
label v color size family anchor angle
|
||||
point-color (cond [(eq? point-fill-color 'auto) (->pen-color point-color)]
|
||||
[else point-fill-color])
|
||||
point-size point-line-width point-sym
|
||||
alpha))))
|
|
@ -15,7 +15,15 @@
|
|||
"shape.rkt"
|
||||
"clip.rkt")
|
||||
|
||||
(provide (all-defined-out))
|
||||
(provide (all-defined-out)
|
||||
plot3d-back-layer
|
||||
plot3d-area-layer
|
||||
plot3d-front-layer
|
||||
)
|
||||
|
||||
(define plot3d-back-layer 2)
|
||||
(define plot3d-area-layer 1)
|
||||
(define plot3d-front-layer 0)
|
||||
|
||||
(define plot3d-subdivisions (make-parameter 0))
|
||||
|
||||
|
@ -643,12 +651,12 @@
|
|||
(send pd set-alpha (shape-alpha s))
|
||||
(match s
|
||||
;; shapes
|
||||
[(shapes alpha _ ss) (draw-shapes ss)]
|
||||
[(shapes alpha _ _ ss) (draw-shapes ss)]
|
||||
;; polygon
|
||||
[(polygon alpha _ vs normal pen-color pen-width pen-style brush-color brush-style)
|
||||
[(polygon alpha _ _ vs normal pen-color pen-width pen-style brush-color brush-style)
|
||||
(draw-polygon alpha center vs normal pen-color pen-width pen-style brush-color brush-style)]
|
||||
;; rectangle
|
||||
[(rectangle alpha _ r pen-color pen-width pen-style brush-color brush-style)
|
||||
[(rectangle alpha _ _ r pen-color pen-width pen-style brush-color brush-style)
|
||||
(for ([face (in-list (rect-visible-faces r theta))])
|
||||
(match face
|
||||
[(list normal vs ...) (draw-polygon alpha center vs
|
||||
|
@ -656,25 +664,25 @@
|
|||
brush-color brush-style)]
|
||||
[_ (void)]))]
|
||||
;; line
|
||||
[(line alpha _ v1 v2 pen-color pen-width pen-style)
|
||||
[(line alpha _ _ v1 v2 pen-color pen-width pen-style)
|
||||
(send pd set-pen pen-color pen-width pen-style)
|
||||
(send pd draw-line (norm->dc v1) (norm->dc v2))]
|
||||
;; text
|
||||
[(text alpha _ anchor angle dist str font-size font-family color)
|
||||
[(text alpha _ _ anchor angle dist str font-size font-family color outline?)
|
||||
(send pd set-font font-size font-family)
|
||||
(send pd set-text-foreground color)
|
||||
(send pd draw-text str (view->dc center) anchor angle dist)]
|
||||
(send pd draw-text str (view->dc center) anchor angle dist #:outline? outline?)]
|
||||
;; glyph
|
||||
[(glyph alpha _ symbol size pen-color pen-width pen-style brush-color brush-style)
|
||||
[(glyph alpha _ _ symbol size pen-color pen-width pen-style brush-color brush-style)
|
||||
(send pd set-pen pen-color pen-width pen-style)
|
||||
(send pd set-brush brush-color brush-style)
|
||||
(send pd draw-glyphs (list (view->dc center)) symbol size)]
|
||||
;; tick glyph
|
||||
[(tick-glyph alpha _ radius angle pen-color pen-width pen-style)
|
||||
[(tick-glyph alpha _ _ radius angle pen-color pen-width pen-style)
|
||||
(send pd set-pen pen-color pen-width pen-style)
|
||||
(send pd draw-tick (view->dc center) radius angle)]
|
||||
;; arrow glyph
|
||||
[(arrow-glyph alpha _ v1 v2 pen-color pen-width pen-style)
|
||||
[(arrow-glyph alpha _ _ v1 v2 pen-color pen-width pen-style)
|
||||
(send pd set-pen pen-color pen-width pen-style)
|
||||
(send pd draw-arrow (norm->dc v1) (norm->dc v2))]
|
||||
[_ (error 'draw-shapes "shape not implemented: ~e" s)]))
|
||||
|
@ -829,12 +837,14 @@
|
|||
(values v1 v2))])
|
||||
(unless (and v1 v2) (return (void)))
|
||||
(cond [identity-transforms?
|
||||
(add-shape! (line alpha (plot->norm c) (plot->norm v1) (plot->norm v2)
|
||||
(add-shape! (line alpha (plot->norm c) plot3d-area-layer
|
||||
(plot->norm v1) (plot->norm v2)
|
||||
pen-color pen-width pen-style))]
|
||||
[else
|
||||
(define vs (subdivide-line plot->dc v1 v2))
|
||||
(for ([v1 (in-list vs)] [v2 (in-list (rest vs))])
|
||||
(add-shape! (line alpha (plot->norm c) (plot->norm v1) (plot->norm v2)
|
||||
(add-shape! (line alpha (plot->norm c) plot3d-area-layer
|
||||
(plot->norm v1) (plot->norm v2)
|
||||
pen-color pen-width pen-style)))]))))
|
||||
|
||||
(define/public (put-lines vs)
|
||||
|
@ -856,7 +866,7 @@
|
|||
vs)]
|
||||
[vs (if identity-transforms? vs (subdivide-polygon plot->dc vs))])
|
||||
(when (empty? vs) (return lst))
|
||||
(cons (polygon alpha (plot->norm c) (map plot->norm vs)
|
||||
(cons (polygon alpha (plot->norm c) plot3d-area-layer (map plot->norm vs)
|
||||
normal pen-color pen-width pen-style brush-color brush-style)
|
||||
lst))))
|
||||
|
||||
|
@ -868,7 +878,7 @@
|
|||
#:when (not (empty? vs)))
|
||||
(add-polygon lst vs (vcenter vs))))
|
||||
(when (not (empty? lst))
|
||||
(add-shape! (shapes alpha (plot->norm c) lst))))
|
||||
(add-shape! (shapes alpha (plot->norm c) plot3d-area-layer lst))))
|
||||
|
||||
(define/public (put-rect r [c (rect-center r)])
|
||||
(when (rect-rational? r)
|
||||
|
@ -876,35 +886,37 @@
|
|||
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max)) r)
|
||||
(match-let ([(vector x-min y-min z-min) (plot->norm (vector x-min y-min z-min))]
|
||||
[(vector x-max y-max z-max) (plot->norm (vector x-max y-max z-max))])
|
||||
(add-shape! (rectangle alpha (plot->norm c)
|
||||
(add-shape! (rectangle alpha (plot->norm c) plot3d-area-layer
|
||||
(vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
|
||||
pen-color pen-width pen-style brush-color brush-style))))))
|
||||
|
||||
(define/public (put-text str v [anchor 'center] [angle 0] [dist 0])
|
||||
(define/public (put-text str v [anchor 'center] [angle 0] [dist 0]
|
||||
#:outline? [outline? #f]
|
||||
#:layer [layer plot3d-area-layer])
|
||||
(when (and (vrational? v) (in-bounds? v))
|
||||
(add-shape! (text alpha (plot->norm v) anchor angle dist str
|
||||
font-size font-family text-foreground))))
|
||||
(add-shape! (text alpha (plot->norm v) layer anchor angle dist str
|
||||
font-size font-family text-foreground outline?))))
|
||||
|
||||
(define/public (put-glyphs vs symbol size)
|
||||
(define/public (put-glyphs vs symbol size #:layer [layer plot3d-area-layer])
|
||||
(for ([v (in-list vs)])
|
||||
(when (and (vrational? v) (in-bounds? v))
|
||||
(add-shape!
|
||||
(glyph alpha (plot->norm v) symbol size
|
||||
(glyph alpha (plot->norm v) layer symbol size
|
||||
pen-color pen-width pen-style brush-color brush-style)))))
|
||||
|
||||
(define/public (put-arrow v1 v2 [c (v* (v+ v1 v2) 1/2)])
|
||||
(when (and (vrational? v1) (vrational? v2) (in-bounds? v1))
|
||||
(cond [(in-bounds? v2)
|
||||
(add-shape!
|
||||
(arrow-glyph alpha (plot->norm c) (plot->norm v1) (plot->norm v2)
|
||||
(arrow-glyph alpha (plot->norm c) plot3d-area-layer (plot->norm v1) (plot->norm v2)
|
||||
(->brush-color (plot-background)) (+ 2 pen-width) 'solid))
|
||||
(add-shape!
|
||||
(arrow-glyph alpha (plot->norm c) (plot->norm v1) (plot->norm v2)
|
||||
(arrow-glyph alpha (plot->norm c) plot3d-area-layer (plot->norm v1) (plot->norm v2)
|
||||
pen-color pen-width pen-style))]
|
||||
[else (put-line v1 v2)])))
|
||||
|
||||
(define/public (put-tick v radius angle)
|
||||
(define/public (put-tick v radius angle #:layer [layer plot3d-area-layer])
|
||||
(when (and (vrational? v) (in-bounds? v))
|
||||
(add-shape! (tick-glyph alpha (plot->norm v) radius angle
|
||||
(add-shape! (tick-glyph alpha (plot->norm v) layer radius angle
|
||||
pen-color pen-width pen-style))))
|
||||
)) ; end class
|
||||
|
|
|
@ -5,12 +5,12 @@
|
|||
|
||||
(provide (all-defined-out))
|
||||
|
||||
(struct shape (alpha center) #:transparent)
|
||||
(struct shape (alpha center layer) #:transparent)
|
||||
|
||||
(struct polygon shape (vs normal pen-color pen-width pen-style brush-color brush-style) #:transparent)
|
||||
(struct rectangle shape (rect pen-color pen-width pen-style brush-color brush-style) #:transparent)
|
||||
(struct line shape (v1 v2 pen-color pen-width pen-style) #:transparent)
|
||||
(struct text shape (anchor angle dist str font-size font-family color) #:transparent)
|
||||
(struct text shape (anchor angle dist str font-size font-family color outline?) #:transparent)
|
||||
(struct glyph shape (symbol size pen-color pen-width pen-style brush-color brush-style) #:transparent)
|
||||
(struct tick-glyph shape (radius angle pen-color pen-width pen-style) #:transparent)
|
||||
(struct arrow-glyph shape (start end pen-color pen-width pen-style) #:transparent)
|
||||
|
@ -19,11 +19,15 @@
|
|||
(define (draw-before? cs1 cs2)
|
||||
(match-define (cons s1 (vector x1 y1 z1)) cs1)
|
||||
(match-define (cons s2 (vector x2 y2 z2)) cs2)
|
||||
(or (y1 . > . y2)
|
||||
(and (y1 . = . y2)
|
||||
(if (z1 . = . z2)
|
||||
(and (polygon? s1) (not (polygon? s2)))
|
||||
(z1 . < . z2)))))
|
||||
(define l1 (shape-layer s1))
|
||||
(define l2 (shape-layer s2))
|
||||
(or (l1 . > . l2)
|
||||
(and (l1 . = . l2)
|
||||
(or (y1 . > . y2)
|
||||
(and (y1 . = . y2)
|
||||
(if (z1 . = . z2)
|
||||
(and (polygon? s1) (not (polygon? s2)))
|
||||
(z1 . < . z2)))))))
|
||||
|
||||
(define (depth-sort s+cs)
|
||||
(sort s+cs draw-before?))
|
||||
|
|
|
@ -202,3 +202,9 @@ Think of it as a version of @racket[discrete-histogram] that allows multiple val
|
|||
(plot3d (stacked-histogram3d data #:labels '("Red" #f "Blue")
|
||||
#:alphas '(2/3 1 2/3)))]
|
||||
}
|
||||
|
||||
@doc-apply[point-label3d]{
|
||||
Returns a renderer that draws a labeled point.
|
||||
If @(racket label) is @(racket #f), the point is labeled with its position.
|
||||
Analogous to @racket[point-label].
|
||||
}
|
||||
|
|
|
@ -249,3 +249,8 @@
|
|||
|
||||
(time
|
||||
(plot3d (contour-intervals3d (λ (x y) (- (sqr x) (sqr y))) -min.0 +min.0 -min.0 +min.0)))
|
||||
|
||||
(time
|
||||
(define (f x y) (* (sin x) (cos y)))
|
||||
(plot3d (list (contour-intervals3d f -3 3 -3 3)
|
||||
(point-label3d (list -1 1 (f -1 1))))))
|
||||
|
|
|
@ -74,3 +74,6 @@
|
|||
|
||||
(require "plot3d/rectangle.rkt")
|
||||
(provide (all-from-out "plot3d/rectangle.rkt"))
|
||||
|
||||
(require "plot3d/decoration.rkt")
|
||||
(provide (all-from-out "plot3d/decoration.rkt"))
|
||||
|
|
25
pkgs/plot/typed/plot3d/decoration.rkt
Normal file
25
pkgs/plot/typed/plot3d/decoration.rkt
Normal file
|
@ -0,0 +1,25 @@
|
|||
#lang typed/racket/base
|
||||
|
||||
(require "../common/types.rkt"
|
||||
"../syntax.rkt")
|
||||
|
||||
(provide point-label3d)
|
||||
|
||||
(require/typed*
|
||||
plot
|
||||
|
||||
[point-label3d (((Sequenceof Real))
|
||||
((Option String)
|
||||
[#:color Plot-Color]
|
||||
[#:size Real]
|
||||
[#:family Font-Family]
|
||||
[#:anchor Anchor]
|
||||
[#:angle Real]
|
||||
[#:point-color Plot-Color]
|
||||
[#:point-fill-color (U Plot-Color 'auto)]
|
||||
[#:point-size Real]
|
||||
[#:point-line-width Real]
|
||||
[#:point-sym Point-Sym]
|
||||
[#:alpha Real])
|
||||
->* renderer3d)]
|
||||
)
|
Loading…
Reference in New Issue
Block a user