/**********************************************************/
/*  In this program, to judge OS spec. (UNIX or Windows)  */
/*    Environment Variable "OS" is checked if it exists,  */
/*      and then if it includes a string 'Windows'.       */
/*  If this criterion is not valid, predefine the static  */
/*    variable OS to be  1 (UNIX)  or  2 (Windows).       */
/**********************************************************/

#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <unistd.h>
#include <time.h>

int premsg(char *str);

/*******************************************************/
/*  Assistance to show the progress of loop operation, */
/*             to set-up Working Directory Path,       */
/*         and to read-in process parameters.          */
/*******************************************************/
#define LDIR 80
#define LNAM 80
#define LSBF 80
static int ipcent;
static char wdr[LDIR+83]="";
static int kop=-1, kon;
static FILE *fp;
static char sbf[LSBF+1];
static char dtmstring[21];
static int kstderr=1;
static int OS=0;

static int ischrdev(FILE *fp)
                    /**** check if '(FILE *)fp' is character device ****/
{   struct stat st;
    if (fstat(fileno(fp),&st) != 0)
        { premsg("\nABEND in ischrdev(FILE *fp)"); exit(9); }
    if (S_ISCHR(st.st_mode)) return(1); else return(0);
}

static int get1c(FILE *fp)
{   int c; while ((c=fgetc(fp)) == '\r'); return(c); }

static int getOS(void)
{   char *p;
    if (OS == 0) {
        if ((p=getenv("OS")) == NULL) OS = 1;           /* UNIX */
        else {
            if (strstr(p,"Windows") == NULL) OS = 1;    /* UNIX */
            else OS = 2;                                /* Windows */
        }
    }
    return(OS);
}

/************************************************************************/

char *strdtm()    /**** get Date/Time string "YYYY-MM-DD hh:mm:ss " ****/
{   time_t dtm; struct tm *stm;
    time(&dtm); stm = localtime(&dtm);
    sprintf(dtmstring, "%04d-%02d-%02d %02d:%02d:%02d ",
            stm->tm_year + 1900, stm->tm_mon + 1, stm->tm_mday,
            stm->tm_hour, stm->tm_min, stm->tm_sec);
    return(dtmstring);
}

int prompt(char *str)
{   fflush(stdout); fprintf(stderr, str);
    fflush(stderr); return(0);
}

int premsg(char *str)
{   fflush(stdout); fprintf(stderr, str); fputc('\n', stderr);
    fflush(stderr); return(0);
}

int dpcini(char *str)
{   if (ischrdev(stderr)) { kstderr = 1; prompt(str); }
    else kstderr = 0;
    ipcent = 0; return(0);
}

int dpcent(int m, int n)
{   int j;
    if (kstderr == 0) return(0);  /**** progress bar only for terminal ****/
    if (n == 0) j = m/2; else j = m*50 / n;
    if (j < 0) j = 0; else if (j > 50) j = 50;
    if (ipcent < j) {
      while (ipcent < j) { ipcent++; fputc('#', stderr); }
      if (ipcent == 50) fputc('\n', stderr);
      fflush(stderr);
    }
    return(ipcent);
}

int parmin(int lbuf, char *buf)
        /**** 'buf' buffer size must be as large as (lbuf+1) bytes ****/
{   int c, n=0; char *sbuf;
    if (lbuf < 2) { premsg("\nparmin: lbuf < 2"); return(-2); }
    lbuf--; sbuf = buf;
    if (kop < 0) { fp = stdin; kop = 0; kon = ischrdev(fp); }
    while ((c=get1c(fp)) == '#') {
        while ((c=get1c(fp)) != '\n') {
            if (c == EOF) { premsg("- EOF"); return(-1); }
        }
    }
    if ((c==EOF) || (c==':')) { premsg("- EOF"); return(-1); }
    if (c != '\n') {
        *buf++ = c; n = 1;
        while ((c=get1c(fp)) != EOF) {
            if (c == '\n') break;
            else if (c == ';') {
                if ((c=get1c(fp)) == '#') {
                    while ((c=get1c(fp)) != '\n') { if (c == EOF) break; }
                    break;
                }
                else {
                    if (n < lbuf) { *buf++ = ';'; n++; }
                    if (c == EOF) break;
                    if (n < lbuf) { *buf++ = c; n++; }
                }
            }
            else {
                if (c == EOF) break;
                if (n < lbuf) { *buf++ = c; n++; }
            }
        }
    }
    *buf++ = '\0';
    if (kon == 0) {
        while ((n>0) && (*(sbuf+n-1)==' ')) n--; *(sbuf+n) = '\0';
        premsg(sbuf);
    }
    return(n);
}

