Move constructors vocabulary to extra and refactor basis code not to use it

db4
Slava Pestov 2009-06-13 18:47:19 -05:00
parent 285c8cecc6
commit b18c84454b
12 changed files with 55 additions and 25 deletions

View File

@ -1,10 +1,10 @@
! 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 alien.accessors assocs byte-arrays combinators USING: accessors alien.accessors assocs byte-arrays combinators
constructors destructors fry io io.binary io.encodings.binary destructors fry io io.binary io.encodings.binary io.streams.byte-array
io.streams.byte-array kernel locals macros math math.ranges kernel locals macros math math.ranges multiline sequences
multiline sequences sequences.private vectors byte-vectors sequences.private vectors byte-vectors combinators.short-circuit
combinators.short-circuit math.bitwise ; math.bitwise ;
IN: bitstreams IN: bitstreams
TUPLE: widthed { bits integer read-only } { #bits integer read-only } ; TUPLE: widthed { bits integer read-only } { #bits integer read-only } ;
@ -36,8 +36,12 @@ TUPLE: bit-writer
TUPLE: msb0-bit-reader < bit-reader ; TUPLE: msb0-bit-reader < bit-reader ;
TUPLE: lsb0-bit-reader < bit-reader ; TUPLE: lsb0-bit-reader < bit-reader ;
CONSTRUCTOR: msb0-bit-reader ( bytes -- bs ) ;
CONSTRUCTOR: lsb0-bit-reader ( bytes -- bs ) ; : <msb0-bit-reader> ( bytes -- bs )
msb0-bit-reader new swap >>bytes ; inline
: <lsb0-bit-reader> ( bytes -- bs )
lsb0-bit-reader new swap >>bytes ; inline
TUPLE: msb0-bit-writer < bit-writer ; TUPLE: msb0-bit-writer < bit-writer ;
TUPLE: lsb0-bit-writer < bit-writer ; TUPLE: lsb0-bit-writer < bit-writer ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2009 Marc Fauconneau. ! Copyright (C) 2009 Marc Fauconneau.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs constructors fry USING: accessors arrays assocs fry
hashtables io kernel locals math math.order math.parser hashtables io kernel locals math math.order math.parser
math.ranges multiline sequences ; math.ranges multiline sequences ;
IN: compression.huffman IN: compression.huffman
@ -58,7 +58,10 @@ TUPLE: huffman-decoder
{ rtable } { rtable }
{ bits/level } ; { bits/level } ;
CONSTRUCTOR: huffman-decoder ( bs tdesc -- decoder ) : <huffman-decoder> ( bs tdesc -- decoder )
huffman-decoder new
swap >>tdesc
swap >>bs
16 >>bits/level 16 >>bits/level
[ ] [ tdesc>> ] [ bits/level>> 2^ ] tri reverse-table >>rtable ; [ ] [ tdesc>> ] [ bits/level>> 2^ ] tri reverse-table >>rtable ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Marc Fauconneau. ! Copyright (C) 2009 Marc Fauconneau.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs byte-arrays USING: accessors arrays assocs byte-arrays
byte-vectors combinators constructors fry grouping hashtables byte-vectors combinators fry grouping hashtables
compression.huffman images io.binary kernel locals compression.huffman images io.binary kernel locals
math math.bitwise math.order math.ranges multiline sequences math math.bitwise math.order math.ranges multiline sequences
sorting ; sorting ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Marc Fauconneau. ! Copyright (C) 2009 Marc Fauconneau.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays byte-arrays combinators USING: accessors arrays byte-arrays combinators
constructors grouping compression.huffman images grouping compression.huffman images
images.processing io io.binary io.encodings.binary io.files images.processing io io.binary io.encodings.binary io.files
io.streams.byte-array kernel locals math math.bitwise io.streams.byte-array kernel locals math math.bitwise
math.constants math.functions math.matrices math.order math.constants math.functions math.matrices math.order
@ -21,7 +21,8 @@ TUPLE: jpeg-image < image
<PRIVATE <PRIVATE
CONSTRUCTOR: jpeg-image ( headers bitstream -- image ) ; : <jpeg-image> ( headers bitstream -- image )
jpeg-image new swap >>bitstream swap >>headers ;
SINGLETONS: SOF DHT DAC RST SOI EOI SOS DQT DNL DRI DHP EXP SINGLETONS: SOF DHT DAC RST SOI EOI SOS DQT DNL DRI DHP EXP
APP JPG COM TEM RES ; APP JPG COM TEM RES ;
@ -56,12 +57,20 @@ APP JPG COM TEM RES ;
TUPLE: jpeg-chunk length type data ; TUPLE: jpeg-chunk length type data ;
CONSTRUCTOR: jpeg-chunk ( type length data -- jpeg-chunk ) ; : <jpeg-chunk> ( type length data -- jpeg-chunk )
jpeg-chunk new
swap >>data
swap >>length
swap >>type ;
TUPLE: jpeg-color-info TUPLE: jpeg-color-info
h v quant-table dc-huff-table ac-huff-table { diff initial: 0 } id ; h v quant-table dc-huff-table ac-huff-table { diff initial: 0 } id ;
CONSTRUCTOR: jpeg-color-info ( h v quant-table -- jpeg-color-info ) ; : <jpeg-color-info> ( h v quant-table -- jpeg-color-info )
jpeg-color-info new
swap >>quant-table
swap >>v
swap >>h ;
: jpeg> ( -- jpeg-image ) jpeg-image get ; : jpeg> ( -- jpeg-image ) jpeg-image get ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg. ! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: constructors kernel splitting unicode.case combinators USING: kernel splitting unicode.case combinators accessors images
accessors images io.pathnames namespaces assocs ; io.pathnames namespaces assocs ;
IN: images.loader IN: images.loader
ERROR: unknown-image-extension extension ; ERROR: unknown-image-extension extension ;

View File

@ -1,10 +1,9 @@
! 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 constructors images io io.binary io.encodings.ascii USING: accessors images io io.binary io.encodings.ascii
io.encodings.binary io.encodings.string io.files io.files.info kernel io.encodings.binary io.encodings.string io.files io.files.info kernel
sequences io.streams.limited fry combinators arrays math sequences io.streams.limited fry combinators arrays math checksums
checksums checksums.crc32 compression.inflate grouping byte-arrays checksums.crc32 compression.inflate grouping byte-arrays images.loader ;
images.loader ;
IN: images.png IN: images.png
SINGLETON: png-image SINGLETON: png-image
@ -15,12 +14,14 @@ TUPLE: loading-png
width height bit-depth color-type compression-method width height bit-depth color-type compression-method
filter-method interlace-method uncompressed ; filter-method interlace-method uncompressed ;
CONSTRUCTOR: loading-png ( -- image ) : <loading-png> ( -- image )
loading-png new
V{ } clone >>chunks ; V{ } clone >>chunks ;
TUPLE: png-chunk length type data ; TUPLE: png-chunk length type data ;
CONSTRUCTOR: png-chunk ( -- png-chunk ) ; : <png-chunk> ( -- png-chunk )
png-chunk new ; inline
CONSTANT: png-header CONSTANT: png-header
B{ HEX: 89 HEX: 50 HEX: 4e HEX: 47 HEX: 0d HEX: 0a HEX: 1a HEX: 0a } B{ HEX: 89 HEX: 50 HEX: 4e HEX: 47 HEX: 0d HEX: 0a HEX: 1a HEX: 0a }

View File

@ -1,7 +1,7 @@
! 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 arrays assocs byte-arrays classes combinators USING: accessors arrays assocs byte-arrays classes combinators
compression.lzw constructors endian fry grouping images io compression.lzw endian fry grouping images io
io.binary io.encodings.ascii io.encodings.binary io.binary io.encodings.ascii io.encodings.binary
io.encodings.string io.encodings.utf8 io.files kernel math io.encodings.string io.encodings.utf8 io.files kernel math
math.bitwise math.order math.parser pack prettyprint sequences math.bitwise math.order math.parser pack prettyprint sequences
@ -12,14 +12,27 @@ IN: images.tiff
SINGLETON: tiff-image SINGLETON: tiff-image
TUPLE: loading-tiff endianness the-answer ifd-offset ifds ; TUPLE: loading-tiff endianness the-answer ifd-offset ifds ;
CONSTRUCTOR: loading-tiff ( -- tiff ) V{ } clone >>ifds ;
: <loading-tiff> ( -- tiff )
loading-tiff new V{ } clone >>ifds ;
TUPLE: ifd count ifd-entries next TUPLE: ifd count ifd-entries next
processed-tags strips bitmap ; processed-tags strips bitmap ;
CONSTRUCTOR: ifd ( count ifd-entries next -- ifd ) ;
: <ifd> ( count ifd-entries next -- ifd )
ifd new
swap >>next
swap >>ifd-entries
swap >>count ;
TUPLE: ifd-entry tag type count offset/value ; TUPLE: ifd-entry tag type count offset/value ;
CONSTRUCTOR: ifd-entry ( tag type count offset/value -- ifd-entry ) ;
: <ifd-entry> ( tag type count offset/value -- ifd-entry )
ifd-entry new
swap >>offset/value
swap >>count
swap >>type
swap >>tag ;
SINGLETONS: photometric-interpretation SINGLETONS: photometric-interpretation
photometric-interpretation-white-is-zero photometric-interpretation-white-is-zero