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
game-worlds gpu gpu.buffers gpu.util.wasd gpu.framebuffers gpu.render
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 }
} clear-framebuffer
] [
render-set new
triangles-mode >>primitive-mode
{ T{ color-attachment f 0 } T{ color-attachment f 1 } } >>output-attachments
swap {
[ <bunny-uniforms> >>uniforms ]
[ bunny>> vertex-array>> >>vertex-array ]
[ bunny>> index-elements>> >>indexes ]
[ sobel>> framebuffer>> >>framebuffer ]
} cleave
render
{
{ "primitive-mode" [ drop triangles-mode ] }
{ "output-attachments" [ drop { T{ color-attachment f 0 } T{ color-attachment f 1 } } ] }
{ "uniforms" [ <bunny-uniforms> ] }
{ "vertex-array" [ bunny>> vertex-array>> ] }
{ "indexes" [ bunny>> index-elements>> ] }
{ "framebuffer" [ sobel>> framebuffer>> ] }
} <render-set> render
] bi ;
: <sobel-uniforms> ( sobel -- uniforms )
@ -250,13 +249,12 @@ BEFORE: bunny-world begin-world
: draw-sobel ( world -- )
T{ depth-state { comparison f } } set-gpu-state*
render-set new
triangle-strip-mode >>primitive-mode
T{ index-range f 0 4 } >>indexes
swap sobel>>
[ <sobel-uniforms> >>uniforms ]
[ vertex-array>> >>vertex-array ] bi
render ;
sobel>> {
{ "primitive-mode" [ drop triangle-strip-mode ] }
{ "indexes" [ drop T{ index-range f 0 4 } ] }
{ "uniforms" [ <sobel-uniforms> ] }
{ "vertex-array" [ vertex-array>> ] }
} <render-set> render ;
: draw-sobeled-bunny ( world -- )
[ draw-bunny ] [ draw-sobel ] bi ;
@ -264,13 +262,12 @@ BEFORE: bunny-world begin-world
: draw-loading ( world -- )
T{ depth-state { comparison f } } set-gpu-state*
render-set new
triangle-strip-mode >>primitive-mode
T{ index-range f 0 4 } >>indexes
swap loading>>
[ { 1.0 -1.0 } swap texture>> loading-uniforms boa >>uniforms ]
[ vertex-array>> >>vertex-array ] bi
render ;
loading>> {
{ "primitive-mode" [ drop triangle-strip-mode ] }
{ "indexes" [ drop T{ index-range f 0 4 } ] }
{ "uniforms" [ { 1.0 -1.0 } swap texture>> loading-uniforms boa ] }
{ "vertex-array" [ vertex-array>> ] }
} <render-set> render ;
M: bunny-world draw-world*
dup bunny>>

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

@ -1,7 +1,7 @@
! (c)2009 Joe Groff bsd license
USING: accessors arrays game-loop game-worlds generalizations
gpu gpu.render gpu.shaders gpu.util gpu.util.wasd kernel
literals math math.matrices math.order math.vectors
USING: accessors arrays combinators.tuple game-loop game-worlds
generalizations gpu gpu.render gpu.shaders gpu.util gpu.util.wasd
kernel literals math math.matrices math.order math.vectors
method-chains sequences ui ui.gadgets ui.gadgets.worlds
ui.pixel-formats ;
IN: gpu.demos.raytrace
@ -97,13 +97,12 @@ AFTER: raytrace-world tick*
spheres>> [ tick-sphere ] each ;
M: raytrace-world draw-world*
render-set new
triangle-strip-mode >>primitive-mode
T{ index-range f 0 4 } >>indexes
swap
[ <sphere-uniforms> >>uniforms ]
[ vertex-array>> >>vertex-array ] bi
render ;
{
{ "primitive-mode" [ drop triangle-strip-mode ] }
{ "indexes" [ drop T{ index-range f 0 4 } ] }
{ "uniforms" [ <sphere-uniforms> ] }
{ "vertex-array" [ vertex-array>> ] }
} <render-set> render ;
M: raytrace-world pref-dim* drop { 1024 768 } ;
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
USING: accessors alien alien.c-types alien.structs arrays
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
gpu.framebuffers.private gpu.shaders gpu.state gpu.textures
gpu.textures.private half-floats images kernel lexer locals
@ -474,13 +474,22 @@ M: vertex-array dispose
PRIVATE>
TUPLE: render-set
{ primitive-mode primitive-mode }
{ vertex-array vertex-array }
{ uniforms uniform-tuple }
{ indexes vertex-indexes initial: T{ index-range } }
{ instances ?integer initial: f }
{ framebuffer any-framebuffer initial: system-framebuffer }
{ output-attachments sequence initial: { default-attachment } } ;
{ primitive-mode primitive-mode read-only }
{ vertex-array vertex-array read-only }
{ uniforms uniform-tuple read-only }
{ indexes vertex-indexes initial: T{ index-range } read-only }
{ instances ?integer initial: f read-only }
{ framebuffer any-framebuffer initial: system-framebuffer read-only }
{ 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 -- )
{