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

diff --git a/lines/lines-tests.factor b/lines/lines-tests.factor
index a22b5935eac52263c277bcb5f64d7e0903670424..907cfa495e85d388eb90314dab663bc4d157298c 100644 (file)
--- a/lines/lines-tests.factor
+++ b/lines/lines-tests.factor
@@ -8,6 +8,10 @@ IN: charts.lines.tests
 { 5 } [ -2/3 -2 { 1 3 } 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 { 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
 { 1 2 } [ { 1 2 } last2 ] unit-test

diff --git a/lines/lines.factor b/lines/lines.factor
index 7081a3220f6061e14ff35b88928a561bc3e8b4e8..77d92de20f489fa9c77af7539619684f0997d23a 100644 (file)
--- a/lines/lines.factor
+++ b/lines/lines.factor
@@ -63,6 +63,7 @@ TUPLE: line < gadget color data ;
 
 : calc-line-slope ( point1 point2 -- slope ) v- first2 swap / ;
 : 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 ;
 
 ! 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.
 : left-cut ( min pairs -- seq )
     2dup first first < [
-        [ dupd first2 dupd calc-line-slope -rot calc-y 2array ] keep
-        rest-slice swap prefix
+        [ dupd first2 y-at 2array ] keep rest-slice swap prefix
     ] [
         nip
     ] if ;
@@ -81,8 +81,7 @@ TUPLE: line < gadget color data ;
 ! last is < max. Otherwise the last one would be = max.
 : right-cut ( max pairs -- seq )
     2dup last first < [
-        [ dupd last2 dupd calc-line-slope -rot calc-y 2array ] keep
-        but-last-slice swap suffix
+        [ dupd last2 y-at 2array ] keep but-last-slice swap suffix
     ] [
         nip
     ] if ;