From 13dc01dbc4c58782f8ef67299912bbc5593d8a4c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= Date: Sun, 9 Mar 2014 13:08:23 +0100 Subject: [PATCH] images.*: fix all image>stream words in extra so that they work with the added parameter --- extra/images/bitmap/bitmap.factor | 3 +-- extra/images/pbm/pbm.factor | 2 +- extra/images/ppm/ppm.factor | 4 ++-- extra/images/testing/testing.factor | 13 +++++++------ extra/images/tga/tga.factor | 23 +++++++++++------------ 5 files changed, 22 insertions(+), 23 deletions(-) diff --git a/extra/images/bitmap/bitmap.factor b/extra/images/bitmap/bitmap.factor index fd5df488c8..80a975d887 100644 --- a/extra/images/bitmap/bitmap.factor +++ b/extra/images/bitmap/bitmap.factor @@ -428,5 +428,4 @@ M: bmp-image stream>image* ( stream bmp-image -- bitmap ) ] bi ; M: bmp-image image>stream - drop BGR reorder-components output-bmp ; - + 2drop BGR reorder-components output-bmp ; diff --git a/extra/images/pbm/pbm.factor b/extra/images/pbm/pbm.factor index 35e14cc9a6..efba26c7b2 100644 --- a/extra/images/pbm/pbm.factor +++ b/extra/images/pbm/pbm.factor @@ -76,7 +76,7 @@ M: pbm-image stream>image* drop [ [ read-pbm ] throw-on-eof ] with-input-stream ; M: pbm-image image>stream - drop { + 2drop { [ drop "P4\n" ascii encode write ] [ dim>> first number>string " " append ascii encode write ] [ dim>> second number>string "\n" append ascii encode write ] diff --git a/extra/images/ppm/ppm.factor b/extra/images/ppm/ppm.factor index 865f377fbc..326edc8f11 100755 --- a/extra/images/ppm/ppm.factor +++ b/extra/images/ppm/ppm.factor @@ -38,7 +38,7 @@ SINGLETON: ppm-image { "P3" [ [ 0 npixels read-numbers ] B{ } make ] } { "P6" [ npixels read ] } } case :> data - + image new RGB >>component-order { width height } >>dim @@ -50,7 +50,7 @@ M: ppm-image stream>image* drop [ [ read-ppm ] throw-on-eof ] with-input-stream ; M: ppm-image image>stream - drop { + 2drop { [ drop "P6\n" ascii encode write ] [ dim>> first number>string " " append ascii encode write ] [ dim>> second number>string "\n" append ascii encode write ] diff --git a/extra/images/testing/testing.factor b/extra/images/testing/testing.factor index a23a548c25..c56c60fbf8 100644 --- a/extra/images/testing/testing.factor +++ b/extra/images/testing/testing.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2009 Keith Lazuka. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors fry images images.loader images.normalization -images.viewer io io.backend io.directories io.encodings.binary -io.files io.pathnames io.streams.byte-array kernel locals +USING: accessors assocs fry images images.loader images.normalization +images.loader.private images.viewer io io.backend io.directories +io.encodings.binary io.files io.pathnames io.streams.byte-array kernel locals namespaces quotations random sequences serialize tools.test ; IN: images.testing @@ -42,8 +42,9 @@ PRIVATE> f verbose-tests? [ path load-image dup clone normalize-image 1quotation swap '[ - binary [ _ image-class image>stream ] with-byte-writer - image-class load-image* normalize-image + binary [ + _ image-class [ types get value-at ] keep image>stream + ] with-byte-writer image-class load-image* normalize-image ] unit-test ] with-variable ; @@ -53,7 +54,7 @@ PRIVATE> [ '[ _ load-reference-image ] ] bi unit-test ] with-variable ; - + : ( -- image ) RGB >>component-order diff --git a/extra/images/tga/tga.factor b/extra/images/tga/tga.factor index f2fd8e8660..70ab3e1df9 100644 --- a/extra/images/tga/tga.factor +++ b/extra/images/tga/tga.factor @@ -21,7 +21,7 @@ ERROR: bad-tga-unsupported ; : read-color-map-type ( -- byte ) 1 read le> dup { 0 1 } member? [ bad-tga-header ] unless ; - + : read-image-type ( -- byte ) 1 read le> dup { 0 1 2 3 9 10 11 } member? [ bad-tga-header ] unless ; inline @@ -167,7 +167,7 @@ ERROR: bad-tga-unsupported ; [ first ] [ dup third second seek-absolute seek-input read ] bi 2array ] map >hashtable ; inline - + :: read-tga ( -- image ) #! Read header read-id-length :> id-length @@ -185,7 +185,7 @@ ERROR: bad-tga-unsupported ; id-length read-image-id :> image-id map-type map-length map-entry-size read-color-map :> color-map-data image-width image-height pixel-depth read-image-data :> image-data - + [ #! Read optional footer 26 seek-end seek-input @@ -208,11 +208,11 @@ ERROR: bad-tga-unsupported ; read-key-color :> key-color read-pixel-aspect-ratio :> aspect-ratio read-gamma-value :> gamma-value - read-color-correction-offset :> color-correction-offset + read-color-correction-offset :> color-correction-offset read-postage-stamp-offset :> postage-stamp-offset read-scan-line-offset :> scan-line-offset read-premultiplied-alpha :> premultiplied-alpha - + color-correction-offset 0 = [ color-correction-offset seek-absolute seek-input @@ -224,10 +224,10 @@ ERROR: bad-tga-unsupported ; postage-stamp-offset seek-absolute seek-input pixel-depth read-postage-stamp-image :> postage-data ] unless - + scan-line-offset seek-absolute seek-input image-height read-scan-line-table :> scan-offsets - + #! Read optional developer section directory-offset 0 = [ f ] @@ -240,11 +240,11 @@ ERROR: bad-tga-unsupported ; #! Only 24-bit uncompressed BGR and 32-bit uncompressed BGRA are supported. #! Other formats would need to be converted to work within the image class. - map-type 0 = [ bad-tga-unsupported ] unless + map-type 0 = [ bad-tga-unsupported ] unless image-type 2 = [ bad-tga-unsupported ] unless pixel-depth { 24 32 } member? [ bad-tga-unsupported ] unless pixel-order { 0 2 } member? [ bad-tga-unsupported ] unless - + #! Create image instance image new alpha-bits 0 = [ BGR ] [ BGRA ] if >>component-order @@ -252,12 +252,12 @@ ERROR: bad-tga-unsupported ; pixel-order 0 = >>upside-down? image-data >>bitmap ubyte-components >>component-type ; - + M: tga-image stream>image* drop [ [ read-tga ] throw-on-eof ] with-input-stream ; M: tga-image image>stream - drop + 2drop [ component-order>> { BGRA BGRA } member? [ bad-tga-unsupported ] unless ] keep @@ -287,4 +287,3 @@ M: tga-image image>stream ] [ bitmap>> write ] } cleave ; -