/* Output from p2c, the Pascal-to-C translator */
/* From input file "strings.pas" */


#include <p2c/p2c.h>


#define STRINGS_G
#include "strings.h"


Char NOT_FOUND[21] = ">}SYMBOL-NOT-FOUND{<";
Char AMBIGUOUS[21] = ">}AMBIGUOUS-SYMBOL{<";
Char DELIMITER_ERROR[21] = ">}DELIMITER--ERROR{<";
Char NO_MORE_TOKENS = '\032';


boolean match_range(low, test, high)
Char *low, *test, *high;
{
  uchar i;
  boolean ok;

  i = 1;
  ok = true;
  while (ok && i <= strlen(low) && i <= strlen(test) && i <= strlen(high)) {
    if (low[i - 1] != '?' && high[i - 1] != '?') {
      if (low[i - 1] <= test[i - 1] && test[i - 1] <= high[i - 1])
	ok = true;
      else
	ok = false;
    }
    i++;
  }
  if (ok)
    return true;
  else
    return false;
}


Char *lbr(Result, s)
Char *Result;
Char *s;
{
  uchar idx;

  idx = 1;
  while (s[idx - 1] == ' ')
    idx++;
  return strsub(Result, s, idx, strlen(s));
}


Char *tbr(Result, s)
Char *Result;
Char *s;
{
  uchar idx;

  idx = strlen(s);
  while (s[idx - 1] == ' ')
    idx--;
  sprintf(Result, "%.*s", idx, s);
  return Result;
}


Char *to_lower(Result, s_)
Char *Result;
Char *s_;
{
  Char s[256];
  uchar i, FORLIM;

  strcpy(s, s_);
  FORLIM = strlen(s);
  for (i = 0; i < FORLIM; i++)
    s[i] = lowercase(s[i]);
  return strcpy(Result, s);
}


Char *to_upper(Result, s_)
Char *Result;
Char *s_;
{
  Char s[256];
  uchar i, FORLIM;

  strcpy(s, s_);
  FORLIM = strlen(s);
  for (i = 0; i < FORLIM; i++)
    s[i] = _toupper(s[i]);
  return strcpy(Result, s);
}


Char *filled_string(Result, c, width)
Char *Result;
Char c;
uchar width;
{
  Char s[256];

  memset((Anyptr)s, c, width + 1L);
  s[(long)((int)width)] = '\0';
  return strcpy(Result, s);
}


Char *right_justify(Result, s_, width)
Char *Result;
Char *s_;
uchar width;
{
  Char s[256];
  Char STR1[256];

  strcpy(s, s_);
  strcpy(s, lbr(STR1, s));
  if (width >= strlen(s)) {
    sprintf(Result, "%s%s", filled_string(STR1, ' ', width - strlen(s)), s);
    return Result;
  } else {
    sprintf(Result, "%.*s", width, s);
    return Result;
  }
}


Char *left_justify(Result, s_, width)
Char *Result;
Char *s_;
uchar width;
{
  Char s[256];
  Char STR1[256];

  strcpy(s, s_);
  strcpy(s, tbr(STR1, s));
  if (width >= strlen(s)) {
    sprintf(Result, "%s%s", s, filled_string(STR1, ' ', width - strlen(s)));
    return Result;
  } else {
    sprintf(Result, "%.*s", width, s);
    return Result;
  }
}


Char *center(Result, s_, width)
Char *Result;
Char *s_;
uchar width;
{
  Char s[256];
  Char pad[256];
  Char STR2[256];

  strcpy(s, s_);
  if (width >= strlen(s)) {
    filled_string(pad, ' ', (int)((width - strlen(s)) / 2));
    sprintf(s, "%s%s%s", pad, strcpy(STR2, s), pad);
    if (strlen(s) < width) {
      sprintf(Result, "%s ", s);
      return Result;
    } else
      return strcpy(Result, s);
  } else {
    sprintf(Result, "%.*s", width, s);
    return Result;
  }
}


