add plot-font-face and use the-font-list to cache fonts

This commit is contained in:
Robby Findler 2014-07-10 23:55:00 -05:00
parent 3333d92652
commit 954f3c52d4
8 changed files with 57 additions and 27 deletions

View File

@ -42,6 +42,7 @@ See @(racket ->pen-color) and @(racket ->brush-color) for details on how @(plot-
@doc-apply[plot-foreground-alpha]
@doc-apply[plot-background-alpha]{The opacity of the background and foreground colors.}
@doc-apply[plot-font-size]{The font size of the title, axis labels, tick labels, and other labels, in drawing units.}
@doc-apply[plot-font-face]{The font face used for the title and labels.}
@doc-apply[plot-font-family]{The font family used for the title and labels.}
@doc-apply[plot-line-width]{The width of axis lines and major tick lines. (Minor tick lines are half this width.)}

View File

@ -28,6 +28,7 @@
(defparam plot-line-width width (>=/c 0) 1)
(defparam plot-tick-size (>=/c 0) 10)
(defparam plot-font-size size (>=/c 0) 11)
(defparam plot-font-face face (or/c string? #f) #f)
(defparam plot-font-family family font-family/c 'roman)
(defparam plot-legend-anchor anchor anchor/c 'top-left)
(defparam plot-legend-box-alpha alpha (real-in 0 1) 2/3)
@ -75,7 +76,7 @@
plot-foreground plot-foreground-alpha
plot-background plot-background-alpha
plot-line-width plot-tick-size
plot-font-size plot-font-family
plot-font-size plot-font-face plot-font-family
plot-legend-anchor plot-legend-box-alpha
plot-axes? plot-tick-labels
plot-decorations?

View File

@ -130,7 +130,7 @@
(send dc set-text-mode 'transparent)
(when clipping-rect?
(send dc set-clipping-rect 0 0 dc-x-size dc-y-size))
(set-font (plot-font-size) (plot-font-family))
(set-font (plot-font-size) (plot-font-face) (plot-font-family))
(set-text-foreground (plot-foreground))
(set-pen (plot-foreground) (plot-line-width) 'solid)
(set-brush (plot-background) 'solid)
@ -213,21 +213,31 @@
;; -----------------------------------------------------------------------------------------------
;; Text parameters
(define font-hash (make-hash))
;; Sets the font, using hash table to cache fonts.
;; Sets the font, using the-font-list to cache fonts.
(define/public set-font
(case-lambda
[(font) (send dc set-font font)]
[(size family)
[(size family) (set-font size #f family)]
[(size face family)
(send dc set-font
(hash-ref! font-hash (vector size family)
(λ () (make-object font% (real->font-size size) family
'normal 'normal #f 'default #t))))]))
(if face
(send the-font-list find-or-create-font
(real->font-size size)
face
family
'normal
'normal)
(send the-font-list find-or-create-font
(real->font-size size)
family
'normal
'normal)))]))
;; Sets only the font size, not the family.
(define/public (set-font-size size)
(set-font size (send (send dc get-font) get-family)))
(set-font size
(send (send dc get-font) get-face)
(send (send dc get-font) get-family)))
;; Returns the character height, as an exact real.
(define/public (get-char-height)

View File

@ -21,7 +21,7 @@
plot-foreground plot-foreground-alpha
plot-background plot-background-alpha
plot-line-width plot-tick-size
plot-font-size plot-font-family
plot-font-size plot-font-face plot-font-family
plot-legend-anchor plot-legend-box-alpha
plot-decorations?
plot-animating?

View File

@ -203,7 +203,7 @@
(match-define (list y-str) (format-tick-labels (plot-y-ticks) y-min y-max (list y)))
(format "(~a,~a)" x-str y-str))
(define ((label-render-proc label v color size family anchor angle
(define ((label-render-proc label v color size face family anchor angle
point-color point-fill-color point-size point-line-width point-sym
alpha)
area)
@ -211,7 +211,7 @@
(send area put-alpha alpha)
; label
(send area put-text-foreground color)
(send area put-font size family)
(send area put-font size face family)
(send area put-text (string-append " " label " ") v anchor angle (* 1/2 point-size) #:outline? #t)
; point
(send area put-pen point-color point-line-width 'solid)
@ -224,6 +224,7 @@
[v (sequence/c real?)] [label (or/c string? #f) #f]
[#:color color plot-color/c (plot-foreground)]
[#:size size (>=/c 0) (plot-font-size)]
[#:face face (or/c string? #f) (plot-font-face)]
[#:family family font-family/c (plot-font-family)]
[#:anchor anchor anchor/c (label-anchor)]
[#:angle angle real? (label-angle)]
@ -248,6 +249,7 @@
[f (real? . -> . (sequence/c real?))] [t real?] [label (or/c string? #f) #f]
[#:color color plot-color/c (plot-foreground)]
[#:size size (>=/c 0) (plot-font-size)]
[#:face face (or/c string? #f) (plot-font-face)]
[#:family family font-family/c (plot-font-family)]
[#:anchor anchor anchor/c (label-anchor)]
[#:angle angle real? (label-angle)]
@ -258,8 +260,9 @@
[#:point-sym point-sym point-sym/c 'fullcircle]
[#:alpha alpha (real-in 0 1) (label-alpha)]
) renderer2d?
(point-label (sequence-head-vector 'parametric-label (f t) 2)
label #:color color #:size size #:family family #:anchor anchor #:angle angle
(point-label (sequence-head-vector 'parametric-label (f t) 2)
label
#:color color #:size size #:face face #:family family #:anchor anchor #:angle angle
#:point-color point-color #:point-fill-color point-fill-color #:point-size point-size
#:point-line-width point-line-width #:point-sym point-sym
#:alpha alpha))
@ -268,6 +271,7 @@
[f (real? . -> . real?)] [θ real?] [label (or/c string? #f) #f]
[#:color color plot-color/c (plot-foreground)]
[#:size size (>=/c 0) (plot-font-size)]
[#:face face (or/c string? #f) (plot-font-face)]
[#:family family font-family/c (plot-font-family)]
[#:anchor anchor anchor/c (label-anchor)]
[#:angle angle real? (label-angle)]
@ -279,7 +283,7 @@
[#:alpha alpha (real-in 0 1) (label-alpha)]
) renderer2d?
(point-label (polar->cartesian θ (f θ)) label
#:color color #:size size #:family family #:anchor anchor #:angle angle
#:color color #:size size #:face face #:family family #:anchor anchor #:angle angle
#:point-color point-color #:point-fill-color point-fill-color #:point-size point-size
#:point-line-width point-line-width #:point-sym point-sym
#:alpha alpha))
@ -288,6 +292,7 @@
[f (real? . -> . real?)] [x real?] [label (or/c string? #f) #f]
[#:color color plot-color/c (plot-foreground)]
[#:size size (>=/c 0) (plot-font-size)]
[#:face face (or/c string? #f) (plot-font-face)]
[#:family family font-family/c (plot-font-family)]
[#:anchor anchor anchor/c (label-anchor)]
[#:angle angle real? (label-angle)]
@ -299,7 +304,7 @@
[#:alpha alpha (real-in 0 1) (label-alpha)]
) renderer2d?
(point-label (vector x (f x)) label
#:color color #:size size #:family family #:anchor anchor #:angle angle
#:color color #:size size #:face face #:family family #:anchor anchor #:angle angle
#:point-color point-color #:point-fill-color point-fill-color #:point-size point-size
#:point-line-width point-line-width #:point-sym point-sym
#:alpha alpha))
@ -308,6 +313,7 @@
[f (real? . -> . real?)] [y real?] [label (or/c string? #f) #f]
[#:color color plot-color/c (plot-foreground)]
[#:size size (>=/c 0) (plot-font-size)]
[#:face face (or/c string? #f) (plot-font-face)]
[#:family family font-family/c (plot-font-family)]
[#:anchor anchor anchor/c (label-anchor)]
[#:angle angle real? (label-angle)]
@ -319,7 +325,7 @@
[#:alpha alpha (real-in 0 1) (label-alpha)]
) renderer2d?
(point-label (vector (f y) y) label
#:color color #:size size #:family family #:anchor anchor #:angle angle
#:color color #:size size #:face face #:family family #:anchor anchor #:angle angle
#:point-color point-color #:point-fill-color point-fill-color #:point-size point-size
#:point-line-width point-line-width #:point-sym point-sym
#:alpha alpha))

View File

@ -463,7 +463,10 @@
(define/public (put-font-size size) (send pd set-font-size size))
(define/public (put-font-family family) (send pd set-font-family family))
(define/public (put-font size family) (send pd set-font size family))
(define/public put-font
(case-lambda
[(size family) (send pd set-font size #f family)]
[(size face family) (send pd set-font size face family)]))
(define/public (put-text-foreground color) (send pd set-text-foreground color))
(define/public (reset-drawing-params)
@ -471,7 +474,7 @@
(put-pen (plot-foreground) (plot-line-width) 'solid)
(put-brush (plot-background) 'solid)
(put-background (plot-background))
(put-font (plot-font-size) (plot-font-family))
(put-font (plot-font-size) (plot-font-face) (plot-font-family))
(put-text-foreground (plot-foreground)))
;; Shapes

View File

@ -23,7 +23,7 @@
(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
(define ((label3d-render-proc label v color size face family anchor angle
point-color point-fill-color point-size point-line-width point-sym
alpha)
area)
@ -31,7 +31,7 @@
(send area put-alpha alpha)
; label
(send area put-text-foreground color)
(send area put-font size family)
(send area put-font size face family)
(send area put-text (string-append " " label " ") v anchor angle (* 1/2 point-size)
#:outline? #t #:layer plot3d-front-layer)
; point
@ -45,6 +45,7 @@
[v (sequence/c real?)] [label (or/c string? #f) #f]
[#:color color plot-color/c (plot-foreground)]
[#:size size (>=/c 0) (plot-font-size)]
[#:face face (or/c string? #f) (plot-font-face)]
[#:family family font-family/c (plot-font-family)]
[#:anchor anchor anchor/c (label-anchor)]
[#:angle angle real? (label-angle)]
@ -59,7 +60,7 @@
(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
label v color size face 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

View File

@ -923,6 +923,7 @@
(define background-color '(255 255 255))
(define font-size 11)
(define font-face #f)
(define font-family 'roman)
(define text-foreground '(0 0 0))
@ -949,11 +950,18 @@
(set! background-color (->brush-color color)))
(define/public (put-font-size size) (set! font-size size))
(define/public (put-font-face face) (set! font-face face))
(define/public (put-font-family family) (set! font-family family))
(define/public (put-font size family)
(put-font-size size)
(put-font-family family))
(define/public put-font
(case-lambda
[(size family)
(put-font-size size)
(put-font-family family)]
[(size face family)
(put-font-size size)
(put-font-face face)
(put-font-family family)]))
(define/public (put-text-foreground c)
(set! text-foreground (->pen-color c)))
@ -963,7 +971,7 @@
(put-pen (plot-foreground) (plot-line-width) 'solid)
(put-brush (plot-background) 'solid)
(put-background (plot-background))
(put-font (plot-font-size) (plot-font-family))
(put-font (plot-font-size) (plot-font-face) (plot-font-family))
(put-text-foreground (plot-foreground)))
;; Drawing shapes