steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Working on Pango binding

db4
Slava Pestov 2009-02-26 23:30:02 -06:00
parent 51fdd23248
commit cf62353e23
13 changed files with 234 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
basis/cairo/cairo.factor
View File

@ -1,37 +1,40 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: cairo.ffi kernel accessors sequences
USING: cairo.ffi alien.c-types kernel accessors sequences
namespaces fry continuations destructors ;
IN: cairo
TUPLE: cairo-t alien ;
C: <cairo-t> cairo-t
M: cairo-t dispose ( alien -- ) alien>> cairo_destroy ;
ERROR: cairo-error message ;
TUPLE: cairo-surface-t alien ;
C: <cairo-surface-t> cairo-surface-t
M: cairo-surface-t dispose ( alien -- ) alien>> cairo_surface_destroy ;
: (check-cairo) ( cairo_status_t -- )
dup CAIRO_STATUS_SUCCESS =
[ drop ] [ cairo_status_to_string cairo-error ] if ;
: check-cairo ( cairo_status_t -- )
dup CAIRO_STATUS_SUCCESS = [ drop ]
[ cairo_status_to_string "Cairo error: " prepend throw ] if ;
: check-cairo ( cairo -- ) cairo_status (check-cairo) ;
SYMBOL: cairo
: cr ( -- cairo ) cairo get ; inline
: (with-cairo) ( cairo-t quot -- )
[ alien>> cairo ] dip
'[ @ cr cairo_status check-cairo ]
with-variable ; inline
: with-cairo ( cairo quot -- )
[ <cairo-t> ] dip '[ _ (with-cairo) ] with-disposal ; inline
'[
_ &cairo_destroy
_ [ check-cairo ] bi
] with-destructors ; inline
: (with-surface) ( cairo-surface-t quot -- )
[ alien>> ] dip [ cairo_surface_status check-cairo ] bi ; inline
: check-surface ( surface -- ) cairo_surface_status check-cairo ;
: with-surface ( cairo_surface quot -- )
[ <cairo-surface-t> ] dip '[ _ (with-surface) ] with-disposal ; inline
'[
_ &cairo_surface_destroy
_ [ check-surface ] bi
] with-destructors ; inline
: with-cairo-from-surface ( cairo_surface quot -- )
'[ cairo_create _ with-cairo ] with-surface ; inline
: width>stride ( width -- stride ) "uint" heap-size * ; inline
: <image-surface> ( data dim -- surface )
first2 over width>stride CAIRO_FORMAT_ARGB32
cairo_image_surface_create_for_data
dup check-surface ;
: make-bitmap-image ( dim quot -- image )
'[ <image-surface> &cairo_surface_destroy @ ] make-memory-bitmap ; inline

8
basis/cairo/ffi/ffi.factor
View File

