X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=blobdiff_plain;f=basis%2Fui%2Fgadgets%2Feditors%2Feditors.factor;h=f846d6cbdb881cefa69dbfb7104f58cc124b6edb;hp=45b7a2735f82939d74081a0db035ba5fa059bdef;hb=4843bd64ead67e74c22eb715eac3ca814304250a;hpb=b98d64358de01a7d2c632725beaa315673272924

diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index 45b7a2735f..f846d6cbdb 100644
--- 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 )
@@ -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 -- )