diff --git a/basis/alien/fortran/fortran-docs.factor b/basis/alien/fortran/fortran-docs.factor index 1b942d30c5..4accbf5965 100644 --- a/basis/alien/fortran/fortran-docs.factor +++ b/basis/alien/fortran/fortran-docs.factor @@ -44,7 +44,7 @@ HELP: fortran-invoke ; ARTICLE: "alien.fortran" "Fortran FFI" -"The " { $vocab-link "alien.fortran" } " vocabulary provides an interface to code shared libraries written in Fortran." +"The " { $vocab-link "alien.fortran" } " vocabulary provides an interface to code in shared libraries written in Fortran." { $subsection "alien.fortran-types" } { $subsection POSTPONE: LIBRARY: } { $subsection POSTPONE: FUNCTION: } diff --git a/basis/alien/fortran/tags.txt b/basis/alien/fortran/tags.txt index 2a9b5def7a..58465edeb5 100644 --- a/basis/alien/fortran/tags.txt +++ b/basis/alien/fortran/tags.txt @@ -1,2 +1,3 @@ fortran ffi +unportable diff --git a/basis/math/blas/ffi/tags.txt b/basis/math/blas/ffi/tags.txt index f468a9989d..a4a4ea88ab 100644 --- a/basis/math/blas/ffi/tags.txt +++ b/basis/math/blas/ffi/tags.txt @@ -1,3 +1,4 @@ math bindings fortran +unportable diff --git a/basis/math/blas/matrices/tags.txt b/basis/math/blas/matrices/tags.txt index 241ec1ecda..5118958180 100644 --- a/basis/math/blas/matrices/tags.txt +++ b/basis/math/blas/matrices/tags.txt @@ -1,2 +1,3 @@ math bindings +unportable diff --git a/basis/math/blas/vectors/tags.txt b/basis/math/blas/vectors/tags.txt index ede10ab61b..5118958180 100644 --- a/basis/math/blas/vectors/tags.txt +++ b/basis/math/blas/vectors/tags.txt @@ -1 +1,3 @@ math +bindings +unportable diff --git a/basis/specialized-arrays/specialized-arrays-docs.factor b/basis/specialized-arrays/specialized-arrays-docs.factor index 1c1b3dbc59..9015cccd8f 100644 --- a/basis/specialized-arrays/specialized-arrays-docs.factor +++ b/basis/specialized-arrays/specialized-arrays-docs.factor @@ -28,6 +28,8 @@ $nl { $snippet "ulonglong" } { $snippet "float" } { $snippet "double" } + { $snippet "complex-float" } + { $snippet "complex-double" } { $snippet "void*" } { $snippet "bool" } } diff --git a/basis/tools/deploy/backend/backend.factor b/basis/tools/deploy/backend/backend.factor index 22d6eb2ffa..ff851edce6 100755 --- a/basis/tools/deploy/backend/backend.factor +++ b/basis/tools/deploy/backend/backend.factor @@ -12,7 +12,7 @@ destructors accessors ; IN: tools.deploy.backend : copy-vm ( executable bundle-name -- vm ) - [ prepend-path ] dip append vm over copy-file ; + prepend-path vm over copy-file ; : copy-fonts ( name dir -- ) deploy-ui? get [ diff --git a/extra/cap/cap.factor b/extra/cap/cap.factor index 716435775d..1f62441028 100644 --- a/extra/cap/cap.factor +++ b/extra/cap/cap.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman, Joe Groff. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays byte-arrays kernel math namespaces -opengl.gl sequences math.vectors ui graphics.bitmap graphics.viewer +opengl.gl sequences math.vectors ui images.bitmap images.viewer models ui.gadgets.worlds ui.gadgets fry alien.syntax ; IN: cap @@ -27,4 +27,4 @@ IN: cap [ screenshot ] dip save-bitmap ; : screenshot. ( window -- ) - [ screenshot ] [ title>> ] bi open-window ; + [ screenshot ] [ title>> ] bi open-window ; 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/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/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 ; diff --git a/extra/id3/authors.txt b/extra/id3/authors.txt new file mode 100644 index 0000000000..ece617b969 --- /dev/null +++ b/extra/id3/authors.txt @@ -0,0 +1,2 @@ +Tim Wawrzynczak + diff --git a/extra/id3/id3-docs.factor b/extra/id3/id3-docs.factor new file mode 100644 index 0000000000..94128dc3b2 --- /dev/null +++ b/extra/id3/id3-docs.factor @@ -0,0 +1,17 @@ +! Copyright (C) 2008 Tim Wawrzynczak +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax sequences kernel ; +IN: id3 + +HELP: id3-parse-mp3-file +{ $values + { "path" "a path string" } + { "object/f" "either a tuple consisting of the data from an MP3 file, or an f indicating this file has no (supported) ID3 information." } } +{ $description "Return a tuple containing the ID3 information parsed out of the MP3 file" } ; + +ARTICLE: "id3" "ID3 tags" +{ $emphasis "ID3" } " tags are textual data that is used to describe the information (title, artist, etc.) in an .MP3 file" +"Parsing an MP3 file: " +{ $subsection id3-parse-mp3-file } ; + +ABOUT: "id3" diff --git a/extra/id3/id3-tests.factor b/extra/id3/id3-tests.factor new file mode 100644 index 0000000000..d84f2c8726 --- /dev/null +++ b/extra/id3/id3-tests.factor @@ -0,0 +1,182 @@ +! Copyright (C) 2009 Tim Wawrzynczak +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test id3 ; +IN: id3.tests + +[ T{ mp3v2-file + { header T{ header f t 0 502 } } + { frames + { + T{ frame + { frame-id "COMM" } + { flags B{ 0 0 } } + { size 19 } + { data "eng, AG# 08E1C12E" } + } + T{ frame + { frame-id "TIT2" } + { flags B{ 0 0 } } + { size 15 } + { data "Stormy Weather" } + } + T{ frame + { frame-id "TRCK" } + { flags B{ 0 0 } } + { size 3 } + { data "32" } + } + T{ frame + { frame-id "TCON" } + { flags B{ 0 0 } } + { size 5 } + { data "(96)" } + } + T{ frame + { frame-id "TALB" } + { flags B{ 0 0 } } + { size 28 } + { data "Night and Day Frank Sinatra" } + } + T{ frame + { frame-id "PRIV" } + { flags B{ 0 0 } } + { size 39 } + { data "WM/MediaClassPrimaryID�}`�#��K�H�*(D" } + } + T{ frame + { frame-id "PRIV" } + { flags B{ 0 0 } } + { size 41 } + { data "WM/MediaClassSecondaryID" } + } + T{ frame + { frame-id "TPE1" } + { flags B{ 0 0 } } + { size 14 } + { data "Frank Sinatra" } + } + } + } +} +] [ "resource:extra/id3/tests/blah3.mp3" id3-parse-mp3-file ] unit-test + +[ + T{ mp3v2-file + { header + T{ header { version t } { flags 0 } { size 1405 } } + } + { frames + { + T{ frame + { frame-id "TIT2" } + { flags B{ 0 0 } } + { size 22 } + { data "Anthem of the Trinity" } + } + T{ frame + { frame-id "TPE1" } + { flags B{ 0 0 } } + { size 12 } + { data "Terry Riley" } + } + T{ frame + { frame-id "TALB" } + { flags B{ 0 0 } } + { size 11 } + { data "Shri Camel" } + } + T{ frame + { frame-id "TCON" } + { flags B{ 0 0 } } + { size 10 } + { data "Classical" } + } + T{ frame + { frame-id "UFID" } + { flags B{ 0 0 } } + { size 23 } + { data "http://musicbrainz.org" } + } + T{ frame + { frame-id "TXXX" } + { flags B{ 0 0 } } + { size 23 } + { data "MusicBrainz Artist Id" } + } + T{ frame + { frame-id "TXXX" } + { flags B{ 0 0 } } + { size 22 } + { data "musicbrainz_artistid" } + } + T{ frame + { frame-id "TRCK" } + { flags B{ 0 0 } } + { size 2 } + { data "1" } + } + T{ frame + { frame-id "TXXX" } + { flags B{ 0 0 } } + { size 22 } + { data "MusicBrainz Album Id" } + } + T{ frame + { frame-id "TXXX" } + { flags B{ 0 0 } } + { size 21 } + { data "musicbrainz_albumid" } + } + T{ frame + { frame-id "TXXX" } + { flags B{ 0 0 } } + { size 29 } + { data "MusicBrainz Album Artist Id" } + } + T{ frame + { frame-id "TXXX" } + { flags B{ 0 0 } } + { size 27 } + { data "musicbrainz_albumartistid" } + } + T{ frame + { frame-id "TPOS" } + { flags B{ 0 0 } } + { size 2 } + { data "1" } + } + T{ frame + { frame-id "TSOP" } + { flags B{ 0 0 } } + { size 1 } + } + T{ frame + { frame-id "TMED" } + { flags B{ 0 0 } } + { size 4 } + { data "DIG" } + } + } + } +} +] [ "resource:extra/id3/tests/blah2.mp3" id3-parse-mp3-file ] unit-test + +[ + T{ mp3v1-file + { title + "BLAH\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" + } + { artist + "ARTIST\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" + } + { album + "ALBUM\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" + } + { year "2009" } + { comment + "COMMENT\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" + } + { genre 89 } + } +] [ "resource:extra/id3/tests/blah.mp3" id3-parse-mp3-file ] unit-test + diff --git a/extra/id3/id3.factor b/extra/id3/id3.factor new file mode 100644 index 0000000000..b2c2ec0621 --- /dev/null +++ b/extra/id3/id3.factor @@ -0,0 +1,154 @@ +! Copyright (C) 2009 Tim Wawrzynczak +! See http://factorcode.org/license.txt for BSD license. +USING: sequences io io.encodings.binary io.files io.pathnames strings kernel math io.mmap io.mmap.uchar accessors syntax combinators math.ranges unicode.categories byte-arrays prettyprint io.encodings.string io.encodings.ascii ; +IN: id3 + +! tuples + +TUPLE: header version flags size ; + +TUPLE: frame frame-id flags size data ; + +TUPLE: mp3v2-file header frames ; + +TUPLE: mp3v1-file title artist album year comment genre ; + +: ( -- object ) mp3v1-file new ; + +: ( header frames -- object ) mp3v2-file boa ; + +:
( -- object ) header new ; + +: ( -- object ) frame new ; + +28bitword ( seq -- int ) + 0 [ swap 7 shift bitor ] reduce ; + +: filter-text-data ( data -- filtered ) + [ printable? ] filter ; + +! frame details stuff + +: valid-frame-id? ( id -- ? ) + [ [ digit? ] [ LETTER? ] bi or ] all? ; + +: read-frame-id ( mmap -- id ) + 4 head-slice ; + +: read-frame-size ( mmap -- size ) + [ 4 8 ] dip subseq ; + +: read-frame-flags ( mmap -- flags ) + [ 8 10 ] dip subseq ; + +: read-frame-data ( frame mmap -- frame data ) + [ 10 over size>> 10 + ] dip filter-text-data ; + +! read whole frames + +: (read-frame) ( mmap -- frame ) + [ ] dip + { + [ read-frame-id ascii decode >>frame-id ] + [ read-frame-flags >byte-array >>flags ] + [ read-frame-size >28bitword >>size ] + [ read-frame-data ascii decode >>data ] + } cleave ; + +: read-frame ( mmap -- frame/f ) + dup read-frame-id valid-frame-id? [ (read-frame) ] [ drop f ] if ; + +: remove-frame ( mmap frame -- mmap ) + size>> 10 + tail-slice ; + +: read-frames ( mmap -- frames ) + [ dup read-frame dup ] + [ [ remove-frame ] keep ] + [ drop ] produce nip ; + +! header stuff + +: read-header-supported-version? ( mmap -- ? ) + 3 tail-slice [ { 4 } head? ] [ { 3 } head? ] bi or ; + +: read-header-flags ( mmap -- flags ) + 5 swap nth ; + +: read-header-size ( mmap -- size ) + [ 6 10 ] dip >28bitword ; + +: read-v2-header ( mmap -- id3header ) + [
] dip + { + [ read-header-supported-version? >>version ] + [ read-header-flags >>flags ] + [ read-header-size >>size ] + } cleave ; + +: drop-header ( mmap -- seq1 seq2 ) + dup 10 tail-slice swap ; + +: read-v2-tag-data ( seq -- mp3v2-file ) + drop-header read-v2-header swap read-frames ; + +! v1 information + +: skip-to-v1-data ( seq -- seq ) + 125 tail-slice* ; + +: read-title ( seq -- title ) + 30 head-slice ; + +: read-artist ( seq -- title ) + [ 30 60 ] dip subseq ; + +: read-album ( seq -- album ) + [ 60 90 ] dip subseq ; + +: read-year ( seq -- year ) + [ 90 94 ] dip subseq ; + +: read-comment ( seq -- comment ) + [ 94 124 ] dip subseq ; + +: read-genre ( seq -- genre ) + [ 124 ] dip nth ; + +: (read-v1-tag-data) ( seq -- mp3-file ) + [ ] dip + { + [ read-title ascii decode >>title ] + [ read-artist ascii decode >>artist ] + [ read-album ascii decode >>album ] + [ read-year ascii decode >>year ] + [ read-comment ascii decode >>comment ] + [ read-genre >fixnum >>genre ] + } cleave ; + +: read-v1-tag-data ( seq -- mp3-file ) + skip-to-v1-data (read-v1-tag-data) ; + +PRIVATE> + +! main stuff + +: id3-parse-mp3-file ( path -- object ) + [ + { + { [ dup id3v2? ] [ read-v2-tag-data ] } ! ( ? -- mp3v2-file ) + { [ dup id3v1? ] [ read-v1-tag-data ] } ! ( ? -- mp3v1-file ) + [ drop f ] ! ( mmap -- f ) + } cond + ] with-mapped-uchar-file ; + +! end diff --git a/extra/id3/tests/blah.mp3 b/extra/id3/tests/blah.mp3 new file mode 100644 index 0000000000..3a60bffd34 Binary files /dev/null and b/extra/id3/tests/blah.mp3 differ diff --git a/extra/id3/tests/blah2.mp3 b/extra/id3/tests/blah2.mp3 new file mode 100644 index 0000000000..5d27429982 Binary files /dev/null and b/extra/id3/tests/blah2.mp3 differ diff --git a/extra/id3/tests/blah3.mp3 b/extra/id3/tests/blah3.mp3 new file mode 100644 index 0000000000..19aaa94dc6 Binary files /dev/null and b/extra/id3/tests/blah3.mp3 differ diff --git a/extra/images/authors.txt b/extra/images/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/images/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/images/backend/authors.txt b/extra/images/backend/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/images/backend/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/images/backend/backend.factor b/extra/images/backend/backend.factor new file mode 100644 index 0000000000..ef2a9a4248 --- /dev/null +++ b/extra/images/backend/backend.factor @@ -0,0 +1,18 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors kernel ; +IN: images.backend + +TUPLE: image width height depth pitch buffer ; + +GENERIC: load-image* ( path tuple -- image ) + +: load-image ( path class -- image ) + new load-image* ; + +: new-image ( width height depth buffer class -- image ) + new + swap >>buffer + swap >>depth + swap >>height + swap >>width ; inline diff --git a/extra/graphics/authors.txt b/extra/images/bitmap/authors.txt old mode 100644 new mode 100755 similarity index 100% rename from extra/graphics/authors.txt rename to extra/images/bitmap/authors.txt diff --git a/extra/images/bitmap/bitmap-tests.factor b/extra/images/bitmap/bitmap-tests.factor new file mode 100644 index 0000000000..a2b3188749 --- /dev/null +++ b/extra/images/bitmap/bitmap-tests.factor @@ -0,0 +1,27 @@ +USING: images.bitmap images.viewer io.encodings.binary +io.files io.files.unique kernel tools.test ; +IN: images.bitmap.tests + +: test-bitmap24 ( -- path ) + "resource:extra/images/test-images/thiswayup24.bmp" ; + +: test-bitmap16 ( -- path ) + "resource:extra/images/test-images/rgb16bit.bmp" ; + +: test-bitmap8 ( -- path ) + "resource:extra/images/test-images/rgb8bit.bmp" ; + +: test-bitmap4 ( -- path ) + "resource:extra/images/test-images/rgb4bit.bmp" ; + +: test-bitmap1 ( -- path ) + "resource:extra/images/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/images/bitmap/bitmap.factor similarity index 81% rename from extra/graphics/bitmap/bitmap.factor rename to extra/images/bitmap/bitmap.factor index f8008dc7c1..50975b2bb3 100755 --- a/extra/graphics/bitmap/bitmap.factor +++ b/extra/images/bitmap/bitmap.factor @@ -4,8 +4,10 @@ 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 +summary ui ui.gadgets.panes images.backend ; +IN: images.bitmap + +TUPLE: bitmap-image < image ; ! Currently can only handle 24/32bit bitmaps. ! Handles row-reversed bitmaps (their height is negative) @@ -14,40 +16,24 @@ 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 ; +buffer ; : 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 ) +: 8bit>buffer ( 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 ) +: raw-bitmap>buffer ( bitmap -- array ) dup bit-count>> { { 32 [ color-index>> ] } { 24 [ color-index>> ] } { 16 [ bmp-not-supported ] } - { 8 [ 8bit>array ] } + { 8 [ 8bit>buffer ] } { 4 [ bmp-not-supported ] } { 2 [ bmp-not-supported ] } { 1 [ bmp-not-supported ] } @@ -95,19 +81,45 @@ M: bitmap-magic summary dup rgb-quads-length read >>rgb-quads dup color-index-length read >>color-index ; -: (load-bitmap) ( path -- bitmap ) +: load-bitmap-data ( 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? ; + buffer>> 4 3 [ 0 = ] all? ; + +: process-bitmap-data ( bitmap -- bitmap ) + dup raw-bitmap>buffer >>buffer + dup alpha-channel-zero? >>alpha-channel-zero? ; : load-bitmap ( path -- bitmap ) - (load-bitmap) - dup raw-bitmap>array >>array - dup alpha-channel-zero? >>alpha-channel-zero? ; + load-bitmap-data process-bitmap-data ; + +: bitmap>image ( bitmap -- bitmap-image ) + { [ width>> ] [ height>> ] [ bit-count>> ] [ buffer>> ] } cleave + bitmap-image new-image ; + +M: bitmap-image load-image* ( path bitmap -- bitmap-image ) + drop load-bitmap + bitmap>image ; + +MACRO: (nbits>bitmap) ( bits -- ) + [ -3 shift ] keep '[ + bitmap new + 2over * _ * >>size-image + swap >>height + swap >>width + swap array-copy [ >>buffer ] [ >>color-index ] bi + _ >>bit-count bitmap>image + ] ; + +: bgr>bitmap ( array height width -- bitmap ) + 24 (nbits>bitmap) ; + +: bgra>bitmap ( array height width -- bitmap ) + 32 (nbits>bitmap) ; : write2 ( n -- ) 2 >le write ; : write4 ( n -- ) 4 >le write ; @@ -116,7 +128,7 @@ M: bitmap-magic summary binary [ B{ CHAR: B CHAR: M } write [ - array>> length 14 + 40 + write4 + buffer>> length 14 + 40 + write4 0 write4 54 write4 40 write4 diff --git a/extra/images/images.factor b/extra/images/images.factor new file mode 100644 index 0000000000..eb4fc63fee --- /dev/null +++ b/extra/images/images.factor @@ -0,0 +1,13 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: constructors kernel splitting unicode.case combinators +accessors images.bitmap images.tiff images.backend io.backend +io.pathnames ; +IN: images + +: ( path -- image ) + normalize-path dup "." split1-last nip >lower + { + { "bmp" [ bitmap-image load-image ] } + { "tiff" [ tiff-image load-image ] } + } case ; diff --git a/extra/graphics/tags.txt b/extra/images/tags.txt similarity index 100% rename from extra/graphics/tags.txt rename to extra/images/tags.txt diff --git a/extra/graphics/bitmap/test-images/1bit.bmp b/extra/images/test-images/1bit.bmp similarity index 100% rename from extra/graphics/bitmap/test-images/1bit.bmp rename to extra/images/test-images/1bit.bmp diff --git a/extra/images/test-images/octagon.tiff b/extra/images/test-images/octagon.tiff new file mode 100644 index 0000000000..2b4ba3950d Binary files /dev/null and b/extra/images/test-images/octagon.tiff differ diff --git a/extra/graphics/tiff/rgb.tiff b/extra/images/test-images/rgb.tiff similarity index 100% rename from extra/graphics/tiff/rgb.tiff rename to extra/images/test-images/rgb.tiff diff --git a/extra/graphics/bitmap/test-images/rgb4bit.bmp b/extra/images/test-images/rgb4bit.bmp similarity index 100% rename from extra/graphics/bitmap/test-images/rgb4bit.bmp rename to extra/images/test-images/rgb4bit.bmp diff --git a/extra/graphics/bitmap/test-images/rgb8bit.bmp b/extra/images/test-images/rgb8bit.bmp similarity index 100% rename from extra/graphics/bitmap/test-images/rgb8bit.bmp rename to extra/images/test-images/rgb8bit.bmp diff --git a/extra/graphics/bitmap/test-images/thiswayup24.bmp b/extra/images/test-images/thiswayup24.bmp similarity index 100% rename from extra/graphics/bitmap/test-images/thiswayup24.bmp rename to extra/images/test-images/thiswayup24.bmp diff --git a/extra/graphics/bitmap/authors.txt b/extra/images/tiff/authors.txt similarity index 100% rename from extra/graphics/bitmap/authors.txt rename to extra/images/tiff/authors.txt diff --git a/extra/images/tiff/tiff-tests.factor b/extra/images/tiff/tiff-tests.factor new file mode 100755 index 0000000000..9905e7ad79 --- /dev/null +++ b/extra/images/tiff/tiff-tests.factor @@ -0,0 +1,10 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test images.tiff ; +IN: images.tiff.tests + +: tiff-test-path ( -- path ) + "resource:extra/images/test-images/rgb.tiff" ; + +: tiff-test-path2 ( -- path ) + "resource:extra/images/test-images/octagon.tiff" ; diff --git a/extra/graphics/tiff/tiff.factor b/extra/images/tiff/tiff.factor similarity index 90% rename from extra/graphics/tiff/tiff.factor rename to extra/images/tiff/tiff.factor index 0481af8747..4be81af095 100755 --- a/extra/graphics/tiff/tiff.factor +++ b/extra/images/tiff/tiff.factor @@ -3,13 +3,14 @@ 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 +io.binary assocs math math.bitwise byte-arrays grouping +images.backend ; +IN: images.tiff -TUPLE: tiff endianness the-answer ifd-offset ifds ; +TUPLE: tiff-image < image ; -CONSTRUCTOR: tiff ( -- tiff ) - V{ } clone >>ifds ; +TUPLE: parsed-tiff endianness the-answer ifd-offset ifds ; +CONSTRUCTOR: parsed-tiff ( -- tiff ) V{ } clone >>ifds ; TUPLE: ifd count ifd-entries next processed-tags strips buffer ; @@ -83,13 +84,13 @@ ERROR: bad-planar-configuration n ; [ 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 ) +ERROR: bad-sample-format n ; +: lookup-sample-format ( sequence -- object ) [ { { 1 [ sample-format-unsigned-integer ] } @@ -100,12 +101,12 @@ sample-format-undefined-data ; } 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 ) +ERROR: bad-extra-samples n ; +: lookup-extra-samples ( sequence -- object ) { { 0 [ extra-samples-unspecified-alpha-data ] } { 1 [ extra-samples-associated-alpha-data ] } @@ -259,13 +260,26 @@ ERROR: bad-small-ifd-type n ; : strips>buffer ( ifd -- ifd ) dup strips>> concat >>buffer ; -: (load-tiff) ( path -- tiff ) +: ifd>image ( ifd -- image ) + { + [ image-width find-tag ] + [ image-length find-tag ] + [ bits-per-sample find-tag sum ] + [ buffer>> ] + } cleave tiff-image new-image ; + +: parsed-tiff>images ( tiff -- sequence ) + ifds>> [ ifd>image ] map ; + +: load-tiff ( path -- parsed-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) ; +! 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 parsed-tiff>images first ; diff --git a/extra/graphics/tiff/authors.txt b/extra/images/viewer/authors.txt similarity index 100% rename from extra/graphics/tiff/authors.txt rename to extra/images/viewer/authors.txt diff --git a/extra/images/viewer/viewer.factor b/extra/images/viewer/viewer.factor new file mode 100644 index 0000000000..4d5df4874a --- /dev/null +++ b/extra/images/viewer/viewer.factor @@ -0,0 +1,69 @@ +! Copyright (C) 2007 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays combinators images.bitmap kernel math +math.functions namespaces opengl opengl.gl ui ui.gadgets +ui.gadgets.panes ui.render images.tiff sequences multiline +images.backend images io.pathnames strings ; +IN: images.viewer + +TUPLE: image-gadget < gadget { image image } ; + +GENERIC: draw-image ( image -- ) + +M: image-gadget pref-dim* + image>> + [ width>> ] [ height>> ] bi + [ abs ] bi@ 2array ; + +M: image-gadget draw-gadget* ( gadget -- ) + origin get [ image>> draw-image ] with-translation ; + +: ( image -- gadget ) + \ image-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-image draw-image ( bitmap -- ) + { + [ + height>> dup 0 < [ + drop + 0 0 glRasterPos2i + 1.0 -1.0 glPixelZoom + ] [ + 0 swap abs glRasterPos2i + 1.0 1.0 glPixelZoom + ] if + ] + [ width>> abs ] + [ height>> abs ] + [ depth>> bits>gl-params ] + [ buffer>> ] + } cleave glDrawPixels ; + +: image-window ( path -- gadget ) + [ dup ] [ open-window ] bi ; + +M: tiff-image draw-image ( tiff -- ) + 0 0 glRasterPos2i 1.0 -1.0 glPixelZoom + { + [ height>> ] + [ width>> ] + [ depth>> bits>gl-params ] + [ buffer>> ] + } cleave glDrawPixels ; + +GENERIC: image. ( image -- ) + +M: string image. ( image -- ) gadget. ; + +M: pathname image. ( image -- ) gadget. ; + +M: image image. ( image -- ) gadget. ; diff --git a/extra/taxes/usa/usa.factor b/extra/taxes/usa/usa.factor index efdb969c01..bbfc332868 100644 --- a/extra/taxes/usa/usa.factor +++ b/extra/taxes/usa/usa.factor @@ -2,8 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs kernel math math.intervals namespaces sequences money math.order taxes.usa.w4 -taxes.usa.futa math.finance taxes.usa.fica -taxes.usa.federal ; +taxes.usa.futa math.finance ; IN: taxes.usa ! Withhold: FICA, Medicare, Federal (FICA is social security) diff --git a/extra/ui/offscreen/offscreen-docs.factor b/extra/ui/offscreen/offscreen-docs.factor index 5d800981bf..4123a83675 100644 --- a/extra/ui/offscreen/offscreen-docs.factor +++ b/extra/ui/offscreen/offscreen-docs.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. USING: help.markup help.syntax kernel quotations ui.gadgets -graphics.bitmap strings ui.gadgets.worlds ; +images.bitmap strings ui.gadgets.worlds ; IN: ui.offscreen HELP: diff --git a/extra/ui/offscreen/offscreen.factor b/extra/ui/offscreen/offscreen.factor index 89c1c7f860..cf9370ed7f 100755 --- a/extra/ui/offscreen/offscreen.factor +++ b/extra/ui/offscreen/offscreen.factor @@ -1,5 +1,5 @@ ! (c) 2008 Joe Groff, see license for details -USING: accessors continuations graphics.bitmap kernel math +USING: accessors continuations images.bitmap kernel math sequences ui.gadgets ui.gadgets.worlds ui ui.backend destructors ; IN: ui.offscreen diff --git a/extra/ui/render/test/test.factor b/extra/ui/render/test/test.factor index 8abfc82a35..412ce5a0a5 100755 --- a/extra/ui/render/test/test.factor +++ b/extra/ui/render/test/test.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors colors arrays kernel sequences math byte-arrays -namespaces grouping fry cap graphics.bitmap +namespaces grouping fry cap images.bitmap ui.gadgets ui.gadgets.packs ui.gadgets.borders ui.gadgets.grids ui.gadgets.grid-lines ui.gadgets.labels ui.gadgets.buttons -ui.render ui opengl opengl.gl colors.constants ; +ui.render ui opengl opengl.gl colors.constants images ; IN: ui.render.test SINGLETON: line-test @@ -40,7 +40,7 @@ SYMBOL: render-output screenshot [ render-output set-global ] [ - "resource:extra/ui/render/test/reference.bmp" load-bitmap + "resource:extra/ui/render/test/reference.bmp" bitmap= "is perfect" "needs work" ? "Your UI rendering " prepend message-window