extra/gml/viewer/viewer.factor

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