.rs.res:
rc $<
-all: factor.com factor.exe
+all: factor.com factor.exe libfactor-ffi-test.dll
libfactor-ffi-test.dll: vm/ffi_test.obj
link $(LINK_FLAGS) /out:libfactor-ffi-test.dll /dll vm/ffi_test.obj
alien.data alien.fortran alien.fortran.private alien.strings
classes.struct arrays assocs byte-arrays combinators fry
generalizations io.encodings.ascii kernel macros
-macros.expander namespaces sequences shuffle tools.test ;
+macros.expander namespaces sequences shuffle tools.test vocabs.parser ;
QUALIFIED-WITH: alien.c-types c
IN: alien.fortran.tests
[ "complex*16" fortran-type>c-type ] unit-test
[ fortran_test_record ]
- [ "fortran_test_record" fortran-type>c-type ] unit-test
+ [
+ [
+ "alien.fortran.tests" use-vocab
+ "fortran_test_record" fortran-type>c-type
+ ] with-manifest
+ ] unit-test
! fortran-arg-type>c-type
[ "integer(*)" fortran-arg-type>c-type ] unit-test
[ c:void* { } ]
- [ "fortran_test_record" fortran-arg-type>c-type ] unit-test
+ [
+ [
+ "alien.fortran.tests" use-vocab
+ "fortran_test_record" fortran-arg-type>c-type
+ ] with-manifest
+ ] unit-test
[ c:char* { } ]
[ "character" fortran-arg-type>c-type ] unit-test
[ "integer(*)" fortran-ret-type>c-type ] unit-test
[ c:void { c:void* } ]
- [ "fortran_test_record" fortran-ret-type>c-type ] unit-test
+ [
+ [
+ "alien.fortran.tests" use-vocab
+ "fortran_test_record" fortran-ret-type>c-type
+ ] with-manifest
+ ] unit-test
! fortran-sig>c-sig
+++ /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 ] }
- } ;
combinators classes.algebra alien alien.c-types
alien.strings alien.arrays alien.complex alien.libraries sets libc
continuations.private fry cpu.architecture classes classes.struct locals
-source-files.errors slots parser generic.parser
+source-files.errors slots parser generic.parser strings
compiler.errors
compiler.alien
compiler.constants
: box-return* ( node -- )
return>> [ ] [ box-return %push-stack ] if-void ;
+GENERIC# dlsym-valid? 1 ( symbols dll -- ? )
+
+M: string dlsym-valid? dlsym ;
+
+M: array dlsym-valid? '[ _ dlsym ] any? ;
+
: check-dlsym ( symbols dll -- )
dup dll-valid? [
- dupd '[ _ dlsym ] any?
+ dupd dlsym-valid?
[ drop ] [ compiling-word get no-such-symbol ] if
] [
dll-path compiling-word get no-such-library drop
] if ;
-: stdcall-mangle ( symbol params -- symbol )
- parameters>> parameter-offsets drop number>string "@" glue ;
+: stdcall-mangle ( params -- symbols )
+ [ function>> ] [ parameters>> parameter-offsets drop number>string ] bi
+ [ drop ] [ "@" glue ] [ "@" glue "_" prepend ] 2tri
+ 3array ;
: alien-invoke-dlsym ( params -- symbols dll )
- [ [ function>> dup ] keep stdcall-mangle 2array ]
- [ library>> library dup [ dll>> ] when ]
+ [ dup abi>> "stdcall" = [ stdcall-mangle ] [ function>> ] if ]
+ [ library>> load-library ]
bi 2dup check-dlsym ;
M: ##alien-invoke generate-insn
[ ] [ stack-frame-bustage 2drop ] unit-test
+! C99 tests
+os windows? [
+
FUNCTION: complex-float ffi_test_45 ( int x ) ;
[ C{ 3.0 0.0 } ] [ 3 ffi_test_45 ] unit-test
ffi_test_48
] unit-test
+] unless
+
! Regression: calling an undefined function would raise a protection fault
FUNCTION: void this_does_not_exist ( ) ;
func "libm" load-library %alien-invoke
dst float-function-return ;
+: stdcall? ( params -- ? )
+ abi>> "stdcall" = ;
+
+: funny-large-struct-return? ( params -- ? )
+ #! MINGW ABI incompatibility disaster
+ [ return>> large-struct? ]
+ [ abi>> "mingw" = os windows? not or ]
+ bi and ;
+
M: x86.32 %cleanup ( params -- )
#! a) If we just called an stdcall function in Windows, it
#! cleaned up the stack frame for us. But we don't want that
#! b) If we just called a function returning a struct, we
#! have to fix ESP.
{
- {
- [ dup abi>> "stdcall" = ]
- [ drop ESP stack-frame get params>> SUB ]
- } {
- [ dup return>> large-struct? ]
- [ drop EAX PUSH ]
- }
+ { [ dup stdcall? ] [ drop ESP stack-frame get params>> SUB ] }
+ { [ dup funny-large-struct-return? ] [ drop EAX PUSH ] }
[ drop ]
} cond ;
#! b) If the callback is returning a large struct, we have
#! to fix ESP.
{
- { [ dup abi>> "stdcall" = ] [
- <alien-stack-frame>
- [ params>> ] [ return>> ] bi +
- ] }
- { [ dup return>> large-struct? ] [ drop 4 ] }
+ { [ dup stdcall? ] [ <alien-stack-frame> [ params>> ] [ return>> ] bi + ] }
+ { [ dup funny-large-struct-return? ] [ drop 4 ] }
[ drop 0 ]
} cond ;
! 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 ] }
+ } ;
return r;
}
-F_STDCALL int ffi_test_18(int x, int y, int z, int t)
+FACTOR_STDCALL(int) ffi_test_18(int x, int y, int z, int t)
{
return x + y + z * t;
}
-F_STDCALL struct bar ffi_test_19(long x, long y, long z)
+FACTOR_STDCALL(struct bar) ffi_test_19(long x, long y, long z)
{
struct bar r;
r.x = x; r.y = y; r.z = z;
return retval;
}
+/* C99 features */
+#ifndef _MSC_VER
+
_Complex float ffi_test_45(int x)
{
return x;
{
return x.parents;
}
+
+#endif
-#ifdef _MSC_VER
- #define WINDOWS
+#if defined(_MSC_VER)
+ #define FACTOR_STDCALL(return_type) return_type __stdcall
+#elif defined(i386) || defined(__i386) || defined(__i386__)
+ #define FACTOR_STDCALL(return_type) __attribute__((stdcall)) return_type
#else
- #include <stdbool.h>
-#endif
-
-#if defined(i386) || defined(__i386) || defined(__i386__) || defined(WIN32)
- #define F_STDCALL __attribute__((stdcall))
-#else
- #define F_STDCALL
+ #define FACTOR_STDCALL(return_type) return_type
#endif
#if defined(__APPLE__)
- #define F_EXPORT __attribute__((visibility("default")))
-#elif defined(WINDOWS)
- #define F_EXPORT __declspec(dllexport)
+ #define FACTOR_EXPORT __attribute__((visibility("default")))
+#elif defined(WIN32) || defined(_MSC_VER)
+ #define FACTOR_EXPORT __declspec(dllexport)
#else
- #define F_EXPORT
+ #define FACTOR_EXPORT
#endif
-F_EXPORT void ffi_test_0(void);
-F_EXPORT int ffi_test_1(void);
-F_EXPORT int ffi_test_2(int x, int y);
-F_EXPORT int ffi_test_3(int x, int y, int z, int t);
-F_EXPORT float ffi_test_4(void);
-F_EXPORT double ffi_test_5(void);
-F_EXPORT double ffi_test_6(float x, float y);
-F_EXPORT double ffi_test_7(double x, double y);
-F_EXPORT double ffi_test_8(double x, float y, double z, float t, int w);
-F_EXPORT int ffi_test_9(int a, int b, int c, int d, int e, int f, int g);
-F_EXPORT int ffi_test_10(int a, int b, double c, int d, float e, int f, int g, int h);
+FACTOR_EXPORT void ffi_test_0(void);
+FACTOR_EXPORT int ffi_test_1(void);
+FACTOR_EXPORT int ffi_test_2(int x, int y);
+FACTOR_EXPORT int ffi_test_3(int x, int y, int z, int t);
+FACTOR_EXPORT float ffi_test_4(void);
+FACTOR_EXPORT double ffi_test_5(void);
+FACTOR_EXPORT double ffi_test_6(float x, float y);
+FACTOR_EXPORT double ffi_test_7(double x, double y);
+FACTOR_EXPORT double ffi_test_8(double x, float y, double z, float t, int w);
+FACTOR_EXPORT int ffi_test_9(int a, int b, int c, int d, int e, int f, int g);
+FACTOR_EXPORT int ffi_test_10(int a, int b, double c, int d, float e, int f, int g, int h);
struct foo { int x, y; };
-F_EXPORT int ffi_test_11(int a, struct foo b, int c);
+FACTOR_EXPORT int ffi_test_11(int a, struct foo b, int c);
struct rect { float x, y, w, h; };
-F_EXPORT int ffi_test_12(int a, int b, struct rect c, int d, int e, int f);
-F_EXPORT int ffi_test_13(int a, int b, int c, int d, int e, int f, int g, int h, int i, int j, int k);
-F_EXPORT struct foo ffi_test_14(int x, int y);
-F_EXPORT char *ffi_test_15(char *x, char *y);
+FACTOR_EXPORT int ffi_test_12(int a, int b, struct rect c, int d, int e, int f);
+FACTOR_EXPORT int ffi_test_13(int a, int b, int c, int d, int e, int f, int g, int h, int i, int j, int k);
+FACTOR_EXPORT struct foo ffi_test_14(int x, int y);
+FACTOR_EXPORT char *ffi_test_15(char *x, char *y);
struct bar { long x, y, z; };
-F_EXPORT struct bar ffi_test_16(long x, long y, long z);
+FACTOR_EXPORT struct bar ffi_test_16(long x, long y, long z);
struct tiny { int x; };
-F_EXPORT struct tiny ffi_test_17(int x);
-F_EXPORT F_STDCALL int ffi_test_18(int x, int y, int z, int t);
-F_EXPORT F_STDCALL struct bar ffi_test_19(long x, long y, long z);
-F_EXPORT void ffi_test_20(double x1, double x2, double x3,
+FACTOR_EXPORT struct tiny ffi_test_17(int x);
+FACTOR_EXPORT FACTOR_STDCALL(int) ffi_test_18(int x, int y, int z, int t);
+FACTOR_EXPORT FACTOR_STDCALL(struct bar) ffi_test_19(long x, long y, long z);
+FACTOR_EXPORT void ffi_test_20(double x1, double x2, double x3,
double y1, double y2, double y3,
double z1, double z2, double z3);
-F_EXPORT long long ffi_test_21(long x, long y);
-F_EXPORT long ffi_test_22(long x, long long y, long long z);
-F_EXPORT float ffi_test_23(float x[3], float y[3]);
+FACTOR_EXPORT long long ffi_test_21(long x, long y);
+FACTOR_EXPORT long ffi_test_22(long x, long long y, long long z);
+FACTOR_EXPORT float ffi_test_23(float x[3], float y[3]);
struct test_struct_1 { char x; };
-F_EXPORT struct test_struct_1 ffi_test_24(void);
+FACTOR_EXPORT struct test_struct_1 ffi_test_24(void);
struct test_struct_2 { char x, y; };
-F_EXPORT struct test_struct_2 ffi_test_25(void);
+FACTOR_EXPORT struct test_struct_2 ffi_test_25(void);
struct test_struct_3 { char x, y, z; };
-F_EXPORT struct test_struct_3 ffi_test_26(void);
+FACTOR_EXPORT struct test_struct_3 ffi_test_26(void);
struct test_struct_4 { char x, y, z, a; };
-F_EXPORT struct test_struct_4 ffi_test_27(void);
+FACTOR_EXPORT struct test_struct_4 ffi_test_27(void);
struct test_struct_5 { char x, y, z, a, b; };
-F_EXPORT struct test_struct_5 ffi_test_28(void);
+FACTOR_EXPORT struct test_struct_5 ffi_test_28(void);
struct test_struct_6 { char x, y, z, a, b, c; };
-F_EXPORT struct test_struct_6 ffi_test_29(void);
+FACTOR_EXPORT struct test_struct_6 ffi_test_29(void);
struct test_struct_7 { char x, y, z, a, b, c, d; };
-F_EXPORT struct test_struct_7 ffi_test_30(void);
-F_EXPORT int ffi_test_31(int x0, int x1, int x2, int x3, int x4, int x5, int x6, int x7, int x8, int x9, int x10, int x11, int x12, int x13, int x14, int x15, int x16, int x17, int x18, int x19, int x20, int x21, int x22, int x23, int x24, int x25, int x26, int x27, int x28, int x29, int x30, int x31, int x32, int x33, int x34, int x35, int x36, int x37, int x38, int x39, int x40, int x41);
-F_EXPORT float ffi_test_31_point_5(float x0, float x1, float x2, float x3, float x4, float x5, float x6, float x7, float x8, float x9, float x10, float x11, float x12, float x13, float x14, float x15, float x16, float x17, float x18, float x19, float x20, float x21, float x22, float x23, float x24, float x25, float x26, float x27, float x28, float x29, float x30, float x31, float x32, float x33, float x34, float x35, float x36, float x37, float x38, float x39, float x40, float x41);
+FACTOR_EXPORT struct test_struct_7 ffi_test_30(void);
+FACTOR_EXPORT int ffi_test_31(int x0, int x1, int x2, int x3, int x4, int x5, int x6, int x7, int x8, int x9, int x10, int x11, int x12, int x13, int x14, int x15, int x16, int x17, int x18, int x19, int x20, int x21, int x22, int x23, int x24, int x25, int x26, int x27, int x28, int x29, int x30, int x31, int x32, int x33, int x34, int x35, int x36, int x37, int x38, int x39, int x40, int x41);
+FACTOR_EXPORT float ffi_test_31_point_5(float x0, float x1, float x2, float x3, float x4, float x5, float x6, float x7, float x8, float x9, float x10, float x11, float x12, float x13, float x14, float x15, float x16, float x17, float x18, float x19, float x20, float x21, float x22, float x23, float x24, float x25, float x26, float x27, float x28, float x29, float x30, float x31, float x32, float x33, float x34, float x35, float x36, float x37, float x38, float x39, float x40, float x41);
struct test_struct_8 { double x; double y; };
-F_EXPORT double ffi_test_32(struct test_struct_8 x, int y);
+FACTOR_EXPORT double ffi_test_32(struct test_struct_8 x, int y);
struct test_struct_9 { float x; float y; };
-F_EXPORT double ffi_test_33(struct test_struct_9 x, int y);
+FACTOR_EXPORT double ffi_test_33(struct test_struct_9 x, int y);
struct test_struct_10 { float x; int y; };
-F_EXPORT double ffi_test_34(struct test_struct_10 x, int y);
+FACTOR_EXPORT double ffi_test_34(struct test_struct_10 x, int y);
struct test_struct_11 { int x; int y; };
-F_EXPORT double ffi_test_35(struct test_struct_11 x, int y);
+FACTOR_EXPORT double ffi_test_35(struct test_struct_11 x, int y);
struct test_struct_12 { int a; double x; };
-F_EXPORT double ffi_test_36(struct test_struct_12 x);
+FACTOR_EXPORT double ffi_test_36(struct test_struct_12 x);
-F_EXPORT void ffi_test_36_point_5(void);
+FACTOR_EXPORT void ffi_test_36_point_5(void);
-F_EXPORT int ffi_test_37(int (*f)(int, int, int));
+FACTOR_EXPORT int ffi_test_37(int (*f)(int, int, int));
-F_EXPORT unsigned long long ffi_test_38(unsigned long long x, unsigned long long y);
+FACTOR_EXPORT unsigned long long ffi_test_38(unsigned long long x, unsigned long long y);
struct test_struct_13 { float x1, x2, x3, x4, x5, x6; };
-F_EXPORT int ffi_test_39(long a, long b, struct test_struct_13 s);
+FACTOR_EXPORT int ffi_test_39(long a, long b, struct test_struct_13 s);
struct test_struct_14 { double x1, x2; };
-F_EXPORT struct test_struct_14 ffi_test_40(double x1, double x2);
+FACTOR_EXPORT struct test_struct_14 ffi_test_40(double x1, double x2);
-F_EXPORT struct test_struct_12 ffi_test_41(int a, double x);
+FACTOR_EXPORT struct test_struct_12 ffi_test_41(int a, double x);
struct test_struct_15 { float x, y; };
-F_EXPORT struct test_struct_15 ffi_test_42(float x, float y);
+FACTOR_EXPORT struct test_struct_15 ffi_test_42(float x, float y);
struct test_struct_16 { float x; int a; };
-F_EXPORT struct test_struct_16 ffi_test_43(float x, int a);
+FACTOR_EXPORT struct test_struct_16 ffi_test_43(float x, int a);
+
+FACTOR_EXPORT struct test_struct_14 ffi_test_44();
-F_EXPORT struct test_struct_14 ffi_test_44();
+/* C99 features */
+#ifndef _MSC_VER
-F_EXPORT _Complex float ffi_test_45(int x);
+#include <stdbool.h>
-F_EXPORT _Complex double ffi_test_46(int x);
+FACTOR_EXPORT _Complex float ffi_test_45(int x);
-F_EXPORT _Complex float ffi_test_47(_Complex float x, _Complex double y);
+FACTOR_EXPORT _Complex double ffi_test_46(int x);
+
+FACTOR_EXPORT _Complex float ffi_test_47(_Complex float x, _Complex double y);
struct bool_field_test {
char *name;
short parents;
};
-F_EXPORT short ffi_test_48(struct bool_field_test x);
+FACTOR_EXPORT short ffi_test_48(struct bool_field_test x);
+
+#endif
projects / factor.git / commitdiff