Merge branch 'master' into new_ui

db4
Slava Pestov 2009-02-15 04:07:51 -06:00
commit 634435d816
6 changed files with 46 additions and 7 deletions

View File

@ -55,7 +55,7 @@ GENERIC: emit-node ( node -- next )
: begin-word ( -- )
#! We store the basic block after the prologue as a loop
#! labelled by the current word, so that self-recursive
#! labeled by the current word, so that self-recursive
#! calls can skip an epilogue/prologue.
##prologue
##branch

View File

@ -85,10 +85,10 @@ image-link = "[[image:" link-content "|" link-content "]]"
simple-link = "[[" link-content "]]"
=> [[ second >string dup simple-link-title link boa ]]
labelled-link = "[[" link-content "|" link-content "]]"
labeled-link = "[[" link-content "|" link-content "]]"
=> [[ [ second >string ] [ fourth >string ] bi link boa ]]
link = image-link | labelled-link | simple-link
link = image-link | labeled-link | simple-link
escaped-char = "\" .
=> [[ second 1string ]]

View File

@ -5,7 +5,7 @@ compression.lzw constructors endian fry grouping images io
io.binary io.encodings.ascii io.encodings.binary
io.encodings.string io.encodings.utf8 io.files kernel math
math.bitwise math.order math.parser pack prettyprint sequences
strings math.vectors ;
strings math.vectors specialized-arrays.float ;
IN: images.tiff
TUPLE: tiff-image < image ;
@ -343,6 +343,27 @@ ERROR: unknown-component-order ifd ;
[ unknown-component-order ]
} case ;
: handle-alpha-data ( ifd -- ifd )
dup extra-samples find-tag {
{ extra-samples-associated-alpha-data [
[
B{ } like dup
byte-array>float-array
4 <sliced-groups>
[
dup fourth dup 0 = [
2drop
] [
[ 3 head-slice ] dip '[ _ / ] change-each
] if
] each
] change-bitmap
] }
{ extra-samples-unspecified-alpha-data [
] }
[ bad-extra-samples ]
} case ;
: ifd>image ( ifd -- image )
{
[ [ image-width find-tag ] [ image-length find-tag ] bi 2array ]
@ -364,6 +385,7 @@ ERROR: unknown-component-order ifd ;
strips>bitmap
fix-bitmap-endianness
strips-predictor
dup extra-samples tag? [ handle-alpha-data ] when
drop
] each
] with-endianness

View File

@ -57,6 +57,13 @@ HELP: with-system-random
{ with-random with-secure-random with-system-random } related-words
HELP: randomize
{ $values
{ "seq" sequence }
{ "seq" sequence }
}
{ $description "Randomizes a sequence in-place with the Fisher-Yates algorithm and returns the sequence." } ;
HELP: delete-random
{ $values
{ "seq" sequence }
@ -83,6 +90,8 @@ $nl
{ $subsection with-secure-random }
"Implementation:"
{ $subsection "random-protocol" }
"Randomizing a sequence:"
{ $subsection randomize }
"Deleting a random element from a sequence:"
{ $subsection delete-random } ;

View File

@ -1,5 +1,5 @@
USING: random sequences tools.test kernel math math.functions
sets ;
sets grouping random.private ;
IN: random.tests
[ 4 ] [ 4 random-bytes length ] unit-test
@ -17,3 +17,9 @@ IN: random.tests
[ t ] [ 1000 [ 400 random ] replicate prune length 256 > ] unit-test
[ f ] [ 0 random ] unit-test
[ { } ] [ { } randomize ] unit-test
[ { 1 } ] [ { 1 } randomize ] unit-test
[ f ]
[ 100 [ { 0 1 } random ] replicate all-equal? ] unit-test

View File

@ -52,8 +52,10 @@ PRIVATE>
[ length random-integer ] keep nth
] if-empty ;
: randomize ( seq -- seq' )
dup length 1 (a,b] [ dup random pick exchange ] each ;
: randomize ( seq -- seq )
dup length [ dup 1 > ]
[ [ random ] [ 1- ] bi [ pick exchange ] keep ]
[ ] while drop ;
: delete-random ( seq -- elt )
[ length random-integer ] keep [ nth ] 2keep delete-nth ;