fix cloning weirdness in images rotation tests
parent
2ff32e838e
commit
a59bf32a33
extra/images/processing/rotation
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue