steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

new bitstream api works, refactor time

db4
Doug Coleman 2009-02-12 22:10:32 -06:00
parent 127ff76c08
commit b5cb425708
2 changed files with 32 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
basis/bitstreams/bitstreams-tests.factor
View File

@ -1,31 +1,27 @@
! Copyright (C) 2009 Doug Coleman. ! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors bitstreams io io.streams.string kernel tools.test USING: accessors bitstreams io io.streams.string kernel tools.test
grouping compression.lzw multiline byte-arrays ; grouping compression.lzw multiline byte-arrays io.encodings.binary
io.streams.byte-array ;
IN: bitstreams.tests IN: bitstreams.tests
[ 1 ] [ 1 t ]
[ B{ 254 } <string-reader> <bitstream-reader> read-bit ] unit-test [ B{ 254 } <string-reader> <bitstream-reader> read-bit ] unit-test
[ 254 ] [ 254 8 t ]
[ B{ 254 } <string-reader> <bitstream-reader> 8 swap read-bits ] unit-test [ B{ 254 } <string-reader> <bitstream-reader> 8 swap read-bits ] unit-test
[ 4095 ] [ 4095 12 t ]
[ B{ 255 255 } <string-reader> <bitstream-reader> 12 swap read-bits ] unit-test [ B{ 255 255 } <string-reader> <bitstream-reader> 12 swap read-bits ] unit-test
[ B{ 254 } ] [ B{ 254 } ]
[ [
<string-writer> <bitstream-writer> 254 8 rot <string-writer> <bitstream-writer> 254 8 rot
[ write-bits ] keep output>> >byte-array [ write-bits ] keep stream>> >byte-array
] unit-test ] unit-test
[ 255 8 t ]
[ B{ 255 } binary <byte-reader> <bitstream-reader> 8 swap read-bits ] unit-test
/* [ 255 8 f ]
[ [ B{ 255 } binary <byte-reader> <bitstream-reader> 9 swap read-bits ] unit-test
] [
B{ 7 7 7 8 8 7 7 9 7 }
[ byte-array>bignum >bin 72 CHAR: 0 pad-head 9 group [ bin> ] map ]
[ lzw-compress ] bi
] unit-test
*/

35
basis/bitstreams/bitstreams.factor
View File

@ -4,7 +4,7 @@ USING: accessors byte-arrays destructors fry io kernel locals
math sequences ; math sequences ;
IN: bitstreams IN: bitstreams
TUPLE: bitstream stream current-bits #bits disposed ; TUPLE: bitstream stream end-of-stream? current-bits #bits disposed ;
TUPLE: bitstream-reader < bitstream ; TUPLE: bitstream-reader < bitstream ;
: reset-bitstream ( stream -- stream ) : reset-bitstream ( stream -- stream )
@ -22,8 +22,12 @@ M: bitstream-reader dispose ( stream -- )
bitstream-reader new-bitstream ; inline bitstream-reader new-bitstream ; inline
: read-next-byte ( bitstream -- bitstream ) : read-next-byte ( bitstream -- bitstream )
dup stream>> stream-read1 dup stream>> stream-read1 [
[ >>current-bits ] [ 8 0 ? >>#bits ] bi ; inline >>current-bits 8 >>#bits
] [
0 >>#bits
t >>end-of-stream?
] if* ;
: maybe-read-next-byte ( bitstream -- bitstream ) : maybe-read-next-byte ( bitstream -- bitstream )
dup #bits>> 0 = [ read-next-byte ] when ; inline dup #bits>> 0 = [ read-next-byte ] when ; inline
@ -31,17 +35,19 @@ M: bitstream-reader dispose ( stream -- )
: shift-one-bit ( bitstream -- n ) : shift-one-bit ( bitstream -- n )
[ current-bits>> ] [ #bits>> ] bi 1- neg shift 1 bitand ; inline [ current-bits>> ] [ #bits>> ] bi 1- neg shift 1 bitand ; inline
: next-bit ( bitstream -- n ) : next-bit ( bitstream -- n/f ? )
maybe-read-next-byte [ maybe-read-next-byte
shift-one-bit dup end-of-stream?>> [
drop f
] [ ] [
[ 1- ] change-#bits maybe-read-next-byte drop [ shift-one-bit ]
] bi ; inline [ [ 1- ] change-#bits maybe-read-next-byte drop ] bi
] if dup >boolean ;
: read-bit ( bitstream -- n ) : read-bit ( bitstream -- n ? )
dup #bits>> 1 = [ dup #bits>> 1 = [
[ current-bits>> 1 bitand ] [ current-bits>> 1 bitand ]
[ read-next-byte drop ] bi [ read-next-byte drop ] bi t
] [ ] [
next-bit next-bit
] if ; inline ] if ; inline
@ -49,9 +55,12 @@ M: bitstream-reader dispose ( stream -- )
: bits>integer ( seq -- n ) : bits>integer ( seq -- n )
0 [ [ 1 shift ] dip bitor ] reduce ; inline 0 [ [ 1 shift ] dip bitor ] reduce ; inline
: read-bits ( width bitstream -- n ) : read-bits ( width bitstream -- n width ? )
'[ _ read-bit ] replicate bits>integer ; inline [
'[ _ read-bit drop ] replicate
[ f = ] trim-tail
[ bits>integer ] [ length ] bi
] 2keep drop over = ;
TUPLE: bitstream-writer < bitstream ; TUPLE: bitstream-writer < bitstream ;