help-smalltalk
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Help-smalltalk] [PATCH] zlib bindings


From: Paolo Bonzini
Subject: [Help-smalltalk] [PATCH] zlib bindings
Date: Thu, 17 May 2007 13:49:56 +0200
User-agent: Thunderbird 2.0.0.0 (Macintosh/20070326)

This patch provides zlib bindings in the form of a nice Decorator for any kind of stream. You can even put a DeflateStream back to back with an InflateStream to get a (pretty expensive) pass-through stream!

There is support for raw (PKZIP), gzip and zlib (RFC1950) formats. The class hierarchy is somewhat arbitrary, I tried to mimic what I would have done if writing everything from scratch.

The length of the patch is mostly because I tried to document the new classes as much as possible, and because I wanted to provide a higher-level interface than, say, the Python module described in http://www.python.org/doc/lib/module-zlib.html (yeah, that one sucks...). I prefer Smalltalk code to look Smalltalk even if it uses foreign libraries.

In addition, I wrote some unit tests but didn't have the patience to put them in SUnit format. :-( We really need a <test>...</test> item in packages.xml, that would encourage me to behave.

I'm committing this to both development and 2.3 branch.

Play with this and make it fail.

Paolo
2007-05-17  Paolo Bonzini  <address@hidden>

        * kernel/PosStream.st: Fix comment of #species.
        * kernel/Stream.st: Fix #nextHunk.
        * examples/zlib.c: New.
        * examples/zlib.st: New.

--- orig/configure.ac
+++ mod/configure.ac
@@ -259,6 +259,7 @@ AC_SUBST(I18N_DISABLED)
 AC_SUBST(NCURSES_DISABLED)
 
 AC_CHECK_HEADER(gdbm.h, MODULES_EXAMPLE="$MODULES_EXAMPLE gdbm.la")
+AC_CHECK_HEADER(zlib.h, MODULES_EXAMPLE="$MODULES_EXAMPLE zlib.la")
 
 AC_ARG_ENABLE(gtk,
 [  --enable-gtk={yes,no,blox}


--- orig/examples/Makefile.am
+++ mod/examples/Makefile.am
@@ -1,8 +1,8 @@
 examplemodulesdir = $(pkgdatadir)/examples/modules
 
-dist_examplemodules_DATA = gdbm.st gdbm-c.st md5.st
+dist_examplemodules_DATA = gdbm.st gdbm-c.st md5.st zlib.st
 
-EXTRA_LTLIBRARIES = gdbm.la
+EXTRA_LTLIBRARIES = gdbm.la zlib.la
 pkglib_LTLIBRARIES = @MODULES_EXAMPLE@ md5.la
 
 gst_module_ldflags = -rpath $(pkglibdir) -release $(VERSION) -module \
@@ -16,4 +16,8 @@ md5_la_SOURCES = md5.c
 md5_la_LIBADD = ../lib-src/library.la
 md5_la_LDFLAGS = $(gst_module_ldflags)
 
+zlib_la_SOURCES = zlib.c
+zlib_la_LIBADD = -lz
+zlib_la_LDFLAGS = $(gst_module_ldflags)
+
 AM_CPPFLAGS = -I$(top_srcdir)/libgst -I$(top_srcdir)/lib-src @INCSNPRINTFV@


--- orig/kernel/PosStream.st
+++ mod/kernel/PosStream.st
@@ -271,7 +271,7 @@ isExternalStream
 !
 
 species
-    "The collections returned by #upTo: etc. are the same kind as
-    those returned by the collection with methods such as #select:"
+    "Return the type of the collections returned by #upTo: etc., which are the
+    same kind as those returned by the collection with methods such as 
#select:."
     ^collection species
 ! !


--- orig/kernel/Stream.st
+++ mod/kernel/Stream.st
@@ -416,19 +416,23 @@ skipToAll: aCollection
                ch := self next.
            ]
     ] repeat
-! !
-
-!Stream methodsFor: 'private'!
+!
 
 nextHunk
