diff --git a/extra/ui/gadgets/plot/plot.factor b/extra/ui/gadgets/plot/plot.factor new file mode 100644 index 0000000000..6fee7dc454 --- /dev/null +++ b/extra/ui/gadgets/plot/plot.factor @@ -0,0 +1,153 @@ + +USING: kernel quotations arrays sequences math math.ranges fry + opengl opengl.gl ui.render ui.gadgets.cartesian processing.shapes + accessors ; + +IN: ui.gadgets.plot + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! Examples: +! +! [ sin ] add-function gadget. +! +! +! [ sin ] red function boa add-function +! [ cos ] blue function boa add-function +! gadget. +! +! +! Use the arrow keys to move around. +! +! Use 'a' and 'z' keys to zoom in and out. + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: plot < cartesian functions points ; + +: init-plot ( plot -- plot ) + init-cartesian + { } >>functions + 100 >>points ; + +: ( -- 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 ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: function function color ; + +GENERIC: plot-function ( plot object -- plot ) + +M: callable plot-function ( plot quotation -- plot ) + [ dup plot-range ] dip '[ dup @ 2array ] map line-strip ; + +M: function plot-function ( plot function -- plot ) + dup color>> dup [ >stroke-color ] [ drop ] if + [ dup plot-range ] dip 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 \ No newline at end of file