diff --git a/collects/plot/common/ticks.rkt b/collects/plot/common/ticks.rkt index 8d003d677e..cfa0149ca2 100644 --- a/collects/plot/common/ticks.rkt +++ b/collects/plot/common/ticks.rkt @@ -627,14 +627,18 @@ (defproc (collapse-nearby-ticks [ts (listof tick?)] [near? (tick? tick? . -> . boolean?)] [format-string string? "~a|~a"]) (listof tick?) - (let* ([ts (remove-duplicates (filter pre-tick-major? ts) #:key pre-tick-value)] - [ts (sort ts < #:key pre-tick-value)]) + (let* ([ts (sort ts < #:key pre-tick-value)]) (append* (for/list ([ts (in-list (group-neighbors ts near?))]) (define n (length ts)) + (define m (count pre-tick-major? ts)) (cond [(n . <= . 1) ts] - [else - (match-define (list (tick xs _ labels) ...) ts) - (define x (/ (apply + xs) n)) - (define label (format format-string (first labels) (last labels))) - (list (tick x #t label))]))))) + [(m . = . 0) (match-define (list (tick xs _ labels) ...) ts) + (define x (/ (apply + xs) n)) + (define label (format format-string (first labels) (last labels))) + (list (tick x #f label))] + [(m . = . 1) (filter pre-tick-major? ts)] + [else (match-define (list (tick xs _ labels) ...) (filter pre-tick-major? ts)) + (define x (/ (apply + xs) n)) + (define label (format format-string (first labels) (last labels))) + (list (tick x #t label))]))))) diff --git a/collects/plot/plot2d/plot-area.rkt b/collects/plot/plot2d/plot-area.rkt index 7119511b55..28fad17d4e 100644 --- a/collects/plot/plot2d/plot-area.rkt +++ b/collects/plot/plot2d/plot-area.rkt @@ -28,6 +28,7 @@ (send pd reset-drawing-params) (define char-height (send pd get-char-height)) + (define half-char-height (* 1/2 char-height)) (define dc-x-max (+ dc-x-min dc-x-size)) (define dc-y-max (+ dc-y-min dc-y-size)) @@ -135,6 +136,9 @@ ;; =============================================================================================== ;; Tick and label constants + (define tick-radius (* 1/2 (plot-tick-size))) + (define half-tick-radius (* 1/2 tick-radius)) + (define near-dist^2 (sqr(* 3 (plot-line-width)))) (define (vnear? v1 v2) ((vmag^2 (v- (plot->dc* v1) (plot->dc* v2))) . <= . near-dist^2)) @@ -163,9 +167,67 @@ (define draw-x-far-tick-labels? (not (and (plot-x-axis?) (equal? x-ticks x-far-ticks)))) (define draw-y-far-tick-labels? (not (and (plot-y-axis?) (equal? y-ticks y-far-ticks)))) + ;; =============================================================================================== + ;; Tick and tick label parameters + + (define (x-tick-value->dc x) (plot->dc* (vector x y-min))) + (define (y-tick-value->dc y) (plot->dc* (vector x-min y))) + (define (x-far-tick-value->dc x) (plot->dc* (vector x y-max))) + (define (y-far-tick-value->dc y) (plot->dc* (vector x-max y))) + + (define (get-tick-params ticks tick-value->dc angle) + (for/list ([t (in-list ticks)]) + (match-define (tick x major? _) t) + (list major? (tick-value->dc x) (if major? tick-radius half-tick-radius) angle))) + + (define (get-x-tick-params) + (if (plot-x-axis?) (get-tick-params x-ticks x-tick-value->dc (* 1/2 pi)) empty)) + + (define (get-y-tick-params) + (if (plot-y-axis?) (get-tick-params y-ticks y-tick-value->dc 0) empty)) + + (define (get-x-far-tick-params) + (if (plot-x-far-axis?) (get-tick-params x-far-ticks x-far-tick-value->dc (* 1/2 pi)) empty)) + + (define (get-y-far-tick-params) + (if (plot-y-far-axis?) (get-tick-params y-far-ticks y-far-tick-value->dc 0) empty)) + + (define x-tick-label-offset (vector 0 (+ (pen-gap) tick-radius))) + (define y-tick-label-offset (vector (- (+ (pen-gap) tick-radius)) 0)) + (define x-far-tick-label-offset (vneg x-tick-label-offset)) + (define y-far-tick-label-offset (vneg y-tick-label-offset)) + + (define (get-tick-label-params ticks tick-label-offset tick-value->dc anchor) + (for/list ([t (in-list ticks)] #:when (pre-tick-major? t)) + (match-define (tick p _ label) t) + (list label (v+ (tick-value->dc p) tick-label-offset) anchor))) + + (define (get-x-tick-label-params) + (if (plot-x-axis?) + (get-tick-label-params x-ticks x-tick-label-offset x-tick-value->dc 'top) + empty)) + + (define (get-y-tick-label-params) + (if (plot-y-axis?) + (get-tick-label-params y-ticks y-tick-label-offset y-tick-value->dc 'right) + empty)) + + (define (get-x-far-tick-label-params) + (if (plot-x-far-axis?) + (get-tick-label-params x-far-ticks x-far-tick-label-offset x-far-tick-value->dc 'bottom) + empty)) + + (define (get-y-far-tick-label-params) + (if (plot-y-far-axis?) + (get-tick-label-params y-far-ticks y-far-tick-label-offset y-far-tick-value->dc 'left) + empty)) + + ;; =============================================================================================== + ;; Axis label parameters + (define (max-tick-offset ts) (cond [(empty? ts) 0] - [(ormap pre-tick-major? ts) (+ (pen-gap) (* 1/2 (plot-tick-size)))] + [(ormap pre-tick-major? ts) (+ (pen-gap) tick-radius)] [else (+ (pen-gap) (* 1/4 (plot-tick-size)))])) (define max-x-tick-offset (if (plot-x-axis?) (max-tick-offset x-ticks) 0)) @@ -189,105 +251,43 @@ (max-tick-label-width y-far-ticks) 0)) - ;; =============================================================================================== - ;; Axis label parameters - (define (get-x-label-params) - (define offset (vector 0 (+ max-x-tick-offset - max-x-tick-label-height - (* 1/2 char-height)))) - (list (plot-x-label) (v+ (view->dc (vector (* 1/2 (+ x-min x-max)) y-min)) offset) - 'top)) + (define offset (vector 0 (+ max-x-tick-offset max-x-tick-label-height half-char-height))) + (list (plot-x-label) (v+ (view->dc (vector x-mid y-min)) offset) 'top)) (define (get-y-label-params) - (define offset (vector (+ max-y-tick-offset - max-y-tick-label-width - (* 1/2 char-height)) - 0)) - (list (plot-y-label) (v- (view->dc (vector x-min (* 1/2 (+ y-min y-max)))) offset) - 'bottom (/ pi 2))) + (define offset (vector (+ max-y-tick-offset max-y-tick-label-width half-char-height) 0)) + (list (plot-y-label) (v- (view->dc (vector x-min y-mid)) offset) 'bottom (/ pi 2))) (define (get-x-far-label-params) - (define offset (vector 0 (+ max-x-far-tick-offset - max-x-far-tick-label-height - (* 1/2 char-height)))) - (list (plot-x-far-label) (v- (view->dc (vector (* 1/2 (+ x-min x-max)) y-max)) offset) - 'bottom)) + (define offset (vector 0 (+ max-x-far-tick-offset max-x-far-tick-label-height half-char-height))) + (list (plot-x-far-label) (v- (view->dc (vector x-mid y-max)) offset) 'bottom)) (define (get-y-far-label-params) - (define offset (vector (+ max-y-far-tick-offset - max-y-far-tick-label-width - (* 1/2 char-height)) - 0)) - (list (plot-y-far-label) (v+ (view->dc (vector x-max (* 1/2 (+ y-min y-max)))) offset) - 'top (/ pi 2))) - - ;; =============================================================================================== - ;; Tick label parameters - - (define (get-x-tick-label-params) - (define offset (vector 0 (+ (pen-gap) (* 1/2 (plot-tick-size))))) - (for/list ([t (in-list x-ticks)] #:when (pre-tick-major? t)) - (match-define (tick x _ label) t) - (list label (v+ (plot->dc* (vector x y-min)) offset) 'top))) - - (define (get-y-tick-label-params) - (define offset (vector (+ (pen-gap) (* 1/2 (plot-tick-size))) 0)) - (for/list ([t (in-list y-ticks)] #:when (pre-tick-major? t)) - (match-define (tick y _ label) t) - (list label (v- (plot->dc* (vector x-min y)) offset) 'right))) - - (define (get-x-far-tick-label-params) - (define offset (vector 0 (+ (pen-gap) (* 1/2 (plot-tick-size))))) - (for/list ([t (in-list x-far-ticks)] #:when (pre-tick-major? t)) - (match-define (tick x _ label) t) - (list label (v- (plot->dc* (vector x y-max)) offset) 'bottom))) - - (define (get-y-far-tick-label-params) - (define offset (vector (+ (pen-gap) (* 1/2 (plot-tick-size))) 0)) - (for/list ([t (in-list y-far-ticks)] #:when (pre-tick-major? t)) - (match-define (tick y _ label) t) - (list label (v+ (plot->dc* (vector x-max y)) offset) 'left))) - - ;; =============================================================================================== - ;; Tick parameters - - (define (get-tick-params) - (cond [(plot-decorations?) - (define radius (* 1/2 (plot-tick-size))) - (define 1/2radius (* 1/2 radius)) - (append - (for/list ([t (in-list (if (plot-x-axis?) x-ticks empty))]) - (match-define (tick x major? _) t) - (list major? (plot->dc* (vector x y-min)) (if major? radius 1/2radius) (* 1/2 pi))) - (for/list ([t (in-list (if (plot-y-axis?) y-ticks empty))]) - (match-define (tick y major? _) t) - (list major? (plot->dc* (vector x-min y)) (if major? radius 1/2radius) 0)) - (for/list ([t (in-list (if (plot-x-far-axis?) x-far-ticks empty))]) - (match-define (tick x major? _) t) - (list major? (plot->dc* (vector x y-max)) (if major? radius 1/2radius) (* 1/2 pi))) - (for/list ([t (in-list (if (plot-y-far-axis?) y-far-ticks empty))]) - (match-define (tick y major? _) t) - (list major? (plot->dc* (vector x-max y)) (if major? radius 1/2radius) 0)))] - [else empty])) + (define offset (vector (+ max-y-far-tick-offset max-y-far-tick-label-width half-char-height) 0)) + (list (plot-y-far-label) (v+ (view->dc (vector x-max y-mid)) offset) 'top (/ pi 2))) ;; =============================================================================================== ;; Fixpoint margin computation - (define (get-label-params) - (cond [(plot-decorations?) - (append (if (plot-x-label) (list (get-x-label-params)) empty) - (if (plot-y-label) (list (get-y-label-params)) empty) - (if (plot-x-far-label) (list (get-x-far-label-params)) empty) - (if (plot-y-far-label) (list (get-y-far-label-params)) empty) - (if (plot-x-axis?) (get-x-tick-label-params) empty) - (if (plot-y-axis?) (get-y-tick-label-params) empty) - (if (and (plot-x-far-axis?) draw-x-far-tick-labels?) - (get-x-far-tick-label-params) - empty) - (if (and (plot-y-far-axis?) draw-y-far-tick-labels?) - (get-y-far-tick-label-params) - empty))] + (define (get-all-tick-label-params) + (append (get-x-tick-label-params) (get-y-tick-label-params) + (if draw-x-far-tick-labels? (get-x-far-tick-label-params) empty) + (if draw-y-far-tick-labels? (get-y-far-tick-label-params) empty))) + + (define (get-all-axis-label-params) + (append (if (plot-x-label) (list (get-x-label-params)) empty) + (if (plot-y-label) (list (get-y-label-params)) empty) + (if (plot-x-far-label) (list (get-x-far-label-params)) empty) + (if (plot-y-far-label) (list (get-y-far-label-params)) empty))) + + (define (get-all-label-params) + (cond [(plot-decorations?) (append (get-all-axis-label-params) (get-all-tick-label-params))] + [else empty])) + + (define (get-all-tick-params) + (cond [(plot-decorations?) (append (get-x-tick-params) (get-y-tick-params) + (get-x-far-tick-params) (get-y-far-tick-params))] [else empty])) (define (new-margins left right top bottom label-params tick-params) @@ -311,7 +311,7 @@ (define-values (area-x-min right area-y-min bottom) (for/fold ([left 0] [right 0] [top init-top-margin] [bottom 0]) ([i (in-range 5)]) (define-values (new-left new-right new-top new-bottom) - (new-margins left right top bottom (get-label-params) (get-tick-params))) + (new-margins left right top bottom (get-all-label-params) (get-all-tick-params))) (set! view->dc (make-view->dc new-left new-right new-top new-bottom)) ;(printf "margins: ~v ~v ~v ~v~n" new-left new-right new-top new-bottom) (values new-left new-right new-top new-bottom))) @@ -323,13 +323,13 @@ ;; Plot decoration (define (draw-labels) - (for ([params (in-list (get-label-params))]) + (for ([params (in-list (get-all-label-params))]) (send/apply pd draw-text params))) (define (draw-ticks) - (for ([params (in-list (get-tick-params))]) + (for ([params (in-list (get-all-tick-params))]) (match-define (list major? v r angle) params) - (if major? (put-major-pen) (put-minor-pen)) + (if major? (send pd set-major-pen) (send pd set-minor-pen)) (send pd draw-tick v r angle))) (define (draw-title) @@ -377,7 +377,7 @@ (draw-labels)) (define/public (draw-legend legend-entries) - (define gap-size (+ (pen-gap) (* 1/2 (plot-tick-size)))) + (define gap-size (+ (pen-gap) tick-radius)) (send pd draw-legend legend-entries (+ area-x-min gap-size) (- area-x-max gap-size)