Delete plot from unmaintained
parent
aff4676e58
commit
b66ec7aa73
|
@ -1,137 +0,0 @@
|
||||||
|
|
||||||
USING: kernel quotations arrays sequences math math.ranges fry
|
|
||||||
opengl opengl.gl ui.render ui.gadgets.cartesian processing.shapes
|
|
||||||
accessors ;
|
|
||||||
|
|
||||||
IN: ui.gadgets.plot
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
TUPLE: plot < cartesian functions points ;
|
|
||||||
|
|
||||||
: init-plot ( plot -- plot )
|
|
||||||
init-cartesian
|
|
||||||
{ } >>functions
|
|
||||||
100 >>points ;
|
|
||||||
|
|
||||||
: <plot> ( -- plot ) plot new init-plot ;
|
|
||||||
|
|
||||||
: step-size ( plot -- step-size )
|
|
||||||
[ [ x-max>> ] [ x-min>> ] bi - ] [ points>> ] bi / ;
|
|
||||||
|
|
||||||
: plot-range ( plot -- range )
|
|
||||||
[ x-min>> ] [ x-max>> ] [ step-size ] tri <range> ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
TUPLE: function function color ;
|
|
||||||
|
|
||||||
GENERIC: plot-function ( plot object -- plot )
|
|
||||||
|
|
||||||
M: callable plot-function ( plot quotation -- plot )
|
|
||||||
>r dup plot-range r> '[ dup @ 2array ] map line-strip ;
|
|
||||||
|
|
||||||
M: function plot-function ( plot function -- plot )
|
|
||||||
dup color>> dup [ >stroke-color ] [ drop ] if
|
|
||||||
>r dup plot-range r> function>> '[ dup @ 2array ] map line-strip ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
: plot-functions ( plot -- plot ) dup functions>> [ plot-function ] each ;
|
|
||||||
|
|
||||||
: draw-axis ( plot -- plot )
|
|
||||||
dup
|
|
||||||
[ [ x-min>> ] [ drop 0 ] bi 2array ]
|
|
||||||
[ [ x-max>> ] [ drop 0 ] bi 2array ] bi line*
|
|
||||||
dup
|
|
||||||
[ [ drop 0 ] [ y-min>> ] bi 2array ]
|
|
||||||
[ [ drop 0 ] [ y-max>> ] bi 2array ] bi line* ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
USING: ui.gadgets.slate ;
|
|
||||||
|
|
||||||
M: plot draw-slate ( plot -- plot )
|
|
||||||
2 glLineWidth
|
|
||||||
draw-axis
|
|
||||||
plot-functions
|
|
||||||
fill-mode
|
|
||||||
1 glLineWidth ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
: add-function ( plot function -- plot )
|
|
||||||
over functions>> swap suffix >>functions ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
: x-span ( plot -- span ) [ x-max>> ] [ x-min>> ] bi - ;
|
|
||||||
: y-span ( plot -- span ) [ y-max>> ] [ y-min>> ] bi - ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
USING: ui.gestures ui.gadgets ;
|
|
||||||
|
|
||||||
: left ( plot -- plot )
|
|
||||||
dup [ x-min>> ] [ x-span 1/10 * ] bi - >>x-min
|
|
||||||
dup [ x-max>> ] [ x-span 1/10 * ] bi - >>x-max
|
|
||||||
dup relayout-1 ;
|
|
||||||
|
|
||||||
: right ( plot -- plot )
|
|
||||||
dup [ x-min>> ] [ x-span 1/10 * ] bi + >>x-min
|
|
||||||
dup [ x-max>> ] [ x-span 1/10 * ] bi + >>x-max
|
|
||||||
dup relayout-1 ;
|
|
||||||
|
|
||||||
: down ( plot -- plot )
|
|
||||||
dup [ y-min>> ] [ y-span 1/10 * ] bi - >>y-min
|
|
||||||
dup [ y-max>> ] [ y-span 1/10 * ] bi - >>y-max
|
|
||||||
dup relayout-1 ;
|
|
||||||
|
|
||||||
: up ( plot -- plot )
|
|
||||||
dup [ y-min>> ] [ y-span 1/10 * ] bi + >>y-min
|
|
||||||
dup [ y-max>> ] [ y-span 1/10 * ] bi + >>y-max
|
|
||||||
dup relayout-1 ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
: zoom-in-horizontal ( plot -- plot )
|
|
||||||
dup [ x-min>> ] [ x-span 1/10 * ] bi + >>x-min
|
|
||||||
dup [ x-max>> ] [ x-span 1/10 * ] bi - >>x-max ;
|
|
||||||
|
|
||||||
: zoom-in-vertical ( plot -- plot )
|
|
||||||
dup [ y-min>> ] [ y-span 1/10 * ] bi + >>y-min
|
|
||||||
dup [ y-max>> ] [ y-span 1/10 * ] bi - >>y-max ;
|
|
||||||
|
|
||||||
: zoom-in ( plot -- plot )
|
|
||||||
zoom-in-horizontal
|
|
||||||
zoom-in-vertical
|
|
||||||
dup relayout-1 ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
: zoom-out-horizontal ( plot -- plot )
|
|
||||||
dup [ x-min>> ] [ x-span 1/10 * ] bi - >>x-min
|
|
||||||
dup [ x-max>> ] [ x-span 1/10 * ] bi + >>x-max ;
|
|
||||||
|
|
||||||
: zoom-out-vertical ( plot -- plot )
|
|
||||||
dup [ y-min>> ] [ y-span 1/10 * ] bi - >>y-min
|
|
||||||
dup [ y-max>> ] [ y-span 1/10 * ] bi + >>y-max ;
|
|
||||||
|
|
||||||
: zoom-out ( plot -- plot )
|
|
||||||
zoom-out-horizontal
|
|
||||||
zoom-out-vertical
|
|
||||||
dup relayout-1 ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
plot
|
|
||||||
H{
|
|
||||||
{ T{ mouse-enter } [ request-focus ] }
|
|
||||||
{ T{ key-down f f "LEFT" } [ left drop ] }
|
|
||||||
{ T{ key-down f f "RIGHT" } [ right drop ] }
|
|
||||||
{ T{ key-down f f "DOWN" } [ down drop ] }
|
|
||||||
{ T{ key-down f f "UP" } [ up drop ] }
|
|
||||||
{ T{ key-down f f "a" } [ zoom-in drop ] }
|
|
||||||
{ T{ key-down f f "z" } [ zoom-out drop ] }
|
|
||||||
}
|
|
||||||
set-gestures
|
|
Loading…
Reference in New Issue