Merge branch 'master' of git://factorcode.org/git/factor

db4
Joe Groff 2010-02-07 00:13:44 -08:00
commit 72f7f472b9
32 changed files with 454 additions and 308 deletions

View File

@ -97,11 +97,11 @@ CONSTANT: ctx-reg 16
rs-reg ctx-reg context-retainstack-offset LWZ ; rs-reg ctx-reg context-retainstack-offset LWZ ;
[ [
0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel 0 12 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel
11 3 profile-count-offset LWZ 11 12 profile-count-offset LWZ
11 11 1 tag-fixnum ADDI 11 11 1 tag-fixnum ADDI
11 3 profile-count-offset STW 11 12 profile-count-offset STW
11 3 word-code-offset LWZ 11 12 word-code-offset LWZ
11 11 compiled-header-size ADDI 11 11 compiled-header-size ADDI
11 MTCTR 11 MTCTR
BCTR BCTR

View File

@ -28,7 +28,7 @@ IN: bootstrap.x86
[ [
! load entry point ! load entry point
safe-reg -7 [] LEA safe-reg 0 MOV rc-absolute-cell rt-this jit-rel
! save stack frame size ! save stack frame size
stack-frame-size PUSH stack-frame-size PUSH
! push entry point ! push entry point

View File

@ -238,7 +238,7 @@ ERROR: bad-tga-unsupported ;
] unless ] unless
] ignore-errors ] ignore-errors
#! Only 24-bit uncompressed RGB and 32-bit uncompressed ARGB are supported. #! Only 24-bit uncompressed BGR and 32-bit uncompressed BGRA are supported.
#! Other formats would need to be converted to work within the image class. #! Other formats would need to be converted to work within the image class.
map-type 0 = [ bad-tga-unsupported ] unless map-type 0 = [ bad-tga-unsupported ] unless
image-type 2 = [ bad-tga-unsupported ] unless image-type 2 = [ bad-tga-unsupported ] unless
@ -247,7 +247,7 @@ ERROR: bad-tga-unsupported ;
#! Create image instance #! Create image instance
image new image new
alpha-bits 0 = [ RGB ] [ ARGB ] if >>component-order alpha-bits 0 = [ BGR ] [ BGRA ] if >>component-order
{ image-width image-height } >>dim { image-width image-height } >>dim
pixel-order 0 = >>upside-down? pixel-order 0 = >>upside-down?
image-data >>bitmap image-data >>bitmap
@ -259,7 +259,7 @@ M: tga-image stream>image
M: tga-image image>stream M: tga-image image>stream
drop drop
[ [
component-order>> { RGB ARGB } member? [ bad-tga-unsupported ] unless component-order>> { BGRA BGRA } member? [ bad-tga-unsupported ] unless
] keep ] keep
B{ 0 } write #! id-length B{ 0 } write #! id-length
@ -272,15 +272,15 @@ M: tga-image image>stream
[ dim>> second 2 >le write ] [ dim>> second 2 >le write ]
[ component-order>> [ component-order>>
{ {
{ RGB [ B{ 24 } write ] } { BGR [ B{ 24 } write ] }
{ ARGB [ B{ 32 } write ] } { BGRA [ B{ 32 } write ] }
} case } case
] ]
[ [
dup component-order>> dup component-order>>
{ {
{ RGB [ 0 ] } { BGR [ 0 ] }
{ ARGB [ 8 ] } { BGRA [ 8 ] }
} case swap } case swap
upside-down?>> [ 0 ] [ 2 ] if 3 shift bitor upside-down?>> [ 0 ] [ 2 ] if 3 shift bitor
1 >le write 1 >le write

View File

@ -3,7 +3,7 @@ USING: io.files io.files.temp io.directories io.pathnames
tools.test io.launcher arrays io namespaces continuations math tools.test io.launcher arrays io namespaces continuations math
io.encodings.binary io.encodings.ascii accessors kernel io.encodings.binary io.encodings.ascii accessors kernel
sequences io.encodings.utf8 destructors io.streams.duplex locals sequences io.encodings.utf8 destructors io.streams.duplex locals
concurrency.promises threads unix.process calendar ; concurrency.promises threads unix.process calendar unix ;
[ ] [ [ ] [
[ "launcher-test-1" temp-file delete-file ] ignore-errors [ "launcher-test-1" temp-file delete-file ] ignore-errors
@ -134,7 +134,7 @@ concurrency.promises threads unix.process calendar ;
[ p fulfill ] [ wait-for-process s fulfill ] bi [ p fulfill ] [ wait-for-process s fulfill ] bi
] in-thread ] in-thread
p 1 seconds ?promise-timeout handle>> 9 kill drop p 1 seconds ?promise-timeout handle>> kill-process*
s ?promise 0 = s ?promise 0 =
] ]
] unit-test ] unit-test

