From 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 Mon Sep 17 00:00:00 2001 From: Joe Hunkeler Date: Tue, 11 Aug 2015 16:51:37 -0400 Subject: Repatch (from linux) of OSX IRAF --- pkg/utilities/t_translit.x | 294 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 294 insertions(+) create mode 100644 pkg/utilities/t_translit.x (limited to 'pkg/utilities/t_translit.x') diff --git a/pkg/utilities/t_translit.x b/pkg/utilities/t_translit.x new file mode 100644 index 00000000..ac7a9aca --- /dev/null +++ b/pkg/utilities/t_translit.x @@ -0,0 +1,294 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include +include +include + +# TRANSLIT -- Copy a file or files, replacing specified characters by +# other characters, or deleting specified characters. + +define NCHARS 128 +define ON 1 +define OFF 0 + +procedure t_translit() + +char from_string[NCHARS], to_string[NCHARS] + +char to[NCHARS], from[NCHARS], lut[NCHARS], infile[SZ_FNAME], endto +char line[SZ_LINE], lastchar +int del[NCHARS], collap[NCHARS] +int list, delete, allbut, lastfrom, lastto, collapse, in, i, op, nchars + +bool clgetb() +int clpopni(), makeset(), strlen(), clgfil(), open(), getline() + +begin + call fseti (STDOUT, F_FLUSHNL, YES) + list = clpopni ("infile") + + # Make from and to character sets + call clgstr ("from_string", from_string, NCHARS) + if (from_string[1] == CH_NOT) { + allbut = YES + if (makeset (from_string, 2, from, NCHARS) == ERR) + call error (1, "From_string too large.") + } else { + allbut = NO + if (makeset (from_string, 1, from, NCHARS) == ERR) + call error (2, "From_string too large.") + } + + if (clgetb ("delete")) { + delete = YES + to[1] = EOS + } else { + delete = NO + call clgstr ("to_string", to_string, NCHARS) + if (makeset (to_string, 1, to, NCHARS) == ERR) + call error (3, "To_string too large.") + } + + lastfrom = strlen (from) + lastto = strlen (to) + endto = to[lastto] + + # Expand to set + if (delete == NO) { + for (i = lastto + 1; i <= NCHARS; i = i + 1) + to[i] = endto + to[i] = EOS + } + + # Collapse data ? + if (delete == YES) { + collapse = NO + } else if (allbut == YES) { + collapse = YES + } else if (lastfrom > lastto) { + if (! clgetb ("collapse")) + collapse = NO + else + collapse = YES + } else { + collapse = NO + } + + # Set up transformations + + # Initialize lookup table, delete and collapse vectors + call makelut (lut, NCHARS) + call amovki (OFF, del, NCHARS) + call amovki (OFF, collap, NCHARS) + + # Delete array + if (delete == YES) { + do i = 1, lastfrom + del[from[i] + 1] = ON + } + + # Collapse array + do i = 1, lastfrom + collap[from[i] + 1] = ON + + # Allbut? + if (allbut == YES) { + if (delete == YES) + call axorki (del, ON, del, NCHARS) + call axorki (collap, ON, collap, NCHARS) + } + + # Set up the transformation + if (delete == NO) { + op = 1 + do i = 1, NCHARS { + if (collap[i] == ON) { + lut[i] = to[op] + op = op + 1 + } + } + } + + # Loop over the files + while (clgfil (list, infile, SZ_FNAME) != EOF) { + + in = open (infile, READ_ONLY, TEXT_FILE) + lastchar = EOF + + repeat { + + nchars = getline (in, line) + if (nchars == EOF) + break + op = 1 + + if (delete == YES) { + call del_line (line, line, nchars, op, lut, del) + } else if (collapse == YES) { + call col_line (line, line, nchars, op, lut, collap, endto, + lastchar) + } else { + call map_line (line, line, nchars, op, lut) + } + + call putline (STDOUT, line) + + } + call close (in) + } + + call clpcls (list) +end + + +# MAKESET -- Procedure to make to and from character sets. + +int procedure makeset (array, k, set, size) + +char array[ARB], set[ARB] +int k, size + +int i, j + +begin + i = k + j = 1 + + call filset ("", array, i, set, j, size) + call chdeposit ("", set, size + 1, j) + + if (j > size + 1) + return (ERR) + else + return (OK) +end + + +# FILSET -- Process a character class into a simple list of characters. + +procedure filset (delim, patstr, ip, patbuf, op, sz_pat) + +char patstr[ARB], delim, patbuf[ARB] +int ip, sz_pat, op +char ch, ch1, ch2 +int cctoc() + +begin + for (; patstr[ip] != delim && patstr[ip] != EOS; ip=ip+1) { + if (patstr[ip] == ESCAPE) { # escape seq. + if (cctoc (patstr, ip, ch) == 1) + ch = patstr[ip] + else + ip = ip - 1 + call chdeposit (ch, patbuf, sz_pat, op) + + } else if (patstr[ip] != CH_RANGE) { + call chdeposit (patstr[ip], patbuf, sz_pat, op) + + } else if (op <= 1 || patstr[ip+1] == EOS) { # literal "-" + ch = CH_RANGE + call chdeposit (ch, patbuf, sz_pat, op) + + # Here if char is CH_RANGE, denoting a range of characters to + # be included in the character class. Range is valid only if + # limit chars are both digits, both lower case, or both upper case. + + } else { + ch1 = patbuf[op-1] # not same as patstr[ip-1] + ch2 = patstr[ip+1] + + if ((IS_DIGIT (ch1) && IS_DIGIT (ch2)) || + (IS_LOWER (ch1) && IS_LOWER (ch2)) || + (IS_UPPER (ch1) && IS_UPPER (ch2))) { + if (ch1 <= ch2) + for (ch=ch1+1; ch <= ch2; ch=ch+1) + call chdeposit (ch, patbuf, sz_pat, op) + else + for (ch=ch1-1; ch >= ch2; ch=ch-1) + call chdeposit (ch, patbuf, sz_pat, op) + ip = ip + 1 + } else { + ch = CH_RANGE + call chdeposit (ch, patbuf, sz_pat, op) + } + } + } +end + + +# MAKELUT -- Make lookup table + +procedure makelut (lut, nchars) + +char lut[ARB] +int nchars + +int i + +begin + do i = 1, nchars + lut[i] = char (i - 1) +end + + +# DEL_LINE -- Procedure to delete characters from a line + +procedure del_line (inline, outline, nchars, op, lut, delete) + +char inline[ARB], outline[ARB], lut[ARB] +int nchars, op, delete[ARB] + +int i + +begin + do i = 1, nchars { + if (delete[inline[i] + 1] == OFF) { + outline[op] = lut[inline[i] + 1] + op = op + 1 + } + } + outline[op] = EOS +end + + +# MAP_LINE -- Procedure to map a line + +procedure map_line (inline, outline, nchars, op, lut) + +char inline[ARB], outline[ARB], lut[ARB] +int nchars, op + +int i + +begin + do i = 1, nchars { + outline[op] = lut[inline[i] + 1] + op = op + 1 + } + outline[op] = EOS +end + + +# COL_LINE -- Procedure to collapse line + +procedure col_line (inline, outline, nchars, op, lut, collap, endto, lastchar) + +char inline[ARB], outline[ARB], lut[ARB], endto, lastchar +int nchars, op, collap[ARB] + +int i + +begin + do i = 1, nchars { + if (collap[inline[i] +1] == ON && lut[inline[i] + 1] == endto && + lastchar == endto) { + ; + } else { + outline[op] = lut[inline[i] + 1] + op = op + 1 + } + lastchar = lut[inline[i] + 1] + } + outline[op] = EOS +end -- cgit