From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- sys/imio/imwrpx.x | 139 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 139 insertions(+) create mode 100644 sys/imio/imwrpx.x (limited to 'sys/imio/imwrpx.x') diff --git a/sys/imio/imwrpx.x b/sys/imio/imwrpx.x new file mode 100644 index 00000000..3cdd2971 --- /dev/null +++ b/sys/imio/imwrpx.x @@ -0,0 +1,139 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include +include +include +include + +# IMWRPX -- Write NPIX pixels, starting with the pixel at the coordinates +# specified by the vector V, from the buffer BUF to the pixel storage file. + +procedure imwrpx (im, buf, npix, v, xstep) + +pointer im # image descriptor +char buf[ARB] # generic buffer containing data to be written +int npix # number of pixels to be written +long v[ARB] # physical coords of first pixel to be written +int xstep # step size between output pixels + +bool rlio +long offset +pointer pl, sp, ibuf +long o_v[IM_MAXDIM] +int sz_pixel, sz_dtype, nbytes, nchars, ip, step + +int sizeof() +long imnote() +errchk imerr, imwrite +include + +begin + pl = IM_PL(im) + sz_dtype = sizeof (IM_PIXTYPE(im)) + sz_pixel = pix_size[IM_PIXTYPE(im)] + step = abs (xstep) + if (v[1] < 1 || ((npix-1) * step) + v[1] > IM_SVLEN(im,1)) + call imerr (IM_NAME(im), SYS_IMREFOOB) + + # Flip the pixel array end for end. + if (xstep < 0) + #call imaflp (buf, npix, sz_dtype) + call imaflp (buf, npix, sz_pixel) + + # Byte swap if necessary. + if (IM_SWAP(im) == YES) { + nbytes = npix * sz_dtype * SZB_CHAR + switch (sz_dtype * SZB_CHAR) { + case 2: + call bswap2 (buf, 1, buf, 1, nbytes) + case 4: + call bswap4 (buf, 1, buf, 1, nbytes) + case 8: + call bswap8 (buf, 1, buf, 1, nbytes) + } + } + + + if (pl != NULL) { + + # Need to unpack again on 64-bit systems. + if ((IM_PIXTYPE(im) == TY_INT || IM_PIXTYPE(im) == TY_LONG) && + SZ_INT != SZ_INT32) { + call iupk32 (buf, buf, npix) + } + + # Write to a pixel list. + rlio = (and (IM_PLFLAGS(im), PL_FAST+PL_RLIO) == PL_FAST+PL_RLIO) + call amovl (v, o_v, IM_MAXDIM) + nchars = npix * sz_pixel + + switch (IM_PIXTYPE(im)) { + case TY_SHORT: + if (rlio) + call pl_plrs (pl, v, buf, 0, npix, PIX_SRC) + else if (step == 1) + call pl_plps (pl, v, buf, 0, npix, PIX_SRC) + else { + do ip = 1, nchars, sz_pixel { + call pl_plpi (pl, o_v, buf[ip], 0, 1, PIX_SRC) + o_v[1] = o_v[1] + step + } + } + case TY_INT, TY_LONG: + if (rlio) + call pl_plri (pl, v, buf, 0, npix, PIX_SRC) + else if (step == 1) + call pl_plpi (pl, v, buf, 0, npix, PIX_SRC) + else { + do ip = 1, nchars, sz_pixel { + call pl_plpi (pl, o_v, buf[ip], 0, 1, PIX_SRC) + o_v[1] = o_v[1] + step + } + } + default: + call smark (sp) + call salloc (ibuf, npix, TY_INT) + + call acht (buf, Memi[ibuf], npix, IM_PIXTYPE(im), TY_INT) + if (rlio) + call pl_plri (pl, v, Memi[ibuf], 0, npix, PIX_SRC) + else if (step == 1) + call pl_plpi (pl, v, Memi[ibuf], 0, npix, PIX_SRC) + else { + do ip = 1, npix { + call pl_plpi (pl, o_v, Memi[ibuf+ip-1], 0, 1, PIX_SRC) + o_v[1] = o_v[1] + step + } + } + call sfree (sp) + } + + } else { + # Write to a file. Compute size of transfer. If transferring + # an entire line, increase size of transfer to the physical line + # length, to avoid having to enblock the data. NOTE: buffer must + # be large enough to guarantee no memory violation. + + offset = imnote (im, v) + + # If not subsampling (stepsize 1), write buffer to file in a + # single transfer. Otherwise, the pixels are not contiguous, + # and must be written individually. + + if (step == 1) { + if (v[1] == 1 && npix == IM_SVLEN(im,1)) + nchars = IM_PHYSLEN(im,1) * sz_pixel + else + nchars = npix * sz_pixel + call imwrite (im, buf, nchars, offset) + + } else { + nchars = npix * sz_pixel + for (ip=1; ip <= nchars; ip=ip+sz_pixel) { + call imwrite (im, buf[ip], sz_pixel, offset) + offset = offset + (sz_pixel * step) + } + } + } +end -- cgit