diff --git a/basis/images/authors.txt b/basis/images/authors.txt index b4bd0e7b35..a4a77d97e9 100644 --- a/basis/images/authors.txt +++ b/basis/images/authors.txt @@ -1 +1,2 @@ -Doug Coleman \ No newline at end of file +Doug Coleman +Daniel Ehrenberg diff --git a/basis/images/images-tests.factor b/basis/images/images-tests.factor new file mode 100644 index 0000000000..39e8b4a364 --- /dev/null +++ b/basis/images/images-tests.factor @@ -0,0 +1,29 @@ +! Copyright (C) 2009 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. +USING: images tools.test kernel accessors ; +IN: images.tests + +[ B{ 57 57 57 255 } ] [ 1 1 T{ image f { 2 3 } RGBA f B{ + 0 0 0 0 + 0 0 0 0 + 0 0 0 0 + 0 0 0 0 + 57 57 57 255 + 0 0 0 0 +} } pixel-at ] unit-test + +[ B{ + 0 0 0 0 + 0 0 0 0 + 0 0 0 0 + 0 0 0 0 + 57 57 57 255 + 0 0 0 0 +} ] [ B{ 57 57 57 255 } 1 1 T{ image f { 2 3 } RGBA f B{ + 0 0 0 0 + 0 0 0 0 + 0 0 0 0 + 0 0 0 0 + 0 0 0 0 + 0 0 0 0 +} } [ set-pixel-at ] keep bitmap>> ] unit-test diff --git a/basis/images/images.factor b/basis/images/images.factor index 178b91ab52..ed317b4685 100755 --- a/basis/images/images.factor +++ b/basis/images/images.factor @@ -1,6 +1,6 @@ -! Copyright (C) 2009 Doug Coleman. +! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: combinators kernel accessors ; +USING: combinators kernel accessors sequences math ; IN: images SINGLETONS: L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR @@ -35,3 +35,21 @@ TUPLE: image dim component-order upside-down? bitmap ; : has-alpha? ( image -- ? ) component-order>> alpha-channel? ; GENERIC: load-image* ( path tuple -- image ) + +> second * + ] + [ component-order>> bytes-per-pixel [ * dup ] keep + ] + [ bitmap>> ] tri ; + +: set-subseq ( new-value from to victim -- ) + 0 swap copy ; inline + +PRIVATE> + +: pixel-at ( x y image -- pixel ) + pixel@ subseq ; + +: set-pixel-at ( pixel x y image -- ) + pixel@ set-subseq ;