Sindbad~EG File Manager
/* lesser-used parts of bblock */
/*
6.1.90 original date
2.21.99 last modified
1.9.00 modified bblock_cases
6.17.04 removed conditional 16-bit compilation
9.5.04 added include pstring
8.24.07 modified bblock_constant_of_integration to use functor_width, to get POLYGAMMA right
9.2.07 changed sizeof(short) to sizeof(coord) at line 268
9.8.11 cast return value of strlen to int for 64-bit compilation
5.8.13 include <stddef.h>, changed ARGPTR to LVARGPTR in pseudo_atom
1.5.15 bblock_series should not be called unless lower limit is an integer. Made it return 1 for failure in that case.
11.5.23 added EXCLUDEENGLISH so this file can compile without "english"
11.21.23 modifed bblock_sqrt and bblock_root for parenwidth and sqrtspace
12.23.23 modified bbblock_prime for UTF-8
11.28.23 modified bblock_integral replacing 16 by 17 to make the height a little bigger.
1.12.24 corrected bblock_logb1.
2.3.24 changed charwidth in bblock_limit
2.6.24 changed bblock_diff
11.24.24 gave get_productspace a size argument
1.13.25 moved b.size = sizein; up in bblock_integral, because it has
to be passed to get_productspace. Also added b.size = sizein; in bblock_diff
and bblock_hidiff and bblock_logb1
1.14.25 and bblock_def_integral and bblock_abs.
*/
#include <stdio.h> // for debugging printf statements
#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 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;
}
/*________________________________________________________________*/
int bblock_subscripted_function(term expr,term *newexpr,US sizein ,US op,US dir)
/* a function of one or more arguments whose first argument should be printed as a subscript,
for example, the Bessel functions.
This is used for constants of integration, too, which have only the subscripted argument.
*/
{ block b;
unsigned long width;
unsigned short f = FUNCTOR(expr);
unsigned n = ARITY(expr); /* one for the subscript, n-1 variables */
int err;
unsigned i;
int FunctorWidth;
err = bb(ARG(0,expr),ARGPTR(*newexpr) + 1,EIGHTPOINT,ROOT,LEFT);
if (err)
return err;
b.h = (coord)(HEIGHT(ARG(1,*newexpr)) + 8);
if(f == CONSTANTOFINTEGRATION)
FunctorWidth = atom_width('c', sizein);
else
FunctorWidth = functor_width(f,sizein);
width = FunctorWidth + WIDTH(ARG(1,*newexpr));
for(i=1;i<n;i++)
{ err = bb(ARG(i,expr),ARGPTR(*newexpr)+i+1, sizein,ROOT,RIGHT);
if(err)
return err;
width += WIDTH(ARG(i+1,*newexpr));
}
b.wl = 8;
if(n > 1)
width += 2*get_parenwidth(sizein); /* for the parentheses */
if(n > 2) /* there are n-2 commas separating the n-1 variables */
width += (n-2) * get_parenwidth(sizein); /* space for the commas */
if(width > MAXWIDTH)
return 2;
b.w = width;
b.size = sizein;
b.leftbra = b.rightbra = 0;
b.extra = 0;
SETBLOCK(*newexpr,b);
return 0;
}
/*____________________________________________________________________*/
int bblock_list(int lineupflag, term expr,term *newexpr,US sizein,US op,US dir)
/* a term with functor LIST is bblocked and displayed like a MATRIX, but without
bars. It's used for titles in ode graphs.
*/
{ return bblock_matrix(lineupflag, expr, newexpr, sizein, op, NOBARS);
}
/*____________________________________________________________________*/
/* matrix(vector(a,b),vector(c,d)) for example */
/* A matrix is a term with arity 'nrows'; each argument is a term with
functor 'vector' and arity 'ncols'; but the rows can't be bblocked
separately, because then the columns wouldn't line up right. */
/* On entering this function, space has been allocated for args to
newexpr, that is, for the rows; but the args of those terms, i.e. the
entries, haven't been allocated. */
/* The bblocked term has arity nrows+2, and each of its args 1,...,nrows
has arity ncols+1, and their args 1,...,ncols contain the bblocked entries.
The last arg is used to point to a dynamic array of column-width numbers. */
/* see display.h for macros ENTRY, ROWS, COLUMNS, etc. */
int bblock_matrix(int lineupflag, term expr,term *newexpr,US sizein,US op,US dir)
/* lineupflag is 1 when we are bblocking a linear system via this function;
0 if it's just an actual matrix. */
{ block b;
term entry;
unsigned long width = 0 ,height = 0;
int err,i,j;
long temp;
short rows, columns;
coord *columnwidths;
unsigned long rowheight, columnwidth, rowlevel;
unsigned long entryheight, entrywidth, entrylevel;
rows = ROWS(expr);
columns = COLUMNS(expr);
columnwidths = (coord *) callocate(columns,sizeof(coord));
if(columnwidths == NULL)
return 1;
COLUMNWIDTHS(*newexpr,rows)=columnwidths;
for(i=1;i<=rows;i++) /* allocate space for the entries of newexpr */
ARG(i,*newexpr)= make_term(VECTOR,(unsigned short)(columns+1));
/* now bblock the entries */
for(i=0;i<rows;i++)
for(j=0;j<columns;j++)
{ err = bb(ENTRY(i,j,expr), /* the entry to be bblocked */
ENTRYPTR(i+1,j+1,*newexpr), /* where to put it */
sizein,MATRIX,RIGHT /* passing MATRIX in 'op' place gets no parens on the entries */
);
if(err)
return 1; /* out of space */
}
/* now calculate the correct placement of the entries */
/* on each row the water levels must line up */
/* First calculate the row heights and levels */
for(i=0;i<rows;i++)
{ rowheight = 0;
rowlevel = 8;
for(j=0;j<columns;j++)
{ entry = ENTRY(i+1,j+1,*newexpr);
if(FUNCTOR(entry) == ILLEGAL) /* void term */
entryheight = entrylevel = 8;
else
{ entryheight = HEIGHT(entry);
entrylevel = LEVEL(entry);
}
temp = (long)(entryheight-entrylevel)-(long)(rowheight-rowlevel);
/* if temp > 0 then the term sticks out that far below
the row so far */
if(entrylevel > rowlevel)
{ rowheight += entrylevel - rowlevel;
rowlevel = entrylevel;
}
if(temp > 0)
rowheight += temp;
}
b = GETBLOCK(ARG(i+1,*newexpr));
if(rowheight > MAXHEIGHT)
return 2; /* too big */
b.h = (coord) rowheight;
b.wl = (coord) rowlevel;
/* widths of the rows are unknown yet and size is irrelevant */
SETBLOCK(ARG(i+1,*newexpr),b);
height += rowheight + get_matrixspace();
if(height > MAXHEIGHT)
return 2; /* too big */
}
height -= get_matrixspace();
/* because we added matrixspace with every row, but we don't need
a space after the last row */
/* Now for the width */
for(j=0;j<columns;j++)
{ columnwidth = 0;
for(i=0;i<rows;i++)
{ entry = ENTRY(i+1,j+1,*newexpr);
if(FUNCTOR(entry)==ILLEGAL) /* void term */
entrywidth = get_charspace();
else
entrywidth = WIDTH(entry);
if(lineupflag && j>0 && j < columns-2 &&
(FUNCTOR(entry) != ILLEGAL) /* non-void term */
&& FUNCTOR(entry) != '-'
)
/* then leave room for a + sign, unless all preceding terms in this
row are void */
{ int p;
term priorentry;
for(p=0;p<j;p++)
{ priorentry = ENTRY(i+1,p+1,*newexpr);
if(FUNCTOR(priorentry) != 0 || ARITY(priorentry) != 0) /* nonvoid*/
break;
}
if(p < j) /* this isn't the first nonvoid entry on this row */
entrywidth += get_sumspace(b.size) + get_charspace();
/* but note, this width doesn't get put into the block of the entry */
}
if(entrywidth > columnwidth)
columnwidth = entrywidth;
}
width += columnwidth;
if(j > 0)
width += get_sumspace(b.size); /* space before this column */
if(columnwidth > MAXWIDTH)
return 2;
columnwidths[j] = (coord) columnwidth;
}
if(paren(op,MATRIX,dir))
{ b.bra = BRACKETS;
b.leftbra = b.rightbra = 1;
width += 2*(get_parenspace(sizein) + get_parenwidth(sizein));
/* for brackets and space between brackets and entries */
height += get_matrixspace(); /* brackets stick out matrixspace/2 above and below */
}
else
{ b.leftbra = b.rightbra = 0;
width += 2*get_parenwidth(sizein); /* for spaces between determinant bars and entries */
}
if(height > MAXHEIGHT)
return 2; /* too big */
b.h = (coord) height;
b.wl = (coord)(b.h/2); /* geometric midpoint */
if(width > MAXWIDTH)
return 2;
b.w = width;
b.size = sizein;
b.extra = 0;
SETBLOCK(*newexpr,b);
/* If the rows of the original matrix were colored, color the rows
of the bblocked matrix accordingly */
for(i=1;i<=rows;i++)
SETCOLOR(ARG(i,*newexpr),COLOR(ARG(i-1,expr)));
return 0;
}
/*___________________________________________________________________*/
/* sum(arg,index,lo,hi) e.g. sum(i^2,i,0,n) */
/* The middle of the sigma lines up with the water level of the summand */
int bblock_indexed_sum(term expr,term *newexpr,US sizein,US op,US dir)
{ block b;
unsigned long width;
long height;
coord charwidth = (coord)(sizein == TENPOINT ? 16 : 13);
// coord charheight = (coord)(sizein == TENPOINT ? get_charspace(): get_eightpointheight());
coord subscriptwidth;
term upper,newlo,newhi,newarg,newindex;
bb(ARG(0,expr),ARGPTR(*newexpr)+1, sizein, SUM, LEFT);
bb(ARG(1,expr),ARGPTR(*newexpr) + 2,EIGHTPOINT,SUM,LO);
bb(ARG(2,expr),ARGPTR(*newexpr) + 3,EIGHTPOINT,SUM,LO);
upper = ARG(3,expr);
bb(upper,ARGPTR(*newexpr) + 4,EIGHTPOINT,SUM,HI);
newarg = ARG(1,*newexpr);
newindex = ARG(2, *newexpr);
newlo = ARG(3,*newexpr);
newhi = ARG(4,*newexpr);
#ifndef SVG
subscriptwidth = (coord)(WIDTH(newlo) + WIDTH(newindex) + 21);
/* 21 for the '=' sign even though it's in EIGHTPOINT;
less makes it look too crowded */
#else
subscriptwidth = (coord)(WIDTH(newlo) + WIDTH(newindex) );
#endif
width = (unsigned long)(WIDTH(newarg) + MAXIMUM((unsigned)subscriptwidth,WIDTH(newhi)) + charwidth);
/* leave a space after the summation sign and limits before the argument */
if(paren(op,SUM,dir))
{ b.leftbra = b.rightbra = 1;
b.bra = PARENS;
width += 2*get_parenspace(sizein) + 2*get_parenwidth(sizein);
}
else
b.leftbra = b.rightbra = 0;
if(width>MAXWIDTH)
return 2;
b.w = width;
b.wl = (coord)(MAXIMUM(HEIGHT(newhi) + 6, LEVEL(newarg)));
height = (coord)(b.wl + MAXIMUM(HEIGHT(newarg) - LEVEL(newarg), HEIGHT(newlo) + get_charspace()/2));
if(height > MAXHEIGHT)
return 2;
b.h = (coord) height;
b.size = sizein;
b.extra = 0;
SETBLOCK(*newexpr,b);
return 0;
}
/*______________________________________________________________________*/
/* Terms with functor PR will always have arity 2
expr = PR(f(u),1) should be printed as f'(u);
PR(f(u),2) should be f''(u); and so also f'''(u);
PR(u,1) should be printed as u'
PR(u+v,1) as (u+v)'
PR(f(x,y),1) as f'(x,y)
PR(f(x,y),2) as f''(x,y)
if the number of primes is not an integer or is more than 6
then it should be enclosed in parentheses and raised like an
exponent.
There are four cases to consider in the display:
0. No args and no raised exponent: u' is the simplest case.
1. No args and a raised exponent as in prime(u,8):
height is HEIGHT(u) + charspace-raisedexponent + HEIGHT(exp),
and the level is LEVEL(u) + charspace -raisedexponent + HEIGHT(exp).
2. Args as in f'(x) and no raised exponent:
then line up the water levels of the args and f,
and print the primes at the top of f,
viz. y + level - charspace.
3. With args and a raised exponent; then u=f(v) with f atomic.
print the exponent at y + LEVEL(u)-charspace.
*/
static char primesymbols[28] = // 9 copies of the 3-character PRIMESTR
{ '\xE2','\x80','\xB2','\xE2','\x80','\xB2','\xE2','\x80','\xB2',
'\xE2','\x80','\xB2','\xE2','\x80','\xB2','\xE2','\x80','\xB2',
'\xE2','\x80','\xB2','\xE2','\x80','\xB2','\xE2','\x80','\xB2',
'\0'
};
int bblock_prime(term expr,term *newexpr, US sizein,US op,US dir)
{ block b;
term u,exp,arg1,arg2,e;
int excess,overlap;
char *printstring;
int flag=1; /* eventually to be the case number as in the comments above */
unsigned short f;
unsigned long n;
unsigned long height,width=0;
int primeswidth;
u = ARG(0,expr);
f = FUNCTOR(u);
exp = ARG(1,expr);
/* first decide which of the four cases we are in */
if(ISINTEGER(exp))
{ n = INTDATA(exp); /* number of primes to print */
if(n==0)
return bb(u,newexpr,sizein,op,dir); /* 0'th deriv is the function itself */
if(n > 0x00fe)
return 2; /* too many primes by far! */
if ((0 < (US) n) && ((US) n < 7) )
{ flag = 0; /* don't need raised exponent */
printstring = primesymbols + 27 - (int)(3*n);
e = pseudo_atom(printstring);
/* primesymbols is a string of 9 primes */
arg2 = make_term(FUNCTOR(e),2);
bblock_atom(e,&arg2,sizein);
b = GETBLOCK(arg2);
bb(exp,&arg2,sizein,PR,RIGHT);
primeswidth = (int) n * functor_width(PR,sizein); /* for the primes */
b.w = primeswidth;
SETBLOCK(arg2,b);
/* Changing the metric information to correspond to
the space required to print ''' instead of "3"
for example */
*((char **)(ARGPTR(arg2)+1)) = printstring;
/* replacing the string "3" by the string "'''" for example,
so when display_object hits it, you'll get ''' printed,
yet we have an object in the term, not a PSEUDOATOM, so
that when locate_term makes an lterm, it contains an object,
so that 'abstract' can recover the original term. */
ARGREP(*newexpr,2,arg2);
width += primeswidth;
}
}
/* Now flag tells us whether we need a raised exponent or not.
Next determine if we have args to print */
if( !paren(PR,f,LEFT) /* f is not +, -, *, /, ^ */
&& !ATOMIC(u) )
flag +=2; /* that sets the case number correctly */
bb(u,ARGPTR(*newexpr)+1,sizein,PR,LEFT);
arg1 = ARG(1,*newexpr);
width += WIDTH(arg1);
if(flag & 1) /* we do need raised exponent, cases 1 and 3 */
{ bb(exp,ARGPTR(*newexpr) + 2,EIGHTPOINT,PR,RIGHT);
arg2 = ARG(2,*newexpr);
b=GETBLOCK(arg2);
if(b.leftbra == 0) /* exponent has no left paren already */
{ b.leftbra = 1;
b.w += get_parenwidth(EIGHTPOINT);
}
if(b.rightbra == 0)
{ b.rightbra = 1;
b.w += get_parenwidth(EIGHTPOINT);
}
SETBLOCK(*(ARGPTR(*newexpr)+2),b);
SETBLOCK(arg2,b);
/* this forces parentheses around the "exponent", even if
if is a number; since bblock_object doesn't consult paren,
assuming instead that numbers never need parentheses, we have
to force it here. */
width += WIDTH(arg2);
}
/* Now arg1 and arg2 are properly bblocked.
Let's calculate the block of the whole term. */
if(width > MAXWIDTH)
return 2;
switch(flag)
{ case 0: /* no args, no raised exponent */
b=GETBLOCK(arg1);
b.w = width;
b.leftbra = b.rightbra = 0;
break;
case 1: /* No args and a raised exponent as in prime(u,8) */
height = HEIGHT(arg1) + get_charspace()-6 + HEIGHT(arg2);
if (height > MAXHEIGHT)
return 2;
b.w = width;
b.h = (coord) height;
b.wl = (coord)(LEVEL(arg1) + get_charspace() -6+ HEIGHT(arg2));
b.size = sizein;
b.leftbra = b.rightbra = 0;
break;
case 2: /* args and no raised exponent, as in f''(x) */
b= GETBLOCK(arg1);
b.w = width;
b.leftbra = b.rightbra = 0;
break;
case 3: /* args and a raised exponent as in prime(f(x),8) */
b = GETBLOCK(arg1);
b.w = width;
overlap = get_charspace() - 6;
/* amount by which exponent overlaps function name in height */
/* The question is, does arg1 stick out above the exponent? */
excess = b.wl - (get_charspace()/2 + HEIGHT(arg2) - overlap);
if(excess < 0)
/* it does not stick out */
{ height = HEIGHT(arg1) + excess;
if(height > MAXHEIGHT)
return 2;
b.h = (coord) height;
b.wl = (coord)(b.wl + excess);
}
/* else if it does stick out, no change in height and water level */
b.size = sizein;
b.leftbra = b.rightbra = 0;
break;
}
b.size = sizein;
b.extra = 0;
SETBLOCK(*newexpr,b);
return 0;
}
/*_______________________________________________________________*/
/* lim(x->0,f(x)) or lim(x->0,LEFT,f(x)) or lim(x->0,RIGHT,f(x)) */
int bblock_limit(term expr, term *newexpr,US sizein,US op ,US dir)
/* bblock a limit term. The water level of lim(x->a,u)
is the water level of u, but the lim(x->a.. part is not
displayed like a fraction without the bar, i.e. with the water level
between lim and x->a; instead, the water level is in the
middle of "lim", and the x->a is tacked on below, separated
from the lim by internal leading in the subscript only.
*/
{ block b;
unsigned long width,height;
int halfheight = (sizein == TENPOINT ? 8 : 6);
coord extraspace;
long belowlevel;
int i,err;
term arg,subscript;
coord limwidth = functor_width(LIMIT, (unsigned char) sizein);
coord charwidth = (coord)(sizein == TENPOINTHEIGHT ? 12 : 9);
unsigned short arity = ARITY(expr); /* 2 or 3; 3 for one-sided limit */
i = arity == 2 ? 1 : 2; /* which arg number is the arg */
err = bb(ARG(i,expr),ARGPTR(*newexpr)+i+1,sizein,SUM,LEFT);
if (err)
return err;
err = bb(ARG(0,expr),ARGPTR(*newexpr)+1,EIGHTPOINT,SUM,LO);
if (err)
return err;
if(arity==3)
{ err = bb(ARG(1,expr), ARGPTR(*newexpr)+2, EIGHTPOINT,ARROW,RIGHT);
/* Even though display_limit only checks the functor, it
still must be a bblocked term, not just a regular term, for
type consistency and so bb_copy doesn't crash. */
if(err)
return err;
}
if(arity==2)
arg = ARG(2,*newexpr);
else
arg = ARG(3,*newexpr);
subscript = ARG(1,*newexpr);
width = WIDTH(arg) + MAXIMUM(WIDTH(subscript),limwidth) + charwidth;
/* one space is left blank after the subscript before the limitand,
that's why the +charspace in the previous line; the subscript is
always at least three characters so we avoid 'limf(x)' automatically */
if(arity==3)
width += 3;
if(paren(op,LIMIT,dir))
{ b.leftbra = b.rightbra = 1;
b.bra = PARENS;
width += 2*get_parenwidth(sizein) + 2*get_parenspace(sizein);
}
else
b.leftbra = b.rightbra = 0;
if (width > MAXWIDTH)
return 2;
b.w = width;
b.wl = LEVEL(arg);
belowlevel = HEIGHT(arg) - LEVEL(arg);
extraspace = (coord) halfheight;
/* this is the amount of space below the water level
and above the subscript. It's charspace/2 (in TENPOINT) since
the water level is in the middle of 'lim'. But in EIGHTPOINT
it must be correspondingly smaller.
*/
if(HEIGHT(subscript) + extraspace > belowlevel)
belowlevel = HEIGHT(subscript) + extraspace;
height = b.wl + belowlevel;
if(height > MAXHEIGHT)
return 2;
b.h = (coord) height;
b.size = sizein;
b.extra = 0;
SETBLOCK(*newexpr,b);
return 0;
}
/*______________________________________________________________*/
int bblock_logb1(term expr, term *newexpr, US sizein, US op, US dir)
/* index is written as a subscript; water level is at the
middle of "log", and is used for the upper coord of the index.
After the index a 'productspace' comes before the arg.
*/
{ block b;
unsigned long height,width;
term arg,base;
int err;
err = bb(ARG(1,expr),ARGPTR(*newexpr) + 2, sizein,LOGB,RIGHT);
if (err)
return err;
err = bb(ARG(0,expr),ARGPTR(*newexpr) + 1, EIGHTPOINT,LOGB,LEFT);
if(err)
return err;
arg = ARG(2,*newexpr);
base = ARG(1,*newexpr);
b.wl = LEVEL(arg);
height = b.wl + MAXIMUM(HEIGHT(base), HEIGHT(arg)-LEVEL(arg));
if (height > MAXHEIGHT)
return 2;
b.h = (coord) height;
b.size = sizein;
width = WIDTH(arg) + WIDTH(base) + get_powerspace() + functor_width(LOG,(short) sizein) + get_productspace(b.size);
/* for "log" + powerspace (before the index) + productspace (after the index) */
if(paren(op,LOG,dir))
{ b.leftbra= b.rightbra = 1;
b.bra = PARENS;
width += 2*get_parenspace(sizein) + 2*get_parenwidth(sizein);
}
else
b.leftbra = b.rightbra = 0;
if(width > MAXWIDTH)
return 2;
b.w = width;
b.size = sizein;
b.extra = 0;
SETBLOCK(*newexpr,b);
return 0;
}
/*____________________________________________________________________*/
int bblock_as_matrix(term expr, term *newexpr,US sizein, US op, US dir)
{ int i,err;
term temp;
temp = make_term(MATRIX,ARITY(expr));
for(i=0;i<ARITY(expr);i++)
{ ARGREP(temp,i,make_term(VECTOR,1));
ARGREP(ARG(i,temp),0,ARG(i,expr));
}
err = bblock_matrix(0,temp,newexpr,sizein,op,dir);
for(i=0;i<ARITY(expr);i++)
RELEASE(ARG(i,temp));
RELEASE(temp);
/* anddisplay ==2 for bars, 1 for no bars. If it's 1 we must correct: */
if(
(get_anddisplay()==1 && FUNCTOR(expr) == AND) ||
(get_ordisplay()==1 && FUNCTOR(expr)==OR)
)
/* no bars */
{ block b;
b= GETBLOCK(*newexpr);
b.leftbra = 0;
b.rightbra = 0;
b.w = (unsigned long)(b.w -( 2*(get_parenspace(sizein) + get_parenwidth(sizein))));
b.h = (coord)(b.h-get_matrixspace()); /* height was taller for brackets too */
b.wl = (coord)(b.wl-get_charspace());
SETBLOCK(*newexpr,b);
}
return err;
}
/*___________________________________________________________________*/
int bblock_linear_system(term expr, term *newexpr,US sizein, US op, US dir)
/* expr has functor LINEARSYSTEM, and arity 2. The 0-th arg is an AND
representing a system of linear equations, to be bblocked as a matrix so the
variables will be lined up. The 1st arg is another AND, giving a list
of atoms to be treated as the variables. All other atoms are regarded as
constants. It is presumed that the system is indeed linear in these
variables--that is checked before creating a term with functor LINEARSYSTEM.
The number of columns is 2 plus the number
of variables; the last column for the right hand sides, the next-to-last
column for the = signs. We create a suitable MATRIX term and call
bblock_matrix. */
/* It is ASSUMED that there is at most one term on each lhs containing
each variable, and that no constant terms are on the left */
{ int i,j,p,k,err;
term temp;
term *varlist = ARGPTR(ARG(1,expr));
unsigned short n = ARITY(ARG(1,expr)); /* the number of variables */
term empty; /* a 'void term' to hold places where coefficients are zero */
unsigned short m;
term eq = MAKE_ATOM('=');
term lhs;
expr = ARG(0,expr); /* the system itself */
m = ARITY(expr); /* number of equations */
SETFUNCTOR(empty,ILLEGAL,0); /* make it a void term */
temp = make_term(MATRIX,m);
for(i=0;i<m;i++)
{ ARGREP(temp,i,make_term(VECTOR,(unsigned short)(n+2)));
assert(INEQUALITY(FUNCTOR(ARG(i,expr))));
lhs = ARG(0,ARG(i,expr)); /* left side of i-th equation */
if(ZERO(lhs)) /* put void entries in all but the last column on left side */
{ for(j=0;j<n-1;j++)
ARGREP(ARG(i,temp),j,empty);
ARGREP(ARG(i,temp),n-1,lhs); /* lhs, not 'zero', in case lhs is colored */
}
else /* lhs isn't zero, the normal case */
{ k = 0;
for(j=0;j<n;j++)
{ /* identify the term in lhs containing varlist[j], if any */
if(FUNCTOR(lhs) != '+') /* lhs has only one term */
{ if (contains(lhs,FUNCTOR(varlist[j])))
{ ARGREP(ARG(i,temp),k,lhs);
++k;
}
else /* put a void term in */
{ ARGREP(ARG(i,temp),k,empty);
++k;
}
}
else /* FUNCTOR(lhs) == '+' */
{ for(p=0;p<ARITY(lhs);p++)
{ if (contains(ARG(p,lhs), FUNCTOR(varlist[j])))
/* there has to be only one term or we wouldn't be
using this function */
{ ARGREP(ARG(i,temp),k,ARG(p,lhs)); /* found it */
if(COLOR(lhs))
SETCOLOR(ARG(k,ARG(i,temp)),COLOR(lhs));
++k;
break;
}
}
if(p==ARITY(lhs)) /* didn't find it */
{ ARGREP(ARG(i,temp),k,empty); /* put a void term in */
k++;
}
}
}
}
ARGREP(ARG(i,temp),n,eq); /* equality sign */
ARGREP(ARG(i,temp),n+1,ARG(1,ARG(i,expr))); /* rhs of i-th equation */
}
for(i=0;i<ARITY(expr);i++)
{ if(COLOR(ARG(i,expr)))
SETCOLOR(ARG(i,temp),COLOR(ARG(i,expr))); /* pass colors of rows through */
}
err = bblock_matrix(1,temp,newexpr,sizein,op,dir);
for(i=0;i<ARITY(expr);i++)
RELEASE(ARG(i,temp));
RELEASE(temp);
/* anddisplay ==2 for bars, 1 for no bars. If it's 1 we must correct: */
if(
(get_anddisplay()==1 && FUNCTOR(expr) == AND) ||
(get_ordisplay()==1 && FUNCTOR(expr)==OR)
)
/* no bars */
{ block b;
b = GETBLOCK(*newexpr);
b.leftbra = 0;
b.rightbra = 0;
b.w = (unsigned long)(b.w - 4*get_charspace());
b.h = (coord)(b.h - get_matrixspace()); /* height was taller for brackets too */
b.wl = (coord)(b.wl - get_charspace());
SETBLOCK(*newexpr,b);
}
return err;
}
/*___________________________________________________________________*/
int bblock_type(term expr,term *newexpr, US sizein,US op,US dir)
/* bblock an expression like n : INTEGER. Possible values of the type
variable are INTEGER, R, RATIONAL, NATNUM, DCOMPLEX. */
/* The output term is given functor '*', so display will just display the
first arg and then the second arg. The second arg is bblocked as an
atom, and given a display string like " \in N". (Originally these strings
were written out in English, like "is an integer", but this takes too
much space in the assumption window.) */
{ int err, typecode;
term arg1,arg2;
unsigned long width;
term temp;
block b;
char *displaystring;
assert(ISINTEGER(ARG(1,expr)));
typecode = (int) INTDATA(ARG(1,expr));
switch(typecode)
{ case INTEGER: displaystring = "Z";
break;
case RATIONAL: displaystring = "Q";
break;
case R : displaystring = "R";
break;
case NATNUM: displaystring = "N";
break;
case DCOMPLEX: displaystring = "C";
break;
default: assert(0);
}
temp = pseudo_atom(displaystring);
err = bb(temp,&arg2,sizein,':',RIGHT);
if (err)
return err;
err = bb(ARG(0,expr),&arg1,sizein,':',LEFT);
if (err)
return err;
b = GETBLOCK(arg1);
width = b.w + WIDTH(arg2);
if(paren(op,LOG,dir))
{ b.leftbra= b.rightbra = 1;
b.bra = PARENS;
width += 2*get_parenspace(sizein) + 2*get_charspace();
}
else
b.leftbra = b.rightbra = 0;
width += (int) strlen(displaystring)*get_charspace() + 2*get_charspace();
/* 2 for the spaces to left and right of \in */
if(width > MAXWIDTH)
return 2;
b.w = width;
ARGREP(*newexpr,1,arg1);
ARGREP(*newexpr,2,arg2);
b.size = sizein;
b.extra = 0;
SETBLOCK(*newexpr,b);
return 0;
}
/*___________________________________________________________________________*/
int bblock_integral(term expr,term *newexpr,US sizein,US op,US dir)
{ block b;
unsigned long width, height;
int err;
coord dwidth = atom_width('d',(short) sizein);
coord submerged;
term arg1,arg2;
err = bb(ARG(0,expr),ARGPTR(*newexpr) + 1,sizein,INTEGRAL,LEFT);
if (err)
return err;
err = bb(ARG(1,expr),ARGPTR(*newexpr) + 2,sizein,INTEGRAL,RIGHT);
if (err)
return err;
arg1 = ARG(1,*newexpr);
arg2 = ARG(2,*newexpr);
b.wl = (coord)(MAXIMUM(16,MAXIMUM(LEVEL(arg1),LEVEL(arg2))));
/* upper half of integration is at least 16 coord units
above water level.
*/
b.size = sizein; // this can't wait till the end because it's passed to get_productspace.
submerged = (coord)( MAXIMUM(
HEIGHT(arg1)-LEVEL(arg1), /* submerged part of integrand */
HEIGHT(arg2)-LEVEL(arg2) /* submerged part of 'variable'*/
));
/* the integral sign always sticks out at least 16 coord units below
water level, hence the MAXIMUM in the next line */
height = (coord)(b.wl + MAXIMUM(16, submerged));
width = (coord)( WIDTH(arg1) + WIDTH(arg2) +
get_integralsignwidth() + dwidth /* for integral and 'd' */
+ get_productspace(b.size) + /* after integral */
get_productspace(b.size)); /* before 'd' */
/* no space after 'd' */
if( paren(op,INTEGRAL,dir) )
{ b.leftbra = b.rightbra = 1;
b.bra = PARENS;
width += 2* get_charspace() + 2* get_parenspace(sizein); /* for parens and spaces */
}
else
b.leftbra = b.rightbra = 0;
if (width > MAXWIDTH)
return 2;
b.w = width;
if (height > MAXHEIGHT)
return 2;
b.h = (coord) height;
b.size = sizein; // done already above
b.extra = 0;
SETBLOCK(*newexpr,b);
return 0;
}
/*____________________________________________________________________*/
/* Taller limits of integration are displaced further
vertically so the lower edge of the the upper limit
and upper edge of the lower limit are where they would be
for one-line limits. */
int bblock_def_integral(term expr,term *newexpr,US sizein,US op,US dir)
{ block b;
unsigned long width, height;
term lowerlimit, upperlimit;
SETFUNCTOR(expr,INTEGRAL,2); /* ignore the limits temporarily by
setting the arity to 2 */
bblock_integral(expr,newexpr,sizein,op,dir);
b = GETBLOCK(*newexpr);
b.size = sizein;
unsigned long tempw = b.w;
SETFUNCTOR(expr,INTEGRAL,4); /* restore original expr */
bb(ARG(2,expr),ARGPTR(*newexpr) + 3,EIGHTPOINT, INTEGRAL,LO);
bb(ARG(3,expr),ARGPTR(*newexpr) + 4,EIGHTPOINT,INTEGRAL, HI);
lowerlimit = ARG(3,*newexpr);
upperlimit = ARG(4,*newexpr);
height = b.h + HEIGHT(lowerlimit) + HEIGHT(upperlimit)-2*EIGHTPOINTHEIGHT + get_lowerlimy() + get_upperlimy();
if(height > MAXHEIGHT)
return 2;
b.h = (coord) height;
width = tempw + MAXIMUM(WIDTH(lowerlimit)+get_lowerlimx(),
WIDTH(upperlimit)+get_upperlimx()
);
/* lowerlimx and lowerlimy specify the horizontal space between the
integral symbol and the limits */
/* b.w already includes space before the integrand so we
don't add more here. */
b.wl = (coord)(b.wl + HEIGHT(upperlimit) - EIGHTPOINTHEIGHT + get_upperlimy());
if(paren(op,INTEGRAL,dir))
{ b.leftbra = b.rightbra = 1;
b.bra = PARENS;
width = (coord)(width + 2*get_parenspace(sizein) + 2*get_charspace());
}
else
b.leftbra = b.rightbra = 0;
if(width > MAXWIDTH)
return 2;
b.w = width;
SETBLOCK(*newexpr,b);
return 0;
}
/*____________________________________________________________________*/
int bblock_abs(term expr, term *newexpr, US sizein)
/* return a term with functor ABSFUNCTOR and .bra field BARS */
/* If you tinker with the spacing here, change save_space in display.c too */
{ block b;
unsigned long width;
int err;
term arg;
err = bb(ARG(0,expr),ARGPTR(*newexpr) + 1,sizein,ABSFUNCTOR,CENTRAL);
if(err)
return err;
arg = ARG(1,*newexpr);
width = WIDTH(arg) + 2; /* for the bars, which are only one pixel wide,
but we here give them one coord space. */
width += 2*get_parenspace(sizein); /* spaces next to the bars */
if(width > MAXWIDTH)
return 2;
b = GETBLOCK(arg);
b.size = sizein;
b.w = width;
b.bra = BARS;
b.leftbra=b.rightbra=1;
b.extra = 0;
SETBLOCK(*newexpr,b);
return 0;
}
/*____________________________________________________________________*/
int bblock_sqrt(term expr,term *newexpr,US sizein,US op,US dir)
{ block b;
unsigned long width,height;
int err;
term arg;
err = bb(ARG(0,expr),ARGPTR(*newexpr) + 1,sizein,SQRT,CENTRAL);
if (err)
return err;
arg = ARG(1,*newexpr);
b = GETBLOCK(arg);
height = b.h + 1 + get_belowrootbar(); /* space for the overbar */
if(height > MAXHEIGHT)
return 2;
b.h = (coord) height;
b.wl = (coord)(b.wl + 1 + get_belowrootbar()); /* if height didn't overflow neither will waterlevel */
width = b.w + 2*get_sqrtspace(); /* for the square root sign and space after the arg under the bar */
if(paren(op,SQRT,dir))
{ b.leftbra = b.rightbra = 1;
b.bra = PARENS;
width += 2*get_parenspace(sizein) + 2*get_parenwidth(sizein);
}
else
b.leftbra = b.rightbra = 0;
if( width > MAXWIDTH)
return 2;
b.w = width;
b.extra = 0;
SETBLOCK(*newexpr,b);
return 0;
}
/*_________________________________________________________________________*/
/*
The lower boundary of the index is 'indexspace' above the lower boundary
of the arg; the index is in eightpoint type.
There is 'rootspace' between the index and the root sign, but
rootspace is negative, so the index gets shoved over the root sign by
a bit. Then the arg is shifted left by undersqrtshift.
*/
int bblock_root(term expr,term *newexpr,US sizein ,US op,US dir)
{ block b;
coord h1,h2;
unsigned long width,height;
int err;
term arg1,arg2;
err = bb(ARG(0,expr),ARGPTR(*newexpr) + 1,EIGHTPOINT,ROOT,LEFT);
if (err)
return err;
err = bb(ARG(1,expr),ARGPTR(*newexpr) + 2, sizein,ROOT,RIGHT);
if(err)
return err;
arg1 = ARG(1,*newexpr);
arg2 = ARG(2,*newexpr);
h2 = (coord)( 1 + get_belowrootbar() + HEIGHT(arg2)); /* overbar and argument */
h1 = (coord)(get_indexspace() + HEIGHT(arg1)); /* index and space below index */
height = MAXIMUM(h1,h2);
if(height > MAXHEIGHT)
return 2;
b.h = (coord) height;
b.wl = (coord)(1 + get_belowrootbar() + LEVEL(arg2));
if(h1 > h2)
b.wl = (coord)(b.wl + h1-h2);
width = WIDTH(arg1) + get_rootspace() +
/* rootspace is negative so this places the index over the left of the root sign */
2*get_sqrtspace() /* for the sqrt sign and space after the arg under the bar */
- get_undersqrtshift() + WIDTH(arg2);
if(paren(op,ROOT,dir))
{ b.leftbra=b.rightbra=1;
b.bra = PARENS;
width += 2*get_parenspace(sizein) + 2*get_parenwidth(sizein);
}
else
b.leftbra = b.rightbra = 0;
if( width > MAXWIDTH)
return 2;
b.w = width;
b.extra = 0;
b.size = sizein;
SETBLOCK(*newexpr,b);
return 0;
}
/*________________________________________________________________________*/
/* simple derivative du/dx, not d^nu/dx^n */
int bblock_diff(term expr, term *newexpr,US sizein,US op,US dir)
{ block b;
b.size = sizein;
unsigned long width, height;
coord h1, h2;
coord charheight =(coord)(sizein == TENPOINT ? get_charspace() : get_eightpointheight());
coord charwidth = (coord)(sizein == TENPOINT ? 10 : 7);
int err;
term arg1,arg2;
err = bb(ARG(0,expr),ARGPTR(*newexpr) + 1,sizein,DIFF,LEFT);
if (err)
return err;
err = bb(ARG(1,expr),ARGPTR(*newexpr) + 2,sizein,DIFF,RIGHT);
if (err)
return err;
arg1 = ARG(1,*newexpr);
arg2 = ARG(2,*newexpr);
h1 = HEIGHT(arg1);
h2 = HEIGHT(arg2);
if(h1 < charheight)
h1 = charheight;
if(h2 < charheight)
h2 = charheight;
if(ATOMIC(ARG(0,expr)) && !(OBJECT(ARG(0,expr)) &&TYPE(ARG(0,expr)) == BIGNUM))
{ height = h1 + h2 + get_abovefractionspace() + get_belowfractionspace();
if (height > MAXHEIGHT)
return 2;
else
b.h = (coord) height;
if(paren(op,DIFF,dir)) /* then fraction must be enclosed in parens */
{ width = MAXIMUM(WIDTH(arg1),WIDTH(arg2)) +
2*get_parenwidth(sizein) + 2*get_parenspace(sizein) /* for parens and spaces by them */
+ charwidth + get_productspace(b.size); /* for 'd' and space after it */
if(width > MAXWIDTH)
return 2;
else
b.w = width;
b.leftbra= b.rightbra = 1;
b.bra = PARENS;
}
else
{ b.w = (MAXIMUM(WIDTH(arg1), WIDTH(arg2)) + get_charspace());
/* for 'd' */
b.leftbra = b.rightbra = 0;
}
b.wl = (coord)(h1 + get_abovefractionspace()); /* water level at the fraction bar */
b.size = sizein;
b.extra = 0;
SETBLOCK(*newexpr,b);
return 0;
}
/* if you get here, then expr was not atomic, i.e. was compound (or was a bignum)*/
/* find height and width of d/dX */
width = (coord)(WIDTH(arg2) + charwidth );
/* 1 for lower 'd' + 1 space */
b.wl = (coord)(MAXIMUM(LEVEL(arg1),charheight+get_abovefractionspace()));
b.h = (coord)(b.wl + MAXIMUM(
HEIGHT(arg1)-LEVEL(arg1), /* submerged part of arg1 */
MAXIMUM(charheight,HEIGHT(arg2))+get_belowfractionspace() /* submerged part of d/dX */
));
width = (coord)(width + WIDTH(arg1));
if( paren(op,DIFF,dir) )
{ b.leftbra = b.rightbra = 1;
b.bra = PARENS;
width = (coord)(width + 2*get_parenspace(sizein) + 2*charwidth); /* for parens and spaces */
}
else
b.leftbra = b.rightbra = 0;
if(width > MAXWIDTH)
return 2;
else
b.w = width;
b.size = sizein;
b.extra = 0;
SETBLOCK(*newexpr,b);
return 0;
}
/*____________________________________________________________________*/
/* term of the form diff(u,x,n), that is d^nu/dx^n. Like du/dx,
this is treated differently if u is atomic than if u is compound. Thus
for example (d^n/dx^n) (sin x). The latter form is also used if
^n is not atomic.
*/
int bblock_hi_diff(term expr,term *newexpr,US sizein,US op,US dir)
/* expr has the form diff(u,n,x) */
{ term u,x,n;
term ub, xb, nb;
block b;
b.size = sizein;
coord q,submerged;
coord charheight = (coord)(sizein == EIGHTPOINT ? get_charspace() : get_eightpointheight());
coord dwidth = atom_width('d',(short)sizein);
assert(ARITY(expr) == 3 && FUNCTOR(expr) == DIFF);
u = ARG(0,expr);
n = ARG(2,expr);
x = ARG(1,expr);
assert(ISATOM(x));
b.bra = b.rightbra = b.leftbra = 0;
bb(u,ARGPTR(*newexpr)+1,sizein,DIFF,LEFT);
bb(n,ARGPTR(*newexpr)+3,EIGHTPOINT,DIFF,CENTRAL);
bb(x,ARGPTR(*newexpr)+2,sizein,DIFF,RIGHT);
ub = ARG(1,*newexpr);
nb = ARG(3,*newexpr);
xb = ARG(2,*newexpr);
if(ATOMIC(u) && ATOMIC(n))
{ /* d^n u/dx^n */
/* use horizontal fraction bar, even in EIGHTPOINT */
q = (coord)(MAXIMUM(WIDTH(ub) + dwidth ,WIDTH(xb) + dwidth));
b.w = (WIDTH(nb) + q + get_powerspace());
b.h = (coord)(MAXIMUM(HEIGHT(ub),charheight) + MAXIMUM(HEIGHT(xb),charheight)
/* they might be subscripted */
+ 2*6 /* for the 'exponents' */
+ get_belowfractionspace() + get_abovefractionspace());
b.wl = (coord)(MAXIMUM(HEIGHT(nb),charheight) + 6 + get_abovefractionspace());
b.size = sizein;
SETBLOCK(*newexpr,b);
return 0;
}
/* Now either u or n is not atomic; so use the d^/dx^n u form
(with a horizontal fraction bar)
*/
b.w = (unsigned long)(dwidth + WIDTH(xb) + get_powerspace() + WIDTH(nb) + get_productspace(sizein) + WIDTH(ub));
b.wl = (coord)(charheight + 6 + get_abovefractionspace()); /* temporarily */
submerged = (coord)(MAXIMUM(HEIGHT(xb),charheight) + 6 + get_belowfractionspace());
/* height of dx^n + belowfractionspace */
b.h = (coord)(MAXIMUM(b.wl , LEVEL(ub)) + MAXIMUM(submerged, HEIGHT(ub)-LEVEL(ub)));
b.wl = (coord)(MAXIMUM(b.wl, LEVEL(ub)));
if( paren(op,DIFF,dir) )
{ b.leftbra = b.rightbra = 1;
b.bra = PARENS;
b.w = (unsigned long)(b.w + 2 * get_parenspace(sizein) + 2 * get_parenwidth(sizein));
/* spaces after/before parens and parens themselves*/
}
else
b.leftbra = b.rightbra = 0;
b.size = sizein;
b.extra = 0;
SETBLOCK(*newexpr,b);
return 0;
}
/*___________________________________________________________________*/
int bblock_cases(term expr, term *newexpr,US sizein, US op, US dir)
/* expr has functor CASES. The arity can be one or more. Each arg except
the last must be an IF term of arity 2. The last one may be an IF or
it may be just an expression. If it is not an IF, it is interpreted as an
"otherwise" clause. We create a suitable MATRIX term and call
bblock_matrix so that all the "if" 's will line up nicely. */
{ int i,err;
unsigned short m;
term row,temp;
char *tempstring;
term ifterm,otherwise,voidterm;
block b;
m = ARITY(expr); /* number of rows */
#ifdef EXCLUDEENGLISH
ifterm = pseudo_atom("if");
#else
ifterm = pseudo_atom((char *) english(2357)); /* if */
#endif
otherwise = pseudo_atom("ow");
/* So the middle column won't be too wide. After bblocking it
will get replaced with "otherwise" */
temp = make_term(MATRIX,m);
for(i=0;i<m;i++)
{ ARGREP(temp,i,make_term(VECTOR,3));
row = ARG(i,expr);
if(FUNCTOR(row)==IF)
/* in row we have if(condition,value), but we want to print
'value if condition', so we have to switch the order of args
and stick in the pseudoatom 'if' */
{ ARGREP(ARG(i,temp),2,ARG(0,row));
ARGREP(ARG(i,temp),1,ifterm);
ARGREP(ARG(i,temp),0,ARG(1,row));
}
else
{ assert(i==m-1); /* only the last row can fail to be an IF term */
ARGREP(ARG(i,temp),0,row);
ARGREP(ARG(i,temp),1,otherwise);
SETFUNCTOR(voidterm,ILLEGAL,0);
ARGREP(ARG(i,temp),2, voidterm); /* no display */
}
}
for(i=0;i<ARITY(expr);i++)
{ if(COLOR(ARG(i,expr)))
SETCOLOR(ARG(i,temp),COLOR(ARG(i,expr))); /* pass colors of rows through */
}
err = bblock_matrix(1,temp,newexpr,sizein,op,dir);
for(i=0;i<ARITY(expr);i++)
RELEASE(ARG(i,temp));
RELEASE(temp);
b = GETBLOCK(*newexpr);
b.leftbra = 1;
b.rightbra = 0;
b.bra = BRACES;
/* Not necessary to adjust b.w */
b.size = sizein;
SETBLOCK(*newexpr,b);
row = ARG(m,*newexpr);
temp = ARG(2,row);
#ifdef EXCLUDEENGLISH
tempstring = "otherwise";
#else
tempstring = (char *) english(2358);
#endif
if(!strcmp( * (( char **)(ARGPTR(temp)+1)), "ow"))
*((char **) ((term *) LVARGPTR(temp)+1)) = tempstring; /* otherwise */
/* it was temporarily set to "ow" as explained above */
/* This has to be one of the more arcane lines in MathXpert! It stems from hacking the
data structure 'term' to support 'PSEUDOATOM' in which a pointer meant to point to terms
is made to point to a string instead. Yuk! But it works. */
return err;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists