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