From 176629055e0de32bd768a5071e1a5a5da7abcb4b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 7 Feb 2009 18:05:11 -0600
Subject: [PATCH] Add support for rendering selected text to ui.text

---
 basis/core-text/core-text.factor | 28 ++++++++++++++++++++++++----
 basis/fonts/fonts.factor         |  6 +++++-
 basis/ui/text/text.factor        |  4 +++-
 3 files changed, 32 insertions(+), 6 deletions(-)

diff --git a/basis/core-text/core-text.factor b/basis/core-text/core-text.factor
index 20f2a9e803..0aa3bce282 100644
--- a/basis/core-text/core-text.factor
+++ b/basis/core-text/core-text.factor
@@ -34,6 +34,7 @@ FUNCTION: CGRect CTLineGetImageBounds ( CTLineRef line, CGContextRef context ) ;
 
 : <CTLine> ( string open-font color -- line )
     [
+        [ dup selection? [ string>> ] when ] 2dip
         [
             kCTForegroundColorAttributeName set
             kCTFontAttributeName set
@@ -53,6 +54,25 @@ TUPLE: line font line metrics dim bitmap age refs disposed ;
     [ ceiling >fixnum ]
     bi@ 2array ;
 
+: fill-background ( context font dim -- )
+    [ background>> >rgba-components CGContextSetRGBFillColor ]
+    [ [ 0 0 ] dip first2 <CGRect> CGContextFillRect ]
+    bi-curry* bi ;
+
+: selection-rect ( dim line selection -- rect )
+    [ start>> ] [ end>> ] bi
+    [ f CTLineGetOffsetForStringIndex ] bi-curry@ bi
+    [ drop nip 0 ] [ swap - swap second ] 3bi <CGRect> ;
+
+:: fill-selection-background ( context dim line string -- )
+    string selection? [
+        context string color>> >rgba-components CGContextSetRGBFillColor
+        context dim line string selection-rect CGContextFillRect
+    ] when ;
+
+: set-text-position ( context metrics -- )
+    [ 0 ] dip descent>> ceiling CGContextSetTextPosition ;
+
 :: <line> ( font string -- line )
     [
         [let* | open-font [ font cache-font CFRetain |CFRelease ]
@@ -61,10 +81,10 @@ TUPLE: line font line metrics dim bitmap age refs disposed ;
                 dim [ metrics bounds>dim ] |
             dim [
                 {
-                    [ font background>> >rgba-components CGContextSetRGBFillColor ]
-                    [ 0 0 dim first2 <CGRect> CGContextFillRect ]
-                    [ 0 metrics descent>> ceiling CGContextSetTextPosition ]
-                    [ line swap CTLineDraw ]
+                    [ font dim fill-background ]
+                    [ dim line string fill-selection-background ]
+                    [ metrics set-text-position ]
+                    [ [ line ] dip CTLineDraw ]
                 } cleave
             ] with-bitmap-context
             [ open-font line metrics dim ] dip 0 0 f
diff --git a/basis/fonts/fonts.factor b/basis/fonts/fonts.factor
index 3e6541283d..4f6fcac27b 100644
--- a/basis/fonts/fonts.factor
+++ b/basis/fonts/fonts.factor
@@ -55,4 +55,8 @@ italic?
         "monospace" >>name
         12 >>size ;
 
-TUPLE: metrics width ascent descent leading ;
\ No newline at end of file
+TUPLE: metrics width ascent descent leading ;
+
+TUPLE: selection string start end color ;
+
+C: <selection> selection
\ No newline at end of file
diff --git a/basis/ui/text/text.factor b/basis/ui/text/text.factor
index 4acf892ae0..87e6dc0862 100644
--- a/basis/ui/text/text.factor
+++ b/basis/ui/text/text.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel arrays sequences math math.order opengl opengl.gl
-strings fonts colors ;
+strings fonts colors accessors ;
 IN: ui.text
 
 <PRIVATE
@@ -56,6 +56,8 @@ GENERIC# draw-text 1 ( font text loc -- )
 
 M: string draw-text draw-string ;
 
+M: selection draw-text draw-string ;
+
 M: sequence draw-text
     [
         [