root/trunk/thune/fcalc.c

Revision 550, 5.0 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-2008  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 "urlan_atoms.h"
22
23
24extern int ur_getSelector( UThread*, const UCell* sel, UCell* res );
25extern int ur_setSelector( UThread*, const UCell* sel, const UCell* nval );
26
27
28/*
29  Returns zero if error thrown.
30*/
31static int _fcalc( UThread* ut, UCell* cell, double* res )
32{
33    switch( ur_type(cell) )
34    {
35        case UT_WORD:
36            cell = ur_wordCell( ut, cell );
37            if( ! cell )
38                return 0;
39            if( ur_is(cell, UT_DECIMAL) )
40                *res = ur_decimal(cell);
41            else if( ur_is(cell, UT_INT) || ur_is(cell, UT_CHAR) )
42                *res = (double) ur_int(cell);
43            else
44                *res = 0.0;
45            break;
46
47        case UT_SELECT:
48        {
49            UCell pick;
50            if( ! ur_getSelector( ut, cell, &pick ) )
51                return 0;
52            cell = &pick;
53            if( ur_is(cell, UT_DECIMAL) )
54                *res = ur_decimal(cell);
55            else if( ur_is(cell, UT_INT) || ur_is(cell, UT_CHAR) )
56                *res = (double) ur_int(cell);
57            else
58                *res = 0.0;
59        }
60            break;
61
62        case UT_DECIMAL:
63            *res = ur_decimal(cell);
64            break;
65
66        case UT_INT:
67        case UT_CHAR:
68            *res = (double) ur_int(cell);
69            break;
70
71        case UT_BLOCK:
72        case UT_PAREN:
73        {
74            UBlock* blk;
75            UCell* it;
76            UCell* end;
77            UCell* val;
78            double num = 0.0;
79            double right;
80
81#define RIGHT_VAL \
82    if( ++it == end ) { \
83        ur_throwErr( UR_ERR_SCRIPT, "fcalc expected operator r-value" ); \
84        return 0; } \
85    if( ! _fcalc( ut, it, &right ) ) \
86        return 0;
87
88
89            blk = ur_block(cell);
90            UR_ITER_BLOCK( it, end, blk, cell );
91            while( it != end )
92            {
93                if( ur_is(it, UT_WORD) )
94                {
95                    switch( ur_atom(it) )
96                    {
97                        case UR_ATOM_PLUS:
98                            RIGHT_VAL
99                            num += right;
100                            break;
101
102                        case UR_ATOM_DASH:
103                            RIGHT_VAL
104                            num -= right;
105                            break;
106
107                        case UR_ATOM_ASTERISK:
108                            RIGHT_VAL
109                            num *= right;
110                            break;
111
112                        case UR_ATOM_SLASH:
113                            RIGHT_VAL
114                            num /= right;
115                            break;
116                        /*
117                        case UR_ATOM_DOT:
118                        {
119                            UCell cc;
120                            ur_initDecimal( &cc, num );
121                            uc_console_out( ut, &cc );
122                        }
123                            break;
124                        */
125                        default:
126                            if( ! _fcalc( ut, it, &num ) )
127                                return 0;
128                    }
129                }
130                else if( ur_is(it, UT_SETWORD) )
131                {
132                    val = ur_wordCell( ut, it );
133                    if( ! val )
134                        return 0;
135                    ur_initDecimal( val, num );
136                }
137                else if( ur_is(it, UT_SETSELECT) )
138                {
139                    UCell tmp;
140                    ur_initDecimal( &tmp, num );
141                    if( ! ur_setSelector( ut, it, &tmp ) )
142                        return 0;
143                }
144                else
145                {
146                    if( ! _fcalc( ut, it, &num ) )
147                        return 0;
148                }
149                ++it;
150            }
151            *res = num;
152        }
153            break;
154
155        default:
156            *res = 0.0;
157            break;
158    }
159    return 1;
160}
161
162
163// (block -- )
164UR_CALL(uc_fcalc)
165{
166    double res;
167
168    if( ! ur_is(tos, UT_BLOCK) )
169    {
170        ur_throwErr( UR_ERR_DATATYPE, "calc expected block!" );
171        return;
172    }
173
174    if( _fcalc( ut, tos, &res ) )
175    {
176        UR_S_DROP;
177    }
178}
179
Note: See TracBrowser for help on using the browser.