steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add a new "make-tuple" combinator for cleaving values into tuple slots by name. make render-set read-only and update gpu demos to use make-tuple

db4
Joe Groff 2009-07-22 12:43:44 -05:00
parent ac2c65e920
commit 3bbc9835fc
5 changed files with 119 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
extra/combinators/tuple/tuple-docs.factor Normal file
View File

@ -0,0 +1,43 @@
! (c)2009 Joe Groff bsd license
USING: assocs classes help.markup help.syntax kernel math
quotations strings ;
IN: combinators.tuple
HELP: 2make-tuple
{ $values
{ "x" object } { "y" object } { "class" class } { "assoc" assoc }
{ "tuple" tuple }
}
{ $description "Constructs a " { $link tuple } " of " { $snippet "class" } " by calling the quotations making up the values of " { $snippet "assoc" } " on " { $snippet "x" } " and " { $snippet "y" } ", assigning the result of each call to the slot named by the corresponding key. The quotations must have the effect " { $snippet "( x y -- slot-value )" } ". The order in which the quotations is called is undefined." } ;
HELP: 3make-tuple
{ $values
{ "x" object } { "y" object } { "z" object } { "class" class } { "assoc" "a list of " { $link string } "/" { $link quotation } " pairs" }
{ "tuple" tuple }
}
{ $description "Constructs a " { $link tuple } " of " { $snippet "class" } " by calling the quotations making up the values of " { $snippet "assoc" } " on " { $snippet "x" } ", " { $snippet "y" } ", and " { $snippet "z" } ", assigning the result of each call to the slot named by the corresponding key. The quotations must have the effect " { $snippet "( x y z -- slot-value )" } ". The order in which the quotations is called is undefined." } ;
HELP: make-tuple
{ $values
{ "x" object } { "class" class } { "assoc" "a list of " { $link string } "/" { $link quotation } " pairs" }
{ "tuple" tuple }
}
{ $description "Constructs a " { $link tuple } " of " { $snippet "class" } " by calling the quotations making up the values of " { $snippet "assoc" } " on " { $snippet "x" } ", assigning the result of each call to the slot named by the corresponding key. The quotations must have the effect " { $snippet "( x -- slot-value )" } ". The order in which the quotations is called is undefined." } ;
HELP: nmake-tuple
{ $values
{ "class" class } { "assoc" "a list of " { $link string } "/" { $link quotation } " pairs" } { "n" integer }
}
{ $description "Constructs a " { $link tuple } " of " { $snippet "class" } " by calling the quotations making up the values of " { $snippet "assoc" } " on the top " { $snippet "n" } " values on the datastack below " { $snippet "class" } ", assigning the result of each call to the slot named by the corresponding key. The order in which the quotations is called is undefined." } ;
{ make-tuple 2make-tuple 3make-tuple nmake-tuple } related-words
ARTICLE: "combinators.tuple" "Tuple-constructing combinators"
"The " { $vocab-link "combinators.tuple" } " vocabulary provides dataflow combinators that construct " { $link tuple } " objects."
{ $subsection make-tuple }
{ $subsection 2make-tuple }
{ $subsection 3make-tuple }
{ $subsection nmake-tuple }
;
ABOUT: "combinators.tuple"

29
extra/combinators/tuple/tuple.factor Normal file
View File

@ -0,0 +1,29 @@
! (c)2009 Joe Groff bsd license
USING: accessors assocs classes.tuple generalizations kernel
locals quotations sequences ;
IN: combinators.tuple
<PRIVATE
:: (tuple-slot-quot) ( slot assoc n -- quot )
slot name>> assoc at [
slot initial>> :> initial
{ n ndrop initial } >quotation
] unless* ;
PRIVATE>
MACRO:: nmake-tuple ( class assoc n -- )
class all-slots [ assoc n (tuple-slot-quot) ] map :> quots
class <wrapper> :> \class
{ quots n ncleave \class boa } >quotation ;
: make-tuple ( x class assoc -- tuple )
1 nmake-tuple ; inline
: 2make-tuple ( x y class assoc -- tuple )
2 nmake-tuple ; inline
: 3make-tuple ( x y z class assoc -- tuple )
3 nmake-tuple ; inline

