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

/*******************************************************/
/*  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 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); }
/************************************************************************/

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, k;
    if (kstderr == 0) return(0);  /**** progress bar only for terminal ****/
    if (n == 0) {
        ipcent = m/2;
        if (ipcent < 0) ipcent = 0;
        else if (ipcent > 50) ipcent = 50;
        if (ipcent == 50) fputc('\n', stderr);
    }
    else {
        j = m*50 / n; if (j < 0) j = 0; else if (j > 50) j = 50;
        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) premsg(sbuf);
    return(n);
}

int get_wkdir(char *pdr, size_t lp)
{   char hmd[LDIR+2], cwd[LDIR+2], sub[81], *p;
    int n;
    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,"%80s",sub) == 1) {
        n = strlen(sub);
        if (n == 80) { prompt("- too long name\n"); return(-1); }
        if (sub[n-1] != '/') strcat(sub,"/");
    }
    p = sub; strcpy(wdr,cwd);
    while (*p != '\0') {
        if (*p == '/') { strcpy(wdr,"/"); p++; }
        else if ((*p=='~') && (*(p+1)=='/')) { p += 2; strcpy(wdr,hmd); }
        else if ((*p=='.') && (*(p+1)=='/')) p += 2;
        else if ((*p=='.') && (*(p+1)=='.') && (*(p+2)=='/')) { p += 3;
            for (n=strlen(wdr)-1; (n>0)&&(wdr[--n]!='/'); wdr[n]='\0'); }
        else { do { strncat(wdr,p,1); } while (*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));
    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)
{   int n; char *p, lswdr[LDIR+80+24]="sh -c \'ls -T0 -CF ";
    p=&lswdr[14]; if (get_wkdir(p,LDIR+83) != 0) exit(1);
    if ((n=strlen(p)) >= *len)
        { premsg("- too long directory-name"); exit(1); }
    strcpy(dnm,p); strcat(p," >&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)
{   int i, nc;
    nc = *lbuf; 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)
{   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;
    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;
}