1 
2 /******************************************************************************
3 * MODULE     : evaluate_misc.cpp
4 * DESCRIPTION: various other primitives for evaluation
5 * COPYRIGHT  : (C) 2006  Joris van der Hoeven
6 *******************************************************************************
7 * This software falls under the GNU general public license version 3 or later.
8 * It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
9 * in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
10 ******************************************************************************/
11 
12 #include "evaluate_main.hpp"
13 #include "std_environment.hpp"
14 #include "vars.hpp"
15 #include "analyze.hpp"
16 #include "url.hpp"
17 #include "../../Graphics/Types/frame.hpp"
18 #include "image_files.hpp"
19 #include "renderer.hpp"
20 
21 static hashmap<string,tree> local_ref ("?");
22 static hashmap<string,tree> global_ref ("?");
23 
24 tree
evaluate_formatting(tree t,string v)25 evaluate_formatting (tree t, string v) {
26   int i, n= N(t);
27   tree r (t, n-1);
28   for (i=0; i<n-1; i++) r[i]= evaluate (t[i]);
29   tree oldv= std_env [v];
30   tree newv= oldv * r;
31   assoc_environment local (1);
32   local->raw_write (0, v, newv);
33   begin_with (std_env, local);
34   tree b= evaluate (t[n-1]);
35   end_with (std_env);
36   return r * tree (TFORMAT, b);
37 }
38 
39 tree
evaluate_table(tree t)40 evaluate_table (tree t) {
41   // FIXME: we should execute values in old cell format
42   assoc_environment local (1);
43   local->raw_write (0, CELL_FORMAT, tree (TFORMAT));
44   begin_with (std_env, local);
45   int i, n= N(t);
46   tree r (t, n);
47   for (i=0; i<n; i++) r[i]= evaluate (t[i]);
48   end_with (std_env);
49   return r;
50 }
51 
52 tree
evaluate_hard_id(tree t)53 evaluate_hard_id (tree t) {
54   if (N(t) == 0) {
55     pointer ptr= (pointer) std_env.operator -> ();
56     return "%" * as_hexadecimal (ptr);
57   }
58   else {
59     t= expand (t[0], true);
60     pointer ptr1= (pointer) std_env.operator -> ();
61     pointer ptr2= (pointer) t.operator -> ();
62     return "%" * as_hexadecimal (ptr1) * "-" * as_hexadecimal (ptr2);
63   }
64 }
65 
66 tree
evaluate_script(tree t)67 evaluate_script (tree t) {
68   if (N(t) != 1 && N(t) != 2) return tree (ERROR, "bad script");
69   if (N(t) == 1) return tree (SCRIPT, evaluate (t[0]));
70   else return tree (SCRIPT, evaluate (t[0]), expand (t[1], true));
71 }
72 
73 tree
evaluate_set_binding(tree t)74 evaluate_set_binding (tree t) {
75   tree keys, value;
76   if (N(t) == 1) {
77     keys= std_env ["the-tags"];
78     if (!is_tuple (keys))
79       return tree (ERROR, "bad set binding");
80     for (int i=0; i<N(keys); i++)
81       if (!is_atomic (keys[i]))
82 	return tree (ERROR, "bad set binding");
83     value= evaluate (t[0]);
84     assoc_environment local (2);
85     local->raw_write (0, string ("the-tags"), tree (TUPLE));
86     local->raw_write (1, string ("the-label"), copy (value));
87     assign (std_env, local);
88   }
89   else if (N(t) >= 2) {
90     tree key= evaluate (t[0]);
91     if (!is_atomic (key))
92       return tree (ERROR, "bad set binding");
93     keys= tuple (key);
94     value= evaluate (t[1]);
95   }
96   else return tree (ERROR, "bad set binding");
97 
98   for (int i=0; i<N(keys); i++) {
99     string key= keys[i]->label;
100     tree old_value= local_ref[key];
101     string part= as_string (std_env ["current-part"]);
102     url base_file_name (as_string (std_env ["base-file-name"]));
103     url cur_file_name (as_string (std_env ["cur-file-name"]));
104     if (is_func (old_value, TUPLE) && (N(old_value) >= 2))
105       local_ref (key)= tuple (copy (value), old_value[1]);
106     else local_ref (key)= tuple (copy (value), "?");
107     if (cur_file_name != base_file_name || N(part) != 0) {
108       string extra;
109       if (cur_file_name != base_file_name)
110 	extra << as_string (delta (base_file_name, cur_file_name));
111       if (N(part) != 0)
112 	extra << "#" << part (1, N(part));
113       local_ref (key) << extra;
114     }
115     /* FIXME:
116     if (complete && is_tuple (old_value) && N(old_value) >= 1) {
117       string old_s= tree_as_string (old_value[0]);
118       string new_s= tree_as_string (value);
119       if (new_s != old_s && !starts (key, "auto-")) {
120         if (new_s == "") typeset_warning << "Redefined " << key << LF;
121 	else typeset_warning << "Redefined " << key << " as " << new_s << LF;
122       }
123     }
124     */
125   }
126 
127   return ""; // FIXME: do stuff from concater_rep::typeset_set_binding instead
128 }
129 
130 tree
evaluate_get_binding(tree t)131 evaluate_get_binding (tree t) {
132   if (N(t) != 1 && N(t) != 2) return tree (ERROR, "bad get binding");
133   string key= evaluate_string (t[0]);
134   tree value= local_ref->contains (key)? local_ref [key]: global_ref [key];
135   int type= (N(t) == 1? 0: as_int (evaluate_string (t[1])));
136   if (type != 0 && type != 1) type= 0;
137   if (is_func (value, TUPLE) && (N(value) >= 2)) value= value[type];
138   else if (type == 1) value= tree (UNINIT);
139   /* FIXME:
140   if (complete && value == tree (UNINIT))
141     typeset_warning << "Undefined reference " << key << LF;
142   */
143   return value;
144 }
145 
146 tree
evaluate_pattern(tree t)147 evaluate_pattern (tree t) {
148   url base_file_name (as_string (std_env ["base-file-name"]));
149   url im= evaluate_string (t[0]);
150   url image= resolve (relative (base_file_name, im));
151   if (is_none (image))
152     image= resolve (url ("$TEXMACS_PATTERN_PATH") * im);
153   if (is_none (image)) return "white";
154   int imw_pt, imh_pt;
155   int dpi= as_int (as_string (std_env ["dpi"]));
156   image_size (image, imw_pt, imh_pt);
157   double pt= ((double) dpi*PIXEL) / 72.0;
158   SI imw= (SI) (((double) imw_pt) * pt);
159   SI imh= (SI) (((double) imh_pt) * pt);
160   if (imw <= 0 || imh <= 0) return "white";
161   string w= evaluate_string (t[1]);
162   string h= evaluate_string (t[2]);
163   if (is_length (w))
164     w= as_string (as_length (w));
165   else if (is_magnification (w))
166     w= as_string ((SI) (get_magnification (w) * ((double) imw)));
167   if (is_length (h))
168     h= as_string (as_length (h));
169   else if (is_magnification (h))
170     h= as_string ((SI) (get_magnification (h) * ((double) imh)));
171   if (w == "" && h != "") {
172     if (is_int (h)) w= as_string ((SI) ((as_double (h) * imw) / imh));
173     else if (is_percentage (h))
174       w= as_string (100.0 * (as_percentage (h) * imw) / imh) * "@";
175     else return "white";
176   }
177   else if (h == "" && w != "") {
178     if (is_int (w)) h= as_string ((SI) ((as_double (w) * imh) / imw));
179     else if (is_percentage (w))
180       h= as_string (100.0 * (as_percentage (w) * imh) / imw) * "@";
181     else return "white";
182   }
183   else if (w == "" && h == "") {
184     w= as_string (imw);
185     h= as_string (imh);
186   }
187   else if ((!is_int (w) && !is_percentage (w)) ||
188 	   (!is_int (h) && !is_percentage (h)))
189     return "white";
190   tree r (PATTERN, as_string (image), w, h);
191   if (N(t) == 4) r << evaluate (t[3]);
192   return r;
193 }
194 
195 tree
evaluate_point(tree t)196 evaluate_point (tree t) {
197   int i, n= N(t);
198   tree u (_POINT, n);
199   for (i=0; i<n; i++)
200     u[i]= evaluate (t[i]);
201   if (n==0 || is_double (u[0])) return u;
202   return as_tree (as_point (u));
203 }
204 
205 /*
206 tree
207 evaluate_box_info (tree t) {
208   tree t1= t[0];
209   tree t2= t[1];
210   if (!is_string (t2))
211     return tree (ERROR, "bad box info");
212   return box_info (edit_env (this), t1, as_string (t2));
213 }
214 
215 tree
216 evaluate_frame_direct (tree t) {
217   tree t1= evaluate (t[0]);
218   return as_tree (!nil (fr) ? fr (::as_point (t1)) : point ());
219 }
220 
221 tree
222 evaluate_frame_inverse (tree t) {
223   tree t1= evaluate (t[0]);
224   return as_tree (!nil (fr) ? fr [::as_point (t1)] : point ());
225 }
226 */
227