View File

@ -91,7 +91,7 @@ M: unix kill-process* ( pid -- )
TUPLE: signal n ; TUPLE: signal n ;
: code>status ( code -- obj ) : code>status ( code -- obj )
dup WIFEXITED [ WEXITSTATUS ] [ WTERMSIG signal boa ] if ; dup WIFSIGNALED [ WTERMSIG signal boa ] [ WEXITSTATUS ] if ;
M: unix wait-for-processes ( -- ? ) M: unix wait-for-processes ( -- ? )
0 <int> -1 over WNOHANG waitpid 0 <int> -1 over WNOHANG waitpid

View File

@ -502,6 +502,7 @@ SYMBOL: nc-buttons
{ {
{ APPCOMMAND_BROWSER_BACKWARD [ pick window left-action send-action ] } { APPCOMMAND_BROWSER_BACKWARD [ pick window left-action send-action ] }
{ APPCOMMAND_BROWSER_FORWARD [ pick window right-action send-action ] } { APPCOMMAND_BROWSER_FORWARD [ pick window right-action send-action ] }
[ drop ]
} case 3drop ; } case 3drop ;
: handle-wm-buttondown ( hWnd uMsg wParam lParam -- ) : handle-wm-buttondown ( hWnd uMsg wParam lParam -- )

View File

@ -49,7 +49,7 @@ HELP: line-metrics
{ $contract "Outputs a " { $link metrics } " object with text measurements." } ; { $contract "Outputs a " { $link metrics } " object with text measurements." } ;
ARTICLE: "text-rendering" "Rendering text" ARTICLE: "text-rendering" "Rendering text"
"The " { $vocab-link "ui.text" } " vocabulary provides a cross-platform interface to the operating system's native font rendering engine. Currently, it uses Core Text on Mac OS X and FreeType on Windows and X11." "The " { $vocab-link "ui.text" } " vocabulary provides a cross-platform interface to the operating system's native font rendering engine. Currently, it uses Core Text on Mac OS X, Uniscribe on Windows and Pango on X11."
{ $subsections "fonts" } { $subsections "fonts" }
"Measuring text:" "Measuring text:"
{ $subsections { $subsections

View File

@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.crossref help.stylesheet help.topics help.syntax USING: help.markup help.crossref help.stylesheet help.topics help.syntax
definitions io prettyprint summary arrays math sequences vocabs strings definitions io prettyprint summary arrays math sequences vocabs strings
see xml.data hashtables assocs game.models.collada.private game.models.util ; see xml.data hashtables assocs game.models.collada.private game.models
game.models.util ;
IN: game.models.collada IN: game.models.collada
ABOUT: "game.models.collada" ABOUT: "game.models.collada"

View File

@ -5,7 +5,7 @@ locals math math.parser sequences sequences.deep
specialized-arrays.instances.alien.c-types.float specialized-arrays.instances.alien.c-types.float
specialized-arrays.instances.alien.c-types.uint splitting xml specialized-arrays.instances.alien.c-types.uint splitting xml
xml.data xml.traversal math.order xml.data xml.traversal math.order
namespaces combinators images gpu.shaders io make namespaces combinators images gpu.shaders io make game.models
game.models.util io.encodings.ascii game.models.loader ; game.models.util io.encodings.ascii game.models.loader ;
IN: game.models.collada IN: game.models.collada
@ -152,7 +152,7 @@ VERTEX-FORMAT: collada-vertex-format
soa>aos soa>aos
[ flatten >float-array ] [ flatten >float-array ]
[ flatten >uint-array ] [ flatten >uint-array ]
bi* collada-vertex-format model boa bi* collada-vertex-format f model boa
] bi ; ] bi ;
: mesh>triangles ( sources vertices mesh-tag -- models ) : mesh>triangles ( sources vertices mesh-tag -- models )

View File

@ -6,4 +6,4 @@ see ;
IN: game.models IN: game.models
HELP: model HELP: model
{ $class-description "Tuple of a packed attribute buffer, index buffer and vertex format suitable for a single OpenGL draw call." } ; { $class-description "Tuple of a packed attribute buffer, index buffer, vertex format and material suitable for a single OpenGL draw call." } ;

View File

@ -3,5 +3,5 @@
USING: ; USING: ;
IN: game.models IN: game.models
TUPLE: model attribute-buffer index-buffer vertex-format ; TUPLE: model attribute-buffer index-buffer vertex-format material ;

View File

@ -0,0 +1,70 @@
! 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 game.models.obj.private game.models
game.models.util io.pathnames ;
IN: game.models.obj
ABOUT: "game.models.obj"
ARTICLE: "game.models.obj" "Conversion of Wavefront OBJ assets"
"The " { $vocab-link "game.models.obj" } " vocabulary implements words for converting Wavefront OBJ assets to data suitable for use with OpenGL." ;
HELP: material
{ $class-description "Tuple describing the GPU state that needs to be applied prior to rendering geometry tagged with this material." } ;
HELP: cm
{ $values { "current-material" material } }
{ $description "Convenience word for accessing the current material while parsing primitives." } ;
HELP: md
{ $values { "material-dictionary" assoc } }
{ $description "Convenience word for accessing the material dictionary while parsing primitives. " } ;
HELP: strings>floats
{ $values { "strings" sequence } { "floats" sequence } }
{ $description "Convert a sequence of strings to a sequence of floats." } ;
HELP: strings>faces
{ $values { "strings" sequence } { "faces" sequence } }
{ $description "Convert a sequence of '/'-delimited strings into a sequence of sequences of numbers. Each number is an index into the vertex, texture or normal tables, respectively." } ;
HELP: split-string
{ $values { "string" string } { "strings" sequence } }
{ $description "Split the given string on whitespace." } ;
HELP: line>mtl
{ $values { "line" string } }
{ $description "Process a line from a material file within the current parsing context." } ;
HELP: read-mtl
{ $values { "file" pathname } { "material-dictionary" assoc } }
{ $description "Read the specified material file and generate a material dictionary keyed by material name." } ;
HELP: obj-vertex-format
{ $class-description "Vertex format used for rendering OBJ geometry." } ;
HELP: triangle>aos
{ $values { "x" sequence } { "y" sequence } }
{ $description "Convert a sequence of vertex, texture and normal indices into a sequence of vertex, texture and normal values." } ;
HELP: quad>aos
{ $values { "x" sequence } { "y" sequence } { "z" sequence } }
{ $description "Convert a sequence of vertex, texture and normal indices into two sequences of vertex, texture and normal values. This splits a quad into two triangles." } ;
HELP: face>aos
{ $values { "x" sequence } { "y" sequence } }
{ $description "Convert a face line to a sequence of vertex attributes." } ;
HELP: push*
{ $values { "elt" "an object" } { "seq" sequence } { "seq" sequence } }
{ $description "Push the value onto the sequence, keeping the sequence on the stack." } ;
HELP: push-current-model
{ $description "Push the current model being built onto the models list and initialize a fresh empty model." } ;
HELP: line>obj
{ $values { "line" string } }
{ $description "Process a line from the object file within the current parsing context." } ;

View File

@ -1,98 +1,166 @@
! Copyright (C) 2010 Your name. ! Copyright (C) 2010 Erik Charlebois
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: io io.encodings.ascii math.parser sequences splitting kernel USING: io io.encodings.ascii math.parser sequences splitting kernel
assocs io.files combinators math.order math namespaces assocs io.files combinators math.order math namespaces
arrays sequences.deep accessors arrays sequences.deep accessors
specialized-arrays.instances.alien.c-types.float specialized-arrays.instances.alien.c-types.float
specialized-arrays.instances.alien.c-types.uint specialized-arrays.instances.alien.c-types.uint
game.models.util gpu.shaders images game.models.loader ; game.models game.models.util gpu.shaders images
game.models.loader prettyprint ;
IN: game.models.obj IN: game.models.obj
SINGLETON: obj-models SINGLETON: obj-models
"obj" ascii obj-models register-models-class "obj" ascii obj-models register-models-class
<PRIVATE <PRIVATE
SYMBOLS: v vt vn i ; SYMBOLS: vp vt vn current-model current-material material-dictionary models ;
TUPLE: material
{ name initial: f }
{ ambient-reflectivity initial: { 1.0 1.0 1.0 } }
{ diffuse-reflectivity initial: { 1.0 1.0 1.0 } }
{ specular-reflectivity initial: { 1.0 1.0 1.0 } }
{ transmission-filter initial: { 1.0 1.0 1.0 } }
{ dissolve initial: 1.0 }
{ specular-exponent initial: 10.0 }
{ refraction-index initial: 1.5 }
{ ambient-map initial: f }
{ diffuse-map initial: f }
{ specular-map initial: f }
{ specular-exponent-map initial: f }
{ dissolve-map initial: f }
{ displacement-map initial: f }
{ bump-map initial: f }
{ reflection-map initial: f } ;
: cm ( -- current-material ) current-material get ; inline
: md ( -- material-dictionary ) material-dictionary get ; inline
: strings>floats ( strings -- floats )
[ string>float ] map ;
: strings>faces ( strings -- faces )
[ "/" split [ string>number ] map ] map ;
: split-string ( string -- strings )
" \t\n" split harvest ;
: line>mtl ( line -- )
" \t\n" split harvest
[
[ rest ] [ first ] bi
{
{ "newmtl" [ first
[ material new swap >>name current-material set ]
[ cm swap md set-at ] bi
] }
{ "Ka" [ 3 head [ string>float ] map cm (>>ambient-reflectivity) ] }
{ "Kd" [ 3 head [ string>float ] map cm (>>diffuse-reflectivity) ] }
{ "Ks" [ 3 head [ string>float ] map cm (>>specular-reflectivity) ] }
{ "Tf" [ 3 head [ string>float ] map cm (>>transmission-filter) ] }
{ "d" [ first string>float cm (>>dissolve) ] }
{ "Ns" [ first string>float cm (>>specular-exponent) ] }
{ "Ni" [ first string>float cm (>>refraction-index) ] }
{ "map_Ka" [ first cm (>>ambient-map) ] }
{ "map_Kd" [ first cm (>>diffuse-map) ] }
{ "map_Ks" [ first cm (>>specular-map) ] }
{ "map_Ns" [ first cm (>>specular-exponent-map) ] }
{ "map_d" [ first cm (>>dissolve-map) ] }
{ "map_bump" [ first cm (>>bump-map) ] }
{ "bump" [ first cm (>>bump-map) ] }
{ "disp" [ first cm (>>displacement-map) ] }
{ "refl" [ first cm (>>reflection-map) ] }
[ 2drop ]
} case
] unless-empty ;
: read-mtl ( file -- material-dictionary )
[
f current-material set
H{ } clone material-dictionary set
] H{ } make-assoc
[
ascii file-lines [ line>mtl ] each
md
] bind ;
VERTEX-FORMAT: obj-vertex-format VERTEX-FORMAT: obj-vertex-format
{ "POSITION" float-components 3 f } { "POSITION" float-components 3 f }
{ "TEXCOORD" float-components 2 f } { "TEXCOORD" float-components 2 f }
{ "NORMAL" float-components 3 f } ; { "NORMAL" float-components 3 f } ;
: string>floats ( x -- y ) : triangle>aos ( x -- y )
[ string>float ] map ; dup length
{
: string>faces ( x -- y ) { 3 [
[ "/" split [ string>number ] map ] map ;
: 3face>aos ( x -- y )
dup length {
{ 3
[
first3 first3
[ 1 - v get nth ] [ 1 - vp get nth ]
[ 1 - vt get nth ] [ 1 - vt get nth ]
[ 1 - vn get nth ] tri* 3array flatten [ 1 - vn get nth ] tri* 3array flatten
] } ] }
{ 2 { 2 [
[
first2 first2
[ 1 - v get nth ] [ 1 - vp get nth ]
[ 1 - vt get nth ] bi* 2array flatten [ 1 - vt get nth ] bi* 2array flatten
] } ] }
} case ; } case ;
: quad>aos ( x -- y z )
[ 3 head [ triangle>aos 1array ] map ]
[ [ 2 swap nth ]
[ 3 swap nth ]
[ 0 swap nth ] tri 3array
[ triangle>aos 1array ] map ]
bi ;
: 4face>aos ( x -- y z ) : face>aos ( x -- y )
[ 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 dup length
{ {
{ 3 [ [ 3face>aos 1array ] map 1array ] } { 3 [ [ triangle>aos 1array ] map 1array ] }
{ 4 [ 4face>aos 2array ] } { 4 [ quad>aos 2array ] }
} case ; } case ;
: push* ( x z -- y ) : push* ( elt seq -- seq )
[ push ] keep ; [ push ] keep ;
: push-current-model ( -- )
current-model get [
[ dseq>> flatten >float-array ]
[ iseq>> flatten >uint-array ]
bi obj-vertex-format current-material get model boa models get push
V{ } V{ } H{ } <indexed-seq> current-model set
] unless-empty ;
: line>obj ( line -- ) : line>obj ( line -- )
" \t\n" split harvest dup split-string
length 1 >
[ [
[ rest ] [ first ] bi [ rest ] [ first ] bi
{ {
{ "#" [ drop ] } { "mtllib" [ first read-mtl material-dictionary set ] }
{ "v" [ string>floats 3 head v [ push* ] change ] } { "v" [ strings>floats 3 head vp [ push* ] change ] }
{ "vt" [ string>floats 2 head vt [ push* ] change ] } { "vt" [ strings>floats 2 head vt [ push* ] change ] }
{ "vn" [ string>floats 3 head vn [ push* ] change ] } { "vn" [ strings>floats 3 head vn [ push* ] change ] }
{ "f" [ string>faces faces>aos [ [ i [ push* ] change ] each ] each ] } { "usemtl" [ push-current-model first md at current-material set ] }
{ "o" [ drop ] } { "f" [ strings>faces face>aos [ [ current-model [ push* ] change ] each ] each ] }
{ "g" [ drop ] } [ 2drop ]
{ "s" [ drop ] }
{ "mtllib" [ drop ] }
{ "usemtl" [ drop ] }
} case } case
] ] unless-empty ;
[ drop ] if ;
PRIVATE> PRIVATE>
M: obj-models stream>models M: obj-models stream>models
drop drop
[ [
V{ } V{ } clone vp set
[ clone v set ] V{ } clone vt set
[ clone vt set ] V{ } clone vn set
[ clone vn set ] tri V{ } clone models set
V{ } V{ } H{ } <indexed-seq> i set V{ } V{ } H{ } <indexed-seq> current-model set
f current-material set
f material-dictionary set
] H{ } make-assoc ] H{ } make-assoc
[ [
[ line>obj ] each-stream-line i get [ line>obj ] each-stream-line push-current-model
] bind models get
[ dseq>> flatten >float-array ] ] bind ;
[ iseq>> flatten >uint-array ] bi obj-vertex-format model boa 1array ;

View File

@ -3,8 +3,6 @@
USING: sequences accessors kernel locals assocs ; USING: sequences accessors kernel locals assocs ;
IN: game.models.util IN: game.models.util
TUPLE: model attribute-buffer index-buffer vertex-format ;
TUPLE: indexed-seq dseq iseq rassoc ; TUPLE: indexed-seq dseq iseq rassoc ;
INSTANCE: indexed-seq sequence INSTANCE: indexed-seq sequence

View File

@ -8,92 +8,108 @@ io io.encodings.ascii io.files io.files.temp kernel locals math
math.matrices math.vectors.simd math.parser math.vectors math.matrices math.vectors.simd math.parser math.vectors
method-chains namespaces sequences splitting threads ui ui.gadgets method-chains namespaces sequences splitting threads ui ui.gadgets
ui.gadgets.worlds ui.pixel-formats specialized-arrays ui.gadgets.worlds ui.pixel-formats specialized-arrays
specialized-vectors literals fry xml specialized-vectors literals fry
xml.traversal sequences.deep destructors math.bitwise opengl.gl sequences.deep destructors math.bitwise opengl.gl
game.models.obj game.models.loader game.models.collada ; game.models game.models.obj game.models.loader game.models.collada
prettyprint images.tga ;
FROM: alien.c-types => float ; FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: float
SPECIALIZED-VECTOR: uint SPECIALIZED-VECTOR: uint
IN: model-viewer IN: model-viewer
GLSL-SHADER: model-vertex-shader vertex-shader GLSL-SHADER: obj-vertex-shader vertex-shader
uniform mat4 mv_matrix, p_matrix; uniform mat4 mv_matrix;
uniform vec3 light_position; uniform mat4 p_matrix;
attribute vec3 POSITION; attribute vec3 POSITION;
attribute vec3 TEXCOORD;
attribute vec3 NORMAL; attribute vec3 NORMAL;
attribute vec2 TEXCOORD;
varying vec2 texit; varying vec2 texcoord_fs;
varying vec3 norm; varying vec3 normal_fs;
varying vec3 world_pos_fs;
void main() void main()
{ {
vec4 position = mv_matrix * vec4(POSITION, 1.0); vec4 position = mv_matrix * vec4(POSITION, 1.0);
gl_Position = p_matrix * position; gl_Position = p_matrix * position;
texit = TEXCOORD; world_pos_fs = POSITION;
norm = NORMAL; texcoord_fs = TEXCOORD;
normal_fs = NORMAL;
} }
; ;
GLSL-SHADER: model-fragment-shader fragment-shader GLSL-SHADER: obj-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 mat4 mv_matrix, p_matrix;
uniform vec3 light_position; uniform sampler2D map_Ka;
uniform sampler2D map_bump;
attribute vec3 POSITION; uniform vec3 Ka;
attribute vec3 COLOR; uniform vec3 view_pos;
varying vec4 color; uniform vec3 light;
varying vec2 texcoord_fs;
varying vec3 normal_fs;
varying vec3 world_pos_fs;
void main() void main()
{ {
gl_Position = p_matrix * mv_matrix * vec4(POSITION, 1.0); vec4 d = texture2D(map_Ka, texcoord_fs.xy);
color = vec4(COLOR, 1); vec3 b = texture2D(map_bump, texcoord_fs.xy).xyz;
vec3 n = normal_fs;
vec3 v = normalize(view_pos - world_pos_fs);
vec3 l = normalize(light);
vec3 h = normalize(v + l);
float cosTh = saturate(dot(n, l));
gl_FragColor = d * cosTh
+ d * 0.5 * cosTh * pow(saturate(dot(n, h)), 10.0) ;
} }
; ;
GLSL-SHADER: debug-fragment-shader fragment-shader GLSL-PROGRAM: obj-program
varying vec4 color; obj-vertex-shader obj-fragment-shader ;
void main()
{
gl_FragColor = color;
}
;
GLSL-PROGRAM: debug-program debug-vertex-shader debug-fragment-shader ;
UNIFORM-TUPLE: model-uniforms < mvp-uniforms UNIFORM-TUPLE: model-uniforms < mvp-uniforms
{ "light-position" vec3-uniform f } ; { "map_Ka" texture-uniform f }
{ "map_bump" texture-uniform f }
{ "Ka" vec3-uniform f }
{ "light" vec3-uniform f }
{ "view_pos" vec3-uniform f }
;
TUPLE: model-state TUPLE: model-state
models models
vertex-arrays vertex-arrays
index-vectors ; index-vectors
textures
bumps
kas ;
TUPLE: model-world < wasd-world TUPLE: model-world < wasd-world model-path model-state ;
{ model-state model-state } ;
VERTEX-FORMAT: model-vertex TUPLE: vbo
{ "POSITION" float-components 3 f } vertex-buffer
{ "NORMAL" float-components 3 f } index-buffer index-count vertex-format texture bump ka ;
{ "TEXCOORD" float-components 2 f } ;
VERTEX-FORMAT: debug-vertex : white-image ( -- image )
{ "POSITION" float-components 3 f } { 1 1 } BGR ubyte-components f
{ "COLOR" float-components 3 f } ; B{ 255 255 255 } image boa ;
TUPLE: vbo vertex-buffer index-buffer index-count vertex-format ; : up-image ( -- image )
{ 1 1 } BGR ubyte-components f
B{ 0 0 0 } image boa ;
: make-texture ( pathname alt -- texture )
swap [ nip load-image ] [ ] if*
[
[ component-order>> ]
[ component-type>> ] bi
T{ texture-parameters
{ wrap repeat-texcoord }
{ min-filter filter-linear }
{ min-mipmap-filter f } }
<texture-2d>
]
[
0 swap [ allocate-texture-image ] 3keep 2drop
] bi ;
: <model-buffers> ( models -- buffers ) : <model-buffers> ( models -- buffers )
[ [
@ -102,14 +118,18 @@ TUPLE: vbo vertex-buffer index-buffer index-count vertex-format ;
[ index-buffer>> underlying>> static-upload draw-usage index-buffer byte-array>buffer ] [ index-buffer>> underlying>> static-upload draw-usage index-buffer byte-array>buffer ]
[ index-buffer>> length ] [ index-buffer>> length ]
[ vertex-format>> ] [ vertex-format>> ]
[ material>> ambient-map>> white-image make-texture ]
[ material>> bump-map>> up-image make-texture ]
[ material>> ambient-reflectivity>> ]
} cleave vbo boa } cleave vbo boa
] map ; ] map ;
: fill-model-state ( model-state -- ) : fill-model-state ( model-state -- )
dup models>> <model-buffers> dup models>> <model-buffers>
{
[ [
[ [
[ vertex-buffer>> model-program <program-instance> ] [ vertex-buffer>> obj-program <program-instance> ]
[ vertex-format>> ] bi buffer>vertex-array [ vertex-format>> ] bi buffer>vertex-array
] map >>vertex-arrays drop ] map >>vertex-arrays drop
] ]
@ -118,61 +138,39 @@ TUPLE: vbo vertex-buffer index-buffer index-count vertex-format ;
[ index-buffer>> ] [ index-count>> ] bi [ index-buffer>> ] [ index-count>> ] bi
'[ _ 0 <buffer-ptr> _ uint-indexes <index-elements> ] call '[ _ 0 <buffer-ptr> _ uint-indexes <index-elements> ] call
] map >>index-vectors drop ] map >>index-vectors drop
] 2bi ; ]
[ [ texture>> ] map >>textures drop ]
[ [ bump>> ] map >>bumps drop ]
[ [ ka>> ] map >>kas drop ]
} 2cleave ;
: model-files ( -- files ) : <model-state> ( model-world -- model-state )
{ "C:/Users/erikc/Downloads/test2.dae" model-path>> 1array model-state new swap
"C:/Users/erikc/Downloads/Sponza.obj" } ; [ load-models ] [ append ] map-reduce >>models ;
: <model-state> ( -- model-state ) :: <model-uniforms> ( world -- uniforms )
model-state new world model-state>>
model-files [ load-models ] [ append ] map-reduce >>models ; [ textures>> ] [ bumps>> ] [ kas>> ] tri
[| texture bump ka |
world wasd-mv-matrix
world wasd-p-matrix
texture bump ka
{ 0.5 0.5 0.5 }
world location>>
model-uniforms boa
] 3map ;
M: model-world begin-game-world : clear-screen ( -- )
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 0 0 0 0 glClearColor
1 glClearDepth 1 glClearDepth
HEX: ffffffff glClearStencil HEX: ffffffff glClearStencil
{ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT GL_STENCIL_BUFFER_BIT } flags glClear { GL_COLOR_BUFFER_BIT
GL_DEPTH_BUFFER_BIT
GL_STENCIL_BUFFER_BIT } flags glClear ;
[ : draw-model ( world -- )
triangle-fill dup t <triangle-state> set-gpu-state clear-screen
face-ccw cull-back <triangle-cull-state> set-gpu-state face-ccw cull-back <triangle-cull-state> set-gpu-state
cmp-less <depth-state> set-gpu-state cmp-less <depth-state> set-gpu-state
[ model-state>> vertex-arrays>> ] [ model-state>> vertex-arrays>> ]
[ model-state>> index-vectors>> ] [ model-state>> index-vectors>> ]
@ -185,27 +183,39 @@ M: model-world begin-game-world
{ "vertex-array" [ drop drop ] } { "vertex-array" [ drop drop ] }
{ "indexes" [ drop nip ] } { "indexes" [ drop nip ] }
} 3<render-set> render } 3<render-set> render
] curry 2each ] 3each ;
]
[
cmp-always <depth-state> set-gpu-state
draw-axes
]
bi ;
M: model-world draw-world* TUPLE: model-attributes < game-attributes model-path ;
draw-model ;
M: model-world draw-world* draw-model ;
M: model-world wasd-movement-speed drop 1/4. ; M: model-world wasd-movement-speed drop 1/4. ;
M: model-world wasd-near-plane drop 1/32. ; M: model-world wasd-near-plane drop 1/32. ;
M: model-world wasd-far-plane drop 1024.0 ; M: model-world wasd-far-plane drop 1024.0 ;
M: model-world begin-game-world
init-gpu
{ 0.0 0.0 2.0 } 0 0 set-wasd-view
[ <model-state> [ fill-model-state ] keep ] [ (>>model-state) ] bi ;
M: model-world apply-world-attributes
{
[ model-path>> >>model-path ]
[ call-next-method ]
} cleave ;
GAME: model-viewer { :: open-model-viewer ( model-path -- )
[
f
T{ model-attributes
{ world-class model-world } { world-class model-world }
{ title "Model Viewer" }
{ pixel-format-attributes { windowed double-buffered } }
{ grab-input? t } { grab-input? t }
{ use-game-input? t } { title "Model Viewer" }
{ pixel-format-attributes
{ windowed double-buffered }
}
{ pref-dim { 1024 768 } } { pref-dim { 1024 768 } }
{ tick-interval-micros $[ 60 fps ] } { tick-interval-micros 16666 }
} ; { use-game-input? t }
{ model-path model-path }
}
clone
open-window
] with-ui ;

View File

@ -287,6 +287,7 @@
("\\_<\\()\\))\\_>" (1 ")(")) ("\\_<\\()\\))\\_>" (1 ")("))
;; Quotations: ;; Quotations:
("\\_<'\\(\\[\\)\\_>" (1 "(]")) ; fried ("\\_<'\\(\\[\\)\\_>" (1 "(]")) ; fried
("\\_<$\\(\\[\\)\\_>" (1 "(]")) ; parse-time
("\\_<\\(\\[\\)\\_>" (1 "(]")) ("\\_<\\(\\[\\)\\_>" (1 "(]"))
("\\_<\\(\\]\\)\\_>" (1 ")[")))) ("\\_<\\(\\]\\)\\_>" (1 ")["))))

View File

@ -187,16 +187,11 @@ void factor_vm::primitive_fread()
data_root<byte_array> buf(allot_uninitialized_array<byte_array>(size),this); data_root<byte_array> buf(allot_uninitialized_array<byte_array>(size),this);
for(;;)
{
int c = safe_fread(buf.untagged() + 1,1,size,file); int c = safe_fread(buf.untagged() + 1,1,size,file);
if(c == 0) if(c == 0)
{ {
if(feof(file)) if(feof(file))
{
ctx->push(false_object); ctx->push(false_object);
break;
}
else else
io_error(); io_error();
} }
@ -210,8 +205,6 @@ void factor_vm::primitive_fread()
} }
ctx->push(buf.value()); ctx->push(buf.value());
break;
}
} }
} }

