Sampo Vuori
Doug Coleman
+Slava Pestov
! Copyright (C) 2008 Doug Coleman.
+! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: cairo.ffi alien.c-types kernel accessors sequences
-namespaces fry continuations destructors math images.memory ;
+USING: colors fonts cairo.ffi alien alien.c-types kernel accessors
+sequences namespaces fry continuations destructors math images
+images.memory ;
IN: cairo
ERROR: cairo-error message ;
<image-surface> &cairo_surface_destroy
cairo_create &cairo_destroy
@
- ] make-memory-bitmap ; inline
+ ] make-memory-bitmap
+ BGRA >>component-order ; inline
+
+: dummy-cairo ( -- cr )
+ #! Sometimes we want a dummy context; eg with Pango, we want
+ #! to measure text dimensions to create a new image context with,
+ #! but we need an existing context to measure text dimensions
+ #! with so we use the dummy.
+ \ dummy-cairo [
+ CAIRO_FORMAT_ARGB32 0 0 cairo_image_surface_create
+ cairo_create
+ ] initialize-alien ;
+
+: set-source-color ( cr color -- )
+ >rgba-components cairo_set_source_rgba ;
\ No newline at end of file
] initialize-alien ;
: make-bitmap-image ( dim quot -- image )
- '[ <CGBitmapContext> &CGContextRelease @ ] make-memory-bitmap ; inline
+ '[ <CGBitmapContext> &CGContextRelease @ ] make-memory-bitmap
+ ARGB >>component-order ; inline
TYPEDEF: void* gpointer
TYPEDEF: int gint
+TYPEDEF: bool gboolean
FUNCTION: void
g_free ( gpointer mem ) ;
GENERIC: load-image* ( path tuple -- image )
: add-dummy-alpha ( seq -- seq' )
- 3 <sliced-groups> [ 255 suffix ] map concat ;
+ 3 <groups> [ 255 suffix ] map concat ;
: normalize-floats ( byte-array -- byte-array )
byte-array>float-array [ 255.0 * >integer ] B{ } map-as ;
drop RGB16>8 add-dummy-alpha ;
: BGR>RGB ( bitmap bytes-per-pixel -- pixels )
- dup <sliced-groups>
- [ 3 head-slice reverse-here ] each ; inline
+ <groups> [ 3 cut [ reverse ] dip append ] map B{ } join ; inline
M: BGRA normalize-component-order*
drop 4 BGR>RGB ;
M: BGR normalize-component-order*
drop 3 BGR>RGB add-dummy-alpha ;
+: ARGB>RGBA ( bitmap -- bitmap' )
+ 4 <groups> [ unclip suffix ] map B{ } join ;
+
+M: ARGB normalize-component-order*
+ drop ARGB>RGBA ;
+
+M: ABGR normalize-component-order*
+ drop ARGB>RGBA 4 BGR>RGB ;
+
GENERIC: normalize-scan-line-order ( image -- image )
M: image normalize-scan-line-order ;
[ bitmap-data ] keep
<image>
swap >>dim
- swap >>bitmap
- little-endian? ARGB BGRA ? >>component-order ;
+ swap >>bitmap ;
PRIVATE>
M: RGBA component-order>format drop GL_RGBA GL_UNSIGNED_BYTE ;
M: ARGB component-order>format drop GL_BGRA_EXT GL_UNSIGNED_INT_8_8_8_8_REV ;
-M: BGRA component-order>format drop GL_BGRA_EXT GL_UNSIGNED_INT_8_8_8_8 ;
+M: BGRA component-order>format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ;
: repeat-last ( seq n -- seq' )
over peek pad-tail concat ;
--- /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.
!
! pangocairo bindings, from pango/pangocairo.h
: 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
+ [ pango_font_metrics_get_ascent PANGO_SCALE /f >>height ]
+ [ pango_font_metrics_get_descent PANGO_SCALE /f >>descent ] bi
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) ;
+ strip-font-colors (cache-font-metrics) ;
\ 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 alien.syntax math destructors accessors assocs
-namespaces kernel pango pango.fonts pango.cairo cairo.ffi glib unicode.data ;
+USING: arrays sequences alien alien.c-types alien.destructors
+alien.syntax math math.vectors destructors combinators colors fonts
+accessors assocs namespaces kernel pango pango.fonts pango.cairo cairo
+cairo.ffi glib unicode.data locals images cache init ;
IN: pango.layouts
LIBRARY: pango
pango_layout_get_baseline ( PangoLayout* layout ) ;
FUNCTION: void
-pango_layout_get_pixel_extents ( PangoLayout *layout, PangoRectangle *ink_rect, PangoRectangle *logical_rect ) ;
+pango_layout_get_pixel_extents ( PangoLayout* layout, PangoRectangle* ink_rect, PangoRectangle* logical_rect ) ;
+
+FUNCTION: PangoLayoutLine*
+pango_layout_get_line_readonly ( PangoLayout* layout, int line ) ;
+
+FUNCTION: void
+pango_layout_line_index_to_x ( PangoLayoutLine* line, int index_, gboolean trailing, int* x_pos ) ;
+
+FUNCTION: gboolean
+pango_layout_line_x_to_index ( PangoLayoutLine* line, int x_pos, int* index_, int* trailing ) ;
+
+FUNCTION: PangoLayoutIter*
+pango_layout_get_iter ( PangoLayout* layout ) ;
+
+FUNCTION: int
+pango_layout_iter_get_baseline ( PangoLayoutIter* iter ) ;
+
+FUNCTION: void
+pango_layout_iter_free ( PangoLayoutIter* iter ) ;
+
+DESTRUCTOR: pango_layout_iter_free
: layout-dim ( layout -- dim )
0 <int> 0 <int> [ pango_layout_get_pixel_size ] 2keep
[ *int ] bi@ 2array ;
-ERROR: bad-font name ;
+: layout-extents ( layout -- ink-rect logical-rect )
+ "PangoRectangle" <c-object>
+ "PangoRectangle" <c-object>
+ [ pango_layout_get_pixel_extents ] 2keep
+ [ PangoRectangle>rect ] bi@ ;
+
+: layout-baseline ( layout -- baseline )
+ pango_layout_get_iter &pango_layout_iter_free
+ pango_layout_iter_get_baseline
+ PANGO_SCALE /f ;
: set-layout-font ( str layout -- )
- swap cache-font-description pango_layout_set_font_description ;
+ swap pango_layout_set_font_description ;
: set-layout-text ( str layout -- )
#! Replace nulls with something else since Pango uses null-terminated
swap { { 0 CHAR: zero-width-no-break-space } } substitute
-1 pango_layout_set_text ;
-: <layout> ( text font cairo -- layout )
+: <PangoLayout> ( text font -- layout )
+ dummy-cairo pango_cairo_create_layout |g_object_unref
+ [ set-layout-font ] keep
+ [ set-layout-text ] keep ;
+
+: set-foreground ( cr font -- )
+ foreground>> set-source-color ;
+
+: fill-background ( cr font dim -- )
+ [ background>> set-source-color ]
+ [ [ 0 0 ] dip first2 cairo_rectangle ] bi-curry*
+ [ cairo_fill ]
+ tri ;
+
+:: fill-selection-background ( cr loc dim layout string -- )
+ ;
+
+: set-text-position ( cr loc -- )
+ first2 cairo_move_to ;
+
+: layout-metrics ( dim baseline -- metrics )
+ metrics new
+ swap >>ascent
+ swap first2 [ >>width ] [ >>height ] bi*
+ dup [ height>> ] [ ascent>> ] bi - >>descent ;
+
+TUPLE: layout font layout metrics image loc dim disposed ;
+
+:: <layout> ( font string -- line )
[
- pango_cairo_create_layout |g_object_unref
- [ set-layout-font ] keep
- [ set-layout-text ] keep
+ ! TODO: metrics and loc
+ [let* | open-font [ font cache-font-description ]
+ layout [ string open-font <PangoLayout> ]
+ logical-rect [ layout layout-extents ] ink-rect [ ]
+ baseline [ layout layout-baseline ]
+ logical-loc [ logical-rect loc>> ]
+ logical-dim [ logical-rect dim>> ]
+ ink-loc [ ink-rect loc>> ]
+ ink-dim [ ink-rect dim>> ]
+ metrics [ logical-dim baseline layout-metrics ] |
+ open-font layout metrics
+ ink-dim [
+ {
+ [ layout pango_cairo_update_layout ]
+ [ font ink-dim fill-background ]
+ [ font set-foreground ]
+ [ ink-loc ink-dim layout string fill-selection-background ]
+ [ logical-loc ink-loc v- set-text-position ]
+ [ layout pango_cairo_show_layout ]
+ } cleave
+ ] make-bitmap-image
+ logical-loc ink-loc v-
+ logical-dim
+ ]
+ f layout boa
] with-destructors ;
-: dummy-cairo ( -- cr )
- \ dummy-cairo [
- CAIRO_FORMAT_ARGB32 0 0 cairo_image_surface_create
- cairo_create
- ] initialize-alien ;
+M: layout dispose* layout>> g_object_unref ;
+
+SYMBOL: cached-layouts
+
+: cached-layout ( font string -- layout )
+ cached-layouts get [ <layout> ] 2cache ;
+
+: cached-line ( font string -- line )
+ cached-layout layout>> 0 pango_layout_get_line_readonly ;
+
+[ <cache-assoc> cached-layouts set-global ] "pango.layouts" add-init-hook
\ 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: system alien.destructors alien.c-types alien.syntax alien
-combinators ;
+USING: arrays system alien.destructors alien.c-types alien.syntax alien
+combinators math.rectangles kernel ;
IN: pango
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
FUNCTION: PangoContext*
pango_context_new ( ) ;
+C-STRUCT: PangoRectangle
+ { "int" "x" }
+ { "int" "y" }
+ { "int" "width" }
+ { "int" "height" } ;
+
+: PangoRectangle>rect ( PangoRectangle -- rect )
+ [ [ PangoRectangle-x ] [ PangoRectangle-y ] bi 2array ]
+ [ [ PangoRectangle-width ] [ PangoRectangle-height ] bi 2array ] bi
+ <rect> ;
+
: dummy-pango-context ( -- context )
\ dummy-pango-context [ pango_context_new ] initialize-alien ;
\ No newline at end of file
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types assocs cache kernel math
+namespaces opengl.textures pango.cairo pango.layouts
+ui.gadgets.worlds ui.text ui.text.private ;
+IN: ui.text.pango
+
+SINGLETON: pango-renderer
+
+M: pango-renderer init-text-rendering
+ <cache-assoc> >>text-handle drop ;
+
+M: pango-renderer string-dim cached-layout dim>> ;
+
+M: pango-renderer finish-text-rendering
+ text-handle>> purge-cache
+ cached-layouts get purge-cache ;
+
+: rendered-layout ( font string -- texture )
+ world get text-handle>>
+ [ cached-layout [ image>> ] [ loc>> ] bi <texture> ]
+ 2cache ;
+
+M: pango-renderer draw-string ( font string -- )
+ rendered-layout draw-texture ;
+
+M: pango-renderer x>offset ( x font string -- n )
+ cached-line swap 0 <int> 0 <int>
+ [ pango_layout_line_x_to_index drop ] 2keep
+ [ *int ] bi@ + ;
+
+M: pango-renderer offset>x ( n font string -- x )
+ cached-line swap f
+ 0 <int> [ pango_layout_line_index_to_x ] keep *int ;
+
+: missing-metrics ( metrics -- metrics ) 5 >>cap-height 5 >>x-height ;
+
+M: pango-renderer font-metrics ( font -- metrics )
+ cache-font-metrics missing-metrics ;
+
+M: pango-renderer line-metrics ( font string -- metrics )
+ cached-layout metrics>> missing-metrics ;
+
+pango-renderer font-renderer set-global
\ No newline at end of file
projects / factor.git / commitdiff