Block caret code

(cherry picked from commit 749ecba7c3e80891109273ff714e993afbe003c0)

# Conflicts:
#	basis/ui/gadgets/editors/editors.factor

diff --git a/basis/ui/gadgets/editors/editors-docs.factor b/basis/ui/gadgets/editors/editors-docs.factor
index 180d5c46fc8f35bf7061aa5d002c65776ad34949..927e50682496b31a70f920b773531ea00a3f80af 100644 (file)
--- a/basis/ui/gadgets/editors/editors-docs.factor
+++ b/basis/ui/gadgets/editors/editors-docs.factor
@@ -33,6 +33,29 @@ HELP: <editor>
 
 { editor-caret editor-mark } related-words
 
+HELP: caret-is-shape
+{ $description
+  "Shape is defined as line, box, or filled box"
+}
+$nl
+{ $code
+"  IN: ui.gadgets.editors"
+"  2 caret-is-shape set"
+""
+} print-element
+$nl
+{ $table
+  { "Value" "Shape" }
+  { "f" "default (line)" }
+  { "0" "line" }
+  { "1" "box" }
+  { "2" "filled box" }
+} print-element
+
+{ $references   "Set desired shape in your .factor-rc file" 
+ "rc-files" }
+    ;
+
 HELP: editor-caret
 { $values { "editor" editor } { "loc" "a pair of integers" } }
 { $description "Outputs the current caret location as a line/column number pair." } ;

diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index 75c2c21e898f24fe28744ad55ae83bd94404b999..b4ec2c37448db8c2093ae956ae893b067b55cbac 100644 (file)
--- 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