From 965e8f96d13d26cf34c9c5a42a7e27c29eeea989 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 10 Dec 2010 20:35:45 -0700 Subject: [PATCH] fix `get-char-height' and `get-char-width' in dc<%> Closes PR 11526 --- collects/racket/draw/private/bitmap-dc.rkt | 24 +++++++++++++-- collects/racket/draw/private/dc.rkt | 34 ++++++++++++++++++++-- collects/racket/draw/unsafe/pango.rkt | 9 ++++++ collects/tests/gracket/dc.rktl | 3 ++ 4 files changed, 65 insertions(+), 5 deletions(-) diff --git a/collects/racket/draw/private/bitmap-dc.rkt b/collects/racket/draw/private/bitmap-dc.rkt index b5b1159ccc..4ac570c946 100644 --- a/collects/racket/draw/private/bitmap-dc.rkt +++ b/collects/racket/draw/private/bitmap-dc.rkt @@ -85,7 +85,8 @@ get-size get-transformation set-transformation - scale) + scale + get-font) (super-new) @@ -149,6 +150,25 @@ (scale sx sy) (begin0 (draw-bitmap-section src (/ dest-x sx) (/ dest-y sy) src-x src-y src-w src-h style color mask) - (set-transformation t))))))) + (set-transformation t))))) + + (def/override (get-char-width) + (if (internal-get-bitmap) + (super get-char-width) + (send (get-temp-bitmap-dc) get-char-width))) + + (def/override (get-char-height) + (if (internal-get-bitmap) + (super get-char-height) + (send (get-temp-bitmap-dc) get-char-height))) + + (define temp-dc #f) + (define/private (get-temp-bitmap-dc) + (let ([dc (or (and temp-dc (weak-box-value temp-dc)) + (let ([dc (make-object bitmap-dc% (make-object bitmap% 1 1))]) + (set! temp-dc (make-weak-box dc)) + dc))]) + (send dc set-font (get-font)) + dc)))) (install-bitmap-dc-class! bitmap-dc%) diff --git a/collects/racket/draw/private/dc.rkt b/collects/racket/draw/private/dc.rkt index c8e1a98249..9c71ea07fe 100644 --- a/collects/racket/draw/private/dc.rkt +++ b/collects/racket/draw/private/dc.rkt @@ -1385,9 +1385,6 @@ (vector-set! vec 3 #f) (vector-set! vec 4 #f))))) - (def/public (get-char-width) - 10.0) - (def/public (start-doc [string? desc]) (check-ok 'start-doc)) (def/public (end-doc) @@ -1617,6 +1614,37 @@ (install-alternate-face c layout font desc attrs context) (zero? (pango_layout_get_unknown_glyphs_count layout)))) (g_object_unref layout)))))) + + (def/public (get-char-width) + (with-cr + 10.0 + cr + (get-font-metric cr pango_font_metrics_get_approximate_char_width))) + + (def/public (get-char-height) + (with-cr + 12.0 + cr + (get-font-metric cr (lambda (m) + (+ (pango_font_metrics_get_ascent m) + (pango_font_metrics_get_descent m)))))) + + (define/private (get-font-metric cr sel) + (let ([desc (get-pango font)] + [attrs (send font get-pango-attrs)] + [context+fontmap (or (for/or ([c (in-vector contexts)] + [fm (in-vector font-maps)]) + (and c (cons c fm))) + (cons + (pango_cairo_create_context cr) + (pango_cairo_font_map_new)))]) + (let ([font (pango_font_map_load_font (cdr context+fontmap) + (car context+fontmap) + desc)]) + (let ([metrics (pango_font_get_metrics font (pango_language_get_default))]) + (let ([v (sel metrics)]) + (pango_font_metrics_unref metrics) + (/ v (exact->inexact PANGO_SCALE))))))) (void)) diff --git a/collects/racket/draw/unsafe/pango.rkt b/collects/racket/draw/unsafe/pango.rkt index 873297050a..0b095f791b 100644 --- a/collects/racket/draw/unsafe/pango.rkt +++ b/collects/racket/draw/unsafe/pango.rkt @@ -53,6 +53,7 @@ (define PangoFontFamily (_cpointer 'PangoFontFamily)) (define PangoFont (_cpointer 'PangoFont)) (define PangoFontMap (_cpointer 'PangoFontMap)) +(define PangoFontMetrics (_cpointer 'PangoFontMetrics)) (define PangoAttrList (_cpointer 'PangoAttrList)) (define PangoAttribute (_cpointer 'PangoAttribute)) (define PangoLanguage (_cpointer 'PangoLanguage)) @@ -190,6 +191,14 @@ #:wrap (allocator pango_coverage_unref)) (define-pango pango_coverage_get (_fun PangoCoverage _int -> _int)) +(define-pango pango_font_metrics_unref (_fun PangoFontMetrics -> _void) + #:wrap (deallocator)) +(define-pango pango_font_get_metrics (_fun PangoFont PangoLanguage -> PangoFontMetrics) + #:wrap (allocator pango_font_metrics_unref)) +(define-pango pango_font_metrics_get_approximate_char_width (_fun PangoFontMetrics -> _int)) +(define-pango pango_font_metrics_get_ascent (_fun PangoFontMetrics -> _int)) +(define-pango pango_font_metrics_get_descent (_fun PangoFontMetrics -> _int)) + (define-pango pango_layout_get_unknown_glyphs_count (_fun PangoLayout -> _int)) (define-pango pango_attr_list_unref (_fun PangoAttrList -> _void) diff --git a/collects/tests/gracket/dc.rktl b/collects/tests/gracket/dc.rktl index afce8bc4c5..7213989f6a 100644 --- a/collects/tests/gracket/dc.rktl +++ b/collects/tests/gracket/dc.rktl @@ -72,6 +72,9 @@ (try-ok 'set-text-foreground (make-object color% "Yellow")) (try-ok 'set-text-mode 'transparent) + (try-ok 'get-char-height) + (try-ok 'get-char-width) + (try 'try-color (make-object color% "Yellow") (make-object color%))) (st #f mdc ok?)