+++ /dev/null
-! Copyright (C) 2010 Erik Charlebois
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types arrays classes.struct combinators
-combinators.short-circuit game.loop game.worlds gpu gpu.buffers
-gpu.util.wasd gpu.framebuffers gpu.render gpu.shaders gpu.state
-gpu.textures gpu.util grouping http.client images images.loader
-io io.encodings.ascii io.files io.files.temp kernel locals math
-math.matrices math.vectors.simd math.parser math.vectors
-method-chains namespaces sequences splitting threads ui ui.gadgets
-ui.gadgets.worlds ui.pixel-formats specialized-arrays
-specialized-vectors literals game.models.collada fry xml xml.traversal sequences.deep
-
-math.bitwise
-opengl.gl
-prettyprint ;
-FROM: alien.c-types => float ;
-SPECIALIZED-ARRAY: float
-SPECIALIZED-VECTOR: uint
-IN: collada.viewer
-
-GLSL-SHADER: collada-vertex-shader vertex-shader
-uniform mat4 mv_matrix, p_matrix;
-uniform vec3 light_position;
-
-attribute vec3 POSITION;
-attribute vec3 NORMAL;
-attribute vec2 TEXCOORD;
-
-varying vec2 texit;
-varying vec3 norm;
-
-void main()
-{
- vec4 position = mv_matrix * vec4(POSITION, 1.0);
- gl_Position = p_matrix * position;
- texit = TEXCOORD;
- norm = NORMAL;
-}
-;
-
-GLSL-SHADER: collada-fragment-shader fragment-shader
-varying vec2 texit;
-varying vec3 norm;
-void main()
-{
- gl_FragColor = vec4(texit, 0, 1) + vec4(norm, 1);
-}
-;
-
-GLSL-PROGRAM: collada-program
- collada-vertex-shader collada-fragment-shader ;
-
-GLSL-SHADER: debug-vertex-shader vertex-shader
-uniform mat4 mv_matrix, p_matrix;
-uniform vec3 light_position;
-
-attribute vec3 POSITION;
-attribute vec3 COLOR;
-varying vec4 color;
-
-void main()
-{
- gl_Position = p_matrix * mv_matrix * vec4(POSITION, 1.0);
- color = vec4(COLOR, 1);
-}
-;
-
-GLSL-SHADER: debug-fragment-shader fragment-shader
-varying vec4 color;
-void main()
-{
- gl_FragColor = color;
-}
-;
-
-GLSL-PROGRAM: debug-program debug-vertex-shader debug-fragment-shader ;
-
-UNIFORM-TUPLE: collada-uniforms < mvp-uniforms
- { "light-position" vec3-uniform f } ;
-
-TUPLE: collada-state
- models
- vertex-arrays
- index-vectors ;
-
-TUPLE: collada-world < wasd-world
- { collada collada-state } ;
-
-VERTEX-FORMAT: collada-vertex
- { "POSITION" float-components 3 f }
- { "NORMAL" float-components 3 f }
- { "TEXCOORD" float-components 2 f } ;
-
-VERTEX-FORMAT: debug-vertex
- { "POSITION" float-components 3 f }
- { "COLOR" float-components 3 f } ;
-
-: <collada-buffers> ( models -- buffers )
-! drop
-! float-array{ -0.5 0 0 1 0 0 0 1 0 0 1 0 0.5 0 0 0 0 1 }
-! uint-array{ 0 1 2 }
-! f model boa 1array
- [
- [ attribute-buffer>> underlying>> static-upload draw-usage vertex-buffer byte-array>buffer ]
- [ index-buffer>> underlying>> static-upload draw-usage index-buffer byte-array>buffer ]
- [ index-buffer>> length ] tri 3array
- ] map ;
-
-: fill-collada-state ( collada-state -- )
- dup models>> <collada-buffers>
- [
- [
- first collada-program <program-instance> collada-vertex buffer>vertex-array
- ] map >>vertex-arrays drop
- ]
- [
- [
- [ second ] [ third ] bi
- '[ _ 0 <buffer-ptr> _ uint-indexes <index-elements> ] call
- ] map >>index-vectors drop
- ] 2bi ;
-
-: <collada-state> ( -- collada-state )
- collada-state new
- "C:/Users/erikc/Downloads/test2.dae"
- #! "/Users/erikc/Documents/mech.dae"
- file>xml "mesh" deep-tags-named [ mesh>models ] map flatten >>models ;
-
-M: collada-world begin-game-world
- init-gpu
- { 0.0 0.0 2.0 } 0 0 set-wasd-view
- <collada-state> [ fill-collada-state drop ] [ >>collada drop ] 2bi ;
-
-: <collada-uniforms> ( world -- uniforms )
- [ wasd-mv-matrix ] [ wasd-p-matrix ] bi
- { -10000.0 10000.0 10000.0 } ! light position
- collada-uniforms boa ;
-
-: draw-line ( world from to color -- )
- [ 3 head ] tri@ dup -rot append -rot append swap append >float-array
- underlying>> stream-upload draw-usage vertex-buffer byte-array>buffer
- debug-program <program-instance> debug-vertex buffer>vertex-array
-
- { 0 1 } >uint-array stream-upload draw-usage index-buffer byte-array>buffer
- 2 '[ _ 0 <buffer-ptr> _ uint-indexes <index-elements> ] call
-
- rot <collada-uniforms>
-
- {
- { "primitive-mode" [ 3drop lines-mode ] }
- { "uniforms" [ nip nip ] }
- { "vertex-array" [ drop drop ] }
- { "indexes" [ drop nip ] }
- } 3<render-set> render ;
-
-: draw-lines ( world lines -- )
- 3 <groups> [ first3 draw-line ] with each ; inline
-
-: draw-axes ( world -- )
- { { 0 0 0 } { 1 0 0 } { 1 0 0 }
- { 0 0 0 } { 0 1 0 } { 0 1 0 }
- { 0 0 0 } { 0 0 1 } { 0 0 1 } } draw-lines ;
-
-: draw-collada ( world -- )
- 0 0 0 0 glClearColor
- 1 glClearDepth
- HEX: ffffffff glClearStencil
- { GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT GL_STENCIL_BUFFER_BIT } flags glClear
-
- [
- #! triangle-lines dup t <triangle-state> set-gpu-state
- face-ccw cull-back <triangle-cull-state> set-gpu-state
- cmp-less <depth-state> set-gpu-state
- [ collada>> vertex-arrays>> ]
- [ collada>> index-vectors>> ]
- [ <collada-uniforms> ]
- tri
- [
- {
- { "primitive-mode" [ 3drop triangles-mode ] }
- { "uniforms" [ nip nip ] }
- { "vertex-array" [ drop drop ] }
- { "indexes" [ drop nip ] }
- } 3<render-set> render
- ] curry 2each
- ]
- [
- cmp-always <depth-state> set-gpu-state
- draw-axes
- ]
- bi ;
-
-M: collada-world draw-world*
- draw-collada ;
-
-M: collada-world wasd-movement-speed drop 1/4. ;
-M: collada-world wasd-near-plane drop 1/32. ;
-M: collada-world wasd-far-plane drop 1024.0 ;
-
-GAME: collada-game {
- { world-class collada-world }
- { title "Collada Viewer" }
- { pixel-format-attributes {
- windowed
- double-buffered
- } }
- { grab-input? t }
- { use-game-input? t }
- { pref-dim { 1024 768 } }
- { tick-interval-micros $[ 60 fps ] }
- } ;
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.crossref help.stylesheet help.topics help.syntax
definitions io prettyprint summary arrays math sequences vocabs strings
-see xml.data hashtables assocs ;
+see xml.data hashtables assocs game.models.collada.private game.models.util ;
IN: game.models.collada
ABOUT: "game.models.collada"
ARTICLE: "game.models.collada" "Conversion of COLLADA assets"
"The " { $vocab-link "game.models.collada" } " vocabulary implements words for converting COLLADA assets to data suitable for use with OpenGL. See the COLLADA documentation at " { $url "http://collada.org" } "." ;
-HELP: model
-{ $class-description "Tuple of a packed attribute buffer, index buffer and vertex format suitable for a single OpenGL draw call." } ;
-
HELP: source
{ $class-description "Tuple of a vertex attribute semantic, offset in triangle index buffer and float data for a single vertex attribute." } ;
HELP: unit-ratio
{ $description "Scaling ratio for the coordinates of the tags being read." } ;
-HELP: indexed-seq
-{ $class-description "A sequence described by a sequence of unique elements and a sequence of indices. The sequence can only be appended to. An associative map is used as a reverse lookup table when appending." } ;
-
-HELP: <indexed-seq>
-{ $values { "dseq-exemplar" sequence } { "iseq-examplar" sequence } { "rassoc-examplar" assoc } }
-{ $class-description "Construct an " { $link indexed-seq } " using the given examplars for the underlying data structures." } ;
-
HELP: string>numbers ( string -- number-seq )
{ $values { "string" string } { "number-seq" sequence } }
{ $description "Splits a string on whitespace and converts the elements to a number sequence." } ;
{ $values { "source-seq" sequence } { "largest-offset+1" number } }
{ $description "Finds the largest offset in the sequence of " { $link source } " tuples and adds 1, which is the index stride for " { $link group-indices } "." } ;
-HELP: <model>
-{ $values { "attribute-buffer" sequence } { "index-buffer" sequence } { "sources" sequence } { "model" model } }
-{ $description "Converts the inputs to a form suitable for use with " { $vocab-link "gpu" } " and constructs a " { $link model } "." } ;
-
HELP: pack-attributes
{ $values { "source-indices" sequence } { "sources" sequence } { "attributes" sequence } }
{ $description "Packs the attributes for a single vertex into a sequence from a set of source data streams." } ;
specialized-arrays.instances.alien.c-types.float
specialized-arrays.instances.alien.c-types.uint splitting xml
xml.data xml.traversal math.order
-namespaces combinators images gpu.shaders io make ;
+namespaces combinators images gpu.shaders io make
+game.models.util io.encodings.ascii game.models.loader ;
IN: game.models.collada
-TUPLE: model attribute-buffer index-buffer vertex-format ;
-TUPLE: source semantic offset data ;
-
-SYMBOLS: up-axis unit-ratio ;
+SINGLETON: collada-models
+"dae" ascii collada-models register-models-class
ERROR: missing-attr tag attr ;
ERROR: missing-child tag child-name ;
-TUPLE: indexed-seq dseq iseq rassoc ;
-INSTANCE: indexed-seq sequence
-
-M: indexed-seq length
- iseq>> length ; inline
-
-M: indexed-seq nth
- [ iseq>> nth ] keep dseq>> nth ; inline
-
-M:: indexed-seq set-nth ( elt n seq -- )
- seq dseq>> :> dseq
- seq iseq>> :> iseq
- seq rassoc>> :> rassoc
- seq length n = not [ seq immutable ] when
- elt rassoc at
- [
- iseq push
- ]
- [
- dseq length
- [ elt rassoc set-at ]
- [ iseq push ] bi
- elt dseq push
- ] if* ; inline
-
-: <indexed-seq> ( dseq-examplar iseq-exampler rassoc-examplar -- indexed-seq )
- indexed-seq new
- swap clone >>rassoc
- swap clone >>iseq
- swap clone >>dseq ;
-
-M: indexed-seq new-resizable
- [ dseq>> ] [ iseq>> ] [ rassoc>> ] tri <indexed-seq>
- dup -rot
- [ [ dseq>> new-resizable ] keep (>>dseq) ]
- [ [ iseq>> new-resizable ] keep (>>iseq) ]
- [ [ rassoc>> clone nip ] keep (>>rassoc) ]
- 2tri ;
-
+<PRIVATE
+TUPLE: source semantic offset data ;
+SYMBOLS: up-axis unit-ratio ;
: string>numbers ( string -- number-seq )
- " \t\n" split [ "" = ] trim [ string>number ] map ;
+ " \t\n" split harvest [ string>number ] map ;
: string>floats ( string -- float-seq )
- " \t\n" split [ "" = ] trim [ string>float ] map ;
+ " \t\n" split harvest [ string>float ] map ;
: x/ ( tag child-name -- child-tag )
[ tag-named ]
[ tags-named ] dip map ; inline
SINGLETONS: x-up y-up z-up ;
-
UNION: rh-up x-up y-up z-up ;
GENERIC: >y-up-axis! ( seq from-axis -- seq )
: largest-offset+1 ( source-seq -- largest-offset+1 )
[ offset>> ] [ max ] map-reduce 1 + ;
-: <model> ( attribute-buffer index-buffer sources -- model )
- [ flatten >float-array ]
- [ flatten >uint-array ]
- [
- [
- {
- [ semantic>> ]
- [ drop float-components ]
- [ data>> first length ]
- [ drop f ]
- } cleave vertex-attribute boa
- ] map
- ] tri* model boa ;
+VERTEX-FORMAT: collada-vertex-format
+ { "POSITION" float-components 3 f }
+ { "NORMAL" float-components 3 f }
+ { "TEXCOORD" float-components 2 f } ;
: pack-attributes ( source-indices sources -- attributes )
[
] V{ } make flatten ;
:: soa>aos ( triangles-indices sources -- attribute-buffer index-buffer )
- [ triangles-indices [ [
- sources pack-attributes ,
- ] each ] each ]
+ [ triangles-indices [ [ sources pack-attributes , ] each ] each ]
V{ } V{ } H{ } <indexed-seq> make [ dseq>> ] [ iseq>> ] bi ;
: triangles>model ( sources vertices triangles-tag -- model )
group-indices
]
[
- [ soa>aos ] keep <model>
+ soa>aos
+ [ flatten >float-array ]
+ [ flatten >uint-array ]
+ bi* collada-vertex-format model boa
] bi ;
: mesh>triangles ( sources vertices mesh-tag -- models )
: mesh>models ( mesh-tag -- models )
[
- { { up-axis y-up } { unit-ratio 0.5 } } [
+ { { up-axis y-up } { unit-ratio 1 } } [
mesh>sources
] bind
]
[ mesh>vertices ]
[ mesh>triangles ] tri ;
+PRIVATE>
+
+M: collada-models stream>models
+ drop read-xml "mesh" deep-tags-named [ mesh>models ] map flatten ;
--- /dev/null
+! Copyright (C) 2010 Your name.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs byte-arrays combinators game.models
+io.encodings.ascii io.files io.pathnames io.streams.byte-array
+kernel namespaces sequences splitting
+strings unicode.case arrays io.encodings ;
+IN: game.models.loader
+
+ERROR: unknown-models-extension extension ;
+
+<PRIVATE
+
+SYMBOL: types
+types [ H{ } clone ] initialize
+
+: models-class ( path -- class )
+ file-extension >lower types get ?at
+ [ unknown-models-extension ] unless second ;
+
+: models-encoding ( path -- encoding )
+ file-extension >lower types get ?at
+ [ unknown-models-extension ] unless first ;
+
+: open-models-file ( path encoding -- stream )
+ <file-reader> ;
+
+PRIVATE>
+
+GENERIC# load-models* 2 ( obj encoding class -- models )
+
+GENERIC: stream>models ( stream class -- models )
+
+: register-models-class ( extension encoding class -- )
+ 2array swap types get set-at ;
+
+: load-models ( path -- models )
+ [ dup models-encoding open-models-file ] [ models-encoding ] [ models-class ] tri load-models* ;
+
+M: byte-array load-models*
+ [ <byte-reader> ] dip stream>models ;
+
+M: decoder load-models* nip stream>models ;
+
+M: string load-models* [ open-models-file ] dip stream>models ;
+
+M: pathname load-models* [ open-models-file ] dip stream>models ;
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.crossref help.stylesheet help.topics help.syntax
+definitions io prettyprint summary arrays math sequences vocabs strings
+see ;
+IN: game.models
+
+HELP: model
+{ $class-description "Tuple of a packed attribute buffer, index buffer and vertex format suitable for a single OpenGL draw call." } ;
--- /dev/null
+! Copyright (C) 2010 Your name.
+! See http://factorcode.org/license.txt for BSD license.
+USING: ;
+IN: game.models
+
+TUPLE: model attribute-buffer index-buffer vertex-format ;
+
--- /dev/null
+! Copyright (C) 2010 Your name.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io io.encodings.ascii math.parser sequences splitting kernel
+assocs io.files combinators math.order math namespaces
+arrays sequences.deep accessors
+specialized-arrays.instances.alien.c-types.float
+specialized-arrays.instances.alien.c-types.uint
+game.models.util gpu.shaders images game.models.loader ;
+IN: game.models.obj
+
+SINGLETON: obj-models
+"obj" ascii obj-models register-models-class
+
+<PRIVATE
+SYMBOLS: v vt vn i ;
+
+VERTEX-FORMAT: obj-vertex-format
+ { "POSITION" float-components 3 f }
+ { "TEXCOORD" float-components 2 f }
+ { "NORMAL" float-components 3 f } ;
+
+: string>floats ( x -- y )
+ [ string>float ] map ;
+
+: string>faces ( x -- y )
+ [ "/" split [ string>number ] map ] map ;
+
+: 3face>aos ( x -- y )
+ dup length {
+ { 3
+ [
+ first3
+ [ 1 - v get nth ]
+ [ 1 - vt get nth ]
+ [ 1 - vn get nth ] tri* 3array flatten
+ ] }
+ { 2
+ [
+ first2
+ [ 1 - v get nth ]
+ [ 1 - vt get nth ] bi* 2array flatten
+ ] }
+ } case ;
+
+
+: 4face>aos ( x -- y z )
+ [ 3 head [ 3face>aos 1array ] map ]
+ [ [ 0 swap nth ] [ 2 swap nth ] [ 3 swap nth ] tri 3array [ 3face>aos 1array ] map ]
+ bi
+ ;
+
+: faces>aos ( x -- y )
+ dup length
+ {
+ { 3 [ [ 3face>aos 1array ] map 1array ] }
+ { 4 [ 4face>aos 2array ] }
+ } case ;
+
+: push* ( x z -- y )
+ [ push ] keep ;
+
+: line>obj ( line -- )
+ " \t\n" split harvest dup
+ length 1 >
+ [
+ [ rest ] [ first ] bi
+ {
+ { "#" [ drop ] }
+ { "v" [ string>floats 3 head v [ push* ] change ] }
+ { "vt" [ string>floats 2 head vt [ push* ] change ] }
+ { "vn" [ string>floats 3 head vn [ push* ] change ] }
+ { "f" [ string>faces faces>aos [ [ i [ push* ] change ] each ] each ] }
+ { "o" [ drop ] }
+ { "g" [ drop ] }
+ { "s" [ drop ] }
+ { "mtllib" [ drop ] }
+ { "usemtl" [ drop ] }
+ } case
+ ]
+ [ drop ] if ;
+
+PRIVATE>
+
+M: obj-models stream>models
+ drop
+ [
+ V{ }
+ [ clone v set ]
+ [ clone vt set ]
+ [ clone vn set ] tri
+ V{ } V{ } H{ } <indexed-seq> i set
+ ] H{ } make-assoc
+ [
+ [ line>obj ] each-stream-line i get
+ ] bind
+ [ dseq>> flatten >float-array ]
+ [ iseq>> flatten >uint-array ] bi obj-vertex-format model boa 1array ;
+
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.crossref help.stylesheet help.topics help.syntax
+definitions io prettyprint summary arrays math sequences vocabs strings
+see xml.data hashtables assocs ;
+IN: game.models.util
+
+HELP: indexed-seq
+{ $class-description "A sequence described by a sequence of unique elements and a sequence of indices. The sequence can only be appended to. An associative map is used as a reverse lookup table when appending." } ;
+
+HELP: <indexed-seq>
+{ $values { "dseq-exemplar" sequence } { "iseq-examplar" sequence } { "rassoc-examplar" assoc } }
+{ $class-description "Construct an " { $link indexed-seq } " using the given examplars for the underlying data structures." } ;
--- /dev/null
+USING: game.models.util tools.test make accessors kernel ;
+IN: game.models.util.tests
+
+[ V{ 1 2 3 4 } ] [
+ [ 1 , 1 , 2 , 3 , 3 , 4 , ]
+ V{ } V{ } H{ } <indexed-seq> make
+ dseq>>
+] unit-test
+
+[ V{ 0 0 1 2 2 3 } ] [
+ [ 1 , 1 , 2 , 3 , 3 , 4 , ]
+ V{ } V{ } H{ } <indexed-seq> make
+ iseq>>
+] unit-test
--- /dev/null
+! Copyright (C) 2010 Your name.
+! See http://factorcode.org/license.txt for BSD license.
+USING: sequences accessors kernel locals assocs ;
+IN: game.models.util
+
+TUPLE: model attribute-buffer index-buffer vertex-format ;
+
+TUPLE: indexed-seq dseq iseq rassoc ;
+INSTANCE: indexed-seq sequence
+
+M: indexed-seq length
+ iseq>> length ; inline
+
+M: indexed-seq nth
+ [ iseq>> nth ] keep dseq>> nth ; inline
+
+M:: indexed-seq set-nth ( elt n seq -- )
+ seq dseq>> :> dseq
+ seq iseq>> :> iseq
+ seq rassoc>> :> rassoc
+ seq length n = not [ seq immutable ] when
+ elt rassoc at
+ [
+ iseq push
+ ]
+ [
+ dseq length
+ [ elt rassoc set-at ]
+ [ iseq push ] bi
+ elt dseq push
+ ] if* ; inline
+
+: <indexed-seq> ( dseq-examplar iseq-exampler rassoc-examplar -- indexed-seq )
+ indexed-seq new
+ swap clone >>rassoc
+ swap clone >>iseq
+ swap clone >>dseq ;
+
+M: indexed-seq new-resizable
+ [ dseq>> ] [ iseq>> ] [ rassoc>> ] tri <indexed-seq>
+ dup -rot
+ [ [ dseq>> new-resizable ] keep (>>dseq) ]
+ [ [ iseq>> new-resizable ] keep (>>iseq) ]
+ [ [ rassoc>> clone nip ] keep (>>rassoc) ]
+ 2tri ;
+
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types arrays classes.struct combinators
+combinators.short-circuit game.loop game.worlds gpu gpu.buffers
+gpu.util.wasd gpu.framebuffers gpu.render gpu.shaders gpu.state
+gpu.textures gpu.util grouping http.client images images.loader
+io io.encodings.ascii io.files io.files.temp kernel locals math
+math.matrices math.vectors.simd math.parser math.vectors
+method-chains namespaces sequences splitting threads ui ui.gadgets
+ui.gadgets.worlds ui.pixel-formats specialized-arrays
+specialized-vectors literals fry xml
+xml.traversal sequences.deep destructors math.bitwise opengl.gl
+game.models.obj game.models.loader game.models.collada ;
+FROM: alien.c-types => float ;
+SPECIALIZED-ARRAY: float
+SPECIALIZED-VECTOR: uint
+IN: model-viewer
+
+GLSL-SHADER: model-vertex-shader vertex-shader
+uniform mat4 mv_matrix, p_matrix;
+uniform vec3 light_position;
+
+attribute vec3 POSITION;
+attribute vec3 NORMAL;
+attribute vec2 TEXCOORD;
+
+varying vec2 texit;
+varying vec3 norm;
+
+void main()
+{
+ vec4 position = mv_matrix * vec4(POSITION, 1.0);
+ gl_Position = p_matrix * position;
+ texit = TEXCOORD;
+ norm = NORMAL;
+}
+;
+
+GLSL-SHADER: model-fragment-shader fragment-shader
+varying vec2 texit;
+varying vec3 norm;
+void main()
+{
+ gl_FragColor = vec4(texit, 0, 1) + vec4(norm, 1);
+}
+;
+
+GLSL-PROGRAM: model-program
+ model-vertex-shader model-fragment-shader ;
+
+GLSL-SHADER: debug-vertex-shader vertex-shader
+uniform mat4 mv_matrix, p_matrix;
+uniform vec3 light_position;
+
+attribute vec3 POSITION;
+attribute vec3 COLOR;
+varying vec4 color;
+
+void main()
+{
+ gl_Position = p_matrix * mv_matrix * vec4(POSITION, 1.0);
+ color = vec4(COLOR, 1);
+}
+;
+
+GLSL-SHADER: debug-fragment-shader fragment-shader
+varying vec4 color;
+void main()
+{
+ gl_FragColor = color;
+}
+;
+
+GLSL-PROGRAM: debug-program debug-vertex-shader debug-fragment-shader ;
+
+UNIFORM-TUPLE: model-uniforms < mvp-uniforms
+ { "light-position" vec3-uniform f } ;
+
+TUPLE: model-state
+ models
+ vertex-arrays
+ index-vectors ;
+
+TUPLE: model-world < wasd-world
+ { model-state model-state } ;
+
+VERTEX-FORMAT: model-vertex
+ { "POSITION" float-components 3 f }
+ { "NORMAL" float-components 3 f }
+ { "TEXCOORD" float-components 2 f } ;
+
+VERTEX-FORMAT: debug-vertex
+ { "POSITION" float-components 3 f }
+ { "COLOR" float-components 3 f } ;
+
+TUPLE: vbo vertex-buffer index-buffer index-count vertex-format ;
+
+: <model-buffers> ( models -- buffers )
+ [
+ {
+ [ attribute-buffer>> underlying>> static-upload draw-usage vertex-buffer byte-array>buffer ]
+ [ index-buffer>> underlying>> static-upload draw-usage index-buffer byte-array>buffer ]
+ [ index-buffer>> length ]
+ [ vertex-format>> ]
+ } cleave vbo boa
+ ] map ;
+
+: fill-model-state ( model-state -- )
+ dup models>> <model-buffers>
+ [
+ [
+ [ vertex-buffer>> model-program <program-instance> ]
+ [ vertex-format>> ] bi buffer>vertex-array
+ ] map >>vertex-arrays drop
+ ]
+ [
+ [
+ [ index-buffer>> ] [ index-count>> ] bi
+ '[ _ 0 <buffer-ptr> _ uint-indexes <index-elements> ] call
+ ] map >>index-vectors drop
+ ] 2bi ;
+
+: model-files ( -- files )
+ { "C:/Users/erikc/Downloads/test2.dae"
+ "C:/Users/erikc/Downloads/Sponza.obj" } ;
+
+: <model-state> ( -- model-state )
+ model-state new
+ model-files [ load-models ] [ append ] map-reduce >>models ;
+
+M: model-world begin-game-world
+ init-gpu
+ { 0.0 0.0 2.0 } 0 0 set-wasd-view
+ <model-state> [ fill-model-state drop ] [ >>model-state drop ] 2bi ;
+
+: <model-uniforms> ( world -- uniforms )
+ [ wasd-mv-matrix ] [ wasd-p-matrix ] bi
+ { -10000.0 10000.0 10000.0 } ! light position
+ model-uniforms boa ;
+
+: draw-line ( world from to color -- )
+ [ 3 head ] tri@ dup -rot append -rot append swap append >float-array
+ underlying>> stream-upload draw-usage vertex-buffer byte-array>buffer
+ debug-program <program-instance> debug-vertex buffer>vertex-array
+
+ { 0 1 } >uint-array stream-upload draw-usage index-buffer byte-array>buffer
+ 2 '[ _ 0 <buffer-ptr> _ uint-indexes <index-elements> ] call
+
+ rot <model-uniforms>
+
+ {
+ { "primitive-mode" [ 3drop lines-mode ] }
+ { "uniforms" [ nip nip ] }
+ { "vertex-array" [ drop drop ] }
+ { "indexes" [ drop nip ] }
+ } 3<render-set> render ;
+
+: draw-lines ( world lines -- )
+ 3 <groups> [ first3 draw-line ] with each ; inline
+
+: draw-axes ( world -- )
+ { { 0 0 0 } { 1 0 0 } { 1 0 0 }
+ { 0 0 0 } { 0 1 0 } { 0 1 0 }
+ { 0 0 0 } { 0 0 1 } { 0 0 1 } } draw-lines ;
+
+: draw-model ( world -- )
+ 0 0 0 0 glClearColor
+ 1 glClearDepth
+ HEX: ffffffff glClearStencil
+ { GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT GL_STENCIL_BUFFER_BIT } flags glClear
+
+ [
+ triangle-fill dup t <triangle-state> set-gpu-state
+ face-ccw cull-back <triangle-cull-state> set-gpu-state
+
+ cmp-less <depth-state> set-gpu-state
+ [ model-state>> vertex-arrays>> ]
+ [ model-state>> index-vectors>> ]
+ [ <model-uniforms> ]
+ tri
+ [
+ {
+ { "primitive-mode" [ 3drop triangles-mode ] }
+ { "uniforms" [ nip nip ] }
+ { "vertex-array" [ drop drop ] }
+ { "indexes" [ drop nip ] }
+ } 3<render-set> render
+ ] curry 2each
+ ]
+ [
+ cmp-always <depth-state> set-gpu-state
+ draw-axes
+ ]
+ bi ;
+
+M: model-world draw-world*
+ draw-model ;
+
+M: model-world wasd-movement-speed drop 1/4. ;
+M: model-world wasd-near-plane drop 1/32. ;
+M: model-world wasd-far-plane drop 1024.0 ;
+
+GAME: model-viewer {
+ { world-class model-world }
+ { title "Model Viewer" }
+ { pixel-format-attributes { windowed double-buffered } }
+ { grab-input? t }
+ { use-game-input? t }
+ { pref-dim { 1024 768 } }
+ { tick-interval-micros $[ 60 fps ] }
+ } ;