extra/gml/viewer/viewer.factor

   1 USING: accessors alien.c-types alien.data alien.data.map arrays\r
   2 assocs byte-arrays colors combinators combinators.short-circuit\r
   3 destructors euler.b-rep euler.b-rep.triangulation fry game.input\r
   4 game.loop game.models.half-edge game.worlds gml.printer gpu\r
   5 gpu.buffers gpu.framebuffers gpu.render gpu.shaders gpu.state\r
   6 gpu.util.wasd growable images kernel literals locals math\r
   7 math.order math.ranges math.vectors math.vectors.conversion\r
   8 math.vectors.simd math.vectors.simd.cords method-chains models\r
   9 namespaces sequences sets specialized-vectors typed ui\r
  10 ui.gadgets ui.gadgets.worlds ui.gestures ui.pixel-formats\r
  11 vectors ;\r
  12 FROM: math.matrices => m.v ;\r
  13 FROM: models => change-model ;\r
  14 SPECIALIZED-VECTORS: ushort float-4 ;\r
  15 IN: gml.viewer\r
  16 \r
  17 CONSTANT: neutral-edge-color float-4{ 1 1 1 1 }\r
  18 CONSTANT: neutral-face-color float-4{ 1 1 1 1 }\r
  19 CONSTANT: selected-face-color float-4{ 1 0.9 0.8 1 }\r
  20 \r
  21 : double-4>float-4 ( in: double-4 -- out: float-4 )\r
  22     [ head>> ] [ tail>> ] bi double-2 float-4 vconvert ; inline\r
  23 : rgba>float-4 ( in: rgba -- out: float-4 )\r
  24     >rgba-components float-4-boa ; inline\r
  25 \r
  26 : face-color ( edge -- color )\r
  27     face-normal float-4{ 0 1 0.1 0 } v. 0.3 * 0.4 + dup dup 1.0 float-4-boa ; inline\r
  28 \r
  29 TUPLE: b-rep-vertices\r
  30     { array byte-array read-only }\r
  31     { face-vertex-count integer read-only }\r
  32     { edge-vertex-count integer read-only }\r
  33     { point-vertex-count integer read-only } ;\r
  34 \r
  35 :: <b-rep-vertices> ( face-array  face-count\r
  36                       edge-array  edge-count\r
  37                       point-array point-count -- vxs )\r
  38     face-array edge-array point-array 3append\r
  39     face-count edge-count point-count \ b-rep-vertices boa ; inline\r
  40 \r
  41 : face-selected? ( face selected -- ? )\r
  42     [ f ] 2dip [ edge>> ] dip '[ _ in? or ] each-face-edge ;\r
  43 \r
  44 :: b-rep-face-vertices ( b-rep selected -- vertices count indices )\r
  45     float-4-vector{ } clone :> vertices\r
  46     ushort-vector{ } clone :> indices\r
  47 \r
  48     0 b-rep faces>> [| count face |\r
  49         face selected face-selected? :> selected?\r
  50         face dup base-face>> eq? [\r
  51             face edge>> face-color\r
  52                 selected? selected-face-color neutral-face-color ? v* :> color\r
  53             face triangulate-face seq>> :> triangles\r
  54             triangles members :> tri-vertices\r
  55             tri-vertices >index-hash :> vx-indices\r
  56 \r
  57             tri-vertices [\r
  58                 position>> double-4>float-4 vertices push\r
  59                 color vertices push\r
  60             ] each\r
  61             triangles [ vx-indices at count + indices push ] each\r
  62 \r
  63             count tri-vertices length +\r
  64         ] [ count ] if\r
  65     ] each :> total\r
  66     vertices float-4 >c-array underlying>>\r
  67     total\r
  68     indices ushort-array{ } like ;\r
  69 \r
  70 : b-rep-edge-vertices ( b-rep -- vertices count )\r
  71     vertices>> [\r
  72         [\r
  73             position>> [ double-4>float-4 ] keep\r
  74             [ drop neutral-edge-color ]\r
  75             [ vertex-color rgba>float-4 ] 2bi\r
  76         ] data-map( object -- float-4[4] )\r
  77     ] [ length 2 * ] bi ; inline\r
  78 \r
  79 GENERIC: selected-vectors ( object -- vectors )\r
  80 M: object selected-vectors drop { } ;\r
  81 M: double-4 selected-vectors 1array ;\r
  82 M: sequence selected-vectors [ selected-vectors ] map concat ;\r
  83 \r
  84 : selected-vertices ( selected -- vertices count )\r
  85     selected-vectors [\r
  86         [ [ double-4>float-4 ] [ vertex-color rgba>float-4 ] bi ]\r
  87         data-map( object -- float-4[2] )\r
  88     ] [ length ] bi ; inline\r
  89 \r
  90 : edge-vertex-index ( e vertex-indices selected -- n selected? )\r
  91     [ dup vertex>> ] [ at 2 * ] [ swapd in? [ [ 1 + ] when ] keep ] tri* ;\r
  92 \r
  93 :: b-rep-edge-index-array ( b-rep selected offset -- edge-indices )\r
  94     b-rep vertices>> >index-hash :> vertex-indices\r
  95     b-rep edges>> length <ushort-vector> :> edge-indices\r
  96 \r
  97     b-rep edges>> [| e |\r
  98         e opposite-edge>> :> o\r
  99         e vertex-indices selected edge-vertex-index [ offset + ] dip :> ( from e-selected? )\r
 100         o vertex-indices selected edge-vertex-index [ offset + ] dip :> ( to   o-selected? )\r
 101 \r
 102         from to < [ from edge-indices push to edge-indices push ] when\r
 103     ] each\r
 104 \r
 105     edge-indices ushort-array{ } like ;\r
 106 \r
 107 :: make-b-rep-vertices ( b-rep selected -- vertices face-indices edge-indices point-indices )\r
 108     b-rep selected b-rep-face-vertices :> ( face-vertices face-count face-indices )\r
 109     b-rep b-rep-edge-vertices :> ( edge-vertices edge-count )\r
 110     selected selected-vertices :> ( sel-vertices sel-count )\r
 111     face-vertices face-count edge-vertices edge-count sel-vertices sel-count\r
 112     <b-rep-vertices> :> vertices\r
 113 \r
 114     vertices array>>\r
 115 \r
 116     face-indices\r
 117 \r
 118     b-rep selected vertices face-vertex-count>> b-rep-edge-index-array\r
 119     vertices\r
 120 \r
 121     [ face-vertex-count>> ]\r
 122     [ edge-vertex-count>> + dup ]\r
 123     [ point-vertex-count>> + ] tri\r
 124     [a,b) ushort >c-array ;\r
 125 \r
 126 VERTEX-FORMAT: wire-vertex-format\r
 127     { "vertex"  float-components 3 f }\r
 128     { f         float-components 1 f }\r
 129     { "color"   float-components 4 f } ;\r
 130 \r
 131 GLSL-SHADER-FILE: gml-viewer-vertex-shader vertex-shader "viewer.v.glsl"\r
 132 GLSL-SHADER-FILE: gml-viewer-fragment-shader fragment-shader "viewer.f.glsl"\r
 133 GLSL-PROGRAM: gml-viewer-program\r
 134     gml-viewer-vertex-shader gml-viewer-fragment-shader\r
 135     wire-vertex-format ;\r
 136 \r
 137 TUPLE: gml-viewer-world < wasd-world\r
 138     { b-rep b-rep }\r
 139     selected\r
 140     program\r
 141     vertex-array\r
 142     face-indices edge-indices point-indices\r
 143     view-faces? view-edges?\r
 144     drag? ;\r
 145 \r
 146 TYPED: refresh-b-rep-view ( world: gml-viewer-world -- )\r
 147     dup control-value >>b-rep\r
 148     dup vertex-array>> [ vertex-array-buffer dispose ] when*\r
 149     dup [ b-rep>> ] [ selected>> value>> ] bi make-b-rep-vertices {\r
 150         [\r
 151             static-upload draw-usage vertex-buffer byte-array>buffer\r
 152             over program>> <vertex-array> >>vertex-array\r
 153         ]\r
 154         [ >>face-indices ]\r
 155         [ >>edge-indices ]\r
 156         [ >>point-indices ]\r
 157     } spread\r
 158     drop ;\r
 159 \r
 160 : viewable? ( gml-viewer-world -- ? )\r
 161     { [ b-rep>> ] [ program>> ] } 1&& ;\r
 162 \r
 163 M: gml-viewer-world model-changed\r
 164     nip\r
 165     [ control-value ]\r
 166     [ b-rep<< ]\r
 167     [ dup viewable? [ refresh-b-rep-view ] [ drop ] if ] tri ;\r
 168 \r
 169 : init-viewer-model ( gml-viewer-world -- )\r
 170     [ dup model>> add-connection ]\r
 171     [ dup selected>> add-connection ] bi ;\r
 172 \r
 173 : reset-view ( gml-viewer-world -- )\r
 174     { 0.0 0.0 5.0 } 0.0 0.0 set-wasd-view drop ;\r
 175 \r
 176 M: gml-viewer-world begin-game-world\r
 177     init-gpu\r
 178     t >>view-faces?\r
 179     t >>view-edges?\r
 180     T{ point-state { size 5.0 } } set-gpu-state\r
 181     dup reset-view\r
 182     gml-viewer-program <program-instance> >>program\r
 183     dup init-viewer-model\r
 184     refresh-b-rep-view ;\r
 185 \r
 186 M: gml-viewer-world end-game-world\r
 187     [ dup selected>> remove-connection ]\r
 188     [ dup model>> remove-connection ] bi ;\r
 189 \r
 190 M: gml-viewer-world draw-world*\r
 191     system-framebuffer {\r
 192         { default-attachment { 0.0 0.0 0.0 1.0 } }\r
 193         { depth-attachment 1.0 }\r
 194     } clear-framebuffer\r
 195 \r
 196     [\r
 197         dup view-faces?>> [\r
 198             T{ depth-state { comparison cmp-less } } set-gpu-state\r
 199             {\r
 200                 { "primitive-mode" [ drop triangles-mode ] }\r
 201                 { "indexes"        [ face-indices>> ] }\r
 202                 { "uniforms"       [ <mvp-uniforms> ] }\r
 203                 { "vertex-array"   [ vertex-array>> ] }\r
 204             } <render-set> render\r
 205             T{ depth-state { comparison f } } set-gpu-state\r
 206         ] [ drop ] if\r
 207     ] [\r
 208         dup view-edges?>> [\r
 209             {\r
 210                 { "primitive-mode" [ drop lines-mode ] }\r
 211                 { "indexes"        [ edge-indices>> ] }\r
 212                 { "uniforms"       [ <mvp-uniforms> ] }\r
 213                 { "vertex-array"   [ vertex-array>> ] }\r
 214             } <render-set> render\r
 215         ] [ drop ] if\r
 216     ] [\r
 217         {\r
 218             { "primitive-mode" [ drop points-mode ] }\r
 219             { "indexes"        [ point-indices>> ] }\r
 220             { "uniforms"       [ <mvp-uniforms> ] }\r
 221             { "vertex-array"   [ vertex-array>> ] }\r
 222         } <render-set> render\r
 223     ] tri ;\r
 224 \r
 225 TYPED: rotate-view-mode ( world: gml-viewer-world -- )\r
 226     dup view-edges?>> [\r
 227         dup view-faces?>>\r
 228         [ f >>view-faces? ]\r
 229         [ f >>view-edges? t >>view-faces? ] if\r
 230     ] [ t >>view-edges? ] if drop ;\r
 231 \r
 232 CONSTANT: edge-hitbox-radius 0.05\r
 233 \r
 234 :: line-nearest-t ( p0 u q0 v -- tp tq )\r
 235     p0 q0 v- :> w0\r
 236 \r
 237     u u v. :> a\r
 238     u v v. :> b\r
 239     v v v. :> c\r
 240     u w0 v. :> d\r
 241     v w0 v. :> e\r
 242 \r
 243     a c * b b * - :> denom\r
 244 \r
 245     b e * c d * - denom /f\r
 246     a e * b d * - denom /f ;\r
 247 \r
 248 :: intersects-edge-node? ( source direction edge -- ? )\r
 249     edge vertex>> position>> double-4>float-4 :> edge-source\r
 250     edge opposite-edge>> vertex>> position>> double-4>float-4 edge-source v- :> edge-direction\r
 251 \r
 252     source direction edge-source edge-direction line-nearest-t :> ( ray-t edge-t )\r
 253 \r
 254     ray-t 0.0 >= edge-t 0.0 0.5 between? and [\r
 255         source direction ray-t v*n v+\r
 256         edge-source edge-direction edge-t v*n v+ v- norm\r
 257         edge-hitbox-radius <\r
 258     ] [ f ] if ;\r
 259 \r
 260 : intersecting-edge-node ( source direction b-rep -- edge/f )\r
 261     edges>> [ intersects-edge-node? ] 2with find nip ;\r
 262 \r
 263 : select-edge ( world -- )\r
 264     [ [ location>> ] [ hand-loc get wasd-pixel-ray ] bi ]\r
 265     [ b-rep>> intersecting-edge-node ]\r
 266     [ '[ _ [ selected>> push-model ] [ refresh-b-rep-view ] bi ] when* ] tri ;\r
 267 \r
 268 gml-viewer-world H{\r
 269     { T{ button-up f f 1 } [ dup drag?>> [ drop ] [ select-edge ] if ] }\r
 270     { T{ drag f 1 } [ t >>drag? drop ] }\r
 271     { T{ key-down f f "RET" } [ reset-view ] }\r
 272     { T{ key-down f f "TAB" } [ rotate-view-mode ] }\r
 273 } set-gestures\r
 274 \r
 275 AFTER: gml-viewer-world tick-game-world\r
 276     dup drag?>> [\r
 277         read-mouse buttons>>\r
 278         ! FIXME: GTK Mouse buttons are an integer\r
 279         ! MacOSX mouse buttons are an array of bools\r
 280         dup integer? [ 0 bit? ] [ first ] if >>drag?\r
 281     ] when drop ;\r
 282 \r
 283 M: gml-viewer-world wasd-mouse-scale drag?>> -1/600. 0.0 ? ;\r
 284 \r
 285 : wrap-in-model ( object -- model )\r
 286     dup model? [ <model> ] unless ;\r
 287 : wrap-in-growable-model ( object -- model )\r
 288     dup model? [\r
 289         dup growable? [ >vector ] unless\r
 290         <model>\r
 291     ] unless ;\r
 292 \r
 293 : gml-viewer ( b-rep selection -- )\r
 294     [ wrap-in-model ] [ wrap-in-growable-model ] bi*\r
 295     '[\r
 296         f T{ game-attributes\r
 297             { world-class gml-viewer-world }\r
 298             { title "GML wireframe viewer" }\r
 299             { pixel-format-attributes {\r
 300                 windowed\r
 301                 double-buffered\r
 302                 T{ depth-bits f 16 }\r
 303             } }\r
 304             { grab-input? f }\r
 305             { use-game-input? t }\r
 306             { use-audio-engine? f }\r
 307             { pref-dim { 1024 768 } }\r
 308             { tick-interval-nanos $[ 30 fps ] }\r
 309         } open-window*\r
 310         _ >>model\r
 311         _ >>selected\r
 312         drop\r
 313     ] with-ui ;\r