]> gitweb.factorcode.org Git - factor.git/blob - extra/game/debug/debug.factor
specialized-arrays: performed some cleanup.
[factor.git] / extra / game / debug / debug.factor
1 ! Copyright (C) 2010 Erik Charlebois
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types alien.data arrays circular colors
4 colors.constants columns destructors fonts gpu.buffers
5 gpu.render gpu.shaders gpu.state gpu.textures images kernel
6 literals locals make math math.constants math.functions
7 math.vectors sequences specialized-arrays typed ui.text fry ;
8 FROM: alien.c-types => float ;
9 SPECIALIZED-ARRAYS: float uint ;
10 IN: game.debug
11
12 <PRIVATE
13 ! Vertex shader for debug shapes
14 GLSL-SHADER: debug-shapes-vertex-shader vertex-shader
15 uniform   mat4 u_mvp_matrix;
16 attribute vec3 a_position;
17 attribute vec3 a_color;
18 varying   vec3 v_color;
19 void main()
20 {
21     gl_Position = u_mvp_matrix * vec4(a_position, 1.0);
22     gl_PointSize = 5.0;
23     v_color = a_color;
24 }
25 ;
26
27 GLSL-SHADER: debug-shapes-fragment-shader fragment-shader
28 varying vec3 v_color;
29 void main()
30 {
31     gl_FragColor = vec4(v_color, 1.0);
32 }
33 ;
34
35 VERTEX-FORMAT: debug-shapes-vertex-format
36     { "a_position" float-components 3 f }
37     { "a_color"    float-components 3 f } ;
38
39 UNIFORM-TUPLE: debug-shapes-uniforms
40     { "u_mvp_matrix" mat4-uniform f } ;
41
42 GLSL-PROGRAM: debug-shapes-program debug-shapes-vertex-shader
43 debug-shapes-fragment-shader debug-shapes-vertex-format ;
44
45 ! Vertex shader for debug text
46 GLSL-SHADER: debug-text-vertex-shader vertex-shader
47 attribute vec2 a_position;
48 attribute vec2 a_texcoord;
49 varying   vec2 v_texcoord;
50 void main()
51 {
52     gl_Position = vec4(a_position, 0.0, 1.0);
53     v_texcoord  = a_texcoord;
54 }
55 ;
56
57 GLSL-SHADER: debug-text-fragment-shader fragment-shader
58 uniform sampler2D u_text_map;
59 uniform vec3 u_background_color;
60 varying vec2 v_texcoord;
61 void main()
62 {
63     vec4 c = texture2D(u_text_map, v_texcoord);
64     if (c.xyz == u_background_color)
65         discard;
66     else
67         gl_FragColor = c;
68 }
69 ;
70
71 VERTEX-FORMAT: debug-text-vertex-format
72     { "a_position" float-components 2 f }
73     { "a_texcoord" float-components 2 f } ;
74
75 UNIFORM-TUPLE: debug-text-uniforms
76     { "u_text_map"         texture-uniform f }
77     { "u_background_color" vec3-uniform    f } ;
78
79 GLSL-PROGRAM: debug-text-program debug-text-vertex-shader
80 debug-text-fragment-shader debug-text-vertex-format ;
81
82 CONSTANT: debug-text-font
83     T{ font 
84        { name       "monospace"  }
85        { size       16           }
86        { bold?      f            }
87        { italic?    f            }
88        { foreground COLOR: white }
89        { background COLOR: black } }
90        
91 CONSTANT: debug-text-texture-parameters       
92     T{ texture-parameters
93        { wrap              repeat-texcoord }
94        { min-filter        filter-linear   }
95        { min-mipmap-filter f               } }
96        
97 : text>image ( string color -- image )      
98     debug-text-font clone swap >>foreground swap string>image drop ;
99
100 :: image>texture ( image -- texture )
101     image [ component-order>> ] [ component-type>> ] bi
102     debug-text-texture-parameters <texture-2d> &dispose
103     [ 0 image allocate-texture-image ] keep ;
104
105 :: screen-quad ( image pt dim -- float-array )
106     pt dim v/ 2.0 v*n 1.0 v-n
107     dup image dim>> dim v/ 2.0 v*n v+
108     [ first2 ] bi@ :> ( x0 y0 x1 y1 )
109     image upside-down?>>
110     [ { x0 y0 0 0 x1 y0 1 0 x1 y1 1 1 x0 y1 0 1 } ]
111     [ { x0 y0 0 1 x1 y0 1 1 x1 y1 1 0 x0 y1 0 0 } ]
112     if float >c-array ;
113
114 : debug-text-uniform-variables ( string color -- image uniforms )
115     text>image dup image>texture
116     float-array{ 0.0 0.0 0.0 }
117     debug-text-uniforms boa swap ;
118
119 : debug-text-vertex-array ( image pt dim -- vertex-array )
120     screen-quad stream-upload draw-usage vertex-buffer byte-array>buffer &dispose
121     debug-text-program <program-instance> <vertex-array> &dispose ;
122  
123 : debug-text-index-buffer ( -- index-buffer )
124     uint-array{ 0 1 2 2 3 0 } stream-upload draw-usage index-buffer
125     byte-array>buffer &dispose 0 <buffer-ptr> 6 uint-indexes <index-elements> ;
126
127 : debug-text-render ( uniforms vertex-array index-buffer -- )
128     [
129         {
130             { "primitive-mode" [ 3drop triangles-mode ] }
131             { "uniforms"       [ 2drop ] }
132             { "vertex-array"   [ drop nip ] }
133             { "indexes"        [ 2nip ] }
134         } 3<render-set> render
135     ] with-destructors ;
136
137 : debug-shapes-vertex-array ( sequence -- vertex-array )
138     stream-upload draw-usage vertex-buffer byte-array>buffer &dispose
139     debug-shapes-program <program-instance> &dispose <vertex-array> &dispose ;
140
141 : draw-debug-primitives ( mode primitives mvp-matrix -- )
142     f origin-upper-left 1.0 <point-state> set-gpu-state
143     {
144         { "primitive-mode"     [ 2drop ] }
145         { "uniforms"           [ 2nip debug-shapes-uniforms boa ] }
146         { "vertex-array"       [ drop nip debug-shapes-vertex-array ] }
147         { "indexes"            [ drop nip length 0 swap <index-range> ] }
148     } 3<render-set> render ;
149
150 CONSTANT: box-vertices
151     { { {  1  1  1 } {  1  1 -1 } }
152       { {  1  1  1 } {  1 -1  1 } }
153       { {  1  1  1 } { -1  1  1 } }
154       { { -1 -1 -1 } { -1 -1  1 } }
155       { { -1 -1 -1 } { -1  1 -1 } }
156       { { -1 -1 -1 } {  1 -1 -1 } }
157       { { -1 -1  1 } { -1  1  1 } }
158       { { -1 -1  1 } {  1 -1  1 } }
159       { { -1  1 -1 } { -1  1  1 } }
160       { { -1  1 -1 } {  1  1 -1 } }
161       { {  1 -1 -1 } {  1 -1  1 } }
162       { {  1 -1 -1 } {  1  1 -1 } } }
163       
164 CONSTANT: cylinder-vertices
165     $[ 12 iota [ 2pi 12 / * [ cos ] [ drop 0.0 ] [ sin ] tri 3array ] map ]
166     
167 :: scale-cylinder-vertices ( radius half-height verts -- bot-verts top-verts )
168     verts
169     [ [ radius v*n { 0 half-height 0 } v- ] map ]
170     [ [ radius v*n { 0 half-height 0 } v+ ] map ] bi ;
171 PRIVATE>
172
173 : debug-point ( pt color -- )
174     [ first3 [ , ] tri@ ]
175     [ [ red>> , ] [ green>> , ] [ blue>> , ] tri ]
176     bi* ; inline
177
178 : debug-line ( from to color -- )
179     dup swapd [ debug-point ] 2bi@ ; inline
180
181 : debug-axes ( pt mat -- )
182     [ 0 <column> normalize over v+ COLOR: red debug-line ]
183     [ 1 <column> normalize over v+ COLOR: green debug-line ]
184     [ 2 <column> normalize over v+ COLOR: blue debug-line ]
185     2tri ; inline
186         
187 :: debug-box ( pt half-widths color -- )
188     box-vertices [
189         first2 [ half-widths v* pt v+ ] bi@ color debug-line
190     ] each ; inline
191
192 :: debug-circle ( points color -- )
193     points dup <circular> [ 1 swap change-circular-start ] keep
194     [ color debug-line ] 2each ; inline
195
196 :: debug-cylinder ( pt half-height radius color -- )
197     radius half-height cylinder-vertices scale-cylinder-vertices
198     [ [ color debug-circle ] bi@ ]
199     [ color '[ _ debug-line ] 2each ] 2bi ; inline
200
201 TYPED: draw-debug-lines ( lines: float-array mvp-matrix -- )
202     [ lines-mode -rot draw-debug-primitives ] with-destructors ; inline
203
204 TYPED: draw-debug-points ( points: float-array mvp-matrix -- )
205     [ points-mode -rot draw-debug-primitives ] with-destructors ; inline
206         
207 TYPED: draw-text ( string color: rgba pt dim -- )
208     [
209         [ debug-text-uniform-variables ] 2dip
210         debug-text-vertex-array
211         debug-text-index-buffer
212         debug-text-render
213     ] with-destructors ; inline