fix cloning weirdness in images rotation tests

db4
Doug Coleman 2009-06-09 11:48:39 -04:00
parent 2ff32e838e
commit a59bf32a33
2 changed files with 11 additions and 20 deletions
extra/images/processing/rotation

View File

@ -21,23 +21,17 @@ IN: images.processing.rotation.tests
>>
CONSTANT: pasted-image
$[
"vocab:images/processing/rotation/test-bitmaps/PastedImage.bmp"
load-image clone-image
]
: pasted-image ( -- image )
"vocab:images/processing/rotation/test-bitmaps/PastedImage.bmp"
load-image clone-image ;
CONSTANT: pasted-image90
$[
"vocab:images/processing/rotation/test-bitmaps/PastedImage90.bmp"
load-image clone-image
]
: pasted-image90 ( -- image )
"vocab:images/processing/rotation/test-bitmaps/PastedImage90.bmp"
load-image clone-image ;
CONSTANT: lake-image
$[
"vocab:images/processing/rotation/test-bitmaps/lake.bmp"
load-image preprocess
]
: lake-image ( -- image )
"vocab:images/processing/rotation/test-bitmaps/lake.bmp"
load-image clone-image image>pixel-rows ;
[ t ] [ pasted-image dup clone-image 4 [ 90 rotate ] times = ] unit-test
[ t ] [ pasted-image dup clone-image 2 [ 180 rotate ] times = ] unit-test

View File

@ -40,20 +40,17 @@ ERROR: unsupported-rotation degrees ;
: flatten-table ( seq^3 -- seq )
[ concat ] map concat ;
: preprocess ( image -- pixelrows )
normalize-image image>pixel-rows ;
: ?reverse-dimensions ( image n -- )
{ 270 90 } member? [ [ reverse ] change-dim ] when drop ;
: normalize-degree ( n -- n' ) 360 rem ;
: processing-effect ( image quot -- image' )
'[ preprocess @ flatten-table ] [ (>>bitmap) ] [ ] tri ; inline
'[ image>pixel-rows @ flatten-table ] [ (>>bitmap) ] [ ] tri ; inline
:: rotate' ( image n -- image )
n normalize-degree :> n'
image preprocess :> pixel-table
image image>pixel-rows :> pixel-table
image n' ?reverse-dimensions
pixel-table n' (rotate) :> table-rotated
image table-rotated flatten-table >>bitmap ;