extra/ui/gadgets/plot/plot.factor

   1
   2 USING: kernel quotations arrays sequences math math.ranges fry
   3        opengl opengl.gl ui.render ui.gadgets.cartesian processing.shapes
   4        accessors ;
   5
   6 IN: ui.gadgets.plot
   7
   8 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   9
  10 TUPLE: plot < cartesian functions points ;
  11
  12 : init-plot ( plot -- plot )
  13   init-cartesian
  14     { } >>functions
  15     100 >>points ;
  16
  17 : <plot> ( -- plot ) plot new init-plot ;
  18
  19 : step-size ( plot -- step-size )
  20   [ [ x-max>> ] [ x-min>> ] bi - ] [ points>> ] bi / ;
  21
  22 : plot-range ( plot -- range )
  23   [ x-min>> ] [ x-max>> ] [ step-size ] tri <range> ;
  24
  25 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  26
  27 TUPLE: function function color ;
  28
  29 GENERIC: plot-function ( plot object -- plot )
  30
  31 M: callable plot-function ( plot quotation -- plot )
  32   >r dup plot-range r> '[ dup @ 2array ] map line-strip ;
  33
  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 ;
  37
  38 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  39
  40 : plot-functions ( plot -- plot ) dup functions>> [ plot-function ] each ;
  41
  42 : draw-axis ( plot -- plot )
  43   dup
  44     [ [ x-min>> ] [ drop 0  ] bi 2array ]
  45     [ [ x-max>> ] [ drop 0  ] bi 2array ] bi line*
  46   dup
  47     [ [ drop 0  ] [ y-min>> ] bi 2array ]
  48     [ [ drop 0  ] [ y-max>> ] bi 2array ] bi line* ;
  49
  50 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  51
  52 USING: ui.gadgets.slate ;
  53
  54 M: plot draw-slate ( plot -- plot )
  55    2 glLineWidth
  56    draw-axis
  57    plot-functions
  58    fill-mode
  59    1 glLineWidth ;
  60
  61 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  62
  63 : add-function ( plot function -- plot )
  64   over functions>> swap suffix >>functions ;
  65
  66 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  67
  68 : x-span ( plot -- span ) [ x-max>> ] [ x-min>> ] bi - ;
  69 : y-span ( plot -- span ) [ y-max>> ] [ y-min>> ] bi - ;
  70
  71 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  72
  73 USING: ui.gestures ui.gadgets ;
  74
  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
  78   dup relayout-1 ;
  79
  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
  83   dup relayout-1 ;
  84
  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
  88   dup relayout-1 ;
  89
  90 : up ( plot -- plot )
  91   dup [ y-min>> ] [ y-span 1/10 * ] bi + >>y-min
  92   dup [ y-max>> ] [ y-span 1/10 * ] bi + >>y-max
  93   dup relayout-1 ;
  94
  95 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  96
  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 ;
 100
 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 ;
 104
 105 : zoom-in ( plot -- plot )
 106   zoom-in-horizontal
 107   zoom-in-vertical
 108   dup relayout-1 ;
 109
 110 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 111
 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 ;
 115
 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 ;
 119
 120 : zoom-out ( plot -- plot )
 121   zoom-out-horizontal
 122   zoom-out-vertical
 123   dup relayout-1 ;
 124
 125 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 126
 127 plot
 128   H{
 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 ] }
 136   }
 137 set-gestures