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