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 ! Examples:
  11 !
  12 !   <plot> [ sin ] add-function gadget.
  13 !
  14 !   <plot>
  15 !     [ sin ] red  function boa add-function
  16 !     [ cos ] blue function boa add-function
  17 !   gadget.
  18 !
  19 !
  20 ! Use the arrow keys to move around.
  21 !
  22 ! Use 'a' and 'z' keys to zoom in and out.
  23
  24 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  25
  26 TUPLE: plot < cartesian functions points ;
  27
  28 : init-plot ( plot -- plot )
  29   init-cartesian
  30     { } >>functions
  31     100 >>points ;
  32
  33 : <plot> ( -- plot ) plot new init-plot ;
  34
  35 : step-size ( plot -- step-size )
  36   [ [ x-max>> ] [ x-min>> ] bi - ] [ points>> ] bi / ;
  37
  38 : plot-range ( plot -- range )
  39   [ x-min>> ] [ x-max>> ] [ step-size ] tri <range> ;
  40
  41 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  42
  43 TUPLE: function function color ;
  44
  45 GENERIC: plot-function ( plot object -- plot )
  46
  47 M: callable plot-function ( plot quotation -- plot )
  48   [ dup plot-range ] dip '[ dup @ 2array ] map line-strip ;
  49
  50 M: function plot-function ( plot function -- plot )
  51    dup color>> dup [ >stroke-color ] [ drop ] if
  52    [ dup plot-range ] dip function>> '[ dup @ 2array ] map line-strip ;
  53
  54 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  55
  56 : plot-functions ( plot -- plot ) dup functions>> [ plot-function ] each ;
  57
  58 : draw-axis ( plot -- plot )
  59   dup
  60     [ [ x-min>> ] [ drop 0  ] bi 2array ]
  61     [ [ x-max>> ] [ drop 0  ] bi 2array ] bi line*
  62   dup
  63     [ [ drop 0  ] [ y-min>> ] bi 2array ]
  64     [ [ drop 0  ] [ y-max>> ] bi 2array ] bi line* ;
  65
  66 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  67
  68 USING: ui.gadgets.slate ;
  69
  70 M: plot draw-slate ( plot -- plot )
  71    2 glLineWidth
  72    draw-axis
  73    plot-functions
  74    fill-mode
  75    1 glLineWidth ;
  76
  77 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  78
  79 : add-function ( plot function -- plot )
  80   over functions>> swap suffix >>functions ;
  81
  82 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  83
  84 : x-span ( plot -- span ) [ x-max>> ] [ x-min>> ] bi - ;
  85 : y-span ( plot -- span ) [ y-max>> ] [ y-min>> ] bi - ;
  86
  87 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  88
  89 USING: ui.gestures ui.gadgets ;
  90
  91 : left ( plot -- plot )
  92   dup [ x-min>> ] [ x-span 1/10 * ] bi - >>x-min
  93   dup [ x-max>> ] [ x-span 1/10 * ] bi - >>x-max
  94   dup relayout-1 ;
  95
  96 : right ( plot -- plot )
  97   dup [ x-min>> ] [ x-span 1/10 * ] bi + >>x-min
  98   dup [ x-max>> ] [ x-span 1/10 * ] bi + >>x-max
  99   dup relayout-1 ;
 100
 101 : down ( 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   dup relayout-1 ;
 105
 106 : up ( plot -- plot )
 107   dup [ y-min>> ] [ y-span 1/10 * ] bi + >>y-min
 108   dup [ y-max>> ] [ y-span 1/10 * ] bi + >>y-max
 109   dup relayout-1 ;
 110
 111 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 112
 113 : zoom-in-horizontal ( plot -- plot )
 114   dup [ x-min>> ] [ x-span 1/10 * ] bi + >>x-min
 115   dup [ x-max>> ] [ x-span 1/10 * ] bi - >>x-max ;
 116
 117 : zoom-in-vertical ( plot -- plot )
 118   dup [ y-min>> ] [ y-span 1/10 * ] bi + >>y-min
 119   dup [ y-max>> ] [ y-span 1/10 * ] bi - >>y-max ;
 120
 121 : zoom-in ( plot -- plot )
 122   zoom-in-horizontal
 123   zoom-in-vertical
 124   dup relayout-1 ;
 125
 126 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 127
 128 : zoom-out-horizontal ( plot -- plot )
 129   dup [ x-min>> ] [ x-span 1/10 * ] bi - >>x-min
 130   dup [ x-max>> ] [ x-span 1/10 * ] bi + >>x-max ;
 131
 132 : zoom-out-vertical ( plot -- plot )
 133   dup [ y-min>> ] [ y-span 1/10 * ] bi - >>y-min
 134   dup [ y-max>> ] [ y-span 1/10 * ] bi + >>y-max ;
 135
 136 : zoom-out ( plot -- plot )
 137   zoom-out-horizontal
 138   zoom-out-vertical
 139   dup relayout-1 ;
 140
 141 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 142
 143 plot
 144   H{
 145     { T{ mouse-enter } [ request-focus ] }
 146     { T{ key-down f f "LEFT"  } [ left drop  ] }
 147     { T{ key-down f f "RIGHT" } [ right drop ] }
 148     { T{ key-down f f "DOWN"  } [ down drop  ] }
 149     { T{ key-down f f "UP"    } [ up drop    ] }
 150     { T{ key-down f f "a"     } [ zoom-in  drop ] }
 151     { T{ key-down f f "z"     } [ zoom-out drop ] }
 152   }
 153 set-gestures