png/0000755000176000001440000000000012247446061011074 5ustar ripleyuserspng/inst/0000755000176000001440000000000012247435151012047 5ustar ripleyuserspng/inst/img/0000755000176000001440000000000012247435151012623 5ustar ripleyuserspng/inst/img/Rlogo.png0000644000176000001440000002700612247435151014420 0ustar ripleyusersPNG  IHDRdLbKGD pHYs.#.#x?vtIME' IDATx}w]e]O/[2d24H.(b(XAI\Z(CPB ϤM?3sgϜ$`;s2^]Yk(|S72JӴ*˲*ljv[i&l;6=aALv2EQIx1̓'Eԧff=rc>f$q&ڎ3u&۱Cu][wA4Lض u\`;&D@uiz3òCӾm'Nvwߤ6n.˅>Ѷcm۪v](7s[u] LeY( .ׅ8u8q\0YBQKh~76a9l?w_m+eEQE{}/a`[vݒzx[3uJ8 .na4EU5/)1ʋԮ]Ǫ#˴۶8(PěOnߍz,,ׅe T{-uJR$ǁm۰ٶ ۶`6,˂8@,|GnzŸLؓ2-Ӻ6 &P #`CQ޾#SUw/FTmۀ¶P8c_p]-SaIxb[lˆi 1 òUU^u ?tOj3M|۱#K( mwB"4M@ tdxRy3#aۻm8Fm{@X6,˄eZ0LeT 3oO% ?`LK øuoɞo> !0MA5 u=io?Р `g^R`;,˂i0-eum Ʋ,X 4a0=Z]U} T_bq8exJH˱x4!(2r  i.@348za0,X]*JD}Ӵ&ζ풭2*!B@34òi2M4Ų-4at]aPpU_y{VT˶INPe!Mҩ$t]E( ='x8EQ ,MӠit]aucXnS2Tq]qnS Àxa8.4Mi0b& ]aui&tW89;XpXy'L&}nSOQP8P,"N\dYqX  " y.`:TM(exb0-=h[k ^P8woE5EO=v,(ݿVg eq<\ǁ( e0m-ӄ=P)yYcE~ֶ鄐7D׃<Es8yP(/@(CQdȊ IQeo4GT ǶKIiP(B,-'CA Àa M8A4 MSjZ~tMנh}羻fCin̓ !8CYY2`5f @<G<GmM*+*P0%Q 5 #ni]Ne['s LB|}%j8}y`px׮'ˊq:N˱8E狎 # KP,C4 / 0E@4M#bb$3iE:/Cń6TW,d (EA.];cR)Bt+?c^[|JƵ7\vQضMqx<{{u\ **$Q(B\p/I_t? ;=ErLt:mUU 0i,Z(2$YBP%]]y&$i!kllgS>.ҲsL8 ˀJD$B.ȐUPͻCY4U] ?FUE>,[/̛ Ӵ   Q^^  !$ YV04ucvryomxB7z|eNPS+'y,! H B 5)//?!y|(v04!(/+9֯S΁eYBBè䉓1f8I D HXz HbQ)妧xV>f](Jp]S±-&$A33Vxel#&( `9Ȥ% 777Oy }se(@@f=t?TMC(B$F$CuU5LMca6XD6,+>ss_@umL qM0uÆ FQ]]I'cBK; "bd*w[ "#A?kɢeoj2F?[lV@ B0-rT:t:$B%h`ϵ67_}劋ٹ4͌Ϧ8-[ ˃y)NҫL`0'r2!4(B(Ix7qpACԢyxAh湮xΪ5+ѱl\B]Gqĉ/?]xq:L Сk*YD&5MbwϟcƠ::z?]~֍Wz^ KI|_L T0PUU!(t:y |g@1 (++C&UqhUS::u`ӦeDȴq,#^^C#Qq>s J{X>7ah V^wgmKu]tyo<-J.q]ѲL4nB:$I_?kǽ3(pASݫ,Xl1h'# 0 tk׭F6^QNᄒ`aR3,CcJ"X`Vċ Ӳ DIB._nX{'} B ux͗p羀h Z@6-R+Vyͷc2xݍW]V䥎 Hh$!egA}]=VY\.A pcs4]ǦM144BA$Pdy{K_=\kp(kaRF.=ɡi (1O aXdrP 4QG˰c-֯] ! A}i_׼kk.+(;,H$e+_G1}6888pUI<Ϗ+u7A zY ^rFe"Q(xy C3csa GنĠkVa릵 :k[dp@0p$@ ° }C7a:vuCovD咠( [vbGM|WG1O@:9L>=q @Ea .L,wvD.Pg=*.UU]YD"W`/#=f@u0@\ bUja`u@~l 0zlvlE<M{3k9+rP]]p 4̲<(-Y<#<,=ҁQfUAoOO)@i0n:|.*Ma۶Ntn]D7o y!6\BTmq\mnXرm3Ƕ ~4ҩ!| аn݆SL4e˗7LcrUe6`#dYigl]F__z1~\mrd30tCМt~8q"#I0"WEq+kjCӴH&j攼** uwy (קˑe >Tr{wiYq4a˲#Τ<XʼU#>F&)AD\^ukv,X P$L1Gߎ@D7giO3$fj^$7{Ao ݳN魮y8/p8lzx0E-Eh"Wm8s0MsɧJahewXSsO 4 ,d0Bzy"iCS 1 <e4uXq,9eNP5EBX*0B%ޣ«sEKð.M3,Fae 2e]q]&$A(؎4 |4SMeyUE4[iB(uJG cN8,'`sD}m&Ojkv_DMHnCAēN~7.< k7B2/Z?^9uV5weƼbJC!(RRfӅp( ghC$EV&޻pǥ+FoW'zm.N;|vR>p8OνG?rjhtEGc ]? ^cPCCCp <)1*P( x}}PTD"}_||868.$r>H 9Qz1:cՍېI%0ؿ(8AYY\l]dWӟ;oZ1aG}gEuL>{r/Nr޹X|YCCu]kv+s-˂i & ULò,T'JCA@Szz IL&|C=O6:KpQmHt[[7i{(C8E(Sl`8e!94MS1˧>4ff{kӴv IDAT}G1A_dC'9)>iYV,+ƓO<S rzB{y.a^?)/Ǯ9X2̂8R䩲W Iz]G^c яl6 ˴MeuMM :̼"8S\D,5譗/w㈕U!fҨk =1PH0pH`( ͙4o>Ļ}/+򍺮pI&Ŝ9OAKJ/^q}0@8w׿PF#}(;6F8]eAUXA@Q, ` 9 MզH\yJ4|OWTP(,z5p|5c HY4nlX;Ǯu,)O e`zqX @=] EƷ"B TU &Scwu\x׾U_9*_[*N8? C2!ھ};}P JaB[JZNf5MiwkQlY FҘ@74j,*b9,0g&ߘq=Y D?I Jy]KjլY/+&n0L6+04zw!+G*5]6 O@$ð^D4]#CGvg|K{xO~8Quo7ބeZQ!8 -w>?<d|.e+1nl3m5:a 46?Ͽ{+OfhA"9UU"łeM̀eY؎!8>N1b`@3 V0 YU,l a\eSOW5M+ 12Uy ebES8xjN!!|W|Mo03 ALz$\jGǑǝgB4V?ôrU' ªqc^ Gwϝ.HTc^S1IaZ;/oNd5B}XYێ]n MkU; JUuHB0RBs%,ʫGoB Uض#T㨊}t_<.vAQߚ#.va2LsgYC`Dxt`)}b5/  b@Q(qEP*t]E6Eee%G5b X%h po"A$k/Xx RI[n}G͸M@zq\@A*@ DID.fYds9,4ai'^Md<^h,p8\2@Q`!O\K%o͢{)FrxU#x6mMJoǫDMӎw\]<;R A e38ҫ.u(lSTׯK$ 4l&ʊ 4i@"*0fAe(dIp$]Ϧ/ˮO #㺫o< {~S*<[oi6u]q{KjI ǻ@?m{| f1~r&΀zedtڎLuc%/Mӵ UuP ]öNxygxS\]np/iph+~ɶ/1E Ǽf: ʴk\Xm6S5QUdc\hniC׮׀CA3+ n}myۦQKZWNe4/#:~|3:npm(g3phtMA>d_mNjinP??iTl:$ID&Ei쇦uY!QH%# s/14FS&5_?@є }4MKxйmgY^t9@lKйi ]Э}g_wwhnX۶0 @(+WU>SxaN a>rԖ=[!~qCQ‘X?kZfIENDB`png/src/0000755000176000001440000000000012247435151011661 5ustar ripleyuserspng/src/Makevars0000644000176000001440000000015212247435151013353 0ustar ripleyusersPKG_LIBS=$(PNG_LIBS) `libpng-config --static --ldflags` PKG_CFLAGS=$(PNG_CFLAGS) `libpng-config --cflags` png/src/read.c0000644000176000001440000002647512247435153012760 0ustar ripleyusers#include #include #include #include /* for R_RGB / R_RGBA */ #include typedef struct read_job { FILE *f; int ptr, len; char *data; } read_job_t; static void user_error_fn(png_structp png_ptr, png_const_charp error_msg) { read_job_t *rj = (read_job_t*)png_get_error_ptr(png_ptr); if (rj->f) fclose(rj->f); Rf_error("libpng error: %s", error_msg); } static void user_warning_fn(png_structp png_ptr, png_const_charp warning_msg) { Rf_warning("libpng warning: %s", warning_msg); } static void user_read_data(png_structp png_ptr, png_bytep data, png_size_t length) { read_job_t *rj = (read_job_t*) png_get_io_ptr(png_ptr); png_size_t to_read = length; if (to_read > (rj->len - rj->ptr)) to_read = (rj->len - rj->ptr); if (to_read > 0) { memcpy(data, rj->data + rj->ptr, to_read); rj->ptr += to_read; } if (to_read < length) memset(data + length - to_read, 0, length - to_read); } #if USE_R_MALLOC static png_voidp malloc_fn(png_structp png_ptr, png_alloc_size_t size) { return (png_voidp) R_alloc(1, size); } static void free_fn(png_structp png_ptr, png_voidp ptr) { /* this is a no-op because R releases the memory at the end of the call */ } #endif #define RX_swap32(X) (X) = (((unsigned int)X) >> 24) | ((((unsigned int)X) >> 8) & 0xff00) | (((unsigned int)X) << 24) | ((((unsigned int)X) & 0xff00) << 8) SEXP read_png(SEXP sFn, SEXP sNative, SEXP sInfo) { SEXP res = R_NilValue, info_list = R_NilValue, info_tail = R_NilValue; const char *fn; char header[8]; int native = asInteger(sNative), info = (asInteger(sInfo) == 1); FILE *f; read_job_t rj; png_structp png_ptr; png_infop info_ptr; if (TYPEOF(sFn) == RAWSXP) { rj.data = (char*) RAW(sFn); rj.len = LENGTH(sFn); rj.ptr = 0; rj.f = f = 0; } else { if (TYPEOF(sFn) != STRSXP || LENGTH(sFn) < 1) Rf_error("invalid filename"); fn = CHAR(STRING_ELT(sFn, 0)); f = fopen(fn, "rb"); if (!f) Rf_error("unable to open %s", fn); if (fread(header, 1, 8, f) < 1 || png_sig_cmp((png_bytep) header, 0, 8)) { fclose(f); Rf_error("file is not in PNG format"); } rj.f = f; } /* use our own error hanlding code and pass the fp so it can be closed on error */ png_ptr = png_create_read_struct(PNG_LIBPNG_VER_STRING, (png_voidp)&rj, user_error_fn, user_warning_fn); if (!png_ptr) { if (f) fclose(f); Rf_error("unable to initialize libpng"); } info_ptr = png_create_info_struct(png_ptr); if (!info_ptr) { if (f) fclose(f); png_destroy_read_struct(&png_ptr, (png_infopp)NULL, (png_infopp)NULL); Rf_error("unable to initialize libpng"); } if (f) { png_init_io(png_ptr, f); png_set_sig_bytes(png_ptr, 8); } else png_set_read_fn(png_ptr, (png_voidp) &rj, user_read_data); #define add_info(K, V) { info_tail = SETCDR(info_tail, CONS(V, R_NilValue)); SET_TAG(info_tail, install(K)); } /* png_read_png(png_ptr, info_ptr, PNG_TRANSFORM_STRIP_16 | PNG_TRANSFORM_EXPAND, NULL); */ png_read_info(png_ptr, info_ptr); { png_uint_32 width, height; png_bytepp row_pointers; char *img_memory; SEXP dim; int bit_depth, color_type, interlace_type, compression_type, filter_method, rowbytes; int need_swap = 0; png_get_IHDR(png_ptr, info_ptr, &width, &height, &bit_depth, &color_type, &interlace_type, &compression_type, &filter_method); rowbytes = png_get_rowbytes(png_ptr, info_ptr); #if VERBOSE_INFO Rprintf("png: %d x %d [%d], %d bytes, 0x%x, %d, %d\n", (int) width, (int) height, bit_depth, rowbytes, color_type, interlace_type, compression_type, filter_method); #endif if (info) { SEXP dv; double d; png_uint_32 rx, ry; int ut, num_text = 0; png_textp text_ptr; info_tail = info_list = PROTECT(CONS((dv = allocVector(INTSXP, 2)), R_NilValue)); INTEGER(dv)[0] = (int) width; INTEGER(dv)[1] = (int) height; SET_TAG(info_list, install("dim")); add_info("bit.depth", ScalarInteger(bit_depth)); switch(color_type) { case PNG_COLOR_TYPE_GRAY: add_info("color.type", mkString("gray")); break; case PNG_COLOR_TYPE_GRAY_ALPHA: add_info("color.type", mkString("gray + alpha")); break; case PNG_COLOR_TYPE_PALETTE: add_info("color.type", mkString("palette")); break; case PNG_COLOR_TYPE_RGB: add_info("color.type", mkString("RGB")); break; case PNG_COLOR_TYPE_RGB_ALPHA: add_info("color.type", mkString("RGBA")); break; default: add_info("color.type", ScalarInteger(color_type)); } if (png_get_gAMA(png_ptr, info_ptr, &d)) add_info("gamma", ScalarReal(d)); #ifdef PNG_pHYs_SUPPORTED if (png_get_pHYs(png_ptr, info_ptr, &rx, &ry, &ut)) { if (ut == PNG_RESOLUTION_METER) { dv = allocVector(REALSXP, 2); REAL(dv)[0] = ((double)rx) / 39.37008; REAL(dv)[1] = ((double)ry) / 39.37008; add_info("dpi", dv); } else if (ut == PNG_RESOLUTION_UNKNOWN) add_info("asp", ScalarReal(rx / ry)); } if (png_get_text(png_ptr, info_ptr, &text_ptr, &num_text)) { SEXP txt_key, txt_val = PROTECT(allocVector(STRSXP, num_text)); if (num_text) { int i; setAttrib(txt_val, R_NamesSymbol, txt_key = allocVector(STRSXP, num_text)); for (i = 0; i < num_text; i++) { SET_STRING_ELT(txt_val, i, text_ptr[i].text ? mkChar(text_ptr[i].text) : NA_STRING); SET_STRING_ELT(txt_key, i, text_ptr[i].key ? mkChar(text_ptr[i].key) : NA_STRING); } } add_info("text", txt_val); UNPROTECT(1); } #endif } /* on little-endian machines it's all well, but on big-endian ones we'll have to swap */ #if ! defined (__BIG_ENDIAN__) && ! defined (__LITTLE_ENDIAN__) /* old compiler so have to use run-time check */ { char bo[4] = { 1, 0, 0, 0 }; int bi; memcpy(&bi, bo, 4); if (bi != 1) need_swap = 1; } #endif #ifdef __BIG_ENDIAN__ need_swap = 1; #endif /*==== set any transforms that we desire: ====*/ /* palette->RGB - no discussion there */ if (color_type == PNG_COLOR_TYPE_PALETTE) png_set_palette_to_rgb(png_ptr); /* expand gray scale to 8 bits */ if (color_type == PNG_COLOR_TYPE_GRAY && bit_depth < 8) png_set_expand_gray_1_2_4_to_8(png_ptr); /* this should not be necessary but it's in the docs to guarantee 8-bit */ if (bit_depth < 8) png_set_packing(png_ptr); /* convert tRNS chunk into alpha */ if (png_get_valid(png_ptr, info_ptr, PNG_INFO_tRNS)) png_set_tRNS_to_alpha(png_ptr); /* native format doesn't allow for 16-bit so it needs to be truncated */ if (bit_depth == 16 && native) { Rf_warning("Image uses 16-bit channels but R native format only supports 8-bit, truncating LSB."); png_set_strip_16(png_ptr); } /* for native output we need to a) convert gray to RGB, b) add alpha */ if (native) { if (color_type == PNG_COLOR_TYPE_GRAY || color_type == PNG_COLOR_TYPE_GRAY_ALPHA) png_set_gray_to_rgb(png_ptr); if (!(color_type & PNG_COLOR_MASK_ALPHA)) /* if there is no alpha, add it */ png_set_add_alpha(png_ptr, 0xFF, PNG_FILLER_AFTER); } #if 0 /* we use native (network) endianness since we read each byte anyway */ /* on little-endian machines we need to swap 16-bit values - this is the inverse of need_swap as used for R! */ if (!need_swap && bit_depth == 16) png_set_swap(png_ptr); #endif /* PNG wants up to call png_set_interlace_handling so it can get ready to de-interlace images */ png_set_interlace_handling(png_ptr); /* all transformations are in place, so it's time to update the info structure so we can allocate stuff */ png_read_update_info(png_ptr, info_ptr); /* re-read some important bits from the updated structure */ rowbytes = png_get_rowbytes(png_ptr, info_ptr); bit_depth = png_get_bit_depth(png_ptr, info_ptr); color_type = png_get_color_type(png_ptr, info_ptr); #if VERBOSE_INFO Rprintf(" -filter-> %d-bits, %d bytes, 0x%x\n", bit_depth, rowbytes, color_type); #endif /* allocate data fro row pointers and the image using R's allocation */ row_pointers = (png_bytepp) R_alloc(height, sizeof(png_bytep)); img_memory = R_alloc(height, rowbytes); { /* populate the row pointers */ char *i_ptr = img_memory; int i; for (i = 0; i < height; i++, i_ptr += rowbytes) row_pointers[i] = (png_bytep) i_ptr; } /* do the reading work */ png_read_image(png_ptr, row_pointers); if (f) { rj.f = 0; fclose(f); } /* native output - vector of integers */ if (native) { int pln = rowbytes / width; if (pln < 1 || pln > 4) { png_destroy_read_struct(&png_ptr, &info_ptr, (png_infopp)NULL); Rf_error("native output for %d planes is not possible.", pln); } res = PROTECT(allocVector(INTSXP, width * height)); if (pln == 4) { /* 4 planes - efficient - just copy it all */ int y, *idata = INTEGER(res); for (y = 0; y < height; idata += width, y++) memcpy(idata, row_pointers[y], width * sizeof(int)); if (need_swap) { int *ide = idata; idata = INTEGER(res); for (; idata < ide; idata++) RX_swap32(*idata); } } else if (pln == 3) { /* RGB */ int x, y, *idata = INTEGER(res); for (y = 0; y < height; y++) for (x = 0; x < rowbytes; x += 3) *(idata++) = R_RGB((unsigned int) row_pointers[y][x], (unsigned int) row_pointers[y][x + 1], (unsigned int) row_pointers[y][x + 2]); } else if (pln == 2) { /* GA */ int x, y, *idata = INTEGER(res); for (y = 0; y < height; y++) for (x = 0; x < rowbytes; x += 2) *(idata++) = R_RGBA((unsigned int) row_pointers[y][x], (unsigned int) row_pointers[y][x], (unsigned int) row_pointers[y][x], (unsigned int) row_pointers[y][x + 1]); } else { /* gray */ int x, y, *idata = INTEGER(res); for (y = 0; y < height; y++) for (x = 0; x < rowbytes; x++) *(idata++) = R_RGB((unsigned int) row_pointers[y][x], (unsigned int) row_pointers[y][x], (unsigned int) row_pointers[y][x]); } dim = allocVector(INTSXP, 2); INTEGER(dim)[0] = height; INTEGER(dim)[1] = width; setAttrib(res, R_DimSymbol, dim); setAttrib(res, R_ClassSymbol, mkString("nativeRaster")); setAttrib(res, install("channels"), ScalarInteger(pln)); UNPROTECT(1); } else { int x, y, p, pln = rowbytes / width, pls = width * height; double * data; if (bit_depth == 16) { res = PROTECT(allocVector(REALSXP, (rowbytes * height) / 2)); pln /= 2; } else res = PROTECT(allocVector(REALSXP, rowbytes * height)); data = REAL(res); if (bit_depth == 16) for(y = 0; y < height; y++) for (x = 0; x < width; x++) for (p = 0; p < pln; p++) data[y + x * height + p * pls] = ((double)( (((unsigned int)(((unsigned char *)row_pointers[y])[2 * (x * pln + p)])) << 8) | ((unsigned int)(((unsigned char *)row_pointers[y])[2 * (x * pln + p) + 1])) )) / 65535.0; else for(y = 0; y < height; y++) for (x = 0; x < width; x++) for (p = 0; p < pln; p++) data[y + x * height + p * pls] = ((double)row_pointers[y][x * pln + p]) / 255.0; dim = allocVector(INTSXP, (pln > 1) ? 3 : 2); INTEGER(dim)[0] = height; INTEGER(dim)[1] = width; if (pln > 1) INTEGER(dim)[2] = pln; setAttrib(res, R_DimSymbol, dim); UNPROTECT(1); } } if (info) { PROTECT(res); setAttrib(res, install("info"), info_list); UNPROTECT(2); } png_destroy_read_struct(&png_ptr, &info_ptr, (png_infopp)NULL); return res; } png/src/Makevars.win0000644000176000001440000000034212247435151014150 0ustar ripleyusers## detect 64-bit Windows ifeq ($(strip $(shell $(R_HOME)/bin/R --slave -e 'cat(.Machine$$sizeof.pointer)')),8) PKG_CPPFLAGS=-Iwin64 PKG_LIBS=-Lwin64 -lpng -lz else PKG_CPPFLAGS=-Iwin32 PKG_LIBS=-Lwin32 -lpng -lz endif png/src/write.c0000644000176000001440000002345412247435153013171 0ustar ripleyusers#include #include #include #include /* for R_RED, ..., R_ALPHA */ #include typedef struct write_job { FILE *f; int ptr, len; char *data; SEXP rvlist, rvtail; int rvlen; } write_job_t; /* default size of a raw vector chunk when collecting the image result */ #define INIT_SIZE (1024*256) static void user_error_fn(png_structp png_ptr, png_const_charp error_msg) { write_job_t *rj = (write_job_t*)png_get_error_ptr(png_ptr); if (rj->f) fclose(rj->f); Rf_error("libpng error: %s", error_msg); } static void user_warning_fn(png_structp png_ptr, png_const_charp warning_msg) { Rf_warning("libpng warning: %s", warning_msg); } static void user_write_data(png_structp png_ptr, png_bytep data, png_size_t length) { write_job_t *rj = (write_job_t*) png_get_io_ptr(png_ptr); png_size_t to_write = length; while (length) { /* use iteration instead of recursion */ if (to_write > (rj->len - rj->ptr)) to_write = (rj->len - rj->ptr); if (to_write > 0) { memcpy(rj->data + rj->ptr, data, to_write); rj->ptr += to_write; length -= to_write; data += to_write; rj->rvlen += to_write; } if (length) { /* more to go -- need next buffer */ SEXP rv = allocVector(RAWSXP, INIT_SIZE); SETCDR(rj->rvtail, CONS(rv, R_NilValue)); rj->rvtail = CDR(rj->rvtail); rj->len = LENGTH(rv); rj->data = (char*) RAW(rv); rj->ptr = 0; to_write = length; } } } static void user_flush_data(png_structp png_ptr) { } #if USE_R_MALLOC static png_voidp malloc_fn(png_structp png_ptr, png_alloc_size_t size) { return (png_voidp) R_alloc(1, size); } static void free_fn(png_structp png_ptr, png_voidp ptr) { /* this is a no-op because R releases the memory at the end of the call */ } #endif #define RX_swap32(X) (X) = (((unsigned int)(X)) >> 24) | ((((unsigned int)(X)) >> 8) & 0xff00) | (((unsigned int)(X)) << 24) | ((((unsigned int)(X)) & 0xff00) << 8) SEXP write_png(SEXP image, SEXP sFn, SEXP sDPI, SEXP sAsp, SEXP sText) { SEXP res = R_NilValue, dims; const char *fn; int planes = 1, width, height, native = 0, raw_array = 0, use_dpi = 0; double dpi_x = 0, dpi_y = 0; FILE *f; write_job_t rj; png_structp png_ptr; png_infop info_ptr; if (inherits(image, "nativeRaster") && TYPEOF(image) == INTSXP) native = 1; if (TYPEOF(image) == RAWSXP) raw_array = 1; if (!native && !raw_array && TYPEOF(image) != REALSXP) Rf_error("image must be a matrix or array of raw or real numbers"); if (TYPEOF(sDPI) == REALSXP || TYPEOF(sDPI) == INTSXP) { if (LENGTH(sDPI) < 1 || LENGTH(sDPI) > 2) Rf_error("invalid dpi specification - must be NULL or a numeric vector of length 1 or 2"); if (TYPEOF(sDPI) == REALSXP) { dpi_x = REAL(sDPI)[0]; dpi_y = (LENGTH(sDPI) > 1) ? REAL(sDPI)[1] : dpi_x; } else { dpi_x = INTEGER(sDPI)[0]; dpi_y = (LENGTH(sDPI) > 1) ? INTEGER(sDPI)[1] : dpi_x; } use_dpi = 1; } else if (sDPI != R_NilValue) Rf_error("invalid `dpi' specification - must be NULL or a numeric vector of length 1 or 2"); if (((TYPEOF(sAsp) == REALSXP || TYPEOF(sAsp) == INTSXP) && LENGTH(sAsp) != 1) || (sAsp != R_NilValue && TYPEOF(sAsp) != REALSXP && TYPEOF(sAsp) != INTSXP)) Rf_error("invalid `asp' specification - must be NULL or a numeric scalar"); if (use_dpi && sAsp != R_NilValue) Rf_error("`asp' and `dpi' are mutually exclusive"); if (sAsp != R_NilValue) { dpi_x = asReal(sAsp); dpi_y = 1.0; use_dpi = 2; } dims = Rf_getAttrib(image, R_DimSymbol); if (dims == R_NilValue || TYPEOF(dims) != INTSXP || LENGTH(dims) < 2 || LENGTH(dims) > 3) Rf_error("image must be a matrix or an array of two or three dimensions"); if (raw_array && LENGTH(dims) == 3) { /* raw arrays have either bpp, width, height or width, height dimensions */ planes = INTEGER(dims)[0]; width = INTEGER(dims)[1]; height = INTEGER(dims)[2]; } else { /* others have width, height[, bpp] */ width = INTEGER(dims)[1]; height = INTEGER(dims)[0]; if (LENGTH(dims) == 3) planes = INTEGER(dims)[2]; } if (planes < 1 || planes > 4) Rf_error("image must have either 1 (grayscale), 2 (GA), 3 (RGB) or 4 (RGBA) planes"); if (native && planes > 1) Rf_error("native raster must be a matrix"); if (native) { /* nativeRaster should have a "channels" attribute if it has anything else than 4 channels */ SEXP cha = getAttrib(image, install("channels")); if (cha != R_NilValue) { planes = asInteger(cha); if (planes < 1 || planes > 4) planes = 4; } else planes = 4; } if (raw_array) { if (planes != 4) Rf_error("Only RGBA format is supported as raw data"); native = 1; /* from now on we treat raw arrays like native */ } if (TYPEOF(sFn) == RAWSXP) { SEXP rv = allocVector(RAWSXP, INIT_SIZE); rj.rvtail = rj.rvlist = PROTECT(CONS(rv, R_NilValue)); rj.data = (char*) RAW(rv); rj.len = LENGTH(rv); rj.ptr = 0; rj.rvlen = 0; rj.f = f = 0; } else { if (TYPEOF(sFn) != STRSXP || LENGTH(sFn) < 1) Rf_error("invalid filename"); fn = CHAR(STRING_ELT(sFn, 0)); f = fopen(fn, "wb"); if (!f) Rf_error("unable to create %s", fn); rj.f = f; } /* use our own error hanlding code and pass the fp so it can be closed on error */ png_ptr = png_create_write_struct(PNG_LIBPNG_VER_STRING, (png_voidp)&rj, user_error_fn, user_warning_fn); if (!png_ptr) { if (f) fclose(f); Rf_error("unable to initialize libpng"); } info_ptr = png_create_info_struct(png_ptr); if (!info_ptr) { if (f) fclose(f); png_destroy_write_struct(&png_ptr, (png_infopp)NULL); Rf_error("unable to initialize libpng"); } if (f) png_init_io(png_ptr, f); else png_set_write_fn(png_ptr, (png_voidp) &rj, user_write_data, user_flush_data); png_set_IHDR(png_ptr, info_ptr, width, height, 8, (planes == 1) ? PNG_COLOR_TYPE_GRAY : ((planes == 2) ? PNG_COLOR_TYPE_GRAY_ALPHA : ((planes == 3) ? PNG_COLOR_TYPE_RGB : PNG_COLOR_TYPE_RGB_ALPHA)), PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT); #ifdef PNG_pHYs_SUPPORTED if (use_dpi == 1) png_set_pHYs(png_ptr, info_ptr, dpi_x * 39.37008, dpi_y * 39.37008, PNG_RESOLUTION_METER); else if (use_dpi == 2) png_set_pHYs(png_ptr, info_ptr, dpi_x * 10000.0, dpi_y * 10000.0, PNG_RESOLUTION_UNKNOWN); #else if (use_dpi) Rf_warning("pHYs is unsupported in your build of libpng, cannot set dpi/asp"); #endif if (TYPEOF(sText) == STRSXP && LENGTH(sText)) { SEXP nam = getAttrib(sText, R_NamesSymbol); int i, n = LENGTH(sText); { png_text text_ptr[n]; /* text_ptr can be transient but the char* pointers must be valid until info is written! */ for (i = 0; i < n; i++) { text_ptr[i].compression = PNG_TEXT_COMPRESSION_NONE; text_ptr[i].key = (char*) ((nam == R_NilValue || i >= LENGTH(nam)) ? "" : CHAR(STRING_ELT(nam, i))); text_ptr[i].text = (char*) CHAR(STRING_ELT(sText, i)); } png_set_text(png_ptr, info_ptr, text_ptr, n); } } { int rowbytes = width * planes, i; png_bytepp row_pointers; png_bytep flat_rows; row_pointers = (png_bytepp) R_alloc(height, sizeof(png_bytep)); flat_rows = (png_bytep) R_alloc(height, width * planes); for(i = 0; i < height; i++) row_pointers[i] = flat_rows + (i * width * planes); if (!native) { int x, y, p, pls = width * height; double *data = REAL(image); for(y = 0; y < height; y++) for (x = 0; x < width; x++) for (p = 0; p < planes; p++) { double v = data[y + x * height + p * pls]; if (v < 0) v = 0; if (v > 255.0) v = 1.0; row_pointers[y][x * planes + p] = (unsigned char)(v * 255.0 + 0.5); } } else { if (planes == 4) { /* 4 planes - efficient - just copy it all */ int y, *idata = raw_array ? ((int*) RAW(image)) : INTEGER(image), need_swap = 0; for (y = 0; y < height; idata += width, y++) memcpy(row_pointers[y], idata, width * sizeof(int)); /* on little-endian machines it's all well, but on big-endian ones we'll have to swap */ #if ! defined (__BIG_ENDIAN__) && ! defined (__LITTLE_ENDIAN__) /* old compiler so have to use run-time check */ { char bo[4] = { 1, 0, 0, 0 }; int bi; memcpy(&bi, bo, 4); if (bi != 1) need_swap = 1; } #endif #ifdef __BIG_ENDIAN__ need_swap = 1; #endif if (need_swap) { unsigned int *idp = (unsigned int*) flat_rows, *ide = idp + (height * width); for (; idp < ide; idp++) RX_swap32(*idp); } } else if (planes == 3) { /* RGB */ int x, y, *idata = INTEGER(res); for (y = 0; y < height; y++) for (x = 0; x < rowbytes; idata++) { row_pointers[y][x++] = R_RED(*idata); row_pointers[y][x++] = R_GREEN(*idata); row_pointers[y][x++] = R_BLUE(*idata); } } else if (planes == 2) { /* GA */ int x, y, *idata = INTEGER(res); for (y = 0; y < height; y++) for (x = 0; x < rowbytes; idata++) { row_pointers[y][x++] = R_RED(*idata); row_pointers[y][x++] = R_ALPHA(*idata); } } else { /* gray */ int x, y, *idata = INTEGER(res); for (y = 0; y < height; y++) for (x = 0; x < rowbytes; idata++) row_pointers[y][x++] = R_RED(*idata); } } png_set_rows(png_ptr, info_ptr, row_pointers); } png_write_png(png_ptr, info_ptr, PNG_TRANSFORM_IDENTITY, NULL); png_destroy_write_struct(&png_ptr, &info_ptr); if (f) { /* if it is a file, just return */ fclose(f); return R_NilValue; } /* otherwise collect the vector blocks into one vector */ res = allocVector(RAWSXP, rj.rvlen); { int to_go = rj.rvlen; unsigned char *data = RAW(res); while (to_go && rj.rvlist != R_NilValue) { SEXP ve = CAR(rj.rvlist); int this_len = (to_go > LENGTH(ve)) ? LENGTH(ve) : to_go; memcpy(data, RAW(ve), this_len); to_go -= this_len; data += this_len; rj.rvlist = CDR(rj.rvlist); } } UNPROTECT(1); return res; } png/NAMESPACE0000644000176000001440000000007312247435151012311 0ustar ripleyusersuseDynLib(png, write_png, read_png) exportPattern(".*PNG") png/NEWS0000644000176000001440000000367212247435151011601 0ustar ripleyusersNEWS/Changelog 0.1-7 2013-12-03 o fix endianness issue in writePNG() on big-endian machines when using nativeRaster 0.1-6 2013-07-02 o add support for text tags as well as R object metadata which is serialized into the text field (Thanks to Duncan Temple Lang for the idea) 0.1-5 2013-06-03 o add dpi and asp to writePNG() which allows to store the image resolution or aspect ratio (via the sPHYs PNG tag). o add info flag to readPNG() which interprets some optional tags to return additional information such as dpi, asp or gamma if stored. o try to detect local libpng via LOCAL_SOFT on Windows. Note that if you use LOCAL_SOFT, you are taking full responsibility over the libraries that png will be linked against. 0.1-4 2011-12-10 o writePNG() now supports binary connection as target and the default target is now raw() 0.1-3 2011-09-02 o remove debugging output o added a missing call to png_set_interlace_handling to allow libpng to de-interlace images o prevent warnings in readPNG() example for the windows device which is incapable of any transparency 0.1-2 2011-01-19 o support raw array as input to writePNG (RGBA only) o do not truncate 16-bit images in readPNG() if the resulting output is not nativeRaster o Windows binary on RForge has been updated to libpng 1.5.0 0.1-1 2010-04-06 o add tolerance to writePNG() to avoid shifts by one in color because of numerical representation of discretized values o adapt to a last-minute change in R 2.11.0 from raster() to rasterImage() o add support for more efficient nativeRaster format 0.1-0 2010-03-17 o first release on CRAN, supports readPNG() and writePNG() for files and raw vectors. readPNG() supports any input color type but will convert to 1-4 planes with 8-bit accuracy each. writePNG() will write out 1-4 planes 8-bit each. writePNG() has currenty no provision for generating or stroring a palette. png/R/0000755000176000001440000000000012247435151011273 5ustar ripleyuserspng/R/write.R0000644000176000001440000000112712247435151012551 0ustar ripleyuserswritePNG <- function(image, target = raw(), dpi = NULL, asp = NULL, text = NULL, metadata = NULL) { if (!is.null(text) && !is.character(text)) text <- sapply(text, as.character) if (!is.null(metadata)) { rmd <- rawToChar(serialize(metadata, NULL, TRUE)) text <- if (is.null(text)) c(R.metadata=rmd) else c(text, R.metadata=rmd) } if (inherits(target, "connection")) { r <- .Call(write_png, image, raw(), dpi, asp, text) writeBin(r, target) invisible(NULL) } else invisible(.Call(write_png, image, if (is.raw(target)) target else path.expand(target), dpi, asp, text)) } png/R/read.R0000644000176000001440000000102412247435151012326 0ustar ripleyusersreadPNG <- function(source, native=FALSE, info=FALSE) if (info) { ## extra processing to interpret R.metadata if (!is.raw(source)) source <- path.expand(source) x <- .Call(read_png, source, native, TRUE) txt <- attr(x, "info")$text if ("R.metadata" %in% names(txt)) { attr(x, "metadata") <- unserialize(charToRaw(txt["R.metadata"])) attr(x, "info")$text <- txt[-which(names(txt) == "R.metadata")] } x } else .Call(read_png, if (is.raw(source)) source else path.expand(source), native, FALSE) png/MD50000644000176000001440000000113512247446061011404 0ustar ripleyusersc9b6ac3cd888b98fa0d875308eb6f5ce *DESCRIPTION d674f0b464da3777a68d03b3030a5083 *NAMESPACE 3eef6f3624b5f41bad7e27d6f5f50708 *NEWS 517d1c2ed74f8175ac738fa752a61045 *R/read.R ffed5973ae4ecb0056f0619ca62a0a5b *R/write.R 351b3c99336c44dc0ef13d6f6b503db4 *configure.win 7381224c65138a2acdf3a8346f8275c4 *inst/img/Rlogo.png 0ee7cd3abffb5dd15a5785a694246a8a *man/readPNG.Rd 653b98a2f5c34e372796df456f220933 *man/writePNG.Rd 7fc91ecfbf95133433e23f2e50b4a66d *src/Makevars 6c1ccc946d45a3351a32f63d8498f712 *src/Makevars.win 99e46bd4b410b68b8fb9c1f3d66c859a *src/read.c b03bb7476f2872fef94827c1af6c8c13 *src/write.c png/DESCRIPTION0000644000176000001440000000110212247446061012574 0ustar ripleyusersPackage: png Version: 0.1-7 Title: Read and write PNG images Author: Simon Urbanek Maintainer: Simon Urbanek Depends: R (>= 2.9.0) Description: This package provides an easy and simple way to read, write and display bitmap images stored in the PNG format. It can read and write both files and in-memory raw vectors. License: GPL-2 | GPL-3 SystemRequirements: libpng URL: http://www.rforge.net/png/ Packaged: 2013-12-03 20:09:14 UTC; svnuser NeedsCompilation: yes Repository: CRAN Date/Publication: 2013-12-03 22:25:05 png/man/0000755000176000001440000000000012247435151011645 5ustar ripleyuserspng/man/writePNG.Rd0000644000176000001440000001003412247435151013631 0ustar ripleyusers\name{writePNG} \alias{writePNG} \title{ Write a bitmap image in PNG format } \description{ Create a PNG image from an array or matrix. } \usage{ writePNG(image, target = raw(), dpi = NULL, asp = NULL, text = NULL, metadata = NULL) } \arguments{ \item{image}{image represented by a real matrix or array with values in the range of 0 to 1. Values outside this range will be clipped. The object must be either two-dimensional (grayscale matrix) or three dimensional array (third dimension specifying the plane) and must have either one (grayscale), two (grayscale + alpha), three (RGB) or four (RGB + alpha) planes. (For alternative image specifications see deatils)} \item{target}{Either name of the file to write, a binary connection or a raw vector (\code{raw()} - the default - is good enough) indicating that the output should be a raw vector.} \item{dpi}{optional, if set, must be a numeric vector of length 1 or 2 specifying the resolution of the image in DPI (dots per inch) for x and y (in that order) - it is recycled to length 2.} \item{asp}{optional, if set, must be a numeric scalar specifying the aspect ratio (\code{x / y}). \code{dpi} and \code{asp} are mututally exclusive, speciyfing both is an error.} \item{text}{optional, named character vector of entries that will be saved in the text chunk of the PNG. Names are used as keys. Note that the \code{"R.metadata"} key is reserved for internal use - see below} \item{metadata}{optional, an R object that will be serialized into the \code{"R.metadata"} text key} } \value{ Either \code{NULL} if the target is a file or a raw vector containing the compressed PNG image if the target was a raw vector. } \details{ \code{writePNG} takes an image as input and compresses it into PNG format. The image input is usually a matrix (for grayscale images - dimensions are width, height) or an array (for color and alpha images - dimensions are width, height, planes) of reals. The planes are interpreted in the sequence red, green, blue, alpha. Alternative representation of an image is of \code{nativeRaster} class which is an integer matrix with each entry representing one pixel in binary encoded RGBA format (as used internally by R). It can be obtained from \code{\link{readPNG}} using \code{native = TRUE}. Finally, \code{writePNG} also supports raw array containing the RGBA image as bytes. The dimensions of the raw array have to be planes, width, height (because the storage is interleaved). Currently only 4 planes (RGBA) are supported and the processing is equivalent to that of a native raster. The result is either stored in a file (if \code{target} is a file name), in a raw vector (if \code{target} is a raw vector) or sent to a binary connection. If either \code{dpi} or \code{asp} is set, the \code{sPHy} chunk is generated based on that information. Note that not all image viewers interpret this setting, and even fewer support non-square pixels. } %\references{ %} \author{ Simon Urbanek } \note{ Currently \code{writePNG} only produces 8-bit, deflate-compressed, non-quantized, non-interlaced images. Note in particular that \code{\link{readPNG}} can read 16-bit channels but storing them back using \code{writePNG} will strip the 8 LSB (irrelevant for display purposes but possibly relevant for use of PNG in signal-processing if the input is truly 16-bit wide). } \seealso{ \code{\link{readPNG}} } \examples{ # read a sample file (R logo) img <- readPNG(system.file("img","Rlogo.png",package="png")) # write the image into a raw vector r <- writePNG(img) # read it back again img2 <- readPNG(r) # it better be the same identical(img, img2) # try to write a native raster img3 <- readPNG(system.file("img","Rlogo.png",package="png"), TRUE) r2 <- writePNG(img3) img4 <- readPNG(r2, TRUE) identical(img3, img4) ## text and metadata r <- writePNG(img, text=c(source=R.version.string), metadata=sessionInfo()) img5 <- readPNG(r, info=TRUE) attr(img5, "info") attr(img5, "metadata") } \keyword{IO} png/man/readPNG.Rd0000644000176000001440000000553612247435151013425 0ustar ripleyusers\name{readPNG} \alias{readPNG} \title{ Read a bitmap image stored in the PNG format } \description{ Reads an image from a PNG file/content into a raster array. } \usage{ readPNG(source, native = FALSE, info = FALSE) } \arguments{ \item{source}{Either name of the file to read from or a raw vector representing the PNG file content.} \item{native}{determines the image representation - if \code{FALSE} (the default) then the result is an array, if \code{TRUE} then the result is a native raster representation.} \item{info}{logical, if \code{TRUE} additional \code{"info"} attribute is attached to the result containing information from optional tags in the file (such as bit depth, resolution, gamma, text etc.). If the PNG file contains R metadata, it will also contain a \code{"metadata"} attribute with the unserialized R object.} } %\details{ %} \value{ If \code{native} is \code{FALSE} then an array of the dimensions height x width x channels. If there is only one channel the result is a matrix. The values are reals between 0 and 1. If \code{native} is \code{TRUE} then an object of the class \code{nativeRaster} is returned instead. The latter cannot be easily computed on but is the most efficient way to draw using \code{rasterImage}. Most common files decompress into RGB (3 channels), RGBA (4 channels), Grayscale (1 channel) or GA (2 channels). Note that G and GA images cannot be directly used in \code{\link{rasterImage}} unless \code{native} is set to \code{TRUE} because \code{rasterImage} requires RGB or RGBA format (\code{nativeRaster} is always 8-bit RGBA). As of png 0.1-2 files with 16-bit channels are converted in full resolution to the array format, but the \code{nativeRaster} format only supports 8-bit and therefore a truncation is performed (eight least significant bits are dropped) with a warning if \code{native} is \code{TRUE}. } %\references{ %} %\author{ %} %\note{ %} \seealso{ \code{\link{rasterImage}}, \code{\link{writePNG}} } \examples{ # read a sample file (R logo) img <- readPNG(system.file("img", "Rlogo.png", package="png")) # read it also in native format img.n <- readPNG(system.file("img", "Rlogo.png", package="png"), TRUE) # if your R supports it, we'll plot it if (exists("rasterImage")) { # can plot only in R 2.11.0 and higher plot(1:2, type='n') if (names(dev.cur()) == "windows") { # windows device doesn't support semi-transparency so we'll need # to flatten the image transparent <- img[,,4] == 0 img <- as.raster(img[,,1:3]) img[transparent] <- NA # interpolate must be FALSE on Windows, otherwise R will # try to interpolate transparency and fail rasterImage(img, 1.2, 1.27, 1.8, 1.73, interpolate=FALSE) } else { # any reasonable device will be fine using alpha rasterImage(img, 1.2, 1.27, 1.8, 1.73) rasterImage(img.n, 1.5, 1.5, 1.9, 1.8) } } } \keyword{IO} png/configure.win0000644000176000001440000000376512247435151013605 0ustar ripleyusers#!/bin/sh echo " checking PNG headers and libraries" allok=yes use_local=no ## In the future we should be able to use ## local=`${R_HOME}/bin/R CMD config LOCAL_SOFT` ## but up to at least R 3.0.1 that doesn't work if [ -z "$MAKE" ]; then MAKE=`${R_HOME}/bin/R CMD config MAKE` if [ -z "$MAKE" ]; then MAKE=make fi fi makefiles="-f ${R_HOME}/etc${R_ARCH}/Makeconf -f ${R_SHARE_DIR}/make/config.mk" local=`${MAKE} -s ${makefiles} print R_HOME=${R_HOME} VAR=LOCAL_SOFT` if [ -e $local/lib ]; then if ls $local/lib/libpng.* 2>/dev/null; then echo " found libpng in LOCAL_SOFT: $local/lib" use_local=yes elif ls $local/lib${R_ARCH}/libpng.* 2>/dev/null; then echo " found libpng in LOCAL_SOFT: $local/lib${R_ARCH}" use_local=yes else echo " LOCAL_SOFT does not contain libpng, fall back to external png" fi else echo " LOCAL_SOFT does not exist, fall back to external png" fi if [ ${use_local} = no ]; then if [ ! -e src/win32/libz.a ]; then if [ ! -e src/libpng-current-win.tar.gz ]; then echo " cannot find current PNG files" echo " attempting to download them" echo 'download.file("http://www.rforge.net/png/files/libpng-current-win.tar.gz","src/libpng-current-win.tar.gz",mode="wb",quiet=TRUE)'|${R_HOME}/bin/R --vanilla --slave fi if [ ! -e src/libpng-current-win.tar.gz ]; then allok=no else echo " unpacking current PNG" tar fxz src/libpng-current-win.tar.gz -C src if [ ! -e src/win32/libz.a ]; then allok=no fi fi fi if [ ! -e src/win32/libz.a ]; then allok=no fi fi if [ ${allok} != yes ]; then echo "" echo " *** ERROR: unable to find PNG files" echo "" echo " They must be either in src/win32, in a tar-ball" echo " src/libpng-current-win.tar.gz or" echo " available via the LOCAL_SOFT R make setting." echo "" echo " You can get the latest binary tar ball from" echo " http://www.rforge.net/png/files/" echo "" exit 1 fi echo " seems ok, ready to go" exit 0