extra/bunny/model/model.factor

   1 USING: accessors alien.c-types arrays combinators destructors
   2 http.client io io.encodings.ascii io.files io.files.temp kernel
   3 locals math math.matrices math.parser math.vectors opengl
   4 opengl.capabilities opengl.gl opengl.demo-support sequences
   5 splitting vectors words specialized-arrays alien.data ;
   6 FROM: sequences => change-nth ;
   7 QUALIFIED-WITH: alien.c-types c
   8 SPECIALIZED-ARRAY: c:float
   9 SPECIALIZED-ARRAY: c:uint
  10 IN: bunny.model
  11
  12 : numbers ( str -- seq )
  13     " " split [ string>number ] map sift ;
  14
  15 : (parse-model) ( vs is -- vs is )
  16     readln [
  17         numbers {
  18             { [ dup length 5 = ] [ 3 head pick push ] }
  19             { [ dup first 3 = ] [ rest over push ] }
  20             [ drop ]
  21         } cond (parse-model)
  22     ] when* ;
  23
  24 : parse-model ( -- vs is )
  25     100000 <vector> 100000 <vector> (parse-model) ;
  26
  27 : n ( vs triple -- n )
  28     swap [ nth ] curry map
  29     [ [ second ] [ first ] bi v- ] [ [ third ] [ first ] bi v- ] bi cross
  30     vneg normalize ;
  31
  32 : normal ( ns vs triple -- )
  33     [ n ] keep [ rot [ v+ ] change-nth ] with with each ;
  34
  35 : normals ( vs is -- ns )
  36     [ [ length { 0.0 0.0 0.0 } <array> ] keep ] dip
  37     [ [ 2dup ] dip normal ] each drop
  38     [ normalize ] map ;
  39
  40 : read-model ( stream -- model )
  41     ascii [ parse-model ] with-file-reader
  42     [ normals ] 2keep 3array ;
  43
  44 : model-path ( -- path ) "bun_zipper.ply" temp-file ;
  45
  46 : model-url ( -- url ) "http://duriansoftware.com/joe/media/bun_zipper.ply" ;
  47
  48 : maybe-download ( -- path )
  49     model-path dup exists? [
  50         "Downloading bunny from " write
  51         model-url dup print flush
  52         over download-to
  53     ] unless ;
  54
  55 :: (draw-triangle) ( ns vs triple -- )
  56     triple [| elt |
  57         elt ns nth gl-normal
  58         elt vs nth gl-vertex
  59     ] each ;
  60
  61 : draw-triangles ( ns vs is -- )
  62     GL_TRIANGLES [ [ (draw-triangle) ] with with each ] do-state ;
  63
  64 TUPLE: bunny-dlist list ;
  65 TUPLE: bunny-buffers array element-array nv ni ;
  66
  67 : <bunny-dlist> ( model -- geom )
  68     GL_COMPILE [ first3 draw-triangles ] make-dlist
  69     bunny-dlist boa ;
  70
  71 : <bunny-buffers> ( model -- geom )
  72     {
  73         [
  74             [ first concat ] [ second concat ] bi
  75             append c:float >c-array underlying>>
  76             GL_ARRAY_BUFFER swap GL_STATIC_DRAW <gl-buffer>
  77         ]
  78         [
  79             third concat c:uint >c-array underlying>>
  80             GL_ELEMENT_ARRAY_BUFFER swap GL_STATIC_DRAW <gl-buffer>
  81         ]
  82         [ first length 3 * ]
  83         [ third length 3 * ]
  84     } cleave bunny-buffers boa ;
  85
  86 GENERIC: bunny-geom ( geom -- )
  87 GENERIC: draw-bunny ( geom draw -- )
  88
  89 M: bunny-dlist bunny-geom
  90     list>> glCallList ;
  91
  92 M: bunny-buffers bunny-geom
  93     dup [ array>> ] [ element-array>> ] bi [
  94         { GL_VERTEX_ARRAY GL_NORMAL_ARRAY } [
  95             GL_FLOAT 0 0 buffer-offset glNormalPointer
  96             [
  97                 nv>> c:float heap-size * buffer-offset
  98                 [ 3 GL_FLOAT 0 ] dip glVertexPointer
  99             ] [
 100                 ni>>
 101                 GL_TRIANGLES swap GL_UNSIGNED_INT 0 buffer-offset glDrawElements
 102             ] bi
 103         ] all-enabled-client-state
 104     ] with-array-element-buffers ;
 105
 106 M: bunny-dlist dispose
 107     list>> delete-dlist ;
 108
 109 M: bunny-buffers dispose
 110     [ array>> ] [ element-array>> ] bi
 111     delete-gl-buffer delete-gl-buffer ;
 112
 113 : <bunny-geom> ( model -- geom )
 114     "1.5" { "GL_ARB_vertex_buffer_object" }
 115     has-gl-version-or-extensions?
 116     [ <bunny-buffers> ] [ <bunny-dlist> ] if ;