-    "Private - Used internally by the VM when we file in a stream."
+    "Answer a more-or-less arbitrary amount of data.  When used on files, this
+     does at most one I/O operation.  For other kinds of stream, the definition
+     may vary.  This method is used by the VM when loading data from a 
Smalltalk
+     stream, and by various kind of Stream decorators supplied with GNU
+     Smalltalk (including zlib streams)."
     | s |
     s := self species new: 1024.
     1 to: 1024 do: [ :i |
-       self atEnd ifTrue: [ ^s copyFrom: 1 to: i ].
+       self atEnd ifTrue: [ ^s copyFrom: 1 to: i - 1 ].
        s at: i put: self next ].
     ^s
-!
+! !
+
+!Stream methodsFor: 'private'!
 
 prefixTableFor: aCollection
     "Private - Answer the prefix table for the Knuth-Morris-Pratt algorithm.


--- orig/packages.xml.in
+++ mod/packages.xml.in
@@ -287,6 +287,15 @@
 </@address@hidden>
 
 <package>
+  <name>ZLib</name>
+  <filein>zlib.st</filein>
+  <module>zlib</module>
+  <directory>examples</directory>
+
+  <file>zlib.st</file>
+</package>
+
+<package>
   <name>MD5</name>
   <filein>md5.st</filein>
   <module>md5</module>



--- /dev/null
+++ mod/examples/zlib.c
@@ -0,0 +1,237 @@
+/***********************************************************************
+ *
+ *     Zlib interface definitions for GNU Smalltalk 
+ *
+ *
+ ***********************************************************************/
+
+/***********************************************************************
+ *
+ * Copyright 2007 Free Software Foundation, Inc.
+ * Written by Paolo Bonzini.
+ *
+ * This file is part of GNU Smalltalk.
+ *
+ * GNU Smalltalk is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by the Free
+ * Software Foundation; either version 2, or (at your option) any later 
+ * version.
+ * 
+ * Linking GNU Smalltalk statically or dynamically with other modules is
+ * making a combined work based on GNU Smalltalk.  Thus, the terms and
+ * conditions of the GNU General Public License cover the whole
+ * combination.
+ *
+ * In addition, as a special exception, the Free Software Foundation
+ * give you permission to combine GNU Smalltalk with free software
+ * programs or libraries that are released under the GNU LGPL and with
+ * independent programs running under the GNU Smalltalk virtual machine.
+ *
+ * You may copy and distribute such a system following the terms of the
+ * GNU GPL for GNU Smalltalk and the licenses of the other code
+ * concerned, provided that you include the source code of that other
+ * code when and as the GNU GPL requires distribution of source code.
+ *
+ * Note that people who make modified versions of GNU Smalltalk are not
+ * obligated to grant this special exception for their modified
+ * versions; it is their choice whether to do so.  The GNU General
+ * Public License gives permission to release a modified version without
+ * this exception; this exception also makes it possible to release a
+ * modified version which carries forward this exception.
+ *
+ * GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+ * more details.
+ * 
+ * You should have received a copy of the GNU General Public License along with
+ * GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
+ * Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  
+ *
+ ***********************************************************************/
+
+
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+
+#include <stdlib.h>
+#include <zlib.h>
+
+#include "gstpub.h"
+
+static VMProxy *vmProxy;
+
+typedef struct zlib_stream {
+  OBJ_HEADER;
+  OOP ptr;
+  OOP endPtr;
+  OOP inBytes;
+  OOP outBytes;
+  OOP delta;
+  OOP source;
+  OOP zlibObject;
+} *zlib_stream;
+
+
+
+/* Wrappers around deflateInit/inflateInit.  Additionally, we allow specifying
+   the window size to support raw and gzip encoding.  */
+
+void
+gst_deflateInit (OOP oop, int factor, int winSize)
+{
+  zlib_stream zs = (zlib_stream) OOP_TO_OBJ (oop);
+  z_stream *zlib_obj = calloc (1, sizeof (z_stream));
+
+  zs->zlibObject = vmProxy->cObjectToOOP (zlib_obj);
+  deflateInit2 (zlib_obj, factor, Z_DEFLATED, winSize, 8, Z_DEFAULT_STRATEGY);
+}
+
+
+void
+gst_inflateInit (OOP oop, int winSize)
+{
+  zlib_stream zs = (zlib_stream) OOP_TO_OBJ (oop);
+  z_stream *zlib_obj = calloc (1, sizeof (z_stream));
+
+  zs->zlibObject = vmProxy->cObjectToOOP (zlib_obj);
+  inflateInit2 (zlib_obj, winSize);
+}
+
+
+/* Wrappers around deflateEnd/inflateEnd.  Nothing interesting goes on here.  
*/
+
+void
+gst_deflateEnd (OOP oop)
+{
+  zlib_stream zs = (zlib_stream) OOP_TO_OBJ (oop);
+  z_stream *zlib_obj = vmProxy->OOPToCObject (zs->zlibObject);
+
+  deflateEnd (zlib_obj);
+  zs->zlibObject = vmProxy->nilOOP;
+  free (zlib_obj);
+}
+
+
+void
+gst_inflateEnd (OOP oop)
+{
+  zlib_stream zs = (zlib_stream) OOP_TO_OBJ (oop);
+  z_stream *zlib_obj = vmProxy->OOPToCObject (zs->zlibObject);
+
+  inflateEnd (zlib_obj);
+  zs->zlibObject = vmProxy->nilOOP;
+  free (zlib_obj);
+}
+
+
+/* Common function to wrap deflate/inflate.  Takes care of setting up the
+   zlib buffers so that they point into the Smalltalk buffers.  */
+
+static int
+zlib_wrapper (OOP oop, int finish, int (*func) (z_stream *, int))
+{
+  zlib_stream zs = (zlib_stream) OOP_TO_OBJ (oop);
+  z_stream *zlib_obj = vmProxy->OOPToCObject (zs->zlibObject);
+  OOP inBytesOOP = zs->inBytes;
+  OOP outBytesOOP = zs->outBytes;
+  char *inBytes = &STRING_OOP_AT (OOP_TO_OBJ (inBytesOOP), 1);
+  char *outBytes = &STRING_OOP_AT (OOP_TO_OBJ (outBytesOOP), 1);
+  size_t inSize = vmProxy->OOPSize (inBytesOOP);
+  size_t outSize = vmProxy->OOPSize (outBytesOOP);
+  int ret;
+
+  if (!zlib_obj)
+    return -1;
+
+  /* If the buffer has leftover data, relocate next_in because the Smalltalk
+     object might have moved.  Otherwise initialize it from inBytesOOP.  */
+  if (zlib_obj->opaque)
+    zlib_obj->next_in = inBytes + (ptrdiff_t) zlib_obj->opaque; 
+  else
+    {
+      zlib_obj->next_in = inBytes;
+      zlib_obj->avail_in = inSize;
+    }
+
+  /* Call the function we are wrapping.  */
+  zlib_obj->next_out = outBytes;
+  zlib_obj->avail_out = outSize;
+  ret = func (zlib_obj, finish ? Z_FINISH : Z_NO_FLUSH);
+  if (ret == Z_BUF_ERROR)
+    {
+      zlib_obj->msg = NULL;
+      ret = Z_OK;
+    }
+
+  /* If the buffer has leftover data, clear the inBytes field of the object.
+     Otherwise store how many bytes were consumed in zs->opaque.  */
+  if (zlib_obj->avail_in == 0)
+    {
+      zs->inBytes = vmProxy->nilOOP;
+      zlib_obj->opaque = NULL;
+    }
+  else
+    zlib_obj->opaque = (PTR) ((char *) zlib_obj->next_in - (char *) inBytes);
+
+  /* Return the number of bytes written to the output buffer, or -1 if the
+     output is finished.  */
+  if (ret < 0)
+    return -1;
+  else if (finish && inSize == 0 && outSize == zlib_obj->avail_out)
+    return -1;
+  else
+    return outSize - zlib_obj->avail_out;
+}
+
+
+int
+gst_deflate (OOP oop, int finish)
+{
+  return zlib_wrapper (oop, finish, deflate);
+}
+
+
+
+int
+gst_inflate (OOP oop, int finish)
+{
+  return zlib_wrapper (oop, finish, inflate);
+}
+
+
+/* Retrieves the error message from the z_stream object.  */
+
+char *
+gst_zlibError (OOP oop)
+{
+  zlib_stream zs = (zlib_stream) OOP_TO_OBJ (oop);
+  z_stream *zlib_obj = vmProxy->OOPToCObject (zs->zlibObject);
+  char *result = NULL;
+
+  if (zlib_obj)
+    {
+      result = zlib_obj->msg;
+      zlib_obj->msg = NULL;
+    }
+
+  return result;
+}
+
+
+/* Module initialization function.  */
+
+void
+gst_initModule (VMProxy * proxy)
+{
+  vmProxy = proxy;
+  vmProxy->defineCFunc ("gst_deflateInit", gst_deflateInit);
+  vmProxy->defineCFunc ("gst_deflateEnd", gst_deflateEnd);
+  vmProxy->defineCFunc ("gst_deflate", gst_deflate);
+  vmProxy->defineCFunc ("gst_inflateInit", gst_inflateInit);
+  vmProxy->defineCFunc ("gst_inflateEnd", gst_inflateEnd);
+  vmProxy->defineCFunc ("gst_inflate", gst_inflate);
+  vmProxy->defineCFunc ("gst_zlibError", gst_zlibError);
+}



