Lisp_Object difference2(Lisp_Object a, Lisp_Object b)
{
Lisp_Object nil;
switch ((int)b & TAG_BITS)
{
case TAG_FIXNUM:
if (is_fixnum(a))
{
int32_t r = int_of_fixnum(a) - int_of_fixnum(b);
int32_t t = r & fix_mask;
if (t == 0 || t == fix_mask) return fixnum_of_int(r);
else return make_one_word_bignum(r);
}
else if (b != ~0x7ffffffe) return plus2(a, 2*TAG_FIXNUM-b);
else
{ push(a);
b = make_one_word_bignum(-int_of_fixnum(b));
break;
}
case TAG_NUMBERS:
push(a);
if (type_of_header(numhdr(b)) == TYPE_BIGNUM) b = negateb(b);
else b = negate(b);
break;
case TAG_BOXFLOAT:
default:
push(a);
b = negate(b);
break;
}
pop(a);
errexit();
return plus2(a, b);
}
static Lisp_Object pluscc(Lisp_Object a, Lisp_Object b)
/*
* Add complex values.
*/
{
Lisp_Object c, nil;
push2(a, b);
c = plus2(imag_part(a), imag_part(b));
pop2(b, a);
errexit();
a = plus2(real_part(a), real_part(b));
errexit();
return make_complex(a, c);
}
static Lisp_Object mod_by_rem(Lisp_Object a, Lisp_Object b)
{
Lisp_Object nil;
CSLbool sb = minusp(b);
errexit();
a = Cremainder(a, b); /* Repeats dispatch on argument type. Sorry */
errexit();
if (sb)
{ if (plusp(a))
{ errexit();
a = plus2(a, b);
}
}
else if (minusp(a))
{ errexit();
a = plus2(a, b);
}
return a;
}
Lisp_Object sub1(Lisp_Object p)
/*
* Decrement a number. Short cut when the number is a fixnum, otherwise
* just hand over to the general addition code.
*/
{
if (is_fixnum(p))
{ if (p == ~0x7ffffffe) /* The ONLY possible overflow case here */
return make_one_word_bignum(int_of_fixnum(p) - 1);
else return (Lisp_Object)(p - 0x10);
}
else return plus2(p, fixnum_of_int(-1));
}
Lisp_Object add1(Lisp_Object p)
/*
* Increment a number. Short cut when the number is a fixnum, otherwise
* just hand over to the general addition code.
*/
{
if (is_fixnum(p))
{ if (p == 0x7ffffff1) /* The ONLY possible overflow case here */
return make_one_word_bignum(0x08000000);
else return (Lisp_Object)(p + 0x10);
}
else return plus2(p, fixnum_of_int(1));
}
static Lisp_Object plusic(Lisp_Object a, Lisp_Object b)
/*
* real of any sort plus complex.
*/
{
Lisp_Object nil;
push(b);
a = plus2(a, real_part(b));
pop(b);
errexit();
/*
* make_complex() takes responsibility for mapping #C(n 0) onto n
*/
return make_complex(a, imag_part(b));
}
static Lisp_Object plusir(Lisp_Object a, Lisp_Object b)
/*
* fixnum and ratio, but also valid for bignum and ratio.
* Note that if the inputs were in lowest terms there is no need for
* and GCD calculations here.
*/
{
Lisp_Object nil;
push(b);
a = times2(a, denominator(b));
nil = C_nil;
if (!exception_pending()) a = plus2(a, numerator(stack[0]));
pop(b);
errexit();
return make_ratio(a, denominator(b));
}
VAL eval(VAL x) {
if (x->ty != FUN) return x;
else {
function* f = (function*)(x -> info);
switch(f->ftag) {
EVALCASE(FPLUS2,2,plus2(FARG(0),FARG(1)));
EVALCASE(ADDER1,3,adder1(FARG(0),FARG(1),FARG(2)));
EVALCASE(ADDER,2,adder(FARG(0),FARG(1)));
EVALCASE(FTAG_EVM_plus,2,_EVM_plus(FARG(0),FARG(1)));
EVALCASE(FTAG_EVMSC_1_plus,4,_EVMSC_1_plus(FARG(0),FARG(1),FARG(2),FARG(3)));
EVALCASE(FTAG_EVMSC_0_plus,3,_EVMSC_0_plus(FARG(0),FARG(1),FARG(2)));
EVALCASE(FTAG_EVM_natElim,4,_EVM_natElim(FARG(0),FARG(1),FARG(2),FARG(3)));
EVALDEFAULT;
}
}
return x;
}
void display(void)
{
glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT);
glLoadIdentity();
gluLookAt(r*cos(c*du), h, r*sin(c*du), 0, 0, 0, 0, 3, 0); //head position;eye direction(0.0,0.0,0.0),original point;(0.0,1.0,0.0),head above direction¡£
//cylinder a(1, 15, 0, 90, 0, 0, 5, 0); //r,h,xangle yangle zangle, module position(xx yy zz)
//sphere b(3, 100, 100, 0, 0, 0, 0, 2.5, 0); //r,xangle yangle zangle, module position(xx yy zz)
//cube c(5, 10, 0, 0, 1, 1, 1); //length xangle yangle zangle, module position(xx yy zz)
//rectangularpyramid d(4, 0, 0, 0, 0, 2, 0); //length xangle yangle zangle, module position(xx yy zz)
//triangularpyramid f(2, 0, 0, 0, 8, 8, 8);//length xangle yangle zangle, module position(xx yy zz)
//f.draw();
sphere sp(3, 100, 100, 0, 0, -2, 0, 8, 0);
cylinder cy(3, 5, 0, 90, 0, -3, 9, -10);
cube cu(3, 0, 0, 0, 0, 8, 10);
triangularpyramid tr(2, 0, 0, 0, 0, -6, 8);
rectangularpyramid rec(2, 0, 0, 0, 0, -6, -8);
cylinder k1(0.3, 2, 90, 0, 0, 0, 0, 0);
cylinder k2(0.3, 2, -90, 0, 0, 0, 0, 0);
cylinder k3(0.3, 2, -45, 0, 0, 0, 0, 0);
cylinder k4(0.3, 2.5, 45, 0, 0, 0, 0, 0);
cylinder u1(0.3, 2, 90, 0, 0, 0, 0, 3);
cylinder u2(0.3, 1.5, -90, 0, 0, 0, 0, 3);
cylinder u3(0.3, 2, 0, 0, 0, 0, -1.8, 3);
cylinder u4(0.3, 2, 90, 0, 0, 0, 0, 5);
cylinder u5(0.3, 1.5, -90, 0, 0, 0, 0, 5);
cylinder g1(0.3, 2, -90, 0, 0, 0, -0.5, 6.4);
cylinder g2(0.3, 1.5, -90, 0, 0, 0, -0.5, 6.4);
cylinder g3(0.3, 2, 0, 0, 0, 0, -0.3, 6.4);
cylinder g4(0.3, 2, 0, 0, 0, 0, 1.3, 6.4);
cylinder g5(0.3, 2, 90, 0, 0, 0, 0, 8.4);
cylinder g6(0.3, 1.5, -90, 0, 0, 0, 0, 8.4);
cylinder g7(0.3, 2, 0, 0, 0, 0, -1.8, 6.4);
cylinder e1(0.3, 1.8, -90, 0, 0, 0, -0.2, 10);
cylinder e2(0.3, 1.8, 90, 0, 0, 0, -0.2, 10);
cylinder e3(0.3, 2, 0, 0, 0, 0, -0.3, 10);
cylinder e4(0.3, 2, 0, 0, 0, 0, 1.3, 10);
cylinder e5(0.3, 2, 0, 0, 0, 0, -1.8, 10);
cylinder r1(0.3, 1.8, -90, 0, 0, 0, -0.2, 13.5);
cylinder r2(0.3, 1.8, 90, 0, 0, 0, -0.2, 13.5);
cylinder r3(0.3, 2, 0, 0, 0, 0, -0.3, 13.5);
cylinder r4(0.3, 1.2, 0, 0, 0, 0, 1.3, 13.5);
cylinder r5(0.3, 1.7, 60, 0, 0, 0, 1.3, 14.5);
cylinder r6(0.3, 2.5, 45, 0, 0, 0, 0, 13.5);
cylinder c1(0.3, 2, 90, 0, 0, 0, 0, -15);
cylinder c2(0.3, 2, -90, 0, 0, 0, 0, -15);
cylinder c3(0.3, 3, 0, 0, 0, 0, -1.8, -15);
cylinder c4(0.3, 3, 0, 0, 0, 0, 1.8, -15);
cylinder plus1(0.3,3.5, 0, 0, 0, 0, 0, -11);
cylinder plus2(0.3, 4, 90, 0, 0, 0, 2, -9.2);
cylinder plus3(0.3, 3.5, 0, 0, 0, 0, 0, -6);
cylinder plus4(0.3, 4, 90, 0, 0, 0, 2, -4.2);
cy.draw();
sp.draw();
cu.draw();
tr.draw();
rec.draw();
k1.draw();
k2.draw();
k3.draw();
k4.draw();
u1.draw();
u2.draw();
u3.draw();
u4.draw();
u5.draw();
g1.draw();
g2.draw();
g3.draw();
g4.draw();
g5.draw();
g6.draw();
g7.draw();
e1.draw();
e2.draw();
e3.draw();
e4.draw();
e5.draw();
r1.draw();
r2.draw();
r3.draw();
r4.draw();
r5.draw();
r6.draw();
c1.draw();
c2.draw();
c3.draw();
c4.draw();
plus1.draw();
plus2.draw();
plus3.draw();
plus4.draw();
glFlush();
}
double CalcIntegralOfFullTrg(SurfacePoints p, PointsXYZ &m, double time, SourceOfNoise &source_of_noise, CoordXYZ &control_point, int &err)
{
int i,j,n=4;
double rho=0;
CoordXYZ strg[3],h1,h2;
CoordXYZ xtrg[3];
if(p.size()!=3) { cout << " ERROR 8_1 " << p.size() << "!=3\n"; exit(0);}
for (int i = 0; i < 3; i++)
xtrg[i] = GetCoordSurf(p[i],m);
// cout << " CalcIntegralOfFullTrg started " << endl;
CoordXYZ pyr_points[4];
for (int i = 0; i < kbase; i++)
pyr_points[i].resize(3);
// сформируем пирамиду
int k=0;
for (int i = 0; i < 3; i++)
{
add_to_ip(ip,k,p[i].a_index);
add_to_ip(ip,k,p[i].b_index);
}
if(k!=4)
{
cout << "ERROR 6 : In base tetrahtdron only " << k << " nodes <4.";
err=2;
return 0;
}
// cout << ip[0] << " " << ip[1] << " " << ip[2] << " " << ip[3] << " " << endl;
for (int i = 0; i < 4; i++)
pyr_points[i]=m[ip[i]];
BasePoints bp(pyr_points,ip,err);
if(err)
return err;
for (int i = 0; i < 3; i++)
strg[i].resize(3);
/*
к этому моменту есть :
- координаты вершин базовой пирамиды
- номера вершин базовой пирамиды
- функция вычисления значения поля в точке r
при заданных значениях f в узлах пирамиды
*/
for(i=0;i<n;i++)
for(j=0;j<n-i;j++)
{
strg[0]=
plus2(
plus2(xtrg[0],
smult2((double)i/(double)n,minus2(xtrg[1],xtrg[0]))),
smult2((double)j/(double)n,minus2(xtrg[2],xtrg[0])));
strg[1]=
plus2(
plus2(xtrg[0],
smult2((double)(i+1)/(double)n,minus2(xtrg[1],xtrg[0]))),
smult2((double)j/(double)n,minus2(xtrg[2],xtrg[0])));
strg[2]=
plus2(
plus2(xtrg[0],
smult2((double)i/(double)n,minus2(xtrg[1],xtrg[0]))),
smult2((double)(j+1)/(double)n,minus2(xtrg[2],xtrg[0])));
if(!isbp) rho+=CalcIntegralOfSmallTrg(strg, time, source_of_noise, control_point);
else rho+=CalcIntegralOfSmallTrgBp(strg, time, bp, control_point);
if(j<n-i-1)
{
strg[0]=
plus2(
plus2(xtrg[0],
smult2((double)(i+1)/(double)n,minus2(xtrg[1],xtrg[0]))),
smult2((double)(j+1)/(double)n,minus2(xtrg[2],xtrg[0])));
strg[2]=
plus2(
plus2(xtrg[0],
smult2((double)(i+1)/(double)n,minus2(xtrg[1],xtrg[0]))),
smult2((double)j/(double)n,minus2(xtrg[2],xtrg[0])));
strg[1]=
plus2(
plus2(xtrg[0],
smult2((double)i/(double)n,minus2(xtrg[1],xtrg[0]))),
smult2((double)(j+1)/(double)n,minus2(xtrg[2],xtrg[0])));
if(!isbp) rho+=CalcIntegralOfSmallTrg(strg, time, source_of_noise, control_point);
else rho+=CalcIntegralOfSmallTrgBp(strg, time, bp, control_point);
}
}
return rho;
}
static Lisp_Object plusrr(Lisp_Object a, Lisp_Object b)
/*
* Adding two ratios involves some effort to keep the result in
* lowest terms.
*/
{
Lisp_Object nil = C_nil;
Lisp_Object na = numerator(a), nb = numerator(b);
Lisp_Object da = denominator(a), db = denominator(b);
Lisp_Object w = nil;
push5(na, nb, da, db, nil);
#define g stack[0]
#define db stack[-1]
#define da stack[-2]
#define nb stack[-3]
#define na stack[-4]
g = gcd(da, db);
nil = C_nil;
if (exception_pending()) goto fail;
/*
* all the calls to quot2() in this procedure are expected - nay required -
* to give exact integer quotients.
*/
db = quot2(db, g);
nil = C_nil;
if (exception_pending()) goto fail;
g = quot2(da, g);
nil = C_nil;
if (exception_pending()) goto fail;
na = times2(na, db);
nil = C_nil;
if (exception_pending()) goto fail;
nb = times2(nb, g);
nil = C_nil;
if (exception_pending()) goto fail;
na = plus2(na, nb);
nil = C_nil;
if (exception_pending()) goto fail;
da = times2(da, db);
nil = C_nil;
if (exception_pending()) goto fail;
g = gcd(na, da);
nil = C_nil;
if (exception_pending()) goto fail;
na = quot2(na, g);
nil = C_nil;
if (exception_pending()) goto fail;
da = quot2(da, g);
nil = C_nil;
if (exception_pending()) goto fail;
w = make_ratio(na, da);
/*
* All the goto statements and the label seem a fair way of expressing
* the common action that has to be taken if an error or interrupt is
* detected during any of the intermediate steps here. Anyone who
* objects can change it if they really want...
*/
fail:
popv(5);
return w;
#undef na
#undef nb
#undef da
#undef db
#undef g
}
