! 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
! 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" {
FUNCTION: void
cairo_destroy ( cairo_t* cr ) ;
+DESTRUCTOR: cairo_destroy
+
FUNCTION: uint
cairo_get_reference_count ( cairo_t* cr ) ;
FUNCTION: void
cairo_surface_destroy ( cairo_surface_t* surface ) ;
+DESTRUCTOR: cairo_surface_destroy
+
FUNCTION: uint
cairo_surface_get_reference_count ( cairo_surface_t* surface ) ;
--- /dev/null
+Matthew Willis
+Slava Pestov
! 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_object_unref ( gpointer object ) ;
+g_free ( gpointer mem ) ;
-DESTRUCTOR: g_object_unref
+LIBRARY: gobject
FUNCTION: void
-g_free ( gpointer mem ) ;
+g_object_unref ( gpointer object ) ;
+
+DESTRUCTOR: g_object_unref
--- /dev/null
+Binding for GLib
! 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 ) ;
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) ;
--- /dev/null
+Matthew Willis
+Slava Pestov
! 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 ) ;
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
\ No newline at end of file
--- /dev/null
+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
\ No newline at end of file
! 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 ;
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 )
] with-destructors ;
: dummy-cairo ( -- cr )
- [
+ \ dummy-cairo [
CAIRO_FORMAT_ARGB32 0 0 cairo_image_surface_create
cairo_create
] initialize-alien ;
<< "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 >>
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 ;
\ No newline at end of file
projects / factor.git / commitdiff