From 4b416f1a5ac4f718132d4ee8121471b939e7ac5d Mon Sep 17 00:00:00 2001 From: Alexander Iljin Date: Sat, 7 Jan 2017 01:36:15 +0300 Subject: [PATCH] charts: move code related to line drawing to charts.lines --- charts-tests.factor | 24 ------------ charts.factor | 83 +-------------------------------------- lines/authors.txt | 1 + lines/lines-tests.factor | 30 ++++++++++++++ lines/lines.factor | 85 ++++++++++++++++++++++++++++++++++++++++ 5 files changed, 117 insertions(+), 106 deletions(-) create mode 100644 lines/authors.txt create mode 100644 lines/lines-tests.factor create mode 100644 lines/lines.factor diff --git a/charts-tests.factor b/charts-tests.factor index 67c6444e8b..51e4c048b1 100644 --- a/charts-tests.factor +++ b/charts-tests.factor @@ -2,27 +2,3 @@ USING: tools.test charts ; IN: charts.tests - -{ { } } -[ { } { } clip-data ] unit-test - -{ { } } -[ { { 0 1 } { 0 5 } } { } clip-data ] unit-test - -! Adjustment after search is required in both directions. -{ - { - { 1 3 } { 1 4 } { 1 5 } - { 2 6 } { 3 7 } { 4 8 } - { 5 9 } { 5 10 } { 5 11 } { 5 12 } - } -} [ - { { 1 5 } { 0 14 } } - { - { 0 1 } { 0 2 } - { 1 3 } { 1 4 } { 1 5 } - { 2 6 } { 3 7 } { 4 8 } - { 5 9 } { 5 10 } { 5 11 } { 5 12 } - { 6 13 } { 7 14 } - } clip-data -] unit-test diff --git a/charts.factor b/charts.factor index 2d90d984d2..1c9bc369f2 100644 --- a/charts.factor +++ b/charts.factor @@ -1,86 +1,12 @@ ! Copyright (C) 2016-2017 Alexander Ilin. -USING: accessors arrays binary-search colors.constants -combinators.short-circuit kernel locals math math.order -math.rectangles math.statistics opengl opengl.gl sequences -specialized-arrays.instances.alien.c-types.float ui.gadgets -ui.render ; +USING: kernel ui.gadgets ; IN: charts TUPLE: chart < gadget ; -! Data must be sorted by ascending x coordinate. -TUPLE: line < gadget color data ; - M: chart pref-dim* drop { 300 300 } ; -: (line-vertices) ( seq -- vertices ) - concat [ 0.3 + ] float-array{ } map-as ; - -: draw-line ( seq -- ) - dup dup length odd? [ [ 1 head* ] dip ] [ 1 head* ] if - 1 tail append - [ (line-vertices) gl-vertex-pointer GL_LINES 0 ] keep - length glDrawArrays ; - - ] with search ; - -: finder ( elt seq -- seq quot ) - [ first ] dip [ first = not ] with ; inline - -: adjusted-tail ( index elt seq -- seq' ) - [ finder find-last-from drop ] keep swap [ 1 + tail ] when* ; - -: adjusted-head ( index elt seq -- seq' ) - [ finder find-from drop ] keep swap [ head ] when* ; - -! : data-rect ( data -- rect ) -! [ [ first first ] [ last first ] bi ] keep -! [ second ] map minmax swapd -! 2array [ 2array ] dip ; - -: first-in-bounds? ( min,max pairs -- ? ) - { - [ [ first ] dip last first > not ] - [ [ second ] dip first first < not ] - } 2&& ; - -: second-in-bounds? ( min,max pairs -- ? ) - [ second ] map minmax 2array - { - [ [ first ] dip second > not ] - [ [ second ] dip first < not ] - } 2&& ; - -! : pairs-in-bounds? ( bounds pairs -- ? ) -! { -! [ [ first ] dip first-in-bounds? ] -! [ [ second ] dip second-in-bounds? ] -! } 2&& ; - -: clip-by-first ( min,max pairs -- pairs' ) - 2dup first-in-bounds? [ - [ dup first ] dip [ search-index ] keep adjusted-tail - [ second ] dip [ search-index ] keep adjusted-head - ] [ - 2drop { } clone - ] if ; - -PRIVATE> - -! bounds: { { first-min first-max } { second-min second-max } } -: clip-data ( bounds data -- data' ) - dup empty? [ nip ] [ - dupd [ first ] dip clip-by-first - dup empty? [ nip ] [ - [ second ] dip [ second-in-bounds? ] keep swap - [ drop { } clone ] unless - ] if - ] if ; - ! Return the bottom-left and top-right corners of the visible area. : chart-axes ( chart -- seq ) drop { { 0 300 } { 0 300 } } ; @@ -90,11 +16,4 @@ PRIVATE> ! Cut off data outside the presentation window. ! Remove redundant points from the drawing pass. -M: line draw-gadget* - dup parent>> dup chart? [ - chart-axes swap - [ color>> gl-color ] [ data>> ] bi - clip-data [ draw-line ] unless-empty - ] [ 2drop ] if ; - ! chart new line new COLOR: blue >>color { { 0 100 } { 100 0 } { 100 50 } { 150 50 } { 200 100 } } >>data add-gadget gadget. diff --git a/lines/authors.txt b/lines/authors.txt new file mode 100644 index 0000000000..8e1955f8e1 --- /dev/null +++ b/lines/authors.txt @@ -0,0 +1 @@ +Alexander Ilin diff --git a/lines/lines-tests.factor b/lines/lines-tests.factor new file mode 100644 index 0000000000..7baca14c23 --- /dev/null +++ b/lines/lines-tests.factor @@ -0,0 +1,30 @@ +! Copyright (C) 2017 Alexander Ilin. + +USING: tools.test charts.lines ; +IN: charts.lines.tests + +{ { } } +[ { } { } clip-data ] unit-test + +{ { } } +[ { { 0 1 } { 0 5 } } { } clip-data ] unit-test + +! Adjustment after search is required in both directions. +{ + { + { 1 3 } { 1 4 } { 1 5 } + { 2 6 } { 3 7 } { 4 8 } + { 5 9 } { 5 10 } { 5 11 } { 5 12 } + } +} [ + { { 1 5 } { 0 14 } } + { + { 0 1 } { 0 2 } + { 1 3 } { 1 4 } { 1 5 } + { 2 6 } { 3 7 } { 4 8 } + { 5 9 } { 5 10 } { 5 11 } { 5 12 } + { 6 13 } { 7 14 } + } clip-data +] unit-test + +! TODO: add tests where after search there is no adjustment necessary, so that extra adjustment would take bad elements. Also, add tests for sequences fully outside the range. diff --git a/lines/lines.factor b/lines/lines.factor new file mode 100644 index 0000000000..3ae415c92d --- /dev/null +++ b/lines/lines.factor @@ -0,0 +1,85 @@ +! Copyright (C) 2016-2017 Alexander Ilin. + +USING: accessors arrays binary-search charts +combinators.short-circuit kernel math math.order math.statistics +opengl opengl.gl sequences +specialized-arrays.instances.alien.c-types.float ui.gadgets +ui.render ; +IN: charts.lines + +! Data must be sorted by ascending x coordinate. +TUPLE: line < gadget color data ; + +: (line-vertices) ( seq -- vertices ) + concat [ 0.3 + ] float-array{ } map-as ; + +: draw-line ( seq -- ) + dup dup length odd? [ [ 1 head* ] dip ] [ 1 head* ] if + 1 tail append + [ (line-vertices) gl-vertex-pointer GL_LINES 0 ] keep + length glDrawArrays ; + + ] with search ; + +: finder ( elt seq -- seq quot ) + [ first ] dip [ first = not ] with ; inline + +: adjusted-tail ( index elt seq -- seq' ) + [ finder find-last-from drop ] keep swap [ 1 + tail ] when* ; + +: adjusted-head ( index elt seq -- seq' ) + [ finder find-from drop ] keep swap [ head ] when* ; + +! : data-rect ( data -- rect ) +! [ [ first first ] [ last first ] bi ] keep +! [ second ] map minmax swapd +! 2array [ 2array ] dip ; + +: first-in-bounds? ( min,max pairs -- ? ) + { + [ [ first ] dip last first > not ] + [ [ second ] dip first first < not ] + } 2&& ; + +: second-in-bounds? ( min,max pairs -- ? ) + [ second ] map minmax 2array + { + [ [ first ] dip second > not ] + [ [ second ] dip first < not ] + } 2&& ; + +! : pairs-in-bounds? ( bounds pairs -- ? ) +! { +! [ [ first ] dip first-in-bounds? ] +! [ [ second ] dip second-in-bounds? ] +! } 2&& ; + +: clip-by-first ( min,max pairs -- pairs' ) + 2dup first-in-bounds? [ + [ dup first ] dip [ search-index ] keep adjusted-tail + [ second ] dip [ search-index ] keep adjusted-head + ] [ + 2drop { } clone + ] if ; + +PRIVATE> + +! bounds: { { first-min first-max } { second-min second-max } } +: clip-data ( bounds data -- data' ) + dup empty? [ nip ] [ + dupd [ first ] dip clip-by-first + dup empty? [ nip ] [ + [ second ] dip [ second-in-bounds? ] keep swap + [ drop { } clone ] unless + ] if + ] if ; + +M: line draw-gadget* + dup parent>> dup chart? [ + chart-axes swap + [ color>> gl-color ] [ data>> ] bi + clip-data [ draw-line ] unless-empty + ] [ 2drop ] if ;