diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 53887d62eb..b112dc5750 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -3,14 +3,11 @@ - windows port from erg - why aren't some cocoa words compiled? - editor: - - multi-line inserts - scroll to caret - - only redraw visible lines - clicking input doesn't resize editor gadget - better listener multi-line expression handling - shift modifier not delivered - x11 copy to clipboard -- one-column table doesn't need borders...? - httpd search tools - remaining HTML issues need fixing @@ -26,6 +23,7 @@ + ui: +- one-column table doesn't need borders...? [2:45pm] tathi: Factor's text display is a bit odd sometimes, until you mouse over (or click, if there's no "live" text) [2:48pm] tathi: it appears to be using the font metrics from the sprite tuple, but re-using the texture from the previous letter [2:59pm] tathi: hmm...and it looks like it's only be happening the first time you use a given character (from a given font face) @@ -36,6 +34,8 @@ - autoscroll - page up/down - search and replace + - only redraw visible lines + - more efficient multi-line inserts - finish gui stepper - windows are not updated while resizing - graphical module manager tool diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index ea183a85a2..ff5ba48215 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -199,6 +199,7 @@ sequences vectors words ; "/library/ui/gadgets/books.factor" "/library/ui/gadgets/outliner.factor" "/library/ui/text/document.factor" + "/library/ui/text/elements.factor" "/library/ui/text/editor.factor" "/library/ui/text/commands.factor" "/library/ui/text/field.factor" diff --git a/library/ui/text/document.factor b/library/ui/text/document.factor index d41c741eb1..bf9b896962 100644 --- a/library/ui/text/document.factor +++ b/library/ui/text/document.factor @@ -63,31 +63,6 @@ C: document ( -- document ) ] each-line 2drop ] { } make "\n" join ; -: replace-columns ( str start# end# line# document -- ) - [ - [ swap [ replace-slice ] change-nth ] keep - ] change-model ; - -: set-on-1 ( lines startloc endloc document -- ) - >r >r >r first r> second r> first2 swap r> replace-columns ; - -: loc-col/str ( loc lines -- col str ) - >r first2 swap r> nth ; - -: merge-lines ( lines startloc endloc lines -- str ) - #! Start line from 0 to start col + end line from end col - #! to length - tuck loc-col/str tail-slice - >r loc-col/str head-slice - swap first r> append3 ; - -: set-on>1pre ( str startloc endloc lines -- ) - [ merge-lines 1array ] 3keep - >r [ first ] 2apply 1+ r> replace-slice ; - -: set-on>1 ( str startloc endloc document -- ) - [ set-on>1pre ] change-model ; - : text+loc ( lines loc -- loc ) over >r over length 1 = [ nip first2 @@ -95,10 +70,25 @@ C: document ( -- document ) first swap length 1- + 0 ] if r> peek length + 2array ; +: prepend-first ( str seq -- seq ) + 0 [ append ] change-nth ; + +: append-last ( str seq -- seq ) + dup length 1- [ swap append ] change-nth ; + +: prepare-insert ( newinput startloc endloc lines -- newinput ) + tuck loc-col/str tail-slice >r loc-col/str head-slice r> + pick append-last over prepend-first ; + +: (set-doc-range) ( newlines startloc endloc lines -- newlines ) + [ prepare-insert ] 3keep + >r [ first ] 2apply 1+ r> + replace-slice ; + : set-doc-range ( str startloc endloc document -- ) [ >r >r >r "\n" split r> [ text+loc ] 2keep r> r> - pick pick lines-equal? [ set-on-1 ] [ set-on>1 ] if + [ (set-doc-range) ] change-model ] keep update-locs ; : remove-doc-range ( startloc endloc document -- ) @@ -123,72 +113,6 @@ C: document ( -- document ) : doc-end ( document -- loc ) model-value dup length 1- swap peek length 2array ; -GENERIC: prev-elt ( loc document elt -- loc ) -GENERIC: next-elt ( loc document elt -- loc ) - -TUPLE: char-elt ; - -: (prev-char) ( loc document quot -- loc ) - -rot { - { [ over { 0 0 } = ] [ drop ] } - { [ over second zero? ] [ >r first 1- r> line-end ] } - { [ t ] [ pick call ] } - } cond nip ; inline - -: (next-char) ( loc document quot -- loc ) - -rot { - { [ 2dup doc-end = ] [ drop ] } - { [ 2dup line-end? ] [ drop first 1+ 0 2array ] } - { [ t ] [ pick call ] } - } cond nip ; inline - -M: char-elt prev-elt - drop [ drop -1 +col ] (prev-char) ; - -M: char-elt next-elt - drop [ drop 1 +col ] (next-char) ; - -TUPLE: word-elt ; - -: (word-elt) ( loc document quot -- loc ) - pick >r - >r >r first2 swap r> doc-line r> call - r> =col ; inline - -: ((word-elt)) [ ?nth blank? ] 2keep ; - -: (prev-word) ( col str -- col ) - >r 1- r> ((word-elt)) - [ blank? xor ] find-last-with* drop 1+ ; - -M: word-elt prev-elt - drop [ [ (prev-word) ] (word-elt) ] (prev-char) ; - -: (next-word) ( col str -- col ) - ((word-elt)) - [ [ blank? xor ] find-with* drop ] keep - over -1 = [ nip length ] [ drop ] if ; - -M: word-elt next-elt - drop [ [ (next-word) ] (word-elt) ] (next-char) ; - -TUPLE: one-line-elt ; - -M: one-line-elt prev-elt - 2drop first 0 2array ; -M: one-line-elt next-elt - drop >r first dup r> doc-line length 2array ; - -TUPLE: line-elt ; - -M: line-elt prev-elt 2drop -1 +line ; -M: line-elt next-elt 2drop 1 +line ; - -TUPLE: doc-elt ; - -M: doc-elt prev-elt 3drop { 0 0 } ; -M: doc-elt next-elt drop nip doc-end ; - : doc-text ( document -- str ) model-value "\n" join ; diff --git a/library/ui/text/elements.factor b/library/ui/text/elements.factor new file mode 100644 index 0000000000..fabcf1bcec --- /dev/null +++ b/library/ui/text/elements.factor @@ -0,0 +1,68 @@ +IN: gadgets-text +USING: arrays kernel math sequences strings ; + +GENERIC: prev-elt ( loc document elt -- loc ) +GENERIC: next-elt ( loc document elt -- loc ) + +TUPLE: char-elt ; + +: (prev-char) ( loc document quot -- loc ) + -rot { + { [ over { 0 0 } = ] [ drop ] } + { [ over second zero? ] [ >r first 1- r> line-end ] } + { [ t ] [ pick call ] } + } cond nip ; inline + +: (next-char) ( loc document quot -- loc ) + -rot { + { [ 2dup doc-end = ] [ drop ] } + { [ 2dup line-end? ] [ drop first 1+ 0 2array ] } + { [ t ] [ pick call ] } + } cond nip ; inline + +M: char-elt prev-elt + drop [ drop -1 +col ] (prev-char) ; + +M: char-elt next-elt + drop [ drop 1 +col ] (next-char) ; + +TUPLE: word-elt ; + +: (word-elt) ( loc document quot -- loc ) + pick >r + >r >r first2 swap r> doc-line r> call + r> =col ; inline + +: ((word-elt)) [ ?nth blank? ] 2keep ; + +: (prev-word) ( col str -- col ) + >r 1- r> ((word-elt)) + [ blank? xor ] find-last-with* drop 1+ ; + +M: word-elt prev-elt + drop [ [ (prev-word) ] (word-elt) ] (prev-char) ; + +: (next-word) ( col str -- col ) + ((word-elt)) + [ [ blank? xor ] find-with* drop ] keep + over -1 = [ nip length ] [ drop ] if ; + +M: word-elt next-elt + drop [ [ (next-word) ] (word-elt) ] (next-char) ; + +TUPLE: one-line-elt ; + +M: one-line-elt prev-elt + 2drop first 0 2array ; +M: one-line-elt next-elt + drop >r first dup r> doc-line length 2array ; + +TUPLE: line-elt ; + +M: line-elt prev-elt 2drop -1 +line ; +M: line-elt next-elt 2drop 1 +line ; + +TUPLE: doc-elt ; + +M: doc-elt prev-elt 3drop { 0 0 } ; +M: doc-elt next-elt drop nip doc-end ;