 : char-widths ( open-font string -- widths )
     [ char-width ] with { } map-as ;
 
-: scan-sums ( seq -- seq' )
+: sums ( seq -- seq )
     0 [ + ] accumulate nip ;
 
-:: (draw-string) ( open-font sprites string loc -- )
+: font-sprites ( font world -- sprites )
+    fonts>> [ drop H{ } clone ] cache ;
+
+: draw-background ( widths open-font -- )
+    [ sum ] [ height>> ] bi* 2array gl-fill-rect ;
+
+:: draw-selection ( widths open-font line -- )
+    line color>> gl-color
+    widths line start>> head-slice sum 0 2array [
+        line [ start>> ] [ end>> ] bi widths <slice> sum
+        open-font height>> 2array gl-fill-rect
+    ] with-translation ;
+
+M:: freetype-renderer draw-string ( font line loc -- )
+    line dup selection? [ string>> ] when :> string
+    font open-font :> open-font
+    open-font world get font-sprites :> sprites
+    open-font string char-widths :> widths
     GL_TEXTURE_2D [
         loc [
-            string open-font string char-widths scan-sums [
-                [ open-font sprites ] 2dip draw-char
-            ] 2each
+            font background>> gl-color
+            widths open-font draw-background
+            line selection? [ widths open-font line draw-selection ] when
+            font foreground>> gl-color
+            string widths sums [ [ open-font sprites ] 2dip draw-char ] 2each
         ] with-translation
     ] do-enabled ;
 
-: font-sprites ( font world -- open-font sprites )
-    fonts>> [ open-font H{ } clone 2array ] cache first2 ;
-
-M: freetype-renderer draw-string ( font string loc -- )
-    [ world get font-sprites ] 2dip (draw-string) ;
-
 : run-char-widths ( open-font string -- widths )
-    char-widths [ scan-sums ] [ 2 v/n ] bi v+ ;
+    char-widths [ sums ] [ 2 v/n ] bi v+ ;
 
 M: freetype-renderer x>offset ( x font string -- n )
     [ open-font ] dip


M: freetype-font hashcode* drop freetype-font hashcode* ;

: close-font ( font -- ) handle>> FT_Done_Face ;

: close-freetype ( -- )
    global [
        open-fonts [ [ drop close-font ] assoc-each f ] change
        freetype [ FT_Done_FreeType f ] change
    ] bind ;

M: freetype-renderer free-fonts ( world -- )
    values [ second free-sprites ] each ;

: ttf-name ( font -- name )
    [ [ name>> ] [ bold?>> ] [ italic?>> ] tri ] output>array H{

    [ dup handle>> 0 ] dip
    6 shift dpi get-global dup FT_Set_Char_Size freetype-error ;

MEMO: (open-font) ( font -- open-font )
    freetype-font new
        H{ } clone >>widths
        over open-face >>handle
        swap size>> set-char-size
        init-font ;

GENERIC: open-font ( font -- open-font )

M: font open-font
    clone f >>background f >>foreground (open-font) ;

: load-glyph ( font char -- glyph )
    [ handle>> dup ] dip 0 FT_Load_Char
    freetype-error face-glyph ;

: char-width ( open-font char -- w )
    swap [ widths>> ] keep
    [ swap load-glyph glyph-hori-advance ft-ceil ] curry cache ;

M: freetype-renderer string-width ( font string -- w )
    [ [ 0 ] dip open-font ] dip [ char-width + ] with each ;