Char *merge(Result, s1, s2)
Char *Result;
Char *s1, *s2;
{
  uchar i, FORLIM;

  if (strlen(s1) != strlen(s2))
    return strcpy(Result, "");
  Result[(long)strlen(s1)] = '\0';
  FORLIM = strlen(s1);
  for (i = 0; i < FORLIM; i++) {
    if (s1[i] != ' ' && s2[i] != ' ')
      Result[i] = '*';
    else {
      if (s1[i] != ' ')
	Result[i] = s1[i];
      else
	Result[i] = s2[i];
    }
  }
  return Result;
}


Char lowercase(ch)
Char ch;
{
  Char Result;

  if (isupper(ch))
    Result = (Char)(ch + 0x20);
  else
    Result = ch;
  return Result;
}


Char *untab(Result, s_, tabsize)
Char *Result;
Char *s_;
uchar tabsize;
{
  Char s[256];
  uchar i;
  Char STR1[256];
  Char STR2[256];
  Char STR4[256];

  strcpy(s, s_);
  i = 1;
  while (i <= strlen(s)) {
    if (s[i - 1] == '\t') {
      sprintf(STR4, "%.*s%s%s",
	      i - 1, s, filled_string(STR2, ' ', tabsize - i % tabsize),
	      strsub(STR1, s, i + 1, strlen(s)));
      strcpy(s, STR4);
    }
    i++;
  }
  return strcpy(Result, s);
}


Char *tab_compress(Result, s, tabsize)
Char *Result;
Char *s;
uchar tabsize;
{
  static Char blanks[33] = "                                ";
  uchar testloc, lasttest;
  Char outstr[256];
  Char STR1[256];
  Char STR2[256], STR3[256];

  testloc = 0;
  lasttest = 1;
  *outstr = '\0';
  while (testloc <= strlen(s)) {
    if (testloc > 0) {
      if (testloc == tabsize) {
	sprintf(STR2, "%.*s", tabsize - 1, blanks);
	if (!strcmp(strsub(STR1, s, testloc - tabsize + 1, tabsize - 1), STR2))
	  strcat(outstr, "\t");
	else
	  strcat(outstr, strsub(STR3, s, testloc - tabsize + 1, tabsize - 1));
      } else {
	sprintf(STR2, "%.*s", tabsize, blanks);
	if (!strcmp(strsub(STR1, s, testloc - tabsize, tabsize), STR2))
	  strcat(outstr, "\t");
	else
	  strcat(outstr, strsub(STR3, s, testloc - tabsize, tabsize));
      }
      lasttest = testloc;
    }
    testloc += tabsize;
  }
  sprintf(Result, "%s%s", outstr, strsub(STR1, s, lasttest, tabsize));
  return Result;
}


Char *replace_chars(Result, s_, find, sub)
Char *Result;
Char *s_;
Char find, sub;
{
  Char s[256];
  uchar i, FORLIM;

  strcpy(s, s_);
  FORLIM = strlen(s);
  for (i = 0; i < FORLIM; i++) {
    if (s[i] == find)
      s[i] = sub;
  }
  return strcpy(Result, s);
}


Char *replace_strs(Result, s_, find, sub)
Char *Result;
Char *s_, *find, *sub;
{
  Char s[256];
  uchar loc;

  strcpy(s, s_);
  if (*find == '\0')
    return strcpy(Result, s);
  do {
    loc = strpos2(s, find, 1);
    if (loc != 0) {
      strdelete((Anyptr)s, loc, strlen(find));
      strinsert(sub, (Anyptr)s, loc);
    }
  } while (loc != 0);
  return strcpy(Result, s);
}


Char *find_symbol_def(Result, slist, symbol)
Char *Result;
symbol_node *slist;
Char *symbol;
{
  strcpy(Result, NOT_FOUND);   /* set default return value... */
  if (slist == NULL)   /* make sure list is not empty */
    return Result;
  do {
    if (!strcmp(slist->sstr, symbol))   /* found ! */
    {  /* return corresponding def string */
      return strcpy(Result, slist->dstr);
    }
    slist = slist->next;   /* go thru list links ... */
  } while (slist != NULL);   /* end of list found. */
  return Result;
}


