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

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

db4
Slava Pestov 2009-07-31 22:33:24 -05:00
parent 7c43f71c6d 5e5bddbe54
commit 6d296b6504
12 changed files with 112 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
core/classes/classes-docs.factor
View File

@ -35,6 +35,7 @@ $nl
"You can ask a class for its superclass:"
{ $subsection superclass }
{ $subsection superclasses }
{ $subsection subclass-of? }
"Class predicates can be used to test instances directly:"
{ $subsection "class-predicates" }
"There is a universal class which all objects are an instance of, and an empty class with no instances:"
@ -102,7 +103,21 @@ HELP: superclasses
}
} ;
{ superclass superclasses } related-words
HELP: subclass-of?
{ $values
{ "class" class }
{ "superclass" class }
{ "?" boolean }
}
{ $description "Outputs a boolean value indicating whether " { $snippet "class" } " is at any level a subclass of " { $snippet "superclass" } "." }
{ $examples
{ $example "USING: classes classes.tuple prettyprint words ;"
"tuple-class \\ class subclass-of? ."
"t"
}
} ;
{ superclass superclasses subclass-of? } related-words
HELP: members
{ $values { "class" class } { "seq" "a sequence of union members, or " { $link f } } }

3
core/classes/classes.factor
View File

@ -59,6 +59,9 @@ M: predicate reset-word
: superclasses ( class -- supers )
[ superclass ] follow reverse ;
: subclass-of? ( class superclass -- ? )
swap superclasses member? ;
: members ( class -- seq )
#! Output f for non-classes to work with algebra code
dup class? [ "members" word-prop ] [ drop f ] if ;

20
core/io/pathnames/pathnames-docs.factor
View File

@ -23,6 +23,24 @@ HELP: file-name
{ $example "USING: io.pathnames prettyprint ;" "\"/usr/libexec/awk/\" file-name ." "\"awk\"" }
} ;
HELP: file-extension
{ $values { "path" "a pathname string" } { "extension" string } }
{ $description "Outputs the extension of " { $snippet "path" } ", or " { $link f } " if the filename has no extension." }
{ $examples
{ $example "USING: io.pathnames prettyprint ;" "\"/usr/bin/gcc\" file-extension ." "f" }
{ $example "USING: io.pathnames prettyprint ;" "\"/home/csi/gui.vbs\" file-extension ." "\"vbs\"" }
} ;
HELP: file-stem
{ $values { "path" "a pathname string" } { "stem" string } }
{ $description "Outputs the " { $link file-name } " of " { $snippet "filename" } " with the file extension removed, if any." }
{ $examples
{ $example "USING: io.pathnames prettyprint ;" "\"/usr/bin/gcc\" file-stem ." "\"gcc\"" }
{ $example "USING: io.pathnames prettyprint ;" "\"/home/csi/gui.vbs\" file-stem ." "\"gui\"" }
} ;
{ file-name file-stem file-extension } related-words
HELP: path-components
{ $values { "path" "a pathnames string" } { "seq" sequence } }
{ $description "Splits a pathname on the " { $link path-separator } " into its its component strings." } ;
@ -86,6 +104,8 @@ ARTICLE: "io.pathnames" "Pathname manipulation"
"Pathname manipulation:"
{ $subsection parent-directory }
{ $subsection file-name }
{ $subsection file-stem }
{ $subsection file-extension }
{ $subsection last-path-separator }
{ $subsection path-components }
{ $subsection prepend-path }

5
core/io/pathnames/pathnames.factor
View File

@ -118,7 +118,10 @@ PRIVATE>
] if
] unless ;
: file-extension ( filename -- extension )
: file-stem ( path -- stem )
file-name "." split1-last drop ;
: file-extension ( path -- extension )
file-name "." split1-last nip ;
: path-components ( path -- seq )

28
core/slots/slots.factor
View File

