Move constructors vocabulary to extra and refactor basis code not to use it
parent
285c8cecc6
commit
b18c84454b
|
@ -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 ;
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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 }
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue