diff --git a/basis/pango/cairo/cairo.factor b/basis/pango/cairo/cairo.factor index 297991569f..e7c1e9fa8c 100644 --- a/basis/pango/cairo/cairo.factor +++ b/basis/pango/cairo/cairo.factor @@ -3,9 +3,7 @@ ! See http://factorcode.org/license.txt for BSD license. ! ! pangocairo bindings, from pango/pangocairo.h -USING: cairo.ffi alien.c-types math alien.syntax system destructors -memoize accessors kernel combinators alien arrays fonts pango -pango.fonts namespaces ; +USING: alien alien.syntax combinators system cairo.ffi ; IN: pango.cairo << "pangocairo" { @@ -87,40 +85,4 @@ FUNCTION: void pango_cairo_layout_path ( cairo_t* cr, PangoLayout* layout ) ; FUNCTION: void -pango_cairo_error_underline_path ( cairo_t* cr, double x, double y, double width, double height ) ; - -SYMBOL: dpi - -72 dpi set-global - -: dummy-pango-context ( -- context ) - \ dummy-pango-context [ - pango_context_new - ] initialize-alien ; - -MEMO: (cache-font) ( font -- open-font ) - [ - pango_cairo_font_map_get_default - dup dpi get pango_cairo_font_map_set_resolution - dummy-pango-context - ] dip - cache-font-description - pango_font_map_load_font ; - -: cache-font ( font -- open-font ) - strip-font-colors (cache-font) ; - -: get-font-metrics ( font -- metrics ) - (cache-font) f pango_font_get_metrics &pango_font_metrics_unref ; - -: parse-font-metrics ( metrics -- metrics' ) - [ metrics new ] dip - [ pango_font_metrics_get_ascent pango>float >>ascent ] - [ pango_font_metrics_get_descent pango>float >>descent ] bi - compute-height ; - -MEMO: (cache-font-metrics) ( font -- metrics ) - [ get-font-metrics parse-font-metrics ] with-destructors ; - -: cache-font-metrics ( font -- metrics ) - strip-font-colors (cache-font-metrics) ; \ No newline at end of file +pango_cairo_error_underline_path ( cairo_t* cr, double x, double y, double width, double height ) ; \ No newline at end of file diff --git a/basis/pango/layouts/layouts.factor b/basis/pango/layouts/layouts.factor index 4ea1080404..e8f96be48c 100644 --- a/basis/pango/layouts/layouts.factor +++ b/basis/pango/layouts/layouts.factor @@ -5,7 +5,7 @@ USING: arrays sequences alien alien.c-types alien.destructors alien.syntax math math.functions math.vectors destructors combinators colors fonts accessors assocs namespaces kernel pango pango.fonts pango.cairo cairo cairo.ffi glib unicode.data images cache init -math.rectangles fry ; +math.rectangles fry memoize ; IN: pango.layouts LIBRARY: pango @@ -31,8 +31,8 @@ pango_layout_get_font_description ( PangoLayout* layout ) ; FUNCTION: void pango_layout_get_pixel_size ( PangoLayout* layout, int* width, int* height ) ; -FUNCTION: int -pango_layout_get_baseline ( PangoLayout* layout ) ; +FUNCTION: void +pango_layout_get_extents ( PangoLayout* layout, PangoRectangle* ink_rect, PangoRectangle* logical_rect ) ; FUNCTION: void pango_layout_get_pixel_extents ( PangoLayout* layout, PangoRectangle* ink_rect, PangoRectangle* logical_rect ) ; @@ -59,20 +59,35 @@ DESTRUCTOR: pango_layout_iter_free TUPLE: layout font string layout metrics ink-rect logical-rect image disposed ; -: layout-dim ( layout -- dim ) - 0 0 [ pango_layout_get_pixel_size ] 2keep - [ *int ] bi@ 2array ; +SYMBOL: dpi -: layout-extents ( layout -- ink-rect logical-rect ) - "PangoRectangle" - "PangoRectangle" - [ pango_layout_get_pixel_extents ] 2keep - [ PangoRectangle>rect ] bi@ ; +72 dpi set-global -: layout-baseline ( layout -- baseline ) - pango_layout_get_iter &pango_layout_iter_free - pango_layout_iter_get_baseline - pango>float ; +: dummy-pango-context ( -- context ) + \ dummy-pango-context [ + pango_context_new + ] initialize-alien ; + +MEMO: (cache-font) ( font -- open-font ) + [ + pango_cairo_font_map_get_default + dup dpi get pango_cairo_font_map_set_resolution + dummy-pango-context + ] dip + cache-font-description + pango_font_map_load_font ; + +: cache-font ( font -- open-font ) + strip-font-colors (cache-font) ; + +: get-font-metrics ( font -- metrics ) + f pango_font_get_metrics &pango_font_metrics_unref ; + +: parse-font-metrics ( metrics -- metrics' ) + [ metrics new ] dip + [ pango_font_metrics_get_ascent pango>float >>ascent ] + [ pango_font_metrics_get_descent pango>float >>descent ] bi + compute-height ; : set-layout-font ( str layout -- ) swap pango_layout_set_font_description ; @@ -90,6 +105,40 @@ TUPLE: layout font string layout metrics ink-rect logical-rect image disposed ; [ set-layout-font ] keep [ set-layout-text ] keep ; +: layout-extents ( layout -- ink-rect logical-rect ) + "PangoRectangle" + "PangoRectangle" + [ pango_layout_get_extents ] 2keep + [ PangoRectangle>rect ] bi@ ; + +: glyph-height ( font string -- y ) + swap &g_object_unref layout-extents drop dim>> second ; + +: missing-font-metrics ( metrics font -- metrics ) + #! Pango doesn't provide these, but Core Text does, so we + #! simulate them on Pango. + [ "x" glyph-height >>x-height ] + [ "Y" glyph-height >>cap-height ] + bi ; + +MEMO: (cache-font-metrics) ( font -- metrics ) + [ + (cache-font) + [ + get-font-metrics + parse-font-metrics + ] keep + missing-font-metrics + ] with-destructors ; + +: cache-font-metrics ( font -- metrics ) + strip-font-colors (cache-font-metrics) ; + +: layout-baseline ( layout -- baseline ) + pango_layout_get_iter &pango_layout_iter_free + pango_layout_iter_get_baseline + pango>float ; + : set-foreground ( cr font -- ) foreground>> set-source-color ; @@ -130,17 +179,18 @@ TUPLE: layout font string layout metrics ink-rect logical-rect image disposed ; : set-text-position ( cr loc -- ) first2 cairo_move_to ; -: layout-metrics ( dim baseline -- metrics ) - metrics new - swap >>ascent - swap first2 [ >>width ] [ >>height ] bi* +: layout-metrics ( layout -- metrics ) + dup font>> cache-font-metrics clone + swap + [ layout>> layout-baseline >>ascent ] + [ logical-rect>> dim>> [ first >>width ] [ second >>height ] bi ] bi dup [ height>> ] [ ascent>> ] bi - >>descent ; : text-position ( layout -- loc ) [ logical-rect>> ] [ ink-rect>> ] bi [ loc>> ] bi@ v- ; : draw-layout ( layout -- image ) - dup ink-rect>> dim>> [ + dup ink-rect>> dim>> [ >fixnum ] map [ swap { [ layout>> pango_cairo_update_layout ] [ [ font>> ] [ ink-rect>> dim>> ] bi fill-background ] @@ -158,7 +208,7 @@ TUPLE: layout font string layout metrics ink-rect logical-rect image disposed ; swap >>font dup [ string>> ] [ font>> cache-font-description ] bi >>layout dup layout>> layout-extents [ >>ink-rect ] [ >>logical-rect ] bi* - dup [ logical-rect>> dim>> ] [ layout>> layout-baseline ] bi layout-metrics >>metrics + dup layout-metrics >>metrics dup draw-layout >>image ] with-destructors ; diff --git a/basis/pango/pango.factor b/basis/pango/pango.factor index ab0bca2b8b..3a0e2f1cce 100644 --- a/basis/pango/pango.factor +++ b/basis/pango/pango.factor @@ -32,6 +32,6 @@ C-STRUCT: PangoRectangle { "int" "height" } ; : PangoRectangle>rect ( PangoRectangle -- rect ) - [ [ PangoRectangle-x ] [ PangoRectangle-y ] bi 2array ] - [ [ PangoRectangle-width ] [ PangoRectangle-height ] bi 2array ] bi + [ [ PangoRectangle-x pango>float ] [ PangoRectangle-y pango>float ] bi 2array ] + [ [ PangoRectangle-width pango>float ] [ PangoRectangle-height pango>float ] bi 2array ] bi ; \ No newline at end of file diff --git a/basis/ui/text/pango/pango.factor b/basis/ui/text/pango/pango.factor index a0e3a06626..cbeb75d5f8 100644 --- a/basis/ui/text/pango/pango.factor +++ b/basis/ui/text/pango/pango.factor @@ -30,13 +30,10 @@ M: pango-renderer x>offset ( x font string -- n ) M: pango-renderer offset>x ( n font string -- x ) cached-line swap line-offset>x ; -: missing-metrics ( metrics -- metrics ) - 5 >>cap-height 5 >>x-height ; - M: pango-renderer font-metrics ( font -- metrics ) - cache-font-metrics missing-metrics ; + cache-font-metrics ; M: pango-renderer line-metrics ( font string -- metrics ) - cached-layout metrics>> missing-metrics ; + cached-layout metrics>> ; pango-renderer font-renderer set-global \ No newline at end of file