Static Char *match_symbol(Result, slist, symbol)
Char *Result;
symbol_node *slist;
Char *symbol;
{
  uchar found;
  symbol_node *where;

  found = 0;
  if (slist != NULL) {   /* make sure list is not empty */
    do {   /* check for symbol fragment */
      if (strpos2(slist->sstr, symbol, 1) == 1) {   /* note location */
	found++;
	where = slist;
      }
      slist = slist->next;   /* go thru list links ... */
    } while (slist != NULL);   /* end of list found... */
  }
  switch (found) {

  case 0:
    strcpy(Result, NOT_FOUND);
    break;

  case 1:
    strcpy(Result, where->sstr);
    break;

  default:
    strcpy(Result, AMBIGUOUS);
    break;
  }
  return Result;
}


Void init_symbol(slist, symbol, definition)
symbol_node **slist;
Char *symbol;
Char *definition;
{
  symbol_node *current;
  Char STR1[256];

  if (*slist == NULL) {   /*if list currently empty, do special routine..*/
    *slist = (symbol_node *)Malloc(sizeof(symbol_node));
	/* create new node */
    (*slist)->sstr = (Char *)Malloc(strlen(symbol) + 1L);
	/* mem for parameters... */
    (*slist)->dstr = (Char *)Malloc(strlen(definition) + 1L);
    strcpy((*slist)->sstr, symbol);   /* set values from parameters... */
    strcpy((*slist)->dstr, definition);
    (*slist)->next = NULL;   /* make sure next link set to NIL */
    return;
  }
  if (!strcmp(find_symbol_def(STR1, *slist, symbol), NOT_FOUND))
      /* new symbol */
      {  /* add at head of list... */
    current = *slist;   /* save pointer to start of list */
    *slist = (symbol_node *)Malloc(sizeof(symbol_node));
	/* create new node... */
    (*slist)->sstr = (Char *)Malloc(strlen(symbol) + 1L);
	/* mem for parameters */
    (*slist)->dstr = (Char *)Malloc(strlen(definition) + 1L);
    strcpy((*slist)->sstr, symbol);   /* set values appropriately */
    strcpy((*slist)->dstr, definition);
    (*slist)->next = current;
    return;
  }
  current = *slist;   /* starting at root... */
  while (strcmp(current->sstr, symbol))   /* look for symbol... */
    current = current->next;
  /* traverse list via links */
/* p2c: strings.pas, line 386:
 * Warning: Too many arguments for freemem [299] */
  Free(current->dstr);
  current->dstr = (Char *)Malloc(strlen(definition) + 1L);
  strcpy(current->dstr, definition);   /* set new value */

  /* replace definition of old symbol */
}


Void copy_symbols(src, dst)
symbol_node **src, **dst;
{
  symbol_node *current;

  *dst = NULL;
  current = *src;   /* starting at root... */
  while (current != NULL) {   /* until end of list */
    init_symbol(dst, current->sstr, current->dstr);
    current = current->next;
  }
}


Void release_all_symbols(slist)
symbol_node **slist;
{
  symbol_node *current, *destruct;

  if (*slist == NULL)   /* if list not empty...*/
    return;
  current = *slist;   /* starting at root... */
  while (current != NULL) {   /* until end of list */
    destruct = current;   /* release heap memory of each node */
    current = current->next;
/* p2c: strings.pas, line 418:
 * Warning: Too many arguments for freemem [299] */
    Free(destruct->sstr);
/* p2c: strings.pas, line 419:
 * Warning: Too many arguments for freemem [299] */
    Free(destruct->dstr);
    Free(destruct);
  }
  *slist = NULL;   /* make sure root reinitialized to empty value... */
}


/* Local variables for extract_delimited_string: */
struct LOC_extract_delimited_string {
  uchar sp;
  uchar stack[256];
} ;

Local Void push(i, LINK)
uchar i;
struct LOC_extract_delimited_string *LINK;
{
  LINK->sp++;
  LINK->stack[LINK->sp] = i;
}

