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 classes.struct ;
13 FUNCTION: PangoLayout*
14 pango_layout_new ( PangoContext* context ) ;
16 FUNCTION: PangoContext*
17 pango_layout_get_context ( PangoLayout* layout ) ;
20 pango_layout_set_text ( PangoLayout* layout, char* text, int length ) ;
23 pango_layout_get_text ( PangoLayout* layout ) ;
26 pango_layout_get_size ( PangoLayout* layout, int* width, int* height ) ;
29 pango_layout_set_font_description ( PangoLayout* layout, PangoFontDescription* desc ) ;
31 FUNCTION: PangoFontDescription*
32 pango_layout_get_font_description ( PangoLayout* layout ) ;
35 pango_layout_get_pixel_size ( PangoLayout* layout, int* width, int* height ) ;
38 pango_layout_get_extents ( PangoLayout* layout, PangoRectangle* ink_rect, PangoRectangle* logical_rect ) ;
41 pango_layout_get_pixel_extents ( PangoLayout* layout, PangoRectangle* ink_rect, PangoRectangle* logical_rect ) ;
43 FUNCTION: PangoLayoutLine*
44 pango_layout_get_line_readonly ( PangoLayout* layout, int line ) ;
47 pango_layout_line_index_to_x ( PangoLayoutLine* line, int index_, uint trailing, int* x_pos ) ;
50 pango_layout_line_x_to_index ( PangoLayoutLine* line, int x_pos, int* index_, int* trailing ) ;
52 FUNCTION: PangoLayoutIter*
53 pango_layout_get_iter ( PangoLayout* layout ) ;
56 pango_layout_iter_get_baseline ( PangoLayoutIter* iter ) ;
59 pango_layout_iter_free ( PangoLayoutIter* iter ) ;
61 DESTRUCTOR: pango_layout_iter_free
63 TUPLE: layout < disposable font string selection layout metrics ink-rect logical-rect image ;
69 : set-layout-font ( font layout -- )
70 swap cache-font-description pango_layout_set_font_description ;
72 : set-layout-text ( str layout -- )
73 #! Replace nulls with something else since Pango uses null-terminated
75 swap -1 pango_layout_set_text ;
77 : set-layout-resolution ( layout -- )
78 pango_layout_get_context dpi get pango_cairo_context_set_resolution ;
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 ;
86 : layout-extents ( layout -- ink-rect logical-rect )
87 PangoRectangle <struct>
88 PangoRectangle <struct>
89 [ pango_layout_get_extents ] 2keep
90 [ PangoRectangle>rect ] bi@ ;
92 : glyph-height ( font string -- y )
93 swap <PangoLayout> &g_object_unref layout-extents drop dim>> second ;
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.
100 [ "x" glyph-height >>x-height ]
101 [ "Y" glyph-height >>cap-height ] bi
104 : layout-baseline ( layout -- baseline )
105 pango_layout_get_iter &pango_layout_iter_free
106 pango_layout_iter_get_baseline
109 : set-foreground ( cr font -- )
110 foreground>> set-source-color ;
112 : fill-background ( cr font dim -- )
113 [ background>> set-source-color ]
114 [ [ { 0 0 } ] dip <rect> fill-rect ] bi-curry* bi ;
116 : rect-translate-x ( rect x -- rect' )
117 '[ _ 0 2array v- ] change-loc ;
119 : first-line ( layout -- line )
120 layout>> 0 pango_layout_get_line_readonly ;
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
128 : x>line-offset ( layout x -- n )
129 #! n is an index into the UTF8 encoding of the text
132 float>pango 0 <int> 0 <int>
133 [ pango_layout_line_x_to_index drop ] 2keep
135 ] [ drop string>> ] 2bi utf8-index> + ;
137 : selection-start/end ( selection -- start end )
138 selection>> [ start>> ] [ end>> ] bi ;
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> ;
144 : fill-selection-background ( cr layout -- )
146 [ selection>> color>> set-source-color ]
148 [ selection-rect ] [ ink-rect>> loc>> first ] bi
154 : text-position ( layout -- loc )
155 [ logical-rect>> ] [ ink-rect>> ] bi [ loc>> ] bi@ v- ;
157 : set-text-position ( cr loc -- )
158 first2 cairo_move_to ;
160 : layout-metrics ( layout -- metrics )
161 dup font>> missing-font-metrics clone
163 [ layout>> layout-baseline >>ascent ]
164 [ logical-rect>> dim>> [ first >>width ] [ second >>height ] bi ] bi
165 dup [ height>> ] [ ascent>> ] bi - >>descent ;
167 : draw-layout ( layout -- image )
168 dup ink-rect>> dim>> [ >fixnum ] map [
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 ]
177 ] make-bitmap-image ;
179 : escape-nulls ( str -- str' )
180 { { 0 CHAR: zero-width-no-break-space } } substitute ;
182 : unpack-selection ( layout string/selection -- layout )
184 [ string>> escape-nulls >>string ] [ >>selection ] bi
185 ] [ escape-nulls >>string ] if ; inline
187 : <layout> ( font string -- line )
189 layout new-disposable
190 swap unpack-selection
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
198 M: layout dispose* layout>> g_object_unref ;
200 SYMBOL: cached-layouts
202 : cached-layout ( font string -- layout )
203 cached-layouts get [ <layout> ] 2cache ;
205 : cached-line ( font string -- line )
206 cached-layout layout>> first-line ;
208 [ <cache-assoc> cached-layouts set-global ] "pango.layouts" add-init-hook