use singletons instead of subclassing the image class

diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor
index 2ee7c2514c7cd01fb4d0a5f4490b7831d39a6b66..4f2ad720b63c337f3b7b446ce968862a753c9830 100755 (executable)
--- a/basis/images/bitmap/bitmap.factor
+++ b/basis/images/bitmap/bitmap.factor
@@ -15,7 +15,8 @@ IN: images.bitmap
 : write2 ( n -- ) 2 >le write ;
 : write4 ( n -- ) 4 >le write ;
 
-TUPLE: bitmap-image < image ;
+SINGLETON: bitmap-image
+"bmp" bitmap-image register-image-class
 
 TUPLE: loading-bitmap 
 magic size reserved1 reserved2 offset header-length width
@@ -247,7 +248,9 @@ ERROR: unknown-component-order bitmap ;
         [ unknown-component-order ]
     } case ;
 
-: loading-bitmap>image ( image loading-bitmap -- bitmap-image )
+M: bitmap-image load-image* ( path bitmap-image -- bitmap )
+    drop load-bitmap
+    [ image new ] dip
     {
         [ loading-bitmap>bytes >>bitmap ]
         [ [ width>> ] [ height>> abs ] bi 2array >>dim ]
@@ -256,11 +259,6 @@ ERROR: unknown-component-order bitmap ;
         [ bitmap>component-order >>component-order ]
     } cleave ;
 
-M: bitmap-image load-image* ( path loading-bitmap -- bitmap )
-    swap load-bitmap loading-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 62c4f7e2ed3cf60c0b481d3186ddf2168764ae76..4c76b85459ec14c62c8187e22419ede4cb292ab4 100755 (executable)
--- a/basis/images/images.factor
+++ b/basis/images/images.factor
@@ -34,14 +34,7 @@ TUPLE: image dim component-order upside-down? bitmap ;
 
 : has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
 
-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 ;
+GENERIC: load-image* ( path class -- image )
 
 <PRIVATE
 

diff --git a/basis/images/jpeg/jpeg.factor b/basis/images/jpeg/jpeg.factor
index 9d44aa1187e69088e9a86e3d41f51856746772c3..2cdc32e9df5bbd71812b441b170c62f9e6dae43f 100755 (executable)
--- a/basis/images/jpeg/jpeg.factor
+++ b/basis/images/jpeg/jpeg.factor
@@ -7,11 +7,13 @@ io.streams.byte-array kernel locals math math.bitwise
 math.constants math.functions math.matrices math.order\r
 math.ranges math.vectors memoize multiline namespaces\r
 sequences sequences.deep images.loader ;\r
+QUALIFIED-WITH: bitstreams bs\r
 IN: images.jpeg\r
 \r
-QUALIFIED-WITH: bitstreams bs\r
+SINGLETON: jpeg-image\r
+{ "jpg" "jpeg" } [ jpeg-image register-image-class ] each\r
 \r
-TUPLE: jpeg-image < image\r
+TUPLE: loading-jpeg < image\r
     { headers }\r
     { bitstream }\r
     { color-info initial: { f f f f } }\r
@@ -21,7 +23,7 @@ TUPLE: jpeg-image < image
 \r
 <PRIVATE\r
 \r
-CONSTRUCTOR: jpeg-image ( headers bitstream -- image ) ;\r
+CONSTRUCTOR: loading-jpeg ( headers bitstream -- image ) ;\r
 \r
 SINGLETONS: SOF DHT DAC RST SOI EOI SOS DQT DNL DRI DHP EXP\r
 APP JPG COM TEM RES ;\r
@@ -63,7 +65,7 @@ TUPLE: jpeg-color-info
 \r
 CONSTRUCTOR: jpeg-color-info ( h v quant-table -- jpeg-color-info ) ;\r
 \r
-: jpeg> ( -- jpeg-image ) jpeg-image get ;\r
+: jpeg> ( -- jpeg-image ) loading-jpeg get ;\r
 \r
 : apply-diff ( dc color -- dc' )\r
     [ diff>> + dup ] [ (>>diff) ] bi ;\r
@@ -291,9 +293,9 @@ PRIVATE>
     binary [\r
         parse-marker { SOI } assert=\r
         parse-headers\r
-        contents <jpeg-image>\r
+        contents <loading-jpeg>\r
     ] with-file-reader\r
-    dup jpeg-image [\r
+    dup loading-jpeg [\r
         baseline-parse\r
         baseline-decompress\r
         jpeg> bitmap>> 3 <groups> [ color-transform ] change-each\r
@@ -302,5 +304,3 @@ 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 19f2fd12c8d1ce572494d97140ddd8c8e7454723..51d4e0fadffdb80ff21bb6914c7bc1e6bb393d8c 100644 (file)
--- a/basis/images/loader/loader.factor
+++ b/basis/images/loader/loader.factor
@@ -7,16 +7,18 @@ IN: images.loader
 ERROR: unknown-image-extension extension ;
 
 <PRIVATE
+
 SYMBOL: types
 types [ H{ } clone ] initialize
 
 : image-class ( path -- class )
     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* ;
+    dup image-class load-image* ;

diff --git a/basis/images/png/png.factor b/basis/images/png/png.factor
index b8a9a1d569d6bb6c8a0cabd8aa2c1f870674510f..fd5e36e2125eac6c2202b2a37d2af893ec582dea 100755 (executable)
--- a/basis/images/png/png.factor
+++ b/basis/images/png/png.factor
@@ -7,12 +7,15 @@ checksums checksums.crc32 compression.inflate grouping byte-arrays
 images.loader ;
 IN: images.png
 
-TUPLE: png-image < image chunks
+SINGLETON: png-image
+"png" png-image register-image-class
+
+TUPLE: loading-png < image chunks
 width height bit-depth color-type compression-method
 filter-method interlace-method uncompressed ;
 
-CONSTRUCTOR: png-image ( -- image )
-V{ } clone >>chunks ;
+CONSTRUCTOR: loading-png ( -- image )
+    V{ } clone >>chunks ;
 
 TUPLE: png-chunk length type data ;
 
@@ -105,7 +108,7 @@ ERROR: unimplemented-color-type image ;
 
 : load-png ( path -- image )
     binary stream-throws <limited-file-reader> [
-        <png-image>
+        <loading-png>
         read-png-header
         read-png-chunks
         parse-ihdr-chunk
@@ -115,5 +118,3 @@ 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 c98f737b11f73bae1fc14dc0aa372c50a242d5fe..6b2de12d51cd480fb9a0d996cfc29d58c9a5c336 100755 (executable)
--- a/basis/images/tiff/tiff.factor
+++ b/basis/images/tiff/tiff.factor
@@ -9,7 +9,7 @@ strings math.vectors specialized-arrays.float locals
 images.loader ;
 IN: images.tiff
 
-TUPLE: tiff-image < image ;
+SINGLETON: tiff-image
 
 TUPLE: parsed-tiff endianness the-answer ifd-offset ifds ;
 CONSTRUCTOR: parsed-tiff ( -- tiff ) V{ } clone >>ifds ;
@@ -483,18 +483,6 @@ ERROR: unknown-component-order ifd ;
         [ unknown-component-order ]
     } case ;
 
-: normalize-alpha-data ( seq -- byte-array )
-    B{ } like dup
-    byte-array>float-array
-    4 <sliced-groups>
-    [
-        dup fourth dup 0 = [
-            2drop
-        ] [
-            [ 3 head-slice ] dip '[ _ / ] change-each
-        ] if
-    ] each ;
-
 : handle-alpha-data ( ifd -- ifd )
     dup extra-samples find-tag {
         { extra-samples-associated-alpha-data [ ] }
@@ -508,7 +496,7 @@ ERROR: unknown-component-order ifd ;
         [ [ image-width find-tag ] [ image-length find-tag ] bi 2array ]
         [ ifd-component-order f ]
         [ bitmap>> ]
-    } cleave tiff-image boa ;
+    } cleave image boa ;
 
 : tiff>image ( image -- image )
     ifds>> [ ifd>image ] map first ;