{ 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." } ;
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
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 )
{ [ 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