View File

@ -37,8 +37,6 @@ u64 system_micros()
- EPOCH_OFFSET) / 10; - EPOCH_OFFSET) / 10;
} }
/* On VirtualBox, QueryPerformanceCounter does not increment
the high part every time the low part overflows. Workaround. */
u64 nano_count() u64 nano_count()
{ {
LARGE_INTEGER count; LARGE_INTEGER count;
@ -53,8 +51,14 @@ u64 nano_count()
if(ret == 0) if(ret == 0)
fatal_error("QueryPerformanceFrequency", 0); fatal_error("QueryPerformanceFrequency", 0);
if(count.LowPart < lo) #ifdef FACTOR_64
hi += 1; hi = count.HighPart;
#else
/* On VirtualBox, QueryPerformanceCounter does not increment
the high part every time the low part overflows. Workaround. */
if(lo > count.LowPart)
hi++;
#endif
lo = count.LowPart; lo = count.LowPart;
return (u64)((((u64)hi << 32) | (u64)lo)*(1000000000.0/frequency.QuadPart)); return (u64)((((u64)hi << 32) | (u64)lo)*(1000000000.0/frequency.QuadPart));
@ -91,7 +95,7 @@ LONG factor_vm::exception_handler(PEXCEPTION_POINTERS pe)
case STATUS_FLOAT_UNDERFLOW: case STATUS_FLOAT_UNDERFLOW:
case STATUS_FLOAT_MULTIPLE_FAULTS: case STATUS_FLOAT_MULTIPLE_FAULTS:
case STATUS_FLOAT_MULTIPLE_TRAPS: case STATUS_FLOAT_MULTIPLE_TRAPS:
#ifdef FACTOR_AMD64 #ifdef FACTOR_64
signal_fpu_status = fpu_status(MXCSR(c)); signal_fpu_status = fpu_status(MXCSR(c));
#else #else
signal_fpu_status = fpu_status(X87SW(c) | MXCSR(c)); signal_fpu_status = fpu_status(X87SW(c) | MXCSR(c));

View File

@ -128,7 +128,7 @@ segment::~segment()
long getpagesize() long getpagesize()
{ {
static long g_pagesize = 0; static long g_pagesize = 0;
if (! g_pagesize) if(!g_pagesize)
{ {
SYSTEM_INFO system_info; SYSTEM_INFO system_info;
GetSystemInfo (&system_info); GetSystemInfo (&system_info);