<commit_before>! Copyright (C) 2009 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs byte-arrays checksums
checksums.crc32 combinators compression.inflate fry grouping
images images.loader io io.binary io.encodings.ascii
io.encodings.binary io.encodings.string io.streams.byte-array
io.streams.throwing kernel locals math math.bitwise
math.functions math.order math.ranges sequences sorting ;
QUALIFIED: bitstreams
IN: images.png

SINGLETON: png-image
"png" png-image ?register-image-class

TUPLE: loading-png
    chunks
    width height bit-depth color-type compression-method
    filter-method interlace-method uncompressed ;

CONSTANT: filter-none 0
CONSTANT: filter-sub 1
CONSTANT: filter-up 2
CONSTANT: filter-average 3
CONSTANT: filter-paeth 4

CONSTANT: greyscale 0
CONSTANT: truecolor 2
CONSTANT: indexed-color 3
CONSTANT: greyscale-alpha 4
CONSTANT: truecolor-alpha 6

CONSTANT: interlace-none 0
CONSTANT: interlace-adam7 1

CONSTANT: starting-row  { 0 0 4 0 2 0 1 }
CONSTANT: starting-col  { 0 4 0 2 0 1 0 }
CONSTANT: row-increment { 8 8 8 4 4 2 2 }
CONSTANT: col-increment { 8 8 4 4 2 2 1 }
CONSTANT: block-height  { 8 8 4 4 2 2 1 }
CONSTANT: block-width   { 8 4 4 2 2 1 1 }

: <loading-png> ( -- image )
    loading-png new
    V{ } clone >>chunks ;

TUPLE: png-chunk length type data ;

: <png-chunk> ( -- png-chunk )
    png-chunk new ; inline

CONSTANT: png-header
    B{ 0x89 0x50 0x4e 0x47 0x0d 0x0a 0x1a 0x0a }

ERROR: bad-png-header header ;

: read-png-header ( -- )
    8 read dup png-header sequence= [
        bad-png-header
    ] unless drop ;

ERROR: bad-checksum ;

: read-png-chunks ( loading-png -- loading-png )
    <png-chunk>
    4 read be> [ >>length ] [ 4 + ] bi
    read dup crc32 checksum-bytes
    4 read = [ bad-checksum ] unless
    4 cut-slice
    [ ascii decode >>type ] [ B{ } like >>data ] bi*
    [ over chunks>> push ]
    [ type>> ] bi "IEND" =
    [ read-png-chunks ] unless ;

: find-chunk ( loading-png string -- chunk )
    [ chunks>> ] dip '[ type>> _ = ] find nip ;

: find-chunks ( loading-png string -- chunk )
    [ chunks>> ] dip '[ type>> _ = ] filter ;

: parse-ihdr-chunk ( loading-png -- loading-png )
    dup "IHDR" find-chunk data>> {
        [ [ 0 4 ] dip subseq be> >>width ]
        [ [ 4 8 ] dip subseq be> >>height ]
        [ [ 8 ] dip nth >>bit-depth ]
        [ [ 9 ] dip nth >>color-type ]
        [ [ 10 ] dip nth >>compression-method ]
        [ [ 11 ] dip nth >>filter-method ]
        [ [ 12 ] dip nth >>interlace-method ]
    } cleave ;

: find-compressed-bytes ( loading-png -- bytes )
    "IDAT" find-chunks [ data>> ] map concat ;<commit_msg>images.png: length>> field isnt needed<commit_after>! Copyright (C) 2009 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs byte-arrays checksums
checksums.crc32 combinators compression.inflate fry grouping
images images.loader io io.binary io.encodings.ascii
io.encodings.binary io.encodings.string io.streams.byte-array
io.streams.throwing kernel locals math math.bitwise
math.functions math.order math.ranges sequences sorting ;
QUALIFIED: bitstreams
IN: images.png

SINGLETON: png-image
"png" png-image ?register-image-class

TUPLE: loading-png
    chunks
    width height bit-depth color-type compression-method
    filter-method interlace-method uncompressed ;

CONSTANT: filter-none 0
CONSTANT: filter-sub 1
CONSTANT: filter-up 2
CONSTANT: filter-average 3
CONSTANT: filter-paeth 4

CONSTANT: greyscale 0
CONSTANT: truecolor 2
CONSTANT: indexed-color 3
CONSTANT: greyscale-alpha 4
CONSTANT: truecolor-alpha 6

CONSTANT: interlace-none 0
CONSTANT: interlace-adam7 1

CONSTANT: starting-row  { 0 0 4 0 2 0 1 }
CONSTANT: starting-col  { 0 4 0 2 0 1 0 }
CONSTANT: row-increment { 8 8 8 4 4 2 2 }
CONSTANT: col-increment { 8 8 4 4 2 2 1 }
CONSTANT: block-height  { 8 8 4 4 2 2 1 }
CONSTANT: block-width   { 8 4 4 2 2 1 1 }

: <loading-png> ( -- image )
    loading-png new
    V{ } clone >>chunks ;

TUPLE: png-chunk type data ;

: <png-chunk> ( -- png-chunk )
    png-chunk new ; inline

CONSTANT: png-header
    B{ 0x89 0x50 0x4e 0x47 0x0d 0x0a 0x1a 0x0a }

ERROR: bad-png-header header ;

: read-png-header ( -- )
    8 read dup png-header sequence= [
        bad-png-header
    ] unless drop ;

ERROR: bad-checksum ;

: read-png-chunks ( loading-png -- loading-png )
    <png-chunk>
    4 read be> 4 +
    read dup crc32 checksum-bytes
    4 read = [ bad-checksum ] unless
    4 cut-slice
    [ ascii decode >>type ] [ B{ } like >>data ] bi*
    [ over chunks>> push ]
    [ type>> ] bi "IEND" =
    [ read-png-chunks ] unless ;

: find-chunk ( loading-png string -- chunk )
    [ chunks>> ] dip '[ type>> _ = ] find nip ;

: find-chunks ( loading-png string -- chunk )
    [ chunks>> ] dip '[ type>> _ = ] filter ;

: parse-ihdr-chunk ( loading-png -- loading-png )
    dup "IHDR" find-chunk data>> {
        [ [ 0 4 ] dip subseq be> >>width ]
        [ [ 4 8 ] dip subseq be> >>height ]
        [ [ 8 ] dip nth >>bit-depth ]
        [ [ 9 ] dip nth >>color-type ]
        [ [ 10 ] dip nth >>compression-method ]
        [ [ 11 ] dip nth >>filter-method ]
        [ [ 12 ] dip nth >>interlace-method ]
    } cleave ;

: find-compressed-bytes ( loading-png -- bytes )
    "IDAT" find-chunks [ data>> ] map concat ;
{'fraction_non_alphanumeric': 0.122655663915979, 'fraction_numerical': 0.037134283570892726, 'mean_word_length': 2.7689045936395758, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 93, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 14, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1654093', 'n_tokens_mistral': 2062, 'n_tokens_neox': 1857, 'n_words': 583}