home *** CD-ROM | disk | FTP | other *** search
- #include "all.h"
- #include "regtabext.h"
-
- errfcn( x, erf,erfc,erfci,erfci2, deriv )
- float x, *erf,*erfc,*erfci,*erfci2, *deriv;
- /* ERROR FUNCTION AND ASSOCIATED FUNCTIONS */
- /* X - ARGUMENT OF ERROR FUNCTION. POSITIVE OR NEGATIVE */
-
- /* X */
- /* ERF = 2/SQRT(PI) S EXP( - T**2 ) DT */
- /* 0 */
-
- /* ERFC = 1.0 - ERF */
- /* ERFCI IS IERFC(X) */
- /* ERFCI = (1.0/SQRT(PI))*EXP(-X**2)-X(ERFC(X)) */
-
- /* ERFCI2 IS I**2ERFC(X) */
- /* ERFCI2 = 1/4 ((1+2*X**2)ERFC(X)- 2/SQRT(PI)*X*EXP(-X**2)) */
- /* OR ALTERNATIVELY */
- /* ERFCI2 = 1/4 (ERCF(X)-2*X*ERFCI(X)) */
-
- /* DERIV - D/DX OF ERF(X) */
-
- /* METHOD: RATIONAL APPROXIMATION */
-
- /* SOURCE: ABRAMOWITZ AND STEGUN, P.299, HANDBOOK OF */
- /* MATHEMATICAL FUNCTIONS AND CARSLAW AND JAEGER */
- /* CONDUCTION OF HEAT IN SOLIDS P. 482 */
- {
- double t, xx, rat, dexpxx;
- double derf, dderiv, derfc, derfci, derfci2;
- double t2,t3,t4;
-
- double p=0.3275911, a1=0.254829592, a2=-0.284496736;
- double a3=1.421413741, a4=-1.453152027, a5=1.061405429;
- double sqrtpi=1.772453851, pi=3.141592654;
-
- xx = fabs( (double) x);
- dexpxx = exp( -(xx*xx) );
- if( xx<1.0e-7 ) { /*use first two terms of taylor series expansion*/
- derf = (2.0 / sqrtpi) * xx * (1.0 - (xx*xx/3.0) );
- if( x<0.0 ) derf=(-derf);
- derfc = 1.0 - derf;
- }
- else { /*use rational approximation*/
- t = 1.0 / ( 1.0 + p*xx );
- t2 = t*t;
- t3 = t2*t;
- t4 = t2*t2;
- rat = (a5*t4 + a4*t3 + a3*t2 + a2*t + a1);
- derf = 1.0 - t*rat*dexpxx;
- if (x<0.0) {
- derf = (-derf);
- derfc = 2.0 - t*rat*dexpxx;
- }
- else {
- derfc = t*rat*dexpxx;
- } /*end if*/
- } /*end if*/
- xx = (double) x;
- derfci = (1.0/sqrtpi)*dexpxx-xx*derfc;
- derfci2 = 0.25 * (derfc-2.0*xx*derfci);
- dderiv = (2.0*dexpxx)/sqrtpi;
-
- *erf = (float) ( derf );
- *erfc = (float) ( derfc );
- *erfci = (float) (derfci);
- *erfci2 = (float) (derfci2);
- *deriv = (float) ( dderiv );
- }
-
-
- ToNaN(f)
- float *f;
- {
- if( (errno==EDOM) || (errno==ERANGE) ) {
- *f=infinity;
- }
- }
- SetVar( vName, vValue )
- char vName[], vValue[];
- /*create entry in macro substitution table and set value*/
- /*if variable previously exists, it is overwritten */
- /* returns false if the list is full or if not a valid variable name */
- /* valid variable names must not contain spaces */
-
- {
- int i, inList;
- char *index();
-
- if ( (strlen(vName)==0) || ((long)index(vName, ' ')!=0L) ) {
- return(FALSE);
- }
- else {
- inList = FALSE;
- i = 0;
- while ( (!inList) && (i<macVars.numVars) ) {
- if ( strcmp(vName,macVars.inStr[i]) == 0 ) {
- inList = TRUE;
- } /*end if inList*/
- i++;
- } /*end while*/
- if (inList) {
- strcpy( macVars.outStr[i-1], vValue );
- return( TRUE );
- }
- else {
- if ( (macVars.numVars+1) >= maxVars ) {
- return( FALSE );
- }
- else {
- strcpy( macVars.inStr[macVars.numVars], vName );
- strcpy( macVars.outStr[macVars.numVars], vValue );
- macVars.numVars++;
- return( TRUE );
- } /*end if enough space*/
- } /*end if not inList*/
- } /*end if valid name*/
- }
-
- DelVar( vName )
- char vName[];
- /* deletes macro substitution variable from table*/
- {
-
- int i, j, inList;
-
- if (macVars.numVars==0) {
- return( FALSE );
- }
- else {
- inList = FALSE;
- i = 0;
- while ( (!inList) && (i<macVars.numVars) ) {
- if ( strcmp(vName,macVars.inStr[i])==0 ) {
- inList = TRUE;
- } /*end if match*/
- i++;
- }
- i--; /*i now points to selected variable*/
- if (inList) {
- if (i != (macVars.numVars-1) ) { /*if not last in list, move others*/
- for ( j=(i+1); j<macVars.numVars; j++ ) {
- strcpy( macVars.inStr[j-1], macVars.inStr[j] );
- strcpy( macVars.outStr[j-1], macVars.outStr[j] );
- }
- } /*end if*/
- macVars.numVars--;
- return( TRUE );
- } /*end if inList*/
- else {
- return( FALSE );
- } /*end if not inList */
- } /*end if list not empty*/
- }
-
- ListVars()
- /* list macro substitution table */
- {
- int i;
-
- for( i=0; i<macVars.numVars; i++ ) {
- CheckAbortMenu();
- WritePhrase( "\'" );
- WritePhrase( macVars.inStr[i] );
- WritePhrase( "\' \'" );
- WritePhrase( macVars.outStr[i] );
- WriteLine( "\'" );
- } /* end for */
- }
-
- SBreak( command, macrosOn )
- commandRec *command;
- int macrosOn;
- /* breaks command string into command words that are separated by blanks */
- /* quoted blanks not broken */
- /* macro substitutions performed on all command words if macrosOn true */
- {
- int i, j, ibuf, len;
- char c[2];
- int quote, word, error, status;
-
- for( i=0; i<numCmdWds; i++ ) {
- strcpy( command->cmdWord[i], "" ); /*set command words to null*/
- }
-
- i = 0;
- j = 0;
- quote = FALSE;
- word = FALSE;
- error = FALSE;
- ibuf = 0;
- if( (len=strlen(command->cmdStr))==0) {
- return(TRUE);
- }
-
- c[1] = '\0';
- while ( (ibuf<len) && (!error) ) {
- if ( i >= cmdWordLen ) {
- error = TRUE;
- }
- else {
- c[0] = command->cmdStr[ibuf];
- if( j >= numCmdWds ) {
- error = TRUE;
- }
- else if ( ((c[0]==' ')||(c[0]=='\t')) && (!quote) ) {
- if (word) {
- word = FALSE;
- i = 0;
- j++;
- }
- }
- else if ( (c[0]==' ')||(c[0]=='\t') && quote ) {
- word = TRUE;
- strcat( command->cmdWord[j], c );
- i++;
- }
- else if ( (c[0]=='\'') && (!quote) ) {
- word = TRUE;
- quote = TRUE;
- }
- else if ( (c[0]=='\'') && quote ) {
- word = FALSE;
- quote = FALSE;
- i = 0;
- j++;
- }
- else {
- word = TRUE;
- strcat( command->cmdWord[j], c );
- i++;
- } /*end if on characters*/;
- } /*end if cmdWordLen*/
- ibuf++;
- } /*end while*/;
-
- status = FALSE;
- if ( !error ) {
- i = 0;
- status = TRUE;
- while ( (i<numCmdWds) && status && macrosOn ) {
- status = GetVar( command->cmdWord[i], command->cmdWord[i] );
- i++;
- } /*while numCmdWds*/;
- } /*if not error*/
-
- return( (!error) && status );
- }
-
- GetVar( vName, vValue)
- char vName[], vValue[];
- /* does macro-substitution on a variable reference*/
- /* does not change the value of VValue on no-match*/
- /* returns false only if no match occurs on a valid variable name*/
- /* where a valid variable reference*/
- /* a) starts with a @ */
- /* b) contains no spaces */
-
- {
- int i, len;
- int inList;
- char *index();
-
- if( ((long)index(vName,' ')!=0L) || ((long)index(vName,'@')!=(long)vName) ) {
- /*not a variable reference*/
- return(TRUE);
- }
- else if ( (len=strlen(vName)) < 2 ) { /*string consisting only of @ is invalid*/
- return(FALSE);
- }
- else if (macVars.numVars==0) { /*is valid reference but no variables defined*/
- return(FALSE);
- }
- else { /* is a valid variable reference */
- inList = FALSE;
- i = 0;
- while ( (!inList) && (i<macVars.numVars) ) {
- if (strcmp( &(vName[1]) , macVars.inStr[i] ) == 0) {
- inList = TRUE;
- } /*end if*/
- i++;
- } /*end while*/
- if (inList) {
- strcpy( vValue, macVars.outStr[i-1] );
- return(TRUE);
- } /*end if inList*/
- else {
- return(FALSE);
- } /*end if not inList*/
- } /* end if valid reference*/
- }
-
- done()
- {
- if( doneFlag ) {
- if( CautionAlert(quitAlertRes, NULL)==1 ) {
- return(TRUE);
- }
- else {
- return(FALSE);
- }
- }
- else {
- return(FALSE);
- }
- }
-
- GoodRow( row ) /* returns 0 if 1<=row<=rows, 1 if rows<row<=maxrows, 2 otherwise */
- int row;
- {
- if( (row>=1) && (row<=table.header.rows) ) {
- return(0);
- }
- else if( (row>table.header.rows) && (row<=table.header.maxRows) ) {
- return(1);
- }
- else {
- return(2);
- }
- }
-
- GoodCol( col ) /* returns 0 if 1<=col<=cols, 1 if cols<col<=maxcols, 2 otherwise */
- int col;
- {
- if( (col>=1) && (col<=table.header.cols) ) {
- return(0);
- }
- else if( (col>table.header.cols) && (col<=table.header.maxCols) ) {
- return(1);
- }
- else {
- return(2);
- }
- }
-
- ErrMsg( message )
- char message[];
- {
- int i;
- char s[80];
-
- HiliteMenu(0);
- RedoEditWindow();
- if( currentWindow!=coWindow ) {
- SetPort(theWindow[coWindow]);
- SelectWindow( theWindow[coWindow] );
- currentWindow = coWindow;
- whichWindow = theWindow[coWindow];
- }
- (*coText)->selStart = (*coText)->teLength;
- (*coText)->selEnd = (*coText)->teLength;
- TEInsert( "Error: ", 7L, coText );
- TEInsert( message, (long)strlen(message), coText );
- TEInsert( "\r", 1L, coText );
- if( mem.active ) { /*turn off procedure*/
- TESetSelect( (long)((*prText)->lineStarts[mem.stack[mem.stackPtr]]),
- (long)((*prText)->lineStarts[mem.stack[mem.stackPtr]+1]),
- prText );
- pendingFlag=FALSE;
- NoPendingInput();
- for (i=mem.stackPtr; i>=0; i-- ) {
- IToS( mem.stack[i]+1, s );
- TEInsert("called from line ",17L,coText);
- TEInsert(s, (long)strlen(s), coText );
- TEInsert("\r", 1L, coText);
- }
- mem.active=FALSE;
- mem.stackPtr=-1;
- loops.numLoops=0;
- }
- TEInsert( "> ", 2L, coText );
- IfOutScroll( coText );
- SysBeep(5);
- longjmp(envbuf,-1);
- }
-
- WriteLine( message )
- char message[];
- {
- if( currentWindow!=coWindow ) {
- SetPort(theWindow[coWindow]);
- SelectWindow( theWindow[coWindow] );
- currentWindow = coWindow;
- whichWindow = theWindow[coWindow];
- }
- (*coText)->selStart = (*coText)->teLength;
- (*coText)->selEnd = (*coText)->teLength;
- TEInsert( &message[0], (long)strlen(message), coText );
- TEInsert( "\r", 1L, coText );
- IfOutScroll( coText );
- }
-
- WritePhrase( message )
- char message[];
- {
- if( currentWindow!=coWindow ) {
- SetPort(theWindow[coWindow]);
- SelectWindow( theWindow[coWindow] );
- currentWindow = coWindow;
- whichWindow = theWindow[coWindow];
- }
- (*coText)->selStart = (*coText)->teLength;
- (*coText)->selEnd = (*coText)->teLength;
- TEInsert( &message[0], (long)strlen(message), coText );
- IfOutScroll( coText );
- }
-
-
- CheckAbortMenu()
- {
- Point mPoint;
- if (Button() != 0) {
- GetMouse( &mPoint );
- LocalToGlobal( &mPoint );
- if( PtInRect( pass(mPoint), &abortRect ) != 0 ) {
- SysBeep(20);
- SetPort(theWindow[coWindow]);
- SelectWindow( theWindow[coWindow] );
- currentWindow = coWindow;
- whichWindow = theWindow[coWindow];
- if( mem.active ) { /*turn off procedure*/
- mem.active=FALSE;
- mem.stackPtr=-1;
- loops.numLoops=0;
- pendingFlag=FALSE;
- NoPendingInput();
- }
- TEInsert( "Abort!\r",7L,coText);
- TEInsert( "> ", 2L, coText );
- IfOutScroll( coText );
- RedoEditWindow();
- HiliteMenu(0);
- longjmp(envbuf,-1);
- } /*end if abort menu and item*/
- } /*end if mouse is down*/
- HiliteMenu(0);
- }
- PendingInput()
- {
- DisableItem( myMenu[apMenu], 0 );
- DisableItem( myMenu[fiMenu], 1 );
- DisableItem( myMenu[fiMenu], 4 );
- DisableItem( myMenu[fiMenu], 7 );
- DisableItem( myMenu[edMenu], 0 );
- DisableItem( myMenu[wiMenu], 3 );
- DisableItem( myMenu[wiMenu], 4 );
- }
-
- NoPendingInput()
- {
- EnableItem( myMenu[apMenu], 0 );
- EnableItem( myMenu[fiMenu], 1 );
- EnableItem( myMenu[fiMenu], 4 );
- EnableItem( myMenu[fiMenu], 7 );
- EnableItem( myMenu[edMenu], 0 );
- EnableItem( myMenu[wiMenu], 3 );
- EnableItem( myMenu[wiMenu], 4 );
- }
-
- Graph2Vars()
- {
- int status;
- char s[cmdWordLen];
-
- RToS( graph.xMin, s );
- status = SetVar( "xmin", s );
-
- RToS( graph.xMax, s );
- status = status && SetVar( "xmax", s );
-
- RToS( graph.yMin, s );
- status = status && SetVar( "ymin", s );
-
- RToS( graph.yMax, s );
- status = status && SetVar( "ymax", s );
-
- if( !status ) {
- ErrMsg("couldnt create graphics variables");
- }
- }
-
- FindLabel( s, line) /*search for particular label and return its line number*/
- char s[];
- int *line;
- {
- commandRec tCommand;
- int i, j, k, match;
-
- match = FALSE;
- *line = 0;
- for( i=0; (i<mem.numLabels && (!match)); i++) { /*search label list*/
- j=(*prText)->lineStarts[mem.labels[i]];
- k=((*prText)->teLength)-1;
- HLock((*prText)->hText);
- ExtractLine( *((*prText)->hText), j, k, tCommand.cmdStr );
- HUnlock((*prText)->hText);
- if( !SBreak( &tCommand, FALSE ) ) {
- WriteLine("(find) bad line in procedure:");
- /*ErrMsg(tCommand.cmdStr);*/
- }
- if (strcmp(tCommand.cmdWord[1],s)==0) {
- match = TRUE;
- *line = mem.labels[i];
- }
- } /*end for*/
- return( match );
- }
-
- ListLabels() /*constructs label list from current contents of procedure memory*/
- {
- commandRec tCommand;
- int i, j, k, badLine;
-
- mem.numLabels = 0;
- badLine=FALSE;
- for( i=0; i<(*prText)->nLines; i++) {/*scan memory sequentially*/
- j=(*prText)->lineStarts[i];
- k=((*prText)->teLength)-1;
- HLock((*prText)->hText);
- ExtractLine( *((*prText)->hText), j, k, tCommand.cmdStr );
- HUnlock((*prText)->hText);
- if( !SBreak( &tCommand, FALSE ) ) {
- TESetSelect( (long)((*prText)->lineStarts[i]), (long)((*prText)->lineStarts[i+1]),
- prText );
- WriteLine("bad line in procedure:");
- WriteLine(tCommand.cmdStr);
- badLine=TRUE;
- }
- if( strcmp(tCommand.cmdWord[0],"label")==0 ) {
- mem.labels[mem.numLabels] = i;
- mem.numLabels++;
- }
- } /*end for*/
- if( badLine ) {
- ErrMsg("procedure aborted");
- }
- }
-
- ExtractLine(c, start, end, cc)
- char c[];
- int start, end;
- char cc[];
- {
- int i;
- for( i=0; ( (i<(end-start+1)) && (i<(cmdWordLen-1)) ); i++ ) {
- cc[i] = c[i+start];
- if (cc[i]=='\r') {
- cc[i] = '\0';
- break;
- }
- }
- cc[i] = '\0';
- }
-
- RedoEditWindow()
- {
- GrafPtr oldPort;
- int oldWindow;
-
- GetPort( &oldPort );
- oldWindow=currentWindow;
-
- SetPort( theWindow[edWindow] );
- InvalRect( &(theWindow[edWindow]->portRect) );
- tabEd.activeName=FALSE;
- tabEd.activeEntry=FALSE;
-
- SetPort( oldPort );
- currentWindow=oldWindow;
- whichWindow=theWindow[currentWindow];
- }
-
-
-
-
-
-