/[ascend]/trunk/tcltk98/generic/interface/MtxProc.c
ViewVC logotype

Contents of /trunk/tcltk98/generic/interface/MtxProc.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 389 - (show annotations) (download) (as text)
Thu Mar 30 06:24:10 2006 UTC (16 years, 1 month ago) by johnpye
File MIME type: text/x-csrc
File size: 11168 byte(s)
Cleaning up #includes in the Tcl/Tk interface. Doing this
all as a group so that it can be reversed out if necessary.
1 /*
2 * Incidence matrix routines
3 * by Kirk Abbott and Ben Allan
4 * Created: 1/94
5 *
6 * This file is part of the ASCEND Tcl/Tk interface
7 *
8 * Copyright 1997, Carnegie Mellon University
9 *
10 * The ASCEND Tcl/Tk interface is free software; you can redistribute
11 * it and/or modify it under the terms of the GNU General Public License as
12 * published by the Free Software Foundation; either version 2 of the
13 * License, or (at your option) any later version.
14 *
15 * The ASCEND Tcl/Tk interface is distributed in hope that it will be
16 * useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
17 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 * General Public License for more details.
19 *
20 * You should have received a copy of the GNU General Public License
21 * along with the program; if not, write to the Free Software Foundation,
22 * Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
23 * COPYING. COPYING is found in ../compiler.
24 */
25
26
27 #ifndef NO_SIGNAL_TRAPS
28 #include <setjmp.h>
29 #include <signal.h>
30 #endif /* NO_SIGNAL_TRAPS */
31 #include <tcl.h>
32 #include <tk.h>
33 #include <utilities/ascConfig.h>
34 #include <utilities/ascSignal.h>
35 #include <utilities/ascMalloc.h>
36 #include <utilities/mem.h>
37 #include <utilities/set.h>
38 #include <general/list.h>
39 #include <compiler/fractions.h>
40 #include <compiler/dimen.h>
41 #include <compiler/compiler.h>
42 #include <compiler/instance_enum.h>
43 #include <compiler/symtab.h>
44 #include <compiler/instance_name.h>
45
46 #include <solver/incidence.h>
47
48 #include <compiler/types.h>
49 #include <compiler/functype.h>
50 #include <compiler/func.h>
51 #include <compiler/extfunc.h>
52 #include <compiler/extcall.h>
53 #include <compiler/relation_type.h>
54
55 #include "old_utils.h"
56 #include "HelpProc.h"
57 #include "Qlfdid.h"
58 #include "MtxProc.h"
59 #include "DisplayProc.h"
60 #include "HelpProc.h"
61 #include "SolverGlobals.h"
62
63
64 #ifndef lint
65 static CONST char MtxProcID[] = "$Id: MtxProc.c,v 1.29 2003/08/23 18:43:07 ballan Exp $";
66 #endif
67
68
69 #define TORF(b) ((b) ? "TRUE" : "FALSE")
70 #define YORN(b) ((b) ? "YES" : "NO")
71 #define ONEORZERO(b) ((b) ? "1" : "0")
72 #define SNULL (char *)NULL
73 #define QLFDID_LENGTH 1023
74 #define MP_DEBUG TRUE
75
76 /* Some code moved to solver/incidence.h -- JP, 30 Jan 06 */
77
78 static int GPI_Error(ClientData cdata, Tcl_Interp *interp,
79 int argc, CONST84 char *argv[])
80 {
81 /* stop gcc whine about unused parameters */
82 (void)cdata;
83 (void)argc;
84 (void)argv;
85
86 Tcl_ResetResult(interp);
87 Tcl_SetResult(interp, "Error in args to mtx_gui_plot_incidence", TCL_STATIC);
88 FPRINTF(stderr,
89 "\nmtx_gui_plot_incidence <sf xoff yoff cname bmfg bmbg ra ca va ea>\n");
90 FPRINTF(stderr,"\tsf is a bitmap size number 1-14\n");
91 FPRINTF(stderr,"\txoff is upper left x position (pixels) \n");
92 FPRINTF(stderr,"\tyoff is upper left y position (pixels) \n");
93 FPRINTF(stderr,"\tcname is the name of an existing tk canvas\n");
94 FPRINTF(stderr,"\tbmfg is the bitmap foreground color\n");
95 FPRINTF(stderr,"\tbmbg is the bitmap background color\n");
96 FPRINTF(stderr,"\tra, ca, va, ea are global arrays of index info\n");
97 FPRINTF(stderr,"\tSee MtxProc.h for more details if needed.\n");
98 return TCL_ERROR;
99 }
100
101 /*
102 TCL: mtx_gui_plot_incidence <sf xoff yoff cname bmfg bmbg ra ca va ea>\n");
103 WARNING: If you mess with this arg list, update the SET_PLOT_STRING macro
104 below.rel_incidence_list
105 */
106 int Asc_MtxGUIPlotIncidence(ClientData cdata, Tcl_Interp *interp,
107 int argc, CONST84 char *argv[])
108 {
109
110 int sf,xoff,yoff,status,i,j,x,y,vndx;
111 Tk_Window tkcanwin, tkwin;
112 slv_system_t sys;
113 incidence_vars_t pd;
114 struct rel_relation *rel;
115 const struct var_variable **vp;
116 char numstring[80],*plotstring;
117 CONST84 char *svstat;
118 int nvars,n;
119
120 if ( argc != 11 ) {
121 return GPI_Error(cdata, interp, argc, argv);
122 }
123 sf=1000;
124 xoff=yoff=2;
125 status=Tcl_GetInt(interp,argv[1],&sf);
126 if (sf > 14 || sf <1 || status==TCL_ERROR) {
127 FPRINTF(stderr, "mtx_gui_plot_incidence: illegal sf given!\n");
128 return GPI_Error(cdata, interp, argc, argv);
129 }
130 status=Tcl_GetInt(interp,argv[2],&xoff);
131 if (status==TCL_ERROR) {
132 FPRINTF(stderr, "mtx_gui_plot_incidence: illegal xoff given!\n");
133 return GPI_Error(cdata, interp, argc, argv);
134 }
135 status=Tcl_GetInt(interp,argv[3],&yoff);
136 if (status==TCL_ERROR) {
137 FPRINTF(stderr, "mtx_gui_plot_incidence: illegal yoff given!\n");
138 return GPI_Error(cdata, interp, argc, argv);
139 }
140
141 tkwin = Tk_MainWindow(interp);
142 if (ISNULL(tkwin)) {
143 FPRINTF(stderr, "mtx_gui_plot_incidence: root window gone!\n");
144 return GPI_Error(cdata, interp, argc, argv);
145 }
146 tkcanwin = Tk_NameToWindow(interp, argv[4], tkwin);
147 if (ISNULL(tkcanwin)) {
148 FPRINTF(stderr, "mtx_gui_plot_incidence: illegal cname given!\n");
149 return GPI_Error(cdata, interp, argc, argv);
150 }
151 /*
152 we are not going to verify the colors, we are just going to handle
153 errors if they do not plot properly.
154 */
155 sys = g_solvsys_cur;
156
157 if (ISNULL(sys)) {
158 FPRINTF(stderr,"mtx_gui_plot_incidence: called without slv sys\n");
159 Tcl_SetResult(interp, "mtx_gui_plot_incidence: NULL solve system",
160 TCL_STATIC);
161 return TCL_ERROR;
162 }
163 /* this needs to go
164 mtx=slv_get_sys_mtx(sys);
165 if (ISNULL(mtx)) {
166 FPRINTF(stderr,"mtx_gui_plot_incidence: linear system has no mtx\n");
167 Tcl_SetResult(interp, "mtx_gui_plot_incidence: C matrix missing! No Plot.",
168 TCL_STATIC);
169 return TCL_ERROR;
170 }
171 */
172 if (build_incidence_data(sys,&pd)) {
173 FPRINTF(stderr,"mtx_gui_plot_incidence: error calculating grid\n");
174 Tcl_SetResult(interp, "mtx_gui_plot_incidence: C plot calculation error",
175 TCL_STATIC);
176 free_incidence_data(&pd);
177 return TCL_ERROR;
178 }
179 #define MAX_BM_NAME_LEN 60
180 /*for 2 lines, y is the length of the tcl string */
181 y = strlen(argv[4]) /* window */
182 + strlen(argv[5]) + strlen(argv[6]) /* colors */
183 + 40 /* pixel coords x y */
184 + MAX_BM_NAME_LEN /* bitmap name space */
185 + 62; /* create bitmap -bitmap -anchor nw -background -foreground */
186 plotstring=(char *)ascmalloc(sizeof(char)*y+1);
187 #undef MAX_BM_NAME_LEN
188
189 /* MACRO begin. really ugly. Dependent on arglist to function.*/
190 #define SET_PLOT_STRING(type) \
191 sprintf(plotstring, \
192 "%s create bitmap %d %d -bitmap %s%d -anchor nw -background %s -foreground %s"\
193 ,argv[4],x,y,(type),sf,argv[6],argv[5])
194 /* MACRO end */
195
196 for (i=0; i < pd.nprow; i++) {
197 y=yoff+sf*i;
198 rel=pd.rlist[pd.pr2e[i]];
199 vp = rel_incidence_list(rel);
200 if (rel_included(rel) && rel_active(rel)) { /* dense squares */
201 nvars = rel_n_incidences(rel);
202 for(n=0; n < nvars; n++ ) {
203 if (var_flags(vp[n]) & VAR_SVAR) {
204 vndx = var_sindex(vp[n]);
205 x = xoff + sf*pd.v2pc[vndx];
206 if (pd.vfixed[vndx]) {
207 SET_PLOT_STRING("asc_sq_c");
208 status=Tcl_GlobalEval(interp,plotstring);
209 } else {
210 SET_PLOT_STRING("asc_sq_");
211 status=Tcl_GlobalEval(interp,plotstring);
212 }
213 if (status==TCL_ERROR) {
214 FPRINTF(stderr,"Error plotting x%d y%d with:\n%s\n",x,y,plotstring);
215 free_incidence_data(&pd);
216 return status;
217 }
218 }
219 }
220 } else { /* hollow squares */
221 if (rel_active(rel)) {
222 nvars = rel_n_incidences(rel);
223 for(n=0; n < nvars; n++ ) {
224 if (var_flags(vp[n]) & VAR_SVAR) {
225 vndx = var_sindex(vp[n]);
226 x = xoff + sf*pd.v2pc[vndx];
227 if (pd.vfixed[vndx]) {
228 SET_PLOT_STRING("asc_sq_x");
229 status=Tcl_GlobalEval(interp,plotstring);
230 } else {
231 SET_PLOT_STRING("asc_sq_h");
232 status=Tcl_GlobalEval(interp,plotstring);
233 }
234 if (status==TCL_ERROR) {
235 FPRINTF(stderr,"Error plotting x%d y%d with:\n%s\n",
236 x,y,plotstring);
237 free_incidence_data(&pd);
238 return status;
239 }
240 }
241 }
242 }
243 }
244 }
245 #undef SET_PLOT_STRING
246 /*
247 at this point we can now use plotstring as just a big string buff
248 for the array stuffing.
249 */
250 /* set arrays */
251 /* we are only going to check the first setvar in each array */
252 /* ra */
253 sprintf(plotstring,"%d",pd.nprow);
254 svstat=Tcl_SetVar2(interp,argv[7],"num",plotstring, TCL_GLOBAL_ONLY);
255 if (ISNULL(svstat)) {
256 FPRINTF(stderr,"mtx_gui_plot_incidence: Error setting %s(num)\n",argv[7]);
257 return TCL_ERROR;
258 }
259 for (i=0; i < pd.nprow; i++) {
260 sprintf(plotstring,"%d",i);
261 sprintf(numstring,"%d",pd.pr2e[i]);
262 Tcl_SetVar2(interp,argv[7],plotstring,numstring, TCL_GLOBAL_ONLY);
263 }
264 /* ca */
265 sprintf(plotstring,"%d",pd.npcol);
266 svstat=Tcl_SetVar2(interp,argv[8],"num",plotstring, TCL_GLOBAL_ONLY);
267 if (ISNULL(svstat)) {
268 FPRINTF(stderr,"mtx_gui_plot_incidence: Error setting %s(num)\n",argv[8]);
269 return TCL_ERROR;
270 }
271 for (j=0; j < pd.npcol; j++) {
272 sprintf(plotstring,"%d",j);
273 sprintf(numstring,"%d",pd.pc2v[j]);
274 Tcl_SetVar2(interp,argv[8],plotstring,numstring, TCL_GLOBAL_ONLY);
275 }
276 /* va */
277 sprintf(plotstring,"%d",pd.nvar);
278 svstat=Tcl_SetVar2(interp,argv[9],"num",plotstring, TCL_GLOBAL_ONLY);
279 if (ISNULL(svstat)) {
280 FPRINTF(stderr,"mtx_gui_plot_incidence: Error setting %s(num)\n",argv[9]);
281 return TCL_ERROR;
282 }
283 for (j=0; j < pd.nvar; j++) {
284 sprintf(plotstring,"%d",j);
285 sprintf(numstring,"%d",pd.v2pc[j]);
286 Tcl_SetVar2(interp,argv[9],plotstring,numstring, TCL_GLOBAL_ONLY);
287 }
288 /* ea */
289 sprintf(plotstring,"%d",pd.neqn);
290 svstat=Tcl_SetVar2(interp,argv[10],"num",plotstring, TCL_GLOBAL_ONLY);
291 if (ISNULL(svstat)) {
292 FPRINTF(stderr,"mtx_gui_plot_incidence: Error setting %s(num)\n",argv[10]);
293 return TCL_ERROR;
294 }
295 for (i=0; i < pd.neqn; i++) {
296 sprintf(plotstring,"%d",i);
297 sprintf(numstring,"%d",pd.e2pr[i]);
298 Tcl_SetVar2(interp,argv[10],plotstring,numstring, TCL_GLOBAL_ONLY);
299 }
300
301 free_incidence_data(&pd);
302 Tcl_ResetResult(interp);
303 ascfree(plotstring);
304 return TCL_OK;
305 }
306
307 #define LONGHELP(b,ms) ((b)?ms:"")
308 int Asc_MtxHelpList(ClientData cdata, Tcl_Interp *interp,
309 int argc, CONST84 char *argv[])
310 {
311 boolean detail=1;
312
313 (void)cdata; /* stop gcc whine about unused parameter */
314
315 if ( argc > 2 ) {
316 FPRINTF(stderr,"call is: mtxhelp [s,l] \n");
317 Tcl_SetResult(interp, "Too many args to mtxhelp. Want 0 or 1 args",
318 TCL_STATIC);
319 return TCL_ERROR;
320 }
321 if ( argc == 2 ) {
322 if (argv[1][0]=='s') {
323 detail=0;
324 }
325 if (argv[1][0]=='l') {
326 detail=1;
327 }
328 PRINTF("%-23s%s\n","mtx_gui_plot_incidence",
329 LONGHELP(detail,"set TCL array/Tk canvas info"));
330 PRINTF("%-23s%s\n","mtxhelp",
331 LONGHELP(detail,"show this list"));
332 PRINTF("\n");
333 }
334 if ( argc == 1 ) {
335 char * tmps;
336 tmps= (char *)ascmalloc((MAXIMUM_NUMERIC_LENGTH+1)*sizeof(char));
337 sprintf(tmps,"mtx_gui_plot_incidence");
338 Tcl_AppendElement(interp,tmps);
339 sprintf(tmps,"mtxhelp");
340 Tcl_AppendElement(interp,tmps);
341 ascfree(tmps);
342 }
343 return TCL_OK;
344 }

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22