57 lines
		
	
	
		
			1.5 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			57 lines
		
	
	
		
			1.5 KiB
		
	
	
	
		
			Factor
		
	
	
USING: alien alien.c-types
 | 
						|
math kernel byte-arrays freetype
 | 
						|
opengl.gadgets accessors pango
 | 
						|
ui.gadgets memoize
 | 
						|
arrays sequences libc opengl.gl
 | 
						|
system combinators alien.syntax
 | 
						|
pango.layouts ;
 | 
						|
IN: pango.ft2
 | 
						|
 | 
						|
<< "pangoft2" {
 | 
						|
    { [ os winnt? ] [ "libpangocairo-1.0-0.dll" ] }
 | 
						|
    { [ os macosx? ] [ "libpangocairo-1.0.0.dylib" ] }
 | 
						|
    { [ os unix? ] [ "libpangoft2-1.0.so" ] }
 | 
						|
} cond "cdecl" add-library >>
 | 
						|
 | 
						|
LIBRARY: pangoft2
 | 
						|
 | 
						|
FUNCTION: PangoFontMap*
 | 
						|
pango_ft2_font_map_new ( ) ;
 | 
						|
 | 
						|
FUNCTION: PangoContext*
 | 
						|
pango_ft2_font_map_create_context ( PangoFT2FontMap* fontmap ) ;
 | 
						|
 | 
						|
FUNCTION: void
 | 
						|
pango_ft2_render_layout ( FT_Bitmap* bitmap, PangoLayout* layout, int x, int y ) ;
 | 
						|
 | 
						|
: 4*-ceil ( n -- k*4 )
 | 
						|
    3 + 4 /i 4 * ;
 | 
						|
 | 
						|
: <ft-bitmap> ( width height -- ft-bitmap )
 | 
						|
    swap dup
 | 
						|
    2dup * 4*-ceil
 | 
						|
    "uchar" malloc-array
 | 
						|
    256
 | 
						|
    FT_PIXEL_MODE_GRAY
 | 
						|
    "FT_Bitmap" <c-object> dup >r
 | 
						|
    {
 | 
						|
        [ set-FT_Bitmap-pixel_mode ]
 | 
						|
        [ set-FT_Bitmap-num_grays  ]
 | 
						|
        [ set-FT_Bitmap-buffer     ]
 | 
						|
        [ set-FT_Bitmap-pitch      ]
 | 
						|
        [ set-FT_Bitmap-width      ]
 | 
						|
        [ set-FT_Bitmap-rows       ]
 | 
						|
    } cleave r> ;
 | 
						|
 | 
						|
: render-layout ( layout -- dims alien )
 | 
						|
    [ 
 | 
						|
        pango-layout-get-pixel-size
 | 
						|
        2array dup 2^-bounds first2 <ft-bitmap> dup
 | 
						|
    ] [ 0 0 pango_ft2_render_layout ] bi FT_Bitmap-buffer ;
 | 
						|
 | 
						|
MEMO: ft2-context ( -- PangoContext* )
 | 
						|
    pango_ft2_font_map_new pango_ft2_font_map_create_context ;
 | 
						|
 | 
						|
: with-ft2-layout ( quot -- )
 | 
						|
    ft2-context pango_layout_new swap with-layout ; inline
 |