Words in images to get and set pixels

basis/images/authors.txt

@@ -1 +1,2 @@
 Doug Coleman
+Daniel Ehrenberg

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

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 ;