From 567ee96c61fba326ea79d0561cc3e61eabcffe71 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 26 Nov 2011 08:48:35 -0700 Subject: [PATCH] racket/draw: generalize "face" in a font% to be a description Also add an option to `get-face-list' so that it can actually return faces, instead of just families. --- collects/racket/draw/private/font.rkt | 67 +++++++++++-------- collects/racket/draw/unsafe/pango.rkt | 10 +++ collects/scribblings/draw/draw-funcs.scrbl | 22 +++--- collects/scribblings/draw/font-class.scrbl | 14 ++-- .../draw/font-name-directory-intf.scrbl | 23 +++++-- 5 files changed, 86 insertions(+), 50 deletions(-) diff --git a/collects/racket/draw/private/font.rkt b/collects/racket/draw/private/font.rkt index 547a467633..7e8d7809b5 100644 --- a/collects/racket/draw/private/font.rkt +++ b/collects/racket/draw/private/font.rkt @@ -133,27 +133,27 @@ (and desc (install! desc) desc)) - (let* ([desc (pango_font_description_new)]) - (pango_font_description_set_family desc - (if ps? - (send the-font-name-directory - get-post-script-name - id - weight - style) - (send the-font-name-directory - get-screen-name - id - weight - style))) - (pango_font_description_set_style desc (case style - [(normal) PANGO_STYLE_NORMAL] - [(italic) PANGO_STYLE_ITALIC] - [(slant) PANGO_STYLE_OBLIQUE])) - (pango_font_description_set_weight desc (case weight - [(normal) PANGO_WEIGHT_MEDIUM] - [(light) PANGO_WEIGHT_LIGHT] - [(bold) PANGO_WEIGHT_BOLD])) + (let* ([desc (pango_font_description_from_string (if ps? + (send the-font-name-directory + get-post-script-name + id + weight + style) + (send the-font-name-directory + get-screen-name + id + weight + style)))]) + (unless (eq? style 'normal) + (pango_font_description_set_style desc (case style + [(normal) PANGO_STYLE_NORMAL] + [(italic) PANGO_STYLE_ITALIC] + [(slant) PANGO_STYLE_OBLIQUE]))) + (unless (eq? weight 'normal) + (pango_font_description_set_weight desc (case weight + [(normal) PANGO_WEIGHT_MEDIUM] + [(light) PANGO_WEIGHT_LIGHT] + [(bold) PANGO_WEIGHT_BOLD]))) (if size-in-pixels? (pango_font_description_set_absolute_size desc (* size PANGO_SCALE)) (pango_font_description_set_size desc (inexact->exact (floor (* size PANGO_SCALE))))) @@ -287,14 +287,25 @@ (define the-font-list (new font-list%)) -(define (get-face-list [mode 'all]) +(define (get-face-list [mode 'all] #:all-variants? [all-variants? #f]) + (unless (or (eq? mode 'all) (eq? mode 'mono)) + (raise-type-error get-face-list "'all or 'mono" mode)) (sort - (map pango_font_family_get_name - (let ([fams (pango_font_map_list_families - (pango_cairo_font_map_get_default))]) - (if (eq? mode 'mono) - (filter pango_font_family_is_monospace fams) - fams))) + (apply + append + (for/list ([fam (in-list + (let ([fams (pango_font_map_list_families + (pango_cairo_font_map_get_default))]) + (if (eq? mode 'mono) + (filter pango_font_family_is_monospace fams) + fams)))]) + (if (not all-variants?) + (list (pango_font_family_get_name fam)) + (for/list ([face (in-list (pango_font_family_list_faces fam))]) + (string-append + (pango_font_family_get_name fam) + " " + (pango_font_face_get_face_name face)))))) string _void + -> (begin0 + (for/list ([i (in-range len)]) + (ptr-ref faces PangoFontFace i)) + (g_free faces)))) +(define-pango pango_font_face_get_face_name (_pfun PangoFontFace -> _string)) (define-pango pango_font_description_free (_pfun PangoFontDescription -> _void) #:wrap (deallocator)) diff --git a/collects/scribblings/draw/draw-funcs.scrbl b/collects/scribblings/draw/draw-funcs.scrbl index 80d942c13d..10f6e40f32 100644 --- a/collects/scribblings/draw/draw-funcs.scrbl +++ b/collects/scribblings/draw/draw-funcs.scrbl @@ -8,18 +8,22 @@ @defparam[current-ps-setup pss (is-a?/c ps-setup%)]{ A parameter that determines the current PostScript configuration - settings. See @racket[post-script-dc%] and @racket[printer-dc%]. + settings. See @racket[post-script-dc%] and @racket[printer-dc%].} -} -@defproc[(get-face-list [family (one-of/c 'mono 'all) 'all]) +@defproc[(get-face-list [kind (one-of/c 'mono 'all) 'all] + [#:all-variants? all-variants? any/c #f]) (listof string?)]{ -Returns a list of font face names available on the current system. If - @racket['mono] is provided as the argument, then only faces that are - known to correspond to monospace fonts are included in the list. +Returns a list of font face names available on the current system. If + @racket[kind] is @racket['mono], then only faces that are known to + correspond to monospace fonts are included in the list. -} +If @racket[all-variants?] is @racket[#f] (the default), then the + result is in more standard terminology a list of font + family names, which are combined with style and weight options to + arrive at a face; if @racket[all-variants?] is true, then the result + includes a string for each available face in the family.} @defproc[(get-family-builtin-face [family (one-of/c 'default 'decorative 'roman 'script @@ -29,9 +33,7 @@ Returns a list of font face names available on the current system. If Returns the built-in default face mapping for a particular font family. -See @racket[font%] for information about @racket[family]. - -} +See @racket[font%] for information about @racket[family].} @defproc[(make-bitmap [width exact-positive-integer?] diff --git a/collects/scribblings/draw/font-class.scrbl b/collects/scribblings/draw/font-class.scrbl index a87cb8ab3d..3a8455fa51 100644 --- a/collects/scribblings/draw/font-class.scrbl +++ b/collects/scribblings/draw/font-class.scrbl @@ -28,11 +28,15 @@ A @defterm{font} is an object which determines the appearance of text, but see @racket[normal-control-font])} ] - @margin-note{The terminology ``family'' and ``face'' is mangled relative - to its usual meaning. A @racket[font%] ``face'' is really - a font family in the usual terminology, while a @racket[font%] - ``family'' is a kind of abstract font family that is mapped to a - particular font family on a given platform.}} + @margin-note{The terminology ``family'' and ``face'' is mangled + relative to its usual meaning. A @racket[font%] ``face'' + is really used more like a font family in the usual + terminology, or more generally as a face-description + string that is combined with other @racket[font%] + attributes to arrive at a face. A @racket[font%] + ``family'' is a kind of abstract font family that is + mapped to a particular font family on a given + platform.}} @item{face --- A string face name, such as @racket["Courier"]. The format and meaning of a face name is platform- and diff --git a/collects/scribblings/draw/font-name-directory-intf.scrbl b/collects/scribblings/draw/font-name-directory-intf.scrbl index 2199b734b3..f19a1f586c 100644 --- a/collects/scribblings/draw/font-name-directory-intf.scrbl +++ b/collects/scribblings/draw/font-name-directory-intf.scrbl @@ -26,11 +26,20 @@ To extract mapping information from @racket[the-font-name-directory], For a family without a face string, the corresponding font ID has a useful built-in mapping for every platform and device. For a family with a face string, @racket[the-font-name-directory] interprets the string - (in a platform-specific way) to generate a mapping for ``screen'' + (in a platform-specific way) to generate a mapping for drawing (to a canvas's @racket[dc<%>], a @racket[bitmap-dc%], or a - @racket[printer-dc%]). When drawing to a @racket[post-script-dc%] - object, the face-specific mapping defaults to the family's mapping. + @racket[printer-dc%]). +Currently, on all platforms, a face string is interpreted as a + @hyperlink["http://www.pango.org"]{Pango} font description. A + description can be a family name such as @racket["Helvetica"], a face + name such as @racket["Helvetica Bold"], or a list of comma-separated + families followed by space-separated font options such as + @racket["Helvetica,Arial bold italic"]. Any size in a font + description is overridden by a given @racket[font%]'s size. Any + (slant) style or weight options in a font description are overridden + by a non-@racket['normal] value for a given @racket[font%]'s style + or weight, respectively. @defmethod[(find-family-default-font-id [family (one-of/c 'default 'decorative 'roman 'script 'swiss 'modern 'symbol 'system)]) @@ -91,7 +100,7 @@ Font ID are useful only as mapping indices for [style (one-of/c 'normal 'italic 'slant)]) (or/c string? false/c)]{ -Gets a PostScript font name for a font ID, weight, and style +Gets a PostScript font description for a font ID, weight, and style combination. See @racket[font%] for information about @racket[weight] and @@ -104,7 +113,7 @@ See @racket[font%] for information about @racket[weight] and [style (one-of/c 'normal 'italic 'slant)]) (or/c string? false/c)]{ -Gets a platform-dependent screen font name (used for drawing to a +Gets a platform-dependent screen font description (used for drawing to a canvas's @racket[dc<%>], a @racket[bitmap-dc%], or a @racket[printer-dc%]) for a font ID, weight, and style combination. @@ -119,7 +128,7 @@ See @racket[font%] for information about @racket[weight] and [name string?]) void?]{ -Sets a PostScript font name for a font ID, weight, and style +Sets a PostScript font description for a font ID, weight, and style combination. See also @method[font-name-directory<%> get-post-script-name]. @@ -133,7 +142,7 @@ See @racket[font%] for information about @racket[weight] and @racket[style]. [name string?]) void?]{ -Sets a platform-dependent screen font name (used for drawing to a +Sets a platform-dependent screen font description (used for drawing to a canvas's @racket[dc<%>], a @racket[bitmap-dc%], or a @racket[printer-dc%]) for a font ID, weight, and style combination.