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
   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 < demo-gadget model-triangles geom draw-seq draw-n ;
  11
  12 : <bunny-gadget> ( -- bunny-gadget )
  13     0.0 0.0 0.375 bunny-gadget new-demo-gadget
  14     maybe-download read-model >>model-triangles ;
  15
  16 : bunny-gadget-draw ( gadget -- draw )
  17     [ draw-n>> ] [ draw-seq>> ] bi nth ;
  18
  19 : bunny-gadget-next-draw ( gadget -- )
  20     dup [ draw-seq>> ] [ draw-n>> ] bi
  21     1+ swap length mod
  22     >>draw-n relayout-1 ;
  23
  24 M: bunny-gadget graft* ( gadget -- )
  25     GL_DEPTH_TEST glEnable
  26     dup model-triangles>> <bunny-geom> >>geom
  27     dup
  28     [ <bunny-fixed-pipeline> ]
  29     [ <bunny-cel-shaded> ]
  30     [ <bunny-outlined> ] tri 3array
  31     sift >>draw-seq
  32     0 >>draw-n
  33     drop ;
  34
  35 M: bunny-gadget ungraft* ( gadget -- )
  36     [ geom>> [ dispose ] when* ]
  37     [ draw-seq>> [ [ dispose ] when* ] each ] bi ;
  38
  39 M: bunny-gadget draw-gadget* ( gadget -- )
  40     dup draw-seq>> empty? [ drop ] [
  41         0.15 0.15 0.15 1.0 glClearColor
  42         GL_DEPTH_BUFFER_BIT GL_COLOR_BUFFER_BIT bitor glClear
  43         dup demo-gadget-set-matrices
  44         GL_MODELVIEW glMatrixMode
  45         0.02 -0.105 0.0 glTranslatef
  46         [ geom>> ] [ bunny-gadget-draw ] bi draw-bunny
  47     ] if ;
  48
  49 M: bunny-gadget pref-dim* ( gadget -- dim )
  50     drop { 640 480 } ;
  51
  52 bunny-gadget H{
  53     { T{ key-down f f "TAB" } [ bunny-gadget-next-draw ] }
  54 } set-gestures
  55
  56 : bunny-window ( -- )
  57     [ <bunny-gadget> "Bunny" open-window ] with-ui ;
  58
  59 MAIN: bunny-window