#include <stdio.h>
#include <stdlib.h>
#include <string.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 81

static int ipcent;
static char wdr[LDIR+83]="";
static int kop=0;
static FILE *fp;
static char sbf[LSBF];

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

int dpcent(int m, int n)
{   int j, k;
    if (n == 0) {
        ipcent = m;
        if (ipcent < 0) ipcent = 0;
        else if (ipcent > 100) ipcent = 100;
        fprintf(stderr, "%3d%%", ipcent);
        if (ipcent == 100) fputc('\n', stderr);
    }
    else {
        j = m*100 / n; if (j < 0) j = 0; else if (j > 100) j = 100;
        if (j > ipcent) {
            for (k=0; k<4; k++) fputc('\b', stderr);
            ipcent = j; fprintf(stderr, "%3d%%", ipcent);
            if (ipcent == 100) fputc('\n', stderr);
        }
    }
    fflush(stderr); return(ipcent);
}

int opnpin()
{   char s[LNAM+2], nam[LNAM+1], *nam2;
    int n, c=0, l;
    if (kop != 0) { fprintf(stderr, "opnpin: PIn already open\n"); return(1); }
    fprintf(stderr, "Process parameters predefined ?\n");
    fprintf(stderr, "  then Enter filename, else Hit <RETURN>.  ==> ");
    if (fgets(s,LNAM+2,stdin) == NULL) return(0);
    if (sscanf(s,"%s",nam) == 1) {
        if ((nam2=strchr(nam,':')) != NULL)
            { *nam2 = '\0'; nam2++; strcat(nam2," "); l = strlen(nam2); }
        if ((fp=fopen(nam,"r")) == NULL)
            { fprintf(stderr, "Parameter file open fail\n"); return(1); }
        if (nam2 == NULL) kop = 1;
        else {
            while (c != EOF) {
                if ((c=fgetc(fp)) == EOF) break;
                else if (c == ':') {
                    if (fgets(s,LNAM+1,fp) == NULL) break;
                    n = strlen(s)-1; if (s[n] == '\n') s[n]='\0'; 
                    strcat(s," ");
                    if (strncmp(nam2,s,l) == 0) { kop = 1; break; }
                }
                else if (c != '\n') {
                    while ((c=fgetc(fp)) != '\n') { if (c == EOF) break; }
                }
            }
            if (kop != 1)
                { fprintf(stderr, "Tag-name seek fail\n"); return(1); }
        }
    }
    else kop = 2;
    return(0);
}

int clspin()
{   if (kop == 0) { fprintf(stderr, "clspin: PIn not open\n"); return(1); }
    fclose(fp); kop = 0; return(0);
}

