Redoing images.loader to work with jpeg

diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor
index 48095bb26bf99800da68e7252dbd170bb4c65721..04a4fae77ea214a1596b00a5fa825c632fc245ed 100755 (executable)
--- a/basis/images/bitmap/bitmap.factor
+++ b/basis/images/bitmap/bitmap.factor
@@ -3,7 +3,7 @@
 USING: accessors alien alien.c-types arrays byte-arrays columns
 combinators fry grouping io io.binary io.encodings.binary io.files
 kernel macros math math.bitwise math.functions namespaces sequences
-strings images endian summary locals ;
+strings images endian summary locals images.loader ;
 IN: images.bitmap
 
 : assert-sequence= ( a b -- )
@@ -129,6 +129,8 @@ ERROR: unknown-component-order bitmap ;
 M: bitmap-image load-image* ( path loading-bitmap -- bitmap )
     swap load-bitmap-data loading-bitmap>bitmap-image ;
 
+"bmp" bitmap-image register-image-class
+
 PRIVATE>
 
 : bitmap>color-index ( bitmap -- byte-array )

diff --git a/basis/images/images.factor b/basis/images/images.factor
index ed317b4685a3eda306887711cf7e8e93fefc96ce..62c4f7e2ed3cf60c0b481d3186ddf2168764ae76 100755 (executable)
--- a/basis/images/images.factor
+++ b/basis/images/images.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators kernel accessors sequences math ;
+USING: combinators kernel accessors sequences math arrays ;
 IN: images
 
 SINGLETONS: L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
@@ -36,10 +36,17 @@ TUPLE: image dim component-order upside-down? bitmap ;
 
 GENERIC: load-image* ( path tuple -- image )
 
+: make-image ( bitmap -- image )
+    ! bitmap is a sequence of sequences of pixels which are RGBA
+    <image>
+        over [ first length ] [ length ] bi 2array >>dim
+        RGBA >>component-order
+        swap concat concat B{ } like >>bitmap ;
+
 <PRIVATE
 
 : pixel@ ( x y image -- start end bitmap )
-    [ dim>> second * + ]
+    [ dim>> first * + ]
     [ component-order>> bytes-per-pixel [ * dup ] keep + ]
     [ bitmap>> ] tri ;
 

diff --git a/basis/images/jpeg/jpeg.factor b/basis/images/jpeg/jpeg.factor
index 648923704aa473ab78455db490984190cdc3178d..9d44aa1187e69088e9a86e3d41f51856746772c3 100755 (executable)
--- a/basis/images/jpeg/jpeg.factor
+++ b/basis/images/jpeg/jpeg.factor
@@ -6,7 +6,7 @@ images.processing io io.binary io.encodings.binary io.files
 io.streams.byte-array kernel locals math math.bitwise\r
 math.constants math.functions math.matrices math.order\r
 math.ranges math.vectors memoize multiline namespaces\r
-sequences sequences.deep ;\r
+sequences sequences.deep images.loader ;\r
 IN: images.jpeg\r
 \r
 QUALIFIED-WITH: bitstreams bs\r
@@ -302,3 +302,5 @@ PRIVATE>
 \r
 M: jpeg-image load-image* ( path jpeg-image -- bitmap )\r
     drop load-jpeg ;\r
+\r
+{ "jpg" "jpeg" } [ jpeg-image register-image-class ] each\r

diff --git a/basis/images/loader/loader.factor b/basis/images/loader/loader.factor
index d86b275635b48611f8456ec079e174c53ad64ec7..19f2fd12c8d1ce572494d97140ddd8c8e7454723 100644 (file)
--- a/basis/images/loader/loader.factor
+++ b/basis/images/loader/loader.factor
@@ -1,22 +1,22 @@
-! Copyright (C) 2009 Doug Coleman.
+! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: constructors kernel splitting unicode.case combinators
-accessors images.bitmap images.tiff images io.pathnames
-images.png ;
+accessors images io.pathnames namespaces assocs ;
 IN: images.loader
 
 ERROR: unknown-image-extension extension ;
 
+<PRIVATE
+SYMBOL: types
+types [ H{ } clone ] initialize
+
 : image-class ( path -- class )
-    file-extension >lower {
-        { "bmp" [ bitmap-image ] }
-        { "tif" [ tiff-image ] }
-        { "tiff" [ tiff-image ] }
-        ! { "jpg" [ jpeg-image ] }
-        ! { "jpeg" [ jpeg-image ] }
-        { "png" [ png-image ] }
-        [ unknown-image-extension ]
-    } case ;
+    file-extension >lower types get ?at
+    [ unknown-image-extension ] unless ;
+PRIVATE>
+
+: register-image-class ( extension class -- )
+    swap types get set-at ;
 
 : load-image ( path -- image )
     dup image-class new load-image* ;

diff --git a/basis/images/png/png.factor b/basis/images/png/png.factor
index c5b84de221910ce78d119763422fa29fd09d7c5b..d4b284142f34e2ea9922169280fb4d4f6dbf58d4 100755 (executable)
--- a/basis/images/png/png.factor
+++ b/basis/images/png/png.factor
@@ -3,7 +3,8 @@
 USING: accessors constructors images io io.binary io.encodings.ascii
 io.encodings.binary io.encodings.string io.files io.files.info kernel
 sequences io.streams.limited fry combinators arrays math
-checksums checksums.crc32 compression.inflate grouping byte-arrays ;
+checksums checksums.crc32 compression.inflate grouping byte-arrays
+images.loader ;
 IN: images.png
 
 TUPLE: png-image < image chunks
@@ -115,3 +116,5 @@ ERROR: unimplemented-color-type image ;
 
 M: png-image load-image*
     drop load-png ;
+
+"png" png-image register-image-class

diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor
index 27dc25de7374a2404da0eb8b54438d61495296ee..c98f737b11f73bae1fc14dc0aa372c50a242d5fe 100755 (executable)
--- a/basis/images/tiff/tiff.factor
+++ b/basis/images/tiff/tiff.factor
@@ -5,7 +5,8 @@ compression.lzw constructors endian fry grouping images io
 io.binary io.encodings.ascii io.encodings.binary
 io.encodings.string io.encodings.utf8 io.files kernel math
 math.bitwise math.order math.parser pack prettyprint sequences
-strings math.vectors specialized-arrays.float locals ;
+strings math.vectors specialized-arrays.float locals
+images.loader ;
 IN: images.tiff
 
 TUPLE: tiff-image < image ;
@@ -561,3 +562,5 @@ ERROR: unknown-component-order ifd ;
 ! tiff files can store several images -- we just take the first for now
 M: tiff-image load-image* ( path tiff-image -- image )
     drop load-tiff tiff>image ;
+
+{ "tif" "tiff" } [ tiff-image register-image-class ] each

diff --git a/basis/ui/images/images.factor b/basis/ui/images/images.factor
index 2b1caa8ab9d3fc95bbfcdfc7ec5ccf0738fb8efa..519217a6442d8e5f38c8bafde8767eb96140ea8a 100755 (executable)
--- a/basis/ui/images/images.factor
+++ b/basis/ui/images/images.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces cache images images.loader accessors assocs
 kernel opengl opengl.gl opengl.textures ui.gadgets.worlds
-memoize ;
+memoize images.tiff ;
 IN: ui.images
 
 TUPLE: image-name path ;
@@ -29,4 +29,4 @@ PRIVATE>
     rendered-image draw-scaled-texture ;
 
 : image-dim ( image-name -- dim )
-    cached-image dim>> ;
\ No newline at end of file
+    cached-image dim>> ;