charts: move code related to line drawing to charts.lines
Alexander Iljin
John Benediktsson
parent
b357c62122
commit
4b416f1a5a
|
|
@ -2,27 +2,3 @@
|
||||||
|
|
||||||
USING: tools.test charts ;
|
USING: tools.test charts ;
|
||||||
IN: charts.tests
|
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
|
|
||||||
|
|
|
||||||
|
|
@ -1,86 +1,12 @@
|
||||||
! Copyright (C) 2016-2017 Alexander Ilin.
|
! Copyright (C) 2016-2017 Alexander Ilin.
|
||||||
|
|
||||||
USING: accessors arrays binary-search colors.constants
|
USING: kernel ui.gadgets ;
|
||||||
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 ;
|
|
||||||
IN: charts
|
IN: charts
|
||||||
|
|
||||||
TUPLE: chart < gadget ;
|
TUPLE: chart < gadget ;
|
||||||
|
|
||||||
! Data must be sorted by ascending x coordinate.
|
|
||||||
TUPLE: line < gadget color data ;
|
|
||||||
|
|
||||||
M: chart pref-dim* drop { 300 300 } ;
|
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 ;
|
|
||||||
|
|
||||||
<PRIVATE
|
|
||||||
|
|
||||||
: search-index ( elt seq -- index elt )
|
|
||||||
[ first <=> ] 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 <extent-rect> ;
|
|
||||||
|
|
||||||
: 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.
|
! Return the bottom-left and top-right corners of the visible area.
|
||||||
: chart-axes ( chart -- seq )
|
: chart-axes ( chart -- seq )
|
||||||
drop { { 0 300 } { 0 300 } } ;
|
drop { { 0 300 } { 0 300 } } ;
|
||||||
|
|
@ -90,11 +16,4 @@ PRIVATE>
|
||||||
! Cut off data outside the presentation window.
|
! Cut off data outside the presentation window.
|
||||||
! Remove redundant points from the drawing pass.
|
! 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.
|
! chart new line new COLOR: blue >>color { { 0 100 } { 100 0 } { 100 50 } { 150 50 } { 200 100 } } >>data add-gadget gadget.
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
Alexander Ilin
|
||||||
|
|
@ -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.
|
||||||
|
|
@ -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 ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: search-index ( elt seq -- index elt )
|
||||||
|
[ first <=> ] 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 <extent-rect> ;
|
||||||
|
|
||||||
|
: 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 ;
|
||||||
Loading…
Reference in New Issue