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

db4
Doug Coleman 2009-09-01 18:16:31 -05:00
commit b282dd9eac
4 changed files with 24 additions and 25 deletions

View File

@ -51,5 +51,5 @@ M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-in
M: freebsd file-systems ( -- array ) M: freebsd file-systems ( -- array )
f 0 0 getfsstat dup io-error f 0 0 getfsstat dup io-error
\ statfs <struct-array> \ statfs <struct-array>
[ dup length 0 getfsstat io-error ] [ dup byte-length 0 getfsstat io-error ]
[ [ f_mntonname>> utf8 alien>string file-system-info ] map ] bi ; [ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;

View File

@ -48,5 +48,5 @@ M: netbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-inf
M: netbsd file-systems ( -- array ) M: netbsd file-systems ( -- array )
f 0 0 getvfsstat dup io-error f 0 0 getvfsstat dup io-error
\ statvfs <struct-array> \ statvfs <struct-array>
[ dup length 0 getvfsstat io-error ] [ dup byte-length 0 getvfsstat io-error ]
[ [ f_mntonname>> utf8 alien>string file-system-info ] map ] bi ; [ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;

View File

@ -49,5 +49,5 @@ M: openbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-in
M: openbsd file-systems ( -- seq ) M: openbsd file-systems ( -- seq )
f 0 0 getfsstat dup io-error f 0 0 getfsstat dup io-error
\ statfs <struct-array> \ statfs <struct-array>
[ dup length 0 getfsstat io-error ] [ dup byte-length 0 getfsstat io-error ]
[ [ f_mntonname>> utf8 alien>string file-system-info ] map ] bi ; [ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;

View File

@ -1,9 +1,8 @@
USING: accessors arrays byte-arrays combinators USING: accessors arrays byte-arrays combinators
combinators.short-circuit fry hints images kernel locals math combinators.short-circuit fry hints images kernel locals math
math.affine-transforms math.functions math.order math.affine-transforms math.functions math.order math.polynomials
math.polynomials math.private math.vectors random math.vectors random random.mersenne-twister sequences
random.mersenne-twister sequences sequences.private sequences.private sequences.product ;
sequences.product ;
IN: noise IN: noise
: <perlin-noise-table> ( -- table ) : <perlin-noise-table> ( -- table )
@ -35,25 +34,25 @@ HINTS: (fade) { float float float } ;
HINTS: grad { fixnum float float float } ; HINTS: grad { fixnum float float float } ;
: unit-cube ( point -- cube ) : unit-cube ( point -- cube )
[ floor >fixnum 256 rem ] map ; [ floor 256 rem ] map ;
:: hashes ( table x y z -- aaa baa aba bba aab bab abb bbb ) :: hashes ( table x y z -- aaa baa aba bba aab bab abb bbb )
x table nth-unsafe y fixnum+fast :> a x table nth-unsafe y + :> a
x 1 fixnum+fast table nth-unsafe y fixnum+fast :> b x 1 + table nth-unsafe y + :> b
a table nth-unsafe z fixnum+fast :> aa a table nth-unsafe z + :> aa
b table nth-unsafe z fixnum+fast :> ba b table nth-unsafe z + :> ba
a 1 fixnum+fast table nth-unsafe z fixnum+fast :> ab a 1 + table nth-unsafe z + :> ab
b 1 fixnum+fast table nth-unsafe z fixnum+fast :> bb b 1 + table nth-unsafe z + :> bb
aa table nth-unsafe aa table nth-unsafe
ba table nth-unsafe ba table nth-unsafe
ab table nth-unsafe ab table nth-unsafe
bb table nth-unsafe bb table nth-unsafe
aa 1 fixnum+fast table nth-unsafe aa 1 + table nth-unsafe
ba 1 fixnum+fast table nth-unsafe ba 1 + table nth-unsafe
ab 1 fixnum+fast table nth-unsafe ab 1 + table nth-unsafe
bb 1 fixnum+fast table nth-unsafe ; inline bb 1 + table nth-unsafe ; inline
HINTS: hashes { byte-array fixnum fixnum fixnum } ; HINTS: hashes { byte-array fixnum fixnum fixnum } ;