! Copyright (C) 2009, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.strings arrays assocs cache cairo
-cairo.ffi classes.struct combinators destructors fonts fry
-init io.encodings.utf8 kernel math math.rectangles math.vectors
-memoize namespaces sequences ui.text ui.text.private
-gobject.ffi pango.ffi pango.cairo.ffi ;
+USING: accessors alien.c-types alien.data alien.strings arrays assocs
+cache cairo cairo.ffi classes.struct combinators destructors fonts fry
+gobject.ffi init io.encodings.utf8 kernel math math.rectangles
+math.vectors memoize namespaces pango.cairo.ffi pango.ffi sequences
+ui.text ui.text.private ;
IN: ui.text.pango
: pango>float ( n -- x ) PANGO_SCALE /f ; inline
: float>pango ( x -- n ) PANGO_SCALE * >integer ; inline
-MEMO: (cache-font-description) ( font -- description )
+MEMO:: (cache-font-description) ( name size bold? italic? -- description )
[
- [ pango_font_description_new |pango_font_description_free ] dip {
- [ name>> utf8 string>alien pango_font_description_set_family ]
- [ size>> float>pango 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
+ pango_font_description_new |pango_font_description_free {
+ [ name utf8 string>alien pango_font_description_set_family ]
+ [ size float>pango 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 ]
+ [ ]
+ } cleave
] with-destructors ;
: cache-font-description ( font -- description )
- strip-font-colors (cache-font-description) ;
-
+ { [ name>> ] [ size>> ] [ bold?>> ] [ italic?>> ] } cleave
+ (cache-font-description) ;
TUPLE: layout < disposable font string selection layout metrics ink-rect logical-rect image ;
<rect> ;
: layout-extents ( layout -- ink-rect logical-rect )
- PangoRectangle <struct>
- PangoRectangle <struct>
+ PangoRectangle new
+ PangoRectangle new
[ pango_layout_get_extents ] 2keep
[ PangoRectangle>rect ] bi@ ;
layout>> 0 pango_layout_get_line_readonly ;
: line-offset>x ( layout n -- x )
- #! n is an index into the UTF8 encoding of the text
+ ! n is an index into the UTF8 encoding of the text
[ drop first-line ] [ swap string>> >utf8-index ] 2bi
- f 0 <int> [ pango_layout_line_index_to_x ] keep
- *int pango>float ;
+ f { int } [ pango_layout_line_index_to_x ] with-out-parameters
+ pango>float ;
: x>line-offset ( layout x -- n )
- #! n is an index into the UTF8 encoding of the text
+ ! n is an index into the UTF8 encoding of the text
[
[ first-line ] dip
- float>pango 0 <int> 0 <int>
- [ pango_layout_line_x_to_index drop ] 2keep
- [ *int ] bi@ swap
+ float>pango
+ { int int }
+ [ pango_layout_line_x_to_index drop ] with-out-parameters
+ swap
] [ drop string>> ] 2bi utf8-index> + ;
: selection-start/end ( selection -- start end )
] make-bitmap-image ;
: escape-nulls ( str -- str' )
- #! Replace nulls with something else since Pango uses null-terminated
- #! strings
- { { 0 CHAR: zero-width-no-break-space } } substitute ;
+ ! Replace nulls with something else since Pango uses null-terminated
+ ! strings
+ H{ { 0 CHAR: zero-width-no-break-space } } substitute ;
: unpack-selection ( layout string/selection -- layout )
dup selection? [
] [ escape-nulls >>string ] if ; inline
: set-layout-resolution ( layout -- )
- pango_layout_get_context dpi get pango_cairo_context_set_resolution ;
+ pango_layout_get_context dpi get-global pango_cairo_context_set_resolution ;
: <PangoLayout> ( text font -- layout )
dummy-cairo pango_cairo_create_layout |g_object_unref
swap <PangoLayout> &g_object_unref layout-extents drop dim>> second ;
MEMO: missing-font-metrics ( font -- metrics )
- #! Pango doesn't provide x-height and cap-height but Core Text does, so we
- #! simulate them on Pango.
+ ! Pango doesn't provide x-height and cap-height but Core Text does, so we
+ ! simulate them on Pango.
[
[ metrics new ] dip
[ "x" glyph-height >>x-height ]
dup [ string>> ] [ font>> ] bi <PangoLayout> >>layout
dup layout>> layout-extents [ >>ink-rect ] [ >>logical-rect ] bi*
dup layout-metrics >>metrics
- dup draw-layout >>image
] with-destructors ;
M: layout dispose* layout>> g_object_unref ;
SYMBOL: cached-layouts
: cached-layout ( font string -- layout )
- cached-layouts get [ <layout> ] 2cache ;
+ cached-layouts get-global [ <layout> ] 2cache ;
: cached-line ( font string -- line )
cached-layout layout>> first-line ;
+: layout>image ( layout -- image )
+ dup image>> [ dup draw-layout >>image ] unless image>> ;
+
SINGLETON: pango-renderer
M: pango-renderer string-dim
[ " " string-dim { 0 1 } v* ]
- [ cached-layout logical-rect>> dim>> [ >integer ] map ] if-empty ;
+ [ cached-layout logical-rect>> dim>> v>integer ] if-empty ;
M: pango-renderer flush-layout-cache
- cached-layouts get purge-cache ;
+ cached-layouts get-global purge-cache ;
-M: pango-renderer string>image ( font string -- image loc )
- cached-layout [ image>> ] [ text-position vneg ] bi ;
+M: pango-renderer string>image
+ cached-layout [ layout>image ] [ text-position vneg ] bi ;
-M: pango-renderer x>offset ( x font string -- n )
+M: pango-renderer x>offset
cached-layout swap x>line-offset ;
-M: pango-renderer offset>x ( n font string -- x )
+M: pango-renderer offset>x
cached-layout swap line-offset>x ;
-M: pango-renderer font-metrics ( font -- metrics )
+M: pango-renderer font-metrics
" " cached-layout metrics>> clone f >>width ;
-M: pango-renderer line-metrics ( font string -- metrics )
+M: pango-renderer line-metrics
[ " " line-metrics clone 0 >>width ]
[ cached-layout metrics>> ]
if-empty ;
] "ui.text.pango" add-startup-hook
pango-renderer font-renderer set-global
-
projects / factor.git / blobdiff