From 4e206f41813beeb9f1b056439219243ee355952f Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Fri, 14 Mar 2014 07:31:27 -0700
Subject: [PATCH] images.loader: optionally register "non-system" image
classes.
---
basis/images/loader/loader.factor | 3 +++
extra/images/bitmap/bitmap.factor | 2 +-
extra/images/gif/gif.factor | 2 +-
extra/images/pbm/pbm.factor | 2 +-
extra/images/pgm/pgm.factor | 2 +-
extra/images/png/png.factor | 2 +-
extra/images/ppm/ppm.factor | 2 +-
extra/images/tga/tga.factor | 2 +-
extra/images/tiff/tiff.factor | 2 +-
unmaintained/images/jpeg/jpeg.factor | 3 +--
10 files changed, 12 insertions(+), 10 deletions(-)
diff --git a/basis/images/loader/loader.factor b/basis/images/loader/loader.factor
index a97315f884..a50391b1bd 100644
--- a/basis/images/loader/loader.factor
+++ b/basis/images/loader/loader.factor
@@ -32,6 +32,9 @@ GENERIC: stream>image* ( stream class -- image )
: register-image-class ( extension class -- )
swap types get set-at ;
+: ?register-image-class ( extension class -- )
+ over types get key? [ 2drop ] [ register-image-class ] if ;
+
: load-image ( path -- image )
[ binary <file-reader> ] [ image-class ] bi load-image* ;
diff --git a/extra/images/bitmap/bitmap.factor b/extra/images/bitmap/bitmap.factor
index 80a975d887..2ac2326e32 100644
--- a/extra/images/bitmap/bitmap.factor
+++ b/extra/images/bitmap/bitmap.factor
@@ -14,7 +14,7 @@ IN: images.bitmap
! http://www.digicamsoft.com/bmp/bmp.html
SINGLETON: bmp-image
-"bmp" bmp-image register-image-class
+"bmp" bmp-image ?register-image-class
: write2 ( n -- ) 2 >le write ;
: write4 ( n -- ) 4 >le write ;
diff --git a/extra/images/gif/gif.factor b/extra/images/gif/gif.factor
index 25776bffdd..cdfd9d1a5a 100644
--- a/extra/images/gif/gif.factor
+++ b/extra/images/gif/gif.factor
@@ -7,7 +7,7 @@ kernel make math math.bitwise namespaces sequences ;
IN: images.gif
SINGLETON: gif-image
-"gif" gif-image register-image-class
+"gif" gif-image ?register-image-class
TUPLE: loading-gif
loading?
diff --git a/extra/images/pbm/pbm.factor b/extra/images/pbm/pbm.factor
index efba26c7b2..ae1b258246 100644
--- a/extra/images/pbm/pbm.factor
+++ b/extra/images/pbm/pbm.factor
@@ -7,7 +7,7 @@ sequences io.streams.throwing ;
IN: images.pbm
SINGLETON: pbm-image
-"pbm" pbm-image register-image-class
+"pbm" pbm-image ?register-image-class
<PRIVATE
: read-token ( -- token )
diff --git a/extra/images/pgm/pgm.factor b/extra/images/pgm/pgm.factor
index d8e1033c90..d7ea44c886 100644
--- a/extra/images/pgm/pgm.factor
+++ b/extra/images/pgm/pgm.factor
@@ -7,7 +7,7 @@ SPECIALIZED-ARRAY: ushort
IN: images.pgm
SINGLETON: pgm-image
-"pgm" pgm-image register-image-class
+"pgm" pgm-image ?register-image-class
: read-token ( -- token )
[ read1 dup blank?
diff --git a/extra/images/png/png.factor b/extra/images/png/png.factor
index f39285ad38..ffd0a7a09d 100644
--- a/extra/images/png/png.factor
+++ b/extra/images/png/png.factor
@@ -11,7 +11,7 @@ QUALIFIED: math
IN: images.png
SINGLETON: png-image
-"png" png-image register-image-class
+"png" png-image ?register-image-class
TUPLE: loading-png
chunks
diff --git a/extra/images/ppm/ppm.factor b/extra/images/ppm/ppm.factor
index 326edc8f11..34d3a288b0 100755
--- a/extra/images/ppm/ppm.factor
+++ b/extra/images/ppm/ppm.factor
@@ -6,7 +6,7 @@ math.parser sequences io.streams.throwing ;
IN: images.ppm
SINGLETON: ppm-image
-"ppm" ppm-image register-image-class
+"ppm" ppm-image ?register-image-class
: read-token ( -- token )
[ read1 dup blank?
diff --git a/extra/images/tga/tga.factor b/extra/images/tga/tga.factor
index 70ab3e1df9..debf66d0f3 100644
--- a/extra/images/tga/tga.factor
+++ b/extra/images/tga/tga.factor
@@ -7,7 +7,7 @@ ui.pixel-formats combinators continuations io.streams.throwing ;
IN: images.tga
SINGLETON: tga-image
-"tga" tga-image register-image-class
+"tga" tga-image ?register-image-class
ERROR: bad-tga-header ;
ERROR: bad-tga-footer ;
diff --git a/extra/images/tiff/tiff.factor b/extra/images/tiff/tiff.factor
index bdba422fd8..5abf233a2f 100755
--- a/extra/images/tiff/tiff.factor
+++ b/extra/images/tiff/tiff.factor
@@ -563,4 +563,4 @@ ERROR: unknown-component-order ifd ;
M: tiff-image stream>image* ( stream tiff-image -- image )
drop [ [ load-tiff tiff>image ] throw-on-eof ] with-input-stream ;
-{ "tif" "tiff" } [ tiff-image register-image-class ] each
+{ "tif" "tiff" } [ tiff-image ?register-image-class ] each
diff --git a/unmaintained/images/jpeg/jpeg.factor b/unmaintained/images/jpeg/jpeg.factor
index d18412e0c1..4b530091ee 100644
--- a/unmaintained/images/jpeg/jpeg.factor
+++ b/unmaintained/images/jpeg/jpeg.factor
@@ -21,8 +21,7 @@ TUPLE: loading-jpeg < image
{ huff-tables initial: { f f f f } }
{ components } ;
-"jpg" jpeg-image register-image-class
-"jpeg" jpeg-image register-image-class
+{ "jpg" "jpeg" } [ jpeg-image ?register-image-class ] each
<PRIVATE