2 USING: kernel quotations arrays sequences math math.ranges fry
3 opengl opengl.gl ui.render ui.gadgets.cartesian processing.shapes
8 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
10 TUPLE: plot < cartesian functions points ;
12 : init-plot ( plot -- plot )
17 : <plot> ( -- plot ) plot new init-plot ;
19 : step-size ( plot -- step-size )
20 [ [ x-max>> ] [ x-min>> ] bi - ] [ points>> ] bi / ;
22 : plot-range ( plot -- range )
23 [ x-min>> ] [ x-max>> ] [ step-size ] tri <range> ;
25 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
27 TUPLE: function function color ;
29 GENERIC: plot-function ( plot object -- plot )
31 M: callable plot-function ( plot quotation -- plot )
32 >r dup plot-range r> '[ dup @ 2array ] map line-strip ;
34 M: function plot-function ( plot function -- plot )
35 dup color>> dup [ >stroke-color ] [ drop ] if
36 >r dup plot-range r> function>> '[ dup @ 2array ] map line-strip ;
38 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
40 : plot-functions ( plot -- plot ) dup functions>> [ plot-function ] each ;
42 : draw-axis ( plot -- plot )
44 [ [ x-min>> ] [ drop 0 ] bi 2array ]
45 [ [ x-max>> ] [ drop 0 ] bi 2array ] bi line*
47 [ [ drop 0 ] [ y-min>> ] bi 2array ]
48 [ [ drop 0 ] [ y-max>> ] bi 2array ] bi line* ;
50 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
52 USING: ui.gadgets.slate ;
54 M: plot draw-slate ( plot -- plot )
61 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
63 : add-function ( plot function -- plot )
64 over functions>> swap suffix >>functions ;
66 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
68 : x-span ( plot -- span ) [ x-max>> ] [ x-min>> ] bi - ;
69 : y-span ( plot -- span ) [ y-max>> ] [ y-min>> ] bi - ;
71 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
73 USING: ui.gestures ui.gadgets ;
75 : left ( plot -- plot )
76 dup [ x-min>> ] [ x-span 1/10 * ] bi - >>x-min
77 dup [ x-max>> ] [ x-span 1/10 * ] bi - >>x-max
80 : right ( plot -- plot )
81 dup [ x-min>> ] [ x-span 1/10 * ] bi + >>x-min
82 dup [ x-max>> ] [ x-span 1/10 * ] bi + >>x-max
85 : down ( plot -- plot )
86 dup [ y-min>> ] [ y-span 1/10 * ] bi - >>y-min
87 dup [ y-max>> ] [ y-span 1/10 * ] bi - >>y-max
91 dup [ y-min>> ] [ y-span 1/10 * ] bi + >>y-min
92 dup [ y-max>> ] [ y-span 1/10 * ] bi + >>y-max
95 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
97 : zoom-in-horizontal ( plot -- plot )
98 dup [ x-min>> ] [ x-span 1/10 * ] bi + >>x-min
99 dup [ x-max>> ] [ x-span 1/10 * ] bi - >>x-max ;
101 : zoom-in-vertical ( plot -- plot )
102 dup [ y-min>> ] [ y-span 1/10 * ] bi + >>y-min
103 dup [ y-max>> ] [ y-span 1/10 * ] bi - >>y-max ;
105 : zoom-in ( plot -- plot )
110 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
112 : zoom-out-horizontal ( plot -- plot )
113 dup [ x-min>> ] [ x-span 1/10 * ] bi - >>x-min
114 dup [ x-max>> ] [ x-span 1/10 * ] bi + >>x-max ;
116 : zoom-out-vertical ( plot -- plot )
117 dup [ y-min>> ] [ y-span 1/10 * ] bi - >>y-min
118 dup [ y-max>> ] [ y-span 1/10 * ] bi + >>y-max ;
120 : zoom-out ( plot -- plot )
125 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
129 { T{ mouse-enter } [ request-focus ] }
130 { T{ key-down f f "LEFT" } [ left drop ] }
131 { T{ key-down f f "RIGHT" } [ right drop ] }
132 { T{ key-down f f "DOWN" } [ down drop ] }
133 { T{ key-down f f "UP" } [ up drop ] }
134 { T{ key-down f f "a" } [ zoom-in drop ] }
135 { T{ key-down f f "z" } [ zoom-out drop ] }