diff options
Diffstat (limited to 'pkg/proto/t_binfil.x')
| -rw-r--r-- | pkg/proto/t_binfil.x | 257 |
1 files changed, 257 insertions, 0 deletions
diff --git a/pkg/proto/t_binfil.x b/pkg/proto/t_binfil.x new file mode 100644 index 00000000..d2d025e7 --- /dev/null +++ b/pkg/proto/t_binfil.x @@ -0,0 +1,257 @@ +include <imhdr.h> +include <error.h> +include <mach.h> + +# Binary file image transfer utilities -- +# 1. Convert from IRAF image to binary format +# 1. Convert from binary formats to IRAF image + +define LEN_USER_AREA 720 + +# BINFIL -- Convert IRAF image file of shorts to a binary string +# A short header of 90 bytes is prepended and has the +# following elements; +# +# bytes content +# 1-2 nrows +# 3-4 ncols +# 5-6 IRAF pixel type +# 7-26 space set to 0 +# 27-90 header (ASCII) + +procedure t_binfil() + +char ifile[SZ_FNAME], header[64], out_image[SZ_FNAME] +int infile, nfiles, fd, i, file_nr, ncols, nrows, ptype +short space[10], sncols, snrows, sptype +long v1[IM_MAXDIM] +real scale_fact, temp +bool add_header +pointer im, pix, sp, inpix + +int clpopni(), clplen(), clgfil(), open(), imgnlr(), strlen() +real clgetr() +bool clgetb() +pointer immap() + +begin + # Get file names + infile = clpopni ("input") + nfiles = clplen (infile) + + # Get optional scaling factor + scale_fact = clgetr ("scale_fact") + if (scale_fact == 0.0) + scale_fact = 1.0 + + # Should a header string be added? + add_header = clgetb ("header") + + # Zero header spaces + do i = 1, 10 + space[i] = 0 + + # Loop over all images + while (clgfil (infile, ifile, SZ_FNAME) != EOF) { + iferr (im = immap (ifile, READ_ONLY, LEN_USER_AREA)) { + call eprintf ("[%s] not found\n") + call pargstr (ifile) + go to 10 + } + + ncols = IM_LEN (im, 1) + nrows = IM_LEN (im, 2) + ptype = IM_PIXTYPE (im) + + # Pack header characters + call strpak (IM_TITLE(im), header, strlen (IM_TITLE(im))) + + # Create output file name and open it - append ".b" + call sprintf (out_image, SZ_FNAME, "%s.b") + call pargstr (ifile) + call printf ("%s --> %s\n") + call pargstr (ifile) + call pargstr (out_image) + call flush (STDOUT) + + file_nr = file_nr + 1 + + fd = open (out_image, NEW_FILE, BINARY_FILE) + + # Write header parameters + if (add_header) { + sncols = ncols + snrows = nrows + sptype = ptype + call write (fd, sncols, SZ_SHORT/SZ_CHAR) + call write (fd, snrows, SZ_SHORT/SZ_CHAR) + call write (fd, sptype, SZ_SHORT/SZ_CHAR) + call write (fd, space, 10 * SZ_SHORT/SZ_CHAR) + call write (fd, header, 64 / SZB_CHAR) + } + + call smark (sp) + call salloc (pix, ncols, TY_SHORT) + + # Access pixels and write them out for each row + call amovkl (long(1), v1, IM_MAXDIM) + while (imgnlr (im, inpix, v1) != EOF) { + do i = 1, ncols { + temp = Memr[inpix+i-1] * scale_fact + + if (temp > MAX_SHORT) + temp = MAX_SHORT + else if (temp < -(MAX_SHORT)) + temp = -MAX_SHORT + + Mems[pix+i-1] = temp + } + + call write (fd, Mems[pix], ncols * SZ_SHORT/SZ_CHAR) + + } + call close (fd) + call sfree (sp) + + call imunmap (im) +10 ; + } +end + +# IRAFIL -- Convert 16 or 8-bit binary string to IRAF image file + +procedure t_irafil() + +char ifile[SZ_FNAME], out_image[SZ_FNAME] +int infile, nfiles, fd, i, j, file_nr, ncols, nrows, ptype, krow +int nr_bits, nr_chars, nr_skip, nc_skip, ival +long offset +bool flip, sign16 +pointer im, pix, sp, temp, opix, sp1, hdr, src + +int clpopni(), clplen(), clgfil(), clgeti() +int open(), read() +bool clgetb() +pointer immap(), impl2s(), impl2l() + +begin + # Get file names + infile = clpopni ("input") + nfiles = clplen (infile) + + # Get image dimensions + nrows = clgeti ("nrows") + ncols = clgeti ("ncols") + + # Is input string of data 8 or 16 bits? + nr_bits = clgeti ("bits") + if (nr_bits != 8 && nr_bits != 16) + call error (0, "Must be 8 or 16 bits") + + # Is bit 16 to be used as a sign bit? + if (nr_bits == 16) { + sign16 = clgetb ("signed") + offset = 65536 + } else { + sign16 = true + offset = 256 + } + + # Should image be top-bottom flipped? + # For some input images (e.g. Compaq 286 display) this is + # needed to make SNAPS look correct. + flip = clgetb ("tb_flip") + + # Header info can be skipped if number of bytes is given + nr_skip = clgeti ("skip") + + # Loop over all images + while (clgfil (infile, ifile, SZ_FNAME) != EOF) { + iferr (fd = open (ifile, READ_ONLY, BINARY_FILE)) { + call eprintf ("cannot open %s\n") + call pargstr (ifile) + go to 10 + } + + if (sign16) + ptype = TY_SHORT + else + ptype = TY_LONG + + # Create output file name and open it - append ".i" + call sprintf (out_image, SZ_FNAME, "%s.i") + call pargstr (ifile) + file_nr = file_nr + 1 + call printf ("%s --> %s\n") + call pargstr (ifile) + call pargstr (out_image) + call flush (STDOUT) + + im = immap (out_image, NEW_IMAGE, 0) + IM_NDIM (im) = 2 + IM_LEN (im, 1) = ncols + IM_LEN (im, 2) = nrows + IM_PIXTYPE (im) = ptype + + call smark (sp) + call salloc (pix, ncols, TY_SHORT) + call salloc (temp, ncols, TY_SHORT) + + # Skip over header pixels if any + nc_skip = nr_skip / 2 + if (nr_skip > 0) { + call smark (sp1) + call salloc (hdr, nc_skip, TY_SHORT) + if (read (fd, Mems[hdr], nc_skip) != EOF) + ; + call sfree (sp1) + } + + # Access pixels and write them out for each row + nr_chars = ncols * nr_bits / 8 / 2 + do i = 1, nrows { + iferr (nc_skip = read (fd, Mems[pix], nr_chars)) + call amovks (0, Mems[pix], nr_chars) + else { + if (nr_bits == 8) { + call chrupk (Mems[pix], 1, Mems[temp], 1, ncols) + src = temp + } else + src = pix + } + + # Provide top-bottom flip for special image formats + if (flip) + krow = nrows-i+1 + else + krow = i + + # Select proper pointer type + if (sign16) + opix = impl2s (im, krow) + else + opix = impl2l (im, krow) + + # Transfer all pixels, correcting for signed/unsigned data + do j = 1, ncols { + ival = Mems[src+j-1] + if (sign16) { + if (nr_bits == 8 && ival < 0) + Mems[opix+j-1] = ival + offset + else + Mems[opix+j-1] = ival + } else { + if (ival < 0) + Meml[opix+j-1] = ival + offset + else + Meml[opix+j-1] = ival + } + } + } + + call sfree (sp) + call close (fd) + call imunmap (im) +10 ; + } +end |