int get_wkdir(char *pdr, size_t lp)
        /**** 'pdr' buffer size must be as large as (lp) bytes ****/
{   char hmd[LDIR+2], cwd[LDIR+2], sub[82], *p;
    int n;
/**************************************/
    if (OS == 0) getOS();               /* check if UNIX or Windows */
/**************************************/
    if (OS == 1) {                      /* UNIX OS */
        if ((p=getenv("HOME")) == NULL) { strcpy(hmd,"/"); }
        else if (strlen(p) > LDIR)
             { prompt("- too long HOME name\n"); return(-1); }
        else { strcpy(hmd,p); strcat(hmd,"/");
               prompt(" Home directory:  ~/ : "); premsg(hmd); }
        if ((p=getenv("PWD")) == NULL) { strcpy(cwd,"/"); }
        else if (strlen(p) > LDIR)
             { prompt("- too long PWD name\n"); return(-1); }
        else { strcpy(cwd,p); strcat(cwd,"/");
               prompt(" Current dir.  :  ./ : "); premsg(cwd); }
        prompt("Specify Working directory ==> ");
        if (parmin(LSBF,sbf) < 0) return(-1);
        strcpy(sub,"");
        if (sscanf(sbf,"%81s",sub) == 1) {
            n = strlen(sub);
            if (n == 81) { prompt("- too long name\n"); return(-1); }
            if (sub[n-1] != '/') strcat(sub,"/");
        }
        p = sub; strcpy(wdr,cwd);
        if (*p == '/') { strcpy(wdr,"/"); p++; }
        else if ((*p=='~') && (*(p+1)=='/')) { strcpy(wdr,hmd); p += 2; }
        while (*p != '\0') {
            if (*p == '/') p++;
            else if ((*p=='.') && (*(p+1)=='\0')) p++;
            else if ((*p=='.') && (*(p+1)=='/')) p += 2;
            else if ((*p=='.') && (*(p+1)=='.') &&
                     ((*(p+2)=='\0') || (*(p+2)=='/'))) {
                p += 2; if (*p != '\0') p++;
                for (n=strlen(wdr)-1; n>0; n--)
                    { wdr[n] = '\0'; if (wdr[n-1] == '/') break; }
                if (n <= 0) strcpy(wdr,"/");
            }
            else {
                while ((*p != '\0') && (*p != '/')) { strncat(wdr,p,1); p++; }
                strcat(wdr, "/"); if (*p != '\0') p++;
            }
        }
    }
/**************************************/
    else {                              /* Windows OS */
        premsg(" Root directory:  \\  : c:\\");
        if ((p=getcwd(cwd,LDIR+1)) == NULL)
            { prompt("- too long PWD name\n"); return(-1); }
        if (cwd[strlen(cwd)-1] != '\\') strcat(cwd,"/");
        prompt(" Current dir.  :  .\\ : "); premsg(cwd);
        prompt("Specify Working directory ==> ");
        if (parmin(LSBF,sbf) < 0) return(-1);
        strcpy(sub,"");
        if (sscanf(sbf,"%81s",sub) == 1) {
            n = strlen(sub);
            if (n == 81) { prompt("- too long name\n"); return(-1); }
            if ((sub[n-1] != '\\') && (sub[n-1] != '/')) strcat(sub,"/");
        }
        p = sub; strcpy(wdr,cwd);
        if (*p == '\0') {
        } else if ((*p=='/') || (*p=='\\')) {
            strcpy(wdr, "\\"); p++;
        } else if ((*(p+1)==':') && ((*(p+2)=='/') || (*(p+2)=='\\'))) {
            wdr[0]=*p; wdr[1]=':'; wdr[2]='\\'; wdr[3]='\0'; p += 3;
        } else if ((*(p+1)==':') && ((*(p+2)!='/') && (*(p+2)!='\\'))) {
            wdr[0]=*p; wdr[1]=':'; wdr[2]='\\'; wdr[3]='\0'; p += 2;
            while ((*p != '\0') && (*p != '/') && (*p != '\\'))
                { strncat(wdr,p,1); p++; }
            strcat(wdr,"/"); if (*p != '\0') p++;
        }
        while (*p != '\0') {
            if ((*p=='/') || (*p=='\\')) p++;
            else if ((*p=='.') && ((*(p+1)=='/') || (*(p+1)=='\\'))) p += 2;
            else if ((*p=='.') && (*(p+1)=='.') &&
                     ((*(p+2)=='\0') || (*(p+2)=='/') || (*(p+2)=='\\'))) {
                p += 2; if (*p != '\0') p++;
                for (n=strlen(wdr)-1; n>0; n--) {
                    wdr[n] = '\0';
                    if ((wdr[n-1]=='/') || (wdr[n-1]=='\\')) break;
                }
                if (n <= 0) strcpy(wdr, "\\");
            }
            else {
                while ((*p != '\0') && (*p != '/') && (*p != '\\'))
                    { strncat(wdr,p,1); p++; }
                strcat(wdr, "/"); if (*p != '\0') p++;
            }
        }
    }
/**************************************/
    prompt(" Working Directory : "); premsg(wdr);
    if (--lp < strlen(wdr))
        { prompt("- unable to store pathname\n"); return(1); }
    strcpy(pdr,wdr); return(0);
}

void gparma(char *str, int lnam, char *nam)
{   char tnam[81];
    prompt(str); if (parmin(LSBF,sbf) < 0) exit(1);
    if (sscanf(sbf,"%80s",tnam) == 1) {
        lnam--; if (strlen(tnam) > lnam) tnam[lnam] = '\0';
        strcpy(nam,tnam);
    }
}
void gparmi(char *str, int *iv)
{   prompt(str); if (parmin(LSBF,sbf) < 0) exit(1);
    sscanf(sbf, "%d", iv);
}
void gparmf(char *str, float *fv)
{   prompt(str); if (parmin(LSBF,sbf) < 0) exit(1);
    sscanf(sbf, "%f", fv);
}
void gparmd(char *str, double *dv)
{   prompt(str); if (parmin(LSBF,sbf) < 0) exit(1);
    sscanf(sbf, "%lf", dv);
}
void gparmif(char *str, int *iv, float *fv)
{   prompt(str); if (parmin(LSBF,sbf) < 0) exit(1);
    sscanf(sbf, "%d%f", iv,fv);
}
void gparmid(char *str, int *iv, double *dv)
{   prompt(str); if (parmin(LSBF,sbf) < 0) exit(1);
    sscanf(sbf, "%d%lf", iv,dv);
}
void gparmi2(char *str, int *iv1, int *iv2)
{   prompt(str); if (parmin(LSBF,sbf) < 0) exit(1);
    sscanf(sbf, "%d%d", iv1,iv2);
}
void gparmf2(char *str, float *fv1, float *fv2)
{   prompt(str); if (parmin(LSBF,sbf) < 0) exit(1);
    sscanf(sbf, "%f%f", fv1,fv2);
}
void gparmd2(char *str, double *dv1, double *dv2)
{   prompt(str); if (parmin(LSBF,sbf) < 0) exit(1);
    sscanf(sbf, "%lf%lf", dv1,dv2);
}

/*************************************************/
/*  Support for paremeter data input from file   */
/*************************************************/

