extra/bunny/model/model.factor

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