basis/pango/cairo/cairo.factor

   1 ! Copyright (C) 2008 Matthew Willis.
   2 ! Copyright (C) 2009 Slava Pestov.
   3 ! See http://factorcode.org/license.txt for BSD license.
   4 !
   5 ! pangocairo bindings, from pango/pangocairo.h
   6 USING: arrays sequences alien alien.c-types alien.data
   7 alien.destructors alien.libraries alien.syntax math
   8 math.functions math.vectors destructors combinators colors fonts
   9 accessors assocs namespaces kernel pango pango.fonts
  10 pango.layouts glib unicode.data images cache init system
  11 math.rectangles fry memoize io.encodings.utf8 classes.struct
  12 cairo cairo.ffi ;
  13 IN: pango.cairo
  14
  15 << {
  16     { [ os winnt? ] [ "pangocairo" "libpangocairo-1.0-0.dll" cdecl add-library ] }
  17     { [ os macosx? ] [ "pangocairo" "/opt/local/lib/libpangocairo-1.0.0.dylib" cdecl add-library ] }
  18     { [ os unix? ] [ ] }
  19 } cond >>
  20
  21 LIBRARY: pangocairo
  22
  23 C-TYPE: PangoCairoFontMap
  24 C-TYPE: PangoCairoFont
  25
  26 FUNCTION: PangoFontMap*
  27 pango_cairo_font_map_new ( ) ;
  28
  29 FUNCTION: PangoFontMap*
  30 pango_cairo_font_map_new_for_font_type ( cairo_font_type_t fonttype ) ;
  31
  32 FUNCTION: PangoFontMap*
  33 pango_cairo_font_map_get_default ( ) ;
  34
  35 FUNCTION: cairo_font_type_t
  36 pango_cairo_font_map_get_font_type ( PangoCairoFontMap* fontmap ) ;
  37
  38 FUNCTION: void
  39 pango_cairo_font_map_set_resolution ( PangoCairoFontMap* fontmap, double dpi ) ;
  40
  41 FUNCTION: double
  42 pango_cairo_font_map_get_resolution ( PangoCairoFontMap* fontmap ) ;
  43
  44 FUNCTION: PangoContext*
  45 pango_cairo_font_map_create_context ( PangoCairoFontMap* fontmap ) ;
  46
  47 FUNCTION: cairo_scaled_font_t*
  48 pango_cairo_font_get_scaled_font ( PangoCairoFont* font ) ;
  49
  50 ! Update a Pango context for the current state of a cairo context
  51 FUNCTION: void
  52 pango_cairo_update_context ( cairo_t* cr, PangoContext* context ) ;
  53
  54 FUNCTION: void
  55 pango_cairo_context_set_font_options ( PangoContext* context, cairo_font_options_t* options ) ;
  56
  57 FUNCTION: cairo_font_options_t*
  58 pango_cairo_context_get_font_options ( PangoContext* context ) ;
  59
  60 FUNCTION: void
  61 pango_cairo_context_set_resolution ( PangoContext* context, double dpi ) ;
  62
  63 FUNCTION: double
  64 pango_cairo_context_get_resolution ( PangoContext* context ) ;
  65
  66 ! Convenience
  67 FUNCTION: PangoLayout*
  68 pango_cairo_create_layout ( cairo_t* cr ) ;
  69
  70 FUNCTION: void
  71 pango_cairo_update_layout ( cairo_t* cr, PangoLayout* layout ) ;
  72
  73 ! Rendering
  74 FUNCTION: void
  75 pango_cairo_show_glyph_string ( cairo_t* cr, PangoFont* font, PangoGlyphString* glyphs ) ;
  76
  77 FUNCTION: void
  78 pango_cairo_show_layout_line ( cairo_t* cr, PangoLayoutLine* line ) ;
  79
  80 FUNCTION: void
  81 pango_cairo_show_layout ( cairo_t* cr, PangoLayout* layout ) ;
  82
  83 FUNCTION: void
  84 pango_cairo_show_error_underline ( cairo_t* cr, double x, double y, double width, double height ) ;
  85
  86 ! Rendering to a path
  87 FUNCTION: void
  88 pango_cairo_glyph_string_path ( cairo_t* cr, PangoFont* font, PangoGlyphString* glyphs ) ;
  89
  90 FUNCTION: void
  91 pango_cairo_layout_line_path  ( cairo_t* cr, PangoLayoutLine* line ) ;
  92
  93 FUNCTION: void
  94 pango_cairo_layout_path ( cairo_t* cr, PangoLayout* layout ) ;
  95
  96 FUNCTION: void
  97 pango_cairo_error_underline_path ( cairo_t* cr, double x, double y, double width, double height ) ;
  98
  99 TUPLE: layout < disposable font string selection layout metrics ink-rect logical-rect image ;
 100
 101 SYMBOL: dpi
 102
 103 72 dpi set-global
 104
 105 : set-layout-font ( font layout -- )
 106     swap cache-font-description pango_layout_set_font_description ;
 107
 108 : set-layout-text ( str layout -- )
 109     #! Replace nulls with something else since Pango uses null-terminated
 110     #! strings
 111     swap -1 pango_layout_set_text ;
 112
 113 : layout-extents ( layout -- ink-rect logical-rect )
 114     PangoRectangle <struct>
 115     PangoRectangle <struct>
 116     [ pango_layout_get_extents ] 2keep
 117     [ PangoRectangle>rect ] bi@ ;
 118
 119 : layout-baseline ( layout -- baseline )
 120     pango_layout_get_iter &pango_layout_iter_free
 121     pango_layout_iter_get_baseline
 122     pango>float ;
 123
 124 : set-foreground ( cr font -- )
 125     foreground>> set-source-color ;
 126
 127 : fill-background ( cr font dim -- )
 128     [ background>> set-source-color ]
 129     [ [ { 0 0 } ] dip <rect> fill-rect ] bi-curry* bi ;
 130
 131 : rect-translate-x ( rect x -- rect' )
 132     '[ _ 0 2array v- ] change-loc ;
 133
 134 : first-line ( layout -- line )
 135     layout>> 0 pango_layout_get_line_readonly ;
 136
 137 : line-offset>x ( layout n -- x )
 138     #! n is an index into the UTF8 encoding of the text
 139     [ drop first-line ] [ swap string>> >utf8-index ] 2bi
 140     0 { int } [ pango_layout_line_index_to_x ] [ ] with-out-parameters
 141     pango>float ;
 142
 143 : x>line-offset ( layout x -- n )
 144     #! n is an index into the UTF8 encoding of the text
 145     [
 146         [ first-line ] dip
 147         float>pango
 148         { int int }
 149         [ pango_layout_line_x_to_index drop ] [ ] with-out-parameters
 150         swap
 151     ] [ drop string>> ] 2bi utf8-index> + ;
 152
 153 : selection-start/end ( selection -- start end )
 154     selection>> [ start>> ] [ end>> ] bi ;
 155
 156 : selection-rect ( layout -- rect )
 157     [ ink-rect>> dim>> ] [ ] [ selection-start/end ] tri [ line-offset>x ] bi-curry@ bi
 158     [ drop nip 0 2array ] [ swap - swap second 2array ] 3bi <rect> ;
 159
 160 : fill-selection-background ( cr layout -- )
 161     dup selection>> [
 162         [ selection>> color>> set-source-color ]
 163         [
 164             [ selection-rect ] [ ink-rect>> loc>> first ] bi
 165             rect-translate-x
 166             fill-rect
 167         ] 2bi
 168     ] [ 2drop ] if ;
 169
 170 : text-position ( layout -- loc )
 171     [ logical-rect>> ] [ ink-rect>> ] bi [ loc>> ] bi@ v- ;
 172
 173 : set-text-position ( cr loc -- )
 174     first2 cairo_move_to ;
 175
 176 : draw-layout ( layout -- image )
 177     dup ink-rect>> dim>> [ >fixnum ] map [
 178         swap {
 179             [ layout>> pango_cairo_update_layout ]
 180             [ [ font>> ] [ ink-rect>> dim>> ] bi fill-background ]
 181             [ fill-selection-background ]
 182             [ text-position set-text-position ]
 183             [ font>> set-foreground ]
 184             [ layout>> pango_cairo_show_layout ]
 185         } 2cleave
 186     ] make-bitmap-image ;
 187
 188 : escape-nulls ( str -- str' )
 189     { { 0 CHAR: zero-width-no-break-space } } substitute ;
 190
 191 : unpack-selection ( layout string/selection -- layout )
 192     dup selection? [
 193         [ string>> escape-nulls >>string ] [ >>selection ] bi
 194     ] [ escape-nulls >>string ] if ; inline
 195
 196 : set-layout-resolution ( layout -- )
 197     pango_layout_get_context dpi get pango_cairo_context_set_resolution ;
 198
 199 : <PangoLayout> ( text font -- layout )
 200     dummy-cairo pango_cairo_create_layout |g_object_unref
 201     [ set-layout-resolution ] keep
 202     [ set-layout-font ] keep
 203     [ set-layout-text ] keep ;
 204
 205 : glyph-height ( font string -- y )
 206     swap <PangoLayout> &g_object_unref layout-extents drop dim>> second ;
 207
 208 MEMO: missing-font-metrics ( font -- metrics )
 209     #! Pango doesn't provide x-height and cap-height but Core Text does, so we
 210     #! simulate them on Pango.
 211     [
 212         [ metrics new ] dip
 213         [ "x" glyph-height >>x-height ]
 214         [ "Y" glyph-height >>cap-height ] bi
 215     ] with-destructors ;
 216
 217 : layout-metrics ( layout -- metrics )
 218     dup font>> missing-font-metrics clone
 219         swap
 220         [ layout>> layout-baseline >>ascent ]
 221         [ logical-rect>> dim>> [ first >>width ] [ second >>height ] bi ] bi
 222         dup [ height>> ] [ ascent>> ] bi - >>descent ;
 223
 224 : <layout> ( font string -- line )
 225     [
 226         layout new-disposable
 227             swap unpack-selection
 228             swap >>font
 229             dup [ string>> ] [ font>> ] bi <PangoLayout> >>layout
 230             dup layout>> layout-extents [ >>ink-rect ] [ >>logical-rect ] bi*
 231             dup layout-metrics >>metrics
 232             dup draw-layout >>image
 233     ] with-destructors ;
 234
 235 M: layout dispose* layout>> g_object_unref ;
 236
 237 SYMBOL: cached-layouts
 238
 239 : cached-layout ( font string -- layout )
 240     cached-layouts get [ <layout> ] 2cache ;
 241
 242 : cached-line ( font string -- line )
 243     cached-layout layout>> first-line ;
 244
 245 [ <cache-assoc> cached-layouts set-global ] "pango.cairo" add-startup-hook