Redoing images.loader to work with jpeg

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 )

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 ;
 

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
 math.constants math.functions math.matrices math.order
 math.ranges math.vectors memoize multiline namespaces
-sequences sequences.deep ;
+sequences sequences.deep images.loader ;
 IN: images.jpeg
 
 QUALIFIED-WITH: bitstreams bs
@@ -302,3 +302,5 @@ PRIVATE>
 
 M: jpeg-image load-image* ( path jpeg-image -- bitmap )
     drop load-jpeg ;
+
+{ "jpg" "jpeg" } [ jpeg-image register-image-class ] each

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* ;

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

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

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>> ;
+    cached-image dim>> ;