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

charts.lines: make clip-by-first operate on slices internally

char-rename
Alexander Iljin 2017-01-11 00:32:45 +03:00 committed by John Benediktsson
parent 418b798460
commit 118b06be29
1 changed files with 8 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
lines/lines.factor
View File

@ -21,11 +21,12 @@ TUPLE: line < gadget color data ;
: finder ( elt seq -- seq quot ) : finder ( elt seq -- seq quot )
[ first ] dip [ first = not ] with ; inline [ first ] dip [ first = not ] with ; inline
: adjusted-tail ( index elt seq -- seq' ) : adjusted-tail-slice ( index elt seq -- slice )
[ finder find-last-from drop ] keep swap [ 1 + tail ] when* ; [ finder find-last-from drop ] keep
swap [ 1 + tail-slice ] when* ;
: adjusted-head ( index elt seq -- seq' ) : adjusted-head-slice ( index elt seq -- slice )
[ finder find-from drop ] keep swap [ head ] when* ; [ finder find-from drop ] keep swap [ head-slice ] when* ;
! : data-rect ( data -- rect ) ! : data-rect ( data -- rect )
! [ [ first first ] [ last first ] bi ] keep ! [ [ first first ] [ last first ] bi ] keep
@ -53,8 +54,9 @@ TUPLE: line < gadget color data ;
: clip-by-first ( min,max pairs -- pairs' ) : clip-by-first ( min,max pairs -- pairs' )
2dup first-in-bounds? [ 2dup first-in-bounds? [
[ dup first ] dip [ search-first ] keep adjusted-tail [ dup first ] dip [ search-first ] keep adjusted-tail-slice
[ second ] dip [ search-first ] keep adjusted-head [ second ] dip [ search-first ] keep adjusted-head-slice
dup like
] [ ] [
2drop { } clone 2drop { } clone
] if ; ] if ;