Initial commit

1 files changed, 256 insertions, 0 deletions

diff --git a/pkg/dataio/cardimage/t_wcardimage.x b/pkg/dataio/cardimage/t_wcardimage.x
new file mode 100644
index 00000000..0a85bb55
--- /dev/null
+++ b/pkg/dataio/cardimage/t_wcardimage.x
@@ -0,0 +1,256 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <fset.h>
+include <error.h>
+include <mach.h>
+
+define	TABSIZE		8
+
+# Procedure to write cardimage files. See wcardimage.hlp for documentation.
+
+procedure t_wcardimage()
+
+char    out_file[SZ_FNAME]		# input file name list
+char	in_file[SZ_FNAME]		# output file name list
+bool    verbose				# verbose mode ?
+
+char	out_fname[SZ_FNAME]
+int	ncards, file_number, nlines, list, len_list
+
+bool	clgetb()
+int	fstati(), clpopni(), clplen(), mtfile(), mtneedfileno()
+int	clgeti(), clgfil(), strlen(), btoi()
+include "wcardimage.com"
+
+begin
+	# Flush standard output on newline
+	if (fstati (STDOUT, F_REDIR) == NO)
+	    call fseti (STDOUT, F_FLUSHNL, YES)
+
+	# Get the parameters.
+	list = clpopni ("textfile")
+	len_list = clplen (list)
+
+	# Get name of output file.
+	# If no tape file number is given tape output then the program
+	# asks whether the tape is blank or contains data.
+	# If it is blank the tape begins writing at file 1 otherwise at EOT.
+	# Note that at some point this code needs to be modified to
+	# accept an output file name template.
+
+	call clgstr ( "cardfile", out_file, SZ_FNAME)
+	if (mtfile (out_file) == YES) {
+	    if (mtneedfileno (out_file) == YES) {
+		if (! clgetb("new_tape"))
+		    call mtfname (out_file, EOT, out_fname, SZ_FNAME)
+		else
+		    call mtfname (out_file, 1, out_fname, SZ_FNAME)
+	    } else
+		call strcpy (out_file, out_fname, SZ_FNAME)
+	}
+
+	# Get card_length and determine whether it fits in an integral number
+	# of characters.
+
+	card_length = min (SZ_LINE, clgeti ("card_length"))
+	if (mod (card_length, SZB_CHAR) !=  0)
+	    call error (1, "A card must fit in an integral number of chars.")
+
+	# Get number of cards per physical block and convert to packed chars.
+	cards_per_blk = clgeti ("cards_per_blk")
+
+	# Get the formatting parameters.
+	call clgstr ("contn_string", contn_string, SZ_LINE)
+	    if (strlen (contn_string) > card_length)
+		call error (2,
+		    "Continuation string cannot be > card_length chars.")
+	detab = btoi (clgetb ("detab"))
+
+	# Get the character type parameters.
+	ebcdic = btoi (clgetb ("ebcdic"))
+	ibm = btoi (clgetb ("ibm"))
+	if (ibm == YES && ebcdic == YES)
+	    call error (3, "Ibm and ebcdic cannot both be true.")
+
+	verbose = clgetb ("verbose")
+
+	file_number = 1
+	while (clgfil (list, in_file, SZ_FNAME) !=  EOF) {
+	    if (mtfile (out_file) == NO) {
+		if (len_list > 1) {
+		    call sprintf (out_fname[1], SZ_FNAME, "%s%03d")
+			call pargstr (out_file)
+		        call pargi (file_number)
+		} else
+		    call strcpy (out_file, out_fname, SZ_FNAME)
+	    } else {
+		if (file_number == 2)
+		    call mtfname (out_fname, EOT, out_fname, SZ_FNAME)
+	    }
+
+	    # Copy text file to cardimage file.
+
+	    iferr {
+		if (verbose) {
+		    call printf ("File: %s -> %s: ")
+			call pargstr (in_file)
+			call pargstr (out_fname)
+		}
+
+		call wc_textfile_to_cardfile (in_file, out_fname, ncards,
+		    nlines)
+
+		if (verbose) {
+		    call printf ("%d lines read -> %d cards written\n")
+			call pargi (nlines)
+			call pargi (ncards)
+		}
+	    } then {
+		call flush (STDOUT)
+		call erract (EA_FATAL)
+	    } else if (ncards == 0) {
+		if (verbose)
+		    call printf ("\tInput file is binary or empty\n")
+	    }
+
+	    file_number = file_number + 1
+	}
+end
+
+
+# WC_TEXTFILE_TO_CARDFILE -- Reads a textfile from disk and outputs a card
+# image file to tape or disk.
+
+procedure wc_textfile_to_cardfile (in_file, out_fname, ncards, nlines)
+
+char    in_file[ARB]			# input file name
+char	out_fname[ARB]			# output file name
+int     ncards				# number of card images
+int     nlines				# number of text lines
+
+char    linebuf[SZ_LINE]
+int     in, out, nchars, chars_per_blk
+int     mtopen(), open(), access(), wc_fetchline(), mtfile()
+errchk  mtopen, open, access, wc_fetchline, write, close, wc_text_to_card
+include "wcardimage.com"
+
+begin
+	nlines = 0
+	ncards = 0
+
+	if (access (in_file, READ_ONLY, TEXT_FILE) != YES)
+	    return
+
+	# Open the file.
+	in = open (in_file, READ_ONLY, TEXT_FILE)
+	if (mtfile (out_fname) == YES) {
+	    chars_per_blk = cards_per_blk * card_length / SZB_CHAR
+	    out = mtopen (out_fname, WRITE_ONLY, chars_per_blk)
+	} else
+	    out = open (out_fname, NEW_FILE, BINARY_FILE)
+
+	# Write file.
+	nchars = wc_fetchline (in, linebuf, nlines, card_length+1)
+	while (nchars != EOF) {
+	    call wc_text_to_card (linebuf, nchars, linebuf)
+	    call write (out, linebuf, card_length/SZB_CHAR)
+	    ncards = ncards + 1
+	    nchars = wc_fetchline (in, linebuf, nlines, card_length+1)
+	}
+	
+	call close (in)
+	call close (out)
+end
+
+
+# WC_TEXT_TO_CARD -- Convert text string into a packed cardimage string
+# removing the newline character if necessary, padding with blanks
+# if required and optionally translating from ascii to ebcdic or ibm
+# ebcdic.
+
+procedure wc_text_to_card (line, nchars, card)
+
+char    line[ARB]			# input text line
+int	nchars				# number of chars in line
+char	card[ARB]			# output packed card image
+
+int     init, ip
+errchk	ascii_to_ebcdic, ascii_to_ibm, achtsb, chrpak
+include "wcardimage.com"
+
+begin
+	# Pad with blanks.
+	init = nchars
+	if (line[init] != '\n')
+	    init = init + 1
+	for (ip=init;  ip <= card_length;  ip=ip+1)
+	    line[ip] = ' '
+
+	# Pack the line.
+	if (ebcdic == YES) {
+	    call ascii_to_ebcdic (line, card, card_length)
+	    call achtsb (card, card, card_length)
+	} else if (ibm == YES) {
+	    call ascii_to_ibm (line, card, card_length)
+	    call achtsb (card, card, card_length)
+	} else
+	    call chrpak (line, 1, card, 1, card_length)
+end
+
+
+# WC_FETCHLINE -- Procedure to fetch a line of text and split it into pieces
+# <= maxch characters long, optionally prefixing the remainders of lines
+# with a character string.
+
+int procedure wc_fetchline (fd, linebuf, lp, maxch)
+
+int    fd				# input file descriptor
+char   linebuf[ARB]			# output chunk of text
+int    lp				# number of lines read
+int    maxch				# maximum size of chunk of text
+
+char   line[SZ_LINE], inline[SZ_LINE]
+int    nchars, ip, op, offset, strsize
+int    getline(), gstrcpy(), strlen(), strncmp()
+errchk  getline(), strdetab()
+include "wcardimage.com"
+data   ip /1/
+
+begin
+	# Get new line and detab if requested.
+	if (ip == 1) {
+	    if (detab == YES) {
+		nchars = getline (fd, inline)
+		call strdetab (inline, line, SZ_LINE, TABSIZE)
+	    } else 
+		nchars = getline (fd, line)
+	    if (nchars == EOF)
+		return (EOF)
+
+	    lp = lp + 1
+	    offset = 0
+	    strsize = strlen (contn_string)
+	    if (strsize != 0 && strncmp (line, contn_string, strsize) == 0)
+		call eprintf ("Warning: Line matches continuation string\n")
+
+	} else {
+	    # Otherwise determine length of continuation string.
+	    offset = gstrcpy (contn_string, linebuf, SZ_LINE)
+	}
+
+	# Copy maxch characters to the output buffer.
+	op = offset + 1
+	while (line[ip] != EOS && op < maxch && line[ip] != '\n') {
+	    linebuf[op] = line[ip]
+	    ip = ip + 1
+	    op = op + 1
+	}
+
+	# Add newline and EOS reset pointer.
+	linebuf[op] = '\n'
+	linebuf[op+1] = EOS
+	if (line[ip] == EOS || line[ip] == '\n')
+	    ip = 1
+
+	return (op)
+end