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.vectors destructors combinators colors fonts
6 accessors assocs namespaces kernel pango pango.fonts pango.cairo cairo
7 cairo.ffi glib unicode.data locals images cache init ;
12 FUNCTION: PangoLayout*
13 pango_layout_new ( PangoContext* context ) ;
16 pango_layout_set_text ( PangoLayout* layout, char* text, int length ) ;
19 pango_layout_get_text ( PangoLayout* layout ) ;
22 pango_layout_get_size ( PangoLayout* layout, int* width, int* height ) ;
25 pango_layout_set_font_description ( PangoLayout* layout, PangoFontDescription* desc ) ;
27 FUNCTION: PangoFontDescription*
28 pango_layout_get_font_description ( PangoLayout* layout ) ;
31 pango_layout_get_pixel_size ( PangoLayout* layout, int* width, int* height ) ;
34 pango_layout_get_baseline ( PangoLayout* layout ) ;
37 pango_layout_get_pixel_extents ( PangoLayout* layout, PangoRectangle* ink_rect, PangoRectangle* logical_rect ) ;
39 FUNCTION: PangoLayoutLine*
40 pango_layout_get_line_readonly ( PangoLayout* layout, int line ) ;
43 pango_layout_line_index_to_x ( PangoLayoutLine* line, int index_, gboolean trailing, int* x_pos ) ;
46 pango_layout_line_x_to_index ( PangoLayoutLine* line, int x_pos, int* index_, int* trailing ) ;
48 FUNCTION: PangoLayoutIter*
49 pango_layout_get_iter ( PangoLayout* layout ) ;
52 pango_layout_iter_get_baseline ( PangoLayoutIter* iter ) ;
55 pango_layout_iter_free ( PangoLayoutIter* iter ) ;
57 DESTRUCTOR: pango_layout_iter_free
59 : layout-dim ( layout -- dim )
60 0 <int> 0 <int> [ pango_layout_get_pixel_size ] 2keep
63 : layout-extents ( layout -- ink-rect logical-rect )
64 "PangoRectangle" <c-object>
65 "PangoRectangle" <c-object>
66 [ pango_layout_get_pixel_extents ] 2keep
67 [ PangoRectangle>rect ] bi@ ;
69 : layout-baseline ( layout -- baseline )
70 pango_layout_get_iter &pango_layout_iter_free
71 pango_layout_iter_get_baseline
74 : set-layout-font ( str layout -- )
75 swap pango_layout_set_font_description ;
77 : set-layout-text ( str layout -- )
78 #! Replace nulls with something else since Pango uses null-terminated
80 swap { { 0 CHAR: zero-width-no-break-space } } substitute
81 -1 pango_layout_set_text ;
83 : <PangoLayout> ( text font -- layout )
84 dummy-cairo pango_cairo_create_layout |g_object_unref
85 [ set-layout-font ] keep
86 [ set-layout-text ] keep ;
88 : set-foreground ( cr font -- )
89 foreground>> set-source-color ;
91 : fill-background ( cr font dim -- )
92 [ background>> set-source-color ]
93 [ [ 0 0 ] dip first2 cairo_rectangle ] bi-curry*
97 :: fill-selection-background ( cr loc dim layout string -- )
100 : set-text-position ( cr loc -- )
101 first2 cairo_move_to ;
103 : layout-metrics ( dim baseline -- metrics )
106 swap first2 [ >>width ] [ >>height ] bi*
107 dup [ height>> ] [ ascent>> ] bi - >>descent ;
109 TUPLE: layout font layout metrics image loc dim disposed ;
111 :: <layout> ( font string -- line )
113 ! TODO: metrics and loc
114 [let* | open-font [ font cache-font-description ]
115 layout [ string open-font <PangoLayout> ]
116 logical-rect [ layout layout-extents ] ink-rect [ ]
117 baseline [ layout layout-baseline ]
118 logical-loc [ logical-rect loc>> ]
119 logical-dim [ logical-rect dim>> ]
120 ink-loc [ ink-rect loc>> ]
121 ink-dim [ ink-rect dim>> ]
122 metrics [ logical-dim baseline layout-metrics ] |
123 open-font layout metrics
126 [ layout pango_cairo_update_layout ]
127 [ font ink-dim fill-background ]
128 [ font set-foreground ]
129 [ ink-loc ink-dim layout string fill-selection-background ]
130 [ logical-loc ink-loc v- set-text-position ]
131 [ layout pango_cairo_show_layout ]
134 logical-loc ink-loc v-
140 M: layout dispose* layout>> g_object_unref ;
142 SYMBOL: cached-layouts
144 : cached-layout ( font string -- layout )
145 cached-layouts get [ <layout> ] 2cache ;
147 : cached-line ( font string -- line )
148 cached-layout layout>> 0 pango_layout_get_line_readonly ;
150 [ <cache-assoc> cached-layouts set-global ] "pango.layouts" add-init-hook