home *** CD-ROM | disk | FTP | other *** search
/ WinWares 1 / WINWARES.ISO / calc / tablecrv / c.tcl < prev    next >
Encoding:
Text File  |  1993-06-01  |  13.6 KB  |  439 lines
  1. ~~C~~
  2. /*--------------------------------------------------------------*
  3.                TableCurve C Library Module
  4.  *--------------------------------------------------------------*/
  5.  
  6. #include <dos.h>
  7. #include <stdio.h>
  8. #include <stdlib.h>
  9. #include <math.h>
  10.  
  11. /*--------------------------------------------------------------*
  12.    Although the full calling routine for the functions is 
  13.    specific to the Borland Turbo-C++/2.0 and Microsoft C 5.x/6.x
  14.    compilers, the generated code has been designed for simplicity
  15.    and for portability using standard ANSI C and standard 
  16.    BIOS/DOS system calls. Only the system interrupt function 
  17.    int86() and the system registers union REGS are likely to be
  18.    compiler-dependent.
  19.  *--------------------------------------------------------------*/
  20.  
  21. /*--------------------------------------------------------------*
  22.    Floating point exceptions are math errors such as numeric
  23.    overflow and division by zero that normally abort a program
  24.    dumping the user back to DOS. Included in the TableCurve
  25.    generated code is a way to mask these errors with the Turbo-C
  26.    and Microsoft C compilers. This code uses _control87()
  27.    to mask all exceptions and a user matherr() function to
  28.    resolve such errors in math routine calls such as pow(),
  29.    log(), exp(), and so forth. 
  30.                   ------------------------   
  31.    Note for Microsoft compilers: The /NOE option is required
  32.    with the linker since the matherr() function is duplicated. 
  33.    The following batch file commands can be used:
  34.                        cl -c -AS %1.c  
  35.                        link %1 /NOE ;
  36.                   ------------------------
  37.    This code for masking floating point exceptions will be added
  38.    by uncommenting the following #define MASKFPERR.
  39.  *--------------------------------------------------------------*/
  40.  
  41. /* #define MASKFPERR */    /* uncomment for masking math errors */
  42.  
  43. #ifdef MASKFPERR
  44. #include <float.h>
  45. #define CW_NEW (CW_DEFAULT | EM_ZERODIVIDE  | EM_OVERFLOW)
  46. #define MASK_ALL (0xFFFF)
  47. #endif
  48.  
  49. /*--------------------------------------------------------------*
  50.    function prototypes
  51.  *--------------------------------------------------------------*/
  52. void display(int cnt);
  53. void cursor(int row, int col);
  54. int getattr(void);
  55. int getvmode(int *iscolor);
  56. void cls(int attr);
  57. void clsblk(int top, int left, int btm, int right, int attr);
  58. void psa(char *str, int attr, int row, int col);
  59. void pca(char c, int attr, int row, int col);
  60. void setwin(int trow, int lcol, int brow, int rcol, int attr,
  61.   int border, char *title);
  62. int numfld(char *fld, int row, int col, int maxlen, int attr);
  63. double rtbis(double y,int dir);
  64. double `FNAME`(double x);
  65.  
  66. double _x[17],_y[17];
  67.  
  68. /*--------------------------------------------------------------*/
  69. void main(void)
  70. /*--------------------------------------------------------------*/
  71. {
  72.   int i,irow=6,j,gooddata,vmode,iscolor,dir=0;
  73.   int attr0,attr1,attr2;
  74.   char temp[80];
  75.  
  76. #ifdef MASKFPERR
  77.   _control87(CW_NEW|EM_INVALID,MASK_ALL);  /* mask all exceptions */
  78. #endif
  79.  
  80.   attr0=getattr();               /* screen attribute at startup */
  81.   getvmode(&iscolor);            /* get video mode and color flag */    
  82.   if(iscolor){
  83.     attr1=1|(7<<4);              /* main window color attribute */
  84.     attr2=15|(1<<4);             /* xy data window color attribute */
  85.     }
  86.   else{
  87.     attr1=15|(0<<4);             /* main window monochr. attribute */
  88.     attr2=0|(7<<4);              /* xy data window monochr. attribute */
  89.     }
  90.   cls(attr1);
  91.  
  92.   strcpy(temp,
  93.     " TableCurve `LANG` Function:`FILE` `DATE` `TIME` ");
  94.   setwin(0,1,24,78,attr1,2,temp);  /* main window */
  95.   strcpy(temp," `TITLE` ");
  96.   setwin(4,32,23,76,attr2,1,temp); /* x-y data window */
  97.   psa("`XTITLE`",attr2,5,34);
  98.   psa("`YTITLE`",attr2,5,56);
  99.  
  100.   psa("`EQSTR`",attr1,2,3);       /* equation data summary */
  101.   psa("Eqn# `EQNO`",attr1,3,5);
  102.   psa("r2=`R2VAL`",attr1,4,5);
  103.   psa("a= `ASTR`",attr1,5,5);
  104.   psa("b= `BSTR`",attr1,6,5);
  105.   psa("c= `CSTR`",attr1,7,5);
  106.   psa("d= `DSTR`",attr1,8,5);
  107.   psa("e= `ESTR`",attr1,9,5);
  108.   psa("f= `FSTR`",attr1,10,5);
  109.   psa("g= `GSTR`",attr1,11,5);
  110.   psa("h= `HSTR`",attr1,12,5);
  111.   psa("i= `ISTR`",attr1,13,5);
  112.   psa("j= `JSTR`",attr1,14,5);
  113.   psa("k= `KSTR`",attr1,15,5);
  114.   psa("X= `XTITLE`",attr1,17,3);
  115.   psa("Y= `YTITLE`",attr1,18,3);
  116.   psa("Enter Value [x=,y=]",attr1,20,3);
  117.   psa("Press Esc to End Program",attr1,23,3);
  118.  
  119.   while(1){                                 /* data entry loop */
  120.     j=irow-6;
  121.     gooddata=numfld(temp,21,3,25,attr2);    /* numeric input */
  122.     if(gooddata==0){
  123.       cls(attr0);
  124.       exit(-1);                             /* exit with escape */
  125.       }
  126.     else if(gooddata>0){
  127.       _x[j]=atof(temp);                     /* x entry */
  128.       _y[j]=`FNAME`(_x[j]);                 /* calculate y-value */
  129.       }
  130.     else{
  131.       _y[j]=atof(temp);                     /* y entry */
  132.       _x[j]=rtbis(_y[j],++dir%2);           /* find x root, alternate dir */
  133.       }
  134.     if(irow==22)
  135.       clsblk(22,33,22,75,attr2);            /* clr row at btm of window */
  136.     sprintf(temp,"%.12lg",_x[j]);
  137.     psa(temp,attr2,irow,34);
  138.     sprintf(temp,"%.12lg",_y[j]);
  139.     psa(temp,attr2,irow,56);
  140.     if(++irow>22)
  141.       irow=22;
  142.     }
  143. }
  144.  
  145. #ifdef MASKFPERR
  146. /*--------------------------------------------------------------*/
  147. int matherr(struct exception *m)
  148. /*--------------------------------------------------------------*/
  149. {
  150.   if(m->type==UNDERFLOW){
  151.     m->retval=0;
  152.     return(1);
  153.     }
  154.   m->retval=0;     /* can change to any default return value */
  155.   return(1);
  156. }
  157. #endif
  158.  
  159. /*--------------------------------------------------------------*/
  160. void cursor(int row, int col)
  161. /*--------------------------------------------------------------*/
  162. {                  /* Sets Cursor Position (row=0,col=0 Origin) */
  163.   union REGS rin,rout;
  164.   rin.h.ah=2;
  165.   rin.h.bh=0;
  166.   rin.h.dh=row;
  167.   rin.h.dl=col;
  168.   int86(0x10,&rin,&rout);
  169. }
  170.  
  171. /*--------------------------------------------------------------*/
  172. int getattr(void)
  173. /*--------------------------------------------------------------*/
  174. {
  175.   union REGS rin,rout;
  176.   rin.h.ah=8;                        /* get attribute at cursor */
  177.   rin.h.bh=0;
  178.   int86(0x10,&rin,&rout);
  179.   return((int)rout.h.ah);
  180. }
  181.  
  182. /*--------------------------------------------------------------*/
  183. int getvmode(int *iscolor)
  184. /*--------------------------------------------------------------*/
  185. {
  186.   union REGS rin,rout;
  187.   int mode;
  188.   rin.h.ah=15;                              /* get display mode */
  189.   int86(0x10,&rin,&rout);
  190.   mode=(int)rout.h.al;
  191.   *iscolor=1;
  192.   if(mode==0 || mode==2 || mode==7)
  193.     *iscolor=0;
  194.   return(mode);          /* sets color flag, returns video mode */
  195. }
  196.  
  197. /*--------------------------------------------------------------*/
  198. void cls(int attr)
  199. /*--------------------------------------------------------------*/
  200. {                /* Clears Screen w/Attribute, Cursor to Origin */
  201.   union REGS rin,rout;
  202.   rin.h.ah=6;  
  203.   rin.h.al=0;
  204.   rin.h.bh=attr;
  205.   rin.h.ch=0;  /* top row */
  206.   rin.h.cl=0;  /* top column */
  207.   rin.h.dh=24; /* bottom row */
  208.   rin.h.dl=79; /* bottom column */
  209.   int86(0x10,&rin,&rout);
  210.   cursor(0,0);
  211. }
  212.  
  213. /*--------------------------------------------------------------*/
  214. void clsblk(int top, int left, int btm, int right, int attr)
  215. /*--------------------------------------------------------------*/
  216. {             /* Clears Screen Block w/Attribute, Cursor Inside */
  217.   union REGS rin,rout;
  218.   rin.h.ah=6;  
  219.   rin.h.al=0;
  220.   rin.h.bh=attr;
  221.   rin.h.ch=top;     /* top row */
  222.   rin.h.cl=left;    /* top column */
  223.   rin.h.dh=btm;     /* bottom row */
  224.   rin.h.dl=right;   /* bottom column */
  225.   int86(0x10,&rin,&rout);
  226.   cursor(top+1,left+1);
  227. }
  228.  
  229. /*--------------------------------------------------------------*/
  230. void psa(char *str, int attr, int row, int col)
  231. /*--------------------------------------------------------------*/
  232. {                        /* Write String w/attribute at row,col */
  233.   while (*str)
  234.     pca(*str++,attr,row,col++);  
  235. }
  236.  
  237. /*--------------------------------------------------------------*/
  238. void pca(char c, int attr, int row, int col)
  239. /*--------------------------------------------------------------*/
  240. {
  241.   union REGS rin,rout;
  242.   cursor(row,col);           /* set cursor */
  243.   rin.h.ah=9;                /* print char with attribute */
  244.   rin.h.al=c;
  245.   rin.h.bh=0;
  246.   rin.h.bl=attr;
  247.   rin.x.cx=1;
  248.   int86(0x10,&rin,&rout);
  249. }
  250.  
  251. /*--------------------------------------------------------------*/
  252. void setwin(int trow, int lcol, int brow, int rcol, int attr,
  253.   int border, char *title)
  254. /*--------------------------------------------------------------*/
  255. {                                /* Set Simple Window and Title */
  256.   int tl,tr,bl,br,lr,tb,i,length;
  257.   clsblk(trow,lcol,brow,rcol,attr);
  258.   if(border==1){                 /* Single Border */
  259.     tl=218; tr=191; bl=192; br=217; lr=196; tb=179;
  260.     }
  261.   else{                          /* Double Border */
  262.     tl=201; tr=187; bl=200; br=188; lr=205; tb=186;
  263.     }
  264.   pca(tl,attr,trow,lcol);
  265.   pca(bl,attr,brow,lcol);
  266.   pca(tr,attr,trow,rcol);
  267.   pca(br,attr,brow,rcol);
  268.   for(i=lcol+1; i<rcol; i++){
  269.     pca(lr,attr,trow,i);
  270.     pca(lr,attr,brow,i);
  271.     }
  272.   for(i=trow+1; i<brow; i++){
  273.     pca(tb,attr,i,lcol);
  274.     pca(tb,attr,i,rcol);
  275.     }
  276.   i=0;
  277.   while(title[i++]!='\0');
  278.   length=i-1;
  279.   psa(title,attr,trow,(rcol+lcol)/2-length/2);
  280. }
  281.  
  282. /*--------------------------------------------------------------*/
  283. int numfld(char *fld, int row, int col, int maxlen, int attr)
  284. /*--------------------------------------------------------------*/
  285.   /* Simple Numeric Input Routine                           *
  286.    * fld      storage for number as char string             *
  287.    * row,col  starting cursor position for field            *
  288.    * maxlen   field length                                  *
  289.    * attr     entry field attribute                         *
  290.    * returns  entry length(x), -entry length(y), 0(ESC hit) */
  291. {
  292.   int i,j,yflag,expflag,pass;
  293.   char c;
  294.  
  295.   for(j=0;j<maxlen;j++)
  296.     pca(32,attr,row,col+j);
  297.   cursor(row,col);
  298.   i=j=yflag=expflag=0;
  299.   while(i<maxlen){
  300.     c=getch();
  301.     pass=0;
  302.     if(i==0){
  303.       if(c=='y' || c=='Y'){   /* allow Y only in first position */
  304.         yflag=1;              /* set flag for Y being entered */
  305.         pass=1;               /* do not include character in return string */
  306.         }
  307.       if(c=='x' || c=='X')    /* allow X only in first position */
  308.         pass=1;
  309.       }
  310.     if(i==1 && c=='=')        /* allow = only in second position */
  311.       pass=1;
  312.     if((c>='0' && c<='9') || c=='-' ||  c=='.' || c=='+' ||
  313.       ( (c=='E' || c=='e') && !expflag ) || pass){
  314.       pca(c,attr,row,col+i);      /* print character */
  315.       cursor(row,col+i+1);        /* advance cursor */
  316.       i++;
  317.       if(!pass)
  318.         fld[j++]=c;
  319.       if(c=='E' || c=='e')   /* flag first occurence of E for sci notn */
  320.         expflag=1;
  321.       }
  322.     else if((c==10 || c==13 || i==maxlen) && i!=0)
  323.       break;
  324.     else if(c=='\b' && i>0){
  325.       i--;
  326.       pca(32,attr,row,col+i);
  327.       if(i==0)
  328.         yflag=0;
  329.       if(j!=0){
  330.         j--;
  331.         if(fld[j]=='E' || fld[j]=='e')
  332.           expflag=0;
  333.         fld[j]=0;
  334.         }
  335.       }
  336.     else if(c==27)
  337.       return(0);
  338.     }
  339.   fld[j]='\0';
  340.   return(yflag?-j:j);
  341. }
  342.  
  343. /*--------------------------------------------------------------*/
  344. double rtbis(double y,int dir)
  345. /*--------------------------------------------------------------*/
  346.   /* root bisection routine */
  347.   /* dir=0 starts at lowest partition, dir=1 starts at highest partition */ 
  348.   /* last chance is partition from XatYmin to XatYmax */
  349.   /* returns 0 upon failure to find root */
  350. {
  351.   double x1,x2,xinc,dx,f,fmid,xmid,rtb,xacc;
  352.   int i,j;
  353.   xacc=1E-6*`XMEAN`;       /* convergence limit */
  354.   xinc=`XRANGE`/4.0;
  355.   for(i=0;i<5;i++){        /* x-scale into 4 partitions */
  356.     if(i==4){
  357.       x1=`XATYMIN`;
  358.       x2=`XATYMAX`;
  359.       }
  360.     else{
  361.       if(dir){
  362.         x2=`XMAXIMUM`-xinc*(double)i;
  363.         x1=`XMAXIMUM`-xinc*(double)(i+1);
  364.         }
  365.       else{
  366.         x1=`XMINIMUM`+xinc*(double)i;
  367.         x2=`XMINIMUM`+xinc*(double)(i+1);
  368.         }
  369.       }
  370.     f=y-`FNAME`(x1);
  371.     fmid=y-`FNAME`(x2);
  372.     if(f*fmid >=0)
  373.       continue;
  374.     rtb = (f<0.0) ? (dx=x2-x1,x1) : (dx=x1-x2,x2);
  375.     for(j=1; j<=100; j++){
  376.       fmid=y-`FNAME`(xmid=rtb+(dx*= 0.5));
  377.       if(fmid<=0)
  378.         rtb=xmid;
  379.       if(fabs(dx)<xacc || fmid==0.0)
  380.         return(rtb);
  381.       }
  382.     }
  383.   return(0);
  384. }
  385.  
  386. !!C!!
  387. #include <math.h> `SCOPE`
  388. double erf(double x)`ERF`
  389. {`ERF`
  390.   double t,z,ans;`ERF`        
  391.   z=fabs(x);`ERF`
  392.   t=1.0/(1.0+0.5*z);`ERF`
  393.   ans=(t*exp(-z*z-1.26551223+t*(1.00002368+t*(0.37409196+t*(0.09678418+`ERF`
  394.     t*(-0.18628806+t*(0.27886807+t*(-1.13520398+t*(1.48851587+`ERF`
  395.     t*(-0.82215223+t*0.17087277))))))))));`ERF`
  396.   return x>=0.0 ? 1.0-ans : -1.0+ans;`ERF`
  397. }`ERF`
  398.  
  399. /*--------------------------------------------------------------*/
  400. double `FNAME`(double x)
  401. /*--------------------------------------------------------------*
  402.    TableCurve Function: `FILE` `DATE` `TIME`
  403.    `TITLE`
  404.    X= `XTITLE`
  405.    Y= `YTITLE`
  406.    Eqn# `EQNO`  `EQSTR`
  407.    r2=`R2VAL`
  408.    r2adj=`R2ADJ`
  409.    StdErr=`STDERR`
  410.    Fstat=`FVAL`
  411.    a= `ASTR`
  412.    b= `BSTR`
  413.    c= `CSTR`
  414.    d= `DSTR`
  415.    e= `ESTR`
  416.    f= `FSTR`
  417.    g= `GSTR`
  418.    h= `HSTR`
  419.    i= `ISTR`
  420.    j= `JSTR`
  421.    k= `KSTR`
  422.  *--------------------------------------------------------------*/
  423. {
  424.   double y;
  425.   double n;`FDECLN`
  426.   double `FLIST`;
  427.   x=`FX`;
  428.   n=`FBAL2`;
  429.   n=`FAUX`;
  430.   x1=`F1`;
  431.   x2=`F2`;
  432.   x3=`F3`;
  433.   x4=`F4`;
  434.   y=`EQNCODE`;
  435.   return(`FY`);
  436. }
  437. !!C!!
  438. ~~C~~
  439.