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 ;
   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         set-bunny-gadget-model
  17     } bunny-gadget construct ;
  18
  19 : bunny-gadget-draw ( gadget -- draw )
  20     { bunny-gadget-draw-n bunny-gadget-draw-seq }
  21     get-slots nth ;
  22
  23 : bunny-gadget-next-draw ( gadget -- )
  24     dup { bunny-gadget-draw-seq bunny-gadget-draw-n }
  25     get-slots
  26     1+ swap length mod
  27     swap [ set-bunny-gadget-draw-n ] keep relayout-1 ;
  28
  29 M: bunny-gadget graft* ( gadget -- )
  30     GL_DEPTH_TEST glEnable
  31     dup bunny-gadget-model <bunny-geom>
  32     over {
  33         [ <bunny-fixed-pipeline> ]
  34         [ <bunny-cel-shaded> ]
  35         [ <bunny-outlined> ]
  36     } map-call-with [ ] filter
  37     0
  38     roll {
  39         set-bunny-gadget-geom
  40         set-bunny-gadget-draw-seq
  41         set-bunny-gadget-draw-n
  42     } set-slots ;
  43
  44 M: bunny-gadget ungraft* ( gadget -- )
  45     { bunny-gadget-geom bunny-gadget-draw-seq } get-slots
  46     [ [ dispose ] when* ] each
  47     [ dispose ] when* ;
  48
  49 M: bunny-gadget draw-gadget* ( gadget -- )
  50     0.15 0.15 0.15 1.0 glClearColor
  51     GL_DEPTH_BUFFER_BIT GL_COLOR_BUFFER_BIT bitor glClear
  52     dup demo-gadget-set-matrices
  53     GL_MODELVIEW glMatrixMode
  54     0.02 -0.105 0.0 glTranslatef
  55     { bunny-gadget-geom bunny-gadget-draw } get-slots
  56     draw-bunny ;
  57
  58 M: bunny-gadget pref-dim* ( gadget -- dim )
  59     drop { 640 480 } ;
  60
  61 bunny-gadget H{
  62     { T{ key-down f f "TAB" } [ bunny-gadget-next-draw ] }
  63 } set-gestures
  64
  65 : bunny-window ( -- )
  66     [ <bunny-gadget> "Bunny" open-window ] with-ui ;
  67
  68 MAIN: bunny-window