Fix conflict

db4
Slava Pestov 2009-02-10 00:44:23 -06:00
commit 6235e95052
42 changed files with 577 additions and 159 deletions

View File

@ -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: }

View File

@ -1,2 +1,3 @@
fortran
ffi
unportable

View File

@ -1,3 +1,4 @@
math
bindings
fortran
unportable

View File

@ -1,2 +1,3 @@
math
bindings
unportable

View File

@ -1 +1,3 @@
math
bindings
unportable

View File

@ -28,6 +28,8 @@ $nl
{ $snippet "ulonglong" }
{ $snippet "float" }
{ $snippet "double" }
{ $snippet "complex-float" }
{ $snippet "complex-double" }
{ $snippet "void*" }
{ $snippet "bool" }
}

View File

@ -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 [

View File

@ -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 <graphics-gadget> ] [ title>> ] bi open-window ;
[ screenshot <image-gadget> ] [ title>> ] bi open-window ;

View File

@ -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

View File

@ -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" ;

View File

@ -1 +0,0 @@
Doug Coleman

View File

@ -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 ;
: <graphics-gadget> ( 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 <graphics-gadget> gadget. ;
: bitmap-window ( path -- gadget )
load-bitmap <graphics-gadget> [ "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 ;

2
extra/id3/authors.txt Normal file
View File

@ -0,0 +1,2 @@
Tim Wawrzynczak

17
extra/id3/id3-docs.factor Normal file
View File

@ -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"

182
extra/id3/id3-tests.factor Normal file
View File

@ -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<49>}`<60>#<23><>K<EFBFBD>H<EFBFBD>*(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

154
extra/id3/id3.factor Normal file
View File

@ -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 ;
: <mp3v1-file> ( -- object ) mp3v1-file new ;
: <mp3v2-file> ( header frames -- object ) mp3v2-file boa ;
: <header> ( -- object ) header new ;
: <frame> ( -- object ) frame new ;
<PRIVATE
! utility words
: id3v2? ( mmap -- ? )
"ID3" head? ;
: id3v1? ( mmap -- ? )
128 tail-slice* "TAG" head? ;
: >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 <slice> filter-text-data ;
! read whole frames
: (read-frame) ( mmap -- frame )
[ <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 <slice> >28bitword ;
: read-v2-header ( mmap -- id3header )
[ <header> ] 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 <mp3v2-file> ;
! 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 )
[ <mp3v1-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

BIN
extra/id3/tests/blah.mp3 Normal file

Binary file not shown.

BIN
extra/id3/tests/blah2.mp3 Normal file

Binary file not shown.

BIN
extra/id3/tests/blah3.mp3 Normal file

Binary file not shown.

1
extra/images/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

View File

@ -0,0 +1 @@
Doug Coleman

View File

@ -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

View File

View File

@ -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

View File

@ -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 <sliced-groups> [ 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 <sliced-groups> 3 <column> [ 0 = ] all? ;
buffer>> 4 <sliced-groups> 3 <column> [ 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

View File

@ -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
: <image> ( path -- image )
normalize-path dup "." split1-last nip >lower
{
{ "bmp" [ bitmap-image load-image ] }
{ "tiff" [ tiff-image load-image ] }
} case ;

View File

Before

Width:  |  Height:  |  Size: 1.6 KiB

After

Width:  |  Height:  |  Size: 1.6 KiB

Binary file not shown.

View File

Before

Width:  |  Height:  |  Size: 5.2 KiB

After

Width:  |  Height:  |  Size: 5.2 KiB

View File

Before

Width:  |  Height:  |  Size: 11 KiB

After

Width:  |  Height:  |  Size: 11 KiB

View File

Before

Width:  |  Height:  |  Size: 59 KiB

After

Width:  |  Height:  |  Size: 59 KiB

View File

@ -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" ;

View File

@ -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 [
<tiff>
<parsed-tiff>
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 ;

View File

@ -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 )
\ 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 )
[ <image> <image-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 -- ) <image> <image-gadget> gadget. ;
M: pathname image. ( image -- ) <image> <image-gadget> gadget. ;
M: image image. ( image -- ) <image-gadget> gadget. ;

View File

@ -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)

View File

@ -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: <offscreen-world>

View File

@ -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

View File

@ -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" <image>
bitmap= "is perfect" "needs work" ?
"Your UI rendering " prepend
message-window