Local boolean pop(i, LINK)
uchar *i;
struct LOC_extract_delimited_string *LINK;
{
  if (LINK->sp > 0) {
    *i = LINK->stack[LINK->sp];
    LINK->sp--;
    return true;
  } else
    return false;
}


/* finds "first" innermost delimited string marked lf & rt chars */
/* returns startloc of left ch and size to rt ch */

Void extract_delimited_string(lfchar, rtchar, instr_, startloc, size)
Char lfchar, rtchar;
Char *instr_;
uchar *startloc, *size;
{
  struct LOC_extract_delimited_string V;
  Char instr[256];
  boolean first_single;
  uchar i, j, FORLIM;

  strcpy(instr, instr_);
  V.sp = 0;
  first_single = true;
  if (lfchar == rtchar) {
    rtchar = '\255';
    FORLIM = strlen(instr);
    for (i = 0; i < FORLIM; i++) {
      if (first_single && instr[i] == lfchar)
	first_single = false;
      else {
	if (instr[i] == lfchar) {
	  first_single = true;
	  instr[i] = rtchar;
	}
      }
    }
  }

  *startloc = 0;
  *size = 255;   /* if startloc = 0 and size = 255, no delimiters, no error */
  FORLIM = strlen(instr);
  /* if size = 0 then unbalanced delimiter (err) detected */
  for (i = 1; i <= FORLIM; i++) {
    if (instr[i - 1] == lfchar)
      push(i, &V);
    if (instr[i - 1] == rtchar) {
      if (pop(&j, &V)) {
	*startloc = j;
	*size = i - j + 1;
	return;
      } else {
	*startloc = 0;
	*size = 0;
	return;
      }
    }
  }
  if (V.sp != 0)
    *size = 0;
}


#define UNDEF_MACRO_ERROR  1
#define MACRO_BRACKET_ERROR  2


long expand_macros(mlist, mc, msize, instr_, outstr)
symbol_node *mlist;
Char mc;
uchar msize;
Char *instr_;
Char *outstr;
{
  long Result;
  Char instr[256];
  uchar start, size;
  Char expr[256];
  Char macro[256];
  Char lookup[256];
  Char define[256];
  Char STR1[256];
  Char STR2[256];
  Char STR3[256];

  strcpy(instr, instr_);
  Result = 0;
  while ((strpos2(instr, "[", 1) != 0) | (strpos2(instr, "]", 1) != 0)) {
    extract_delimited_string('[', ']', instr, &start, &size);
    if (size == 0) {
      Result = MACRO_BRACKET_ERROR;
      strcpy(outstr, instr);
      return Result;

    }
    strsub(expr, instr, start, size);
    strsub(macro, expr, 2, (int)(strlen(expr) - 2L));
    while ((strpos2(macro, (sprintf(STR1, "%c", mc), STR1), 1) != 0) &
	   (strpos2(macro, "[", 1) == 0)) {
      sprintf(STR3, "%c", mc);
      strsub(lookup, macro, strpos2(macro, STR3, 1), msize);
      find_symbol_def(define, mlist, lookup);
      if (!strcmp(define, NOT_FOUND)) {
	Result = UNDEF_MACRO_ERROR;
	strcpy(outstr, instr);
	return Result;
      }
      strcpy(macro, replace_strs(STR3, macro, lookup, define));
    }
    strcpy(instr, replace_strs(STR1, instr, expr, macro));
  }
  while (strpos2(instr, (sprintf(STR1, "%c", mc), STR1), 1) != 0) {
    sprintf(STR2, "%c", mc);
    strsub(lookup, instr, strpos2(instr, STR2, 1), msize);
    find_symbol_def(define, mlist, lookup);
    if (!strcmp(define, NOT_FOUND)) {
      Result = UNDEF_MACRO_ERROR;
      strcpy(outstr, instr);
      return Result;
    }
    strcpy(instr, replace_strs(STR2, instr, lookup, define));
  }

  strcpy(outstr, instr);
  return Result;
}

#undef UNDEF_MACRO_ERROR
#undef MACRO_BRACKET_ERROR


Char *macro_error(Result, i)
Char *Result;
long i;
{
  return Result;
}


