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

charts.lines: don't keep extra elements in data if exact match was found

char-rename
Alexander Iljin 2017-01-12 15:31:37 +03:00 committed by John Benediktsson
parent 6071bd8d26
commit 317fe9e9f4
1 changed files with 19 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
lines/lines.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2016-2017 Alexander Ilin. ! Copyright (C) 2016-2017 Alexander Ilin.
USING: accessors arrays binary-search charts USING: accessors arrays binary-search charts
combinators.short-circuit kernel math math.order math.statistics combinators.short-circuit kernel locals math math.order
opengl opengl.gl sequences math.statistics opengl opengl.gl sequences
specialized-arrays.instances.alien.c-types.float ui.gadgets specialized-arrays.instances.alien.c-types.float ui.gadgets
ui.render ; ui.render ;
IN: charts.lines IN: charts.lines
@ -19,15 +19,23 @@ TUPLE: line < gadget color data ;
: search-first ( elt seq -- index elt ) : search-first ( elt seq -- index elt )
[ first <=> ] with search ; [ first <=> ] with search ;
: search-first? ( elt seq -- index elt exact-match? )
dupd search-first rot [ dup first ] dip = ;
: finder ( elt seq -- seq quot ) : finder ( elt seq -- seq quot )
[ first ] dip [ first = not ] with ; inline [ first ] dip [ first = not ] with ; inline
: adjusted-tail-slice ( index elt seq -- slice ) ! Return a slice of the seq with all elements equal elt to the
[ finder find-last-from drop ] keep ! left of the index, plus one that's not equal, if requested.
swap [ 1 + tail-slice ] when* ; :: adjusted-tail-slice ( index elt plus-one? seq -- slice )
index elt seq finder find-last-from drop seq swap
[ plus-one? [ 1 + ] unless tail-slice ] when* ;
: adjusted-head-slice ( index elt seq -- slice ) ! Return a slice of the seq with all elements equal elt to the
[ finder find-from drop ] keep swap [ head-slice ] when* ; ! right of the index, plus one that's not equal, if requested.
:: adjusted-head-slice ( index elt plus-one? seq -- slice )
index elt seq finder find-from drop seq swap
[ plus-one? [ 1 + ] when short head-slice ] when* ;
! : data-rect ( data -- rect ) ! : data-rect ( data -- rect )
! [ [ first first ] [ last first ] bi ] keep ! [ [ first first ] [ last first ] bi ] keep
@ -55,8 +63,10 @@ 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-slice [ dup first ] dip [ search-first? not ] keep
[ second ] dip [ search-first ] keep adjusted-head-slice adjusted-tail-slice
[ second ] dip [ search-first? not ] keep
adjusted-head-slice
dup like dup like
] [ ] [
2drop { } clone 2drop { } clone