steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Blinking cursor

db4
Slava Pestov 2008-11-20 22:13:32 -06:00
parent f24036834e
commit 17b2566017
1 changed files with 61 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
basis/ui/gadgets/editors/editors.factor
View File

@ -2,17 +2,17 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays documents io kernel math models USING: accessors arrays documents io kernel math models
namespaces make opengl opengl.gl sequences strings io.styles namespaces make opengl opengl.gl sequences strings io.styles
math.vectors sorting colors combinators assocs math.order math.vectors sorting colors combinators assocs math.order fry
ui.clipboards ui.commands ui.gadgets ui.gadgets.borders calendar alarms ui.clipboards ui.commands ui.gadgets
ui.gadgets.buttons ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.borders ui.gadgets.buttons ui.gadgets.labels
ui.gadgets.theme ui.gadgets.wrappers ui.render ui.gestures ui.gadgets.scrollers ui.gadgets.theme ui.gadgets.wrappers
math.geometry.rect ; ui.render ui.gestures math.geometry.rect ;
IN: ui.gadgets.editors IN: ui.gadgets.editors
TUPLE: editor < gadget TUPLE: editor < gadget
font color caret-color selection-color font color caret-color selection-color
caret mark caret mark
focused? ; focused? blink blink-alarm ;
: <loc> ( -- loc ) { 0 0 } <model> ; : <loc> ( -- loc ) { 0 0 } <model> ;
@ -64,14 +64,14 @@ M: editor ungraft*
caret>> set-model ; caret>> set-model ;
: change-caret ( editor quot -- ) : change-caret ( editor quot -- )
over >r >r dup editor-caret* swap model>> r> call r> [ [ [ editor-caret* ] [ model>> ] bi ] dip call ] [ drop ] 2bi
set-caret ; inline set-caret ; inline
: mark>caret ( editor -- ) : mark>caret ( editor -- )
dup editor-caret* swap mark>> set-model ; [ editor-caret* ] [ mark>> ] bi set-model ;
: change-caret&mark ( editor quot -- ) : change-caret&mark ( editor quot -- )
over >r change-caret r> mark>caret ; inline [ change-caret ] [ drop mark>caret ] 2bi ; inline
: editor-line ( n editor -- str ) control-value nth ; : editor-line ( n editor -- str ) control-value nth ;
@ -85,8 +85,8 @@ M: editor ungraft*
: point>loc ( point editor -- loc ) : point>loc ( point editor -- loc )
[ [
>r first2 r> tuck y>line dup , [ first2 ] dip tuck y>line dup ,
>r dup editor-font* r> [ dup editor-font* ] dip
rot editor-line x>offset , rot editor-line x>offset ,
] { } make ; ] { } make ;
@ -94,11 +94,35 @@ M: editor ungraft*
[ hand-rel ] keep point>loc ; [ hand-rel ] keep point>loc ;
: click-loc ( editor model -- ) : click-loc ( editor model -- )
>r clicked-loc r> set-model ; [ clicked-loc ] dip set-model ;
: focus-editor ( editor -- ) t >>focused? relayout-1 ; : blink-caret ( editor -- )
[ not ] change-blink relayout-1 ;
: unfocus-editor ( editor -- ) f >>focused? relayout-1 ; : start-blinking ( editor -- )
t >>blink
dup '[ _ blink-caret ] 750 milliseconds every >>blink-alarm drop ;
: stop-blinking ( editor -- )
blink-alarm>> cancel-alarm ;
: restart-blinking ( editor -- )
dup focused?>> [
[ stop-blinking ]
[ start-blinking ]
[ relayout-1 ]
tri
] [ drop ] if ;
: focus-editor ( editor -- )
dup start-blinking
t >>focused?
relayout-1 ;
: unfocus-editor ( editor -- )
dup stop-blinking
f >>focused?
relayout-1 ;
: (offset>x) ( font col# str -- x ) : (offset>x) ( font col# str -- x )
swap head-slice string-width ; swap head-slice string-width ;
@ -106,7 +130,7 @@ M: editor ungraft*
: offset>x ( col# line# editor -- x ) : offset>x ( col# line# editor -- x )
[ editor-line ] keep editor-font* -rot (offset>x) ; [ editor-line ] keep editor-font* -rot (offset>x) ;
: loc>x ( loc editor -- x ) >r first2 swap r> offset>x ; : loc>x ( loc editor -- x ) [ first2 swap ] dip offset>x ;
: line>y ( lines# editor -- y ) : line>y ( lines# editor -- y )
line-height * ; line-height * ;
@ -126,7 +150,7 @@ M: editor ungraft*
] [ drop ] if ; ] [ drop ] if ;
: draw-caret ( -- ) : draw-caret ( -- )
editor get focused?>> [ editor get [ focused?>> ] [ blink>> ] bi and [
editor get editor get
[ caret-color>> gl-color ] [ caret-color>> gl-color ]
[ [
@ -143,7 +167,7 @@ M: editor ungraft*
line-translation gl-translate ; line-translation gl-translate ;
: draw-line ( editor str -- ) : draw-line ( editor str -- )
>r font>> r> { 0 0 } draw-string ; [ font>> ] dip { 0 0 } draw-string ;
: first-visible-line ( editor -- n ) : first-visible-line ( editor -- n )
clip get rect-loc second origin get second - clip get rect-loc second origin get second -
@ -169,7 +193,7 @@ M: editor ungraft*
rot control-value <slice> ; rot control-value <slice> ;
: with-editor-translation ( n quot -- ) : with-editor-translation ( n quot -- )
>r line-translation origin get v+ r> with-translation ; [ line-translation origin get v+ ] dip with-translation ;
inline inline
: draw-lines ( -- ) : draw-lines ( -- )
@ -199,7 +223,7 @@ M: editor ungraft*
editor get selection-start/end editor get selection-start/end
over first [ over first [
2dup [ 2dup [
>r 2dup r> draw-selected-line [ 2dup ] dip draw-selected-line
1 translate-lines 1 translate-lines
] each-line 2drop ] each-line 2drop
] with-editor-translation ; ] with-editor-translation ;
@ -217,7 +241,7 @@ M: editor pref-dim*
drop relayout ; drop relayout ;
: caret/mark-changed ( model editor -- ) : caret/mark-changed ( model editor -- )
nip [ relayout-1 ] [ scroll>caret ] bi ; nip [ restart-blinking ] [ scroll>caret ] bi ;
M: editor model-changed M: editor model-changed
{ {
@ -247,7 +271,9 @@ M: editor user-input*
M: editor gadget-text* editor-string % ; M: editor gadget-text* editor-string % ;
: extend-selection ( editor -- ) : extend-selection ( editor -- )
dup request-focus dup caret>> click-loc ; dup request-focus
dup restart-blinking
dup caret>> click-loc ;
: mouse-elt ( -- element ) : mouse-elt ( -- element )
hand-click# get { hand-click# get {
@ -259,14 +285,15 @@ M: editor gadget-text* editor-string % ;
editor-mark* before? ; editor-mark* before? ;
: drag-selection-caret ( loc editor element -- loc ) : drag-selection-caret ( loc editor element -- loc )
>r [ drag-direction? ] 2keep [
model>> [ drag-direction? ] 2keep model>>
r> prev/next-elt ? ; ] dip prev/next-elt ? ;
: drag-selection-mark ( loc editor element -- loc ) : drag-selection-mark ( loc editor element -- loc )
>r [ drag-direction? not ] 2keep [
nip dup editor-mark* swap model>> [ drag-direction? not ] keep
r> prev/next-elt ? ; [ editor-mark* ] [ model>> ] bi
] dip prev/next-elt ? ;
: drag-caret&mark ( editor -- caret mark ) : drag-caret&mark ( editor -- caret mark )
dup clicked-loc swap mouse-elt dup clicked-loc swap mouse-elt
@ -285,15 +312,16 @@ M: editor gadget-text* editor-string % ;
over gadget-selection? [ over gadget-selection? [
drop nip remove-selection drop nip remove-selection
] [ ] [
over >r >r dup editor-caret* swap model>> [ [ [ editor-caret* ] [ model>> ] bi ] dip call ]
r> call r> model>> remove-doc-range [ drop model>> ]
2bi remove-doc-range
] if ; inline ] if ; inline
: editor-delete ( editor elt -- ) : editor-delete ( editor elt -- )
swap [ over >r rot next-elt r> swap ] delete/backspace ; swap [ over [ rot next-elt ] dip swap ] delete/backspace ;
: editor-backspace ( editor elt -- ) : editor-backspace ( editor elt -- )
swap [ over >r rot prev-elt r> ] delete/backspace ; swap [ over [ rot prev-elt ] dip ] delete/backspace ;
: editor-select-prev ( editor elt -- ) : editor-select-prev ( editor elt -- )
swap [ rot prev-elt ] change-caret ; swap [ rot prev-elt ] change-caret ;
@ -311,9 +339,8 @@ M: editor gadget-text* editor-string % ;
tuck caret>> set-model mark>> set-model ; tuck caret>> set-model mark>> set-model ;
: select-elt ( editor elt -- ) : select-elt ( editor elt -- )
over >r [ [ [ editor-caret* ] [ model>> ] bi ] dip prev/next-elt ] [ drop ] 2bi
>r dup editor-caret* swap model>> r> prev/next-elt editor-select ;
r> editor-select ;
: start-of-document ( editor -- ) T{ doc-elt } editor-prev ; : start-of-document ( editor -- ) T{ doc-elt } editor-prev ;