From be272a0bde65f2184f0215529cdcf6a9a46a7fe1 Mon Sep 17 00:00:00 2001 From: Anton Gorenko Date: Sun, 23 May 2010 16:10:41 +0600 Subject: [PATCH] change Pango-based ui.text backend (move all util words from pango and pango.cairo vocabularies to ui.text.pango) --- basis/ui/text/pango/pango.factor | 182 ++++++++++++++++++++++++++++++- 1 file changed, 179 insertions(+), 3 deletions(-) diff --git a/basis/ui/text/pango/pango.factor b/basis/ui/text/pango/pango.factor index 9cea94bec4..b3aa858507 100644 --- a/basis/ui/text/pango/pango.factor +++ b/basis/ui/text/pango/pango.factor @@ -1,10 +1,180 @@ ! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs cache kernel math math.vectors -namespaces pango pango.cairo ui.text ui.text.private -sequences ; +USING: accessors alien.c-types alien.strings arrays assocs cache cairo +cairo.ffi classes.struct combinators destructors fonts fry +init io.encodings.utf8 kernel math math.rectangles math.vectors +memoize namespaces sequences ui.text ui.text.private +gobject gobject.ffi pango pango.ffi pango.cairo pango.cairo.ffi ; IN: ui.text.pango +: pango>float ( n -- x ) PANGO_SCALE /f ; inline +: float>pango ( x -- n ) PANGO_SCALE * >integer ; inline + +MEMO: (cache-font-description) ( font -- description ) + [ + [ pango_font_description_new |pango_font_description_free ] dip { + [ name>> utf8 string>alien pango_font_description_set_family ] + [ size>> float>pango pango_font_description_set_size ] + [ bold?>> PANGO_WEIGHT_BOLD PANGO_WEIGHT_NORMAL ? pango_font_description_set_weight ] + [ italic?>> PANGO_STYLE_ITALIC PANGO_STYLE_NORMAL ? pango_font_description_set_style ] + [ drop ] + } 2cleave + ] with-destructors ; + +: cache-font-description ( font -- description ) + strip-font-colors (cache-font-description) ; + + +TUPLE: layout < disposable font string selection layout metrics ink-rect logical-rect image ; + +SYMBOL: dpi + +72 dpi set-global + +: set-layout-font ( font layout -- ) + swap cache-font-description pango_layout_set_font_description ; + +: set-layout-text ( str layout -- ) + swap utf8 string>alien -1 pango_layout_set_text ; + +: PangoRectangle>rect ( PangoRectangle -- rect ) + [ [ x>> pango>float ] [ y>> pango>float ] bi 2array ] + [ [ width>> pango>float ] [ height>> pango>float ] bi 2array ] bi + ; + +: layout-extents ( layout -- ink-rect logical-rect ) + PangoRectangle + PangoRectangle + [ pango_layout_get_extents ] 2keep + [ PangoRectangle>rect ] bi@ ; + +: 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 ; + +: fill-background ( cr font dim -- ) + [ background>> set-source-color ] + [ [ { 0 0 } ] dip fill-rect ] bi-curry* bi ; + +: rect-translate-x ( rect x -- rect' ) + '[ _ 0 2array v- ] change-loc ; + +: first-line ( layout -- line ) + layout>> 0 pango_layout_get_line_readonly ; + +: line-offset>x ( layout n -- x ) + #! n is an index into the UTF8 encoding of the text + [ drop first-line ] [ swap string>> >utf8-index ] 2bi + 0 0 [ pango_layout_line_index_to_x ] keep + *int pango>float ; + +: x>line-offset ( layout x -- n ) + #! n is an index into the UTF8 encoding of the text + [ + [ first-line ] dip + float>pango 0 0 + [ pango_layout_line_x_to_index drop ] 2keep + [ *int ] bi@ swap + ] [ drop string>> ] 2bi utf8-index> + ; + +: selection-start/end ( selection -- start end ) + selection>> [ start>> ] [ end>> ] bi ; + +: selection-rect ( layout -- rect ) + [ ink-rect>> dim>> ] [ ] [ selection-start/end ] tri [ line-offset>x ] bi-curry@ bi + [ drop nip 0 2array ] [ swap - swap second 2array ] 3bi ; + +: fill-selection-background ( cr layout -- ) + dup selection>> [ + [ selection>> color>> set-source-color ] + [ + [ selection-rect ] [ ink-rect>> loc>> first ] bi + rect-translate-x + fill-rect + ] 2bi + ] [ 2drop ] if ; + +: text-position ( layout -- loc ) + [ logical-rect>> ] [ ink-rect>> ] bi [ loc>> ] bi@ v- ; + +: set-text-position ( cr loc -- ) + first2 cairo_move_to ; + +: draw-layout ( layout -- image ) + dup ink-rect>> dim>> [ >fixnum ] map [ + swap { + [ layout>> pango_cairo_update_layout ] + [ [ font>> ] [ ink-rect>> dim>> ] bi fill-background ] + [ fill-selection-background ] + [ text-position set-text-position ] + [ font>> set-foreground ] + [ layout>> pango_cairo_show_layout ] + } 2cleave + ] make-bitmap-image ; + +: escape-nulls ( str -- str' ) + #! Replace nulls with something else since Pango uses null-terminated + #! strings + { { 0 CHAR: zero-width-no-break-space } } substitute ; + +: unpack-selection ( layout string/selection -- layout ) + dup selection? [ + [ string>> escape-nulls >>string ] [ >>selection ] bi + ] [ escape-nulls >>string ] if ; inline + +: set-layout-resolution ( layout -- ) + pango_layout_get_context dpi get pango_cairo_context_set_resolution ; + +: ( text font -- layout ) + dummy-cairo pango_cairo_create_layout |g_object_unref + [ set-layout-resolution ] keep + [ set-layout-font ] keep + [ set-layout-text ] keep ; + +: glyph-height ( font string -- y ) + swap &g_object_unref layout-extents drop dim>> second ; + +MEMO: missing-font-metrics ( font -- metrics ) + #! Pango doesn't provide x-height and cap-height but Core Text does, so we + #! simulate them on Pango. + [ + [ metrics new ] dip + [ "x" glyph-height >>x-height ] + [ "Y" glyph-height >>cap-height ] bi + ] with-destructors ; + +: layout-metrics ( layout -- metrics ) + dup font>> missing-font-metrics clone + swap + [ layout>> layout-baseline >>ascent ] + [ logical-rect>> dim>> [ first >>width ] [ second >>height ] bi ] bi + dup [ height>> ] [ ascent>> ] bi - >>descent ; + +: ( font string -- line ) + [ + layout new-disposable + swap unpack-selection + swap >>font + dup [ string>> ] [ font>> ] bi >>layout + dup layout>> layout-extents [ >>ink-rect ] [ >>logical-rect ] bi* + dup layout-metrics >>metrics + dup draw-layout >>image + ] with-destructors ; + +M: layout dispose* layout>> g_object_unref ; + +SYMBOL: cached-layouts + +: cached-layout ( font string -- layout ) + cached-layouts get [ ] 2cache ; + +: cached-line ( font string -- line ) + cached-layout layout>> first-line ; + SINGLETON: pango-renderer M: pango-renderer string-dim @@ -31,4 +201,10 @@ M: pango-renderer line-metrics ( font string -- metrics ) [ cached-layout metrics>> ] if-empty ; +[ + \ (cache-font-description) reset-memoized + cached-layouts set-global +] "ui.text.pango" add-startup-hook + pango-renderer font-renderer set-global +