void opnpinc(int argc, char *argv[])
/************************************************************************/
/*  When using from C language main program,                            */
/*   do not call the functions opnpin_() and clspin_(),                 */
/*    but use opnpinc() with the setting of "argc" and "argv" arguments */
/*     and clspin(), as follows.                                        */
/*          main (int argc, char *argv[])                               */
/*          {   opnpinc(argc, argv);                                    */
/*              .....                                                   */
/*              clspin();                                               */
/*          }                                                           */
/*  opnpin_() and clspin_() are defined in another source "opnpin.c".   */
/************************************************************************/
{   char s[LNAM+2], nam[LNAM+2], *nam2, *ps;
    int c=0, l, n, iargc;
    if (kop > 0) { premsg("opnpin: PIn already open"); exit(1); }
    iargc = argc;
    if (iargc < 2) { fp = stdin; kop = 1; kon = ischrdev(fp); return; }
    strncpy(nam, argv[1], (size_t)(LNAM+1));
        /* strncpy(s1,s2,len) pads \0 upto len, if s2 is short. */
    if (nam[LNAM] != '\0')
        { premsg("opnpin: too long filename"); exit(1); }
    if (strcmp(nam,"-") == 0)
        { fp = stdin; kop = 1; kon = ischrdev(fp); return; }
    if ((nam2=strchr(nam,':')) != NULL)
        { *nam2 = '\0'; nam2++; strcat(nam2," "); l = strlen(nam2); }
    if ((fp=fopen(nam,"r")) == NULL)
        { premsg("opnpin: PIn file open fail"); exit(1); }
    kon = ischrdev(fp);
    if (nam2 == NULL) { kop = 2; return; }
    while (c != EOF) {
        c = get1c(fp);
        if (c == EOF) break;
        else if (c == ':') {
            for (ps=s,n=1; n<LNAM; n++) {
              c = get1c(fp); if (c == EOF) break;
              *ps++ = c; if (c == '\n') break;
            }
            *ps = '\0'; if (c == EOF) break;
            n = strlen(s)-1;
            if (s[n] == '\n') s[n]='\0';
            else { while ((c=get1c(fp)) != '\n') { if (c == EOF) break; } }
            strcat(s," ");
            if (strncmp(nam2,s,l) == 0) { kop = 2; return; }
        }
        else if (c != '\n')
            { while ((c=get1c(fp)) != '\n') { if (c == EOF) break; } }
    }
    premsg("opnpin: tag-name seek fail"); exit(1);
}

void clspin()
{   if (kop < 1) { premsg("clspin: PIn not open"); exit(1); }
    if (kop == 2) { fclose(fp); fp = stdin; kon = ischrdev(fp); }
    kop = 0;
}

/*******************************************************/
/*  Get char.length after space trimming on the right  */
/*     ( for FORTRAN programing )                      */
/*******************************************************/
int lrtrim_(char name[], size_t len)
{   while((len>1) && (name[len-1]==' ')) len--; return(len); }

/*************************************************/
/*  ERROR exit with End-code output to <stderr>  */
/*     ( for FORTRAN programing )                */
/*************************************************/
void abend_(int *ecd)
{   prompt("\nERROR "); fprintf(stderr, "%d (Abend)\n", *ecd); exit(9); }
void abendm_(char *ems, size_t len)
{   prompt("\n[ABEND] "); while (len-- > 0) fputc(*ems++, stderr);
    fputc('\n', stderr); exit(9); }

/***********************/
/*  FORTRAN interface  */
/***********************/
void strdtm_(char *sdt, size_t ls)
{   int i; char *dtms;
    dtms = strdtm();
    for (i=0; i<ls; i++,sdt++) { *sdt = *dtms; if (i < 19) dtms++; }
}

void prompt_(char *str, size_t ls)
{   int i, c;
    fflush(stdout);
    for (i=0; i<ls; i++) {
        if ((c=*str++) == '\0') break;
        fputc(c, stderr);
    }
    fflush(stderr);
}
void premsg_(char *str, size_t ls)
{   prompt_(str,ls); fputc('\n',stderr); fflush(stderr); }

void dpcent_(int *m, int *n) { dpcent(*m, *n); }
void dpcini_(char *str, size_t ls)
{   int l; char pstr[31];
    if (ls<30) l=ls; else l=30;
    strncpy(pstr,str,l); pstr[l]='\0'; dpcini(pstr);
}