int parmin(int lbuf, char *buf)
{   int c, n=0; char *sbuf;
    if (lbuf < 2) { fprintf(stderr, "parmin: lbuf < 2\n"); return(-2); }
    lbuf--; sbuf = buf;
    if (kop == 1) {
        while ((c=fgetc(fp)) == '#') {
            while ((c=fgetc(fp)) != '\n') { if (c == EOF) return(-1); }
        }
        if (c == EOF) return(-1);
        if (c == ':') return(-1);
        if (c != '\n') {
            *buf++ = c; n = 1;
            while ((c=fgetc(fp)) != EOF) {
                if (c == '\n') break;
                else if (c == ';') {
                    if ((c=fgetc(fp)) == '#') {
                        while ((c=fgetc(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'; fprintf(stderr,sbuf); fputc('\n', stderr);
    }
    else {
        while ((c=getchar()) != EOF) {
            if (c == '\n') break;
            if (n < lbuf) { *buf++ = c; n++; }
        }
        *buf++ = '\0';
    }
    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)
        { prompt("- failed to get HOME\n"); return(-1); }
    else if (strlen(p) > LDIR)
        { prompt("- too long HOME name\n"); return(-1); }
    else { strcpy(hmd,p); strcat(hmd,"/"); }
    if ((p=getenv("PWD")) == NULL)
        { prompt("- failed to get PWD\n"); return(-1); }
    else if (strlen(p) > LDIR)
        { prompt("- too long PWD name\n"); return(-1); }
    else { strcpy(cwd,p); strcat(cwd,"/"); }
    if (kop != 1) {
        prompt(" Home directory:  ~ : "); prompt(hmd); fputc('\n', stderr);
        prompt(" Current dir.  :  . : "); prompt(cwd); fputc('\n', stderr);
    }
    prompt("Specify Working directory ==> ");
    if (parmin(LSBF,sbf) < 0) { prompt("- EOF\n"); 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 : "); prompt(wdr); fputc('\n', stderr);
    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) { prompt("- EOF\n"); 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) { prompt("- EOF\n"); exit(1); }
    sscanf(sbf, "%d", iv);
}
void gparmf(char *str, float *fv)
{   prompt(str);
    if (parmin(LSBF,sbf) < 0) { prompt("- EOF\n"); exit(1); }
    sscanf(sbf, "%f", fv);
}
void gparmd(char *str, double *dv)
{   prompt(str);
    if (parmin(LSBF,sbf) < 0) { prompt("- EOF\n"); exit(1); }
    sscanf(sbf, "%lf", dv);
}
void gparmif(char *str, int *iv, float *fv)
{   prompt(str);
    if (parmin(LSBF,sbf) < 0) { prompt("- EOF\n"); exit(1); }
    sscanf(sbf, "%d%f", iv,fv);
}
void gparmid(char *str, int *iv, double *dv)
{   prompt(str);
    if (parmin(LSBF,sbf) < 0) { prompt("- EOF\n"); exit(1); }
    sscanf(sbf, "%d%lf", iv,dv);
}
void gparmi2(char *str, int *iv1, int *iv2)
{   prompt(str);
    if (parmin(LSBF,sbf) < 0) { prompt("- EOF\n"); exit(1); }
    sscanf(sbf, "%d%d", iv1,iv2);
}
void gparmf2(char *str, float *fv1, float *fv2)
{   prompt(str);
    if (parmin(LSBF,sbf) < 0) { prompt("- EOF\n"); exit(1); }
    sscanf(sbf, "%f%f", fv1,fv2);
}
void gparmd2(char *str, double *dv1, double *dv2)
{   prompt(str);
    if (parmin(LSBF,sbf) < 0) { prompt("- EOF\n"); exit(1); }
    sscanf(sbf, "%lf%lf", dv1,dv2);
}

/***********************/
/*  FORTRAN interface  */
/***********************/
void prompt_(char *str, size_t ls)
{   int i, c;
    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); }
void dpcent_(int *m, int *n) { dpcent(*m, *n); }
void opnpin_() { if (opnpin() != 0) exit(1); }
void clspin_() { if (clspin() != 0) exit(1); }
void parmin_(char *str, int lbuf, char *buf, size_t ls)
{   prompt_(str,ls);
    if (parmin(LSBF,sbf) < 0) { prompt("- EOF\n"); exit(1); }
}
int lwkdir_(int *len, char *dnm)
{   int n; char *p, lswdr[LDIR+80+24]="sh -c \'ls -CF ";
    p=&lswdr[14]; if (get_wkdir(p,LDIR+83) != 0) exit(1);
    if ((n=strlen(p)) >= *len)
        { fprintf(stderr, "- too long directory-name\n"); exit(1); }
    strcpy(dnm,p); strcat(p," >&2 \'");
    system(lswdr); return(n);
}
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) { prompt("- EOF\n"); 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) { prompt("- EOF\n"); 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) { prompt("- EOF\n"); 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) { prompt("- EOF\n"); 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) { prompt("- EOF\n"); 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) { prompt("- EOF\n"); 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) { prompt("- EOF\n"); 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) { prompt("- EOF\n"); 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) { prompt("- EOF\n"); exit(1); }
    sscanf(sbf, "%lf%lf", &d1,&d2); *dv1 = d1; *dv2 = d2;
}