Fix text positioning with pango backend

Implement selection rendering
Make resolution configurable
Clean up float <-> fixed point conversion

basis/cairo/cairo.factor

@@ -3,7 +3,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: colors fonts cairo.ffi alien alien.c-types kernel accessors
 sequences namespaces fry continuations destructors math images
-images.memory ;
+images.memory math.rectangles ;
 IN: cairo
 
 ERROR: cairo-error message ;
@@ -60,3 +60,8 @@ ERROR: cairo-error message ;
 
 : set-source-color ( cr color -- )
     >rgba-components cairo_set_source_rgba ;
+
+: fill-rect ( cr rect -- )
+    [ rect-bounds [ first2 ] bi@ cairo_rectangle ]
+    [ drop cairo_fill ]
+    2bi ;

basis/pango/cairo/cairo.factor

@@ -5,7 +5,7 @@
 ! pangocairo bindings, from pango/pangocairo.h
 USING: cairo.ffi alien.c-types math alien.syntax system destructors
 memoize accessors kernel combinators alien arrays fonts pango
-pango.fonts ;
+pango.fonts namespaces ;
 IN: pango.cairo
 
 << "pangocairo" {
@@ -89,8 +89,21 @@ 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 ) ;
 
+SYMBOL: dpi
+
+72 dpi set-global
+
+: dummy-pango-context ( -- context )
+    \ dummy-pango-context [
+        pango_context_new
+    ] initialize-alien ;
+
 MEMO: (cache-font) ( font -- open-font )
-    [ pango_cairo_font_map_get_default dummy-pango-context ] dip
+    [
+        pango_cairo_font_map_get_default
+        dup dpi get pango_cairo_font_map_set_resolution
+        dummy-pango-context
+    ] dip
     cache-font-description
     pango_font_map_load_font ;
 
@@ -102,9 +115,9 @@ 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_ascent pango>float >>ascent ]
-    [ pango_font_metrics_get_descent PANGO_SCALE /f >>descent ] bi
+    [ pango_font_metrics_get_descent pango>float >>descent ] bi
-    dup [ height>> ] [ descent>> ] bi - >>ascent ;
+    compute-height ;
 
 MEMO: (cache-font-metrics) ( font -- metrics )
     [ get-font-metrics parse-font-metrics ] with-destructors ;

basis/pango/fonts/fonts.factor

@@ -92,7 +92,7 @@ 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 ]
+            [ 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 ]

basis/pango/layouts/layouts.factor

@@ -2,9 +2,10 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays sequences alien alien.c-types alien.destructors
-alien.syntax math math.vectors destructors combinators colors fonts
+alien.syntax math math.functions math.vectors destructors combinators
-accessors assocs namespaces kernel pango pango.fonts pango.cairo cairo
+colors fonts accessors assocs namespaces kernel pango pango.fonts
-cairo.ffi glib unicode.data locals images cache init ;
+pango.cairo cairo cairo.ffi glib unicode.data images cache init
+math.rectangles fry ;
 IN: pango.layouts
 
 LIBRARY: pango
@@ -56,6 +57,8 @@ pango_layout_iter_free ( PangoLayoutIter* iter ) ;
 
 DESTRUCTOR: pango_layout_iter_free
 
+TUPLE: layout font string layout metrics ink-rect logical-rect image disposed ;
+
 : layout-dim ( layout -- dim )
     0 <int> 0 <int> [ pango_layout_get_pixel_size ] 2keep
     [ *int ] bi@ 2array ;
@@ -69,7 +72,7 @@ DESTRUCTOR: pango_layout_iter_free
 : layout-baseline ( layout -- baseline )
     pango_layout_get_iter &pango_layout_iter_free
     pango_layout_iter_get_baseline
-    PANGO_SCALE /f ;
+    pango>float ;
 
 : set-layout-font ( str layout -- )
     swap pango_layout_set_font_description ;
@@ -77,7 +80,9 @@ DESTRUCTOR: pango_layout_iter_free
 : 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
+    swap
+    dup selection? [ string>> ] when
+    { { 0 CHAR: zero-width-no-break-space } } substitute
     -1 pango_layout_set_text ;
 
 : <PangoLayout> ( text font -- layout )
@@ -90,12 +95,37 @@ DESTRUCTOR: pango_layout_iter_free
 
 : fill-background ( cr font dim -- )
     [ background>> set-source-color ]
-    [ [ 0 0 ] dip first2 cairo_rectangle ] bi-curry*
+    [ [ { 0 0 } ] dip <rect> fill-rect ] bi-curry* bi ;
-    [ cairo_fill ]
-    tri ;
 