--- /dev/null
+++ mod/examples/zlib.st
@@ -0,0 +1,463 @@
+"======================================================================
+|
+|   ZLib module declarations
+|
+|
+ ======================================================================"
+
+
+"======================================================================
+|
+| Copyright 2007 Free Software Foundation, Inc.
+| Written by Paolo Bonzini
+|
+| This file is part of GNU Smalltalk.
+|
+| GNU Smalltalk is free software; you can redistribute it and/or modify it
+| under the terms of the GNU General Public License as published by the Free
+| Software Foundation; either version 2, or (at your option) any later version.
+|
+| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
+| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+| FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
+| details.
+|
+| You should have received a copy of the GNU General Public License along with
+| GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
+| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+Error subclass: #ZlibError
+       instanceVariableNames: 'stream'
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Examples-Useful'!
+
+ZlibError comment: 'This exception is raised whenever there is an error
+in a compressed stream.'!
+
+Stream subclass: #ZlibStream
+       instanceVariableNames: 'ptr endPtr inBytes outBytes delta source 
zlibObject'
+       classVariableNames: 'BufferSize'
+       poolDictionaries: ''
+       category: 'Examples-Useful'!
+
+ZlibStream comment: 'This abstract class implements the basic buffering that is
+used for communication with zlib.'!
+
+ZlibStream subclass: #RawDeflateStream
+       instanceVariableNames: ''
+       classVariableNames: 'DefaultCompressionLevel'
+       poolDictionaries: ''
+       category: 'Examples-Useful'!
+
+RawDeflateStream comment: 'Instances of this class produce "raw" (PKZIP)
+deflated data.'!
+
+RawDeflateStream subclass: #DeflateStream
+       instanceVariableNames: ''
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Examples-Useful'!
+
+DeflateStream comment: 'Instances of this class produce "standard"
+(zlib, RFC1950) deflated data.'!
+
+RawDeflateStream subclass: #GZipDeflateStream
+       instanceVariableNames: ''
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Examples-Useful'!
+
+GZipDeflateStream comment: 'Instances of this class produce GZip (RFC1952)
+deflated data.'!
+
+ZlibStream subclass: #RawInflateStream
+       instanceVariableNames: ''
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Examples-Useful'!
+
+RawInflateStream comment: 'Instances of this class reinflate "raw" (PKZIP)
+deflated data.'!
+
+RawInflateStream subclass: #InflateStream
+       instanceVariableNames: ''
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Examples-Useful'!
+
+InflateStream comment: 'Instances of this class reinflate "standard"
+(zlib, RFC1950) deflated data.'!
+
+RawInflateStream subclass: #GZipInflateStream
+       instanceVariableNames: ''
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Examples-Useful'!
+
+GZipInflateStream comment: 'Instances of this class reinflate GZip (RFC1952)
+deflated data.'!
+
+
+!ZlibError methodsFor: 'accessing'!
+
+stream
+    "Answer the ZlibStream that caused the error."
+    ^stream!
+
+stream: anObject
+    "Set the ZlibStream that caused the error."
+    stream := anObject! !
+
+
+!ZlibStream class methodsFor: 'testing'!
+
+testVector
+    "Return a long and repetitive string."
+    | original |
+    original := 'The quick brown fox jumps over the lazy dog
+'.
+    original := original, original, original.
+    original := original, original, original.
+    original := original, original, original.
+    ^original, original, original!
+
+doDeflate
+    "Deflate the long string and return the result."
+    ^(DeflateStream on: self testVector readStream) contents!
+
+testError
+    "Test whether catching errors works."
+    ^[ (InflateStream on: #[12 34 56] readStream) contents. false ]
+       on: ZlibError do: [ :ex | ex return: true ]!
+
+testRaw
+    "Test connecting a DeflateStream back-to-back with an InflateStream."
+    | deflate |
+    deflate := RawDeflateStream on: self testVector readStream.
+    ^(RawInflateStream on: deflate) contents = self testVector!
+
+testGZip
+    "Test connecting a DeflateStream back-to-back with an InflateStream."
+    | deflate |
+    deflate := GZipDeflateStream on: self testVector readStream.
+    ^(GZipInflateStream on: deflate) contents = self testVector!
+
+testDirect
+    "Test connecting a DeflateStream back-to-back with an InflateStream."
+    | deflate |
+    deflate := DeflateStream on: self testVector readStream.
+    ^(InflateStream on: deflate) contents = self testVector!
+
+testInflate
+    "Basic compression/decompression test."
+    ^(InflateStream on: self doDeflate readStream) contents = self testVector!
+
+testNextHunk
+    "Test accessing data with nextHunk (needed to file-in compressed data)."
+    | original stream data |
+    original := self testVector.
+    stream := InflateStream on: self doDeflate readStream.
+
+    data := String new.
+    [ stream atEnd ] whileFalse: [ data := data, stream nextHunk ].
+    ^data = original!
+
+testRandomAccess
+    "Test random access to deflated data."
+    | original stream data ok |
+    original := self testVector.
+    stream := InflateStream on: self doDeflate readStream.
+    stream contents.
+
+    stream position: 0.
+    ok := ((original copyFrom: 1 to: 512) = (stream next: 512)).
+    stream position: 512.
+    ok := ok and: [ ((original copyFrom: 513 to: 1024) = (stream next: 512)) ].
+    stream position: 1536.
+    ok := ok and: [ ((original copyFrom: 1537 to: 2048) = (stream next: 512)) 
].
+    stream position: 1.
+    ok := ok and: [ ((original copyFrom: 2 to: 512) = (stream next: 511)) ].
+    stream position: 514.
+    ok := ok and: [ ((original copyFrom: 515 to: 1024) = (stream next: 510)) ].
+    ^ok!
+
+runTests
+    "Run zlib tests, which ought to be converted to SUnit..."
+    | oldBufSize |
+    oldBufSize := self bufferSize.
+    self bufferSize: 512.
+    self testError printNl.
+    self testInflate printNl.
+    self testNextHunk printNl.
+    self testRandomAccess printNl.
+    self testDirect printNl.
+    self testRaw printNl.
+    self testGZip printNl.
+    self bufferSize: oldBufSize! !
+
+
+
+!ZlibStream class methodsFor: 'accessing'!
+
+bufferSize
+    "Answer the size of the output buffers that are passed to zlib.  Each
+     zlib stream uses a buffer of this size."
+    BufferSize isNil ifTrue: [ BufferSize := 16384 ].
+    ^BufferSize!
+
+bufferSize: anInteger
+    "Set the size of the output buffers that are passed to zlib.  Each
+     zlib stream uses a buffer of this size."
+    BufferSize := anInteger!
+
+
+!ZlibStream class methodsFor: 'instance creation'!
+
+new
+    self shouldNotImplement!
+
+on: aStream
+    "Answer an instance of the receiver that decorates aStream."
+    ^self basicNew initialize: aStream!
+
+
+
+!ZlibStream methodsFor: 'streaming'!
+
+atEnd
+    "Answer whether the stream has got to an end"
+    ptr >= endPtr ifFalse: [ ^false ].
+    ^zlibObject isNil or: [
+        self fillBuffer.
+        zlibObject isNil ]!
+
+isExternalStream
+    "Answer whether the receiver streams on a file or socket."
+    ^source isExternalStream!
+
+next
+    "Return the next object (character or byte) in the receiver."
+    self atEnd ifTrue: [ ^self pastEnd ].
+    ptr := ptr + 1.
+    ^outBytes at: ptr!
+
+peekFor: anObject
+    "Returns true and gobbles the next element from the stream of it is
+     equal to anObject, returns false and doesn't gobble the next element
+     if the next element is not equal to anObject."
+    | result | 
+    self atEnd ifTrue: [ ^self pastEnd ].
+    result := (outBytes at: ptr + 1) = anObject.
+    result ifTrue: [ ptr := ptr + 1 ].
+    ^result!
+
+nextHunk
+    "Answer the next buffers worth of stuff in the Stream represented
+     by the receiver.  Do at most one actual compression/decompression
+     operation."
+    | result |
+    self atEnd ifTrue: [ ^self pastEnd ].
+    result := outBytes copyFrom: ptr + 1 to: endPtr.
+    ptr := endPtr.
+    ^result!
+
+peek
+    "Returns the next element of the stream without moving the pointer.
+     Returns nil when at end of stream."
+    self atEnd ifTrue: [ ^nil ].
+    ^outBytes at: ptr + 1!
+
+position
+    "Answer the current value of the stream pointer.  Note that only inflating
+     streams support random access to the stream data."
+    ^delta + ptr!
+
+species
+    "Return the type of the collections returned by #upTo: etc."
+    ^source species! !
+
+
+
+!ZlibStream methodsFor: 'private'!
+
+resetBuffer
+    delta := 0.
+    endPtr := 0.
+    self fillBuffer!
+
+initialize: aStream
+    source := aStream.
+    outBytes := self species new: self class bufferSize.
+    self addToBeFinalized.
+    self resetBuffer!
+
+fillBuffer
+    "Fill the output buffer, supplying data to zlib until it can actually
+     produce something."
+    delta := delta + endPtr.
+    ptr := 0.
+    [
+        inBytes isNil ifTrue: [
+           inBytes := source atEnd
+               ifTrue: [ #[] ]
+               ifFalse: [ source nextHunk ] ].
+
+        endPtr := self processInput: source atEnd.
+       endPtr = 0 ] whileTrue.
+
+    "End of data, or zlib error encountered."
+    endPtr = -1 ifTrue: [ self checkError ]!
+
+finalize
+    self destroyZlibObject! !
+
+!ZlibStream methodsFor: 'private zlib interface'!
+
+checkError
+    | error |
+    error := self getError.
+    self finalize; removeToBeFinalized.
+    error isNil ifFalse: [
+       ZlibError new messageText: error; stream: self; signal ]!
+
+getError
+    <cCall: 'gst_zlibError' returning: #string args: #(#self)>!
+
+destroyZlibObject
+    self subclassResponsibility!
+
+processInput: atEnd
+    self subclassResponsibility! !
+
+
+
+!RawDeflateStream class methodsFor: 'accessing'!
+
+defaultCompressionLevel
+    "Return the default compression level used by deflating streams."
+    DefaultCompressionLevel isNil ifTrue: [ DefaultCompressionLevel := 6 ].
+    ^DefaultCompressionLevel!
+
+defaultCompressionLevel: anInteger
+    "Set the default compression level used by deflating streams.  It
+     should be a number between 1 and 9."
+    DefaultCompressionLevel := anInteger!
+
+
+!RawDeflateStream class methodsFor: 'instance creation'!
+
+on: aStream
+    "Answer a stream that compresses the data in aStream with the default
+     compression level."
+    ^self basicNew
+       initializeZlibObject: self defaultCompressionLevel;
+       initialize: aStream!
+
+on: aStream level: compressionLevel
+    "Answer a stream that compresses the data in aStream with the given
+     compression level."
+    ^self basicNew
+       initializeZlibObject: compressionLevel;
+       initialize: aStream!
+
+
+!RawDeflateStream methodsFor: 'private zlib interface'!
+
+initializeZlibObject: level windowSize: winSize
+    <cCall: 'gst_deflateInit' returning: #void args: #(#self #int #int)>!
+
+initializeZlibObject: level
+    self initializeZlibObject: level windowSize: -15!
+
+destroyZlibObject
+    <cCall: 'gst_deflateEnd' returning: #void args: #(#self)>!
+
+processInput: atEnd
+    <cCall: 'gst_deflate' returning: #int args: #(#self #boolean)>! !
+
+
+
+!DeflateStream methodsFor: 'private zlib interface'!
+
+initializeZlibObject: level
+    self initializeZlibObject: level windowSize: 15! !
+
+
+!GZipDeflateStream methodsFor: 'private zlib interface'!
+
+initializeZlibObject: level
+    self initializeZlibObject: level windowSize: 31! !
+
+
+
+!RawInflateStream methodsFor: 'positioning'!
+
+position: anInteger
+    "Set the current position in the stream to anInteger.  Notice that this
+     class can only provide the illusion of random access, by appropriately
+     rewinding the input stream or skipping compressed data."
+    delta > anInteger ifTrue: [ self reset ].
+    [ delta + endPtr < anInteger ] whileTrue: [ self fillBuffer ].
+    ptr := anInteger - delta!
+
+reset
+    "Reset the stream to the beginning of the compressed data."
+     input stream or skipping compressed data."
+    source reset.
+    self destroyZlibObject; initializeZlibObject.
+    self resetBuffer!
+
+copyFrom: start to: end
+    "Answer the data on which the receiver is streaming, from
+     the start-th item to the end-th.  Note that this method is 0-based,
+     unlike the one in Collection, because a Stream's #position method
+     returns 0-based values.  Notice that this class can only provide
+     the illusion of random access, by appropriately rewinding the input
+     stream or skipping compressed data.""
+    | pos |
+    pos := self position.
+    ^[ self position: start; next: end - start ]
+       ensure: [ self position: pos ]!
+
+isPositionable
+    "Answer true if the stream supports moving backwards with #skip:."
+    ^true!
+
+skip: anInteger
+    "Move the current position by anInteger places, either forwards or
+     backwards."
+    self position: self position + anInteger!
+
+!RawInflateStream methodsFor: 'private zlib interface'!
+
+initialize: aStream
+    self initializeZlibObject.
+    super initialize: aStream!
+
+initializeZlibObject: windowSize
+    <cCall: 'gst_inflateInit' returning: #void args: #(#self #int)>!
+
+initializeZlibObject
+    self initializeZlibObject: -15!
+
+destroyZlibObject
+    <cCall: 'gst_inflateEnd' returning: #void args: #(#self)>!
+
+processInput: atEnd
+    <cCall: 'gst_inflate' returning: #int args: #(#self #boolean)>! !
+
+
+
+!InflateStream methodsFor: 'private zlib interface'!
+
+initializeZlibObject
+    self initializeZlibObject: 15! !
+
+!GZipInflateStream methodsFor: 'private zlib interface'!
+
+initializeZlibObject
+    self initializeZlibObject: 31! !
+


reply via email to

[Prev in Thread] Current Thread [Next in Thread]