Words in images to get and set pixels

diff --git a/basis/images/authors.txt b/basis/images/authors.txt
index b4bd0e7b35e6a8f0d41992b7e7faba52bb7d25da..a4a77d97e963679ec4dbe6317c19e936c2ce96d9 100644 (file)
--- 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 (file)
index 0000000..39e8b4a
--- /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 178b91ab5281d290fd28ad2edc74b320412a52fc..ed317b4685a3eda306887711cf7e8e93fefc96ce 100755 (executable)
--- 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 )
+
+<PRIVATE
+
+: pixel@ ( x y image -- start end bitmap )
+    [ dim>> second * + ]
+    [ component-order>> bytes-per-pixel [ * dup ] keep + ]
+    [ bitmap>> ] tri ;
+
+: set-subseq ( new-value from to victim -- )
+    <slice> 0 swap copy ; inline
+
+PRIVATE>
+
+: pixel-at ( x y image -- pixel )
+    pixel@ subseq ;
+
+: set-pixel-at ( pixel x y image -- )
+    pixel@ set-subseq ;