From 01f6c5a7f646ddd2fb2d969876b83c6b2ef29d2d Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 16:40:14 -0600
Subject: [PATCH 01/41] add a test for saving bitmaps, refactor load-bitmap a
 bit

---
 extra/graphics/bitmap/bitmap-tests.factor | 30 ++++++++++++++++-------
 extra/graphics/bitmap/bitmap.factor       | 27 ++++++++++++--------
 2 files changed, 38 insertions(+), 19 deletions(-)

diff --git a/extra/graphics/bitmap/bitmap-tests.factor b/extra/graphics/bitmap/bitmap-tests.factor
index 15e960084a..ca8be85e12 100644
--- a/extra/graphics/bitmap/bitmap-tests.factor
+++ b/extra/graphics/bitmap/bitmap-tests.factor
@@ -1,15 +1,27 @@
-USING: graphics.bitmap graphics.viewer ;
+USING: graphics.bitmap graphics.viewer io.encodings.binary
+io.files io.files.unique kernel tools.test ;
 IN: graphics.bitmap.tests
 
-: test-bitmap24 ( -- )
-    "resource:extra/graphics/bitmap/test-images/thiswayup24.bmp" bitmap. ;
+: test-bitmap32-alpha ( -- path )
+    "resource:extra/graphics/bitmap/test-images/32alpha.bmp" ;
 
-: test-bitmap8 ( -- )
-    "resource:extra/graphics/bitmap/test-images/rgb8bit.bmp" bitmap. ;
+: test-bitmap24 ( -- path )
+    "resource:extra/graphics/bitmap/test-images/thiswayup24.bmp" ;
 
-: test-bitmap4 ( -- )
-    "resource:extra/graphics/bitmap/test-images/rgb4bit.bmp" bitmap. ;
+: test-bitmap8 ( -- path )
+    "resource:extra/graphics/bitmap/test-images/rgb8bit.bmp" ;
 
-: test-bitmap1 ( -- )
-    "resource:extra/graphics/bitmap/test-images/1bit.bmp" bitmap. ;
+: 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
index bd34a9ee41..a1cf37c8a1 100755
--- a/extra/graphics/bitmap/bitmap.factor
+++ b/extra/graphics/bitmap/bitmap.factor
@@ -1,11 +1,10 @@
-! Copyright (C) 2007 Doug Coleman.
+! Copyright (C) 2007, 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-
-USING: alien arrays byte-arrays combinators summary
-io io.binary io.files kernel libc math
-math.functions math.bitwise namespaces opengl opengl.gl
-prettyprint sequences strings ui ui.gadgets.panes fry
-io.encodings.binary accessors grouping macros alien.c-types ;
+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.
@@ -14,6 +13,7 @@ IN: graphics.bitmap
 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' )
@@ -97,12 +97,19 @@ M: bitmap-magic summary
     dup rgb-quads-length read >>rgb-quads
     dup color-index-length read >>color-index ;
 
-: load-bitmap ( path -- bitmap )
+: (load-bitmap) ( path -- bitmap )
     binary [
         bitmap new
         parse-file-header parse-bitmap-header parse-bitmap
-    ] with-file-reader
-    dup raw-bitmap>array >>array ;
+    ] with-file-reader ;
+
+: alpha-channel-zero? ( bitmap -- ? )
+    array>> 4 <sliced-groups> 3 <column> [ 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 ;

From 71d176716bcbc310b0e72536eb30082af0be5625 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 16:53:41 -0600
Subject: [PATCH 02/41] fix 24-game compile error

---
 extra/24-game/24-game.factor | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/extra/24-game/24-game.factor b/extra/24-game/24-game.factor
index 126215ab13..f842d5f4cb 100644
--- a/extra/24-game/24-game.factor
+++ b/extra/24-game/24-game.factor
@@ -15,7 +15,8 @@ SYMBOL: commands
     { nop rot -rot swap spin swapd } amb-execute ;
 : makes-24? ( a b c d -- ? )
         [
-            2 [ some-rots do-something ] times
+            some-rots do-something
+            some-rots do-something
             maybe-swap do-something
             24 =
         ]
@@ -60,4 +61,4 @@ DEFER: check-status
 : 24-able ( -- vector ) build-quad dup 24-able? [ drop build-quad ] unless ;
 : set-commands ( -- ) { + - * / rot swap q } commands set ;
 : play-game ( -- ) set-commands 24-able repeat ;
-MAIN: play-game
\ No newline at end of file
+MAIN: play-game

From 3df4cfb65164bed7ca4b4ec68056c367108fe8bf Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 16:58:17 -0600
Subject: [PATCH 03/41] fix words help-lint

---
 core/words/words-docs.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/core/words/words-docs.factor b/core/words/words-docs.factor
index 764df9924c..4dfa2d49bc 100644
--- a/core/words/words-docs.factor
+++ b/core/words/words-docs.factor
@@ -107,7 +107,7 @@ $nl
     
     { { { $snippet "\"help\"" } ", " { $snippet "\"help-loc\"" } ", " { $snippet "\"help-parent\"" } } { "Where word help is stored - " { $link "writing-help" } } }
 
-    { { $snippet "\"infer\"" } { $link "compiler-transforms" } }
+    { { $snippet "\"infer\"" } { $link "macros" } }
 
     { { { $snippet "\"inferred-effect\"" } } { $link "inference" } }
 

From e0e333b449e8e1c2609f127e02c9316683361357 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 17:13:47 -0600
Subject: [PATCH 04/41] fix link

---
 basis/html/templates/chloe/chloe-docs.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/html/templates/chloe/chloe-docs.factor b/basis/html/templates/chloe/chloe-docs.factor
index b2259e629e..18e6db66f6 100644
--- a/basis/html/templates/chloe/chloe-docs.factor
+++ b/basis/html/templates/chloe/chloe-docs.factor
@@ -261,7 +261,7 @@ $nl
 ARTICLE: "html.templates.chloe.extend.components.example" "An example of a custom Chloe component"
 "As an example, let's develop a custom Chloe component which renders an image stored in a form value. Since the component does not require any configuration, we can define a singleton class:"
 { $code "SINGLETON: image" }
-"Now we define a method on the " { $link render* } " generic word which renders the image using " { $vocab-link "xml.literals" } ":"
+"Now we define a method on the " { $link render* } " generic word which renders the image using " { $link { "xml.syntax" "literals" } } ":"
 { $code "M: image render* 2drop [XML <img src=<-> /> XML] ;" }
 "Finally, we can define a Chloe component:"
 { $code "COMPONENT: image" }

From 89c0dd21ddde9ff339cbd7c7fdbf6420123afba3 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 17:14:03 -0600
Subject: [PATCH 05/41] fix furnace.utilities lint

---
 basis/furnace/utilities/utilities-docs.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/furnace/utilities/utilities-docs.factor b/basis/furnace/utilities/utilities-docs.factor
index d2291786df..6defba54d2 100644
--- a/basis/furnace/utilities/utilities-docs.factor
+++ b/basis/furnace/utilities/utilities-docs.factor
@@ -27,7 +27,7 @@ HELP: hidden-form-field
     { $example
         "USING: furnace.utilities io ;"
         "\"bar\" \"foo\" hidden-form-field nl"
-        "<input type='hidden' name='foo' value='bar'/>"
+        "<input type=\"hidden\" name=\"foo\" value=\"bar\"/>"
     }
 } ;
 

From 4cd8bba92e3f175e464d1cf2c917244db382e5ee Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 17:31:03 -0600
Subject: [PATCH 06/41] better warnings on unsupported bmp formats

---
 extra/graphics/bitmap/bitmap-tests.factor |  3 +++
 extra/graphics/bitmap/bitmap.factor       | 12 +++++-------
 2 files changed, 8 insertions(+), 7 deletions(-)

diff --git a/extra/graphics/bitmap/bitmap-tests.factor b/extra/graphics/bitmap/bitmap-tests.factor
index ca8be85e12..f8a125e855 100644
--- a/extra/graphics/bitmap/bitmap-tests.factor
+++ b/extra/graphics/bitmap/bitmap-tests.factor
@@ -8,6 +8,9 @@ IN: graphics.bitmap.tests
 : 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" ;
 
diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor
index a1cf37c8a1..f8008dc7c1 100755
--- a/extra/graphics/bitmap/bitmap.factor
+++ b/extra/graphics/bitmap/bitmap.factor
@@ -39,20 +39,18 @@ MACRO: (nbits>bitmap) ( bits -- )
     [ rgb-quads>> 4 <sliced-groups> [ 3 head-slice ] map ]
     [ color-index>> >array ] bi [ swap nth ] with map concat ;
 
-: 4bit>array ( 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 )
     dup bit-count>>
     {
         { 32 [ color-index>> ] }
         { 24 [ color-index>> ] }
-        { 16 [ "16bit" throw ] }
+        { 16 [ bmp-not-supported ] }
         { 8 [ 8bit>array ] }
-        { 4 [ 4bit>array ] }
-        { 2 [ "2bit" throw ] }
-        { 1 [ "1bit" throw ] }
+        { 4 [ bmp-not-supported ] }
+        { 2 [ bmp-not-supported ] }
+        { 1 [ bmp-not-supported ] }
     } case >byte-array ;
 
 ERROR: bitmap-magic ;

From 43a91efde99941c89f5737ca2d17812fa4739e34 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 18:22:28 -0600
Subject: [PATCH 07/41] rename err_no to errno, clear_err_no to clear-errno,
 move them to libc, update usages

---
 basis/io/backend/unix/unix.factor        | 12 ++++++------
 basis/io/sockets/secure/unix/unix.factor |  2 +-
 basis/io/sockets/unix/unix.factor        | 14 +++++++-------
 basis/libc/libc.factor                   | 12 ++++++++++--
 basis/unix/unix.factor                   |  9 ++-------
 5 files changed, 26 insertions(+), 23 deletions(-)

diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor
index 4bc8868a3c..d86a72c665 100644
--- a/basis/io/backend/unix/unix.factor
+++ b/basis/io/backend/unix/unix.factor
@@ -84,8 +84,8 @@ M: fd refill
     fd>> over buffer>> [ buffer-end ] [ buffer-capacity ] bi read
     {
         { [ dup 0 >= ] [ swap buffer>> n>buffer f ] }
-        { [ err_no EINTR = ] [ 2drop +retry+ ] }
-        { [ err_no EAGAIN = ] [ 2drop +input+ ] }
+        { [ errno EINTR = ] [ 2drop +retry+ ] }
+        { [ errno EAGAIN = ] [ 2drop +input+ ] }
         [ (io-error) ]
     } cond ;
 
@@ -104,8 +104,8 @@ M: fd drain
             over buffer>> buffer-consume
             buffer>> buffer-empty? f +output+ ?
         ] }
-        { [ err_no EINTR = ] [ 2drop +retry+ ] }
-        { [ err_no EAGAIN = ] [ 2drop +output+ ] }
+        { [ errno EINTR = ] [ 2drop +retry+ ] }
+        { [ errno EAGAIN = ] [ 2drop +output+ ] }
         [ (io-error) ]
     } cond ;
 
@@ -143,7 +143,7 @@ M: stdin dispose*
     stdin data>> handle-fd buffer buffer-end size read
     dup 0 < [
         drop
-        err_no EINTR = [ buffer stdin size refill-stdin ] [ (io-error) ] if
+        errno EINTR = [ buffer stdin size refill-stdin ] [ (io-error) ] if
     ] [
         size = [ "Error reading stdin pipe" throw ] unless
         size buffer n>buffer
@@ -177,7 +177,7 @@ TUPLE: mx-port < port mx ;
 
 : multiplexer-error ( n -- n )
     dup 0 < [
-        err_no [ EAGAIN = ] [ EINTR = ] bi or
+        errno [ EAGAIN = ] [ EINTR = ] bi or
         [ drop 0 ] [ (io-error) ] if
     ] when ;
 
diff --git a/basis/io/sockets/secure/unix/unix.factor b/basis/io/sockets/secure/unix/unix.factor
index 8419246eb6..f1f39a0559 100644
--- a/basis/io/sockets/secure/unix/unix.factor
+++ b/basis/io/sockets/secure/unix/unix.factor
@@ -15,7 +15,7 @@ M: ssl-handle handle-fd file>> handle-fd ;
     ERR_get_error dup zero? [
         drop
         {
-            { -1 [ err_no ECONNRESET = [ premature-close ] [ (io-error) ] if ] }
+            { -1 [ errno ECONNRESET = [ premature-close ] [ (io-error) ] if ] }
             { 0 [ premature-close ] }
         } case
     ] [ nip (ssl-error) ] if ;
diff --git a/basis/io/sockets/unix/unix.factor b/basis/io/sockets/unix/unix.factor
index f209df5862..e701874afd 100644
--- a/basis/io/sockets/unix/unix.factor
+++ b/basis/io/sockets/unix/unix.factor
@@ -37,8 +37,8 @@ M: object (get-remote-address) ( handle local -- sockaddr )
     dup handle>> handle-fd f 0 write
     {
         { [ 0 = ] [ drop ] }
-        { [ err_no EAGAIN = ] [ dup +output+ wait-for-port wait-to-connect ] }
-        { [ err_no EINTR = ] [ wait-to-connect ] }
+        { [ errno EAGAIN = ] [ dup +output+ wait-for-port wait-to-connect ] }
+        { [ errno EINTR = ] [ wait-to-connect ] }
         [ (io-error) ]
     } cond ;
 
@@ -46,7 +46,7 @@ M: object establish-connection ( client-out remote -- )
     [ drop ] [ [ handle>> handle-fd ] [ make-sockaddr/size ] bi* connect ] 2bi
     {
         { [ 0 = ] [ drop ] }
-        { [ err_no EINPROGRESS = ] [
+        { [ errno EINPROGRESS = ] [
             [ +output+ wait-for-port ] [ wait-to-connect ] bi
         ] }
         [ (io-error) ]
@@ -78,8 +78,8 @@ M: object (accept) ( server addrspec -- fd sockaddr )
     2dup do-accept
     {
         { [ over 0 >= ] [ [ 2nip <fd> init-fd ] dip ] }
-        { [ err_no EINTR = ] [ 2drop (accept) ] }
-        { [ err_no EAGAIN = ] [
+        { [ errno EINTR = ] [ 2drop (accept) ] }
+        { [ errno EAGAIN = ] [
             2drop
             [ drop +input+ wait-for-port ]
             [ (accept) ]
@@ -121,10 +121,10 @@ M: unix (receive) ( datagram -- packet sockaddr )
 :: do-send ( packet sockaddr len socket datagram -- )
     socket handle-fd packet dup length 0 sockaddr len sendto
     0 < [
-        err_no EINTR = [
+        errno EINTR = [
             packet sockaddr len socket datagram do-send
         ] [
-            err_no EAGAIN = [
+            errno EAGAIN = [
                 datagram +output+ wait-for-port
                 packet sockaddr len socket datagram do-send
             ] [
diff --git a/basis/libc/libc.factor b/basis/libc/libc.factor
index 1e751833a2..bcfb97750f 100644
--- a/basis/libc/libc.factor
+++ b/basis/libc/libc.factor
@@ -2,10 +2,18 @@
 ! Copyright (C) 2007, 2008 Slava Pestov
 ! Copyright (C) 2007, 2008 Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien assocs continuations destructors kernel
-namespaces accessors sets summary ;
+USING: alien alien.syntax assocs continuations destructors
+kernel namespaces accessors sets summary ;
 IN: libc
 
+LIBRARY: factor
+
+: errno ( -- int )
+    "int" "factor" "err_no" { } alien-invoke ;
+
+: clear-errno ( -- )
+    "void" "factor" "clear_err_no" { } alien-invoke ;
+
 <PRIVATE
 
 : (malloc) ( size -- alien )
diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor
index 42444261e2..76613934af 100644
--- a/basis/unix/unix.factor
+++ b/basis/unix/unix.factor
@@ -37,18 +37,13 @@ C-STRUCT: group
     { "int" "gr_gid" }
     { "char**" "gr_mem" } ;
 
-LIBRARY: factor
-
-FUNCTION: void clear_err_no ( ) ;
-FUNCTION: int err_no ( ) ;
-
 LIBRARY: libc
 
 FUNCTION: char* strerror ( int errno ) ;
 
 ERROR: unix-error errno message ;
 
-: (io-error) ( -- * ) err_no dup strerror unix-error ;
+: (io-error) ( -- * ) errno dup strerror unix-error ;
 
 : io-error ( n -- ) 0 < [ (io-error) ] when ;
 
@@ -61,7 +56,7 @@ MACRO:: unix-system-call ( quot -- )
             n ndup quot call dup 0 < [
                 drop
                 n narray
-                err_no dup strerror
+                errno dup strerror
                 word unix-system-call-error
             ] [
                 n nnip

From 4ebc3203d65576da5a85e9520b5319ffb6b4a73f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 18:36:00 -0600
Subject: [PATCH 08/41] unbreak bootstrap

---
 basis/libc/libc.factor | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/basis/libc/libc.factor b/basis/libc/libc.factor
index bcfb97750f..c154544f81 100644
--- a/basis/libc/libc.factor
+++ b/basis/libc/libc.factor
@@ -2,12 +2,10 @@
 ! Copyright (C) 2007, 2008 Slava Pestov
 ! Copyright (C) 2007, 2008 Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax assocs continuations destructors
+USING: alien assocs continuations destructors
 kernel namespaces accessors sets summary ;
 IN: libc
 
-LIBRARY: factor
-
 : errno ( -- int )
     "int" "factor" "err_no" { } alien-invoke ;
 

From c8c427ec159b92acf5924e757b5ea3ed95d2e692 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 18:38:41 -0600
Subject: [PATCH 09/41] initial, non-stream-based zlib binding

---
 basis/zlib/authors.txt       |  1 +
 basis/zlib/ffi/authors.txt   |  1 +
 basis/zlib/ffi/ffi.factor    | 30 ++++++++++++++++++++++
 basis/zlib/zlib-tests.factor |  9 +++++++
 basis/zlib/zlib.factor       | 50 ++++++++++++++++++++++++++++++++++++
 5 files changed, 91 insertions(+)
 create mode 100755 basis/zlib/authors.txt
 create mode 100755 basis/zlib/ffi/authors.txt
 create mode 100755 basis/zlib/ffi/ffi.factor
 create mode 100755 basis/zlib/zlib-tests.factor
 create mode 100755 basis/zlib/zlib.factor

diff --git a/basis/zlib/authors.txt b/basis/zlib/authors.txt
new file mode 100755
index 0000000000..7c1b2f2279
--- /dev/null
+++ b/basis/zlib/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
diff --git a/basis/zlib/ffi/authors.txt b/basis/zlib/ffi/authors.txt
new file mode 100755
index 0000000000..7c1b2f2279
--- /dev/null
+++ b/basis/zlib/ffi/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
diff --git a/basis/zlib/ffi/ffi.factor b/basis/zlib/ffi/ffi.factor
new file mode 100755
index 0000000000..bda2809f56
--- /dev/null
+++ b/basis/zlib/ffi/ffi.factor
@@ -0,0 +1,30 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien alien.syntax combinators system ;
+IN: zlib.ffi
+
+<< "zlib" {
+    { [ os winnt? ] [ "zlib1.dll" ] }
+    { [ os macosx? ] [ "libz.dylib" ] }
+    { [ os unix? ] [ "libz.so" ] }
+} cond "cdecl" add-library >>
+
+LIBRARY: zlib
+
+CONSTANT: Z_OK 0
+CONSTANT: Z_STREAM_END 1
+CONSTANT: Z_NEED_DICT 2
+CONSTANT: Z_ERRNO -1
+CONSTANT: Z_STREAM_ERROR -2
+CONSTANT: Z_DATA_ERROR -3
+CONSTANT: Z_MEM_ERROR -4
+CONSTANT: Z_BUF_ERROR -5
+CONSTANT: Z_VERSION_ERROR -6
+
+TYPEDEF: void Bytef
+TYPEDEF: ulong uLongf
+TYPEDEF: ulong uLong
+
+FUNCTION: int compress ( Bytef* dest, uLongf* destLen, Bytef* source, uLong sourceLen ) ;
+FUNCTION: int compress2 ( Bytef* dest, uLongf* destLen, Bytef* source, uLong sourceLen, int level ) ;
+FUNCTION: int uncompress ( Bytef* dest, uLongf* destLen, Bytef* source, uLong sourceLen ) ;
diff --git a/basis/zlib/zlib-tests.factor b/basis/zlib/zlib-tests.factor
new file mode 100755
index 0000000000..0ac77277dc
--- /dev/null
+++ b/basis/zlib/zlib-tests.factor
@@ -0,0 +1,9 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel tools.test zlib classes ;
+IN: zlib.tests
+
+: compress-me ( -- byte-array ) B{ 1 2 3 4 5 } ;
+
+[ t ] [ compress-me [ compress uncompress ] keep = ] unit-test
+[ t ] [ compress-me compress compressed instance? ] unit-test
diff --git a/basis/zlib/zlib.factor b/basis/zlib/zlib.factor
new file mode 100755
index 0000000000..d5eed0b35b
--- /dev/null
+++ b/basis/zlib/zlib.factor
@@ -0,0 +1,50 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien alien.c-types alien.syntax byte-arrays combinators
+kernel math math.functions sequences system accessors
+libc ;
+QUALIFIED: zlib.ffi
+IN: zlib
+
+TUPLE: compressed data length ;
+
+: <compressed> ( data length -- compressed )
+    compressed new
+        swap >>length
+        swap >>data ;
+
+ERROR: zlib-failed n string ;
+
+: zlib-error-message ( n -- * )
+    dup zlib.ffi:Z_ERRNO = [
+        drop errno "native libc error"
+    ] [
+        dup {
+            "no error" "libc_error"
+            "stream error" "data error"
+            "memory error" "buffer error" "zlib version error"
+        } ?nth
+    ] if zlib-failed ;
+
+: zlib-error ( n -- )
+    dup zlib.ffi:Z_OK = [ drop ] [ dup zlib-error-message zlib-failed ] if ;
+
+! Compressed size is up to .001% larger plus 12
+
+: compressed-size ( byte-array -- n )
+    length 1001/1000 * ceiling 12 + ;
+
+: compress ( byte-array -- compressed )
+    [
+        [ compressed-size <byte-array> dup length <ulong> ] keep [
+            dup length zlib.ffi:compress zlib-error
+        ] 3keep drop *ulong head
+    ] keep length <compressed> ;
+
+: uncompress ( compressed -- byte-array )
+    [
+        length>> [ <byte-array> ] keep <ulong> 2dup
+    ] [
+        data>> dup length
+        zlib.ffi:uncompress zlib-error
+    ] bi *ulong head ;

From d5dc7f5db51dca61fcb316298e0bc17aa5db38a6 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 18:40:41 -0600
Subject: [PATCH 10/41] remove bad comment

---
 basis/zlib/zlib.factor | 2 --
 1 file changed, 2 deletions(-)

diff --git a/basis/zlib/zlib.factor b/basis/zlib/zlib.factor
index d5eed0b35b..b40d9c2a98 100755
--- a/basis/zlib/zlib.factor
+++ b/basis/zlib/zlib.factor
@@ -29,8 +29,6 @@ ERROR: zlib-failed n string ;
 : zlib-error ( n -- )
     dup zlib.ffi:Z_OK = [ drop ] [ dup zlib-error-message zlib-failed ] if ;
 
-! Compressed size is up to .001% larger plus 12
-
 : compressed-size ( byte-array -- n )
     length 1001/1000 * ceiling 12 + ;
 

From 201296c04043eeb281a28e1b844ca1ee8f9f0147 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 18:46:23 -0600
Subject: [PATCH 11/41] dllexport err_no and clear_err_no

---
 vm/io.h | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/vm/io.h b/vm/io.h
index 08c9dd7807..dc7d69edee 100755
--- a/vm/io.h
+++ b/vm/io.h
@@ -1,7 +1,7 @@
 void init_c_io(void);
 void io_error(void);
-int err_no(void);
-void clear_err_no(void);
+DLLEXPORT int err_no(void);
+DLLEXPORT void clear_err_no(void);
 
 void primitive_fopen(void);
 void primitive_fgetc(void);

From c45b188581a2bcbff8a4d929e82e307bff66d72f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 22:43:11 -0600
Subject: [PATCH 12/41] fix furnace.utilities

---
 basis/furnace/utilities/utilities-docs.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/furnace/utilities/utilities-docs.factor b/basis/furnace/utilities/utilities-docs.factor
index 6defba54d2..3a0d8804ef 100644
--- a/basis/furnace/utilities/utilities-docs.factor
+++ b/basis/furnace/utilities/utilities-docs.factor
@@ -27,7 +27,7 @@ HELP: hidden-form-field
     { $example
         "USING: furnace.utilities io ;"
         "\"bar\" \"foo\" hidden-form-field nl"
-        "<input type=\"hidden\" name=\"foo\" value=\"bar\"/>"
+        "<input type=\"hidden\" value=\"bar\" name=\"foo\"/>"
     }
 } ;
 

From 0fc6dde17877ff2ff2194339197b7882e382308e Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 22:56:46 -0600
Subject: [PATCH 13/41] make sure multipart parsing has enough bytes to compare
 against

---
 basis/mime/multipart/multipart.factor | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/basis/mime/multipart/multipart.factor b/basis/mime/multipart/multipart.factor
index eda7849a73..37d5e13129 100755
--- a/basis/mime/multipart/multipart.factor
+++ b/basis/mime/multipart/multipart.factor
@@ -42,7 +42,7 @@ ERROR: end-of-stream multipart ;
     [ t >>end-of-stream? ] if* ;
 
 : maybe-fill-bytes ( multipart -- multipart )
-    dup bytes>> [ fill-bytes ] unless  ;
+    dup bytes>> length 256 < [ fill-bytes ] when ;
 
 : split-bytes ( bytes separator -- leftover-bytes safe-to-dump )
     dupd [ length ] bi@ 1- - short cut-slice swap ;
@@ -65,6 +65,7 @@ ERROR: end-of-stream multipart ;
     [ dump-until-separator ] with-string-writer ;
 
 : read-header ( multipart -- multipart )
+    maybe-fill-bytes
     dup bytes>> "--\r\n" sequence= [
         t >>end-of-stream?
     ] [

From b073fe5eeebb803a4af2ac01f31b9db15dba7cbf Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 23:37:18 -0600
Subject: [PATCH 14/41] the start of an endianness library, used by pack

---
 basis/endian/authors.txt         |  1 +
 basis/endian/endian-tests.factor |  7 ++++
 basis/endian/endian.factor       | 67 ++++++++++++++++++++++++++++++++
 3 files changed, 75 insertions(+)
 create mode 100755 basis/endian/authors.txt
 create mode 100755 basis/endian/endian-tests.factor
 create mode 100755 basis/endian/endian.factor

diff --git a/basis/endian/authors.txt b/basis/endian/authors.txt
new file mode 100755
index 0000000000..7c1b2f2279
--- /dev/null
+++ b/basis/endian/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
diff --git a/basis/endian/endian-tests.factor b/basis/endian/endian-tests.factor
new file mode 100755
index 0000000000..b066ce6995
--- /dev/null
+++ b/basis/endian/endian-tests.factor
@@ -0,0 +1,7 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel namespaces tools.test endian ;
+IN: endian.tests
+
+[ t ] [ [ endianness get big-endian = ] with-big-endian ] unit-test
+[ t ] [ [ endianness get little-endian = ] with-little-endian ] unit-test
diff --git a/basis/endian/endian.factor b/basis/endian/endian.factor
new file mode 100755
index 0000000000..a832d6c0a2
--- /dev/null
+++ b/basis/endian/endian.factor
@@ -0,0 +1,67 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types namespaces io.binary fry
+kernel math ;
+IN: endian
+
+SINGLETONS: big-endian little-endian ;
+
+: native-endianness ( -- class )
+    1 <int> *char 0 = big-endian little-endian ? ;
+
+: >signed ( x n -- y )
+    2dup neg 1+ shift 1 = [ 2^ - ] [ drop ] if ;
+
+native-endianness \ native-endianness set-global
+
+SYMBOL: endianness
+
+\ native-endianness get-global endianness set-global
+
+HOOK: >native-endian native-endianness ( obj n -- str )
+
+M: big-endian >native-endian >be ;
+
+M: little-endian >native-endian >le ;
+
+HOOK: unsigned-native-endian> native-endianness ( obj -- str )
+
+M: big-endian unsigned-native-endian> be> ;
+
+M: little-endian unsigned-native-endian> le> ;
+
+: signed-native-endian> ( obj n -- str )
+    [ unsigned-native-endian> ] dip >signed ;
+
+HOOK: >endian endianness ( obj n -- str )
+
+M: big-endian >endian >be ;
+
+M: little-endian >endian >le ;
+
+HOOK: endian> endianness ( seq -- n )
+
+M: big-endian endian> be> ;
+
+M: little-endian endian> le> ;
+
+HOOK: unsigned-endian> endianness ( obj -- str )
+
+M: big-endian unsigned-endian> be> ;
+
+M: little-endian unsigned-endian> le> ;
+
+: signed-endian> ( obj n -- str )
+    [ unsigned-endian> ] dip >signed ;
+
+: with-endianness ( endian quot -- )
+    [ endianness ] dip with-variable ; inline
+
+: with-big-endian ( quot -- )
+    big-endian swap with-endianness ; inline
+
+: with-little-endian ( quot -- )
+    little-endian swap with-endianness ; inline
+
+: with-native-endian ( quot -- )
+    \ native-endianness get-global swap with-endianness ; inline

From 1979fbc61a1c5edb95b69c3cfd56b6f34fbebff8 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 23:37:38 -0600
Subject: [PATCH 15/41] pack uses endian library now

---
 basis/pack/pack.factor | 38 +++++++-------------------------------
 1 file changed, 7 insertions(+), 31 deletions(-)

diff --git a/basis/pack/pack.factor b/basis/pack/pack.factor
index 3cf7dbab4c..9078817206 100755
--- a/basis/pack/pack.factor
+++ b/basis/pack/pack.factor
@@ -5,33 +5,9 @@ io.binary io.streams.string kernel math math.parser namespaces
 make parser prettyprint quotations sequences strings vectors
 words macros math.functions math.bitwise fry generalizations
 combinators.smart io.streams.byte-array io.encodings.binary
-math.vectors combinators multiline ;
+math.vectors combinators multiline endian ;
 IN: pack
 
-SYMBOL: big-endian
-
-: big-endian? ( -- ? )
-    1 <int> *char zero? ;
-
-<PRIVATE
-
-: set-big-endian ( -- )
-    big-endian? big-endian set ; inline
-
-PRIVATE>
-
-: >signed ( x n -- y )
-    2dup neg 1+ shift 1 = [ 2^ - ] [ drop ] if ;
-
-: >endian ( obj n -- str )
-    big-endian get [ >be ] [ >le ] if ; inline
-
-: unsigned-endian> ( obj -- str )
-    big-endian get [ be> ] [ le> ] if ; inline
-
-: signed-endian> ( obj n -- str )
-    [ unsigned-endian> ] dip >signed ;
-
 GENERIC: >n-byte-array ( obj n -- byte-array )
 
 M: integer >n-byte-array ( m n -- byte-array ) >endian ;
@@ -124,13 +100,13 @@ PRIVATE>
     [ ch>packed-length ] sigma ;
  
 : pack-native ( seq str -- seq )
-    [ set-big-endian pack ] with-scope ; inline
+    '[ _ _ pack ] with-native-endian ; inline
 
 : pack-be ( seq str -- seq )
-    [ big-endian on pack ] with-scope ; inline
+    '[ _ _ pack ] with-big-endian ; inline
 
 : pack-le ( seq str -- seq )
-    [ big-endian off pack ] with-scope ; inline
+    '[ _ _ pack ] with-little-endian ; inline
 
 <PRIVATE
 
@@ -146,13 +122,13 @@ MACRO: unpack ( str -- quot )
 PRIVATE>
 
 : unpack-native ( seq str -- seq )
-    [ set-big-endian unpack ] with-scope ; inline
+    '[ _ _ unpack ] with-native-endian ; inline
 
 : unpack-be ( seq str -- seq )
-    [ big-endian on unpack ] with-scope ; inline
+    '[ _ _ unpack ] with-big-endian ; inline
 
 : unpack-le ( seq str -- seq )
-    [ big-endian off unpack ] with-scope ; inline
+    '[ _ _ unpack ] with-little-endian ; inline
 
 ERROR: packed-read-fail str bytes ;
 

From 26f9df982d372c9e628112ba030bca1cd1514ec0 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 23:41:59 -0600
Subject: [PATCH 16/41] the start of a tiff library

---
 extra/graphics/tiff/authors.txt       |   1 +
 extra/graphics/tiff/rgb.tiff          | Bin 0 -> 7916 bytes
 extra/graphics/tiff/tiff-tests.factor |   9 +++++++
 extra/graphics/tiff/tiff.factor       |  37 ++++++++++++++++++++++++++
 4 files changed, 47 insertions(+)
 create mode 100755 extra/graphics/tiff/authors.txt
 create mode 100755 extra/graphics/tiff/rgb.tiff
 create mode 100755 extra/graphics/tiff/tiff-tests.factor
 create mode 100755 extra/graphics/tiff/tiff.factor

diff --git a/extra/graphics/tiff/authors.txt b/extra/graphics/tiff/authors.txt
new file mode 100755
index 0000000000..7c1b2f2279
--- /dev/null
+++ b/extra/graphics/tiff/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
diff --git a/extra/graphics/tiff/rgb.tiff b/extra/graphics/tiff/rgb.tiff
new file mode 100755
index 0000000000000000000000000000000000000000..71cbaa9d6e807156f7da39a5b116c9edb3b0c9e1
GIT binary patch
literal 7916
zcmeHMcT^MWw+#r=t3X6RRC<#hYUoXR4bnxLK!S7xL9Q1Cgh&@qz)BGldhfkA=^#Z!
zK)@iqNqZASuUB2~z4iWmzr{LhhA%Uj$#>4#XP<qpT;T=@od<#blAY2OXQd+}xTj#P
zTWSkoq6k&Gt|y)f;{zjAZ1hTJyrIldYPR|ktnpeLaq4#ZWwyl@{E3?O1`?@52(e^s
z2ZOSitpM5Qx;G3Z+2|gsrs_KymfJy6bY2@e8A+zWvW(F%XQT32?<%X@t8kbUTYQ&8
zp(z4ZVOKnHv(((hSSoF3$*0otrg6pW)<IzHHP@@s>|nBx#_MiZEA7RYB3o_UO{CL}
z`4T$qJq*th{=a--LJ$twGab&~cKEvCxzs}f`5@Q@BhyF!+F=vt__71{97L%+4=m~D
z9hNH{W8PYvFe3@79lyErV~3@*N%(>r?VZKZG6v9RZ*Ra8q*7{>GX|VIe3PpS&ivIS
z?^&LeK8z>{n<{)a0r?nEQ~udCf$vVwgS=r^3G-_E+gF<A-EWOgX23$~hZpylE=S~K
zy<fTIXi>v%6EeNwXFF*rvu!upuv%ip*n(QxuB?^&#g&vGP+-HfAYmMg3;dw@dhhE-
z7lwbw-s{xt<Ji+p99JiR+*N&X<|<~3LOew0`2bPMFR`buj<+UZjDp=TNW8C&jlCOg
z^i?q)_W8zeScPq{mprN+vFVuRB8>Pa_7r)H!eP`Og6gK+u9n01s3Mwe9YxK(>9joB
zKdeLc<9)C@<7q0Hep4&BWl`vzmVJm$=HO><-HG59e(!f5if>oVZ3om$S$LU4yFUfB
z6l=gYlP)(zSA5i*kFB}`&gj8--?pg!q=9lx+FljysPXB#G^_Z^{Jl=egHLZQq*MH?
zz&b1YcLJ@dTns|TBqR4c*JPu(iMM5XZYP`);$PR#kngFaC#sJ^^AU;>)~n*xtyJ8_
zgN8LKgf-rzkuIv|$0MT6L^gz+X{JKj(Z6uh5RYky!n@H76=YN&;B{jqFI3Gn_ns->
zAw9#=76VV-Z^ral&R6F99bBr?r|#!f?Gx%}&eFp}zpivgw~@)XYqp4XMaSU&;ws2#
z5J+~KQY~4Mk2<t*I+t_6o(22^CPGwSQE~d`gX!a2W@EXO=&VJLVS?4gnCV#;M+`AO
zosr6mzF%O1|5f{o&CJ0|cZ~s<&~@r8cd&b*&POL@SA5(2`PlQ#o!R;l_kUca%m;Qv
zf30$?opwFro7`-JOqpSchsX2qIh9&mhLA!i#1gQsg0d%Qv2>5G((Th^x1stmt|j!3
zn3?TIU2Z-`Rj)OL3|sh^%W!}nw#+C9n_&)Zl6+=1yy&%BG_v5cbKZ3439PDsAoe%t
z#*CG4U{?J7rL!l)Kkw*nibUKm4yda4545WJw0(U_=79*PN46{W?3mDv0TTSwoF_Nt
zxRx}mPAdSeBB}1~A4rySZO}MX9%TrnO5;^xeO)D}(L=2q4Yweb`9fnuR;$x_5sY@j
zQ)X19O2);=MaLPRSBv3At~M_k2GX}KCVLjO<;}!oDr>#$;OwC8y!F>#zxagnd-|N?
zAq#GNxhg*6bn)yDpWIWv)H`bKr1t~5&qp+|tUHoU6EOS^ED7D5XUbBvC3Mj+M}tgT
zIwMoSCx+alb2+#uJ*T1aw1|J8o1<8s#a*iNu<TC76g-;#klMgL^IG23a<4DFflo}`
zw%??wk0Al*HmRKRfeKd6qK7-HFO}K#EP8J44Y8119>93(r(8azoEr2oKdCal2S^{+
zTjmlfAs3;83uWe75d|hW_ttk4Iz?d>S?^XMyU-Hm3i6NdZ>Pv|By@e+xVlL%YZatw
zxv~`?29;Gs<t+FfiA%hfireK|cH-TsTKX6>A*Q`gy;~OrXCkO44(Fc9B|6nOThCLl
zSSY(_wv|;q->`NBA?wKAmtFaq-^-h;L;<eNv$Y2EE_(_yv`}?=&dFWjwH>dedY4C^
zmx~eaXwoylG@^P*wdfSO(GHh*^!AFk)mQgvag}qE@AG$_A#LnZiP$fp>4cL)>eaZB
zz3f^s2H_lRd8}&lS8_0EVqG3FAv`K)pg8B=dI*0I>7~)4RnE)eEs(2<yMMO4dyzGL
zSZz&H`+j$S>iVhj*g*nLt|BIWMV+WdGTc5dgoSZ-=&yzFhx<>^Gg0Jc^bAq5qa103
z5%49dqze)%6&njDY1!!S8WOt+Jy)5FDT5LRsyx@2U;k>v9-#R0PnBC&T{-@-PKF6L
zHYJNB9_da$Dz`Z8YyY&>1uU^Schk4p+-19*{PcuV{q)VVWf9CjS8hGQ#3yjSUaih~
zPXm;N{pX|vE6;pV$Q#wHAdEl)*QAYJM!`FqBEtB{Z|(<DlBJ}{2Ei~X20^*jEjjN+
z#6MkTTJZXCo9xc1g6!!@5&A<b18C^_dX;63L&?PQj=BV6By-Es#5*UqF<CM9@_CsB
zp2Wfe#8^y(bdG``=$rc~!%}y%bA><S)Vjw0b(qr`yR%rkWSV`XsD<QyQs=7CM60yQ
zYXJt()AoIRlmQh<nO@Sp+D2rM?XrvuQkjXDvH`XZ1cxGHYYaSvqn#S5#h~n-B*m_-
znR@3y+-*i~K!dN)fUQ01W4}Px8O=e_vV39jHTg6CSrEP`+&1#khyue`-QjR&*%E=y
zJ^8nBd}NnOxP+of<n)=y;|lXIK0=&^{sF?8o_HTM4C0ogb1z)@CDD)T<cD6MPF^HK
zDm{05P2<jRK2nACgrh05QJ2}Kv(O}J%;}lHk2#vPpks2g?}hL>hxJ9)cCX(!T9V?^
zzEn}CS#JvN`#q>Zb-wFCHif3val~CudYtpe5kGOXqVk6dCBr;EoovJo451$!=twn>
zXd{cvSW7VRipLzyq;j@z^jYFNp^{yZb*Z$*59v?*Q%a~%LvUMD!sJLU<xv+OGi;rV
zE`te;h))tY*C0Ra(jLMf9UYTXJJC<cgQbS%kL#q*#lq<Y{z`btvy7TNRo^Od@*4Wd
z&V^h?U$(u5Pdh-JtogJB>#f!~Q@tj+*kO;6TGBYT4MnWKI}*+*BwowPYUChPr0f(W
zt0t@D9%<;QB%)~4z|fxN<o9PBhU#hRkn{03%*8kK##tXH`f9^cD!f`;w_IkiF#78Y
zf)~9uo<Qv!3&zNCRn&2)$Dp%#Q2MMdM<sQY?q6s@#p1I`d>ME$+(E*~`c<TWhJ-~+
z7&$AEdE?jYWc&`!FfPjAW-PB3VmlYEG^0<?YN^T|(Qd8p$odB0Hu9IEBy79!A&K3`
zyqbaSu{wt#G2YkTc=fplqR~dqx=$*fR$094XNy(epDxirD_<LOh89oI=Z;$UhTrci
z5JQ_S|HG@L9{CU%Ms@Ltmy<)1kT0$0-OkNKvL)nMpy^SCLG)o2b0WtDGh^V|y4RA{
zD=GZJaYvX$HQ0>16|rq_5YS_CE8#;aL-ldNbVrOlWyY25n$?}ZY972532(Q(wWr;q
zTIKb&^VZeLz(4?;{Q^uMMtBTEx5o2!wX%Z3#lM&yK0VZlC|xLfxL1ED7sX3<s*Y%E
zdaaJ@9_}dDa>pV@^m4<SgSsqMx@|t!@{gw#1xb~u8Y2wFsO!4(Q4|W1Hhe_Iy^4n0
z@~f#=7v<dIyqH>|G4^YcZtKcK?CN`73|acryP!g9=M+|zHN!Nn_81g1t$JtN3sMo3
z#zwhvetY_A!`fH}yQTq<otbLCdg|v6=mCg%ig3VPj44WWM(?$fw;;#;R-3*u!zU+Y
zRI^wW60bEC`*`M^;~zU9>w>V<2m)?Y^K|~ggp&d6t}(CC;y`wqLm_OjV06%O*r;&)
zUmZ|inMv^#-r`bi>YBfU%rFV#cI=}Mny%SG7U;xIvI{7q&z{Y=(uR}89HrH13qnZG
zCs||;FKjS~+ur7iNpXP;F{<?cz)^Xdr%srWfcTh>S3@_RS6qhpd6cwnxmQ_!@;Rn9
zmX}o(t?$mdmp_RVV<G$4^W{@OR<pr}Z7d4~vg_|{F+Ky`O;oli1uj&}X1`NRGszcJ
z;S2{Kvrv)-atz^iSr(EOr{RmgP;*^Q@`XJmH%%kjrf9f%d99j3@+SeR+y1+fEB*+q
zrvjK;i4CbPw8rp0WN9OG|BYDwr~mv<!~B1jB=m7`ME+Njgr5CdzX_LupCt*WNAtAa
zH{nG;NfNph_hQD6Y9?2HND{hchmf16s+(3vNbbmt#V6Rh`C@r3&=w+0(7`qwX`!|o
zy8+tQnO*ywA?FtCn;D9GPs*KYEhfKAt+?mG>%r9z4B>Nq9Cc&s&quQ%sF0!eTiCYH
zr;29YNrH)U*&t_T{;R)1g!Wk8$nyRjE7^=80-Rr10EFqZ+=YvJ;C+2Q>M%tXfzV27
zDW*`RRDqq1uq(94E2%4-<Jo%rQ5tLlxAwc8FaHnQBEdRI!1qvdaV^t)GLIzj?dJ^=
zCKqe-zek+=P!{_C(Eaa9jW1u386UOD5N?rBLIb8aS%zBGq_G8fl)WlbXx?DX=*hNx
zYr!&_M)E!VyL0%6a%b6N;fNB%!~QSdSimvem!8bH7&dJErsBcYd#lEIPd^Kp4CAa}
zpj(EKc|B2WUfS`u{6_cv0#5jz{~gO^f}W-A$$&s+pat8X7R^dJ!l@0j#hsPa<)y{1
zi*kAfLci5yBC1ESQofT|L5q^r{Tc18=kf3$T-3kmUFXBwujgm%Tk8C1ntteAXTs{z
zV!s~iU3zJ67tN`Y6dt|3W;kjGd&P$u%oP1e@8V9g!|Gk7d@{l=K|^n7!&BKaO;EM-
z-W}idE{R7SM1bCPeaH`gD8r%D)-7=_ZJ8&wqdy;<3_H;ru#Id$#a!M<Wv7opeAzg^
z@k7gJh?4P>;9~25XFjg7Z@8QI(WzLX>qso6XWr9e{AmJgG#KgXn-c2a{0K2~%i1*M
zX>4qL|5wS$8i(TOnQecEr|67$`HiQacT&cilPcG0ND3PFWk@?%ODhnsUhm3B!5Ks4
z1pHZ(<Z`9SA1H9W>cy4Knl8jBJ~ZoImFYoiuGR?%I}%~henp-PZbe_Kh1MZ!$Rs5>
zCy>`EPg9Rcm1UN5HH3w>y6pS1<^I_N*VXXw)PGVO?=~^7acaikUy4(<6SyK0!E^di
zEBiOaF+tnTgI@YgfaJ4QyY&(2H4oDG-qeEK3856#<lp-iLq`!w{P-l@m;DPc2D{=a
zhf)*HzR~;bZ5r_w^9f-z+#l^T#&S>68<w4zY%fM+Q#mDMLXtAZl+bDFF1B~D)g#pY
zPS97n*gfcW=c1Qsm3@iDlUC;~Gw~D@;^o-<R#K&Ql2}>)`%=M&NL4TV?nSZWY6rjr
zU7nKWU0Vis?W#BSj3Q*zKSyW#+!j~{U)mf4n2}}qd$T&sj@gbsdfRe%b^nG)RUq@H
z{i9k+QoP{OTt?DNXx9b>{wo(0-)RL(BpXqY08a<8BB7bW+XjKf^SyQa(om|#XkN`V
zae+#mGfI^H#^6%zMr-=!XtV<@RHtH(QIh|j7+9r`q~@Yp3=idRiowrR=k9Y#ik<IN
zXMxpT_2S>E)@!e6@(oy!n)bSFp55QYUVS~$r*D4|d-0zeEUfQBVOI=MgK3nGUfx;k
z2?ObapK0T1%?eE69z=*cga3%V$)@}?VNF{_F1Z8F3HxOE+d)B7x$7014&cb<>Ac+&
zvG+z9??ATLwdQ$&$Bd9zru25pJo?eCNE~$9sE|olFd#)@gTErU!y=;h3ZjxYI4~rA
z&~{P!ad+QveeiPO*MnJtv}=pskkz2MaYu^j3%^cRYrU&8BlG!>dMzt{3(_^<1jUtg
zUycgdoX_93{z2JWhUfWE9gX0v7yKXBI;$v%8&22cD%>OykBXfosBH^hCU2y|lG5li
z$=m4V&j*A#+BWm^q6j$K+1wl{9Nfliq!HsW)ydAby?gN$l}#XxLe%<n12orD@X{r{
z#uor71saJ0w{aAUO7A_ogSN;<NA?c=#xCJ5O58tEA}mBve}^at|EchnDSb{1Aj#iX
z!$MTP$>|uiO9e#cLwv%q8tHwzN?1u=F(YQQ>GZFygKdnBAzJUX$D1zi`%<}j7dCHg
z(%H%88)v~v?P4bEbH*<DkkF>jeh2zt?;6WD{cy4Z0<U_tFNx;%kd&KA(?Ssc(~3AA
zc`CUZ(%#=7N;kPWVmtZo1<wKE39ue&1nw^3Ol}M&88lgkF%4x{l#BwpjtmD~OHt$M
z8#5Q9(`7xA9)70WbKAmH!(ZI=lhSX-zFoiqJv&21+ghJwb>d_RTh5lhQ^kI~LG<v~
ztwZK)f_Lrv(&QaqcY)S{bfd~uGOnRcEw*yI))mf*l#l$lQe4mPu}v(!60{Cd5J<*)
ziI<2>Ngxh)zJ682yi=NDgZpDccfJmN-73-wOGy3uRUA`q<F)ARKcrDyqhX>GT){-M
zs8b_TUsdQ!-Q})#Gk50dKn4l2p}K9$1nd6{VAi2{c;~<S=Q=+)qSaPk9CL?<J+Pfk
z&xG~c$V9JA>6|=nQs<|Ck4%)4dlw8PwJxVzeAI5cDftMNqyvmhbQjRmnZ{WoKSn0j
z5aLZ3kVU3WVv=diOFk*uH}yN3PDUmYhyo({2J24=>P2@xhqYQP?n=$6es9N7Tq(~i
zSIf!RLe3!ijsdLr?#uqquSPBC+LiOhT-@j_hOn}=gLfrUwG3b7w7W0NqJ<w@LR>4f
zRn=*cMVo#T)iaSv6Mz<KdHzT?1aEEUz#P3lR`hwt|BfkfWcLJO{h-F8eEI#>Q7y6L
zpJN!<BWf<Xu%_u%&f~F?%9P$~^xyv)E7`1ZO843QD6_{+l>{>SNF_;+OK&0V9Kn^e
zf#b1Kh<0?Fvxwio^{jt5Tt+j(sKZX7*EqZHvglX<cC4h$RU&0KcQRID^P9D-?_LB~
zs&D|}ly2@OGUD4<2{vYFAa=R!lgr}+_5|S<-A;&i2ms`BMwGnHb|Dp^W&;QSY0md3
z2TWpPm>o>f6uewyDx)fvA~0(w>VJqOD{<4i$%hd~86zvVtfBA0SZxw^a9*n>W8%Y>
z>A{g~#_-aECHEuPvzl%1og)4Xe4Gr<|E~EAdrnEI)_*9){IKPkJK=_l;LqbXyR|E+
z!3efw&5VD?5+LnZyK~YCxv@sKWqupKrD-{?`wd?IY5bNt^oC}%>Lr%c*~8w<7XQfg
z1Dgyhfa|hpFPJ5NI2pe+Uqd85u-CW<jNhzB{D)3*y&VJAc<{)s(67p_!w3jcZ!>7x
z`Qg_MUz|)sA(OA-+Lo}nj@8xOZ&bXV9i!6jc6Ib$3gkH^br#ig;1^y~9$%lzxU6%$
zU)lan>eQi(oh3rTQ<Lj2pv;lm03wrf|1p-njVSTuE-<eqjyp-5icquZ6UR_1vqd(u
z=swnrH{l7pGSxSVSI__NSo(ED>F7QhN33HUV`N=$#ju>p{27dm_HmK=?<2}j*Am*$
z1xbyTdp1EMXk+*<Bgz|RB{4%)e`VPg9P8XbKVTh2c?|>t;Q;piNC?9I<pC>LI|qD(
z0xS-&Bfu5`D+KHfV0QrfejWA*2L4w8>~Fws1C|chbHG>u<2*T*0oM@%hCMm~Yxi(L
zAbva$r~w}YswV(}&_uwSkbpqMWFSx|IS3>{0X!41BtTEhrvia?s6ik<8W3oc7FYv=
zKvMJ|kkvU5D1-rcPe8w-03Cwxj(-pE0N{t6IzEpAo`iF9J_Rh}0_UfIqbCyxbn0Xs
zcmdGqlXKvuKvXz*Am9O@A>bO?lXdJpbig|Bbs%EEz$e%E0oR<v!9QNN1<n~x&f&m0
U<H^0)dpLjke&|o@z(=6}0?pY|g8%>k

literal 0
HcmV?d00001

diff --git a/extra/graphics/tiff/tiff-tests.factor b/extra/graphics/tiff/tiff-tests.factor
new file mode 100755
index 0000000000..daee9a5d9e
--- /dev/null
+++ b/extra/graphics/tiff/tiff-tests.factor
@@ -0,0 +1,9 @@
+! Copyright (C) 2009 Your name.
+! 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" ;
+
+
diff --git a/extra/graphics/tiff/tiff.factor b/extra/graphics/tiff/tiff.factor
new file mode 100755
index 0000000000..4676ea2748
--- /dev/null
+++ b/extra/graphics/tiff/tiff.factor
@@ -0,0 +1,37 @@
+! 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 ;
+IN: graphics.tiff
+
+TUPLE: tiff
+endianness
+the-answer
+ifd-offset
+;
+
+
+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 ;
+
+: (load-tiff) ( path -- tiff )
+    binary [
+        tiff new
+        read-header
+    ] with-file-reader ;
+
+: load-tiff ( path -- tiff )
+    (load-tiff) ;

From a4b174d04b64df457331dd6e881b4e987d29422f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 00:58:02 -0600
Subject: [PATCH 17/41] spruce up unmaintained/openal -- can maybe go back into
 extra/

---
 unmaintained/openal/macosx/macosx.factor |   6 +-
 unmaintained/openal/openal.factor        | 252 +++++++++++------------
 2 files changed, 128 insertions(+), 130 deletions(-)

diff --git a/unmaintained/openal/macosx/macosx.factor b/unmaintained/openal/macosx/macosx.factor
index d2a0422d8d..abc0d65fb9 100644
--- a/unmaintained/openal/macosx/macosx.factor
+++ b/unmaintained/openal/macosx/macosx.factor
@@ -9,6 +9,6 @@ LIBRARY: alut
 FUNCTION: void alutLoadWAVFile ( ALbyte* fileName, ALenum* format, void** data, ALsizei* size, ALsizei* frequency ) ;
 
 M: macosx load-wav-file ( path -- format data size frequency )
-  0 <int> f <void*> 0 <int> 0 <int>
-  [ alutLoadWAVFile ] 4keep
-  >r >r >r *int r> *void* r> *int r> *int ;
+    0 <int> f <void*> 0 <int> 0 <int>
+    [ alutLoadWAVFile ] 4keep
+    [ [ [ *int ] dip *void* ] dip *int ] dip *int ;
diff --git a/unmaintained/openal/openal.factor b/unmaintained/openal/openal.factor
index 40593d1e8d..8533308f26 100644
--- a/unmaintained/openal/openal.factor
+++ b/unmaintained/openal/openal.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel arrays alien system combinators alien.syntax namespaces
-       alien.c-types sequences vocabs.loader shuffle combinators.lib
+       alien.c-types sequences vocabs.loader shuffle
        openal.backend specialized-arrays.uint ;
 IN: openal
 
@@ -36,75 +36,75 @@ TYPEDEF: int ALenum
 TYPEDEF: float ALfloat
 TYPEDEF: double ALdouble
 
-: AL_INVALID ( -- number ) -1 ; inline
-: AL_NONE ( -- number ) 0 ; inline
-: AL_FALSE ( -- number ) 0 ; inline
-: AL_TRUE ( -- number ) 1 ; inline
-: AL_SOURCE_RELATIVE ( -- number ) HEX: 202 ; inline
-: AL_CONE_INNER_ANGLE ( -- nmber ) HEX: 1001 ; inline
-: AL_CONE_OUTER_ANGLE ( -- number ) HEX: 1002 ; inline
-: AL_PITCH ( -- number ) HEX: 1003 ; inline
-: AL_POSITION ( -- number ) HEX: 1004 ; inline
-: AL_DIRECTION ( -- number ) HEX: 1005 ; inline
-: AL_VELOCITY ( -- number ) HEX: 1006 ; inline
-: AL_LOOPING ( -- number ) HEX: 1007 ; inline
-: AL_BUFFER ( -- number ) HEX: 1009 ; inline
-: AL_GAIN ( -- number ) HEX: 100A ; inline
-: AL_MIN_GAIN ( -- number ) HEX: 100D ; inline
-: AL_MAX_GAIN ( -- number ) HEX: 100E ; inline
-: AL_ORIENTATION ( -- number ) HEX: 100F ; inline
-: AL_CHANNEL_MASK ( -- number ) HEX: 3000 ; inline
-: AL_SOURCE_STATE ( -- number ) HEX: 1010 ; inline
-: AL_INITIAL ( -- number ) HEX: 1011 ; inline
-: AL_PLAYING ( -- number ) HEX: 1012 ; inline
-: AL_PAUSED ( -- number ) HEX: 1013 ; inline
-: AL_STOPPED ( -- number ) HEX: 1014 ; inline
-: AL_BUFFERS_QUEUED ( -- number ) HEX: 1015 ; inline
-: AL_BUFFERS_PROCESSED ( -- number ) HEX: 1016 ; inline
-: AL_SEC_OFFSET ( -- number ) HEX: 1024 ; inline
-: AL_SAMPLE_OFFSET ( -- number ) HEX: 1025 ; inline
-: AL_BYTE_OFFSET ( -- number ) HEX: 1026 ; inline
-: AL_SOURCE_TYPE ( -- number ) HEX: 1027 ; inline
-: AL_STATIC ( -- number ) HEX: 1028 ; inline
-: AL_STREAMING ( -- number ) HEX: 1029 ; inline
-: AL_UNDETERMINED ( -- number ) HEX: 1030 ; inline
-: AL_FORMAT_MONO8 ( -- number ) HEX: 1100 ; inline
-: AL_FORMAT_MONO16 ( -- number ) HEX: 1101 ; inline
-: AL_FORMAT_STEREO8 ( -- number ) HEX: 1102 ; inline
-: AL_FORMAT_STEREO16 ( -- number ) HEX: 1103 ; inline
-: AL_REFERENCE_DISTANCE ( -- number ) HEX: 1020 ; inline
-: AL_ROLLOFF_FACTOR ( -- number ) HEX: 1021 ; inline
-: AL_CONE_OUTER_GAIN ( -- number ) HEX: 1022 ; inline
-: AL_MAX_DISTANCE ( -- number ) HEX: 1023 ; inline
-: AL_FREQUENCY ( -- number ) HEX: 2001 ; inline
-: AL_BITS ( -- number ) HEX: 2002 ; inline
-: AL_CHANNELS ( -- number ) HEX: 2003 ; inline
-: AL_SIZE ( -- number ) HEX: 2004 ; inline
-: AL_UNUSED ( -- number ) HEX: 2010 ; inline
-: AL_PENDING ( -- number ) HEX: 2011 ; inline
-: AL_PROCESSED ( -- number ) HEX: 2012 ; inline
-: AL_NO_ERROR ( -- number ) AL_FALSE ; inline
-: AL_INVALID_NAME ( -- number ) HEX: A001 ; inline
-: AL_ILLEGAL_ENUM ( -- number ) HEX: A002 ; inline
-: AL_INVALID_ENUM ( -- number ) HEX: A002 ; inline
-: AL_INVALID_VALUE ( -- number ) HEX: A003 ; inline
-: AL_ILLEGAL_COMMAND ( -- number ) HEX: A004 ; inline
-: AL_INVALID_OPERATION ( -- number ) HEX: A004 ; inline
-: AL_OUT_OF_MEMORY ( -- number ) HEX: A005 ; inline
-: AL_VENDOR ( -- number ) HEX: B001 ; inline
-: AL_VERSION ( -- number ) HEX: B002 ; inline
-: AL_RENDERER ( -- number ) HEX: B003 ; inline
-: AL_EXTENSIONS ( -- number ) HEX: B004 ; inline
-: AL_DOPPLER_FACTOR ( -- number ) HEX: C000 ; inline
-: AL_DOPPLER_VELOCITY ( -- number ) HEX: C001 ; inline
-: AL_SPEED_OF_SOUND ( -- number ) HEX: C003 ; inline
-: AL_DISTANCE_MODEL ( -- number ) HEX: D000 ; inline
-: AL_INVERSE_DISTANCE ( -- number ) HEX: D001 ; inline
-: AL_INVERSE_DISTANCE_CLAMPED ( -- number ) HEX: D002 ; inline
-: AL_LINEAR_DISTANCE ( -- number ) HEX: D003 ; inline
-: AL_LINEAR_DISTANCE_CLAMPED ( -- number ) HEX: D004 ; inline
-: AL_EXPONENT_DISTANCE ( -- number ) HEX: D005 ; inline
-: AL_EXPONENT_DISTANCE_CLAMPED ( -- number ) HEX: D006 ; inline
+CONSTANT: AL_INVALID -1
+CONSTANT: AL_NONE 0
+CONSTANT: AL_FALSE 0
+CONSTANT: AL_TRUE 1
+CONSTANT: AL_SOURCE_RELATIVE HEX: 202
+CONSTANT: AL_CONE_INNER_ANGLE HEX: 1001
+CONSTANT: AL_CONE_OUTER_ANGLE HEX: 1002
+CONSTANT: AL_PITCH HEX: 1003
+CONSTANT: AL_POSITION HEX: 1004
+CONSTANT: AL_DIRECTION HEX: 1005
+CONSTANT: AL_VELOCITY HEX: 1006
+CONSTANT: AL_LOOPING HEX: 1007
+CONSTANT: AL_BUFFER HEX: 1009
+CONSTANT: AL_GAIN HEX: 100A
+CONSTANT: AL_MIN_GAIN HEX: 100D
+CONSTANT: AL_MAX_GAIN HEX: 100E
+CONSTANT: AL_ORIENTATION HEX: 100F
+CONSTANT: AL_CHANNEL_MASK HEX: 3000
+CONSTANT: AL_SOURCE_STATE HEX: 1010
+CONSTANT: AL_INITIAL HEX: 1011
+CONSTANT: AL_PLAYING HEX: 1012
+CONSTANT: AL_PAUSED HEX: 1013
+CONSTANT: AL_STOPPED HEX: 1014
+CONSTANT: AL_BUFFERS_QUEUED HEX: 1015
+CONSTANT: AL_BUFFERS_PROCESSED HEX: 1016
+CONSTANT: AL_SEC_OFFSET HEX: 1024
+CONSTANT: AL_SAMPLE_OFFSET HEX: 1025
+CONSTANT: AL_BYTE_OFFSET HEX: 1026
+CONSTANT: AL_SOURCE_TYPE HEX: 1027
+CONSTANT: AL_STATIC HEX: 1028
+CONSTANT: AL_STREAMING HEX: 1029
+CONSTANT: AL_UNDETERMINED HEX: 1030
+CONSTANT: AL_FORMAT_MONO8 HEX: 1100
+CONSTANT: AL_FORMAT_MONO16 HEX: 1101
+CONSTANT: AL_FORMAT_STEREO8 HEX: 1102
+CONSTANT: AL_FORMAT_STEREO16 HEX: 1103
+CONSTANT: AL_REFERENCE_DISTANCE HEX: 1020
+CONSTANT: AL_ROLLOFF_FACTOR HEX: 1021
+CONSTANT: AL_CONE_OUTER_GAIN HEX: 1022
+CONSTANT: AL_MAX_DISTANCE HEX: 1023
+CONSTANT: AL_FREQUENCY HEX: 2001
+CONSTANT: AL_BITS HEX: 2002
+CONSTANT: AL_CHANNELS HEX: 2003
+CONSTANT: AL_SIZE HEX: 2004
+CONSTANT: AL_UNUSED HEX: 2010
+CONSTANT: AL_PENDING HEX: 2011
+CONSTANT: AL_PROCESSED HEX: 2012
+CONSTANT: AL_NO_ERROR AL_FALSE
+CONSTANT: AL_INVALID_NAME HEX: A001
+CONSTANT: AL_ILLEGAL_ENUM HEX: A002
+CONSTANT: AL_INVALID_ENUM HEX: A002
+CONSTANT: AL_INVALID_VALUE HEX: A003
+CONSTANT: AL_ILLEGAL_COMMAND HEX: A004
+CONSTANT: AL_INVALID_OPERATION HEX: A004
+CONSTANT: AL_OUT_OF_MEMORY HEX: A005
+CONSTANT: AL_VENDOR HEX: B001
+CONSTANT: AL_VERSION HEX: B002
+CONSTANT: AL_RENDERER HEX: B003
+CONSTANT: AL_EXTENSIONS HEX: B004
+CONSTANT: AL_DOPPLER_FACTOR HEX: C000
+CONSTANT: AL_DOPPLER_VELOCITY HEX: C001
+CONSTANT: AL_SPEED_OF_SOUND HEX: C003
+CONSTANT: AL_DISTANCE_MODEL HEX: D000
+CONSTANT: AL_INVERSE_DISTANCE HEX: D001
+CONSTANT: AL_INVERSE_DISTANCE_CLAMPED HEX: D002
+CONSTANT: AL_LINEAR_DISTANCE HEX: D003
+CONSTANT: AL_LINEAR_DISTANCE_CLAMPED HEX: D004
+CONSTANT: AL_EXPONENT_DISTANCE HEX: D005
+CONSTANT: AL_EXPONENT_DISTANCE_CLAMPED HEX: D006
 
 FUNCTION: void alEnable ( ALenum capability ) ;
 FUNCTION: void alDisable ( ALenum capability ) ; 
@@ -182,34 +182,34 @@ FUNCTION: void alDistanceModel ( ALenum distanceModel ) ;
 
 LIBRARY: alut
 
-: ALUT_API_MAJOR_VERSION ( -- number ) 1 ; inline
-: ALUT_API_MINOR_VERSION ( -- number ) 1 ; inline
-: ALUT_ERROR_NO_ERROR ( -- number ) 0 ; inline
-: ALUT_ERROR_OUT_OF_MEMORY ( -- number ) HEX: 200 ; inline
-: ALUT_ERROR_INVALID_ENUM ( -- number ) HEX: 201 ; inline
-: ALUT_ERROR_INVALID_VALUE ( -- number ) HEX: 202 ; inline
-: ALUT_ERROR_INVALID_OPERATION ( -- number ) HEX: 203 ; inline
-: ALUT_ERROR_NO_CURRENT_CONTEXT ( -- number ) HEX: 204 ; inline
-: ALUT_ERROR_AL_ERROR_ON_ENTRY ( -- number ) HEX: 205 ; inline
-: ALUT_ERROR_ALC_ERROR_ON_ENTRY ( -- number ) HEX: 206 ; inline
-: ALUT_ERROR_OPEN_DEVICE ( -- number ) HEX: 207 ; inline
-: ALUT_ERROR_CLOSE_DEVICE ( -- number ) HEX: 208 ; inline
-: ALUT_ERROR_CREATE_CONTEXT ( -- number ) HEX: 209 ; inline
-: ALUT_ERROR_MAKE_CONTEXT_CURRENT ( -- number ) HEX: 20A ; inline
-: ALUT_ERROR_DESTRY_CONTEXT ( -- number ) HEX: 20B ; inline
-: ALUT_ERROR_GEN_BUFFERS ( -- number ) HEX: 20C ; inline
-: ALUT_ERROR_BUFFER_DATA ( -- number ) HEX: 20D ; inline
-: ALUT_ERROR_IO_ERROR ( -- number ) HEX: 20E ; inline
-: ALUT_ERROR_UNSUPPORTED_FILE_TYPE ( -- number ) HEX: 20F ; inline
-: ALUT_ERROR_UNSUPPORTED_FILE_SUBTYPE ( -- number ) HEX: 210 ; inline
-: ALUT_ERROR_CORRUPT_OR_TRUNCATED_DATA ( -- number ) HEX: 211 ; inline
-: ALUT_WAVEFORM_SINE ( -- number ) HEX: 100 ; inline
-: ALUT_WAVEFORM_SQUARE ( -- number ) HEX: 101 ; inline
-: ALUT_WAVEFORM_SAWTOOTH ( -- number ) HEX: 102 ; inline
-: ALUT_WAVEFORM_WHITENOISE ( -- number ) HEX: 103 ; inline
-: ALUT_WAVEFORM_IMPULSE ( -- number ) HEX: 104 ; inline
-: ALUT_LOADER_BUFFER ( -- number ) HEX: 300 ; inline
-: ALUT_LOADER_MEMORY ( -- number ) HEX: 301 ; inline
+CONSTANT: ALUT_API_MAJOR_VERSION 1
+CONSTANT: ALUT_API_MINOR_VERSION 1
+CONSTANT: ALUT_ERROR_NO_ERROR 0
+CONSTANT: ALUT_ERROR_OUT_OF_MEMORY HEX: 200
+CONSTANT: ALUT_ERROR_INVALID_ENUM HEX: 201
+CONSTANT: ALUT_ERROR_INVALID_VALUE HEX: 202
+CONSTANT: ALUT_ERROR_INVALID_OPERATION HEX: 203
+CONSTANT: ALUT_ERROR_NO_CURRENT_CONTEXT HEX: 204
+CONSTANT: ALUT_ERROR_AL_ERROR_ON_ENTRY HEX: 205
+CONSTANT: ALUT_ERROR_ALC_ERROR_ON_ENTRY HEX: 206
+CONSTANT: ALUT_ERROR_OPEN_DEVICE HEX: 207
+CONSTANT: ALUT_ERROR_CLOSE_DEVICE HEX: 208
+CONSTANT: ALUT_ERROR_CREATE_CONTEXT HEX: 209
+CONSTANT: ALUT_ERROR_MAKE_CONTEXT_CURRENT HEX: 20A
+CONSTANT: ALUT_ERROR_DESTRY_CONTEXT HEX: 20B
+CONSTANT: ALUT_ERROR_GEN_BUFFERS HEX: 20C
+CONSTANT: ALUT_ERROR_BUFFER_DATA HEX: 20D
+CONSTANT: ALUT_ERROR_IO_ERROR HEX: 20E
+CONSTANT: ALUT_ERROR_UNSUPPORTED_FILE_TYPE HEX: 20F
+CONSTANT: ALUT_ERROR_UNSUPPORTED_FILE_SUBTYPE HEX: 210
+CONSTANT: ALUT_ERROR_CORRUPT_OR_TRUNCATED_DATA HEX: 211
+CONSTANT: ALUT_WAVEFORM_SINE HEX: 100
+CONSTANT: ALUT_WAVEFORM_SQUARE HEX: 101
+CONSTANT: ALUT_WAVEFORM_SAWTOOTH HEX: 102
+CONSTANT: ALUT_WAVEFORM_WHITENOISE HEX: 103
+CONSTANT: ALUT_WAVEFORM_IMPULSE HEX: 104
+CONSTANT: ALUT_LOADER_BUFFER HEX: 300
+CONSTANT: ALUT_LOADER_MEMORY HEX: 301
 
 FUNCTION: ALboolean alutInit ( int* argcp, char** argv ) ;
 FUNCTION: ALboolean alutInitWithoutContext ( int* argcp, char** argv ) ;
@@ -234,37 +234,37 @@ FUNCTION: void alutUnloadWAV ( ALenum format, void* data, ALsizei size, ALsizei
 SYMBOL: init
 
 : init-openal ( -- )
-  init get-global expired? [
-    f f alutInit 0 = [ "Could not initialize OpenAL" throw ] when
-    1337 <alien> init set-global
-  ] when ;
+    init get-global expired? [
+        f f alutInit 0 = [ "Could not initialize OpenAL" throw ] when
+        1337 <alien> init set-global
+    ] when ;
 
 : exit-openal ( -- )
-  init get-global expired? [
-    alutExit 0 = [ "Could not close OpenAL" throw ] when
-    f init set-global
-  ] unless ;
+    init get-global expired? [
+        alutExit 0 = [ "Could not close OpenAL" throw ] when
+        f init set-global
+    ] unless ;
 
 : <uint-array> ( n -- byte-array ) "ALuint" <c-array> ;
 
 : gen-sources ( size -- seq )
-  dup <uint-array> 2dup underlying>> alGenSources swap ;
+    dup <uint-array> 2dup underlying>> alGenSources swap ;
 
 : gen-buffers ( size -- seq )
-  dup <uint-array> 2dup underlying>> alGenBuffers swap ;
+    dup <uint-array> 2dup underlying>> alGenBuffers swap ;
 
 : gen-buffer ( -- buffer ) 1 gen-buffers first ;
 
 : create-buffer-from-file ( filename -- buffer )
-  alutCreateBufferFromFile dup AL_NONE = [
-    "create-buffer-from-file failed" throw
-  ] when ;
+    alutCreateBufferFromFile dup AL_NONE = [
+        "create-buffer-from-file failed" throw
+    ] when ;
 
 os macosx? "openal.macosx" "openal.other" ? require
 
 : create-buffer-from-wav ( filename -- buffer )
-  gen-buffer dup rot load-wav-file
-  [ alBufferData ] 4keep alutUnloadWAV ;
+    gen-buffer dup rot load-wav-file
+    [ alBufferData ] 4keep alutUnloadWAV ;
 
 : queue-buffers ( source buffers -- )
     [ length ] [ >uint-array underlying>> ] bi alSourceQueueBuffers ;
@@ -273,29 +273,27 @@ os macosx? "openal.macosx" "openal.other" ? require
     1array queue-buffers ;
 
 : set-source-param ( source param value -- )
-  alSourcei ;
+    alSourcei ;
 
 : get-source-param ( source param -- value )
-  0 <uint> dup >r alGetSourcei r> *uint ;
+    0 <uint> dup [ alGetSourcei ] dip *uint ;
 
 : set-buffer-param ( source param value -- )
-  alBufferi ;
+    alBufferi ;
 
 : get-buffer-param ( source param -- value )
-  0 <uint> dup >r alGetBufferi r> *uint ;
+    0 <uint> dup [ alGetBufferi ] dip *uint ;
 
-: source-play ( source -- )
-  alSourcePlay ;
+: source-play ( source -- ) alSourcePlay ;
 
-: source-stop ( source -- )
-  alSourceStop ;
+: source-stop ( source -- ) alSourceStop ;
 
 : check-error ( -- )
-  alGetError dup ALUT_ERROR_NO_ERROR = [
-    drop
-  ] [
-    alGetString throw
-  ] if ;
+    alGetError dup ALUT_ERROR_NO_ERROR = [
+        drop
+    ] [
+        alGetString throw
+    ] if ;
 
 : source-playing? ( source -- bool )
-  AL_SOURCE_STATE get-source-param AL_PLAYING = ;
+    AL_SOURCE_STATE get-source-param AL_PLAYING = ;

From 5f39a714be67c05b9f8a86c64d4a4616af676fe3 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 00:59:50 -0600
Subject: [PATCH 18/41] add some constants to unix

---
 basis/unix/unix.factor | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor
index 76613934af..a6a0147504 100644
--- a/basis/unix/unix.factor
+++ b/basis/unix/unix.factor
@@ -17,6 +17,10 @@ CONSTANT: MAP_FILE    0
 CONSTANT: MAP_SHARED  1
 CONSTANT: MAP_PRIVATE 2
 
+CONSTANT: SEEK_SET 0
+CONSTANT: SEEK_CUR 1
+CONSTANT: SEEK_END 2
+
 : MAP_FAILED ( -- alien ) -1 <alien> ; inline
 
 CONSTANT: NGROUPS_MAX 16

From f6f716c4e3a6e6457c9eecfb9e3ab418f5463af4 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 01:03:12 -0600
Subject: [PATCH 19/41] unix support for stream seeking

---
 basis/io/backend/unix/unix.factor  | 3 +++
 basis/io/buffers/buffers.factor    | 3 +++
 basis/io/ports/ports.factor        | 8 +++++++-
 core/io/encodings/encodings.factor | 2 ++
 core/io/io.factor                  | 5 ++++-
 5 files changed, 19 insertions(+), 2 deletions(-)

diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor
index d86a72c665..7340260b2e 100644
--- a/basis/io/backend/unix/unix.factor
+++ b/basis/io/backend/unix/unix.factor
@@ -46,6 +46,9 @@ M: fd cancel-operation ( fd -- )
         2bi
     ] if ;
 
+M: unix (stream-seek)
+    handle>> fd>> swap SEEK_SET lseek io-error ;
+
 SYMBOL: +retry+ ! just try the operation again without blocking
 SYMBOL: +input+
 SYMBOL: +output+
diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor
index 4df081b17d..11fbbf947c 100644
--- a/basis/io/buffers/buffers.factor
+++ b/basis/io/buffers/buffers.factor
@@ -27,6 +27,9 @@ M: buffer dispose* ptr>> free ;
 : buffer-empty? ( buffer -- ? )
     fill>> zero? ; inline
 
+: buffer-seek ( n buffer -- )
+    (>>pos) ; inline
+
 : buffer-consume ( n buffer -- )
     [ + ] change-pos
     dup [ pos>> ] [ fill>> ] bi <
diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 1fe717d5ee..dd95e37d72 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -4,7 +4,7 @@ USING: math kernel io sequences io.buffers io.timeouts generic
 byte-vectors system io.encodings math.order io.backend
 continuations classes byte-arrays namespaces splitting
 grouping dlists assocs io.encodings.binary summary accessors
-destructors combinators ;
+destructors combinators unix ;
 IN: io.ports
 
 SYMBOL: default-buffer-size
@@ -93,6 +93,12 @@ M: input-port stream-read-until ( seps port -- str/f sep/f )
         ] [ [ 2drop ] 2dip ] if
     ] if ;
 
+HOOK: (stream-seek) os ( n stream -- )
+
+M: input-port stream-seek ( n stream -- )
+    dup check-disposed
+    2dup buffer>> buffer-seek (stream-seek) ;
+
 TUPLE: output-port < buffered-port ;
 
 : <output-port> ( handle -- output-port )
diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor
index 94d2115478..4693c672a4 100644
--- a/core/io/encodings/encodings.factor
+++ b/core/io/encodings/encodings.factor
@@ -50,6 +50,8 @@ M: object <decoder> f decoder boa ;
 M: decoder stream-read1
     dup >decoder< decode-char fix-read1 ;
 
+M: decoder stream-seek stream>> stream-seek ;
+
 : fix-read ( stream string -- string )
     over cr>> [
         over cr-
diff --git a/core/io/io.factor b/core/io/io.factor
index 55cc336ef8..9b606194e0 100644
--- a/core/io/io.factor
+++ b/core/io/io.factor
@@ -15,6 +15,8 @@ GENERIC: stream-write ( seq stream -- )
 GENERIC: stream-flush ( stream -- )
 GENERIC: stream-nl ( stream -- )
 
+GENERIC: stream-seek ( n stream -- )
+
 : stream-print ( str stream -- ) [ stream-write ] keep stream-nl ;
 
 ! Default streams
@@ -27,6 +29,7 @@ SYMBOL: error-stream
 : read ( n -- seq ) input-stream get stream-read ;
 : read-until ( seps -- seq sep/f ) input-stream get stream-read-until ;
 : read-partial ( n -- seq ) input-stream get stream-read-partial ;
+: seek ( n -- ) input-stream get stream-seek ;
 
 : write1 ( elt -- ) output-stream get stream-write1 ;
 : write ( seq -- ) output-stream get stream-write ;
@@ -82,4 +85,4 @@ PRIVATE>
 
 : stream-copy ( in out -- )
     [ [ [ write ] each-block ] with-output-stream ]
-    curry with-input-stream ;
\ No newline at end of file
+    curry with-input-stream ;

From 790f3b867c7642505a91284fd854da6563ff40d7 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 01:12:03 -0600
Subject: [PATCH 20/41] remove bogus unix depenedency, implement seeking on
 windows

---
 basis/io/backend/windows/nt/nt.factor | 2 ++
 basis/io/ports/ports.factor           | 2 +-
 2 files changed, 3 insertions(+), 1 deletion(-)

diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor
index c6b24a0a11..52ab06e753 100755
--- a/basis/io/backend/windows/nt/nt.factor
+++ b/basis/io/backend/windows/nt/nt.factor
@@ -82,6 +82,8 @@ M: winnt init-io ( -- )
     H{ } clone pending-overlapped set-global
     windows.winsock:init-winsock ;
 
+M: winnt (stream-seek) ( n stream -- ) 2drop ;
+
 : file-error? ( n -- eof? )
     zero? [
         GetLastError {
diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index dd95e37d72..0f2dcc6e21 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -4,7 +4,7 @@ USING: math kernel io sequences io.buffers io.timeouts generic
 byte-vectors system io.encodings math.order io.backend
 continuations classes byte-arrays namespaces splitting
 grouping dlists assocs io.encodings.binary summary accessors
-destructors combinators unix ;
+destructors combinators ;
 IN: io.ports
 
 SYMBOL: default-buffer-size

From ec7356446f275353781b80b31f6235d39d4756df Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 08:59:50 -0600
Subject: [PATCH 21/41] read ifds for tiff files

---
 extra/graphics/tiff/tiff.factor | 35 ++++++++++++++++++++++++++++++++-
 1 file changed, 34 insertions(+), 1 deletion(-)

diff --git a/extra/graphics/tiff/tiff.factor b/extra/graphics/tiff/tiff.factor
index 4676ea2748..34f6c3e4e0 100755
--- a/extra/graphics/tiff/tiff.factor
+++ b/extra/graphics/tiff/tiff.factor
@@ -1,15 +1,28 @@
 ! 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 ;
+kernel pack endian tools.hexdump constructors sequences arrays
+sorting.slots math.order ;
 IN: graphics.tiff
 
 TUPLE: tiff
 endianness
 the-answer
 ifd-offset
+ifds
 ;
 
+CONSTRUCTOR: tiff ( -- tiff )
+    V{ } clone >>ifds ;
+
+TUPLE: ifd count ifd-entries ;
+
+CONSTRUCTOR: ifd ( count ifd-entries -- ifd ) ;
+
+TUPLE: ifd-entry tag type count offset ;
+
+CONSTRUCTOR: ifd-entry ( tag type count offset -- ifd-entry ) ;
+
 
 ERROR: bad-tiff-magic bytes ;
 
@@ -20,6 +33,9 @@ ERROR: bad-tiff-magic bytes ;
         [ bad-tiff-magic ]
     } case ;
 
+: with-tiff-endianness ( tiff quot -- tiff )
+    [ dup endianness>> ] dip with-endianness ; inline
+
 : read-header ( tiff -- tiff )
     2 read tiff-endianness [ >>endianness ] keep
     [
@@ -27,10 +43,27 @@ ERROR: bad-tiff-magic bytes ;
         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> <ifd-entry> ;
+
+: read-ifds ( tiff -- tiff )
+    [
+        dup ifd-offset>> seek
+        2 read endian>
+        dup [ read-ifd ] replicate <ifd> >>ifds
+    ] with-tiff-endianness ;
+
 : (load-tiff) ( path -- tiff )
     binary [
         tiff new
         read-header
+        read-ifds
     ] with-file-reader ;
 
 : load-tiff ( path -- tiff )

From 723f08ca615e9d9f52345230a086956080fa14a8 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 09:52:34 -0600
Subject: [PATCH 22/41] fix buffer-seek

---
 basis/io/buffers/buffers.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor
index 11fbbf947c..bfb6c08471 100644
--- a/basis/io/buffers/buffers.factor
+++ b/basis/io/buffers/buffers.factor
@@ -28,7 +28,7 @@ M: buffer dispose* ptr>> free ;
     fill>> zero? ; inline
 
 : buffer-seek ( n buffer -- )
-    (>>pos) ; inline
+    0 >>fill 0 >>pos 2drop ; inline
 
 : buffer-consume ( n buffer -- )
     [ + ] change-pos

From 044fd02b5cf2200acd59cbd8bed098993f4be418 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 10:07:41 -0600
Subject: [PATCH 23/41] more work on tiff -- parse all the relevant ifd-entries

---
 extra/graphics/tiff/tiff.factor | 165 ++++++++++++++++++++++++++++++--
 1 file changed, 159 insertions(+), 6 deletions(-)

diff --git a/extra/graphics/tiff/tiff.factor b/extra/graphics/tiff/tiff.factor
index 34f6c3e4e0..462f75ff79 100755
--- a/extra/graphics/tiff/tiff.factor
+++ b/extra/graphics/tiff/tiff.factor
@@ -2,7 +2,7 @@
 ! 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 ;
+sorting.slots math.order math.parser prettyprint ;
 IN: graphics.tiff
 
 TUPLE: tiff
@@ -10,20 +10,135 @@ endianness
 the-answer
 ifd-offset
 ifds
-;
+processed-ifds ;
 
 CONSTRUCTOR: tiff ( -- tiff )
     V{ } clone >>ifds ;
 
-TUPLE: ifd count ifd-entries ;
+TUPLE: ifd count ifd-entries next ;
 
-CONSTRUCTOR: ifd ( count ifd-entries -- ifd ) ;
+CONSTRUCTOR: ifd ( count ifd-entries next -- ifd ) ;
 
 TUPLE: ifd-entry tag type count offset ;
 
 CONSTRUCTOR: ifd-entry ( tag type count offset -- ifd-entry ) ;
 
 
+TUPLE: photometric-interpretation color ;
+
+CONSTRUCTOR: photometric-interpretation ( color -- object ) ;
+
+SINGLETONS: white-is-zero black-is-zero rgb palette-color ;
+
+ERROR: bad-photometric-interpretation n ;
+
+: lookup-photometric-interpretation ( n -- singleton )
+    {
+        { 0 [ white-is-zero ] }
+        { 1 [ black-is-zero ] }
+        { 2 [ rgb ] }
+        { 3 [ palette-color ] }
+        [ bad-photometric-interpretation ]
+    } case <photometric-interpretation> ;
+
+
+TUPLE: compression method ;
+
+CONSTRUCTOR: compression ( method -- object ) ;
+
+SINGLETONS: no-compression CCITT-2 pack-bits lzw ;
+
+ERROR: bad-compression n ;
+
+: lookup-compression ( n -- compression )
+    {
+        { 1 [ no-compression ] }
+        { 2 [ CCITT-2 ] }
+        { 5 [ lzw ] }
+        { 32773 [ pack-bits ] }
+        [ bad-compression ]
+    } case <compression> ;
+
+TUPLE: image-length n ;
+CONSTRUCTOR: image-length ( n -- object ) ;
+
+TUPLE: image-width n ;
+CONSTRUCTOR: image-width ( n -- object ) ;
+
+TUPLE: x-resolution n ;
+CONSTRUCTOR: x-resolution ( n -- object ) ;
+
+TUPLE: y-resolution n ;
+CONSTRUCTOR: y-resolution ( n -- object ) ;
+
+TUPLE: rows-per-strip n ;
+CONSTRUCTOR: rows-per-strip ( n -- object ) ;
+
+TUPLE: strip-offsets n ;
+CONSTRUCTOR: strip-offsets ( n -- object ) ;
+
+TUPLE: strip-byte-counts n ;
+CONSTRUCTOR: strip-byte-counts ( n -- object ) ;
+
+TUPLE: bits-per-sample n ;
+CONSTRUCTOR: bits-per-sample ( n -- object ) ;
+
+TUPLE: samples-per-pixel n ;
+CONSTRUCTOR: samples-per-pixel ( n -- object ) ;
+
+SINGLETONS: no-resolution-unit
+inch-resolution-unit
+centimeter-resolution-unit ;
+
+TUPLE: resolution-unit type ;
+CONSTRUCTOR: resolution-unit ( type -- object ) ;
+
+ERROR: bad-resolution-unit n ;
+
+: lookup-resolution-unit ( n -- object )
+    {
+        { 1 [ no-resolution-unit ] }
+        { 2 [ inch-resolution-unit ] }
+        { 3 [ centimeter-resolution-unit ] }
+        [ bad-resolution-unit ]
+    } case <resolution-unit> ;
+
+
+TUPLE: predictor type ;
+CONSTRUCTOR: predictor ( type -- object ) ;
+
+SINGLETONS: no-predictor horizontal-differencing-predictor ;
+
+ERROR: bad-predictor n ;
+
+: lookup-predictor ( n -- object )
+    {
+        { 1 [ no-predictor ] }
+        { 2 [ horizontal-differencing-predictor ] }
+        [ bad-predictor ]
+    } case <predictor> ;
+
+
+TUPLE: planar-configuration type ;
+CONSTRUCTOR: planar-configuration ( type -- object ) ;
+
+SINGLETONS: chunky planar ;
+
+ERROR: bad-planar-configuration n ;
+
+: lookup-planar-configuration ( n -- object )
+    {
+        { 1 [ no-predictor ] }
+        { 2 [ horizontal-differencing-predictor ] }
+        [ bad-predictor ]
+    } case <planar-configuration> ;
+
+
+TUPLE: new-subfile-type n ;
+CONSTRUCTOR: new-subfile-type ( n -- object ) ;
+
+
+
 ERROR: bad-tiff-magic bytes ;
 
 : tiff-endianness ( byte-array -- ? )
@@ -56,14 +171,52 @@ ERROR: bad-tiff-magic bytes ;
     [
         dup ifd-offset>> seek
         2 read endian>
-        dup [ read-ifd ] replicate <ifd> >>ifds
+        dup [ read-ifd ] replicate
+        4 read endian>
+        [ <ifd> push-ifd ] [ 0 = [ read-ifds ] unless ] bi
     ] with-tiff-endianness ;
 
+! ERROR: unhandled-ifd-entry data n ;
+
+: unhandled-ifd-entry ;
+
+: ifd-entry-value ( ifd-entry -- n )
+    dup count>> 1 = [
+        offset>>
+    ] [
+        [ offset>> seek ] [ count>> read ] bi
+    ] if ;
+
+: process-ifd-entry ( ifd-entry -- object )
+    [ ifd-entry-value ] [ tag>> ] bi {
+        { 254 [ <new-subfile-type> ] }
+        { 256 [ <image-width> ] }
+        { 257 [ <image-length> ] }
+        { 258 [ <bits-per-sample> ] }
+        { 259 [ lookup-compression ] }
+        { 262 [ lookup-photometric-interpretation ] }
+        { 273 [ <strip-offsets> ] }
+        { 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 ] }
+        { 317 [ lookup-predictor ] }
+        [ unhandled-ifd-entry swap 2array ]
+    } case ;
+
+: process-ifd ( ifd -- processed-ifd )
+    ifd-entries>> [ process-ifd-entry ] map ;
+
 : (load-tiff) ( path -- tiff )
     binary [
-        tiff new
+        <tiff>
         read-header
         read-ifds
+        dup ifds>> [ process-ifd ] map
+        >>processed-ifds
     ] with-file-reader ;
 
 : load-tiff ( path -- tiff )

From bc0521f88a52b7cef23ed77b75d165107ee36449 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 10:30:51 -0600
Subject: [PATCH 24/41] make seeking support the full lseek options, add
 seeking on output ports, remove seeking from decoders..

---
 basis/io/backend/unix/unix.factor  |  9 +++++++--
 basis/io/ports/ports.factor        | 13 +++++++------
 core/io/encodings/encodings.factor |  2 --
 core/io/io.factor                  |  6 ++++--
 4 files changed, 18 insertions(+), 12 deletions(-)

diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor
index 7340260b2e..e39ae3e7f8 100644
--- a/basis/io/backend/unix/unix.factor
+++ b/basis/io/backend/unix/unix.factor
@@ -46,8 +46,13 @@ M: fd cancel-operation ( fd -- )
         2bi
     ] if ;
 
-M: unix (stream-seek)
-    handle>> fd>> swap SEEK_SET lseek io-error ;
+M: unix (stream-seek) ( n seek-type stream -- )
+    swap {
+        { io:seek-absolute [ SEEK_SET ] }
+        { io:seek-relative [ SEEK_CUR ] }
+        { io:seek-end [ SEEK_END ] }
+    } case
+    [ handle>> fd>> swap ] dip lseek io-error ;
 
 SYMBOL: +retry+ ! just try the operation again without blocking
 SYMBOL: +input+
diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 0f2dcc6e21..4b0336ed26 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -93,12 +93,6 @@ M: input-port stream-read-until ( seps port -- str/f sep/f )
         ] [ [ 2drop ] 2dip ] if
     ] if ;
 
-HOOK: (stream-seek) os ( n stream -- )
-
-M: input-port stream-seek ( n stream -- )
-    dup check-disposed
-    2dup buffer>> buffer-seek (stream-seek) ;
-
 TUPLE: output-port < buffered-port ;
 
 : <output-port> ( handle -- output-port )
@@ -126,6 +120,13 @@ M: output-port stream-write
 
 HOOK: (wait-to-write) io-backend ( port -- )
 
+HOOK: (stream-seek) os ( n seek-type stream -- )
+
+M: port stream-seek ( n seek-type stream -- )
+    dup check-disposed
+    [ nip buffer>> buffer-seek ] [ (stream-seek) ] 3bi ;
+
+
 GENERIC: shutdown ( handle -- )
 
 M: object shutdown drop ;
diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor
index 4693c672a4..94d2115478 100644
--- a/core/io/encodings/encodings.factor
+++ b/core/io/encodings/encodings.factor
@@ -50,8 +50,6 @@ M: object <decoder> f decoder boa ;
 M: decoder stream-read1
     dup >decoder< decode-char fix-read1 ;
 
-M: decoder stream-seek stream>> stream-seek ;
-
 : fix-read ( stream string -- string )
     over cr>> [
         over cr-
diff --git a/core/io/io.factor b/core/io/io.factor
index 9b606194e0..1cfdaf526e 100644
--- a/core/io/io.factor
+++ b/core/io/io.factor
@@ -15,7 +15,8 @@ GENERIC: stream-write ( seq stream -- )
 GENERIC: stream-flush ( stream -- )
 GENERIC: stream-nl ( stream -- )
 
-GENERIC: stream-seek ( n stream -- )
+SINGLETONS: seek-absolute seek-relative seek-end ;
+GENERIC: stream-seek ( n seek-type stream -- )
 
 : stream-print ( str stream -- ) [ stream-write ] keep stream-nl ;
 
@@ -29,7 +30,8 @@ SYMBOL: error-stream
 : read ( n -- seq ) input-stream get stream-read ;
 : read-until ( seps -- seq sep/f ) input-stream get stream-read-until ;
 : read-partial ( n -- seq ) input-stream get stream-read-partial ;
-: seek ( n -- ) input-stream get stream-seek ;
+: seek-input ( n seek-type -- ) input-stream get stream-seek ;
+: seek-output ( n seek-type -- ) output-stream get stream-seek ;
 
 : write1 ( elt -- ) output-stream get stream-write1 ;
 : write ( seq -- ) output-stream get stream-write ;

From 44a4c20f230920da2b6b6b6fe45535b6dd476d2d Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 11:00:16 -0600
Subject: [PATCH 25/41] update stream seeking on windows for new api

---
 basis/io/backend/windows/nt/nt.factor  | 12 +++++++++++-
 basis/io/buffers/buffers.factor        |  6 +++---
 basis/io/ports/ports.factor            |  2 +-
 basis/windows/kernel32/kernel32.factor |  2 +-
 4 files changed, 16 insertions(+), 6 deletions(-)

diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor
index 52ab06e753..7479c0a0bb 100755
--- a/basis/io/backend/windows/nt/nt.factor
+++ b/basis/io/backend/windows/nt/nt.factor
@@ -82,7 +82,17 @@ M: winnt init-io ( -- )
     H{ } clone pending-overlapped set-global
     windows.winsock:init-winsock ;
 
-M: winnt (stream-seek) ( n stream -- ) 2drop ;
+ERROR: invalid-file-size n ;
+
+: handle>file-size ( handle -- n )
+    0 <ulonglong> [ GetFileSizeEx win32-error=0/f ] keep *ulonglong ;
+
+M: winnt (stream-seek) ( n seek-type stream -- )
+    swap {
+        { seek-absolute [ handle>> (>>ptr) ] }
+        { seek-relative [ handle>> [ + ] change-ptr drop ] }
+        { seek-end [ handle>> [ handle>> handle>file-size + ] keep (>>ptr) ] }
+    } case ;
 
 : file-error? ( n -- eof? )
     zero? [
diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor
index bfb6c08471..a647f27dfc 100644
--- a/basis/io/buffers/buffers.factor
+++ b/basis/io/buffers/buffers.factor
@@ -21,15 +21,15 @@ M: buffer dispose* ptr>> free ;
 : buffer-reset ( n buffer -- )
     swap >>fill 0 >>pos drop ;
 
+: buffer-reset-hard ( buffer -- )
+    0 >>fill 0 >>pos drop ;
+
 : buffer-capacity ( buffer -- n )
     [ size>> ] [ fill>> ] bi - ; inline
 
 : buffer-empty? ( buffer -- ? )
     fill>> zero? ; inline
 
-: buffer-seek ( n buffer -- )
-    0 >>fill 0 >>pos 2drop ; inline
-
 : buffer-consume ( n buffer -- )
     [ + ] change-pos
     dup [ pos>> ] [ fill>> ] bi <
diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 4b0336ed26..1f7fc5f115 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -124,7 +124,7 @@ HOOK: (stream-seek) os ( n seek-type stream -- )
 
 M: port stream-seek ( n seek-type stream -- )
     dup check-disposed
-    [ nip buffer>> buffer-seek ] [ (stream-seek) ] 3bi ;
+    [ buffer>> buffer-reset-hard 2drop ] [ (stream-seek) ] 3bi ;
 
 
 GENERIC: shutdown ( handle -- )
diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor
index d3e823f844..3494e83e83 100755
--- a/basis/windows/kernel32/kernel32.factor
+++ b/basis/windows/kernel32/kernel32.factor
@@ -1235,7 +1235,7 @@ ALIAS: GetFileAttributesEx GetFileAttributesExW
 
 FUNCTION: BOOL GetFileInformationByHandle ( HANDLE hFile, LPBY_HANDLE_FILE_INFORMATION lpFileInformation ) ;
 FUNCTION: DWORD GetFileSize ( HANDLE hFile, LPDWORD lpFileSizeHigh ) ;
-! FUNCTION: GetFileSizeEx
+FUNCTION: BOOL GetFileSizeEx ( HANDLE hFile, PLARGE_INTEGER lpFileSize ) ;
 FUNCTION: BOOL GetFileTime ( HANDLE hFile, LPFILETIME lpCreationTime, LPFILETIME lpLastAccessTime, LPFILETIME lpLastWriteTime ) ;
 FUNCTION: DWORD GetFileType ( HANDLE hFile ) ;
 ! FUNCTION: GetFirmwareEnvironmentVariableA

From 2820b9fc9981c9c6aef47844b858ae7b1e8a7ab9 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 11:23:00 -0600
Subject: [PATCH 26/41] better error handling on unix seek, unit tests

---
 core/io/io-tests.factor | 65 ++++++++++++++++++++++++++++++++++++++++-
 core/io/io.factor       |  1 +
 2 files changed, 65 insertions(+), 1 deletion(-)

diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor
index 009ba3a9e7..8bfc52432d 100644
--- a/core/io/io-tests.factor
+++ b/core/io/io-tests.factor
@@ -1,6 +1,6 @@
 USING: arrays io io.files kernel math parser strings system
 tools.test words namespaces make io.encodings.8-bit
-io.encodings.binary sequences ;
+io.encodings.binary sequences io.files.unique ;
 IN: io.tests
 
 [ f ] [
@@ -10,3 +10,66 @@ IN: io.tests
 
 ! Make sure we use correct to_c_string form when writing
 [ ] [ "\0" write ] unit-test
+
+[ B{ 3 2 3 4 5 } ]
+[
+    "seek-test1" unique-file binary
+    [
+        [
+            B{ 1 2 3 4 5 } write flush 0 seek-absolute seek-output
+            B{ 3 } write
+        ] with-file-writer
+    ] [
+        file-contents
+    ] 2bi
+] unit-test
+
+[ B{ 1 2 3 4 3 } ]
+[
+    "seek-test2" unique-file binary
+    [
+        [
+            B{ 1 2 3 4 5 } write flush -1 seek-relative seek-output
+            B{ 3 } write
+        ] with-file-writer
+    ] [
+        file-contents
+    ] 2bi
+] unit-test
+
+[ B{ 1 2 3 4 5 0 3 } ]
+[
+    "seek-test3" unique-file binary
+    [
+        [
+            B{ 1 2 3 4 5 } write flush 1 seek-relative seek-output
+            B{ 3 } write
+        ] with-file-writer
+    ] [
+        file-contents
+    ] 2bi
+] unit-test
+
+[ B{ 3 } ]
+[
+    B{ 1 2 3 4 5 } "seek-test4" unique-file binary [
+        set-file-contents
+    ] [
+        [
+            -3 seek-end seek-input 1 read
+        ] with-file-reader
+    ] 2bi
+] unit-test
+
+[ B{ 2 } ]
+[
+    B{ 1 2 3 4 5 } "seek-test5" unique-file binary [
+        set-file-contents
+    ] [
+        [
+            3 seek-absolute seek-input
+            -2 seek-relative seek-input
+            1 read
+        ] with-file-reader
+    ] 2bi
+] unit-test
diff --git a/core/io/io.factor b/core/io/io.factor
index 1cfdaf526e..11a2a6d1a8 100644
--- a/core/io/io.factor
+++ b/core/io/io.factor
@@ -15,6 +15,7 @@ GENERIC: stream-write ( seq stream -- )
 GENERIC: stream-flush ( stream -- )
 GENERIC: stream-nl ( stream -- )
 
+ERROR: bad-seek-type type ;
 SINGLETONS: seek-absolute seek-relative seek-end ;
 GENERIC: stream-seek ( n seek-type stream -- )
 

From 959ef7a7374de067b21ccfe4d403082641008811 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 11:24:12 -0600
Subject: [PATCH 27/41] better error handling for backends

---
 basis/io/backend/unix/unix.factor     | 1 +
 basis/io/backend/windows/nt/nt.factor | 1 +
 2 files changed, 2 insertions(+)

diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor
index e39ae3e7f8..3372f15cd9 100644
--- a/basis/io/backend/unix/unix.factor
+++ b/basis/io/backend/unix/unix.factor
@@ -51,6 +51,7 @@ M: unix (stream-seek) ( n seek-type stream -- )
         { io:seek-absolute [ SEEK_SET ] }
         { io:seek-relative [ SEEK_CUR ] }
         { io:seek-end [ SEEK_END ] }
+        [ io:bad-seek-type ]
     } case
     [ handle>> fd>> swap ] dip lseek io-error ;
 
diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor
index 7479c0a0bb..7b96e883dd 100755
--- a/basis/io/backend/windows/nt/nt.factor
+++ b/basis/io/backend/windows/nt/nt.factor
@@ -92,6 +92,7 @@ M: winnt (stream-seek) ( n seek-type stream -- )
         { seek-absolute [ handle>> (>>ptr) ] }
         { seek-relative [ handle>> [ + ] change-ptr drop ] }
         { seek-end [ handle>> [ handle>> handle>file-size + ] keep (>>ptr) ] }
+        [ bad-seek-type ]
     } case ;
 
 : file-error? ( n -- eof? )

From f499cab2fbc94ce34a98ec0b1de3aacf7acfb1c3 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 11:35:13 -0600
Subject: [PATCH 28/41] seek -> new seeking

---
 extra/graphics/tiff/tiff.factor | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/extra/graphics/tiff/tiff.factor b/extra/graphics/tiff/tiff.factor
index 462f75ff79..5c1fd4ec65 100755
--- a/extra/graphics/tiff/tiff.factor
+++ b/extra/graphics/tiff/tiff.factor
@@ -169,7 +169,7 @@ ERROR: bad-tiff-magic bytes ;
 
 : read-ifds ( tiff -- tiff )
     [
-        dup ifd-offset>> seek
+        dup ifd-offset>> seek-input
         2 read endian>
         dup [ read-ifd ] replicate
         4 read endian>
@@ -184,7 +184,7 @@ ERROR: bad-tiff-magic bytes ;
     dup count>> 1 = [
         offset>>
     ] [
-        [ offset>> seek ] [ count>> read ] bi
+        [ offset>> seek-input ] [ count>> read ] bi
     ] if ;
 
 : process-ifd-entry ( ifd-entry -- object )

From 8097b52b12656b0ddd34a4e7b75947742d905acd Mon Sep 17 00:00:00 2001
From: Philipp Bruschweiler <blei42@gmail.com>
Date: Sun, 8 Feb 2009 01:03:35 +0100
Subject: [PATCH 29/41] initial infix vocab

---
 extra/infix/ast/ast.factor                   |   8 +
 extra/infix/infix-docs.factor                |  38 ++++
 extra/infix/infix-tests.factor               |  45 +++++
 extra/infix/infix.factor                     |  99 +++++++++++
 extra/infix/parser/parser-tests.factor       | 175 +++++++++++++++++++
 extra/infix/parser/parser.factor             |  30 ++++
 extra/infix/tokenizer/tokenizer-tests.factor |  20 +++
 extra/infix/tokenizer/tokenizer.factor       |  21 +++
 8 files changed, 436 insertions(+)
 create mode 100644 extra/infix/ast/ast.factor
 create mode 100644 extra/infix/infix-docs.factor
 create mode 100644 extra/infix/infix-tests.factor
 create mode 100644 extra/infix/infix.factor
 create mode 100644 extra/infix/parser/parser-tests.factor
 create mode 100644 extra/infix/parser/parser.factor
 create mode 100644 extra/infix/tokenizer/tokenizer-tests.factor
 create mode 100644 extra/infix/tokenizer/tokenizer.factor

diff --git a/extra/infix/ast/ast.factor b/extra/infix/ast/ast.factor
new file mode 100644
index 0000000000..0bc22feeb7
--- /dev/null
+++ b/extra/infix/ast/ast.factor
@@ -0,0 +1,8 @@
+IN: infix.ast
+
+TUPLE: ast-number value ;
+TUPLE: ast-local name ;
+TUPLE: ast-array name index ;
+TUPLE: ast-function name arguments ;
+TUPLE: ast-op left right op ;
+TUPLE: ast-negation term ;
diff --git a/extra/infix/infix-docs.factor b/extra/infix/infix-docs.factor
new file mode 100644
index 0000000000..7a4febb514
--- /dev/null
+++ b/extra/infix/infix-docs.factor
@@ -0,0 +1,38 @@
+USING: help.syntax help.markup prettyprint locals ;
+IN: infix
+
+HELP: [infix
+{ $syntax "[infix ... infix]" }
+{ $description "Parses the infix code inside the brackets, converts it to stack code and executes it." }
+{ $examples
+    { $example
+        "USING: infix prettyprint ;"
+        "IN: scratchpad"
+        "[infix 8+2*3 infix] ."
+        "14"
+    } $nl
+    { $link POSTPONE: [infix } " isn't that useful by itself, as it can only access literal numbers and no variables. It is designed to be used together with locals; for example with " { $link POSTPONE: :: } " :"
+    { $example
+        "USING: infix locals math.functions prettyprint ;"
+        "IN: scratchpad"
+        ":: quadratic-equation ( a b c -- z- z+ )"
+        "    [infix (-b-sqrt(b*b-4*a*c)) / (2*a) infix]"
+        "    [infix (-b+sqrt(b*b-4*a*c)) / (2*a) infix] ;"
+        "1 0 -1 quadratic-equation . ."
+        "1.0\n-1.0"
+    }
+} ;
+
+HELP: [infix|
+{ $syntax "[infix| binding1 [ value1... ]\n        binding2 [ value2... ]\n        ... |\n    infix-expression infix]" }
+{ $description "Introduces a set of lexical bindings and evaluates the body as a snippet of infix code. The values are evaluated in parallel, and may not refer to other bindings within the same " { $link POSTPONE: [infix| } " form, as it is based on " { $link POSTPONE: [let } "." }
+{ $examples
+    { $example
+        "USING: infix prettyprint ;"
+        "IN: scratchpad"
+        "[infix| pi [ 3.14 ] r [ 12 ] | r*r*pi infix] ."
+        "452.16"
+    }
+} ;
+
+{ POSTPONE: [infix POSTPONE: [infix| } related-words
diff --git a/extra/infix/infix-tests.factor b/extra/infix/infix-tests.factor
new file mode 100644
index 0000000000..5ee6468131
--- /dev/null
+++ b/extra/infix/infix-tests.factor
@@ -0,0 +1,45 @@
+USING: infix infix.private kernel locals math math.functions
+tools.test ;
+IN: infix.tests
+
+[ 0 ] [ [infix 0 infix] ] unit-test
+[ 0.5 ] [ [infix 3.0/6 infix] ] unit-test
+[ 1+2/3 ] [ [infix 5/3 infix] ] unit-test
+[ 3 ] [ [infix 2*7%3+1 infix] ] unit-test
+[ 1 ] [ [infix 2-
+     1
+     -5*
+     0 infix] ] unit-test
+
+[ 452.16 ] [ [infix| r [ 12 ] pi [ 3.14 ] |
+    r*r*pi infix] ] unit-test
+[ 0 ] [ [infix| a [ 3 ] | 0 infix] ] unit-test
+[ 4/5 ] [ [infix| x [ 3 ] f [ 12 ] | f/(f+x) infix] ] unit-test
+[ 144 ] [ [infix| a [ 0 ] b [ 12 ] | b*b-a infix] ] unit-test
+
+[ 0 ] [ [infix| a [ { 0 1 2 3 } ] | a[0] infix] ] unit-test
+[ 0 ] [ [infix| a [ { 0 1 2 3 } ] | 3*a[0]*2*a[1] infix] ] unit-test
+[ 6 ] [ [infix| a [ { 0 1 2 3 } ] | a[0]+a[10%3]+a[3-1]+a[18/6] infix] ] unit-test
+[ -1 ] [ [infix| a [ { 0 1 2 3 } ] | -a[+1] infix] ] unit-test
+
+[ 0.0 ] [ [infix sin(0) infix] ] unit-test
+[ 10 ] [ [infix lcm(2,5) infix] ] unit-test
+[ 1.0 ] [ [infix +cos(-0*+3) infix] ] unit-test
+
+[ f ] [ 2 \ gcd check-word ] unit-test ! multiple return values
+[ f ] [ 1 \ drop check-word ] unit-test ! no return value
+[ f ] [ 1 \ lcm check-word ] unit-test ! takes 2 args
+: no-stack-effect-declared + ;
+[ 0 \ no-stack-effect-declared check-word ] must-fail
+
+: qux ( -- x ) 2 ;
+[ t ] [ 0 \ qux check-word ] unit-test
+[ 8 ] [ [infix qux()*3+2 infix] ] unit-test
+: foobar ( x -- y ) 1 + ;
+[ t ] [ 1 \ foobar check-word ] unit-test
+[ 4 ] [ [infix foobar(3*5%12) infix] ] unit-test
+: stupid_function ( x x x x x -- y ) + + + + ;
+[ t ] [ 5 \ stupid_function check-word ] unit-test
+[ 10 ] [ [infix stupid_function (0, 1, 2, 3, 4) infix] ] unit-test
+
+[ -1 ] [ [let | a [ 1 ] | [infix -a infix] ] ] unit-test
diff --git a/extra/infix/infix.factor b/extra/infix/infix.factor
new file mode 100644
index 0000000000..31cd1cbe1f
--- /dev/null
+++ b/extra/infix/infix.factor
@@ -0,0 +1,99 @@
+USING: accessors assocs combinators combinators.short-circuit
+effects fry infix.parser infix.ast kernel locals.parser
+locals.types math multiline namespaces parser quotations
+sequences summary words ;
+IN: infix
+
+<PRIVATE
+: prepare-operand ( term -- quot )
+    dup callable? [ 1quotation ] unless ;
+
+ERROR: local-not-defined name ;
+M: local-not-defined summary
+    drop "local is not defined" ;
+
+: at? ( key assoc -- value/key ? )
+    dupd at* [ nip t ] [ drop f ] if ;
+
+: >local-word ( string -- word )
+    locals get at? [ local-not-defined ] unless ;
+
+: select-op ( string -- word )
+    {
+        { "+" [ [ + ] ] }
+        { "-" [ [ - ] ] }
+        { "*" [ [ * ] ] }
+        { "/" [ [ / ] ] }
+        [ drop [ mod ] ]
+    } case ;
+
+GENERIC: infix-codegen ( ast -- quot/number )
+
+M: ast-number infix-codegen value>> ;
+
+M: ast-local infix-codegen
+    name>> >local-word ;
+
+M: ast-array infix-codegen
+    [ index>> infix-codegen prepare-operand ]
+    [ name>> >local-word ] bi '[ @ _ nth ] ;
+
+M: ast-op infix-codegen
+    [ left>> infix-codegen ] [ right>> infix-codegen ]
+    [ op>> select-op ] tri
+    2over [ number? ] both? [ call ] [
+        [ [ prepare-operand ] bi@ ] dip '[ @ @ @ ]
+    ] if ;
+
+M: ast-negation infix-codegen
+    term>> infix-codegen
+    {
+        { [ dup number? ] [ neg ] }
+        { [ dup callable? ] [ '[ @ neg ] ] }
+        [ '[ _ neg ] ] ! local word
+    } cond ;
+
+ERROR: bad-stack-effect word ;
+M: bad-stack-effect summary
+    drop "Words used in infix must declare a stack effect and return exactly one value" ;
+
+: check-word ( argcount word -- ? )
+    dup stack-effect [ ] [ bad-stack-effect ] ?if
+    [ in>> length ] [ out>> length ] bi
+    [ = ] dip 1 = and ;
+
+: find-and-check ( args argcount string -- quot )
+    dup search [ ] [ no-word ] ?if
+    [ nip ] [ check-word ] 2bi
+    [ 1quotation compose ] [ bad-stack-effect ] if ;
+
+: arguments-codegen ( seq -- quot )
+    dup empty? [ drop [ ] ] [
+        [ infix-codegen prepare-operand ]
+        [ compose ] map-reduce
+    ] if ;
+
+M: ast-function infix-codegen
+    [ arguments>> [ arguments-codegen ] [ length ] bi ]
+    [ name>> ] bi find-and-check ;
+
+: [infix-parse ( end -- result/quot )
+    parse-multiline-string build-infix-ast
+    infix-codegen prepare-operand ;
+PRIVATE>
+
+: [infix
+    "infix]" [infix-parse parsed \ call parsed ; parsing
+
+<PRIVATE
+: parse-infix-locals ( assoc end -- quot )
+    [
+        in-lambda? on
+        [ dup [ locals set ] [ push-locals ] bi ] dip
+        [infix-parse prepare-operand swap pop-locals
+    ] with-scope ;
+PRIVATE>
+
+: [infix|
+    "|" parse-bindings "infix]" parse-infix-locals <let>
+    parsed-lambda ; parsing
diff --git a/extra/infix/parser/parser-tests.factor b/extra/infix/parser/parser-tests.factor
new file mode 100644
index 0000000000..0a0288c41b
--- /dev/null
+++ b/extra/infix/parser/parser-tests.factor
@@ -0,0 +1,175 @@
+USING: infix.ast infix.parser infix.tokenizer tools.test ;
+IN: infix.parser.tests
+
+\ parse-infix must-infer
+\ build-infix-ast must-infer
+
+[ T{ ast-number { value 1 } } ] [ "1" build-infix-ast ] unit-test
+[ T{ ast-negation f T{ ast-number { value 1 } } } ]
+[ "-1" build-infix-ast ] unit-test
+[ T{ ast-op
+    { left
+        T{ ast-op
+            { left T{ ast-number { value 1 } } }
+            { right T{ ast-number { value 2 } } }
+            { op "+" }
+        }
+    }
+    { right T{ ast-number { value 4 } } }
+    { op "+" }
+} ] [ "1+2+4" build-infix-ast ] unit-test
+
+[ T{ ast-op
+    { left T{ ast-number { value 1 } } }
+    { right
+        T{ ast-op
+            { left T{ ast-number { value 2 } } }
+            { right T{ ast-number { value 3 } } }
+            { op "*" }
+        }
+    }
+    { op "+" }
+} ] [ "1+2*3" build-infix-ast ] unit-test
+
+[ T{ ast-op 
+    { left T{ ast-number { value 1 } } }
+    { right T{ ast-number { value 2 } } }
+    { op "+" }
+} ] [ "(1+2)" build-infix-ast ] unit-test
+
+[ T{ ast-local { name "foo" } } ] [ "foo" build-infix-ast ] unit-test
+[ "-" build-infix-ast ] must-fail
+
+[ T{ ast-function
+    { name "foo" }
+    { arguments
+        V{
+            T{ ast-op
+                { left T{ ast-number { value 1 } } }
+                { right T{ ast-number { value 2 } } }
+                { op "+" }
+            }
+            T{ ast-op
+                { left T{ ast-number { value 2 } } }
+                { right T{ ast-number { value 3 } } }
+                { op "%" }
+            }
+        }
+    }
+} ] [ "foo (1+ 2,2%3)  " build-infix-ast ] unit-test
+
+[ T{ ast-op
+    { left
+        T{ ast-op
+            { left
+                T{ ast-function
+                    { name "bar" }
+                    { arguments V{ } }
+                }
+            }
+            { right
+                T{ ast-array
+                    { name "baz" }
+                    { index
+                        T{ ast-op
+                            { left
+                                T{ ast-op
+                                    { left
+                                        T{ ast-number
+                                            { value 2 }
+                                        }
+                                    }
+                                    { right
+                                        T{ ast-number
+                                            { value 3 }
+                                        }
+                                    }
+                                    { op "/" }
+                                }
+                            }
+                            { right
+                                T{ ast-number { value 4 } }
+                            }
+                            { op "+" }
+                        }
+                    }
+                }
+            }
+            { op "+" }
+        }
+    }
+    { right T{ ast-number { value 2 } } }
+    { op "/" }
+} ] [ "(bar() + baz[2/ 3+4 ] )/2" build-infix-ast ] unit-test
+
+[ T{ ast-op
+    { left T{ ast-number { value 1 } } }
+    { right
+        T{ ast-op
+            { left T{ ast-number { value 2 } } }
+            { right T{ ast-number { value 3 } } }
+            { op "/" }
+        }
+    }
+    { op "+" }
+} ] [ "1\n+\n2\r/\t3" build-infix-ast ] unit-test
+
+[ T{ ast-negation
+    { term
+        T{ ast-function
+            { name "foo" }
+            { arguments
+                V{
+                    T{ ast-number { value 2 } }
+                    T{ ast-negation
+                        { term T{ ast-number { value 3 } } }
+                    }
+                }
+            }
+        }
+    }
+} ] [ "-foo(+2,-3)" build-infix-ast ] unit-test
+
+[ T{ ast-array
+    { name "arr" }
+    { index
+        T{ ast-op
+            { left
+                T{ ast-negation
+                    { term
+                        T{ ast-op
+                            { left
+                                T{ ast-function
+                                    { name "foo" }
+                                    { arguments
+                                        V{
+                                            T{ ast-number
+                                                { value 2 }
+                                            }
+                                        }
+                                    }
+                                }
+                            }
+                            { right
+                                T{ ast-negation
+                                    { term
+                                        T{ ast-number
+                                            { value 1 }
+                                        }
+                                    }
+                                }
+                            }
+                            { op "+" }
+                        }
+                    }
+                }
+            }
+            { right T{ ast-number { value 3 } } }
+            { op "/" }
+        }
+    }
+} ] [ "+arr[-(foo(2)+-1)/3]" build-infix-ast ] unit-test
+
+[ "foo bar baz" build-infix-ast ] must-fail
+[ "1+2/4+" build-infix-ast ] must-fail
+[ "quaz(2/3,)" build-infix-ast ] must-fail
diff --git a/extra/infix/parser/parser.factor b/extra/infix/parser/parser.factor
new file mode 100644
index 0000000000..beaf3c335d
--- /dev/null
+++ b/extra/infix/parser/parser.factor
@@ -0,0 +1,30 @@
+USING: infix.ast infix.tokenizer kernel math peg.ebnf sequences
+strings vectors ;
+IN: infix.parser
+
+EBNF: parse-infix
+Number      = . ?[ ast-number? ]?
+Identifier  = . ?[ string? ]?
+Array       = Identifier:i "[" Sum:s "]" => [[ i s ast-array boa ]]
+Function    = Identifier:i "(" FunArgs?:a ")" => [[ i a [ V{ } ] unless* ast-function boa ]]
+
+FunArgs     =   FunArgs:a "," Sum:s => [[ s a push a ]]
+              | Sum:s => [[ s 1vector ]]
+
+Terminal    =   ("-"|"+"):op Terminal:term => [[ term op "-" = [ ast-negation boa ] when ]]
+              | "(" Sum:s ")" => [[ s ]]
+              | Number | Array | Function
+              | Identifier => [[ ast-local boa ]]
+
+Product     =   Product:p ("*"|"/"|"%"):op Terminal:term  => [[ p term op ast-op boa ]]
+              | Terminal
+
+Sum         =   Sum:s ("+"|"-"):op Product:p  => [[ s p op ast-op boa ]]
+              | Product
+
+End         = !(.)
+Expression  = Sum End
+;EBNF
+
+: build-infix-ast ( string -- ast )
+    tokenize-infix parse-infix ;
diff --git a/extra/infix/tokenizer/tokenizer-tests.factor b/extra/infix/tokenizer/tokenizer-tests.factor
new file mode 100644
index 0000000000..7e1fb005ef
--- /dev/null
+++ b/extra/infix/tokenizer/tokenizer-tests.factor
@@ -0,0 +1,20 @@
+USING: infix.ast infix.tokenizer tools.test ;
+IN: infix.tokenizer.tests
+
+\ tokenize-infix must-infer
+[ V{ T{ ast-number f 1 } } ] [ "1" tokenize-infix ] unit-test
+[ V{ T{ ast-number f 1.02 } CHAR: * T{ ast-number f 3 } } ] [ "1.02*3" tokenize-infix ] unit-test
+[ V{ T{ ast-number f 3 } CHAR: / CHAR: ( T{ ast-number f 3 } CHAR: + T{ ast-number f 4 } CHAR: ) } ]
+[ "3/(3+4)" tokenize-infix ] unit-test
+[ V{ "foo"  CHAR: ( "x" CHAR: , "y" CHAR: , "z" CHAR: ) } ] [ "foo(x,y,z)" tokenize-infix ] unit-test
+[ V{ "arr"  CHAR: [ "x" CHAR: + T{ ast-number f 3 } CHAR: ] } ]
+[ "arr[x+3]" tokenize-infix ] unit-test
+[ "1.0.4" tokenize-infix ] must-fail
+[ V{ CHAR: + CHAR: ] T{ ast-number f 3.4 } CHAR: , "bar" } ]
+[ "+]3.4,bar" tokenize-infix ] unit-test
+[ V{ "baz_34c" } ] [ "baz_34c" tokenize-infix ] unit-test
+[ V{ T{ ast-number f 34 } "c_baz" } ] [ "34c_baz"  tokenize-infix ] unit-test
+[ V{ CHAR: ( T{ ast-number f 1 } CHAR: + T{ ast-number f 2 } CHAR: ) } ]
+[ "(1+2)" tokenize-infix ] unit-test
+[ V{ T{ ast-number f 1 } CHAR: + T{ ast-number f 2 } CHAR: / T{ ast-number f 3 } } ]
+[ "1\n+\r2\t/ 3" tokenize-infix ] unit-test
diff --git a/extra/infix/tokenizer/tokenizer.factor b/extra/infix/tokenizer/tokenizer.factor
new file mode 100644
index 0000000000..8c1a1b4a18
--- /dev/null
+++ b/extra/infix/tokenizer/tokenizer.factor
@@ -0,0 +1,21 @@
+USING: infix.ast kernel peg peg.ebnf math.parser sequences
+strings ;
+IN: infix.tokenizer
+
+EBNF: tokenize-infix
+Letter            = [a-zA-Z]
+Digit             = [0-9]
+Digits            = Digit+
+Number            =   Digits '.' Digits => [[ concat >string string>number ast-number boa ]]
+                    | Digits => [[ >string string>number ast-number boa ]]
+Space             = " " | "\n" | "\r" | "\t"
+Spaces            = Space* => [[ ignore ]]
+NameFirst         = Letter | "_" => [[ CHAR: _ ]]
+NameRest          = NameFirst | Digit
+Name              = NameFirst NameRest* => [[ first2 swap prefix >string ]]
+Special           =   [+*/%(),] | "-" => [[ CHAR: - ]]
+                    | "[" => [[ CHAR: [ ]] | "]" => [[ CHAR: ] ]]
+Tok               = Spaces (Name | Number | Special )
+End               = !(.)
+Toks              = Tok* Spaces End
+;EBNF

From 36e5536110a213126cbcee0fd4084b7250799bd0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 7 Feb 2009 20:39:32 -0600
Subject: [PATCH 30/41] Mention string encoding in >string

---
 core/strings/strings-docs.factor | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/core/strings/strings-docs.factor b/core/strings/strings-docs.factor
index d40cd982d8..9a1671b126 100644
--- a/core/strings/strings-docs.factor
+++ b/core/strings/strings-docs.factor
@@ -53,8 +53,9 @@ HELP: 1string
 
 HELP: >string
 { $values { "seq" "a sequence of characters" } { "str" string } }
-{ $description "Outputs a freshly-allocated string with the same elements as a given sequence." }
-{ $errors "Throws an error if the sequence contains elements other than real numbers." } ;
+{ $description "Outputs a freshly-allocated string with the same elements as a given sequence, by interpreting the sequence elements as Unicode code points." }
+{ $notes "This operation is only appropriate if the underlying sequence holds Unicode code points, which is rare unless it is a " { $link slice } " of another string. To convert a sequence of bytes to a string, use the words documented in " { $link "io.encodings.string" } "." }
+{ $errors "Throws an error if the sequence contains elements other than integers." } ;
 
 HELP: resize-string ( n str -- newstr )
 { $values { "n" "a non-negative integer" } { "str" string } { "newstr" string } }

From f08c8dd66d0c840558a61e8b8dad1a7da0bb3841 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 21:23:35 -0600
Subject: [PATCH 31/41] fix some compile bugz

---
 extra/graphics/tiff/tiff.factor | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/extra/graphics/tiff/tiff.factor b/extra/graphics/tiff/tiff.factor
index 5c1fd4ec65..e66ebcc6bd 100755
--- a/extra/graphics/tiff/tiff.factor
+++ b/extra/graphics/tiff/tiff.factor
@@ -169,7 +169,7 @@ ERROR: bad-tiff-magic bytes ;
 
 : read-ifds ( tiff -- tiff )
     [
-        dup ifd-offset>> seek-input
+        dup ifd-offset>> seek-absolute seek-input
         2 read endian>
         dup [ read-ifd ] replicate
         4 read endian>
@@ -184,7 +184,7 @@ ERROR: bad-tiff-magic bytes ;
     dup count>> 1 = [
         offset>>
     ] [
-        [ offset>> seek-input ] [ count>> read ] bi
+        [ offset>> seek-absolute seek-input ] [ count>> read ] bi
     ] if ;
 
 : process-ifd-entry ( ifd-entry -- object )

From f36ec3f0c5da15143f2f6bd1ab3ca88006f14255 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 7 Feb 2009 23:04:55 -0600
Subject: [PATCH 32/41] Add nsum, nspread and nweave to generalizations

---
 .../generalizations-docs.factor               | 52 +++++++++++++++----
 .../generalizations-tests.factor              |  9 ++++
 basis/generalizations/generalizations.factor  | 19 ++++++-
 3 files changed, 67 insertions(+), 13 deletions(-)

diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor
index 912f69587e..ac8e14c05a 100644
--- a/basis/generalizations/generalizations-docs.factor
+++ b/basis/generalizations/generalizations-docs.factor
@@ -30,6 +30,10 @@ HELP: narray
 
 { nsequence narray } related-words
 
+HELP: nsum
+{ $values { "n" integer } }
+{ $description "Adds the top " { $snippet "n" } " stack values." } ;
+
 HELP: firstn
 { $values { "n" integer } }
 { $description "A generalization of " { $link first } ", "
@@ -238,6 +242,11 @@ HELP: ncleave
     }
 } ;
 
+HELP: nspread
+{ $values { "quots" "a sequence of quotations" } { "n" integer } }
+{ $description "A generalization of " { $link spread } " that can work for any quotation arity."
+} ;
+
 HELP: mnswap
 { $values { "m" integer } { "n" integer } }
 { $description "Swaps the top " { $snippet "m" } " stack elements with the " { $snippet "n" } " elements directly underneath." }
@@ -250,6 +259,17 @@ HELP: mnswap
     }
 } ;
 
+HELP: nweave
+{ $values { "n" integer } }
+{ $description "Copies the top " { $snippet "n" } " stack elements underneath each one of the " { $snippet "n" } " elements below." }
+{ $examples
+  { $example
+    "USING: arrays kernel generalizations prettyprint ;"
+    "\"e1\" \"e2\" \"o1\" \"o2\" 2 nweave [ 3array ] 3dip 3array 2array ."
+    "{ { \"e1\" \"o1\" \"o2\" } { \"e2\" \"o1\" \"o2\" } }"
+  }
+} ;
+
 HELP: n*quot
 { $values
      { "n" integer } { "seq" sequence }
@@ -299,18 +319,14 @@ HELP: ntuck
 }
 { $description "A generalization of " { $link tuck } " that can work for any stack depth. The top item will be copied and placed " { $snippet "n" } " items down on the stack." } ;
 
-ARTICLE: "generalizations" "Generalized shuffle words and combinators"
-"The " { $vocab-link "generalizations" } " vocabulary defines a number of stack shuffling words and combinators for use in "
-"macros where the arity of the input quotations depends on an "
-"input parameter."
-$nl
-"Generalized sequence operations:"
+ARTICLE: "sequence-generalizations" "Generalized sequence operations"
 { $subsection narray }
 { $subsection nsequence }
 { $subsection firstn }
 { $subsection nappend }
-{ $subsection nappend-as }
-"Generated stack shuffle operations:"
+{ $subsection nappend-as } ;
+
+ARTICLE: "shuffle-generalizations" "Generalized shuffle words"
 { $subsection ndup }
 { $subsection npick }
 { $subsection nrot }
@@ -319,14 +335,28 @@ $nl
 { $subsection ndrop }
 { $subsection ntuck }
 { $subsection mnswap }
-"Generalized combinators:"
+{ $subsection nweave } ;
+
+ARTICLE: "combinator-generalizations" "Generalized combinators"
 { $subsection ndip }
 { $subsection nslip }
 { $subsection nkeep }
 { $subsection napply }
 { $subsection ncleave }
-"Generalized quotation construction:"
+{ $subsection nspread } ;
+
+ARTICLE: "other-generalizations" "Additional generalizations"
 { $subsection ncurry } 
-{ $subsection nwith } ;
+{ $subsection nwith }
+{ $subsection nsum } ;
+
+ARTICLE: "generalizations" "Generalized shuffle words and combinators"
+"The " { $vocab-link "generalizations" } " vocabulary defines a number of stack shuffling words and combinators for use in "
+"macros where the arity of the input quotations depends on an "
+"input parameter."
+{ $subsection "sequence-generalizations" }
+{ $subsection "shuffle-generalizations" }
+{ $subsection "combinator-generalizations" }
+{ $subsection "other-generalizations" } ;
 
 ABOUT: "generalizations"
diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor
index 35e02f08b4..7ede271d01 100644
--- a/basis/generalizations/generalizations-tests.factor
+++ b/basis/generalizations/generalizations-tests.factor
@@ -53,3 +53,12 @@ IN: generalizations.tests
 
 [ 4 nappend ] must-infer
 [ 4 { } nappend-as ] must-infer
+
+[ 17 ] [ 3 1 3 3 7 5 nsum ] unit-test
+{ 4 1 } [ 4 nsum ] must-infer-as
+
+[ "e1" "o1" "o2" "e2" "o1" "o2" ] [ "e1" "e2" "o1" "o2" 2 nweave ] unit-test
+{ 3 5 } [ 2 nweave ] must-infer-as
+
+[ { 0 1 2 } { 3 5 4 } { 7 8 6 } ]
+[ 9 [ ] each { [ 3array ] [ swap 3array ] [ rot 3array ] } 3 nspread ] unit-test
\ No newline at end of file
diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor
index 4692fd20db..9b2b2456c2 100644
--- a/basis/generalizations/generalizations.factor
+++ b/basis/generalizations/generalizations.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2007, 2008 Chris Double, Doug Coleman, Eduardo
+! Copyright (C) 2007, 2009 Chris Double, Doug Coleman, Eduardo
 ! Cavazos, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences sequences.private math combinators
@@ -23,6 +23,9 @@ MACRO: nsequence ( n seq -- )
 MACRO: narray ( n -- )
     '[ _ { } nsequence ] ;
 
+MACRO: nsum ( n -- )
+    1- [ + ] n*quot ;
+
 MACRO: firstn ( n -- )
     dup zero? [ drop [ drop ] ] [
         [ [ '[ [ _ ] dip nth-unsafe ] ] map ]
@@ -70,11 +73,23 @@ MACRO: ncleave ( quots n -- )
     [ '[ _ '[ _ _ nkeep ] ] map [ ] join ] [ '[ _ ndrop ] ] bi
     compose ;
 
+MACRO: nspread ( quots n -- )
+    over empty? [ 2drop [ ] ] [
+        [ [ but-last ] dip ]
+        [ [ peek ] dip ] 2bi
+        swap
+        '[ [ _ _ nspread ] _ ndip @ ]
+    ] if ;
+
 MACRO: napply ( quot n -- )
     swap <repetition> spread>quot ;
 
 MACRO: mnswap ( m n -- )
-    1+ '[ _ -nrot ] <repetition> spread>quot ;
+    1+ '[ _ -nrot ] swap '[ _ _ napply ] ;
+
+MACRO: nweave ( n -- )
+    [ dup <reversed> [ '[ _ _ mnswap ] ] with map ] keep
+    '[ _ _ ncleave ] ;
 
 : nappend-as ( n exemplar -- seq )
     [ narray concat ] dip like ; inline

From aa6166adf20004d792503fd90e8778047d5f7578 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 8 Feb 2009 00:20:56 -0600
Subject: [PATCH 33/41] Fix typo

---
 extra/websites/concatenative/concatenative.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor
index c1d62c6cda..35a1129338 100644
--- a/extra/websites/concatenative/concatenative.factor
+++ b/extra/websites/concatenative/concatenative.factor
@@ -65,7 +65,7 @@ SYMBOL: dh-file
     "concatenative.org" 25 <inet> smtp-server set-global
     "noreply@concatenative.org" lost-password-from set-global
     "website@concatenative.org" insomniac-sender set-global
-    "slava@factorcode.org" insomniac-recipients set-global
+    { "slava@factorcode.org" } insomniac-recipients set-global
     init-factor-db ;
 
 : init-testing ( -- )

From 16312f67111b3954507865cf5cba2aceb379db9d Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 8 Feb 2009 10:35:30 -0600
Subject: [PATCH 34/41] clean up stream-seek with some suggestions from slava

---
 basis/io/backend/unix/unix.factor     |  4 ++--
 basis/io/backend/windows/nt/nt.factor |  8 ++++----
 basis/io/buffers/buffers.factor       |  3 ---
 basis/io/ports/ports.factor           | 13 +++++++++----
 4 files changed, 15 insertions(+), 13 deletions(-)

diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor
index 3372f15cd9..f5e6426859 100644
--- a/basis/io/backend/unix/unix.factor
+++ b/basis/io/backend/unix/unix.factor
@@ -46,14 +46,14 @@ M: fd cancel-operation ( fd -- )
         2bi
     ] if ;
 
-M: unix (stream-seek) ( n seek-type stream -- )
+M: unix seek-handle ( n seek-type handle -- )
     swap {
         { io:seek-absolute [ SEEK_SET ] }
         { io:seek-relative [ SEEK_CUR ] }
         { io:seek-end [ SEEK_END ] }
         [ io:bad-seek-type ]
     } case
-    [ handle>> fd>> swap ] dip lseek io-error ;
+    [ fd>> swap ] dip lseek io-error ;
 
 SYMBOL: +retry+ ! just try the operation again without blocking
 SYMBOL: +input+
diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor
index 7b96e883dd..107f1902e3 100755
--- a/basis/io/backend/windows/nt/nt.factor
+++ b/basis/io/backend/windows/nt/nt.factor
@@ -87,11 +87,11 @@ ERROR: invalid-file-size n ;
 : handle>file-size ( handle -- n )
     0 <ulonglong> [ GetFileSizeEx win32-error=0/f ] keep *ulonglong ;
 
-M: winnt (stream-seek) ( n seek-type stream -- )
+M: winnt seek-handle ( n seek-type handle -- )
     swap {
-        { seek-absolute [ handle>> (>>ptr) ] }
-        { seek-relative [ handle>> [ + ] change-ptr drop ] }
-        { seek-end [ handle>> [ handle>> handle>file-size + ] keep (>>ptr) ] }
+        { seek-absolute [ (>>ptr) ] }
+        { seek-relative [ [ + ] change-ptr drop ] }
+        { seek-end [ [ handle>> handle>file-size + ] keep (>>ptr) ] }
         [ bad-seek-type ]
     } case ;
 
diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor
index a647f27dfc..4df081b17d 100644
--- a/basis/io/buffers/buffers.factor
+++ b/basis/io/buffers/buffers.factor
@@ -21,9 +21,6 @@ M: buffer dispose* ptr>> free ;
 : buffer-reset ( n buffer -- )
     swap >>fill 0 >>pos drop ;
 
-: buffer-reset-hard ( buffer -- )
-    0 >>fill 0 >>pos drop ;
-
 : buffer-capacity ( buffer -- n )
     [ size>> ] [ fill>> ] bi - ; inline
 
diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 1f7fc5f115..1a58d4200b 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -120,12 +120,17 @@ M: output-port stream-write
 
 HOOK: (wait-to-write) io-backend ( port -- )
 
-HOOK: (stream-seek) os ( n seek-type stream -- )
+HOOK: seek-handle os ( n seek-type handle -- )
 
-M: port stream-seek ( n seek-type stream -- )
-    dup check-disposed
-    [ buffer>> buffer-reset-hard 2drop ] [ (stream-seek) ] 3bi ;
+M: input-port stream-seek ( n seek-type stream -- )
+    [ check-disposed ]
+    [ buffer>> 0 swap buffer-reset ]
+    [ handle>> seek-handle ] tri ;
 
+M: output-port stream-seek ( n seek-type stream -- )
+    [ check-disposed ]
+    [ stream-flush ]
+    [ handle>> seek-handle ] tri ;
 
 GENERIC: shutdown ( handle -- )
 

From 69f4899e11cd69c01c572d9acd68e1ed20029cf9 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 8 Feb 2009 13:51:02 -0600
Subject: [PATCH 35/41] document stream seeking

---
 core/io/io-docs.factor | 53 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 52 insertions(+), 1 deletion(-)

diff --git a/core/io/io-docs.factor b/core/io/io-docs.factor
index d7534ddb50..5d8aa6a88f 100644
--- a/core/io/io-docs.factor
+++ b/core/io/io-docs.factor
@@ -68,6 +68,51 @@ HELP: stream-copy
 { $description "Copies the contents of one stream into another, closing both streams when done." } 
 $io-error ;
 
+
+HELP: stream-seek
+{ $values
+     { "n" integer } { "seek-type" "a seek singleton" } { "stream" "a stream" }
+}
+{ $description "Moves the pointer associated with a stream's handle to an offset " { $snippet "n" } " bytes from the seek type so that further reading or writing happens at the new location. For output streams, the buffer is flushed before seeking. Seeking past the end of an output stream will pad the difference with zeros once the stream is written to again." $nl
+    "Three methods of seeking are supported:"
+    { $list { $link seek-absolute } { $link seek-relative } { $link seek-end } }
+}
+{ $notes "Stream seeking is not supported on streams that do not have a known length, e.g. TCP/IP streams." } ;
+
+HELP: seek-absolute
+{ $values
+    
+     { "value" "a seek singleton" }
+}
+{ $description "Seeks to an offset from the beginning of the stream." } ;
+
+HELP: seek-end
+{ $values
+    
+     { "value" "a seek singleton" }
+}
+{ $description "Seeks to an offset from the end of the stream. If the offset puts the stream pointer past the end of the data on an output stream, writing to it will pad the difference with zeros." } ;
+
+HELP: seek-relative
+{ $values
+    
+     { "value" "a seek singleton" }
+}
+{ $description "Seeks to an offset from the current position of the stream pointer." } ;
+
+
+HELP: seek-input
+{ $values
+     { "n" integer } { "seek-type" "a seek singleton" }
+}
+{ $description "Calls " { $link stream-seek } " on the stream stored in " { $link input-stream } "." } ;
+
+HELP: seek-output
+{ $values
+     { "n" integer } { "seek-type" "a seek singleton" }
+}
+{ $description "Calls " { $link stream-seek } " on the stream stored in " { $link output-stream } "." } ;
+
 HELP: input-stream
 { $var-description "Holds an input stream for various implicit stream operations. Rebound using " { $link with-input-stream } " and " { $link with-input-stream* } "." } ;
 
@@ -196,6 +241,8 @@ $nl
 { $subsection stream-write }
 "This word is only required for string output streams:"
 { $subsection stream-nl }
+"This word is for streams that allow seeking:"
+{ $subsection stream-seek }
 "For a discussion of the distinction between binary and string streams, see " { $link "stream-elements" } "."
 { $see-also "io.timeouts" } ;
 
@@ -249,6 +296,8 @@ $nl
 { $subsection read-partial }
 "If the default input stream is a string stream (" { $link "stream-elements" } "), lines of text can be read:"
 { $subsection readln }
+"Seeking on the default input stream:"
+{ $subsection seek-input }
 "A pair of combinators for rebinding the " { $link input-stream } " variable:"
 { $subsection with-input-stream }
 { $subsection with-input-stream* }
@@ -256,7 +305,7 @@ $nl
 { $subsection output-stream }
 "Unless rebound in a child namespace, this variable will be set to a console stream for showing output to the user."
 $nl
-"Words writing to the default input stream:"
+"Words writing to the default output stream:"
 { $subsection flush }
 { $subsection write1 }
 { $subsection write }
@@ -265,6 +314,8 @@ $nl
 { $subsection print }
 { $subsection nl }
 { $subsection bl }
+"Seeking on the default output stream:"
+{ $subsection seek-output }
 "A pair of combinators for rebinding the " { $link output-stream } " variable:"
 { $subsection with-output-stream }
 { $subsection with-output-stream* }

From fef602b1857ab649d882461e76522388cefb24a9 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 8 Feb 2009 13:58:39 -0600
Subject: [PATCH 36/41] remove superfluous flush from io tests

---
 core/io/io-tests.factor | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor
index 8bfc52432d..d227ebeadf 100644
--- a/core/io/io-tests.factor
+++ b/core/io/io-tests.factor
@@ -16,7 +16,7 @@ IN: io.tests
     "seek-test1" unique-file binary
     [
         [
-            B{ 1 2 3 4 5 } write flush 0 seek-absolute seek-output
+            B{ 1 2 3 4 5 } write 0 seek-absolute seek-output
             B{ 3 } write
         ] with-file-writer
     ] [
@@ -29,7 +29,7 @@ IN: io.tests
     "seek-test2" unique-file binary
     [
         [
-            B{ 1 2 3 4 5 } write flush -1 seek-relative seek-output
+            B{ 1 2 3 4 5 } write -1 seek-relative seek-output
             B{ 3 } write
         ] with-file-writer
     ] [
@@ -42,7 +42,7 @@ IN: io.tests
     "seek-test3" unique-file binary
     [
         [
-            B{ 1 2 3 4 5 } write flush 1 seek-relative seek-output
+            B{ 1 2 3 4 5 } write 1 seek-relative seek-output
             B{ 3 } write
         ] with-file-writer
     ] [

From bba15986972c5b3918fc56cbea83b489c533f199 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 8 Feb 2009 13:59:32 -0600
Subject: [PATCH 37/41] move io tests into io.files

---
 core/io/files/files-tests.factor | 65 ++++++++++++++++++++++++++++++++
 core/io/io-tests.factor          | 63 -------------------------------
 2 files changed, 65 insertions(+), 63 deletions(-)

diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index f9702fd133..423eb38144 100644
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -75,3 +75,68 @@ USE: debugger.threads
 [ t ] [ "quux-test.txt" temp-file exists? ] unit-test
 
 [ ] [ "quux-test.txt" temp-file delete-file ] unit-test
+
+! File seeking tests
+[ B{ 3 2 3 4 5 } ]
+[
+    "seek-test1" unique-file binary
+    [
+        [
+            B{ 1 2 3 4 5 } write 0 seek-absolute seek-output
+            B{ 3 } write
+        ] with-file-writer
+    ] [
+        file-contents
+    ] 2bi
+] unit-test
+
+[ B{ 1 2 3 4 3 } ]
+[
+    "seek-test2" unique-file binary
+    [
+        [
+            B{ 1 2 3 4 5 } write -1 seek-relative seek-output
+            B{ 3 } write
+        ] with-file-writer
+    ] [
+        file-contents
+    ] 2bi
+] unit-test
+
+[ B{ 1 2 3 4 5 0 3 } ]
+[
+    "seek-test3" unique-file binary
+    [
+        [
+            B{ 1 2 3 4 5 } write 1 seek-relative seek-output
+            B{ 3 } write
+        ] with-file-writer
+    ] [
+        file-contents
+    ] 2bi
+] unit-test
+
+[ B{ 3 } ]
+[
+    B{ 1 2 3 4 5 } "seek-test4" unique-file binary [
+        set-file-contents
+    ] [
+        [
+            -3 seek-end seek-input 1 read
+        ] with-file-reader
+    ] 2bi
+] unit-test
+
+[ B{ 2 } ]
+[
+    B{ 1 2 3 4 5 } "seek-test5" unique-file binary [
+        set-file-contents
+    ] [
+        [
+            3 seek-absolute seek-input
+            -2 seek-relative seek-input
+            1 read
+        ] with-file-reader
+    ] 2bi
+] unit-test
+
diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor
index d227ebeadf..9e931279d7 100644
--- a/core/io/io-tests.factor
+++ b/core/io/io-tests.factor
@@ -10,66 +10,3 @@ IN: io.tests
 
 ! Make sure we use correct to_c_string form when writing
 [ ] [ "\0" write ] unit-test
-
-[ B{ 3 2 3 4 5 } ]
-[
-    "seek-test1" unique-file binary
-    [
-        [
-            B{ 1 2 3 4 5 } write 0 seek-absolute seek-output
-            B{ 3 } write
-        ] with-file-writer
-    ] [
-        file-contents
-    ] 2bi
-] unit-test
-
-[ B{ 1 2 3 4 3 } ]
-[
-    "seek-test2" unique-file binary
-    [
-        [
-            B{ 1 2 3 4 5 } write -1 seek-relative seek-output
-            B{ 3 } write
-        ] with-file-writer
-    ] [
-        file-contents
-    ] 2bi
-] unit-test
-
-[ B{ 1 2 3 4 5 0 3 } ]
-[
-    "seek-test3" unique-file binary
-    [
-        [
-            B{ 1 2 3 4 5 } write 1 seek-relative seek-output
-            B{ 3 } write
-        ] with-file-writer
-    ] [
-        file-contents
-    ] 2bi
-] unit-test
-
-[ B{ 3 } ]
-[
-    B{ 1 2 3 4 5 } "seek-test4" unique-file binary [
-        set-file-contents
-    ] [
-        [
-            -3 seek-end seek-input 1 read
-        ] with-file-reader
-    ] 2bi
-] unit-test
-
-[ B{ 2 } ]
-[
-    B{ 1 2 3 4 5 } "seek-test5" unique-file binary [
-        set-file-contents
-    ] [
-        [
-            3 seek-absolute seek-input
-            -2 seek-relative seek-input
-            1 read
-        ] with-file-reader
-    ] 2bi
-] unit-test

From c069add10b86dc8038354e5b91c1b2d3a8da5c87 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 8 Feb 2009 17:34:17 -0600
Subject: [PATCH 38/41] fix using lists

---
 core/io/files/files-tests.factor | 10 ++++------
 core/io/io-tests.factor          |  4 +---
 2 files changed, 5 insertions(+), 9 deletions(-)

diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index 423eb38144..d7fc3851e2 100644
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -1,8 +1,7 @@
-USING: tools.test io.files io.files.private io.files.temp
-io.directories io.encodings.8-bit arrays make system
-io.encodings.binary io threads kernel continuations
-io.encodings.ascii sequences strings accessors
-io.encodings.utf8 math destructors namespaces ;
+USING: arrays debugger.threads destructors io io.directories
+io.encodings.8-bit io.encodings.ascii io.encodings.binary
+io.files io.files.private io.files.temp io.files.unique kernel
+make math sequences system threads tools.test ;
 IN: io.files.tests
 
 \ exists? must-infer
@@ -139,4 +138,3 @@ USE: debugger.threads
         ] with-file-reader
     ] 2bi
 ] unit-test
-
diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor
index 9e931279d7..cf6b935215 100644
--- a/core/io/io-tests.factor
+++ b/core/io/io-tests.factor
@@ -1,6 +1,4 @@
-USING: arrays io io.files kernel math parser strings system
-tools.test words namespaces make io.encodings.8-bit
-io.encodings.binary sequences io.files.unique ;
+USING: io parser tools.test words ;
 IN: io.tests
 
 [ f ] [

From 83252cce04ef5864f6c38eb2343b94e974d5a05c Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 8 Feb 2009 17:37:54 -0600
Subject: [PATCH 39/41] working on tiff

---
 extra/graphics/tiff/tiff.factor | 24 ++++++++++++++----------
 1 file changed, 14 insertions(+), 10 deletions(-)

diff --git a/extra/graphics/tiff/tiff.factor b/extra/graphics/tiff/tiff.factor
index e66ebcc6bd..f0b3f9337e 100755
--- a/extra/graphics/tiff/tiff.factor
+++ b/extra/graphics/tiff/tiff.factor
@@ -2,20 +2,19 @@
 ! 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 ;
+sorting.slots math.order math.parser prettyprint classes ;
 IN: graphics.tiff
 
 TUPLE: tiff
 endianness
 the-answer
 ifd-offset
-ifds
-processed-ifds ;
+ifds ;
 
 CONSTRUCTOR: tiff ( -- tiff )
     V{ } clone >>ifds ;
 
-TUPLE: ifd count ifd-entries next ;
+TUPLE: ifd count ifd-entries next processed-tags strips ;
 
 CONSTRUCTOR: ifd ( count ifd-entries next -- ifd ) ;
 
@@ -137,8 +136,6 @@ ERROR: bad-planar-configuration n ;
 TUPLE: new-subfile-type n ;
 CONSTRUCTOR: new-subfile-type ( n -- object ) ;
 
-
-
 ERROR: bad-tiff-magic bytes ;
 
 : tiff-endianness ( byte-array -- ? )
@@ -176,6 +173,12 @@ ERROR: bad-tiff-magic bytes ;
         [ <ifd> push-ifd ] [ 0 = [ read-ifds ] unless ] bi
     ] with-tiff-endianness ;
 
+: read-strips ( ifd -- ifd )
+    dup processed-tags>>
+    [ [ strip-byte-counts instance? ] find nip n>> ]
+    [ [ strip-offsets instance? ] find nip n>> ] bi
+    [ seek-absolute seek-input read ] { } 2map-as >>strips ;
+
 ! ERROR: unhandled-ifd-entry data n ;
 
 : unhandled-ifd-entry ;
@@ -207,17 +210,18 @@ ERROR: bad-tiff-magic bytes ;
         [ unhandled-ifd-entry swap 2array ]
     } case ;
 
-: process-ifd ( ifd -- processed-ifd )
-    ifd-entries>> [ process-ifd-entry ] map ;
+: process-ifd ( ifd -- ifd )
+    dup ifd-entries>> [ process-ifd-entry ] map >>processed-tags ;
 
 : (load-tiff) ( path -- tiff )
     binary [
         <tiff>
         read-header
         read-ifds
-        dup ifds>> [ process-ifd ] map
-        >>processed-ifds
+        dup ifds>> [ process-ifd read-strips drop ] each
     ] with-file-reader ;
 
 : load-tiff ( path -- tiff )
     (load-tiff) ;
+
+! TODO: duplicate ifds = error, seeking out of bounds = error

From 1818ea5136cd5515772b4c29d6c978378ffae1d2 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 8 Feb 2009 18:42:11 -0600
Subject: [PATCH 40/41] update README.txt

---
 README.txt | 14 ++++++++++----
 1 file changed, 10 insertions(+), 4 deletions(-)

diff --git a/README.txt b/README.txt
index 98616539d2..d60bf03130 100755
--- a/README.txt
+++ b/README.txt
@@ -116,16 +116,22 @@ Now if $DISPLAY is set, running ./factor will start the UI.
 
 * Running Factor on Windows XP/Vista
 
+The Factor runtime is compiled into two binaries:
+
+  factor.com - a Windows console application
+  factor.exe - a Windows native application, without a console
+
 If you did not download the binary package, you can bootstrap Factor in
-the command prompt:
+the command prompt using the console application:
 
-  factor.exe -i=boot.<cpu>.image
+  factor.com -i=boot.<cpu>.image
 
-Once bootstrapped, double-clicking factor.exe starts the Factor UI.
+Once bootstrapped, double-clicking factor.exe or factor.com starts
+the Factor UI.
 
 To run the listener in the command prompt:
 
-  factor.exe -run=listener
+  factor.com -run=listener
 
 * The Factor FAQ
 

From b529df965234019bfdd98a472636dd875bc910a6 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 8 Feb 2009 20:18:30 -0600
Subject: [PATCH 41/41] handle seeking before the file start on windows, add a
 unit test for this

---
 basis/io/backend/windows/nt/nt.factor | 11 ++++++++---
 core/io/files/files-tests.factor      |  6 ++++++
 2 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor
index 107f1902e3..6f283ac1bb 100755
--- a/basis/io/backend/windows/nt/nt.factor
+++ b/basis/io/backend/windows/nt/nt.factor
@@ -87,11 +87,16 @@ ERROR: invalid-file-size n ;
 : handle>file-size ( handle -- n )
     0 <ulonglong> [ GetFileSizeEx win32-error=0/f ] keep *ulonglong ;
 
+ERROR: seek-before-start n ;
+
+: set-seek-ptr ( n handle -- )
+    [ dup 0 < [ seek-before-start ] when ] dip (>>ptr) ;
+
 M: winnt seek-handle ( n seek-type handle -- )
     swap {
-        { seek-absolute [ (>>ptr) ] }
-        { seek-relative [ [ + ] change-ptr drop ] }
-        { seek-end [ [ handle>> handle>file-size + ] keep (>>ptr) ] }
+        { seek-absolute [ set-seek-ptr ] }
+        { seek-relative [ [ ptr>> + ] keep set-seek-ptr ] }
+        { seek-end [ [ handle>> handle>file-size + ] keep set-seek-ptr ] }
         [ bad-seek-type ]
     } case ;
 
diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index d7fc3851e2..152d1bb85d 100644
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -138,3 +138,9 @@ USE: debugger.threads
         ] with-file-reader
     ] 2bi
 ] unit-test
+
+[
+    "seek-test6" unique-file binary [
+        -10 seek-absolute seek-input
+    ] with-file-reader
+] must-fail