-:: fill-selection-background ( cr loc dim layout string -- )
+: rect-translate-x ( rect x -- rect' )
-    ;
+    '[ _ 0 2array v- ] change-loc ;
+
+: first-line ( layout -- line )
+    0 pango_layout_get_line_readonly ;
+
+: line-offset>x ( line n -- x )
+    f 0 <int> [ pango_layout_line_index_to_x ] keep
+    *int pango>float ;
+
+: x>line-offset ( line x -- n )
+    float>pango 0 <int> 0 <int>
+    [ pango_layout_line_x_to_index drop ] 2keep
+    [ *int ] bi@ + ;
+
+: selection-rect ( dim layout selection -- rect )
+    [ first-line ] [ [ start>> ] [ end>> ] bi ] bi*
+    [ line-offset>x ] bi-curry@ bi
+    [ drop nip 0 2array ] [ swap - swap second 2array ] 3bi <rect> ;
+
+: fill-selection-background ( cr layout -- )
+    dup string>> selection? [
+        [ string>> color>> set-source-color ]
+        [
+            [ [ ink-rect>> dim>> ] [ layout>> ] [ string>> ] tri selection-rect ]
+            [ ink-rect>> loc>> first ] bi rect-translate-x
+            fill-rect
+        ] 2bi
+    ] [ 2drop ] if ;
 
 : set-text-position ( cr loc -- )
     first2 cairo_move_to ;
@@ -106,35 +136,30 @@ DESTRUCTOR: pango_layout_iter_free
         swap first2 [ >>width ] [ >>height ] bi*
         dup [ height>> ] [ ascent>> ] bi - >>descent ;
 
-TUPLE: layout font layout metrics image loc dim disposed ;
+: text-position ( layout -- loc )
+    [ logical-rect>> ] [ ink-rect>> ] bi [ loc>> ] bi@ v- ;
 
-:: <layout> ( font string -- line )
+: draw-layout ( layout -- image )
+    dup ink-rect>> dim>> [
+        swap {
+            [ layout>> pango_cairo_update_layout ]
+            [ [ font>> ] [ ink-rect>> dim>> ] bi fill-background ]
+            [ fill-selection-background ]
+            [ text-position set-text-position ]
+            [ font>> set-foreground ]
+            [ layout>> pango_cairo_show_layout ]
+        } 2cleave
+    ] make-bitmap-image ;
+
+: <layout> ( font string -- line )
     [
-        ! TODO: metrics and loc
+        layout new
-        [let* | open-font [ font cache-font-description ]
+            swap >>string
-                layout [ string open-font <PangoLayout> ]
+            swap >>font
-                logical-rect [ layout layout-extents ] ink-rect [ ]
+            dup [ string>> ] [ font>> cache-font-description ] bi <PangoLayout> >>layout
-                baseline [ layout layout-baseline ]
+            dup layout>> layout-extents [ >>ink-rect ] [ >>logical-rect ] bi*
-                logical-loc [ logical-rect loc>> ]
+            dup [ logical-rect>> dim>> ] [ layout>> layout-baseline ] bi layout-metrics >>metrics
-                logical-dim [ logical-rect dim>> ]
+            dup draw-layout >>image
-                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 ;
 
 M: layout dispose* layout>> g_object_unref ;
@@ -145,6 +170,6 @@ SYMBOL: cached-layouts
     cached-layouts get [ <layout> ] 2cache ;
 
 : cached-line ( font string -- line )
-    cached-layout layout>> 0 pango_layout_get_line_readonly ;
+    cached-layout layout>> first-line ;
 
 [ <cache-assoc> cached-layouts set-global ] "pango.layouts" add-init-hook

basis/pango/pango.factor

@@ -2,7 +2,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license
 USING: arrays system alien.destructors alien.c-types alien.syntax alien
-combinators math.rectangles kernel ;
+combinators math.rectangles kernel math ;
 IN: pango
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -19,6 +19,9 @@ LIBRARY: pango
 
 CONSTANT: PANGO_SCALE 1024
 
+: pango>float ( n -- x ) PANGO_SCALE /f ; inline
+: float>pango ( x -- n ) PANGO_SCALE * >integer ; inline
+
 FUNCTION: PangoContext*
 pango_context_new ( ) ;
 
@@ -32,6 +35,3 @@ C-STRUCT: PangoRectangle
     [ [ 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 ;

basis/ui/text/pango/pango.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types assocs cache kernel math
+USING: accessors alien.c-types assocs cache kernel math math.vectors
-namespaces opengl.textures pango.cairo pango.layouts
+namespaces opengl.textures pango.cairo pango.layouts ui.gadgets.worlds
-ui.gadgets.worlds ui.text ui.text.private ;
+ui.text ui.text.private pango ;
 IN: ui.text.pango
 
 SINGLETON: pango-renderer
@@ -10,7 +10,7 @@ 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 string-dim cached-layout logical-rect>> dim>> ;
 
 M: pango-renderer finish-text-rendering
     text-handle>> purge-cache
@@ -18,22 +18,20 @@ M: pango-renderer finish-text-rendering
 
 : rendered-layout ( font string -- texture )
     world get text-handle>>
-    [ cached-layout [ image>> ] [ loc>> ] bi <texture> ]
+    [ cached-layout [ image>> ] [ text-position vneg ] 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>
+    cached-line swap x>line-offset ;
-    [ pango_layout_line_x_to_index drop ] 2keep
-    [ *int ] bi@ + ;
 
 M: pango-renderer offset>x ( n font string -- x )
-    cached-line swap f
+    cached-line swap line-offset>x ;
-    0 <int> [ pango_layout_line_index_to_x ] keep *int ;
 
-: missing-metrics ( metrics -- metrics ) 5 >>cap-height 5 >>x-height ;
+: missing-metrics ( metrics -- metrics )
+    5 >>cap-height 5 >>x-height ;
 
 M: pango-renderer font-metrics ( font -- metrics )
     cache-font-metrics missing-metrics ;