extra/bunny/bunny.factor

   1 USING: alien alien.c-types arrays sequences math math.vectors
   2 math.matrices math.parser io io.files kernel opengl opengl.gl
   3 opengl.glu shuffle http.client vectors namespaces ui.gadgets
   4 ui.gadgets.canvas ui.render ui splitting combinators tools.time
   5 system combinators.lib float-arrays continuations
   6 opengl.demo-support multiline ui.gestures bunny.fixed-pipeline
   7 bunny.cel-shaded bunny.outlined bunny.model accessors destructors ;
   8 IN: bunny
   9
  10 TUPLE: bunny-gadget model geom draw-seq draw-n ;
  11
  12 : <bunny-gadget> ( -- bunny-gadget )
  13     0.0 0.0 0.375 <demo-gadget>
  14     maybe-download read-model {
  15         set-delegate
  16         (>>model)
  17     } bunny-gadget construct ;
  18
  19 : bunny-gadget-draw ( gadget -- draw )
  20     { draw-n>> draw-seq>> }
  21     get-slots nth ;
  22
  23 : bunny-gadget-next-draw ( gadget -- )
  24     dup { draw-seq>> draw-n>> }
  25     get-slots
  26     1+ swap length mod
  27     >>draw-n relayout-1 ;
  28
  29 M: bunny-gadget graft* ( gadget -- )
  30     GL_DEPTH_TEST glEnable
  31     dup model>> <bunny-geom> >>geom
  32     dup
  33     [ <bunny-fixed-pipeline> ]
  34     [ <bunny-cel-shaded> ]
  35     [ <bunny-outlined> ] tri 3array
  36     sift >>draw-seq
  37     0 >>draw-n
  38     drop ;
  39
  40 M: bunny-gadget ungraft* ( gadget -- )
  41     [ geom>> [ dispose ] when* ]
  42     [ draw-seq>> [ [ dispose ] when* ] each ] bi ;
  43
  44 M: bunny-gadget draw-gadget* ( gadget -- )
  45     0.15 0.15 0.15 1.0 glClearColor
  46     GL_DEPTH_BUFFER_BIT GL_COLOR_BUFFER_BIT bitor glClear
  47     dup demo-gadget-set-matrices
  48     GL_MODELVIEW glMatrixMode
  49     0.02 -0.105 0.0 glTranslatef
  50     { geom>> bunny-gadget-draw } get-slots
  51     draw-bunny ;
  52
  53 M: bunny-gadget pref-dim* ( gadget -- dim )
  54     drop { 640 480 } ;
  55
  56 bunny-gadget H{
  57     { T{ key-down f f "TAB" } [ bunny-gadget-next-draw ] }
  58 } set-gestures
  59
  60 : bunny-window ( -- )
  61     [ <bunny-gadget> "Bunny" open-window ] with-ui ;
  62
  63 MAIN: bunny-window