Use symbols for shapes

[factor.git] / basis / ui / gadgets / editors / editors.factor

diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index 36285120eb8618119bb125ae7ca03af776061a96..f846d6cbdb881cefa69dbfb7104f58cc124b6edb 100644 (file)
--- a/basis/ui/gadgets/editors/editors.factor
+++ b/basis/ui/gadgets/editors/editors.factor
@@ -1,18 +1,20 @@
 ! Copyright (C) 2006, 2011 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs calendar colors.constants
-combinators combinators.short-circuit documents
-documents.elements fonts fry grouping kernel literals locals
-make math math.functions math.order math.ranges math.rectangles
-math.vectors models models.arrow namespaces opengl opengl.gl
-sequences sorting splitting system timers ui.baseline-alignment
-ui.clipboards ui.commands ui.gadgets ui.gadgets.borders
+USING: accessors arrays assocs calendar colors combinators
+combinators.short-circuit documents documents.elements fonts fry
+grouping kernel literals locals make math math.functions
+math.order ranges math.rectangles math.vectors models
+models.arrow namespaces opengl opengl.gl sequences sorting
+splitting system timers ui.baseline-alignment ui.clipboards
+ui.commands ui.gadgets ui.gadgets.borders
 ui.gadgets.line-support ui.gadgets.menus ui.gadgets.scrollers
-ui.gestures ui.pens.solid ui.render ui.text ui.theme unicode ;
+prettyprint math.parser
+ui.gestures ui.pens.solid ui.render ui.text ui.theme unicode variables ;
 IN: ui.gadgets.editors
 
 TUPLE: editor < line-gadget
     caret mark
+    caret-shape
     focused? blink blink-timer
     default-text
     preedit-start
@@ -24,12 +26,19 @@ TUPLE: editor < line-gadget
 
 M: editor preedit? preedit-start>> ;
 
+SYMBOLS: +line+ +box+ +filled+ ;
+GLOBAL: caret-is-shape 
++line+ caret-is-shape set-global
+
+: <caret-shape> ( -- shape )  caret-is-shape get-global <model> ;
+
 <PRIVATE
 
 : <loc> ( -- loc ) { 0 0 } <model> ;
 
 : init-editor-locs ( editor -- editor )
     <loc> >>caret
+    <caret-shape> >>caret-shape
     <loc> >>mark ; inline
 
 : editor-theme ( editor -- editor )
@@ -143,10 +152,10 @@ M: editor ungraft*
     [ stop-blinking ] [ f >>focused? relayout-1 ] bi ;
 
 : loc>x ( loc editor -- x )
-    [ first2 swap ] dip [ editor-line ] [ font>> ] bi swap offset>x round ;
+    [ first2 swap ] dip [ editor-line ] [ font>> ] bi swap offset>x gl-round ;
 
 : loc>point ( loc editor -- loc )
-    [ loc>x ] [ [ first ] dip line>y ceiling ] 2bi 2array ;
+    [ loc>x ] [ [ first ] dip line>y gl-ceiling ] 2bi 2array ;
 
 : caret-loc ( editor -- loc )
     [ editor-caret ] keep loc>point ;
@@ -167,11 +176,34 @@ M: editor ungraft*
     { [ focused?>> ] [ blink>> ]
       [ [ preedit? not ] [ preedit-selection-mode?>> not ] bi or ] } 1&& ;
 
+: (caret-location) ( editor -- loc dim )
+    [ caret-loc ] [ caret-dim ] bi ;
+
+: (caret-rect) ( dim -- newdim )
+    second [ 2 / ] keep 2array ;
+
+: draw-caret-line ( editor -- )
+    (caret-location) over v+ gl-line ;
+
+: draw-caret-rect ( editor -- )
+    (caret-location) (caret-rect) gl-rect ;
+
+: draw-caret-rect-filled ( editor -- )
+    (caret-location) (caret-rect) gl-fill-rect ;
+
+: draw-caret-shape ( editor -- )
+    dup caret-shape>> value>>
+    {
+        { +box+ [ draw-caret-rect ] }
+        { +filled+ [ draw-caret-rect-filled ] }
+        [ drop  draw-caret-line ]
+    } case ;
+    
+
 : draw-caret ( editor -- )
     dup draw-caret? [
         [ editor-caret-color gl-color ] dip
-        [ caret-loc ] [ caret-dim ] bi
-        over v+ gl-line
+        draw-caret-shape
     ] [ drop ] if ;
 
 :: draw-preedit-underlines ( editor -- )
@@ -200,16 +232,16 @@ TUPLE: selected-line start end first? last? ;
 
 : compute-selection ( editor -- assoc )
     dup gadget-selection? [
-        [ selection-start/end [ [ first ] bi@ [a,b] ] [ ] 2bi ]
+        [ selection-start/end [ [ first ] bi@ [a..b] ] [ ] 2bi ]
         [ model>> ] bi
         '[ [ _ _ ] [ _ start/end-on-line ] bi 2array ] H{ } map>assoc
     ] [ drop f ] if ;
 
 :: draw-selection ( line pair editor -- )
-    pair [ editor font>> line offset>x ] map :> pair
+    pair [ editor font>> line offset>x gl-round ] map :> pair
     editor selection-color>> gl-color
     pair first 0 2array
-    pair second pair first - round 1 max editor line-height 2array
+    pair second pair first - 1 max editor line-height 2array
     gl-fill-rect ;
 
 : draw-unselected-line ( line editor -- )
@@ -630,19 +662,16 @@ PRIVATE>
 : insert-newline ( editor -- )
     "\n" swap user-input* drop ;
 
-: insert-newline-after ( editor -- )
-    [ insert-newline ] [ previous-character ] bi ;
-
 : change-selection ( editor quot -- )
     '[ gadget-selection @ ] [ user-input* drop ] bi ; inline
 
 <PRIVATE
 
 : join-lines ( string -- string' )
-    "\n" split
+    split-lines
     [ rest-slice [ [ blank? ] trim-head-slice ] map! drop ]
     [ but-last-slice [ [ blank? ] trim-tail-slice ] map! drop ]
-    [ " " join ]
+    [ join-words ]
     tri ;
 
 : last-line? ( document line -- ? )
@@ -687,7 +716,6 @@ multiline-editor "multiline" f {
     { T{ key-down f { S+ } "RET" } insert-newline }
     { T{ key-down f f "ENTER" } insert-newline }
     { T{ key-down f { S+ } "ENTER" } insert-newline }
-    { T{ key-down f { C+ } "o" } insert-newline-after }
     { T{ key-down f { C+ } "j" } com-join-lines }
 } define-command-map