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 ;
|
||||
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.
|
||||
|
||||
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 ;
|
||||
|
||||
<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.
|
||||
: 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.
|
||||
|
|
|
|||
|
|
@ -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