root/trunk/thune/math.c

Revision 550, 23.5 kB (checked in by krobillard, 7 weeks ago)

Thune:

  • 8-bit string encoding is now Latin-1.
  • Now using WELL512a generator for random numbers.
  • Added hash-map datatype. List datatype can now be disabled in config.
  • Added project-point, remap.
  • Unique & fill now handle vector!.
  • File port 'read now retuns none when end of file reached.

Thune-GL:

  • Added draw-prog! & vertex-buffer! datatypes.
  • Display now accepts /fullscreen option.
  • Added particle-sim dialect.
Line 
1/*============================================================================
2    Thune Interpreter
3    Copyright (C) 2005-2007  Karl Robillard
4
5    This library is free software; you can redistribute it and/or
6    modify it under the terms of the GNU Lesser General Public
7    License as published by the Free Software Foundation; either
8    version 2.1 of the License, or (at your option) any later version.
9
10    This library is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13    Lesser General Public License for more details.
14
15    You should have received a copy of the GNU Lesser General Public
16    License along with this library; if not, write to the Free Software
17    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
18===========================================================================*/
19
20
21#include "os_math.h"
22#include "urlan.h"
23#include "internal.h"
24#include "bignum.h"
25
26#include <time.h>
27extern void init_genrand(uint32_t s);
28extern uint32_t genrand_int32();
29extern double genrand_real2();
30
31
32#ifdef LANG_RUNE
33#define UR_CALL_P   UR_CALL_PUB
34#else
35#define UR_CALL_P   UR_CALL
36#endif
37
38
39enum MathJumpPair
40{
41    MJ_INT_INT,
42    MJ_INT_DEC,
43    MJ_DEC_INT,
44    MJ_DEC_DEC,
45    MJ_VEC3_DEC,
46    MJ_DEC_VEC3,
47    MJ_VEC3_VEC3,
48    MJ_COORD_INT,
49    MJ_COORD_COORD,
50    MJ_INT_BIG,
51    MJ_BIG_INT,
52    MJ_DEC_BIG,
53    MJ_BIG_DEC,
54    MJ_BIG_BIG,
55    MJ_NAN
56};
57
58static int _mathJumpIndex( const UCell* a, const UCell* b )
59{
60    if( ur_is(a, UT_INT) || ur_is(a, UT_CHAR) )
61    {
62        if( ur_is(b, UT_INT) || ur_is(b, UT_CHAR) )
63            return MJ_INT_INT;
64        if( ur_is(b, UT_DECIMAL) || ur_is(b, UT_TIME) )
65            return MJ_INT_DEC;
66        if( ur_is(b, UT_BIGNUM) )
67            return MJ_INT_BIG;
68    }
69    else if( ur_is(a, UT_DECIMAL) || ur_is(a, UT_TIME) || ur_is(a, UT_DATE) )
70    {
71        if( ur_is(b, UT_INT) || ur_is(b, UT_CHAR) )
72            return MJ_DEC_INT;
73        if( ur_is(b, UT_DECIMAL) || ur_is(b, UT_TIME) || ur_is(b, UT_DATE) )
74            return MJ_DEC_DEC;
75        if( ur_is(b, UT_VEC3) )
76            return MJ_DEC_VEC3;
77        if( ur_is(b, UT_BIGNUM) )
78            return MJ_DEC_BIG;
79    }
80    else if( ur_is(a, UT_VEC3) )
81    {
82        if( ur_is(b, UT_VEC3) )
83            return MJ_VEC3_VEC3;
84        if( ur_is(b, UT_DECIMAL) )
85            return MJ_VEC3_DEC;
86    }
87    else if( ur_is(a, UT_BIGNUM) )
88    {
89        if( ur_is(b, UT_INT) )
90            return MJ_BIG_INT;
91        if( ur_is(b, UT_DECIMAL) )
92            return MJ_BIG_DEC;
93        if( ur_is(b, UT_BIGNUM) )
94            return MJ_BIG_BIG;
95    }
96    else if( ur_is(a, UT_COORD) )
97    {
98        if( ur_is(b, UT_INT) )
99            return MJ_COORD_INT;
100        if( ur_is(b, UT_COORD) )
101            return MJ_COORD_COORD;
102    }
103
104    return MJ_NAN;
105}
106
107
108#define COMP_OPERATION(OP) \
109    switch( _mathJumpIndex(c1, c2) ) { \
110        case MJ_INT_INT: \
111            return ur_int(c1) OP ur_int(c2); \
112        case MJ_INT_DEC: \
113            return ((double) ur_int(c1)) OP ur_decimal(c2); \
114        case MJ_DEC_INT: \
115            return ur_decimal(c1) OP ((double) ur_int(c2)); \
116        case MJ_DEC_DEC: \
117            return ur_decimal(c1) OP ur_decimal(c2); \
118        case MJ_INT_BIG: \
119         {  UCell big; \
120            bignum_seti(&big, ur_int(c1)); \
121            return bignum_cmp(&big, c2) OP 0; }\
122        case MJ_BIG_INT: \
123          { UCell big; \
124            bignum_seti(&big, ur_int(c2)); \
125            return bignum_cmp(c1, &big) OP 0; } \
126        case MJ_DEC_BIG: \
127         {  UCell big; \
128            bignum_setd(&big, ur_decimal(c1)); \
129            return bignum_cmp(&big, c2) OP 0; }\
130        case MJ_BIG_DEC: \
131          { UCell big; \
132            bignum_setd(&big, ur_decimal(c2)); \
133            return bignum_cmp(c1, &big) OP 0; } \
134        case MJ_BIG_BIG: \
135            return bignum_cmp(c1, c2) OP 0; \
136        default: \
137            return -1; \
138    }
139
140#define COMP_BAD_DT     "Comparison requires char!/int!/decimal!/bignum!"
141
142
143int ur_greaterThan( const UCell* c1, const UCell* c2 )
144{
145    COMP_OPERATION( > )
146}
147
148// (val val -- logic)
149UR_CALL_P( uc_gtQ )
150{
151    int logic = ur_greaterThan( ur_s_prev(tos), tos );
152    if( logic == -1 )
153    {
154        ur_throwErr( UR_ERR_DATATYPE, COMP_BAD_DT );
155    }
156    else
157    {
158        UR_S_DROP;
159        ur_initType( UR_TOS, UT_LOGIC );
160        ur_logic(UR_TOS) = logic;
161    }
162}
163
164
165int ur_lessThan( const UCell* c1, const UCell* c2 )
166{
167    COMP_OPERATION( < )
168}
169
170// (val val -- logic)
171UR_CALL_P( uc_ltQ )
172{
173    int logic = ur_lessThan( ur_s_prev(tos), tos );
174    if( logic == -1 )
175    {
176        ur_throwErr( UR_ERR_DATATYPE, COMP_BAD_DT );
177    }
178    else
179    {
180        UR_S_DROP;
181        ur_initType( UR_TOS, UT_LOGIC );
182        ur_logic(UR_TOS) = logic;
183    }
184}
185
186
187int ur_greaterOrEqual( const UCell* c1, const UCell* c2 )
188{
189    COMP_OPERATION( >= )
190}
191
192int ur_lessOrEqual( const UCell* c1, const UCell* c2 )
193{
194    COMP_OPERATION( <= )
195}
196
197
198#define MATH_OPERATION(OP) \
199    switch( _mathJumpIndex(res, tos) ) { \
200        case MJ_INT_INT: \
201            ur_int(res) = ur_int(res) OP ur_int(tos); \
202            break; \
203        case MJ_INT_DEC: \
204            ur_initType(res, UT_DECIMAL); \
205            ur_decimal(res) = ((double) ur_int(res)) OP ur_decimal(tos); \
206            break; \
207        case MJ_DEC_INT: \
208            ur_decimal(res) = ur_decimal(res) OP ((double) ur_int(tos)); \
209            break; \
210        case MJ_DEC_DEC: \
211            ur_decimal(res) = ur_decimal(res) OP ur_decimal(tos); \
212            break; \
213        case MJ_DEC_VEC3: {\
214            double d = ur_decimal(res); \
215            ur_initType(res, UT_VEC3); \
216            res->vec3.xyz[0] = d OP tos->vec3.xyz[0]; \
217            res->vec3.xyz[1] = d OP tos->vec3.xyz[1]; \
218            res->vec3.xyz[2] = d OP tos->vec3.xyz[2]; \
219            } break; \
220        case MJ_VEC3_DEC: \
221            res->vec3.xyz[0] = res->vec3.xyz[0] OP ur_decimal(tos); \
222            res->vec3.xyz[1] = res->vec3.xyz[1] OP ur_decimal(tos); \
223            res->vec3.xyz[2] = res->vec3.xyz[2] OP ur_decimal(tos); \
224            break; \
225        case MJ_VEC3_VEC3: \
226            res->vec3.xyz[0] = res->vec3.xyz[0] OP tos->vec3.xyz[0]; \
227            res->vec3.xyz[1] = res->vec3.xyz[1] OP tos->vec3.xyz[1]; \
228            res->vec3.xyz[2] = res->vec3.xyz[2] OP tos->vec3.xyz[2]; \
229            break; \
230        case MJ_COORD_INT: \
231        {   int i, count = res->coord.len; \
232            for( i = 0; i < count; ++i ) \
233                res->coord.elem[i] = res->coord.elem[i] OP ur_int(tos); \
234        }   break; \
235        case MJ_COORD_COORD: \
236        {   int i, count = res->coord.len; \
237            if( tos->coord.len < count ) \
238                count = tos->coord.len; \
239            for( i = 0; i < count; ++i ) \
240                res->coord.elem[i] = res->coord.elem[i] OP tos->coord.elem[i];\
241        }   break;
242
243
244#define MATH_OPERATION_END \
245        default: \
246            UR_S_GROW; \
247            ur_throwErr( UR_ERR_DATATYPE, \
248                         "Math operator requires int!/decimal!/vec3!" ); \
249            break; \
250    }
251
252
253// (number number -- sum)
254UR_CALL_P( uc_add )
255{
256    UR_S_DROP;
257#if 0
258    if( ur_is(tos, UT_TIME) && ur_is(UR_TOS, UT_TIME) )
259    {
260        ur_seconds(UR_TOS) += ur_seconds(tos);
261    }
262    else
263#endif
264    {
265        UCell* res = UR_TOS;
266        MATH_OPERATION( + )
267
268            case MJ_INT_BIG:
269                ur_initType( res, UT_BIGNUM );
270                bignum_seti( res, ur_int(res) );
271                goto add_big;
272
273            case MJ_BIG_INT:
274                bignum_seti( tos, ur_int(tos) );
275                goto add_big;
276
277            case MJ_DEC_BIG:
278                ur_initType( res, UT_BIGNUM );
279                bignum_setd( res, ur_decimal(res) );
280                goto add_big;
281
282            case MJ_BIG_DEC:
283                bignum_setd( tos, ur_decimal(tos) );
284                // Fall through...
285
286            case MJ_BIG_BIG:
287add_big:
288                bignum_add( res, tos, res );
289                break;
290
291        MATH_OPERATION_END
292    }
293}
294
295
296// (number number -- difference)
297UR_CALL_P( uc_sub )
298{
299    UR_S_DROP;
300#if 0
301    if( ur_is(tos, UT_TIME) && ur_is(UR_TOS, UT_TIME) )
302    {
303        ur_seconds(UR_TOS) -= ur_seconds(tos);
304    }
305    else
306#endif
307    {
308        UCell* res = UR_TOS;
309        MATH_OPERATION( - )
310
311        case MJ_INT_BIG:
312            ur_initType( res, UT_BIGNUM );
313            bignum_seti( res, ur_int(res) );
314            goto sub_big;
315
316        case MJ_BIG_INT:
317            bignum_seti( tos, -ur_int(tos) );       // Negate second number;
318            bignum_add( res, tos, res );            // add is faster than sub.
319            break;
320
321        case MJ_DEC_BIG:
322            ur_initType( res, UT_BIGNUM );
323            bignum_setd( res, ur_decimal(res) );
324            goto sub_big;
325
326        case MJ_BIG_DEC:
327            bignum_setd( tos, -ur_decimal(tos) );   // Negate second number;
328            bignum_add( res, tos, res );            // add is faster than sub.
329            break;
330
331        case MJ_BIG_BIG:
332sub_big:
333            bignum_sub( res, tos, res );
334            break;
335
336        MATH_OPERATION_END
337    }
338}
339
340
341// (number number -- product)
342UR_CALL_P( uc_mul )
343{
344    UCell* res;
345
346    UR_S_DROP;
347    res = UR_TOS;
348
349    MATH_OPERATION( * )
350
351        case MJ_INT_BIG:
352            ur_initType( res, UT_BIGNUM );
353            bignum_seti( res, ur_int(res) );
354            goto mul_big;
355
356        case MJ_BIG_INT:
357            bignum_seti( tos, ur_int(tos) );
358            goto mul_big;
359
360        case MJ_DEC_BIG:
361            ur_initType( res, UT_BIGNUM );
362            bignum_setd( res, ur_decimal(res) );
363            goto mul_big;
364
365        case MJ_BIG_DEC:
366            bignum_setd( tos, ur_decimal(tos) );
367            // Fall through...
368
369        case MJ_BIG_BIG:
370mul_big:
371            bignum_mul( res, tos, res );
372            break;
373
374    MATH_OPERATION_END
375}
376
377
378// (number number -- quotient)
379UR_CALL_P( uc_div )
380{
381    UCell* res;
382
383    UR_S_DROP;
384    res = UR_TOS;
385
386    MATH_OPERATION( / )
387    MATH_OPERATION_END
388}
389
390
391static void logicError( UThread* ut, const char* name )
392{
393    ur_throwErr( UR_ERR_DATATYPE, "%s expected int!/logic!/char!", name );
394}
395
396
397// (number number -- and)
398UR_CALL( uc_and )
399{
400    UCell* res = ur_s_prev(UR_TOS);
401
402    if( UR_IS_ANY3(tos, UT_INT, UT_LOGIC, UT_CHAR) &&
403        UR_IS_ANY3(res, UT_INT, UT_LOGIC, UT_CHAR) )
404    {
405        UR_S_DROP;
406        ur_initType(res, UT_INT);
407        ur_int(res) &= ur_int(tos);
408    }
409    else
410        logicError(ut,"and");
411}
412
413
414// (number number -- or)
415UR_CALL( uc_or )
416{
417    UCell* res = ur_s_prev(UR_TOS);
418
419    if( UR_IS_ANY3(tos, UT_INT, UT_LOGIC, UT_CHAR) &&
420        UR_IS_ANY3(res, UT_INT, UT_LOGIC, UT_CHAR) )
421    {
422        UR_S_DROP;
423        ur_initType(res, UT_INT);
424        ur_int(res) |= ur_int(tos);
425    }
426    else
427        logicError(ut,"or");
428}
429
430
431// (number number -- xor)
432UR_CALL( uc_xor )
433{
434    UCell* res = ur_s_prev(UR_TOS);
435
436    if( UR_IS_ANY3(tos, UT_INT, UT_LOGIC, UT_CHAR) &&
437        UR_IS_ANY3(res, UT_INT, UT_LOGIC, UT_CHAR) )
438    {
439        UR_S_DROP;
440        ur_initType(res, UT_INT);
441        ur_int(res) ^= ur_int(tos);
442    }
443    else
444        logicError(ut,"xor");
445}
446
447
448// (number number -- min)
449UR_CALL( uc_minimum )
450{
451    UCell* res;
452    UR_S_DROP;
453    res = UR_TOS;
454
455    switch( _mathJumpIndex(res, tos) )
456    {
457        case MJ_INT_INT:
458            if( ur_int(res) > ur_int(tos) )
459                ur_int(res) = ur_int(tos);
460            break;
461        case MJ_INT_DEC:
462        {
463            double d = ur_int(res);
464            if( d > ur_decimal(tos) )
465            {
466                ur_initType(res, UT_DECIMAL);
467                ur_decimal(res) = ur_decimal(tos);
468            }
469        }
470            break;
471        case MJ_DEC_INT:
472        {
473            double d = ur_int(tos);
474            if( ur_decimal(res) > d )
475                ur_decimal(res) = d;
476        }
477            break;
478        case MJ_DEC_DEC:
479            if( ur_decimal(res) > ur_decimal(tos) )
480                ur_decimal(res) = ur_decimal(tos);
481            break;
482        case MJ_VEC3_VEC3:
483            if( res->vec3.xyz[0] > tos->vec3.xyz[0] )
484                res->vec3.xyz[0] = tos->vec3.xyz[0];
485            if( res->vec3.xyz[1] > tos->vec3.xyz[1] )
486                res->vec3.xyz[1] = tos->vec3.xyz[1];
487            if( res->vec3.xyz[2] > tos->vec3.xyz[2] )
488                res->vec3.xyz[2] = tos->vec3.xyz[2];
489            break;
490        default:
491            UR_S_GROW;
492            ur_throwErr( UR_ERR_DATATYPE, "Invalid type for 'minimum" );
493            break;
494    }
495}
496
497
498// (number number -- max)
499UR_CALL( uc_maximum )
500{
501    UCell* res;
502    UR_S_DROP;
503    res = UR_TOS;
504
505    switch( _mathJumpIndex(res, tos) )
506    {
507        case MJ_INT_INT:
508            if( ur_int(res) < ur_int(tos) )
509                ur_int(res) = ur_int(tos);
510            break;
511        case MJ_INT_DEC:
512        {
513            double d = ur_int(res);
514            if( d < ur_decimal(tos) )
515            {
516                ur_initType(res, UT_DECIMAL);
517                ur_decimal(res) = ur_decimal(tos);
518            }
519        }
520            break;
521        case MJ_DEC_INT:
522        {
523            double d = ur_int(tos);
524            if( ur_decimal(res) < d )
525                ur_decimal(res) = d;
526        }
527            break;
528        case MJ_DEC_DEC:
529            if( ur_decimal(res) < ur_decimal(tos) )
530                ur_decimal(res) = ur_decimal(tos);
531            break;
532        case MJ_VEC3_VEC3:
533            if( res->vec3.xyz[0] < tos->vec3.xyz[0] )
534                res->vec3.xyz[0] = tos->vec3.xyz[0];
535            if( res->vec3.xyz[1] < tos->vec3.xyz[1] )
536                res->vec3.xyz[1] = tos->vec3.xyz[1];
537            if( res->vec3.xyz[2] < tos->vec3.xyz[2] )
538                res->vec3.xyz[2] = tos->vec3.xyz[2];
539            break;
540        default:
541            UR_S_GROW;
542            ur_throwErr( UR_ERR_DATATYPE, "Invalid type for 'maximum" );
543            break;
544    }
545}
546
547
548// (int shift-count -- int)
549UR_CALL( uc_lshift )
550{
551    UCell* res = ur_s_prev(tos);
552    if( ur_is(res, UT_INT) && ur_is(tos, UT_INT) )
553    {
554        UR_S_DROP;
555        ur_int(res) <<= ur_int(tos);
556        return;
557    }
558    ur_throwErr( UR_ERR_DATATYPE, "Bit shift expected int! int!" );
559}
560
561
562// (int shift-count -- int)
563UR_CALL( uc_rshift )
564{
565    UCell* res = ur_s_prev(tos);
566    if( ur_is(res, UT_INT) && ur_is(tos, UT_INT) )
567    {
568        UR_S_DROP;
569        ur_int(res) >>= ur_int(tos);
570        return;
571    }
572    ur_throwErr( UR_ERR_DATATYPE, "Bit shift expected int! int!" );
573}
574
575
576/*--------------------------------------------------------------------------*/
577
578
579#define PI      3.14159265358979323846
580
581#define TRIG_FUNC(func) \
582    UR_CALL_UNUSED_TH \
583    if( ur_is(tos, UT_DECIMAL) ) { \
584            ur_decimal(tos) = func( ur_decimal(tos) ); \
585    } else if( ur_is(tos, UT_INT) ) { \
586        ur_initType(tos, UT_DECIMAL); \
587            ur_decimal(tos) = func( (double) ur_int(tos) ); \
588    }
589
590
591static void _convertUnits( UCell* tos, double conv )
592{
593    if( ur_is(tos, UT_DECIMAL) )
594        {
595        ur_decimal(tos) *= conv;
596        }
597    else if( ur_is(tos, UT_INT) )
598        {
599        ur_initType(tos, UT_DECIMAL);
600        ur_decimal(tos) = conv * ur_int(tos);
601        }
602}
603
604
605// (rad -- deg)
606UR_CALL( uc_to_deg )
607{
608    UR_CALL_UNUSED_TH
609    _convertUnits( tos, (180.0 / PI) );
610}
611
612
613// (deg -- rad)
614UR_CALL( uc_to_rad )
615{
616    UR_CALL_UNUSED_TH
617    _convertUnits( tos, (PI / 180.0) );
618}
619
620
621#ifdef UR_CONFIG_TRIG
622// (rad -- sin)
623UR_CALL( uc_sine )
624{
625    TRIG_FUNC( mathSine )
626}
627
628
629UR_CALL( uc_cosine )
630{
631    TRIG_FUNC( mathCosine )
632}
633
634
635UR_CALL( uc_tangent )
636{
637    TRIG_FUNC( mathTan )
638}
639
640
641UR_CALL( uc_arcsine )
642{
643    TRIG_FUNC( mathASine )
644}
645
646
647UR_CALL( uc_arccosine )
648{
649    TRIG_FUNC( mathACosine )
650}
651
652
653UR_CALL( uc_arctangent )
654{
655    TRIG_FUNC( mathATan )
656}
657
658
659// (n -- sqrt)
660UR_CALL( uc_squareRoot )
661{
662    UR_CALL_UNUSED_TH
663    if( ur_is(tos, UT_DECIMAL) )
664    {
665        ur_decimal(tos) = mathSqrt( ur_decimal(tos) );
666    }
667    else
668    {
669        ur_initType( tos, UT_DECIMAL );
670        ur_decimal(tos) = mathSqrt( (double) ur_int(tos) );
671    }
672}
673#endif
674
675
676static unsigned long _clockSeed()
677{
678    unsigned long seed;
679    seed  = time(NULL);
680    seed += clock();
681    return seed;
682}
683
684
685/*
686   (max -- n)
687   (n 'seed -- )
688*/
689UR_CALL( uc_random )
690{
691    if( ur_isASeries( tos ) )
692    {
693        int len = ur_seriesEnd( tos );
694        if( len > 0 )
695            tos->series.it += genrand_int32() % (len - tos->series.it);
696        return;
697    }
698
699    switch( ur_type(tos) )
700    {
701        case UT_DECIMAL:
702            ur_decimal(tos) *= genrand_real2();
703            break;
704
705        case UT_INT:
706            if( ur_int(tos) > 0 )
707                ur_int(tos) = (genrand_int32() % ur_int(tos)) + 1;
708            break;
709
710        case UT_LOGIC:
711            ur_logic(tos) = genrand_int32() & 1;
712            break;
713
714#ifdef UR_CONFIG_MATH3D
715        case UT_VEC3:
716            tos->vec3.xyz[0] *= genrand_real2();
717            tos->vec3.xyz[1] *= genrand_real2();
718            tos->vec3.xyz[2] *= genrand_real2();
719            break;
720#endif
721        case UT_COORD:
722        {
723            int i, n;
724            for( i = 0; i < tos->coord.len; ++i )
725            {
726                n = tos->coord.elem[i];
727                if( n > 0 )
728                    tos->coord.elem[i] = (genrand_int32() % n) + 1;
729            }
730        }
731            break;
732
733        case UT_WORD:
734        case UT_LITWORD:
735        {
736            unsigned long seed;
737
738            tos = ur_s_prev(tos);
739
740            if( ur_is(tos, UT_INT) && ur_int(tos) )
741                seed = ur_int(tos);
742            else
743                seed = _clockSeed();
744            init_genrand( seed );
745
746            UR_S_DROPN( 2 );
747        }
748            break;
749
750        default:
751            ur_throwErr( UR_ERR_DATATYPE, "random does not handle %s",
752                         ur_typeName( ur_type(tos) ) );
753            break;
754    }
755}
756
757
758#if 0
759static void orOpPower( OValue* a )
760{
761    double x, y;
762    OValue* b = a + 1;
763    if( a->type == UT_INT )
764    {
765        if( b->type == UT_INT )
766        {
767            int sum;
768            int n = ur_int(b);
769            if( n )
770            {
771                sum = ur_int(a);
772                while( --n )
773                    sum *= ur_int(a);
774            }
775            else
776            {
777                sum = 0;
778            }
779            orResult( UT_INT, sum );
780            return;
781        }
782        else if( b->type == UT_DECIMAL )
783        {
784            x = (double) ur_int(a);
785            y = ur_decimal(b);
786            goto fp;
787        }
788        a = b;
789    }
790    else if( a->type == UT_DECIMAL )
791    {
792        x = ur_decimal(a);
793        if( b->type == UT_INT )
794        {
795            y = (double) ur_int(b);
796            goto fp;
797        }
798        else if( b->type == UT_DECIMAL )
799        {
800            y = ur_decimal(b);
801            goto fp;
802        }
803        a = b;
804    }
805    ur_throwErrOp( "**", a );
806    return;
807
808fp:
809    orResultDECIMAL( pow(x, y) );
810}
811
812
813static void orOpRemainder( OValue* a )
814{
815    double x, y;
816    OValue* b = a + 1;
817    if( a->type == UT_INT )
818    {
819        if( b->type == UT_INT )
820        {
821            orResult( UT_INT, ur_int(a) % ur_int(b) );
822            return;
823        }
824        else if( b->type == UT_DECIMAL )
825        {
826            x = (double) ur_int(a);
827            y = ur_decimal(b);
828            goto fp;
829        }
830        a = b;
831    }
832    else if( a->type == UT_DECIMAL )
833    {
834        x = ur_decimal(a);
835        if( b->type == UT_INT )
836        {
837            y = (double) ur_int(b);
838            goto fp;
839        }
840        else if( b->type == UT_DECIMAL )
841        {
842            y = ur_decimal(b);
843            goto fp;
844        }
845        a = b;
846    }
847    ur_throwErrOp( "//", a );
848    return;
849
850fp:
851    orResultDECIMAL( mathMod(x, y) );
852}
853#endif
854
855
856// (val -- val)
857UR_CALL( uc_complement )
858{
859    UR_CALL_UNUSED_TH
860    switch( ur_type(tos) )
861    {
862        case UT_LOGIC:
863            ur_logic(tos) ^= 1;
864            break;
865
866        case UT_INT:
867            ur_int(tos) = ~ur_int(tos);
868            break;
869
870        case UT_BITSET:
871        {
872            UBinary* bin;
873            uint8_t* it;
874            uint8_t* end;
875
876            bin = ur_bin(tos);
877            UR_ITER_BIN( it, end, bin, tos )
878
879            while( it != end )
880            {
881                *it = ~(*it);
882                ++it;
883            }
884        }
885            break;
886    }
887}
888
889
890// (n -- abs)
891UR_CALL( uc_abs )
892{
893    UR_CALL_UNUSED_TH
894    switch( ur_type(tos) )
895    {
896        case UT_INT:
897            if( ur_int(tos) < 0 )
898                ur_int(tos) = -ur_int(tos);
899            break;
900
901        case UT_DECIMAL:
902        case UT_TIME:
903            if( ur_decimal(tos) < 0.0 )
904                ur_decimal(tos) = -ur_decimal(tos);
905            break;
906/*
907        case UT_COORD:
908            if( tos->pair[0] < 0 )
909                tos->pair[0] = -tos->pair[0];
910            if( tos->pair[1] < 0 )
911                tos->pair[1] = -tos->pair[1];
912            break;
913*/
914#ifdef UR_CONFIG_MATH3D
915        case UT_VEC3:
916        {
917            float n;
918            if( (n = tos->vec3.xyz[0]) < 0.0f )
919                tos->vec3.xyz[0] = -n;
920            if( (n = tos->vec3.xyz[1]) < 0.0f )
921                tos->vec3.xyz[1] = -n;
922            if( (n = tos->vec3.xyz[2]) < 0.0f )
923                tos->vec3.xyz[2] = -n;
924        }
925            break;
926#endif
927    }
928}
929
930
931// (n -- n)
932UR_CALL( uc_negate )
933{
934    switch( ur_type(tos) )
935    {
936        case UT_INT:
937            ur_int(tos) = -ur_int(tos);
938            break;
939
940        case UT_DECIMAL:
941        case UT_TIME:
942            ur_decimal(tos) = -ur_decimal(tos);
943            break;
944
945        case UT_BIGNUM:
946            bignum_negate( tos, tos );
947            break;
948
949        case UT_COORD:
950        {
951            int16_t* it  = tos->coord.elem;
952            int16_t* end = it + tos->coord.len;
953            while( it != end )
954            {
955                *it = -*it;
956                ++it;
957            }
958        }
959            break;
960
961        case UT_BITSET:
962            uc_complement( ut, tos );
963            break;
964
965#ifdef UR_CONFIG_MATH3D
966        case UT_VEC3:
967            tos->vec3.xyz[0] = -tos->vec3.xyz[0];
968            tos->vec3.xyz[1] = -tos->vec3.xyz[1];
969            tos->vec3.xyz[2] = -tos->vec3.xyz[2];
970            break;
971#endif
972    }
973}
974
975
976#ifdef UR_CONFIG_MATH3D
977#include "math3d.c"
978#endif
979#ifdef UR_CONFIG_FCALC
980#include "fcalc.c"
981#endif
982
983
984static UCallDef _mathCalls[] =
985{
986    { uc_gtQ,          "gt?" },
987    { uc_ltQ,          "lt?" },
988    { uc_add,          "add" },
989    { uc_sub,          "sub" },
990    { uc_mul,          "mul" },
991    { uc_div,          "div" },
992    { uc_and,          "and" },
993    { uc_or,           "or" },
994    { uc_xor,          "xor" },
995    { uc_minimum,      "minimum" },
996    { uc_maximum,      "maximum" },
997    { uc_lshift,       "lshift" },
998    { uc_rshift,       "rshift" },
999    { uc_to_deg,       "to-deg" },
1000    { uc_to_rad,       "to-rad" },
1001#ifdef UR_CONFIG_TRIG
1002    { uc_sine,         "sin" },
1003    { uc_cosine,       "cos" },
1004    { uc_tangent,      "tan" },
1005    { uc_arcsine,      "arcsin" },
1006    { uc_arccosine,    "arccos" },
1007    { uc_arctangent,   "arctan" },
1008    { uc_squareRoot,   "sqrt" },
1009#endif
1010    { uc_random,       "random" },
1011/*
1012    { uc_power,        "**" },
1013    { uc_remainder,    "remainder" },
1014*/
1015    { uc_complement,   "complement" },
1016    { uc_abs,          "abs" },
1017    { uc_negate,       "negate" },
1018
1019#ifdef UR_CONFIG_MATH3D
1020    { uc_dot,          "dot" },
1021    { uc_cross,        "cross" },
1022    { uc_normalize,    "normalize" },
1023    { uc_project_point,"project-point" },
1024    { uc_set_stride,   "set-stride" },
1025    { uc_remap,        "remap" },
1026#endif
1027
1028#ifdef UR_CONFIG_FCALC
1029    { uc_fcalc,         "fcalc" },
1030#endif
1031};
1032
1033
1034void ur_makeCallsMath( UThread* ut )
1035{
1036#if 0
1037    OValue* val;
1038    OContext ctx;
1039
1040    ur_globalCtx( ctx );
1041    val = ur_intern( &ctx, "pi", 2, 0 );
1042    ur_initType( val, UT_DECIMAL );
1043    ur_decimal(val) = PI;
1044#endif
1045
1046    init_genrand( _clockSeed() );
1047
1048    ur_makeCalls( ut, _mathCalls, sizeof(_mathCalls) / sizeof(UCallDef) );
1049}
1050
1051
1052/*EOF*/
Note: See TracBrowser for help on using the browser.