#define FORMAT_OP_ERROR  1
#define FORMAT_BRACKET_ERROR  2


long format_line(instr_, leftmargin, rightmargin, outstr)
Char *instr_;
uchar leftmargin, rightmargin;
Char *outstr;
{
  long Result;
  Char instr[256];
  uchar start, size, width;
  Char expr[256];
  Char format[256];
  Char lfstr[256];
  Char rtstr[256];
  Char censtr[256];
  Char temp[256];
  Char STR1[256];
  Char STR2[256];

  strcpy(instr, instr_);
  Result = 0;
  width = rightmargin - leftmargin + 1;
  *lfstr = '\0';
  *rtstr = '\0';
  *censtr = '\0';
  *temp = '\0';
  if ((strpos2(instr, "{", 1) != 0) | (strpos2(instr, "}", 1) != 0))
    filled_string(outstr, ' ', width);
  else
    strcpy(outstr, instr);

  while ((strpos2(instr, "{", 1) != 0) | (strpos2(instr, "}", 1) != 0)) {
    extract_delimited_string('{', '}', instr, &start, &size);
    if (size == 0) {
      Result = FORMAT_BRACKET_ERROR;
      strcpy(outstr, instr);
      return Result;

    }
    strsub(expr, instr, start - 1, size + 1);
    strsub(format, expr, 3, (int)(strlen(expr) - 3L));
    switch (expr[0]) {

    case '<':
      left_justify(temp, format, width);
      if (*lfstr != '\0') {
	strcpy(lfstr, tbr(STR1, lfstr));
	strcat(lfstr, temp);
	strcpy(lfstr, left_justify(STR1, lfstr, width));
      } else
	strcpy(lfstr, temp);
      break;

    case '>':
      right_justify(temp, format, width);
      if (*rtstr != '\0') {
	strcpy(rtstr, lbr(STR1, rtstr));
	strcat(rtstr, lbr(STR1, temp));
	strcpy(rtstr, right_justify(STR1, rtstr, width));
      } else
	strcpy(rtstr, temp);
      break;

    case '^':
      center(temp, format, width);
      if (*censtr != '\0') {
	strcpy(censtr, tbr(STR1, lbr(STR2, censtr)));
	strcat(censtr, tbr(STR1, lbr(STR2, temp)));
	strcpy(censtr, center(STR1, censtr, width));
      } else
	strcpy(censtr, temp);
      break;

    default:
      Result = FORMAT_OP_ERROR;
      strcpy(outstr, instr);
      return Result;
      break;
    }/*case*/
    strcpy(instr, replace_strs(STR1, instr, expr, ""));
  }
  if (*lfstr != '\0')
    strcpy(outstr, merge(STR1, outstr, lfstr));
  if (*rtstr != '\0')
    strcpy(outstr, merge(STR1, outstr, rtstr));
  if (*censtr != '\0')
    strcpy(outstr, merge(STR1, outstr, censtr));
  return Result;
}

#undef FORMAT_OP_ERROR
#undef FORMAT_BRACKET_ERROR


Char *alpha_count(Result, i)
Char *Result;
long i;
{
  static Char alpha[27] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
  long q, r;
  Char s[21];   /* limited to 26 * 20 items !!! */
  Char c;

  *s = '\0';
  i--;
  if ((unsigned long)i <= 519) {
    q = i / 26;
    r = i % 26;
/* p2c: strings.pas, line 664:
 * Note: Using % for possibly-negative arguments [317] */
    c = alpha[r];
    while (q > 0) {
      sprintf(s + strlen(s), "%c", c);
      q--;
    }
    sprintf(Result, "%s%c", s, c);
    return Result;
  } else
    return strcpy(Result, "*");
}


boolean file_exists(f)
Char *f;
{
  boolean Result;
  FILE *id;

  id = NULL;

  if( (id = fopen( f, "r" )) == NULL )
    {
      fclose( id );
      return true;
    }
  else
    {
      return false;
    }

}  /*file_exists*/


Char *int2str(Result, i)
Char *Result;
long i;
{
  Char s[12];

  sprintf(s, "%12ld", i);
  return strcpy(Result, s);
}


