From 3e6a6c189c03054988c3ca4d8e6db64051f1de09 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 20 Jan 2017 10:43:07 -0800 Subject: [PATCH] charts.lines: some cleanup --- lines/lines.factor | 56 ++++++++++++++++++++-------------------------- 1 file changed, 24 insertions(+), 32 deletions(-) diff --git a/lines/lines.factor b/lines/lines.factor index 03564e8367..a6229459f4 100644 --- a/lines/lines.factor +++ b/lines/lines.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2016-2017 Alexander Ilin. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays binary-search charts combinators +USING: accessors arrays assocs binary-search charts combinators combinators.short-circuit fry kernel locals make math math.order math.statistics math.vectors namespaces opengl opengl.gl sequences specialized-arrays.instances.alien.c-types.float @@ -25,19 +25,16 @@ ALIAS: y second : search-first? ( elt seq -- index elt exact-match? ) dupd search-first rot [ dup first ] dip = ; -: finder ( elt seq -- seq quot ) - [ first ] dip [ first = not ] with ; inline - ! Return a slice of the seq with all elements equal elt to the ! left of the index, plus one that's not equal, if requested. -:: adjusted-tail-slice ( index elt plus-one? seq -- slice ) - index elt seq finder find-last-from drop seq swap +:: adjusted-tail-slice ( n elt plus-one? seq -- slice ) + n seq elt first '[ first _ = not ] find-last-from drop seq swap [ plus-one? [ 1 + ] unless tail-slice ] when* ; ! Return a slice of the seq with all elements equal elt to the ! 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 +:: adjusted-head-slice ( n elt plus-one? seq -- slice ) + n seq elt first '[ first _ = not ] find-from drop seq swap [ plus-one? [ 1 + ] when short head-slice ] when* ; ! : data-rect ( data -- rect ) @@ -97,27 +94,27 @@ ALIAS: y second : clip-by-first ( min,max pairs -- pairs' ) 2dup first-in-bounds? [ - [ dup first ] dip [ search-first? not ] keep + [ dup first ] dip [ search-first? not ] keep adjusted-tail-slice [ dup second ] dip [ search-first? not ] keep adjusted-head-slice dup length 1 > [ min-max-cut ] [ nip ] if dup slice? [ dup like ] when ] [ - 2drop { } clone + 2drop { } ] if ; : between<=> ( value min max -- <=> ) 3dup between? [ 3drop +eq+ ] [ nip > +gt+ +lt+ ? ] if ; - : calc-point-y ( slope y point -- xy ) over [ calc-x ] dip 2array ; : xyy>chunk ( x y1 y2 -- chunk ) [ over ] dip 2array [ 2array ] dip 2array ; :: 2-point-chunk ( left right ymin ymax -- chunk ) - left last :> left-point right first :> right-point + left last :> left-point + right first :> right-point left-point x right-point x = [ left-point x ymin ymax xyy>chunk ] [ @@ -128,7 +125,8 @@ ALIAS: y second ] if ; :: fix-left-chunk ( left right ymin ymax -- left' ) - left last :> left-point right first :> right-point + left last :> left-point + right first :> right-point left-point y { [ ymin = ] [ ymax = ] } 1|| [ left ] [ @@ -143,7 +141,8 @@ ALIAS: y second ] if ; :: fix-right-chunk ( left right ymin ymax -- right' ) - left last :> left-point right first :> right-point + left last :> left-point + right first :> right-point right-point y { [ ymin = ] [ ymax = ] } 1|| [ right ] [ @@ -158,15 +157,9 @@ ALIAS: y second ] if ; : first-point ( chunks -- first-point ) first first ; + : last-point ( chunks -- last-point ) last last ; -SYMBOL: elt - -: each2* ( seq quot: ( prev next -- next' ) -- last ) - [ unclip-slice elt ] dip '[ - [ elt get swap @ elt set ] each elt get - ] with-variable ; inline - :: (make-pair) ( prev next min max -- next' ) prev next min max prev next [ first y min max between<=> ] bi@ 2array @@ -185,13 +178,13 @@ SYMBOL: elt chunks length { { 0 [ chunks ] } { 1 [ - chunks dup first-point y min max between? - [ drop { } clone ] unless + chunks first-point y min max between? + chunks { } ? ] } [ drop [ - chunks [ min max (make-pair) ] each2* + chunks [ ] [ min max (make-pair) ] map-reduce dup first y min max between? [ , ] [ drop ] if ] { } make ] @@ -206,10 +199,10 @@ SYMBOL: elt monotonic-split-slice ] 2keep (drawable-chunks) ; -: middle ( min max -- middle ) dupd swap - 2 / + ; +: middle ( min max -- middle ) + 2 / ; : flip-y-axis ( chunks ymin,ymax -- chunks ) - first2 middle 2 * '[ [ first2 _ swap - 2array ] map ] map ; + first2 middle 2 * '[ [ _ swap - ] assoc-map ] map ; ! value' = (value - min) / (max - min) * width : scale ( width value max min -- value' ) neg [ + ] curry bi@ / * ; @@ -227,14 +220,13 @@ SYMBOL: elt ! ] if ; inline : scale-chunks ( chunks xwidth xmin,xmax yheight ymin,ymax -- chunks' ) - scale-mapper [ scale-mapper ] dip swap - '[ [ first2 @ swap @ swap 2array ] map ] map ; + [ scale-mapper ] 2bi@ '[ [ _ _ bi* ] assoc-map ] map ; PRIVATE> : draw-line ( seq -- ) - dup [ 1 head-slice* ] over length odd? [ dip ] [ call ] if - 1 tail-slice append + dup [ but-last-slice ] over length odd? [ dip ] [ call ] if + rest-slice append [ (line-vertices) gl-vertex-pointer GL_LINES 0 ] keep length glDrawArrays ; @@ -244,7 +236,7 @@ PRIVATE> dupd [ first ] dip clip-by-first dup empty? [ nip ] [ [ second ] dip [ second-in-bounds? ] keep swap - [ drop { } clone ] unless + [ drop { } ] unless ] if ] if ; @@ -256,5 +248,5 @@ M: line draw-gadget* flip-y-axis chart chart-dim first2 [ chart chart-axes first2 ] dip swap scale-chunks - [ [ draw-line ] each ] unless-empty + [ draw-line ] each ] [ 2drop ] if ;