45
extra/gpu/demos/bunny/bunny.factor
View File

@ -1,3 +1,4 @@
! (c)2009 Joe Groff bsd license
USING: accessors alien.c-types arrays combinators combinators.short-circuit USING: accessors alien.c-types arrays combinators combinators.short-circuit
game-worlds gpu gpu.buffers gpu.util.wasd gpu.framebuffers gpu.render game-worlds gpu gpu.buffers gpu.util.wasd gpu.framebuffers gpu.render
gpu.shaders gpu.state gpu.textures gpu.util grouping http.client images gpu.shaders gpu.state gpu.textures gpu.util grouping http.client images
@ -229,16 +230,14 @@ BEFORE: bunny-world begin-world
{ depth-attachment 1.0 } { depth-attachment 1.0 }
} clear-framebuffer } clear-framebuffer
] [ ] [
render-set new {
triangles-mode >>primitive-mode { "primitive-mode" [ drop triangles-mode ] }
{ T{ color-attachment f 0 } T{ color-attachment f 1 } } >>output-attachments { "output-attachments" [ drop { T{ color-attachment f 0 } T{ color-attachment f 1 } } ] }
swap { { "uniforms" [ <bunny-uniforms> ] }
[ <bunny-uniforms> >>uniforms ] { "vertex-array" [ bunny>> vertex-array>> ] }
[ bunny>> vertex-array>> >>vertex-array ] { "indexes" [ bunny>> index-elements>> ] }
[ bunny>> index-elements>> >>indexes ] { "framebuffer" [ sobel>> framebuffer>> ] }
[ sobel>> framebuffer>> >>framebuffer ] } <render-set> render
} cleave
render
] bi ; ] bi ;
: <sobel-uniforms> ( sobel -- uniforms ) : <sobel-uniforms> ( sobel -- uniforms )
@ -250,13 +249,12 @@ BEFORE: bunny-world begin-world
: draw-sobel ( world -- ) : draw-sobel ( world -- )
T{ depth-state { comparison f } } set-gpu-state* T{ depth-state { comparison f } } set-gpu-state*
render-set new sobel>> {
triangle-strip-mode >>primitive-mode { "primitive-mode" [ drop triangle-strip-mode ] }
T{ index-range f 0 4 } >>indexes { "indexes" [ drop T{ index-range f 0 4 } ] }
swap sobel>> { "uniforms" [ <sobel-uniforms> ] }
[ <sobel-uniforms> >>uniforms ] { "vertex-array" [ vertex-array>> ] }
[ vertex-array>> >>vertex-array ] bi } <render-set> render ;
render ;
: draw-sobeled-bunny ( world -- ) : draw-sobeled-bunny ( world -- )
[ draw-bunny ] [ draw-sobel ] bi ; [ draw-bunny ] [ draw-sobel ] bi ;
@ -264,13 +262,12 @@ BEFORE: bunny-world begin-world
: draw-loading ( world -- ) : draw-loading ( world -- )
T{ depth-state { comparison f } } set-gpu-state* T{ depth-state { comparison f } } set-gpu-state*
render-set new loading>> {
triangle-strip-mode >>primitive-mode { "primitive-mode" [ drop triangle-strip-mode ] }
T{ index-range f 0 4 } >>indexes { "indexes" [ drop T{ index-range f 0 4 } ] }
swap loading>> { "uniforms" [ { 1.0 -1.0 } swap texture>> loading-uniforms boa ] }
[ { 1.0 -1.0 } swap texture>> loading-uniforms boa >>uniforms ] { "vertex-array" [ vertex-array>> ] }
[ vertex-array>> >>vertex-array ] bi } <render-set> render ;
render ;
M: bunny-world draw-world* M: bunny-world draw-world*
dup bunny>> dup bunny>>

