extra/pango/ft2/ft2.factor

   1 USING: alien alien.c-types
   2 math kernel byte-arrays freetype
   3 opengl.gadgets accessors pango
   4 ui.gadgets memoize
   5 arrays sequences libc opengl.gl
   6 system combinators alien.syntax
   7 pango.layouts ;
   8 IN: pango.ft2
   9
  10 << "pangoft2" {
  11 !    { [ os winnt? ] [ "libpangocairo-1.dll" ] }
  12 !    { [ os macosx? ] [ "libpangocairo.dylib" ] }
  13     { [ os unix? ] [ "libpangoft2-1.0.so" ] }
  14 } cond "cdecl" add-library >>
  15
  16 LIBRARY: pangoft2
  17
  18 FUNCTION: PangoFontMap*
  19 pango_ft2_font_map_new ( ) ;
  20
  21 FUNCTION: PangoContext*
  22 pango_ft2_font_map_create_context ( PangoFT2FontMap* fontmap ) ;
  23
  24 FUNCTION: void
  25 pango_ft2_render_layout ( FT_Bitmap* bitmap, PangoLayout* layout, int x, int y ) ;
  26
  27 : 4*-ceil ( n -- k*4 )
  28     3 + 4 /i 4 * ;
  29
  30 : <ft-bitmap> ( width height -- ft-bitmap )
  31     swap dup
  32     2dup * 4*-ceil
  33     "uchar" malloc-array
  34     256
  35     FT_PIXEL_MODE_GRAY
  36     "FT_Bitmap" <c-object> dup >r
  37     {
  38         set-FT_Bitmap-rows
  39         set-FT_Bitmap-width
  40         set-FT_Bitmap-pitch
  41         set-FT_Bitmap-buffer
  42         set-FT_Bitmap-num_grays
  43         set-FT_Bitmap-pixel_mode
  44     } set-slots r> ;
  45
  46 : render-layout ( layout -- dims alien )
  47     [
  48         pango-layout-get-pixel-size
  49         2array dup 2^-bounds first2 <ft-bitmap> dup
  50     ] [ 0 0 pango_ft2_render_layout ] bi FT_Bitmap-buffer ;
  51
  52 MEMO: ft2-context ( -- PangoContext* )
  53     pango_ft2_font_map_new pango_ft2_font_map_create_context ;
  54
  55 : with-ft2-layout ( quot -- )
  56     ft2-context pango_layout_new swap with-layout ; inline