@ -4,8 +4,8 @@
! Adapted from cairo.h, version 1.5.14
! License: http://factorcode.org/license.txt
USING: system combinators alien alien.syntax kernel
alien.c-types accessors sequences arrays ui.gadgets ;
USING: system combinators alien alien.syntax alien.c-types
alien.destructors kernel accessors sequences arrays ui.gadgets ;
IN: cairo.ffi
<< "cairo" {
@ -94,6 +94,8 @@ cairo_reference ( cairo_t* cr ) ;
FUNCTION: void
cairo_destroy ( cairo_t* cr ) ;
DESTRUCTOR: cairo_destroy
FUNCTION: uint
cairo_get_reference_count ( cairo_t* cr ) ;
@ -694,6 +696,8 @@ cairo_surface_finish ( cairo_surface_t* surface ) ;
FUNCTION: void
cairo_surface_destroy ( cairo_surface_t* surface ) ;
DESTRUCTOR: cairo_surface_destroy
FUNCTION: uint
cairo_surface_get_reference_count ( cairo_surface_t* surface ) ;

2
basis/glib/authors.txt Normal file
View File

@ -0,0 +1,2 @@
Matthew Willis
Slava Pestov

30
basis/glib/glib.factor
View File

@ -1,14 +1,36 @@
! Copyright (C) 2008 Matthew Willis.
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license
USING: alien.syntax alien.destructors ;
USING: alien alien.syntax alien.destructors combinators system ;
IN: glib
<<
"glib" {
{ [ os winnt? ] [ "glib2.dll" ] }
{ [ os macosx? ] [ "/opt/local/lib/libglib-2.0.0.dylib" ] }
{ [ os unix? ] [ "libglib-2.0.0.so" ] }
} cond "cdecl" add-library
"gobject" {
{ [ os winnt? ] [ "gobject2.dll" ] }
{ [ os macosx? ] [ "/opt/local/lib/libgobject-2.0.0.dylib" ] }
{ [ os unix? ] [ "libgobject-2.0.0.so" ] }
} cond "cdecl" add-library
>>
LIBRARY: glib
TYPEDEF: void* gpointer
TYPEDEF: int gint
FUNCTION: void
g_free ( gpointer mem ) ;
LIBRARY: gobject
FUNCTION: void
g_object_unref ( gpointer object ) ;
DESTRUCTOR: g_object_unref
FUNCTION: void
g_free ( gpointer mem ) ;

1
basis/glib/summary.txt Normal file
View File

@ -0,0 +1 @@
Binding for GLib

1
basis/glib/tags.txt Normal file
View File

@ -0,0 +1 @@
bindings

37
basis/pango/cairo/cairo.factor
View File

@ -2,20 +2,21 @@
! See http://factorcode.org/license.txt for BSD license.
!
! pangocairo bindings, from pango/pangocairo.h
USING: cairo.ffi alien.c-types math alien.syntax system
combinators alien arrays pango pango.fonts ;
USING: cairo.ffi alien.c-types math alien.syntax system destructors
memoize accessors kernel combinators alien arrays fonts pango
pango.fonts ;
IN: pango.cairo
<< "pangocairo" {
{ [ os winnt? ] [ "libpangocairo-1.0-0.dll" ] }
{ [ os macosx? ] [ "libpangocairo-1.0.0.dylib" ] }
{ [ os macosx? ] [ "/opt/local/lib/libpangocairo-1.0.0.dylib" ] }
{ [ os unix? ] [ "libpangocairo-1.0.so" ] }
} cond "cdecl" add-library >>
LIBRARY: pangocairo
FUNCTION: PangoFontMap*
pango_cairo_font_map_new ( ) ;
pango_cairo_font_map_new ( ) ;
FUNCTION: PangoFontMap*
pango_cairo_font_map_new_for_font_type ( cairo_font_type_t fonttype ) ;
@ -86,3 +87,31 @@ pango_cairo_layout_path ( cairo_t* cr, PangoLayout* layout ) ;
FUNCTION: void
pango_cairo_error_underline_path ( cairo_t* cr, double x, double y, double width, double height ) ;
MEMO: (cache-font) ( font -- open-font )
[ pango_cairo_font_map_get_default dummy-pango-context ] dip
cache-font-description
pango_font_map_load_font ;
: cache-font ( font -- open-font )
strip-font-colors (cache-font) ;
: get-font-metrics ( font -- metrics )
(cache-font) f pango_font_get_metrics &pango_font_metrics_unref ;
: parse-font-metrics ( metrics -- metrics' )
[ metrics new ] dip
{
[ pango_font_metrics_get_ascent PANGO_SCALE /f >>height ]
[ pango_font_metrics_get_descent PANGO_SCALE /f >>descent ]
[ drop 0 >>leading ]
[ drop 0 >>cap-height ]
[ drop 0 >>x-height ]
} cleave
dup [ height>> ] [ descent>> ] bi - >>ascent ;
MEMO: (cache-font-metrics) ( font -- metrics )
[ get-font-metrics parse-font-metrics ] with-destructors ;
: cache-font-metrics ( font -- metrics )
strip-font-colors (cache-font-metrics) ;

2
basis/pango/fonts/authors.txt Normal file
View File

@ -0,0 +1,2 @@
Matthew Willis
Slava Pestov

83
basis/pango/fonts/fonts.factor
View File

@ -1,10 +1,61 @@
! Copyright (C) 2008 Matthew Willis.
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license
USING: pango alien.syntax alien.c-types kernel ;
USING: pango alien.syntax alien.c-types alien.destructors
kernel glib accessors combinators destructors init fonts
memoize math ;
IN: pango.fonts
LIBRARY: pango
TYPEDEF: int PangoStyle
C-ENUM:
PANGO_STYLE_NORMAL
PANGO_STYLE_OBLIQUE
PANGO_STYLE_ITALIC ;
TYPEDEF: int PangoWeight
CONSTANT: PANGO_WEIGHT_THIN 100
CONSTANT: PANGO_WEIGHT_ULTRALIGHT 200
CONSTANT: PANGO_WEIGHT_LIGHT 300
CONSTANT: PANGO_WEIGHT_BOOK 380
CONSTANT: PANGO_WEIGHT_NORMAL 400
CONSTANT: PANGO_WEIGHT_MEDIUM 500
CONSTANT: PANGO_WEIGHT_SEMIBOLD 600
CONSTANT: PANGO_WEIGHT_BOLD 700
CONSTANT: PANGO_WEIGHT_ULTRABOLD 800
CONSTANT: PANGO_WEIGHT_HEAVY 900
CONSTANT: PANGO_WEIGHT_ULTRAHEAVY 1000
FUNCTION: PangoFontDescription*
pango_font_description_new ( ) ;
FUNCTION: void
pango_font_description_free ( PangoFontDescription* desc ) ;
DESTRUCTOR: pango_font_description_free
FUNCTION: PangoFontDescription*
pango_font_description_from_string ( char* str ) ;
FUNCTION: char*
pango_font_description_to_string ( PangoFontDescription* desc ) ;
FUNCTION: char*
pango_font_description_to_filename ( PangoFontDescription* desc ) ;
FUNCTION: void
pango_font_description_set_family ( PangoFontDescription* desc, char* family ) ;
FUNCTION: void
pango_font_description_set_style ( PangoFontDescription* desc, PangoStyle style ) ;
FUNCTION: void
pango_font_description_set_weight ( PangoFontDescription* desc, PangoWeight weight ) ;
FUNCTION: void
pango_font_description_set_size ( PangoFontDescription* desc, gint size ) ;
FUNCTION: void
pango_font_map_list_families ( PangoFontMap* fontmap, PangoFontFamily*** families, int* n_families ) ;
@ -22,3 +73,33 @@ pango_font_face_get_face_name ( PangoFontFace* face ) ;
FUNCTION: void
pango_font_face_list_sizes ( PangoFontFace* face, int** sizes, int* n_sizes ) ;
FUNCTION: void pango_font_metrics_unref ( PangoFontMetrics* metrics ) ;
DESTRUCTOR: pango_font_metrics_unref
FUNCTION: int pango_font_metrics_get_ascent ( PangoFontMetrics* metrics ) ;
FUNCTION: int pango_font_metrics_get_descent ( PangoFontMetrics* metrics ) ;
FUNCTION: PangoFont* pango_font_map_load_font ( PangoFontMap* fontmap, PangoContext* context, PangoFontDescription* desc ) ;
FUNCTION: PangoFontMetrics* pango_context_get_metrics ( PangoContext* context, PangoFontDescription* desc, PangoLanguage* language ) ;
FUNCTION: PangoFontMetrics* pango_font_get_metrics ( PangoFont* font, PangoLanguage* language ) ;
MEMO: (cache-font-description) ( font -- description )
[
[ pango_font_description_new |pango_font_description_free ] dip {
[ name>> pango_font_description_set_family ]
[ size>> PANGO_SCALE * >integer pango_font_description_set_size ]
[ bold?>> PANGO_WEIGHT_BOLD PANGO_WEIGHT_NORMAL ? pango_font_description_set_weight ]
[ italic?>> PANGO_STYLE_ITALIC PANGO_STYLE_NORMAL ? pango_font_description_set_style ]
[ drop ]
} 2cleave
] with-destructors ;
: cache-font-description ( font -- description )
strip-font-colors (cache-font-description) ;
[ \ (cache-font-description) reset-memoized ] "pango.fonts" add-init-hook

1
basis/pango/fonts/tags.txt Normal file
View File

@ -0,0 +1 @@
bindings

13
basis/pango/layouts/layouts-tests.factor Normal file
View File

@ -0,0 +1,13 @@
IN: pango.layouts.tests
USING: pango.layouts tools.test glib fonts accessors
sequences combinators.short-circuit math destructors ;
[ t ] [
[
"OH, HAI"
<font> "Helvetica" >>name 12 >>size
dummy-cairo
<layout> &g_object_unref
layout-dim
] with-destructors [ { [ integer? ] [ 0 > ] } 1&& ] all?
] unit-test

44
basis/pango/layouts/layouts.factor
View File

@ -1,9 +1,39 @@
! Copyright (C) 2008 Matthew Willis.
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays alien alien.c-types math destructors accessors
namespaces kernel pango pango.cairo cairo.ffi glib ;
USING: arrays alien alien.c-types alien.syntax math destructors accessors assocs
namespaces kernel pango pango.fonts pango.cairo cairo.ffi glib unicode.data ;
IN: pango.layouts
LIBRARY: pango
FUNCTION: PangoLayout*
pango_layout_new ( PangoContext* context ) ;
FUNCTION: void
pango_layout_set_text ( PangoLayout* layout, char* text, int length ) ;
FUNCTION: char*
pango_layout_get_text ( PangoLayout* layout ) ;
FUNCTION: void
pango_layout_get_size ( PangoLayout* layout, int* width, int* height ) ;
FUNCTION: void
pango_layout_set_font_description ( PangoLayout* layout, PangoFontDescription* desc ) ;
FUNCTION: PangoFontDescription*
pango_layout_get_font_description ( PangoLayout* layout ) ;
FUNCTION: void
pango_layout_get_pixel_size ( PangoLayout* layout, int* width, int* height ) ;
FUNCTION: int
pango_layout_get_baseline ( PangoLayout* layout ) ;
FUNCTION: void
pango_layout_get_pixel_extents ( PangoLayout *layout, PangoRectangle *ink_rect, PangoRectangle *logical_rect ) ;
: layout-dim ( layout -- dim )
0 <int> 0 <int> [ pango_layout_get_pixel_size ] 2keep
[ *int ] bi@ 2array ;
@ -11,12 +41,12 @@ IN: pango.layouts
ERROR: bad-font name ;
: set-layout-font ( str layout -- )
swap dup pango_font_description_from_string
[ ] [ bad-font ] ?if
&pango_font_description_free
pango_layout_set_font_description ;
swap cache-font-description pango_layout_set_font_description ;
: set-layout-text ( str layout -- )
#! Replace nulls with something else since Pango uses null-terminated
#! strings
swap { { 0 CHAR: zero-width-no-break-space } } substitute
-1 pango_layout_set_text ;
: <layout> ( text font cairo -- layout )
@ -27,7 +57,7 @@ ERROR: bad-font name ;
] with-destructors ;
: dummy-cairo ( -- cr )
[
\ dummy-cairo [
CAIRO_FORMAT_ARGB32 0 0 cairo_image_surface_create
cairo_create
] initialize-alien ;

39
basis/pango/pango.factor
View File

@ -10,7 +10,7 @@ IN: pango
<< "pango" {
{ [ os winnt? ] [ "libpango-1.0-0.dll" ] }
{ [ os macosx? ] [ "libpango-1.0.0.dylib" ] }
{ [ os macosx? ] [ "/opt/local/lib/libpango-1.0.0.dylib" ] }
{ [ os unix? ] [ "libpango-1.0.so" ] }
} cond "cdecl" add-library >>
@ -18,37 +18,8 @@ LIBRARY: pango
CONSTANT: PANGO_SCALE 1024
FUNCTION: PangoLayout*
pango_layout_new ( PangoContext* context ) ;
FUNCTION: PangoContext*
pango_context_new ( ) ;
FUNCTION: void
pango_layout_set_text ( PangoLayout* layout, char* text, int length ) ;
FUNCTION: char*
pango_layout_get_text ( PangoLayout* layout ) ;
FUNCTION: void
pango_layout_get_size ( PangoLayout* layout, int* width, int* height ) ;
FUNCTION: PangoFontDescription*
pango_font_description_from_string ( char* str ) ;
FUNCTION: char*
pango_font_description_to_string ( PangoFontDescription* desc ) ;
FUNCTION: char*
pango_font_description_to_filename ( PangoFontDescription* desc ) ;
FUNCTION: void
pango_layout_set_font_description ( PangoLayout* layout, PangoFontDescription* desc ) ;
FUNCTION: PangoFontDescription*
pango_layout_get_font_description ( PangoLayout* layout ) ;
FUNCTION: void
pango_layout_get_pixel_size ( PangoLayout* layout, int* width, int* height ) ;
FUNCTION: void
pango_font_description_free ( PangoFontDescription* desc ) ;
DESTRUCTOR: pango_font_description_free
: dummy-pango-context ( -- context )
\ dummy-pango-context [ pango_context_new ] initialize-alien ;