From 954f3c52d4d65af0788b9b318afc7b3abdc1fbd9 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Thu, 10 Jul 2014 23:55:00 -0500
Subject: [PATCH] add plot-font-face and use the-font-list to cache fonts

---
 .../plot-doc/plot/scribblings/params.scrbl    |  1 +
 .../plot/private/common/parameters.rkt        |  3 +-
 .../plot/private/common/plot-device.rkt       | 28 +++++++++++++------
 .../plot/private/contracted/parameters.rkt    |  2 +-
 .../plot/private/plot2d/decoration.rkt        | 20 ++++++++-----
 .../plot/private/plot2d/plot-area.rkt         |  7 +++--
 .../plot/private/plot3d/decoration.rkt        |  7 +++--
 .../plot/private/plot3d/plot-area.rkt         | 16 ++++++++---
 8 files changed, 57 insertions(+), 27 deletions(-)

diff --git a/pkgs/plot-pkgs/plot-doc/plot/scribblings/params.scrbl b/pkgs/plot-pkgs/plot-doc/plot/scribblings/params.scrbl
index e7a3a5b40c..0a75379a6e 100644
--- a/pkgs/plot-pkgs/plot-doc/plot/scribblings/params.scrbl
+++ b/pkgs/plot-pkgs/plot-doc/plot/scribblings/params.scrbl
@@ -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.)}
 
diff --git a/pkgs/plot-pkgs/plot-lib/plot/private/common/parameters.rkt b/pkgs/plot-pkgs/plot-lib/plot/private/common/parameters.rkt
index ea2f558d5d..e8984c1d8d 100644
--- a/pkgs/plot-pkgs/plot-lib/plot/private/common/parameters.rkt
+++ b/pkgs/plot-pkgs/plot-lib/plot/private/common/parameters.rkt
@@ -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?
diff --git a/pkgs/plot-pkgs/plot-lib/plot/private/common/plot-device.rkt b/pkgs/plot-pkgs/plot-lib/plot/private/common/plot-device.rkt
index 543082c243..321865f24c 100644
--- a/pkgs/plot-pkgs/plot-lib/plot/private/common/plot-device.rkt
+++ b/pkgs/plot-pkgs/plot-lib/plot/private/common/plot-device.rkt
@@ -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)
diff --git a/pkgs/plot-pkgs/plot-lib/plot/private/contracted/parameters.rkt b/pkgs/plot-pkgs/plot-lib/plot/private/contracted/parameters.rkt
index 16c695cab8..f8456c09bb 100644
--- a/pkgs/plot-pkgs/plot-lib/plot/private/contracted/parameters.rkt
+++ b/pkgs/plot-pkgs/plot-lib/plot/private/contracted/parameters.rkt
@@ -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?
diff --git a/pkgs/plot-pkgs/plot-lib/plot/private/plot2d/decoration.rkt b/pkgs/plot-pkgs/plot-lib/plot/private/plot2d/decoration.rkt
index 56435b9da7..3bbaf19ccb 100644
--- a/pkgs/plot-pkgs/plot-lib/plot/private/plot2d/decoration.rkt
+++ b/pkgs/plot-pkgs/plot-lib/plot/private/plot2d/decoration.rkt
@@ -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))
diff --git a/pkgs/plot-pkgs/plot-lib/plot/private/plot2d/plot-area.rkt b/pkgs/plot-pkgs/plot-lib/plot/private/plot2d/plot-area.rkt
index 76b302ea8f..d5d237e321 100644
--- a/pkgs/plot-pkgs/plot-lib/plot/private/plot2d/plot-area.rkt
+++ b/pkgs/plot-pkgs/plot-lib/plot/private/plot2d/plot-area.rkt
@@ -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
diff --git a/pkgs/plot-pkgs/plot-lib/plot/private/plot3d/decoration.rkt b/pkgs/plot-pkgs/plot-lib/plot/private/plot3d/decoration.rkt
index fcf49ee5bf..9192f7386e 100644
--- a/pkgs/plot-pkgs/plot-lib/plot/private/plot3d/decoration.rkt
+++ b/pkgs/plot-pkgs/plot-lib/plot/private/plot3d/decoration.rkt
@@ -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
diff --git a/pkgs/plot-pkgs/plot-lib/plot/private/plot3d/plot-area.rkt b/pkgs/plot-pkgs/plot-lib/plot/private/plot3d/plot-area.rkt
index 8b1440996e..246bc6c2da 100644
--- a/pkgs/plot-pkgs/plot-lib/plot/private/plot3d/plot-area.rkt
+++ b/pkgs/plot-pkgs/plot-lib/plot/private/plot3d/plot-area.rkt
@@ -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