Paste: Image comparer

Author: Gertm
Mode: factor
Date: Mon, 1 Mar 2010 18:32:05
Plain Text | 
! Copyright (C) 2010 Gert Meulyzer.
! See http://factorcode.org/license.txt for BSD license.
! using dynamic variables this time

USING: accessors combinators command-line grouping images
images.bitmap images.loader images.png io io.binary
io.encodings.binary io.files io.pathnames kernel math namespaces
sequences ;
IN: imagecompare

SYMBOLS: bpp img1 img2 new-image new-name ;

: create-output-name ( x x -- ) [ file-stem ] bi@ "_" swap append append ".bmp" append "./" swap append new-name set ;

: load-imgs ( imgpath1 imgpath2 -- ) 2dup create-output-name [ load-image ] bi@ img2 set img1 set ;

: same-res? ( -- x ) img1 get img2 get [ dim>> ] bi@ = ;

: create-new ( -- ) img2 get { [ dim>> ] [ component-order>> ] [ component-type>> ] [ upside-down?>> ] } cleave f image boa new-image set ;

: to-groups ( -- g1 g2 ) img1 get img2 get [ [ bitmap>> ] [ bytes-per-pixel ] bi <groups> ] bi@ ;

: compare ( g1 g2 -- ) [ [ le> ] bi@ - 3 >le ] 2map concat new-image get swap >>bitmap new-image set ;

: write-new-img ( -- ) new-image get new-name get binary [ output-bmp ] with-file-writer ;

: do-comparison ( -- ) create-new to-groups compare write-new-img ;

: go ( x -- ) [ first ] [ second ] bi load-imgs [ same-res? ] [ do-comparison ]
    [ "Not same resolution!" print ] if ;

: cmdgo ( -- ) (command-line) go ;


MAIN: cmdgo

Annotation: variations on create-new

Author: blei
Mode: factor
Date: Mon, 1 Mar 2010 19:05:43
Plain Text | 
: create-new ( -- )
    img2 get {
        [ dim>> ]
        [ component-order>> ]
        [ component-type>> ]
        [ upside-down?>> ]
    } cleave f image boa new-image set ;

or

: create-new ( -- )
    img2 get
    { [ dim>> ] [ component-order>> ] [ component-type>> ] [ upside-down?>> ] } cleave
    f image boa new-image set ;

Annotation: Refactored Version

Author: Gertm
Mode: factor
Date: Mon, 1 Mar 2010 19:05:49
Plain Text | 
! Copyright (C) 2010 Gert Meulyzer.
! See http://factorcode.org/license.txt for BSD license.
! using dynamic variables this time

USING: accessors combinators command-line grouping images
images.bitmap images.loader images.png io io.binary
io.encodings.binary io.files io.pathnames kernel math namespaces
sequences ;
IN: imagecompare

ERROR: not-same-resolution ;

SYMBOLS: bpp img1 img2 new-image new-name ;

: create-output-name ( x x -- x ) [ file-stem ] bi@ "_" glue ".bmp" append ;

: save-output-name ( x x  -- x x ) 2dup create-output-name new-name set ;

: load-imgs ( imgpath1 imgpath2 -- ) save-output-name [ load-image ] bi@
    img2 set img1 set ;

: same-res? ( -- ? ) img1 get img2 get [ dim>> ] bi@ = ;

: create-new ( -- ) img2 get
    { [ dim>> ] [ component-order>> ] [ component-type>> ] [ upside-down?>> ] }
    cleave f image boa new-image set ;

: to-groups ( -- g1 g2 ) img1 get img2 get
    [ [ bitmap>> ] [ bytes-per-pixel ] bi <groups> ] bi@ ;

: compare ( g1 g2 -- ) [ [ le> ] bi@ - 3 >le ] 2map concat
    new-image get swap >>bitmap drop ;

: write-new-img ( -- ) new-image get new-name get
    binary [ output-bmp ] with-file-writer ;

: do-comparison ( -- ) create-new to-groups compare write-new-img ;

: go ( x -- ) first2 load-imgs same-res? [ do-comparison ]
    [ not-same-resolution throw ] if ;

: cmdgo ( -- ) (command-line) go ;


MAIN: cmdgo

New Annotation

Summary:
Author:
Mode:
Body: