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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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/30] 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 } }