19
extra/gpu/demos/raytrace/raytrace.factor
View File

@ -1,7 +1,7 @@
! (c)2009 Joe Groff bsd license ! (c)2009 Joe Groff bsd license
USING: accessors arrays game-loop game-worlds generalizations USING: accessors arrays combinators.tuple game-loop game-worlds
gpu gpu.render gpu.shaders gpu.util gpu.util.wasd kernel generalizations gpu gpu.render gpu.shaders gpu.util gpu.util.wasd
literals math math.matrices math.order math.vectors kernel literals math math.matrices math.order math.vectors
method-chains sequences ui ui.gadgets ui.gadgets.worlds method-chains sequences ui ui.gadgets ui.gadgets.worlds
ui.pixel-formats ; ui.pixel-formats ;
IN: gpu.demos.raytrace IN: gpu.demos.raytrace
@ -97,13 +97,12 @@ AFTER: raytrace-world tick*
spheres>> [ tick-sphere ] each ; spheres>> [ tick-sphere ] each ;
M: raytrace-world draw-world* M: raytrace-world draw-world*
render-set new {
triangle-strip-mode >>primitive-mode { "primitive-mode" [ drop triangle-strip-mode ] }
T{ index-range f 0 4 } >>indexes { "indexes" [ drop T{ index-range f 0 4 } ] }
swap { "uniforms" [ <sphere-uniforms> ] }
[ <sphere-uniforms> >>uniforms ] { "vertex-array" [ vertex-array>> ] }
[ vertex-array>> >>vertex-array ] bi } <render-set> render ;
render ;
M: raytrace-world pref-dim* drop { 1024 768 } ; M: raytrace-world pref-dim* drop { 1024 768 } ;
M: raytrace-world tick-length drop 1000 30 /i ; M: raytrace-world tick-length drop 1000 30 /i ;

25
extra/gpu/render/render.factor
View File

@ -1,7 +1,7 @@
! (c)2009 Joe Groff bsd license ! (c)2009 Joe Groff bsd license
USING: accessors alien alien.c-types alien.structs arrays USING: accessors alien alien.c-types alien.structs arrays
assocs classes.mixin classes.parser classes.singleton assocs classes.mixin classes.parser classes.singleton
classes.tuple classes.tuple.private combinators destructors fry classes.tuple classes.tuple.private combinators combinators.tuple destructors fry
generic generic.parser gpu gpu.buffers gpu.framebuffers generic generic.parser gpu gpu.buffers gpu.framebuffers
gpu.framebuffers.private gpu.shaders gpu.state gpu.textures gpu.framebuffers.private gpu.shaders gpu.state gpu.textures
gpu.textures.private half-floats images kernel lexer locals gpu.textures.private half-floats images kernel lexer locals
@ -474,13 +474,22 @@ M: vertex-array dispose
PRIVATE> PRIVATE>
TUPLE: render-set TUPLE: render-set
{ primitive-mode primitive-mode } { primitive-mode primitive-mode read-only }
{ vertex-array vertex-array } { vertex-array vertex-array read-only }
{ uniforms uniform-tuple } { uniforms uniform-tuple read-only }
{ indexes vertex-indexes initial: T{ index-range } } { indexes vertex-indexes initial: T{ index-range } read-only }
{ instances ?integer initial: f } { instances ?integer initial: f read-only }
{ framebuffer any-framebuffer initial: system-framebuffer } { framebuffer any-framebuffer initial: system-framebuffer read-only }
{ output-attachments sequence initial: { default-attachment } } ; { output-attachments sequence initial: { default-attachment } read-only } ;
: <render-set> ( x quot-assoc -- render-set )
render-set swap make-tuple ; inline
: 2<render-set> ( x y quot-assoc -- render-set )
render-set swap 2make-tuple ; inline
: 3<render-set> ( x y z quot-assoc -- render-set )
render-set swap 3make-tuple ; inline
: render ( render-set -- ) : render ( render-set -- )
{ {