|
|
|
abstract
[The PNG file format interface.] ; eol
[PNG is a clear, highly recommended file format.] ; eol
warning "warning: " [reading is not available yet.]
|
|
abstract
[The PNG file format interface.] ; eol
[PNG is a clear, highly recommended file format.] ; eol
warning "warning: " [reading is not available yet.]
|
|
|
|
|
|
constant read_resolution true
|
|
constant buffer_size 8192
stream raw_write32 PNGResolution:size
stream writechars "pHYs"
var PNGResolution r
|
|
constant buffer_size 8192
stream raw_write32 PNGResolution:size
stream writechars "pHYs"
var PNGResolution r
|
|
|
|
r rx := cast h:size_x/(h:x1-h:x0)*1000 Int
r ry := cast h:size_y/(h:y1-h:y0)*1000 Int
|
|
r rx := cast h:size_x/(abs h:x1-h:x0)*1000 Int
r ry := cast h:size_y/(abs h:y1-h:y0)*1000 Int
|
|
r unit := 1
stream raw_write addressof:r PNGResolution:size
(var PNG_CRC table) init ; table update "pHYs":characters
table update addressof:r PNGResolution:size
stream raw_write32 table:terminate
method f open stream options h -> status
arg_rw ImageReadFilterPng f ; arg_rw Stream stream ; arg S
var Str sign := ".PNG...."
stream raw_read sign:characters sign:len
if sign<>character:137+"PNG[cr][lf]"+character:26+"[lf]"
return failure:"This is not a .png image"
stream raw_read addressof:(var uInt32_hi len) uInt32:size
var Str tag := "1234" ; stream raw_read tag:characters tag
if tag<>"IHDR" or len<>PNGHeader:size
return failure:"Expected PNG header tag to be the first
stream raw_read addressof:(var PNGHeader hdr) PNGHeader:si
if hdr:depth<>8 or (hdr:color<>2 and hdr:color<>6)
return failure:"Only 24 bits or 32 bits per pixel PNG fi
if hdr:compression<>0 or hdr:filter<>0 or hdr:interlace<>0
return failure:"This PNG file encoding is not supported
|
|
r unit := 1
stream raw_write addressof:r PNGResolution:size
(var PNG_CRC table) init ; table update "pHYs":characters
table update addressof:r PNGResolution:size
stream raw_write32 table:terminate
method f open stream options h -> status
arg_rw ImageReadFilterPng f ; arg_rw Stream stream ; arg S
var Str sign := ".PNG...."
stream raw_read sign:characters sign:len
if sign<>character:137+"PNG[cr][lf]"+character:26+"[lf]"
return failure:"This is not a .png image"
stream raw_read addressof:(var uInt32_hi len) uInt32:size
var Str tag := "1234" ; stream raw_read tag:characters tag
if tag<>"IHDR" or len<>PNGHeader:size
return failure:"Expected PNG header tag to be the first
stream raw_read addressof:(var PNGHeader hdr) PNGHeader:si
if hdr:depth<>8 or (hdr:color<>2 and hdr:color<>6)
return failure:"Only 24 bits or 32 bits per pixel PNG fi
if hdr:compression<>0 or hdr:filter<>0 or hdr:interlace<>0
return failure:"This PNG file encoding is not supported
|
|
|
|
h := image_prototype 0 0 hdr:size_x/75*25.4 hdr:size_y/75*
|
|
# FIXME: rather scan all tags until iDAT
if not ((options (options option_position "resolution" 0) options:len) parse word:"resolution" (var Float dpi_x) (var Float dpi_y) any)
dpi_x := options option "resolution" Float ; dpi_y := dpi_x
|
if read_resolution and not stream:atend and (cast stream:stream_read_stop uInt)-(cast stream:stream_read_cur uInt)>=12
var uInt32_hi len := (stream:stream_read_cur translate Byte 4) map uInt32_hi
tag set (stream:stream_read_cur translate Byte 8) 4 false
if tag="pHYs" and len=PNGResolution:size
stream:stream_read_cur := stream:stream_read_cur translate Byte 12
stream raw_read addressof:(var PNGResolution res) PNGResolution:size
dpi_x := res:rx/1000*25.4
dpi_y := res:ry/1000*25.4
|
h := image_prototype 0 0 hdr:size_x/dpi_x*25.4 hdr:size_y/dpi_y*25.4 hdr:size_x hdr:size_y color_gamut:(shunt hdr:color=2 "rgb" hdr:color=6 "rgba" "")
|
|
f s :> stream
f pixel_size := h pixel_size
f line_size := h line_size
f remain := 0
var Pointer:z_stream_s r :> f r
memory_clear addressof:r z_stream_s:size
r data_type := 2
if pliant_alloc
r zalloc := (the_function pliant_zalloc Address uInt uIn
r zfree := (the_function pliant_zfree Address Address) e
if (inflateInit r)<>0
return failure:"failed to initialize Zlib"
f remain := 0
f y := 0
f buffer := (memory_zallocate h:line_size+h:pixel_size add
f previous := (memory_zallocate h:line_size+h:pixel_size a
status := success
|
|
f s :> stream
f pixel_size := h pixel_size
f line_size := h line_size
f remain := 0
var Pointer:z_stream_s r :> f r
memory_clear addressof:r z_stream_s:size
r data_type := 2
if pliant_alloc
r zalloc := (the_function pliant_zalloc Address uInt uIn
r zfree := (the_function pliant_zfree Address Address) e
if (inflateInit r)<>0
return failure:"failed to initialize Zlib"
f remain := 0
f y := 0
f buffer := (memory_zallocate h:line_size+h:pixel_size add
f previous := (memory_zallocate h:line_size+h:pixel_size a
status := success
|