int lwkdir_(int *len, char *dnm, size_t ls)
{   int n; char *p, lswdr[LDIR+83+24];
    for (n=0; n<ls; n++) *(dnm+n) = ' ';
    p=&lswdr[18];
    if (get_wkdir(p,LDIR+83) != 0) exit(1);
    if ((n=strlen(p)) >= *len)
        { premsg("- too long directory-name"); exit(1); }
    strncpy(dnm, p, n);
/**************************************/
    if (OS == 1) {                      /* UNIX OS */
        strncpy(lswdr, "sh -c \'ls -T0 -CF ", 18);
        strcat(lswdr, " >&2 \'");
    }
/**************************************/
    else {                              /* Windows OS */
/*--------  MS-DOS 'dir' command  --------*/
/*      strncpy(lswdr, "        dir  /d   ", 18);     */
/*      strcat(lswdr, " >&2  ");                      */
/*--------   MSYS  'ls' command   --------*/
        strncpy(lswdr, "       ls   -CF   ", 18);
        strcat(lswdr, " >&2  ");
/*----------------------------------------*/
    }
/**************************************/
    struct stat st;
    if (fstat(fileno(stderr),&st) != 0)
        { premsg("\nABEND in lwkdir_:fstat"); exit(9); }
    if (S_ISCHR(st.st_mode)) system(lswdr);
    return(n);
}

void parmin_(char *str, int *lbuf, char buf[], size_t ls, size_t lbf)
{   int i, nc;
    nc = *lbuf; if (nc > lbf) nc = lbf;
    prompt_(str,ls); if (parmin(nc-1,buf) < 0) exit(1);
    for (i=strlen(buf); i<nc; i++) buf[i] = ' ';
}
void gparma_(char *str, int *lnam, char *nam, size_t ls, size_t lnm)
{   char tnam[81]=""; int l, i;
    prompt_(str,ls); if (parmin(LSBF,sbf) < 0) exit(1);
    sscanf(sbf, "%80s", tnam);
    l = strlen(tnam); if (l > *lnam) l = *lnam; if (l > lnm) l = lnm;
    for (i=0; i<l; i++) *nam++ = tnam[i];
    while (i++ < *lnam) *nam++ = ' ';
}
void gparmi_(char *str, int *iv, size_t ls)
{   int i=0; prompt_(str,ls); if (parmin(LSBF,sbf) < 0) exit(1);
    sscanf(sbf, "%d", &i); *iv = i;
}
void gparmf_(char *str, float *fv, size_t ls)
{   float f=0.F; prompt_(str,ls); if (parmin(LSBF,sbf) < 0) exit(1);
    sscanf(sbf, "%f", &f); *fv = f;
}
void gparmd_(char *str, double *dv, size_t ls)
{   double d=0.; prompt_(str,ls); if (parmin(LSBF,sbf) < 0) exit(1);
    sscanf(sbf, "%lf", &d); *dv = d;
}
void gparmif_(char *str, int *iv, float *fv, size_t ls)
{   int i=0; float f=0.F; prompt_(str,ls); if (parmin(LSBF,sbf) < 0) exit(1);
    sscanf(sbf, "%d%f", &i,&f); *iv = i; *fv = f;
}
void gparmid_(char *str, int *iv, double *dv, size_t ls)
{   int i=0; double d=0.; prompt_(str,ls); if (parmin(LSBF,sbf) < 0) exit(1);
    sscanf(sbf, "%d%lf", &i,&d); *iv = i; *dv = d;
}
void gparmi2_(char *str, int *iv1, int *iv2, size_t ls)
{   int i1=0, i2=0; prompt_(str,ls); if (parmin(LSBF,sbf) < 0) exit(1);
    sscanf(sbf, "%d%d", &i1,&i2); *iv1 = i1; *iv2 = i2;
}
void gparmf2_(char *str, float *fv1, float *fv2, size_t ls)
{   float f1=0.F, f2=0.F; prompt_(str,ls); if (parmin(LSBF,sbf) < 0) exit(1);
    sscanf(sbf, "%f%f", &f1,&f2); *fv1 = f1; *fv2 = f2;
}
void gparmd2_(char *str, double *dv1, double *dv2, size_t ls)
{   double d1=0., d2=0.; prompt_(str,ls); if (parmin(LSBF,sbf) < 0) exit(1);
    sscanf(sbf, "%lf%lf", &d1,&d2); *dv1 = d1; *dv2 = d2;
}