X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=blobdiff_plain;f=basis%2Fui%2Fgadgets%2Feditors%2Feditors.factor;h=b4ec2c37448db8c2093ae956ae893b067b55cbac;hp=75c2c21e898f24fe28744ad55ae83bd94404b999;hb=ce7ac93667de16e9206a2140941b67a66886d117;hpb=b6f1ad5736214af111990fd791388de3be919d3b

diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index 75c2c21e89..b4ec2c3744 100644
--- a/basis/ui/gadgets/editors/editors.factor
+++ b/basis/ui/gadgets/editors/editors.factor
@@ -8,7 +8,8 @@ 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 ui.gadgets.editors.private math.parser
+ui.gestures ui.pens.solid ui.render ui.text ui.theme unicode variables ;
 IN: ui.gadgets.editors
 
 TUPLE: editor < line-gadget
@@ -24,12 +25,16 @@ TUPLE: editor < line-gadget
 
 M: editor preedit? preedit-start>> ;
 
+SYMBOL: caret-is-shape 
+: <caret-shape> ( -- shape )  caret-is-shape get <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 )
@@ -167,6 +172,30 @@ 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>> 
+    {
+        { 1 [ draw-caret-rect ] }
+        { 2 [ draw-caret-rect-filled ] }
+        [ drop  draw-caret-line ]
+    } case ;
+    
+
 : draw-caret ( editor -- )
     dup draw-caret? [
         [ editor-caret-color gl-color ] dip