Sindbad~EG File Manager

//
//  bblockseries.c
//  MathXpert Calculus Assistant
//
//  Created by Michael Beeson on 11/6/23.
//

#include <string.h>
#include <assert.h>
#include <stddef.h>  /* ptrdiff_t */


#include "terms.h"
#include "display.h"
#include "display1.h"
#include "dispfunc.h"
#include "arith.h"
#include "polyval.h"
#include "defns.h"
#include "vaux.h"
#include "feval.h"    /* segment */
#include "pvalaux.h"  /* twoparts */
#include "deval.h"    /* deval   */
#include "english.h"
#include "pstring.h"   /* paren */

static void erase_colors(term *t);
static term pseudo_atom(char *x);


/*___________________________________________________________________________*/
int bblock_series(term expr, term *newexpr,US sizein, US op, US dir)
/* expr is an infinite series to be written in ... form, that is, a SUM term
of arity 5.  The last argument is a positive or negative integer n.  If negative
it means that the general term is not to be shown.  If positive, the general
term is to be shown.  The absolute value of n is the number of initial terms to be
shown.  This cannot be zero.
   We call polyval to simplify the terms to be shown, so that we get e.g.
1-x+x^2-x^3  instead of (-1)^0 x^0 + (-1)^1 x + (-1)^2 x^ - (-1)^3 x^3.
But this will cause crashes (e.g. if the lower limit of summation is an atom
instead of an integer) in case the expression being displayed is just being
parsed from a menu or reason string, and its variables are not in the varlist
and hence have no valid value pointers, etc.  Therefore we have to temporarily
add them to varlist and in the end restore the original varlist by setting
nvariables back where it was.
  The lower limit of the sum should be a specific integer.
*/

{ long nterms;
  unsigned short i,m;
  int showgeneralterm,err;
  term u,k,lo,info,temp,v,p,x,c,s;
  double z,saveval;
  int saveflag;
  int save_nvariables;
  aflag flag1,flag2;
  if(FUNCTOR(expr) != SUM || ARITY(expr) != 5)
	  return 1;
  flag1 = flag2 = get_arithflag();
  flag1.intexp = flag1.ratexp = flag1.negexp = flag1.fract = flag1.gcd = 0;
  flag1.flt = DEVALCOEF(expr) ? 1 : 0;
  flag1.factorial = EVALFACTORIAL(expr) ? 1 : 0;
  set_arithflag(flag1);
  saveflag = get_polyvalzeropowerflag();
  u = ARG(0,expr);
  k = ARG(1,expr);
  lo = ARG(2,expr);
  info = ARG(4,expr);
  showgeneralterm = NEGATIVE(info) ? 0 : 1;
  if(NEGATIVE(info))
	  info = ARG(0,info);
  if(!ISINTEGER(info))
	  return 1;
  nterms = INTDATA(info);
  if((nterms + 2) & 0xffff0000L)
	  return 1;  /* we need nterms + 2 to be an unsigned short too */
  m = (unsigned short) (nterms + 1 + 2 * showgeneralterm);
  temp = make_term('+',m);
  set_polyvalzeropowerflag(1);
  save_nvariables = get_nvariables();
  vaux(expr);
  set_valuepointers(&lo);
  set_valuepointers(&u);
  if(contains_functions(u))
     { /* example:  the series for tan(x)  has defined-function coefficients c(n) */
       long a;
       if(ISINTEGER(lo))
          a = INTDATA(lo);
       else if(NEGATIVE(lo) && ISINTEGER(ARG(0,lo)))
          a = -INTDATA(ARG(0,lo));
       else
          { set_polyvalzeropowerflag(saveflag);
            set_arithflag(flag2);
            set_nvariables(save_nvariables);
            return 1;  // lower limit was not an integer;  this should never occur
          }
       err = segment(u,k,a,a+nterms-1,flag1.flt,ARGPTR(temp));
       if(!err)
          goto out;
       /* else continue and just print c0 + c1 x + c2 x^2 + ...  */
     }
  if(DEVALCOEF(expr))
     { x = get_eigenvariable();
       twoparts(u,x,&c,&s);
       saveval = VALUE(k);
       for(i=0;i<nterms;i++)
          { SETVALUE(k,(double)i);
				deval(u,&z);
				if(ISINTEGER(lo))
               p = make_int(INTDATA(lo) + i);
				else
               polyval(sum(lo,make_int(i)),&p);
            subst(p,k,s,&v);
            ARGREP(temp,i,signedproduct(make_double(z),v));
          }
       SETVALUE(k,saveval);
     }
  else
     { for(i=0;i<nterms;i++)
          { if(ISINTEGER(lo))
               p = make_int(INTDATA(lo) + i);
            else
               polyval(sum(lo,make_int(i)),&p);
            subst(p,k,u,&v);
            polyval(v,ARGPTR(temp)+i);
            erase_colors(ARGPTR(temp)+i);
          }
     }
  out:
  set_polyvalzeropowerflag(saveflag);
  set_arithflag(flag2);
  set_nvariables(save_nvariables);
  ARGREP(temp,(unsigned short) nterms,pseudo_atom("..."));
  /* the cast to unsigned short does not lose data because
	  we already returned if nterms does not fit */
  if(showgeneralterm)
	  { ARGREP(temp,(unsigned short)(nterms+1),u);
		 ARGREP(temp,(unsigned short)(nterms+2), pseudo_atom("..."));
	  }
  return bb(temp,newexpr,sizein,op,dir);
}

/*_____________________________________________________________________*/
static void erase_colors(term *t)
/* erase the color info in all subterms of *t */
/* as 'erasecolors' this is exported by automode.dll, but
	a copy is placed here to avoid dependence of symsout.dll on automode.dll
*/
{ unsigned i,n;
  if(COLOR(*t))   /* don't try to erase the color bit unless it's set, because
							if you try SETCOLOR on one of the constant integers, it
							causes an access violation in Win32 */
     SETCOLOR(*t,0);
  if(!ATOMIC(*t))
     { n = ARITY(*t);
       for(i=0;i<n;i++)
          erase_colors(ARGPTR(*t) + i);
     }
}

/*______________________________________________________________________*/
static term pseudo_atom(char *x)
/* Make a new atom which will print out x as its name when it
is bblocked and then displayed.  In order that this should work
without the 'symbols' array of MathXpert, we just make the ARGPTR
of the atom point to x, if it's more than one character long,
or doesn't satisfy isalpha (as when the character is PRIMECHAR),
and give it functor PSEUDOATOM. If it's one character long and
satisfies isalpha, we just use it for the functor. */

{ term ans;
  if(x[1]=='\0' && isalpha((unsigned char)x[0]))
     /* a one-character string which is a letter */
     { ans =  MAKE_ATOM(x[0]);
       return ans;
     }
  SETFUNCTOR(ans,PSEUDOATOM,0);
  ZEROINFO(ans);  /* to make sure the color is zero */
  LVARGPTR(ans) = (void *) x;
  return ans;
}