Paste: rotate image [ take #2 ] WIP

Author: randy7
Mode: factor
Date: Thu, 7 May 2009 09:02:27
Plain Text | 
USING: arrays images.loader grouping colors images images.bitmap sequences accessors kernel math 
combinators fry images.normalization ;

IN: image-rotate

: (rotate-90) ( seq^3 -- seq^3 ) ! seq^3: pixels(byte-array) inside rows inside array.
    flip [ reverse ] map ;

: (rotate-180) ( seq^3 -- seq^3 )
    reverse [ reverse ] map ;
    
: (rotate-270) ( seq^3 -- seq^3 )
    flip reverse ;

: (n-rotate) ( seq n -- image )
    360 mod
    {
        { 0   [ ]              }
        { 90  [ (rotate-90) ]  }
        { 180 [ (rotate-180) ] }
        { 270 [ (rotate-270) ] }
        [ "unsupported rotation" throw ]
    } case ;
    
    
: pad ( byte-row -- byte-row' )
    dup length 4 mod 4 swap - 0 <array> append ;
    
: maybe-remove-pad ( pixels -- pixels' )
    dup [ first length ] [ peek length ] bi = not [ but-last ] when ;

    
: row-length ( image -- n ) 
    [ bitmap>> length ] [ dim>> second ] bi /i ;
    
: image>byte-rows ( image -- byte-rows )
    [ bitmap>> ] [ row-length ] bi group ;

: image>pixel-rows ( image -- pixel-rows )
    [ image>byte-rows ] [ component-order>> bytes-per-pixel ] bi
    '[ _ group maybe-remove-pad ] map ;

: flatten-table ( seq^3 -- seq )
    [ concat pad ] map concat ;
    
: rotate ( image n -- image ) 
    [ normalize-image  dup image>pixel-rows ] dip (n-rotate)
    flatten-table >>bitmap ;
    
: wall-mirror ( image -- image ) 
    image>pixel-rows [ reverse ] map flatten-table >>bitmap ;
: lake-mirror ( image -- image ) 
    image>pixel-rows reverse flatten-table >>bitmap ;

Annotation: oops

Author: meagain
Mode: factor
Date: Thu, 7 May 2009 09:46:54
Plain Text | 
: flatten-table ( seq^3 -- seq )
    [ concat pad ] map concat ;

: preprocess ( image -- pixelrows )
    normalize-image image>pixel-rows ;
    
: rotate ( image n -- image ) 
    [ dup preprocess ] dip (n-rotate)
    flatten-table >>bitmap ;
    
: wall-mirror ( image -- image ) 
    dup preprocess [ reverse ] map flatten-table >>bitmap ;
: lake-mirror ( image -- image ) 
    dup preprocess reverse flatten-table >>bitmap ;

New Annotation

Summary:
Author:
Mode:
Body: