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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
extra/images/processing/rotation/rotation-tests.factor
View File

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

7
extra/images/processing/rotation/rotation.factor
View File

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