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

charts.lines: factor some common code into y-at

char-rename
Alexander Iljin 2017-01-13 13:14:57 +03:00 committed by John Benediktsson
parent 97d6ca4a83
commit 739adb122d
2 changed files with 7 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lines/lines-tests.factor
View File

@ -8,6 +8,10 @@ IN: charts.lines.tests
{ 5 } [ -2/3 -2 { 1 3 } calc-y ] unit-test { 5 } [ -2/3 -2 { 1 3 } calc-y ] unit-test
{ 3 } [ -2/3 1 { -2 5 } calc-y ] unit-test { 3 } [ -2/3 1 { -2 5 } calc-y ] unit-test
{ 5 } [ -2/3 -2 { -2 5 } calc-y ] unit-test { 5 } [ -2/3 -2 { -2 5 } calc-y ] unit-test
{ 5 } [ -2 { 1 3 } { -2 5 } y-at ] unit-test
{ 3 } [ 1 { 1 3 } { -2 5 } y-at ] unit-test
{ 1 } [ 4 { -2 5 } { 1 3 } y-at ] unit-test
{ 0.0 } [ 5.5 { -2 5 } { 1 3 } y-at ] unit-test
{ 2 3 } [ { 1 2 3 } last2 ] unit-test { 2 3 } [ { 1 2 3 } last2 ] unit-test
{ 1 2 } [ { 1 2 } last2 ] unit-test { 1 2 } [ { 1 2 } last2 ] unit-test

7
lines/lines.factor
View File

@ -63,6 +63,7 @@ TUPLE: line < gadget color data ;
: calc-line-slope ( point1 point2 -- slope ) v- first2 swap / ; : calc-line-slope ( point1 point2 -- slope ) v- first2 swap / ;
: calc-y ( slope x point -- y ) first2 [ - * ] dip + ; : calc-y ( slope x point -- y ) first2 [ - * ] dip + ;
: y-at ( x point1 point2 -- y ) dupd calc-line-slope -rot calc-y ;
: last2 ( seq -- penultimate ultimate ) 2 tail* first2 ; : last2 ( seq -- penultimate ultimate ) 2 tail* first2 ;
! Due to the way adjusted-tail-slice works, the first element of ! Due to the way adjusted-tail-slice works, the first element of
@ -70,8 +71,7 @@ TUPLE: line < gadget color data ;
! > min. Otherwise the first one would be = min. ! > min. Otherwise the first one would be = min.
: left-cut ( min pairs -- seq ) : left-cut ( min pairs -- seq )
2dup first first < [ 2dup first first < [
[ dupd first2 dupd calc-line-slope -rot calc-y 2array ] keep [ dupd first2 y-at 2array ] keep rest-slice swap prefix
rest-slice swap prefix
] [ ] [
nip nip
] if ; ] if ;
@ -81,8 +81,7 @@ TUPLE: line < gadget color data ;
! last is < max. Otherwise the last one would be = max. ! last is < max. Otherwise the last one would be = max.
: right-cut ( max pairs -- seq ) : right-cut ( max pairs -- seq )
2dup last first < [ 2dup last first < [
[ dupd last2 dupd calc-line-slope -rot calc-y 2array ] keep [ dupd last2 y-at 2array ] keep but-last-slice swap suffix
but-last-slice swap suffix
] [ ] [
nip nip
] if ; ] if ;