]> gitweb.factorcode.org Git - factor.git/blob - extra/bunny/model/model.factor
Merge branch 'master' of git://factorcode.org/git/factor into constraints
[factor.git] / 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 math math.matrices math.parser math.vectors opengl
4 opengl.capabilities opengl.gl opengl.demo-support sequences
5 splitting vectors words specialized-arrays ;
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 [ 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 ] with with 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" temp-file ;
44
45 : model-url ( -- url ) "http://factorcode.org/bun_zipper.ply" ;
46
47 : maybe-download ( -- path )
48     model-path dup exists? [
49         "Downloading bunny from " write
50         model-url dup print flush
51         over download-to
52     ] unless ;
53
54 : (draw-triangle) ( ns vs triple -- )
55     [ dup roll nth gl-normal swap nth gl-vertex ] with with each ;
56
57 : draw-triangles ( ns vs is -- )
58     GL_TRIANGLES [ [ (draw-triangle) ] with with 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 >float-array underlying>>
72             GL_ARRAY_BUFFER swap GL_STATIC_DRAW <gl-buffer>
73         ]
74         [
75             third concat >uint-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>> "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 ;