Char *float2str(Result, r)
Char *Result;
double r;
{
  Char s[31];

  sprintf(s, "% .5E", r);
  return (lbr(Result, s));
}


Char *cli(Result, slist, sc)
Char *Result;
symbol_node **slist;
Char sc;
{
  uchar idx, start, size;
  Char cmdline[256];
  Char option[256];
  Char parameter[256];
  Char value[256];
  Char STR1[256], STR2[256];
  Char STR3[256];

  strcpy(Result, "");

  *cmdline = '\0';
  for (idx = 1; idx < P_argc; idx++)
    strcat(cmdline, P_argv[idx]);

  sprintf(STR1, "%s%c", to_upper(STR2, cmdline), sc);
  strcpy(cmdline, STR1);
  strcpy(cmdline, replace_strs(STR2, cmdline, " ", ""));

  while (strpos2(cmdline, (sprintf(STR2, "%c", sc), STR2), 1) != 0) {
    extract_delimited_string(sc, sc, cmdline, &start, &size);
    if (size == 0) {
      sprintf(STR3, "%.*s", (int)(strlen(cmdline) - 1L), cmdline);
      init_symbol(slist, "FIRST_PARAM", STR3);
      return Result;

    }
    strsub(option, cmdline, start, size);
    sprintf(STR3, "%c", sc);
    strcpy(cmdline, replace_strs(STR1, cmdline, option, STR3));
    idx = strpos2(option, "=", 1);
    if (idx != 0) {
      strsub(parameter, option, 2, idx - 2);
      strsub(value, option, idx + 1, (int)(strlen(option) - idx - 1L));
    } else {
      strsub(parameter, option, 2, (int)(strlen(option) - 2L));
      strcpy(value, "TRUE");
    }
    if (*parameter == '\0')
      continue;
    match_symbol(option, *slist, parameter);
    if (!strcmp(option, NOT_FOUND) || !strcmp(option, AMBIGUOUS)) {
      sprintf(Result, "CLI error %s for %c%s.", option, sc, parameter);
      return Result;
    }
    if (option[strlen(option) - 1] == '=' && (idx == 0 || *value == '\0')) {
      sprintf(Result, "CLI option %c%s requires parameter value.", sc, option);
      return Result;
    }
    init_symbol(slist, option, value);
  }
  return Result;
}


Char *tokenize(Result, line_)
Char *Result;
Char *line_;
{
  Char line[256];
  static Char TOKEN_DELIMITER = '\255';   /* must sync with next proc */
  static Char TWO_DELIMITERS[3] = "\255\255";
  Char STR1[256];
  Char STR2[256];

  strcpy(line, line_);
  sprintf(line + strlen(line), "%c", TOKEN_DELIMITER);
  strcpy(line, replace_chars(STR1, line, ' ', TOKEN_DELIMITER));
  strcpy(line, replace_chars(STR1, line, '\t', TOKEN_DELIMITER));
  sprintf(STR2, "%c", TOKEN_DELIMITER);
  strcpy(line, replace_strs(STR1, line, TWO_DELIMITERS, STR2));
  if (line[0] == TOKEN_DELIMITER)
    strcpy(line, strsub(STR1, line, 2, strlen(line)));
  return strcpy(Result, line);
}


Char *get_token(Result, line)
Char *Result;
Char *line;
{
  static Char TOKEN_DELIMITER = '\255';   /* must sync with previous proc */
  long new_;
  Char STR1[256];

  sprintf(STR1, "%c", TOKEN_DELIMITER);
  new_ = strpos2(line, STR1, 1);   /* find next token marker */
  if (new_ == 0) {
    sprintf(Result, "%c", NO_MORE_TOKENS);
    return Result;
  }
  sprintf(Result, "%.*s", (int)(new_ - 1), line);
  strcpy(line, strsub(STR1, line, (int)(new_ + 1), strlen(line)));
  return Result;
}


void _strings_init()
{
  /*no initialization performed*/
  static int _was_initialized = 0;
  if (_was_initialized++)
    return;
}


/* End. */