aboutsummaryrefslogtreecommitdiff
path: root/pkg/dataio/cardimage/t_wcardimage.x
diff options
context:
space:
mode:
Diffstat (limited to 'pkg/dataio/cardimage/t_wcardimage.x')
-rw-r--r--pkg/dataio/cardimage/t_wcardimage.x256
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
generated by cgit (git 2.34.1) at 2025-09-20 10:43:42 -0400