@ -26,8 +26,10 @@ PREDICATE: writer-method < method-body "writing" word-prop ;
[ drop define ]
3bi ;
: reader-quot ( slot-spec -- quot )
[
GENERIC# reader-quot 1 ( class slot-spec -- quot )
M: object reader-quot
nip [
dup offset>> ,
\ slot ,
dup class>> object bootstrap-word eq?
@ -51,8 +53,12 @@ PREDICATE: writer-method < method-body "writing" word-prop ;
: define-reader ( class slot-spec -- )
[ nip name>> define-reader-generic ]
[
[ name>> reader-word ] [ reader-quot ] [ reader-props ] tri
define-typecheck
{
[ drop ]
[ nip name>> reader-word ]
[ reader-quot ]
[ nip reader-props ]
} 2cleave define-typecheck
] 2bi ;
: writer-word ( name -- word )
@ -83,8 +89,10 @@ ERROR: bad-slot-value value class ;
: writer-quot/fixnum ( slot-spec -- )
[ [ >fixnum ] dip ] % writer-quot/check ;
: writer-quot ( slot-spec -- quot )
[
GENERIC# writer-quot 1 ( class slot-spec -- quot )
M: object writer-quot
nip [
{
{ [ dup class>> object bootstrap-word eq? ] [ writer-quot/object ] }
{ [ dup class>> "coercer" word-prop ] [ writer-quot/coerce ] }
@ -101,8 +109,12 @@ ERROR: bad-slot-value value class ;
: define-writer ( class slot-spec -- )
[ nip name>> define-writer-generic ] [
[ name>> writer-word ] [ writer-quot ] [ writer-props ] tri
define-typecheck
{
[ drop ]
[ nip name>> writer-word ]
[ writer-quot ]
[ nip writer-props ]
} 2cleave define-typecheck
] 2bi ;
: setter-word ( name -- word )

1
extra/classes/tuple/change-tracking/authors.txt Normal file
View File

@ -0,0 +1 @@
Joe Groff

10
extra/classes/tuple/change-tracking/change-tracking-tests.factor Normal file
View File

@ -0,0 +1,10 @@
USING: classes.tuple.change-tracking tools.test ;
IN: classes.tuple.change-tracking.tests
TUPLE: resource < change-tracking-tuple
{ pathname string } ;
: <resource> ( pathname -- resource ) f swap resource boa ;
[ t ] [ "foo" <resource> "bar" >>pathname changed?>> ] unit-test
[ f ] [ "foo" <resource> [ 123 >>pathname ] [ drop ] recover changed?>> ] unit-test

23
extra/classes/tuple/change-tracking/change-tracking.factor Normal file
View File

@ -0,0 +1,23 @@
! (c)2009 Joe Groff bsd license
USING: accessors classes classes.tuple fry kernel sequences slots ;
IN: classes.tuple.change-tracking
TUPLE: change-tracking-tuple
{ changed? boolean } ;
PREDICATE: change-tracking-tuple-class < tuple-class
change-tracking-tuple subclass-of? ;
: changed? ( tuple -- changed? ) changed?>> ; inline
: clear-changed ( tuple -- tuple ) f >>changed? ; inline
: filter-changed ( sequence -- sequence' ) [ changed? ] filter ; inline
<PRIVATE
M: change-tracking-tuple-class writer-quot ( class slot-spec -- )
[ call-next-method ]
[ name>> "changed?" = [ '[ _ [ t >>changed? drop ] bi ] ] unless ] bi ;
PRIVATE>

1
extra/classes/tuple/change-tracking/summary.txt Normal file
View File

@ -0,0 +1 @@
Tuple classes that keep track of when they've been modified

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

@ -221,7 +221,7 @@ BEFORE: bunny-world begin-world
bunny-uniforms boa ;
: draw-bunny ( world -- )
T{ depth-state { comparison cmp-less } } set-gpu-state*
T{ depth-state { comparison cmp-less } } set-gpu-state
[
sobel>> framebuffer>> {
@ -247,7 +247,7 @@ BEFORE: bunny-world begin-world
sobel-uniforms boa ;
: draw-sobel ( world -- )
T{ depth-state { comparison f } } set-gpu-state*
T{ depth-state { comparison f } } set-gpu-state
sobel>> {
{ "primitive-mode" [ drop triangle-strip-mode ] }
@ -260,7 +260,7 @@ BEFORE: bunny-world begin-world
[ draw-bunny ] [ draw-sobel ] bi ;
: draw-loading ( world -- )
T{ depth-state { comparison f } } set-gpu-state*
T{ depth-state { comparison f } } set-gpu-state
loading>> {
{ "primitive-mode" [ drop triangle-strip-mode ] }

14
extra/gpu/textures/textures-docs.factor
View File

@ -1,5 +1,5 @@
! (c)2009 Joe Groff bsd license
USING: byte-arrays classes gpu.buffers help.markup help.syntax
USING: alien byte-arrays classes gpu.buffers help.markup help.syntax
images kernel math ;
IN: gpu.textures
@ -228,7 +228,11 @@ HELP: texture-cube-map
{ texture-cube-map <texture-cube-map> } related-words
HELP: texture-data
{ $class-description { $snippet "texture-data" } " tuples are used to feed image data to " { $link allocate-texture } " and " { $link update-texture } ". In addition to providing a " { $snippet "ptr" } " to CPU memory or a GPU " { $link buffer-ptr } ", the " { $link texture-data } " object also specifies the " { $link component-order } " and " { $link component-type } " of the referenced data." }
{ $class-description { $snippet "texture-data" } " tuples are used to feed image data to " { $link allocate-texture } " and " { $link update-texture } "."
{ $list
{ "The " { $snippet "ptr" } " slot references either CPU memory (as a " { $link byte-array } " or " { $link alien } ") or a GPU " { $link buffer-ptr } " that contains the image data." }
{ "The " { $snippet "component-order" } " and " { $snippet "component-type" } " slots determine the " { $link component-order } " and " { $link component-type } " of the referenced data." }
} }
{ $notes "Using a " { $link buffer-ptr } " as the " { $snippet "ptr" } " of a " { $snippet "texture-data" } " object requires OpenGL 2.1 or later or the " { $snippet "GL_ARB_pixel_buffer_object" } " extension." } ;
{ texture-data <texture-data> } related-words
@ -254,15 +258,15 @@ HELP: texture-filter
{ $class-description { $snippet "texture-filter" } " values are used in a " { $link texture-parameters } " tuple to determine how a texture should be sampled between pixels or between levels of detail. " { $link filter-linear } " selects linear filtering, while " { $link filter-nearest } " selects nearest-neighbor sampling." } ;
HELP: texture-parameters
{ $class-description "When a " { $link texture } " is created, the following " { $snippet "texture-parameter" } "s are set to control how the texture is sampled:"
{ $class-description "A " { $snippet "texture-parameters" } " tuple is supplied when constructing a " { $link texture } " to control the wrapping, filtering, and level-of-detail handling of the texture. These tuples have the following slots:"
{ $list
{ "The " { $snippet "wrap" } " slot determines how texture coordinates outside the 0.0 to 1.0 range are mapped to the texture image. The slot either contains a single " { $link texture-wrap } " value, which will apply to all three axes, or a sequence of up to three values, which will apply to the S, T, and R axes, respectively." }
{ "The " { $snippet "min-filter" } " and " { $snippet "min-mipmap-filter" } " determine how the texture image is filtered when sampled below its highest level of detail, the former controlling filtering between pixels within a level of detail and the latter filtering between levels of detail. A setting of " { $link filter-linear } " uses linear, bilinear, or trilinear filtering among sampled pixels, while a setting of " { $link filter-nearest } " uses nearest-neighbor sampling. The " { $snippet "min-mipmap-filter" } " slot may additionally be set to " { $link f } " to disable mipmapping and only sample the highest level of detail." }
{ "The " { $snippet "min-filter" } " and " { $snippet "min-mipmap-filter" } " determine how the texture image is filtered when sampled below its highest level of detail, the former filtering between pixels within a level of detail and the latter filtering between levels of detail. A setting of " { $link filter-linear } " uses linear, bilinear, or trilinear filtering among the sampled pixels, while a setting of " { $link filter-nearest } " uses nearest-neighbor sampling. The " { $snippet "min-mipmap-filter" } " slot may additionally be set to " { $link f } " to disable mipmapping and only sample the highest level of detail." }
{ "The " { $snippet "mag-filter" } " analogously determines how the texture image is filtered when sampled above its highest level of detail." }
{ "The " { $snippet "min-lod" } " and " { $snippet "max-lod" } " slots contain integer values that will clamp the range of levels of detail that will be sampled from the texture." }
{ "The " { $snippet "lod-bias" } " slot contains an integer value that will offset the levels of detail that would normally be sampled from the texture." }
{ "The " { $snippet "base-level" } " slot contains an integer value that identifies the highest level of detail for the image, typically zero." }
{ "The " { $snippet "max-level" } " slot contains an integer value that identifies the lowest level of detail for the image. This value will automatically be clamped to the maximum of the base-2 logarithm of the dimensions of the highest level of detail image." }
{ "The " { $snippet "max-level" } " slot contains an integer value that identifies the lowest level of detail for the image. This value will automatically be clamped to the maximum of the base-2 logarithms of the dimensions of the highest level of detail image." }
} } ;
{ texture-parameters set-texture-parameters } related-words

4
extra/gpu/textures/textures.factor
View File

@ -26,14 +26,14 @@ TUPLE: cube-map-face
{ axis cube-map-axis read-only } ;
C: <cube-map-face> cube-map-face
UNION: texture-data-target
texture-1d texture-2d texture-3d cube-map-face ;
UNION: texture-1d-data-target
texture-1d ;
UNION: texture-2d-data-target
texture-2d texture-rectangle texture-1d-array cube-map-face ;
UNION: texture-3d-data-target
texture-3d texture-2d-array ;
UNION: texture-data-target
texture-1d-data-target texture-2d-data-target texture-3d-data-target ;
M: texture dispose
[ [ delete-texture ] when* f ] change-handle drop ;