diff --git a/extra/graphics/authors.txt b/extra/graphics/authors.txt deleted file mode 100644 index 7c1b2f2279..0000000000 --- a/extra/graphics/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/extra/graphics/bitmap/authors.txt b/extra/graphics/bitmap/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/extra/graphics/bitmap/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/extra/graphics/bitmap/bitmap-tests.factor b/extra/graphics/bitmap/bitmap-tests.factor deleted file mode 100644 index f8a125e855..0000000000 --- a/extra/graphics/bitmap/bitmap-tests.factor +++ /dev/null @@ -1,30 +0,0 @@ -USING: graphics.bitmap graphics.viewer io.encodings.binary -io.files io.files.unique kernel tools.test ; -IN: graphics.bitmap.tests - -: test-bitmap32-alpha ( -- path ) - "resource:extra/graphics/bitmap/test-images/32alpha.bmp" ; - -: test-bitmap24 ( -- path ) - "resource:extra/graphics/bitmap/test-images/thiswayup24.bmp" ; - -: test-bitmap16 ( -- path ) - "resource:extra/graphics/bitmap/test-images/rgb16bit.bmp" ; - -: test-bitmap8 ( -- path ) - "resource:extra/graphics/bitmap/test-images/rgb8bit.bmp" ; - -: test-bitmap4 ( -- path ) - "resource:extra/graphics/bitmap/test-images/rgb4bit.bmp" ; - -: test-bitmap1 ( -- path ) - "resource:extra/graphics/bitmap/test-images/1bit.bmp" ; - -[ t ] -[ - test-bitmap24 - [ binary file-contents ] [ load-bitmap ] bi - - "test-bitmap24" unique-file - [ save-bitmap ] [ binary file-contents ] bi = -] unit-test diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor deleted file mode 100755 index f8008dc7c1..0000000000 --- a/extra/graphics/bitmap/bitmap.factor +++ /dev/null @@ -1,139 +0,0 @@ -! Copyright (C) 2007, 2009 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.c-types arrays byte-arrays columns -combinators fry grouping io io.binary io.encodings.binary -io.files kernel libc macros math math.bitwise math.functions -namespaces opengl opengl.gl prettyprint sequences strings -summary ui ui.gadgets.panes ; -IN: graphics.bitmap - -! Currently can only handle 24/32bit bitmaps. -! Handles row-reversed bitmaps (their height is negative) - -TUPLE: bitmap magic size reserved offset header-length width -height planes bit-count compression size-image -x-pels y-pels color-used color-important rgb-quads color-index -alpha-channel-zero? -array ; - -: array-copy ( bitmap array -- bitmap array' ) - over size-image>> abs memory>byte-array ; - -MACRO: (nbits>bitmap) ( bits -- ) - [ -3 shift ] keep '[ - bitmap new - 2over * _ * >>size-image - swap >>height - swap >>width - swap array-copy [ >>array ] [ >>color-index ] bi - _ >>bit-count - ] ; - -: bgr>bitmap ( array height width -- bitmap ) - 24 (nbits>bitmap) ; - -: bgra>bitmap ( array height width -- bitmap ) - 32 (nbits>bitmap) ; - -: 8bit>array ( bitmap -- array ) - [ rgb-quads>> 4 [ 3 head-slice ] map ] - [ color-index>> >array ] bi [ swap nth ] with map concat ; - -ERROR: bmp-not-supported n ; - -: raw-bitmap>array ( bitmap -- array ) - dup bit-count>> - { - { 32 [ color-index>> ] } - { 24 [ color-index>> ] } - { 16 [ bmp-not-supported ] } - { 8 [ 8bit>array ] } - { 4 [ bmp-not-supported ] } - { 2 [ bmp-not-supported ] } - { 1 [ bmp-not-supported ] } - } case >byte-array ; - -ERROR: bitmap-magic ; - -M: bitmap-magic summary - drop "First two bytes of bitmap stream must be 'BM'" ; - -: read2 ( -- n ) 2 read le> ; -: read4 ( -- n ) 4 read le> ; - -: parse-file-header ( bitmap -- bitmap ) - 2 read >string dup "BM" = [ bitmap-magic ] unless >>magic - read4 >>size - read4 >>reserved - read4 >>offset ; - -: parse-bitmap-header ( bitmap -- bitmap ) - read4 >>header-length - read4 >>width - read4 >>height - read2 >>planes - read2 >>bit-count - read4 >>compression - read4 >>size-image - read4 >>x-pels - read4 >>y-pels - read4 >>color-used - read4 >>color-important ; - -: rgb-quads-length ( bitmap -- n ) - [ offset>> 14 - ] [ header-length>> ] bi - ; - -: color-index-length ( bitmap -- n ) - { - [ width>> ] - [ planes>> * ] - [ bit-count>> * 31 + 32 /i 4 * ] - [ height>> abs * ] - } cleave ; - -: parse-bitmap ( bitmap -- bitmap ) - dup rgb-quads-length read >>rgb-quads - dup color-index-length read >>color-index ; - -: (load-bitmap) ( path -- bitmap ) - binary [ - bitmap new - parse-file-header parse-bitmap-header parse-bitmap - ] with-file-reader ; - -: alpha-channel-zero? ( bitmap -- ? ) - array>> 4 3 [ 0 = ] all? ; - -: load-bitmap ( path -- bitmap ) - (load-bitmap) - dup raw-bitmap>array >>array - dup alpha-channel-zero? >>alpha-channel-zero? ; - -: write2 ( n -- ) 2 >le write ; -: write4 ( n -- ) 4 >le write ; - -: save-bitmap ( bitmap path -- ) - binary [ - B{ CHAR: B CHAR: M } write - [ - array>> length 14 + 40 + write4 - 0 write4 - 54 write4 - 40 write4 - ] [ - { - [ width>> write4 ] - [ height>> write4 ] - [ planes>> 1 or write2 ] - [ bit-count>> 24 or write2 ] - [ compression>> 0 or write4 ] - [ size-image>> write4 ] - [ x-pels>> 0 or write4 ] - [ y-pels>> 0 or write4 ] - [ color-used>> 0 or write4 ] - [ color-important>> 0 or write4 ] - [ rgb-quads>> write ] - [ color-index>> write ] - } cleave - ] bi - ] with-file-writer ; diff --git a/extra/graphics/bitmap/test-images/1bit.bmp b/extra/graphics/bitmap/test-images/1bit.bmp deleted file mode 100644 index 2f244c1d05..0000000000 Binary files a/extra/graphics/bitmap/test-images/1bit.bmp and /dev/null differ diff --git a/extra/graphics/bitmap/test-images/rgb4bit.bmp b/extra/graphics/bitmap/test-images/rgb4bit.bmp deleted file mode 100644 index 0c6f00d06c..0000000000 Binary files a/extra/graphics/bitmap/test-images/rgb4bit.bmp and /dev/null differ diff --git a/extra/graphics/bitmap/test-images/rgb8bit.bmp b/extra/graphics/bitmap/test-images/rgb8bit.bmp deleted file mode 100644 index bc95c0f94e..0000000000 Binary files a/extra/graphics/bitmap/test-images/rgb8bit.bmp and /dev/null differ diff --git a/extra/graphics/bitmap/test-images/thiswayup24.bmp b/extra/graphics/bitmap/test-images/thiswayup24.bmp deleted file mode 100644 index 202fb15371..0000000000 Binary files a/extra/graphics/bitmap/test-images/thiswayup24.bmp and /dev/null differ diff --git a/extra/graphics/tags.txt b/extra/graphics/tags.txt deleted file mode 100644 index 04b54a06f4..0000000000 --- a/extra/graphics/tags.txt +++ /dev/null @@ -1 +0,0 @@ -bitmap graphics diff --git a/extra/graphics/tiff/authors.txt b/extra/graphics/tiff/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/extra/graphics/tiff/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/extra/graphics/tiff/rgb.tiff b/extra/graphics/tiff/rgb.tiff deleted file mode 100755 index 71cbaa9d6e..0000000000 Binary files a/extra/graphics/tiff/rgb.tiff and /dev/null differ diff --git a/extra/graphics/tiff/tiff-tests.factor b/extra/graphics/tiff/tiff-tests.factor deleted file mode 100755 index f800b4d213..0000000000 --- a/extra/graphics/tiff/tiff-tests.factor +++ /dev/null @@ -1,11 +0,0 @@ -! Copyright (C) 2009 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: tools.test graphics.tiff ; -IN: graphics.tiff.tests - -: tiff-test-path ( -- path ) - "resource:extra/graphics/tiff/rgb.tiff" ; - -: tiff-test-path2 ( -- path ) - "resource:extra/graphics/tiff/octagon.tiff" ; - diff --git a/extra/graphics/tiff/tiff.factor b/extra/graphics/tiff/tiff.factor deleted file mode 100755 index 0481af8747..0000000000 --- a/extra/graphics/tiff/tiff.factor +++ /dev/null @@ -1,271 +0,0 @@ -! Copyright (C) 2009 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors combinators io io.encodings.binary io.files -kernel pack endian tools.hexdump constructors sequences arrays -sorting.slots math.order math.parser prettyprint classes -io.binary assocs math math.bitwise byte-arrays grouping ; -IN: graphics.tiff - -TUPLE: tiff endianness the-answer ifd-offset ifds ; - -CONSTRUCTOR: tiff ( -- tiff ) - V{ } clone >>ifds ; - -TUPLE: ifd count ifd-entries next -processed-tags strips buffer ; -CONSTRUCTOR: ifd ( count ifd-entries next -- ifd ) ; - -TUPLE: ifd-entry tag type count offset/value ; -CONSTRUCTOR: ifd-entry ( tag type count offset/value -- ifd-entry ) ; - -SINGLETONS: photometric-interpretation -photometric-interpretation-white-is-zero -photometric-interpretation-black-is-zero -photometric-interpretation-rgb -photometric-interpretation-palette-color ; -ERROR: bad-photometric-interpretation n ; -: lookup-photometric-interpretation ( n -- singleton ) - { - { 0 [ photometric-interpretation-white-is-zero ] } - { 1 [ photometric-interpretation-black-is-zero ] } - { 2 [ photometric-interpretation-rgb ] } - { 3 [ photometric-interpretation-palette-color ] } - [ bad-photometric-interpretation ] - } case ; - -SINGLETONS: compression -compression-none -compression-CCITT-2 -compression-lzw -compression-pack-bits ; -ERROR: bad-compression n ; -: lookup-compression ( n -- compression ) - { - { 1 [ compression-none ] } - { 2 [ compression-CCITT-2 ] } - { 5 [ compression-lzw ] } - { 32773 [ compression-pack-bits ] } - [ bad-compression ] - } case ; - -SINGLETONS: resolution-unit -resolution-unit-none -resolution-unit-inch -resolution-unit-centimeter ; -ERROR: bad-resolution-unit n ; -: lookup-resolution-unit ( n -- object ) - { - { 1 [ resolution-unit-none ] } - { 2 [ resolution-unit-inch ] } - { 3 [ resolution-unit-centimeter ] } - [ bad-resolution-unit ] - } case ; - -SINGLETONS: predictor -predictor-none -predictor-horizontal-differencing ; -ERROR: bad-predictor n ; -: lookup-predictor ( n -- object ) - { - { 1 [ predictor-none ] } - { 2 [ predictor-horizontal-differencing ] } - [ bad-predictor ] - } case ; - -SINGLETONS: planar-configuration -planar-configuration-chunky -planar-configuration-planar ; -ERROR: bad-planar-configuration n ; -: lookup-planar-configuration ( n -- object ) - { - { 1 [ planar-configuration-chunky ] } - { 2 [ planar-configuration-planar ] } - [ bad-planar-configuration ] - } case ; - -ERROR: bad-sample-format n ; -SINGLETONS: sample-format -sample-format-unsigned-integer -sample-format-signed-integer -sample-format-ieee-float -sample-format-undefined-data ; -: lookup-sample-format ( seq -- object ) - [ - { - { 1 [ sample-format-unsigned-integer ] } - { 2 [ sample-format-signed-integer ] } - { 3 [ sample-format-ieee-float ] } - { 4 [ sample-format-undefined-data ] } - [ bad-sample-format ] - } case - ] map ; - -ERROR: bad-extra-samples n ; -SINGLETONS: extra-samples -extra-samples-unspecified-alpha-data -extra-samples-associated-alpha-data -extra-samples-unassociated-alpha-data ; -: lookup-extra-samples ( seq -- object ) - { - { 0 [ extra-samples-unspecified-alpha-data ] } - { 1 [ extra-samples-associated-alpha-data ] } - { 2 [ extra-samples-unassociated-alpha-data ] } - [ bad-extra-samples ] - } case ; - -SINGLETONS: image-length image-width x-resolution y-resolution -rows-per-strip strip-offsets strip-byte-counts bits-per-sample -samples-per-pixel new-subfile-type orientation -unhandled-ifd-entry ; - -ERROR: bad-tiff-magic bytes ; -: tiff-endianness ( byte-array -- ? ) - { - { B{ CHAR: M CHAR: M } [ big-endian ] } - { B{ CHAR: I CHAR: I } [ little-endian ] } - [ bad-tiff-magic ] - } case ; - -: read-header ( tiff -- tiff ) - 2 read tiff-endianness [ >>endianness ] keep - [ - 2 read endian> >>the-answer - 4 read endian> >>ifd-offset - ] with-endianness ; - -: push-ifd ( tiff ifd -- tiff ) over ifds>> push ; - -: read-ifd ( -- ifd ) - 2 read endian> - 2 read endian> - 4 read endian> - 4 read endian> ; - -: read-ifds ( tiff -- tiff ) - dup ifd-offset>> seek-absolute seek-input - 2 read endian> - dup [ read-ifd ] replicate - 4 read endian> - [ push-ifd ] [ 0 = [ read-ifds ] unless ] bi ; - -ERROR: no-tag class ; - -: ?at ( key assoc -- value/key ? ) - dupd at* [ nip t ] [ drop f ] if ; inline - -: find-tag ( idf class -- tag ) - swap processed-tags>> ?at [ no-tag ] unless ; - -: read-strips ( ifd -- ifd ) - dup - [ strip-byte-counts find-tag ] - [ strip-offsets find-tag ] bi - 2dup [ integer? ] both? [ - seek-absolute seek-input read 1array - ] [ - [ seek-absolute seek-input read ] { } 2map-as - ] if >>strips ; - -ERROR: unknown-ifd-type n ; - -: bytes>bits ( n/byte-array -- n ) - dup byte-array? [ byte-array>bignum ] when ; - -: value-length ( ifd-entry -- n ) - [ count>> ] [ type>> ] bi { - { 1 [ ] } - { 2 [ ] } - { 3 [ 2 * ] } - { 4 [ 4 * ] } - { 5 [ 8 * ] } - { 6 [ ] } - { 7 [ ] } - { 8 [ 2 * ] } - { 9 [ 4 * ] } - { 10 [ 8 * ] } - { 11 [ 4 * ] } - { 12 [ 8 * ] } - [ unknown-ifd-type ] - } case ; - -ERROR: bad-small-ifd-type n ; - -: adjust-offset/value ( ifd-entry -- obj ) - [ offset/value>> 4 >endian ] [ type>> ] bi - { - { 1 [ 1 head endian> ] } - { 3 [ 2 head endian> ] } - { 4 [ endian> ] } - { 6 [ 1 head endian> 8 >signed ] } - { 8 [ 2 head endian> 16 >signed ] } - { 9 [ endian> 32 >signed ] } - { 11 [ endian> bits>float ] } - [ bad-small-ifd-type ] - } case ; - -: offset-bytes>obj ( bytes type -- obj ) - { - { 1 [ ] } ! blank - { 2 [ ] } ! read c strings here - { 3 [ 2 [ endian> ] map ] } - { 4 [ 4 [ endian> ] map ] } - { 5 [ 8 [ "II" unpack first2 / ] map ] } - { 6 [ [ 8 >signed ] map ] } - { 7 [ ] } ! blank - { 8 [ 2 [ endian> 16 >signed ] map ] } - { 9 [ 4 [ endian> 32 >signed ] map ] } - { 10 [ 8 group [ "ii" unpack first2 / ] map ] } - { 11 [ 4 group [ "f" unpack ] map ] } - { 12 [ 8 group [ "d" unpack ] map ] } - [ unknown-ifd-type ] - } case ; - -: ifd-entry-value ( ifd-entry -- n ) - dup value-length 4 <= [ - adjust-offset/value - ] [ - [ offset/value>> seek-absolute seek-input ] - [ value-length read ] - [ type>> ] tri offset-bytes>obj - ] if ; - -: process-ifd-entry ( ifd-entry -- value class ) - [ ifd-entry-value ] [ tag>> ] bi { - { 254 [ new-subfile-type ] } - { 256 [ image-width ] } - { 257 [ image-length ] } - { 258 [ bits-per-sample ] } - { 259 [ lookup-compression compression ] } - { 262 [ lookup-photometric-interpretation photometric-interpretation ] } - { 273 [ strip-offsets ] } - { 274 [ orientation ] } - { 277 [ samples-per-pixel ] } - { 278 [ rows-per-strip ] } - { 279 [ strip-byte-counts ] } - { 282 [ x-resolution ] } - { 283 [ y-resolution ] } - { 284 [ planar-configuration ] } - { 296 [ lookup-resolution-unit resolution-unit ] } - { 317 [ lookup-predictor predictor ] } - { 338 [ lookup-extra-samples extra-samples ] } - { 339 [ lookup-sample-format sample-format ] } - [ nip unhandled-ifd-entry ] - } case ; - -: process-ifd ( ifd -- ifd ) - dup ifd-entries>> - [ process-ifd-entry swap ] H{ } map>assoc >>processed-tags ; - -: strips>buffer ( ifd -- ifd ) - dup strips>> concat >>buffer ; - -: (load-tiff) ( path -- tiff ) - binary [ - - read-header dup endianness>> [ - read-ifds - dup ifds>> [ process-ifd read-strips strips>buffer drop ] each - ] with-endianness - ] with-file-reader ; - -: load-tiff ( path -- tiff ) (load-tiff) ; diff --git a/extra/graphics/viewer/authors.txt b/extra/graphics/viewer/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/extra/graphics/viewer/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/extra/graphics/viewer/viewer.factor b/extra/graphics/viewer/viewer.factor deleted file mode 100644 index 517ab4e010..0000000000 --- a/extra/graphics/viewer/viewer.factor +++ /dev/null @@ -1,66 +0,0 @@ -! Copyright (C) 2007 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays combinators graphics.bitmap kernel math -math.functions namespaces opengl opengl.gl ui ui.gadgets -ui.gadgets.panes ui.render graphics.tiff sequences ; -IN: graphics.viewer - -TUPLE: graphics-gadget < gadget image ; - -GENERIC: draw-image ( image -- ) -GENERIC: width ( image -- w ) -GENERIC: height ( image -- h ) - -M: graphics-gadget pref-dim* - image>> [ width ] keep height abs 2array ; - -M: graphics-gadget draw-gadget* ( gadget -- ) - origin get [ image>> draw-image ] with-translation ; - -: ( bitmap -- gadget ) - \ graphics-gadget new-gadget - swap >>image ; - -: bits>gl-params ( n -- gl-bgr gl-format ) - { - { 32 [ GL_BGRA GL_UNSIGNED_BYTE ] } - { 24 [ GL_BGR GL_UNSIGNED_BYTE ] } - { 8 [ GL_BGR GL_UNSIGNED_BYTE ] } - { 4 [ GL_BGR GL_UNSIGNED_BYTE ] } - } case ; - -M: bitmap draw-image ( bitmap -- ) - dup height>> 0 < [ - 0 0 glRasterPos2i - 1.0 -1.0 glPixelZoom - ] [ - 0 over height>> abs glRasterPos2i - 1.0 1.0 glPixelZoom - ] if - [ width>> ] keep - [ - [ height>> abs ] keep - bit-count>> bits>gl-params - ] keep array>> glDrawPixels ; - -M: bitmap width ( bitmap -- ) width>> ; -M: bitmap height ( bitmap -- ) height>> ; - -: bitmap. ( path -- ) - load-bitmap gadget. ; - -: bitmap-window ( path -- gadget ) - load-bitmap [ "bitmap" open-window ] keep ; - -M: tiff width ( tiff -- ) ifds>> first image-width find-tag ; -M: tiff height ( tiff -- ) ifds>> first image-length find-tag ; - -M: tiff draw-image ( tiff -- ) - [ 0 0 glRasterPos2i 1.0 -1.0 glPixelZoom ] dip - ifds>> first - { - [ image-width find-tag ] - [ image-length find-tag ] - [ bits-per-sample find-tag sum bits>gl-params ] - [ buffer>> ] - } cleave glDrawPixels ;