extra/math/splines/viewer/viewer.factor

   1 ! Copyright (C) 2010 Erik Charlebois.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel math math.order math.polynomials
   4 opengl.demo-support opengl.gl sequences ui.gadgets
   5 ui.gadgets.panes ui.render arrays ;
   6 IN: math.splines.viewer
   7
   8 <PRIVATE
   9 : eval-polynomials ( polynomials-seq n -- xy-sequence )
  10     [
  11         [ 1 + <iota> ] keep [
  12             /f swap [ polyval ] with map
  13         ] curry with map
  14     ] curry map concat ;
  15 PRIVATE>
  16
  17 TUPLE: spline-gadget < gadget polynomials steps spline-dim ;
  18
  19 M: spline-gadget pref-dim* spline-dim>> ;
  20
  21 M:: spline-gadget draw-gadget* ( gadget -- )
  22     0 0 0 glColor3f
  23
  24     gadget [ polynomials>> ] [ steps>> ] bi eval-polynomials :> pts
  25
  26     pts [ first ] [ max ] map-reduce  :> x-max
  27     pts [ first ] [ min ] map-reduce  :> x-min
  28     pts [ second ] [ max ] map-reduce :> y-max
  29     pts [ second ] [ min ] map-reduce :> y-min
  30
  31     pts [
  32         [ first x-min - x-max x-min - / gadget spline-dim>> first * ]
  33         [ second y-min - y-max y-min - / gadget spline-dim>> second * ] bi 2array
  34     ] map :> pts
  35
  36     GL_LINE_STRIP [
  37         pts [
  38             first2 neg gadget spline-dim>> second + glVertex2f
  39         ] each ]
  40     do-state ;
  41
  42 :: <spline-gadget> ( polynomials dim steps -- gadget )
  43     spline-gadget new
  44     dim >>spline-dim
  45     polynomials >>polynomials
  46     steps >>steps ;
  47
  48 : spline. ( curve dim steps -- )
  49     <spline-gadget> gadget. ;