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

First attempt at ui.text.pango

db4
Slava Pestov 2009-02-28 01:31:51 -06:00
parent cdfab25bb1
commit 385c4661d6
13 changed files with 202 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
basis/cairo/authors.txt
View File

@ -1,2 +1,3 @@
Sampo Vuori
Doug Coleman
Slava Pestov

22
basis/cairo/cairo.factor
View File

@ -1,7 +1,9 @@
! 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 ;
@ -43,4 +45,18 @@ 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 ;

3
basis/core-graphics/core-graphics.factor
View File

@ -126,4 +126,5 @@ PRIVATE>
] initialize-alien ;
: make-bitmap-image ( dim quot -- image )
'[ <CGBitmapContext> &CGContextRelease @ ] make-memory-bitmap ; inline
'[ <CGBitmapContext> &CGContextRelease @ ] make-memory-bitmap
ARGB >>component-order ; inline

1
basis/glib/glib.factor
View File

@ -24,6 +24,7 @@ LIBRARY: glib
TYPEDEF: void* gpointer
TYPEDEF: int gint
TYPEDEF: bool gboolean
FUNCTION: void
g_free ( gpointer mem ) ;

14
basis/images/images.factor
View File

@ -34,7 +34,7 @@ TUPLE: image dim component-order bitmap ;
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 ;
@ -63,8 +63,7 @@ M: R16G16B16 normalize-component-order*
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 ;
@ -75,6 +74,15 @@ M: RGB normalize-component-order*
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 ;

3
basis/images/memory/memory.factor
View File

@ -20,8 +20,7 @@ IN: images.memory
[ bitmap-data ] keep
<image>
swap >>dim
swap >>bitmap
little-endian? ARGB BGRA ? >>component-order ;
swap >>bitmap ;
PRIVATE>

2
basis/opengl/textures/textures.factor
View File

@ -17,7 +17,7 @@ GENERIC: component-order>format ( component-order -- format type )
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 ;

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

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

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

@ -1,4 +1,5 @@
! 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
@ -101,17 +102,12 @@ MEMO: (cache-font) ( font -- open-font )
: 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) ;

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

@ -1,8 +1,10 @@
! 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
@ -32,16 +34,45 @@ FUNCTION: int
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
@ -49,15 +80,71 @@ ERROR: bad-font name ;
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

16
basis/pango/pango.factor
View File

@ -1,7 +1,8 @@
! 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
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -21,5 +22,16 @@ CONSTANT: PANGO_SCALE 1024
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 ;

1
basis/ui/text/pango/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

44
basis/ui/text/pango/pango.factor Normal file
View File

@ -0,0 +1,44 @@
! 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