]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/images/images.factor
Fix conflict in images vocab
[factor.git] / basis / images / images.factor
index 88051ac57d94a7b89216b2106ae6967708b5e842..82576774f49c58e5b4db7e99d8bf7b698796639e 100644 (file)
@@ -34,7 +34,7 @@ TUPLE: image dim component-order bitmap ;
 GENERIC: load-image* ( path tuple -- image )
 
 : add-dummy-alpha ( seq -- seq' )
-    3 <sliced-groups> [ 255 suffix ] map concat ;
+    3 <groups> [ 255 suffix ] map concat ;
 
 : normalize-floats ( byte-array -- byte-array )
     byte-array>float-array [ 255.0 * >integer ] B{ } map-as ;
@@ -42,8 +42,7 @@ GENERIC: load-image* ( path tuple -- image )
 GENERIC: normalize-component-order* ( image component-order -- image )
 
 : normalize-component-order ( image -- image )
-    dup component-order>> '[ _ normalize-component-order* ] change-bitmap
-    RGBA >>component-order ;
+    dup component-order>> '[ _ normalize-component-order* ] change-bitmap ;
 
 M: RGBA normalize-component-order* drop ;
 
@@ -63,8 +62,7 @@ M: R16G16B16 normalize-component-order*
     drop RGB16>8 add-dummy-alpha ;
 
 : BGR>RGB ( bitmap bytes-per-pixel -- pixels )
-    dup <sliced-groups>
-    [ 3 head-slice reverse-here ] each ; inline
+    <groups> [ 3 cut [ reverse ] dip append ] map B{ } join ; inline
 
 M: BGRA normalize-component-order*
     drop 4 BGR>RGB ;
@@ -75,6 +73,15 @@ M: RGB normalize-component-order*
 M: BGR normalize-component-order*
     drop 3 BGR>RGB add-dummy-alpha ;
 
+: ARGB>RGBA ( bitmap -- bitmap' )
+    4 <groups> [ unclip suffix ] map B{ } join ;
+
+M: ARGB normalize-component-order*
+    drop ARGB>RGBA ;
+
+M: ABGR normalize-component-order*
+    drop ARGB>RGBA 4 BGR>RGB ;
+
 GENERIC: normalize-scan-line-order ( image -- image )
 
 M: image normalize-scan-line-order ;
@@ -82,4 +89,4 @@ M: image normalize-scan-line-order ;
 : normalize-image ( image -- image )
     [ >byte-array ] change-bitmap
     normalize-component-order
-    normalize-scan-line-order ;
\ No newline at end of file
+    normalize-scan-line-order ;