basis/pango/layouts/layouts.factor

   1 ! Copyright (C) 2008 Matthew Willis.
   2 ! Copyright (C) 2009 Slava Pestov.
   3 ! See http://factorcode.org/license.txt for BSD license.
   4 USING: arrays sequences alien alien.c-types alien.destructors
   5 alien.syntax math math.functions math.vectors destructors combinators
   6 colors fonts accessors assocs namespaces kernel pango pango.fonts
   7 pango.cairo cairo cairo.ffi glib unicode.data images cache init
   8 math.rectangles fry memoize io.encodings.utf8 ;
   9 IN: pango.layouts
  10
  11 LIBRARY: pango
  12
  13 FUNCTION: PangoLayout*
  14 pango_layout_new ( PangoContext* context ) ;
  15
  16 FUNCTION: PangoContext*
  17 pango_layout_get_context ( PangoLayout* layout ) ;
  18
  19 FUNCTION: void
  20 pango_layout_set_text ( PangoLayout* layout, char* text, int length ) ;
  21
  22 FUNCTION: char*
  23 pango_layout_get_text ( PangoLayout* layout ) ;
  24
  25 FUNCTION: void
  26 pango_layout_get_size ( PangoLayout* layout, int* width, int* height ) ;
  27
  28 FUNCTION: void
  29 pango_layout_set_font_description ( PangoLayout* layout, PangoFontDescription* desc ) ;
  30
  31 FUNCTION: PangoFontDescription*
  32 pango_layout_get_font_description ( PangoLayout* layout ) ;
  33
  34 FUNCTION: void
  35 pango_layout_get_pixel_size ( PangoLayout* layout, int* width, int* height ) ;
  36
  37 FUNCTION: void
  38 pango_layout_get_extents ( PangoLayout* layout, PangoRectangle* ink_rect, PangoRectangle* logical_rect ) ;
  39
  40 FUNCTION: void
  41 pango_layout_get_pixel_extents ( PangoLayout* layout, PangoRectangle* ink_rect, PangoRectangle* logical_rect ) ;
  42
  43 FUNCTION: PangoLayoutLine*
  44 pango_layout_get_line_readonly ( PangoLayout* layout, int line ) ;
  45
  46 FUNCTION: void
  47 pango_layout_line_index_to_x ( PangoLayoutLine* line, int index_, uint trailing, int* x_pos ) ;
  48
  49 FUNCTION: gboolean
  50 pango_layout_line_x_to_index ( PangoLayoutLine* line, int x_pos, int* index_, int* trailing ) ;
  51
  52 FUNCTION: PangoLayoutIter*
  53 pango_layout_get_iter ( PangoLayout* layout ) ;
  54
  55 FUNCTION: int
  56 pango_layout_iter_get_baseline ( PangoLayoutIter* iter ) ;
  57
  58 FUNCTION: void
  59 pango_layout_iter_free ( PangoLayoutIter* iter ) ;
  60
  61 DESTRUCTOR: pango_layout_iter_free
  62
  63 TUPLE: layout < disposable font string selection layout metrics ink-rect logical-rect image ;
  64
  65 SYMBOL: dpi
  66
  67 72 dpi set-global
  68
  69 : set-layout-font ( font layout -- )
  70     swap cache-font-description pango_layout_set_font_description ;
  71
  72 : set-layout-text ( str layout -- )
  73     #! Replace nulls with something else since Pango uses null-terminated
  74     #! strings
  75     swap -1 pango_layout_set_text ;
  76
  77 : set-layout-resolution ( layout -- )
  78     pango_layout_get_context dpi get pango_cairo_context_set_resolution ;
  79
  80 : <PangoLayout> ( text font -- layout )
  81     dummy-cairo pango_cairo_create_layout |g_object_unref
  82     [ set-layout-resolution ] keep
  83     [ set-layout-font ] keep
  84     [ set-layout-text ] keep ;
  85
  86 : layout-extents ( layout -- ink-rect logical-rect )
  87     "PangoRectangle" <c-object>
  88     "PangoRectangle" <c-object>
  89     [ pango_layout_get_extents ] 2keep
  90     [ PangoRectangle>rect ] bi@ ;
  91
  92 : glyph-height ( font string -- y )
  93     swap <PangoLayout> &g_object_unref layout-extents drop dim>> second ;
  94
  95 MEMO: missing-font-metrics ( font -- metrics )
  96     #! Pango doesn't provide x-height and cap-height but Core Text does, so we
  97     #! simulate them on Pango.
  98     [
  99         [ metrics new ] dip
 100         [ "x" glyph-height >>x-height ]
 101         [ "Y" glyph-height >>cap-height ] bi
 102     ] with-destructors ;
 103
 104 : layout-baseline ( layout -- baseline )
 105     pango_layout_get_iter &pango_layout_iter_free
 106     pango_layout_iter_get_baseline
 107     pango>float ;
 108
 109 : set-foreground ( cr font -- )
 110     foreground>> set-source-color ;
 111
 112 : fill-background ( cr font dim -- )
 113     [ background>> set-source-color ]
 114     [ [ { 0 0 } ] dip <rect> fill-rect ] bi-curry* bi ;
 115
 116 : rect-translate-x ( rect x -- rect' )
 117     '[ _ 0 2array v- ] change-loc ;
 118
 119 : first-line ( layout -- line )
 120     layout>> 0 pango_layout_get_line_readonly ;
 121
 122 : line-offset>x ( layout n -- x )
 123     #! n is an index into the UTF8 encoding of the text
 124     [ drop first-line ] [ swap string>> >utf8-index ] 2bi
 125     0 0 <int> [ pango_layout_line_index_to_x ] keep
 126     *int pango>float ;
 127
 128 : x>line-offset ( layout x -- n )
 129     #! n is an index into the UTF8 encoding of the text
 130     [
 131         [ first-line ] dip
 132         float>pango 0 <int> 0 <int>
 133         [ pango_layout_line_x_to_index drop ] 2keep
 134         [ *int ] bi@ swap
 135     ] [ drop string>> ] 2bi utf8-index> + ;
 136
 137 : selection-start/end ( selection -- start end )
 138     selection>> [ start>> ] [ end>> ] bi ;
 139
 140 : selection-rect ( layout -- rect )
 141     [ ink-rect>> dim>> ] [ ] [ selection-start/end ] tri [ line-offset>x ] bi-curry@ bi
 142     [ drop nip 0 2array ] [ swap - swap second 2array ] 3bi <rect> ;
 143
 144 : fill-selection-background ( cr layout -- )
 145     dup selection>> [
 146         [ selection>> color>> set-source-color ]
 147         [
 148             [ selection-rect ] [ ink-rect>> loc>> first ] bi
 149             rect-translate-x
 150             fill-rect
 151         ] 2bi
 152     ] [ 2drop ] if ;
 153
 154 : text-position ( layout -- loc )
 155     [ logical-rect>> ] [ ink-rect>> ] bi [ loc>> ] bi@ v- ;
 156
 157 : set-text-position ( cr loc -- )
 158     first2 cairo_move_to ;
 159
 160 : layout-metrics ( layout -- metrics )
 161     dup font>> missing-font-metrics clone
 162         swap
 163         [ layout>> layout-baseline >>ascent ]
 164         [ logical-rect>> dim>> [ first >>width ] [ second >>height ] bi ] bi
 165         dup [ height>> ] [ ascent>> ] bi - >>descent ;
 166
 167 : draw-layout ( layout -- image )
 168     dup ink-rect>> dim>> [ >fixnum ] map [
 169         swap {
 170             [ layout>> pango_cairo_update_layout ]
 171             [ [ font>> ] [ ink-rect>> dim>> ] bi fill-background ]
 172             [ fill-selection-background ]
 173             [ text-position set-text-position ]
 174             [ font>> set-foreground ]
 175             [ layout>> pango_cairo_show_layout ]
 176         } 2cleave
 177     ] make-bitmap-image ;
 178
 179 : escape-nulls ( str -- str' )
 180     { { 0 CHAR: zero-width-no-break-space } } substitute ;
 181
 182 : unpack-selection ( layout string/selection -- layout )
 183     dup selection? [
 184         [ string>> escape-nulls >>string ] [ >>selection ] bi
 185     ] [ escape-nulls >>string ] if ; inline
 186
 187 : <layout> ( font string -- line )
 188     [
 189         layout new-disposable
 190             swap unpack-selection
 191             swap >>font
 192             dup [ string>> ] [ font>> ] bi <PangoLayout> >>layout
 193             dup layout>> layout-extents [ >>ink-rect ] [ >>logical-rect ] bi*
 194             dup layout-metrics >>metrics
 195             dup draw-layout >>image
 196     ] with-destructors ;
 197
 198 M: layout dispose* layout>> g_object_unref ;
 199
 200 SYMBOL: cached-layouts
 201
 202 : cached-layout ( font string -- layout )
 203     cached-layouts get [ <layout> ] 2cache ;
 204
 205 : cached-line ( font string -- line )
 206     cached-layout layout>> first-line ;
 207
 208 [ <cache-assoc> cached-layouts set-global ] "pango.layouts" add-init-hook