source: tol/toltcl/generic/toltableset.cpp @ d143dd9

1941-docker-image-to-testdevel
Last change on this file since d143dd9 was c14b554, checked in by Jorge Pérez <josp.jorge@…>, 18 years ago

merging from NameBlock/VMatrix branch

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@4 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 41.6 KB
Line 
1/* toltableset.cpp: This file implements the command to manipulate a set
2                    as a table.
3                    GNU/tolTcl Library
4
5   Copyright (C) 2001, 2002, 2003 - Bayes Decisión, SL
6
7   This program is free software; you can redistribute it and/or modify
8   it under the terms of the GNU General Public License as published by
9   the Free Software Foundation; either version 2, or (at your option)
10   any later version.
11
12   This program is distributed in the hope that it will be useful,
13   but WITHOUT ANY WARRANTY; without even the implied warranty of
14   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15   GNU General Public License for more details.
16
17   You should have received a copy of the GNU General Public License
18   along with this program; if not, write to the Free Software
19   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
20   USA.
21 */
22
23#ifdef _MSC_VER
24/* for _finite */
25#  include <float.h>
26#endif
27
28#include <ctype.h>
29#include <toltclInt.h>
30#include <tt_crash.h>
31
32#if defined(_MSC_VER)
33#  include <win_tolinc.h>
34#endif
35
36#include <tol/tol_bcommon.h>
37#include <tol/tol_bdatgra.h>
38#include <tol/tol_bmatgra.h>
39#include <tol/tol_bvmatgra.h>
40#include <tol/tol_bsetgra.h>
41#include <tol/tol_btxtgra.h>
42
43#include <tt_pool.h>
44#include <tt_tclutils.h>
45
46#ifndef NDEBUG
47#define _DEBUG_TABLE_
48#endif
49
50class Tol_Table;
51class Tol_TableSet;
52
53class Tol_ColumnData {
54public:
55  enum enumColType { Text=0, Real, Date };
56
57  Tol_ColumnData( enumColType t );
58  ~Tol_ColumnData();
59  enumColType GetType() {
60    return type;
61  }
62  int HasINF() {
63    return hasINF;
64  }
65  int HasUNK() {
66    return hasUNK;
67  }
68
69  /* return the current number of rows */
70
71  int GetSize() {
72    int size;
73   
74    Tcl_ListObjLength(NULL, values, &size);
75    return size;
76  }
77
78  Tcl_Obj * GetValues() {
79    return values;
80  }
81
82  /* name <colname> type <coltype> [unknown (yes|no) INF (yes|no)] */
83
84  Tcl_Obj * GetInfo();
85
86  /* interp <-- values */
87
88  int ReturnData(Tcl_Interp * interp);
89 
90  /* return values[row] in cell */
91
92  int ReturnCell(Tcl_Interp * interp, int row);
93
94  /*
95   * return the value[row], leave in interp an error message if
96   * something went wrong.
97   */
98
99  Tcl_Obj * GetCell(Tcl_Interp * interp, int row);
100
101  /*
102   * apply script to values[0..]
103   *
104   *  eval $script $row value[$row]
105   */
106
107  int Apply(Tcl_Interp * interp, Tcl_Obj * script);
108
109  void SetName( const char * str );
110
111  int AppendBDat(Tcl_Interp * interp, BDat & dat);
112  int AppendSyntaxObject( Tcl_Interp * interp, BSyntaxObject * so );
113  int PrependSyntaxObject( Tcl_Interp * interp, BSyntaxObject * so );
114  int AppendEmpty();
115  int PrependEmpty();
116protected:
117  /* append functions */
118  int AppendReal( Tcl_Interp * interp, double v );
119  int AppendInfinity();
120  int AppendUnknown();
121  int AppendEmptyReal();
122  int AppendText( char * txt );
123  /* prepend functions */
124  int PrependReal( Tcl_Interp * interp, double v );
125  int PrependInfinity();
126  int PrependUnknown();
127  int PrependEmptyReal();
128  int PrependText( char * txt );
129private:
130  Tcl_DString dsName;
131  enumColType type;
132  int hasINF;
133  int hasUNK;
134  /* list of column values */
135  Tcl_Obj * values;
136};
137
138class Tol_Table {
139public:
140  enum enumHeaderType { Struct, Row, Generic };
141
142  Tol_Table(Tcl_Interp * _interp, char * name);
143  ~Tol_Table();
144
145  void CreateCommand(char * cmd_name) {
146    if (cmd_status == TCL_OK )
147      Tcl_CreateObjCommand(interp, cmd_name, Tol_Table::ObjCmd,
148                           (ClientData)this, Tol_Table::DeleteCmd);
149  }
150
151  int CmdStatus() {
152    return cmd_status;
153  }
154 
155  static int ObjCmd( ClientData clientData,
156                     Tcl_Interp *interp,
157                     int objc, Tcl_Obj *CONST objv[] );
158
159  static void DeleteCmd( ClientData clientData );
160
161  Tcl_Interp * GetInterp(void) {
162    return interp;
163  }
164  int GetRows() {
165    return rows;
166  }
167 
168  /*
169   * implement: tableset info name
170   */
171
172  int ReturnName();
173
174  /*
175   * implement: tableset info header
176   */
177
178  int ReturnHeaderInfo();
179
180  /*
181   * implement: tableset info datarows
182   */
183
184  int ReturnRowsNumber();
185
186  /*
187   * implement: tableset info rowsnames
188   */
189
190  int ReturnRowsNames();
191
192  /*
193   * implement: tableset info columns
194   */
195
196  int ReturnColumnsInfo();
197
198  /*
199   * implement: tableset data get i j
200   *
201   * interp <-- set_data(row,col)
202   */
203
204  int ReturnCell( int row, int col );
205
206  /*
207   * implement: tableset data column col
208   *
209   * interp <-- set_data(col)->ReturnData(interp)
210   */
211
212  int ReturnColumn( int col );
213
214  /*
215   * implement: tableset data apply all script
216   */
217
218  int ApplyAll( Tcl_Obj * script );
219
220  /*
221   * implement: tableset data apply row idx script
222   */
223
224  int ApplyRow( int row, Tcl_Obj * script );
225
226  /*
227   * implement: tableset data apply column idx script
228   */
229
230  int ApplyColumn( int col, Tcl_Obj * script );
231 
232protected:
233  Tcl_Interp * interp;
234
235  int   rows;
236  Tcl_DString dsName;
237  /* how are gotten header names */
238  enumHeaderType  headerType;
239  int extraColumns;
240  ToltclPool columns;
241  Tcl_Obj ** rowsNames;
242  int cmd_status;
243  Tcl_Obj ** retBuffer;
244
245  Tol_ColumnData ** Columns( int i ) {
246    return (Tol_ColumnData**)columns._GetObject(i);
247  }
248};
249
250class Tol_TableSet : public Tol_Table {
251public:
252  Tol_TableSet(Tcl_Interp * _interp, char * setname, BSet * set,
253               Tcl_Obj * obj_result); 
254protected:
255  int Build(BSet * set, Tcl_Obj * obj_result);
256};
257
258class Tol_TableMatrix : public Tol_Table {
259public:
260  Tol_TableMatrix(Tcl_Interp * _interp, char * matname, BMatrix<double> *mat,
261                  Tcl_Obj * obj_result);
262protected:
263  int Build(BMatrix<double> *mat, Tcl_Obj * obj_result); 
264};
265
266/*
267 * Tol_ColumnData implementation
268 *
269 */
270
271/*
272 *   Tol_ColumnData::Tol_ColumnData
273 *
274 *     Constructor
275 */
276
277Tol_ColumnData::Tol_ColumnData( Tol_ColumnData::enumColType t )
278{
279  Tcl_DStringInit( &dsName );
280  type = t;
281  hasINF = 0;
282  hasUNK = 0;
283  Tcl_IncrRefCount(values=Tcl_NewListObj(0, NULL));
284}
285
286/*
287 *  Tol_ColumnData::~Tol_ColumnData()
288 *
289 *    Destructor
290 */
291
292Tol_ColumnData::~Tol_ColumnData()
293{
294  Tcl_DStringFree(&dsName);
295  Tcl_DecrRefCount(values);
296}
297
298/*
299 *  Tol_ColumnData::GetInfo()
300 *
301 *    return
302 *      name <colname> type <coltype> [unknown (0|1) INF (0|1)]
303 */
304
305Tcl_Obj * Tol_ColumnData::GetInfo()
306{
307  Tcl_Obj * info;
308
309#define CD_NAME    0
310#define CD_NAMEV   CD_NAME  + 1
311#define CD_TYPE    CD_NAMEV + 1
312#define CD_TYPEV   CD_TYPE  + 1
313#define CD_UNK     CD_TYPEV + 1
314#define CD_UNKV    CD_UNK   + 1
315#define CD_INF     CD_UNKV  + 1
316#define CD_INFV    CD_INF   + 1
317#define CD_SIZE    CD_INFV  + 1
318
319  int itemc = CD_UNK;
320  Tcl_Obj * itemv[CD_SIZE];
321
322  itemv[CD_NAME] = Tcl_NewStringObj( "name", -1 );
323  itemv[CD_NAMEV] = Tcl_NewStringObj( Tcl_DStringValue(&dsName), -1 );
324  itemv[CD_TYPE] = Tcl_NewStringObj( "type", -1 );
325  switch ( type ) {
326    case Text:
327      itemv[CD_TYPEV] = Tcl_NewStringObj( "Text", -1 );
328      break;
329    case Real:
330      itemv[CD_TYPEV] = Tcl_NewStringObj( "Real", -1 );
331      itemv[CD_UNK] = Tcl_NewStringObj( "unknown", -1 );
332      itemv[CD_UNKV] = Tcl_NewIntObj( hasUNK );
333      itemv[CD_INF] = Tcl_NewStringObj( "infinity", -1 );
334      itemv[CD_INFV] = Tcl_NewIntObj( hasINF );
335      itemc = CD_SIZE;
336      break;
337    case Date:
338      itemv[CD_TYPEV] = Tcl_NewStringObj( "Date", -1 );
339  }
340  info = Tcl_NewListObj( itemc, itemv );
341  return info;
342}
343
344
345/*
346 *  Tol_ColumnData::ReturnData
347 *
348 *    return to interp the values of the column
349 *
350 */
351
352int Tol_ColumnData::ReturnData(Tcl_Interp * interp)
353{
354  Tcl_SetObjResult(interp, values);
355  return TCL_OK;
356}
357
358Tcl_Obj * Tol_ColumnData::GetCell(Tcl_Interp * interp, int row)
359{
360  Tcl_Obj * obj = NULL;
361 
362  if (Tcl_ListObjIndex(interp, values, row, &obj)==TCL_OK)
363    if (!obj) {
364      char buffer[256];
365      sprintf(buffer,"GetCell, index '%d', out of range", row);
366      Tcl_AppendResult(interp, buffer, NULL);
367    }
368  return obj;
369}
370
371int Tol_ColumnData::ReturnCell(Tcl_Interp * interp, int row)
372{
373  Tcl_Obj * obj;
374
375  if (Tcl_ListObjIndex(interp, values, row, &obj)==TCL_OK) {
376    if (obj) {
377      Tcl_SetObjResult(interp, obj);
378      return TCL_OK;
379    }
380    char buffer[256];
381    sprintf(buffer,"ReturnCell, index '%d', out of range", row);
382    Tcl_AppendResult(interp, buffer, NULL);
383  }
384  return TCL_ERROR;
385}
386
387/*
388 *  Tol_ColumnData::Apply
389 *
390 *    apply script to values[0..]
391 *
392 *      eval $script $row value[$row]
393 */
394int Tol_ColumnData::Apply(Tcl_Interp * interp, Tcl_Obj * scriptObj)
395{
396  Tcl_Obj * args[2];
397  Tcl_Obj ** items;
398  int count;
399
400  Tcl_IncrRefCount(args[0]=Tcl_NewObj());
401 
402  /* init script evaluator */
403
404  EvalScript script(interp, scriptObj, 2, args );
405  /* get the array of elements */
406  Tcl_ListObjGetElements(interp, values, &count, &items);
407  for (int r = 0; (r < count) && (script.Status()==TCL_OK); r++) {
408    /* set the arg row value */
409    if (Tcl_IsShared(args[0])) {
410      Tcl_DecrRefCount(args[0]);
411      Tcl_IncrRefCount(args[0] =Tcl_NewIntObj(r));
412    } else
413      Tcl_SetIntObj(args[0], r);
414    /* set the cell value */
415    args[1] = items[r];
416 
417   /* invoke the script */
418   
419    script.Eval();
420  }
421  Tcl_DecrRefCount(args[0]);
422  return script.Status();
423}
424
425void Tol_ColumnData::SetName( const char * str )
426{
427  Tcl_DStringFree( &dsName );
428  Tcl_ExternalToUtfDString( NULL, str, -1, &dsName ); 
429}
430
431/*
432 *  Tol_ColumnData::AppendReal
433 */
434
435int Tol_ColumnData::AppendReal(Tcl_Interp * interp, double v)
436{
437#ifdef _DEBUG_TABLE_
438  if ( type != Real ) {
439    Tcl_AppendResult( interp,
440                      "Tol_ColumnData::AppendReal called on not Real column", NULL );
441    return TCL_ERROR;
442  }
443#endif
444  return Tcl_ListObjAppendElement(interp, values, Tcl_NewDoubleObj(v));
445}
446
447/*
448 *  Tol_ColumnData::PrependReal
449 */
450
451int Tol_ColumnData::PrependReal(Tcl_Interp * interp, double v)
452{
453#ifdef _DEBUG_TABLE_
454  if ( type != Real ) {
455    Tcl_AppendResult( interp,
456                      "Tol_ColumnData::PrependReal called on not Real column", NULL );
457    return TCL_ERROR;
458  }
459#endif
460  Tcl_Obj * items[1];
461  items[0] = Tcl_NewDoubleObj(v);
462  return Tcl_ListObjReplace(NULL, values, 0, 0, 1, items);
463}
464
465/*
466 *  Tol_ColumnData::AppendInfinity
467 */
468
469int Tol_ColumnData::AppendInfinity()
470{
471#ifdef _DEBUG_TABLE_
472  if ( type != Real )
473    return TCL_ERROR;
474#endif
475  hasINF = 1;
476  return Tcl_ListObjAppendElement(NULL, values, Tcl_NewStringObj("INF",-1));
477}
478
479/*
480 *  Tol_ColumnData::PrependInfinity
481 */
482
483int Tol_ColumnData::PrependInfinity()
484{
485#ifdef _DEBUG_TABLE_
486  if ( type != Real )
487    return TCL_ERROR;
488#endif
489  hasINF = 1;
490  Tcl_Obj * items[1];
491  items[0] = Tcl_NewStringObj("INF",-1);
492  return Tcl_ListObjReplace(NULL, values, 0, 0, 1, items);
493}
494
495/*
496 *  Tol_ColumnData::AppendUnknown --
497 */
498
499int Tol_ColumnData::AppendUnknown()
500{
501#ifdef _DEBUG_TABLE_
502  if ( type != Real )
503    return TCL_ERROR;
504#endif
505  hasUNK = 1;
506  return Tcl_ListObjAppendElement(NULL, values, Tcl_NewStringObj("?",-1));
507}
508
509/*
510 *  Tol_ColumnData::PrependUnknown --
511 */
512
513int Tol_ColumnData::PrependUnknown()
514{
515#ifdef _DEBUG_TABLE_
516  if ( type != Real )
517    return TCL_ERROR;
518#endif
519  hasUNK = 1;
520  Tcl_Obj * items[1];
521  items[0] = Tcl_NewStringObj("?",-1);
522  return Tcl_ListObjReplace(NULL, values, 0, 0, 1, items);
523}
524
525/*
526 *  Tol_ColumnData::AppendEmptyReal --
527 */
528
529int Tol_ColumnData::AppendEmptyReal()
530{
531#ifdef _DEBUG_TABLE_
532  if ( type != Real )
533    return TCL_ERROR;
534#endif
535  hasUNK = 1;
536  return Tcl_ListObjAppendElement(NULL, values, Tcl_NewObj());
537}
538
539/*
540 *  Tol_ColumnData::PrependEmptyReal --
541 */
542
543int Tol_ColumnData::PrependEmptyReal()
544{
545#ifdef _DEBUG_TABLE_
546  if ( type != Real )
547    return TCL_ERROR;
548#endif
549  hasUNK = 1;
550  Tcl_Obj * items[1];
551  items[0] = Tcl_NewObj();
552  return Tcl_ListObjReplace(NULL, values, 0, 0, 1, items);
553}
554
555/*
556 *  Tol_ColumnData::AppendText --
557 *
558 */
559
560int Tol_ColumnData::AppendText( char * txt )
561{
562#ifdef _DEBUG_TABLE_
563  if ( type == Real )
564    return TCL_ERROR;
565#endif
566
567  while (*txt && isspace(*txt))
568    ++txt;
569  return Tcl_ListObjAppendElement(NULL, values, Tcl_NewStringObj(txt,-1));
570}
571
572/*
573 *  Tol_ColumnData::PrependText --
574 *
575 */
576
577int Tol_ColumnData::PrependText( char * txt )
578{
579#ifdef _DEBUG_TABLE_
580  if ( type == Real )
581    return TCL_ERROR;
582#endif
583  while (*txt && isspace(*txt))
584    ++txt;
585  Tcl_Obj * items[1];
586  items[0] = Tcl_NewStringObj(txt,-1);
587  return Tcl_ListObjReplace(NULL, values, 0, 0, 1, items);
588}
589
590/*
591 * Tol_columnData::AppendBDat --
592 *
593 */
594
595int Tol_ColumnData::AppendBDat(Tcl_Interp * interp, BDat & dat)
596{
597  if ( dat.IsKnown() ) {
598    double v = dat.Value();
599    if ( isinf(v) )
600      AppendInfinity();
601    else
602      AppendReal(interp, v);
603  } else
604    AppendUnknown();
605  return TCL_OK;
606}
607
608/*
609 *  Tol_ColumnData::AppendSyntaxObject --
610 *
611 */
612
613int Tol_ColumnData::AppendSyntaxObject(Tcl_Interp * interp, BSyntaxObject * so)
614{
615  enumColType so_type = Text;
616
617  if ( so->Grammar() == GraReal() )
618    so_type = Real;
619  else if ( so->Grammar() == GraDate() )
620    so_type = Date;
621  if ( type == Real ) {
622    if ( so_type == Real ) {
623      /* keep on Real column */
624
625      return AppendBDat(interp, Dat(so));
626      /*
627      BDat dat( Dat(so) );
628
629      if ( dat.IsKnown() ) {
630        double v = dat.Value();
631        if ( isinf(v) )
632          AppendInfinity();
633        else
634          AppendReal(interp, v);
635      } else
636        AppendUnknown();
637      return TCL_OK;
638      */
639    } else {
640      if ((so_type == Date) && GetSize()) {
641        /* start a Date column */
642        type = Date;
643      } else {
644        /* convert to Text column, what a shame!!! */
645        type = Text;
646      }
647    }
648  } else if ( type == Date && so_type != Date ) {
649    /* change from Date to Text */
650    type = Text;
651  }
652
653  /*** SI so_type == Text adicionar el contenido de las cadenas sin las "'s ***/
654
655  /* now add the info regardless being Text or Date */
656  BText info(so->Info());
657  AppendText(info.Buffer());
658
659  return TCL_OK;
660}
661
662/*
663 *  Tol_ColumnData::PrependSyntaxObject --
664 *
665 */
666
667int Tol_ColumnData::PrependSyntaxObject( Tcl_Interp * interp, BSyntaxObject * so )
668{
669  enumColType so_type = Text;
670
671  if ( so->Grammar() == GraReal() )
672    so_type = Real;
673  else if ( so->Grammar() == GraDate() )
674    so_type = Date;
675  if ( type == Real ) {   
676    if ( so_type == Real ) {
677      /* keep on Real column */
678     
679      BDat dat( Dat(so) );
680
681      if ( dat.IsKnown() ) {
682        double v = dat.Value();
683        if ( isinf(v) )
684          PrependInfinity();
685        else
686          PrependReal(interp, v);
687      } else
688        PrependUnknown();
689      return TCL_OK;
690    } else {
691      /* convert to Text column, what a shame!!! */
692      type = Text;
693    }
694  } else if ( type == Date && so_type != Date ) {
695    /* change from Date to Text */
696    type = Text;
697  }
698
699  /* now add the info regardless being Text or Date */
700  BText info(so->Info());
701  PrependText(info.Buffer());
702
703  return TCL_OK;
704}
705
706/*
707 *  Tol_ColumnData::AppendEmpty --
708 *
709 */
710
711int Tol_ColumnData::AppendEmpty()
712{
713  if ( type == Real )
714    AppendEmptyReal();
715  else
716    AppendText("");
717
718  return TCL_OK;
719}
720
721/*
722 *  Tol_ColumnData::PrependEmpty --
723 *
724 */
725
726int Tol_ColumnData::PrependEmpty()
727{
728 
729  if ( type == Real )
730    PrependEmptyReal();
731  else
732    PrependText("");
733  return TCL_OK;
734}
735
736/*
737 *  Tol_Table implementation
738 *
739 */
740
741/*
742 * Tol_Table::Tol_Table --
743 */
744
745Tol_Table::Tol_Table(Tcl_Interp * _interp, char * name)
746{
747  rows = 0;
748  interp = _interp;
749  rowsNames = NULL;
750  retBuffer = NULL;
751  Tcl_DStringInit( &dsName );
752  Tcl_ExternalToUtfDString( NULL, name, -1, &dsName );   
753}
754
755/*
756 *  Tol_Table::~Tol_Table()
757 *
758 *    Destructor
759 */
760
761Tol_Table::~Tol_Table()
762{
763  int i;
764
765  Tcl_DStringFree(&dsName);
766  if (rowsNames) {
767    int sizeRN;
768   
769    sizeRN = (headerType == Row) ? rows + 1: rows;
770    for ( i = 0; i < sizeRN; i++ )
771      Tcl_DecrRefCount( rowsNames[i] );
772    Tcl_Free( (char*)rowsNames );
773    rowsNames = NULL;
774  }
775  if ( retBuffer ) {
776    Tcl_Free( (char*)retBuffer );
777    retBuffer = NULL;
778  }
779  for ( i = 0; i < columns.GetSize(); i++ )
780    delete *Columns(i);
781}
782 
783/*
784 *  Tol_Table::ReturnName --
785 *
786 *    implement: tableset info name
787 */
788
789int Tol_Table::ReturnName()
790{
791  Tcl_AppendResult( interp, Tcl_DStringValue(&dsName), NULL );
792  return TCL_OK;
793}
794
795/*
796 *  Tol_Table::ReturnHeaderInfo --
797 *
798 *    implement: tableset info header
799 */
800
801int Tol_Table::ReturnHeaderInfo()
802{
803  switch ( headerType ) {
804    case Struct:
805      Tcl_AppendResult( interp, "struct", NULL );
806      break;
807    case Row:
808      char buffer[256];
809     
810      sprintf( buffer, "row %d", extraColumns );
811      Tcl_AppendResult( interp, buffer, NULL );
812      break;
813    case Generic:      Tcl_AppendResult( interp, "generic", NULL );
814      break;
815    default:
816      Tcl_AppendResult( interp, "FATAL: found invalid header type", NULL );
817      return TCL_ERROR;
818  }
819  return TCL_OK;
820}
821
822/*
823 *  Tol_Table::ReturnRowsNumber --
824 *
825 *    implement: tableset info rows
826 */
827
828int Tol_Table::ReturnRowsNumber()
829{
830  char buffer[1024];
831
832  sprintf( buffer, "%d", rows );
833  Tcl_AppendResult( interp, buffer, NULL );
834  return TCL_OK;
835}
836
837/*
838 *  Tol_Table::ReturnRowsNames --
839 *
840 *    Return the list with the name of the elements of the set.
841 *
842 */
843
844int Tol_Table::ReturnRowsNames()
845{
846  int itemc;
847 
848  itemc = (headerType == Row) ? rows + 1 : rows;
849  Tcl_SetObjResult(interp, Tcl_NewListObj(itemc, rowsNames));
850  return TCL_OK;
851}
852
853/*
854 *  Tol_Table::ReturnColumnsInfo --
855 *
856 *    implement: tableset info columns
857 */
858
859int Tol_Table::ReturnColumnsInfo()
860{
861  Tol_ColumnData * ptrCol;
862  int itemc, i;
863  Tcl_Obj ** itemv;
864 
865  itemc = columns.GetSize();
866  itemv = (Tcl_Obj**)Tcl_Alloc( itemc * sizeof(Tcl_Obj*) );
867  for ( i = 0; i < itemc; i++ ) {
868    ptrCol = *Columns(i);
869    itemv[i] = ptrCol->GetInfo();
870  }
871  Tcl_SetObjResult( interp, Tcl_NewListObj(itemc, itemv) );
872  Tcl_Free( (char*)itemv );
873  return TCL_OK;
874}
875
876/*
877 *  Tol_Table::ReturnCell
878 *
879 *    implement: tableset data get i j
880 *
881 *    interp <-- set_data(row,col)
882 */
883
884int Tol_Table::ReturnCell( int row, int col )
885{
886  Tol_ColumnData * ptrCol;
887  char buffer[1024];
888
889  /* validate arguments */
890
891  if ( row < 0 || row >= rows ) {
892    sprintf( buffer, "invalid row index must be >= 0 && < %d", rows );
893    Tcl_AppendResult( interp, buffer, NULL );   
894    return TCL_ERROR;
895  }
896  if ( col < 0 || col >= columns.GetSize() ) {
897    sprintf( buffer, "invalid column index must be >= 0 && < %d", columns.GetSize() );
898    Tcl_AppendResult( interp, buffer, NULL );   
899    return TCL_ERROR;
900  }
901  ptrCol = *Columns(col);
902  return ptrCol->ReturnCell(interp, row);
903}
904
905/*
906 *  Tol_Table::ReturnColumn
907 *
908 *    implement: tableset data column col
909 *
910 *      interp <-- set_data(col)->ReturnData(interp)
911 */
912
913int Tol_Table::ReturnColumn( int col )
914{
915  Tol_ColumnData * ptrCol;
916
917  /* validate column */
918
919  if ( col < 0 || col >= columns.GetSize() ) {
920    char buffer[1024];
921
922    sprintf( buffer, "invalid column index must be >= 0 && < %d", columns.GetSize() );
923    Tcl_AppendResult( interp, buffer, NULL );   
924    return TCL_ERROR;
925  }
926  ptrCol = *Columns(col);
927  return ptrCol->ReturnData(interp);
928}
929
930
931
932/*
933 *  Tol_Table::ApplyAll --
934 *
935 *    implement: tableset apply all script
936 */
937
938int Tol_Table::ApplyAll( Tcl_Obj * scriptObj )
939{
940  Tcl_Obj * args[3];
941  Tcl_Obj ** items;
942  Tol_ColumnData * ptrCol;
943  int i, r, c, count;
944
945  for ( i = 0; i < 2; i++ ) {
946    args[i] = Tcl_NewObj();
947    Tcl_IncrRefCount( args[i] );
948  }
949
950  /* Init script evaluator */
951
952  EvalScript script(interp, scriptObj, 3, args);
953  for ( c = 0; (script.Status()==TCL_OK) && (c<columns.GetSize()); c++ ) {
954    /* Get the column */
955    ptrCol = *Columns(c);
956
957    /* Set the arg column value */
958
959    if ( Tcl_IsShared( args[1] ) ) {
960      Tcl_DecrRefCount( args[1] );
961      args[1] = Tcl_NewIntObj( c );
962      Tcl_IncrRefCount( args[1] );
963    } else
964      Tcl_SetIntObj( args[1], c );
965    r = 0;
966    /* get the array of elements */
967    Tcl_ListObjGetElements(interp, ptrCol->GetValues(), &count, &items);
968    for (int r = 0; (r < count) && (script.Status()==TCL_OK); r++) {
969      /* set the arg row value */
970      if (Tcl_IsShared(args[0])) {
971        Tcl_DecrRefCount(args[0]);
972        Tcl_IncrRefCount(args[0] =Tcl_NewIntObj(r));
973      } else
974        Tcl_SetIntObj(args[0], r);
975      /* set the cell value */
976      args[2] = items[r];
977     
978      /* invoke the script */
979     
980      script.Eval();
981    }
982  }
983
984  for ( i = 0; i < 2; i++ )
985    Tcl_DecrRefCount(args[i]);
986 
987  return script.Status();
988}
989
990/*
991 *  Tol_Table::ApplyRow
992 *
993 *    implement: tableset apply row idx script
994 */
995
996int Tol_Table::ApplyRow( int row, Tcl_Obj * scriptObj )
997{
998  Tcl_Obj * args[2];
999  Tol_ColumnData * ptrCol;
1000  int c;
1001 
1002  /* verify the row argument */
1003 
1004  if ( row < 0 || row >= rows ) {
1005    char buffer[1024];
1006
1007    sprintf( buffer, "invalid row index must be >= 0 && < %d", rows );
1008    Tcl_AppendResult( interp, buffer, NULL );
1009    return TCL_ERROR;
1010  }
1011
1012  Tcl_IncrRefCount(args[0] = Tcl_NewObj());
1013
1014  /* Init script evaluator */
1015
1016  EvalScript script(interp, scriptObj, 2, args);
1017 
1018  /* loop over columns */
1019
1020  for (c = 0; (script.Status() != TCL_ERROR) && (c < columns.GetSize()); c++ ) {
1021
1022    /* Get the column */
1023
1024    ptrCol = *Columns(c);
1025
1026    /* Set the arg column value */
1027   
1028    if ( Tcl_IsShared( args[0] ) ) {
1029      Tcl_DecrRefCount( args[0] );
1030      args[0] = Tcl_NewIntObj( c );
1031      Tcl_IncrRefCount( args[0] );
1032    } else
1033      Tcl_SetIntObj( args[0], c );
1034   
1035    /* set the cell value */
1036    if (!(args[1] = ptrCol->GetCell(interp, row))) {
1037      /* there was an error getting the cell value */
1038      Tcl_DecrRefCount(args[0]);
1039      return TCL_ERROR;
1040    }
1041    /* Invoke the script */
1042   
1043    script.Eval();
1044  }
1045  Tcl_DecrRefCount(args[0]);
1046  return script.Status();
1047}
1048
1049/*
1050 *  Tol_Table::ApplyColumn
1051 *
1052 *    implement: tableset apply column idx script
1053 */
1054
1055int Tol_Table::ApplyColumn( int col, Tcl_Obj * script )
1056{
1057  Tol_ColumnData * ptrCol;
1058
1059  /* validate the column argument */
1060
1061 
1062  if ( col < 0 || col >= columns.GetSize() ) {
1063    char buffer[1024];
1064
1065    sprintf( buffer, "invalid column index must be >= 0 && < %d", columns.GetSize() );
1066    Tcl_AppendResult( interp, buffer, NULL );
1067    return TCL_ERROR;
1068  }
1069
1070  ptrCol = *Columns(col);
1071 
1072  return ptrCol->Apply(interp, script);
1073}
1074
1075/*
1076 *  Tol_Table::ObjCmd --
1077 *
1078 *    implement an specific group of set given by clientData.
1079 *
1080 *    table info (name | header | rows | columns)
1081 *
1082 *    table data
1083 *
1084 *      table data get i j --> return element in row i column j
1085 *
1086 *      table data apply
1087 *
1088 *         table data apply all script  -->
1089 *
1090 *                            executes script foreach item in the table
1091 *                            concats to script 'i j value' (row, col and value)
1092 *
1093 *         table data apply row idx script -->
1094 *
1095 *                            executes script foreach item in row idx
1096 *                            concats to script 'i value' (column value)
1097 *
1098 *         table data iter column idx script -->
1099 *
1100 *                            executes script foreach item in column idx
1101 *                            concats to script 'i value' (row value)
1102 *
1103 *     table data column idx --> return data in column idx. If column's type
1104 *                             isn't real returns a list with all values. If
1105 *                             column's type is real returns a list with blt
1106 *                             vectors and probabily unknown values, ej,
1107 *                             {Y1 Y2 {} {} Y3 *INF}
1108 */
1109
1110
1111int Tol_Table::ObjCmd (ClientData clientData,
1112                       Tcl_Interp *interp,
1113                       int objc, Tcl_Obj *CONST objv[])
1114{
1115  int tcl_code;
1116  int i, j;
1117 
1118  char * cmd = Tcl_GetString(objv[0]);
1119
1120#ifdef __RELEASE__
1121  try_crash {
1122#endif
1123    Tol_Table * sgrp = (Tol_Table*) clientData;
1124 
1125    if ( objc < 2 ) {
1126      Tcl_AppendResult( interp,
1127                        "wrong # args: should be \"",
1128                        cmd, " option\"", NULL );
1129      return TCL_ERROR;
1130    }
1131 
1132    char * option = Tcl_GetString(objv[1]);
1133    int length = strlen(option);
1134 
1135    if (length && !strncmp( "info", option, length )) {
1136      if ( objc != 3 ) {
1137        Tcl_AppendResult( interp,
1138                          "wrong # args: should be \"",
1139                          cmd, " info option\"", NULL );
1140        return TCL_ERROR;
1141      }
1142      option = Tcl_GetString( objv[2] );
1143      length = strlen( option );
1144      if ( length && !strncmp( "name", option, length ) )
1145        return sgrp->ReturnName();
1146      else if ( length && !strncmp( "header", option, length ) )
1147        return sgrp->ReturnHeaderInfo();
1148      else if ( length && !strncmp( "datarows", option, length ) )
1149        return sgrp->ReturnRowsNumber();
1150      else if ( length && !strncmp( "rowsnames", option, length ) )
1151        return sgrp->ReturnRowsNames();
1152      else if ( length && !strncmp( "columns", option, length ) )
1153        return sgrp->ReturnColumnsInfo();
1154      else {
1155        Tcl_AppendResult( interp,
1156                          "invalid  arg '", option, " should be \"",
1157                          " name, header, datarows, rowsnames or columns\"", NULL );
1158        return TCL_ERROR;
1159      }
1160      //return sgrp->ReturnInfo();
1161    } else if ( length && !strncmp("data", option, length) ) {
1162      if ( objc < 3 || objc > 6 ) {
1163        Tcl_AppendResult( interp,
1164                          "wrong # args: should be: \n",
1165                          cmd, " data get i j\n",
1166                          cmd, " data apply all script\n",
1167                          cmd, " data apply row idx script\n",
1168                          cmd, " data apply column idx script\n",
1169                          cmd, " data column idx", NULL);
1170        return TCL_ERROR;
1171      }
1172      char * arg = Tcl_GetString(objv[2]);
1173   
1174      if ( !strcmp( "column", arg) ) {
1175        if (objc != 4) {
1176          Tcl_AppendResult( interp,
1177                            "wrong # args: should be \"",
1178                            cmd, " data column idx\"", NULL );
1179          return TCL_ERROR;
1180        }
1181        tcl_code = Tcl_GetIntFromObj( interp, objv[3], &i );
1182        if ( tcl_code != TCL_OK )
1183          return tcl_code;
1184        return sgrp->ReturnColumn( i );
1185      } else if ( !strcmp("get", arg) ) {
1186        if ( objc != 5 ) {
1187          Tcl_AppendResult( interp,
1188                            "wrong # args: should be \"",
1189                            cmd, " data get i j\"", NULL );
1190          return TCL_ERROR;
1191        }
1192        tcl_code = Tcl_GetIntFromObj( interp, objv[3], &i );
1193        if ( tcl_code != TCL_OK )
1194          return tcl_code;
1195        tcl_code = Tcl_GetIntFromObj( interp, objv[4], &j );
1196        if ( tcl_code != TCL_OK )
1197          return tcl_code;
1198        sgrp->ReturnCell( i, j );
1199      } else if ( !strcmp("apply", arg) ) {
1200        if (objc < 4) {
1201          Tcl_AppendResult( interp,
1202                            "wrong # args: should be: ",
1203                            cmd, " data apply all script\n",
1204                            cmd, " data apply row idx script\n",
1205                            cmd, " data apply column idx script",NULL);
1206          return TCL_ERROR;
1207        }
1208        arg = Tcl_GetString( objv[3] );
1209        if ( !strcmp("all", arg) ) {
1210          if ( objc != 5 ) {
1211            Tcl_AppendResult( interp,
1212                              "wrong # args: should be \"",
1213                              cmd,
1214                              " data apply all script\"", NULL );
1215            return TCL_ERROR;
1216          }
1217          return sgrp->ApplyAll( objv[4] );
1218          //OK de data apply all script
1219        } else if (!strcmp("row", arg) ) {
1220          if (objc != 6) {
1221            Tcl_AppendResult( interp,
1222                              " wrong # args: should be \"",
1223                              cmd,
1224                              " data apply row idx script\"", NULL );
1225            return TCL_ERROR;
1226          }
1227          tcl_code = Tcl_GetIntFromObj( interp, objv[4], &i );
1228          if ( tcl_code != TCL_OK )
1229            return tcl_code;
1230          return sgrp->ApplyRow( i, objv[5] );
1231        } else if ( !strcmp("column", arg) ) {
1232          if ( objc != 6 ) {
1233            Tcl_AppendResult( interp,
1234                              "wrong # args: should be \"",
1235                              cmd,
1236                              " data apply column idx script\"", NULL );
1237            return TCL_ERROR;
1238          }
1239          tcl_code = Tcl_GetIntFromObj( interp, objv[4], &i );
1240          if ( tcl_code != TCL_OK )
1241            return tcl_code;
1242          return sgrp->ApplyColumn( i, objv[5] );
1243        } else {
1244          Tcl_AppendResult( interp,
1245                            "wrong # args: should be: ",
1246                            cmd, " data apply all script\n",
1247                            cmd, " data apply row idx script\n",
1248                            cmd, " data apply column idx script",NULL);
1249          return TCL_ERROR;
1250        }
1251      } else {
1252        Tcl_AppendResult( interp,
1253                          "wrong # args: should be: \n",
1254                          cmd, " data get i j\n",
1255                          cmd, " data apply all script\n",
1256                          cmd, " data apply row idx script\n",
1257                          cmd, " data apply column idx script\n",
1258                          cmd, " data column idx", NULL);
1259        return TCL_ERROR;
1260      }
1261    } else {
1262      Tcl_AppendResult( interp, "bad option \"",option,
1263                        "\": must be info or data",NULL);
1264      return TCL_ERROR;
1265    }
1266#ifdef __RELEASE__
1267  } catch_crash {
1268    Tcl_AppendResult( interp,
1269                      "Fatal error in tableset subcommand, kill the application",
1270                      NULL);
1271    return TCL_ERROR;
1272  }
1273#endif
1274}
1275
1276void Tol_Table::DeleteCmd( ClientData clientData )
1277{
1278  Tol_Table * tsg = (Tol_Table*)clientData;
1279 
1280  delete tsg;
1281}
1282
1283/*
1284 * Tol_TableSet implementation
1285 */
1286
1287/*
1288 *  Tol_TableSet
1289 *
1290 *     build the matrix data, header and create the ADT
1291 *     in case of success. CmdStatus tell us if the ADT
1292 *     was created.
1293 */
1294
1295Tol_TableSet::Tol_TableSet(Tcl_Interp * _interp, char * setname, BSet * set,
1296                           Tcl_Obj * obj_result)
1297  : Tol_Table(_interp, setname)
1298{
1299  cmd_status = Build(set, obj_result);
1300}
1301
1302/*
1303 *  Tol_TableSet::Build --
1304 *
1305 *    Build the data structure associated to a SetGroup
1306 */
1307
1308int Tol_TableSet::Build( BSet * set, Tcl_Obj * obj_result )
1309{
1310  int card, subcard, i, j, k;
1311  int LastColWithData;
1312  BSyntaxObject * subso, * elem;
1313  BSet * subset;
1314  BStruct * struct0, * struct1;
1315  BText so_name;
1316  int tcl_status;
1317 
1318  Tol_ColumnData * ptrCol;
1319  ToltclPool firstRow;
1320 
1321  card = set->Card();
1322  if ( !card ) {
1323    Tcl_AppendStringsToObj( obj_result,
1324                            "could not create a table from an empty set", NULL );
1325    return TCL_ERROR;
1326  }
1327 
1328  /* rows may be equal to:
1329   *
1330   *    card if headerType == generic || headerType == struct || card == 1
1331   *
1332   *    card - 1 if headerType = row
1333   */
1334 
1335
1336  rowsNames = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*) * card );
1337
1338  rows = 0;
1339 
1340  /* process first row */
1341 
1342  subso = (*set)[1];
1343  so_name = subso->Name();
1344  if ( !so_name.HasName() )
1345    so_name = subso->Description();
1346  Tcl_IncrRefCount(rowsNames[0] = NewExternalStringObj(so_name.Buffer()));
1347  struct0 = NULL;
1348  headerType = Generic;
1349  extraColumns = 0;
1350
1351  /* at least one column, i guess it will be Real */
1352 
1353  columns.AppendObject(ptrCol = new Tol_ColumnData( Tol_ColumnData::Real));
1354
1355  if ( subso->Grammar() == GraSet() ) {
1356    /* first element is a subset */
1357    BText * btxt;
1358 
1359    subset =  &(((BUserSet*)subso)->Contens());
1360    subcard = subset->Card();
1361    if ( subcard ) {
1362      struct0 = subset->Struct();
1363      /* loop for text labels */
1364      for ( i = 1; i <= subcard; i++ ) {
1365        elem = (*subset)[i];
1366        if ( elem->Grammar() != GraText() ||!elem->Info().Length() ) {
1367          /* No Text: invalid column name or empty text*/
1368          break;
1369        }
1370        /* at least we need this column */
1371        btxt = &(((BUserText*)elem)->Contens());
1372        if (i>1) {
1373          /* the first column was previously added
1374           * and ptrCol point to it */
1375          ptrCol = new Tol_ColumnData(Tol_ColumnData::Real);
1376          columns.AppendObject(ptrCol);
1377        }
1378        ptrCol->SetName(btxt->Buffer());       
1379      }
1380      if ( i > subcard ) {
1381        /* could be Row type */
1382        headerType = Row;
1383        /* but only at the end could be verified */
1384      }
1385    } else {
1386      /* first subset is empty, so add empty cell to the first column */
1387      tcl_status = (*Columns(0))->AppendEmpty();
1388      rows = 1;
1389#ifdef _DEBUG_TABLE_
1390      if ( tcl_status != TCL_OK ) {
1391        Tcl_AppendStringsToObj( obj_result,
1392                                "internal error", NULL );
1393        return TCL_ERROR;
1394      }
1395#endif
1396    }
1397  } else {
1398    /* first element is not a subset, add it as the first element of
1399     * the first column the header will be generic */
1400    (*Columns(0))->AppendSyntaxObject(interp, subso);
1401    rows = 1;
1402  }
1403 
1404  /* now going into the data, uff!!! */
1405
1406  for ( i = 2; i <= card; i++, rows++ ) {
1407    subso = (*set)[i];
1408    so_name = subso->Name();
1409
1410    /* set the name of this row */
1411    if ( !so_name.HasName() )
1412      so_name = subso->Description();
1413    Tcl_IncrRefCount(rowsNames[i-1] = NewExternalStringObj(so_name.Buffer()));
1414
1415    if ( subso->Grammar() == GraSet() ) {
1416      /* current element is a subset */
1417      subset =  &(((BUserSet*)subso)->Contens());
1418      subcard = subset->Card();
1419      if ( subcard ) {
1420        /* current subset has elements */
1421        struct1 = subset->Struct();
1422        if ( struct0 && struct1 != struct0 ) {
1423          /* found mismatched struct, so forget it */
1424          struct0 = NULL;
1425        }
1426        for ( j = 1; j <= subcard; j++ ) {
1427          elem = (*subset)[j];
1428          if ( j > columns.GetSize() ) {
1429            /* create a new column, always suppose it will be Real */
1430            ptrCol = new Tol_ColumnData( Tol_ColumnData::Real );
1431            columns.AppendObject( ptrCol );
1432            /* insert empty values at begining */
1433            for ( k = 0; k < rows ; k++ )
1434              ptrCol->AppendEmpty();
1435          } else
1436            ptrCol = *Columns(j-1);
1437          ptrCol->AppendSyntaxObject(interp, elem);
1438        }
1439        LastColWithData = subcard - 1;
1440      } else {
1441        /* current subset has no elements, so prepare for an empty row */
1442        LastColWithData = -1;
1443      }
1444    } else {
1445      /* current element is not a subset, add it to the first column */
1446      (*Columns(0))->AppendSyntaxObject(interp, subso);
1447      LastColWithData = 0;
1448    }
1449    /* add empty to the rest of columns */
1450    for ( j = LastColWithData + 1; j <  columns.GetSize(); j++ ) {
1451      (*Columns(j))->AppendEmpty();
1452    }
1453  }
1454 
1455  /* NOW DECIDE WICH ARE THE NAMES OF THE COLUMNS */
1456 
1457  char buffer[1024];
1458  int idx;
1459 
1460  if ( struct0 ) {
1461    /* names are taken from struct */
1462    BText btxt;
1463   
1464    subso = (*set)[1];
1465    subset =  &(((BUserSet*)subso)->Contens());
1466   
1467    /* here we can ensure that, only if rows > 0
1468     *
1469     *     subset->Card() == columns.GetSize() == struct0->Size()
1470     */
1471   
1472    /* this loop is only for the case rows == 0 */
1473
1474    for (i=columns.GetSize(); i<subset->Card(); i++) {
1475      /* create a new column, always suppose it will be Real */
1476      ptrCol = new Tol_ColumnData( Tol_ColumnData::Real );
1477      columns.AppendObject(ptrCol);
1478    }
1479     
1480    for ( i = 0; i < subset->Card(); i++ ) {
1481      btxt = (*struct0)[i].Name();
1482      (*Columns(i))->SetName(btxt.Buffer());
1483     
1484      /* Insert (prepend) at position 0 (in every column)
1485       * the corresponding element from firstRow
1486       */
1487     
1488      (*Columns(i))->PrependSyntaxObject( interp, (*subset)[i+1] );
1489    }
1490    /* so, the header type is Struct */
1491    headerType = Struct;
1492    /* and we have a one more row */
1493    ++rows;
1494  } else if (headerType == Row) {
1495
1496    /* set[1] is a subset an all its members are text
1497     * and was filled when headerType was determined
1498     */
1499
1500    subset =  &(((BUserSet*)(*set)[1])->Contens());
1501    subcard = subset->Card();
1502    if (!rows) {
1503      /* no data so insert the first row as data */
1504      headerType = Generic;
1505      rows = 1;
1506      for ( i = 0; i < subcard; i++ ) {
1507        subso = (*subset)[i+1];
1508        (*Columns(i))->AppendSyntaxObject(interp, subso);
1509      }
1510      /* this will force generic names for the columns */
1511      i = 0;
1512    } else
1513      i = subcard;
1514
1515    /* complete the extra names as columnXXX */
1516
1517    for ( ;i < columns.GetSize(); i++ ) {
1518      sprintf( buffer, "Column%d", i+1 );
1519      (*Columns(i))->SetName( buffer );
1520      ++extraColumns;
1521    }
1522  } else {
1523    /* we must provide generic names for the columns
1524     * and prepend the first row
1525     */
1526
1527    subso = (*set)[1];
1528    if ( subso->Grammar() == GraSet() ) {
1529      subset =  &(((BUserSet*)subso)->Contens());
1530      subcard = subset->Card();
1531      if ( subcard ) {
1532        /* and we'll have a one more row */
1533        ++rows;
1534      }
1535    } else {
1536      /* this cell was already added at the begining */
1537      subset = NULL;
1538      subcard = 1;
1539    }
1540    const char * ptrName;
1541    for ( i = 0; i < columns.GetSize(); i++ ) {
1542      idx = i+1;
1543      ptrCol = *Columns(i);
1544      if ( subset && subcard ) {
1545        if ( idx <= subcard ) {
1546          elem = (*subset)[idx];           
1547          ptrCol->PrependSyntaxObject( interp, elem );
1548          if (elem->Name().HasName())
1549            ptrName = elem->Name().String();
1550          else {
1551            sprintf( buffer, "Column%d", idx );
1552            ptrName = buffer;
1553          }
1554        } else {
1555          /* the first row is too short */
1556          ptrCol->PrependEmpty();
1557          sprintf( buffer, "Column%d", idx );
1558          ptrName = buffer;
1559        }
1560      } else {
1561        sprintf( buffer, "Column%d", idx );
1562        ptrName = buffer;
1563      }
1564      ptrCol->SetName(ptrName);     
1565    }
1566    /* we may grow the columns, here we have a valid subset */
1567   
1568    for ( ; i < subcard; i++ ) {
1569      idx = i+1;
1570      elem = (*subset)[idx];           
1571      columns.AppendObject(ptrCol = new Tol_ColumnData(Tol_ColumnData::Real));
1572      ptrCol->AppendSyntaxObject(interp,elem);
1573      if (elem->Name().HasName())
1574        ptrName = elem->Name().String();
1575      else {
1576        sprintf( buffer, "Column%d", idx );
1577        ptrName = buffer;
1578      }
1579      ptrCol->SetName( ptrName );
1580      /* we have to fill the rest of rows with empty */
1581      for ( j = 1;  j < rows; j++ )
1582        ptrCol->AppendEmpty();
1583    }
1584  }
1585 
1586  return TCL_OK;
1587}
1588
1589/*
1590 *  Tol_TableMatrix implementation.
1591 */
1592
1593/*
1594 *  Tol_TableMatrix
1595 *
1596 *     build the matrix data, header and create the ADT
1597 *     in case of success. CmdStatus tell us if the ADT
1598 *     was created.
1599 */
1600
1601Tol_TableMatrix::Tol_TableMatrix(Tcl_Interp * _interp, char * matname, BMatrix<double> *mat,
1602                                 Tcl_Obj * obj_result)
1603  : Tol_Table(_interp, matname)
1604{
1605  cmd_status = Build(mat, obj_result);
1606}
1607
1608/*
1609 *  Tol_TableMatrix::Build --
1610 *
1611 *    Build the actual ADT from a BMat object. Return success state.
1612 */
1613
1614int Tol_TableMatrix::Build(BMatrix<double> *mat, Tcl_Obj * obj_result)
1615{
1616  Tol_ColumnData * ptrCol;
1617  int colSize =  mat->Columns();
1618  char buffer[255];
1619
1620  rows = mat->Rows();
1621  rowsNames = (Tcl_Obj**)Tcl_Alloc(sizeof(Tcl_Obj*) * rows);
1622  extraColumns = 0;
1623  headerType = Generic;
1624  for (int col = 0; col < colSize; col++) {
1625    columns.AppendObject(ptrCol = new Tol_ColumnData( Tol_ColumnData::Real));
1626    sprintf(buffer, "column %d", col);
1627    ptrCol->SetName(buffer);
1628    for (int row = 0; row < rows; row++) {
1629      if (!col) {
1630        /* put the name to the row */
1631        sprintf(buffer, "row %d", row);
1632        Tcl_IncrRefCount(rowsNames[row]=Tcl_NewStringObj(buffer, -1));
1633      }
1634      BDat dat((*mat)(row,col));
1635      ptrCol->AppendBDat(interp, dat);
1636    }
1637  }
1638  return TCL_OK;
1639}
1640
1641/*
1642 *  Tol_CreateTable --
1643 *
1644 */
1645
1646int Tol_CreateTable(Tcl_Interp * interp,
1647                    Tcl_Obj *tblcmd, Tcl_Obj *objref,
1648                    int ismat, Tcl_Obj * obj_result)
1649{
1650  Tcl_CmdInfo cmd_info;
1651  char * tblname;
1652
1653  const BSyntaxObject * syn;
1654
1655  tblname = Tcl_GetString(tblcmd);
1656  if (!*tblname) {
1657    Tcl_AppendStringsToObj(obj_result,
1658                           "invalid table group name \"\"",NULL);
1659    return TCL_ERROR;
1660  }
1661
1662  /* verify if sgrp_name already exists as a table group */
1663
1664  if (Tcl_GetCommandInfo(interp, tblname, &cmd_info)) {
1665    if (cmd_info.objProc == Tol_Table::ObjCmd)
1666      Tcl_AppendStringsToObj(obj_result, "\"", tblname, "\"",
1667                             " already exists as a table object", NULL);
1668    else
1669      Tcl_AppendStringsToObj(obj_result, "\"", tblname, "\"",
1670                             " already exists as a command", NULL);
1671     
1672    return TCL_ERROR;
1673  }
1674
1675  // syn = Tol_GetObjFromReference( interp, GraSet(), setref, obj_result );
1676  if (!(syn=Tol_ResolveObject(interp, objref, obj_result))) {
1677    return TCL_ERROR;
1678  }
1679
1680  /* now is ok to create the obj cmd */
1681
1682  BText objname( syn->Name() );
1683  Tol_Table * ptrTable;
1684  if (ismat) {
1685    BMatrix<double> vmat;
1686    BMatrix<double> &theMat = vmat;
1687    if (syn->Grammar()==GraVMatrix()) {
1688      BVMat &V = VMat((BSyntaxObject *)syn);
1689      V.GetDMat(vmat);
1690    } else if (syn->Grammar()==GraMatrix()) {
1691      theMat = ((DMat&)Mat((BSyntaxObject *)syn));
1692    } else { 
1693      Tcl_AppendStringsToObj( obj_result, Tcl_GetString(objref),
1694                              " is not a valid Matrix|VMatrix object", NULL );   
1695      return TCL_ERROR;
1696    }
1697   
1698    ptrTable = new Tol_TableMatrix( interp, objname.Buffer(),
1699                                    &theMat, obj_result );
1700  } else if ( syn->Grammar()==GraSet() ) {
1701   
1702    BSet *ptrSet = &(Set((BSyntaxObject*)syn));
1703    ptrTable = new Tol_TableSet( interp, objname.Buffer(),
1704                                 ptrSet, obj_result );
1705  } else { 
1706    Tcl_AppendStringsToObj( obj_result, Tcl_GetString(objref),
1707                            " is not a valid Set object", NULL );   
1708    return TCL_ERROR;
1709  }
1710  if ( ptrTable->CmdStatus() != TCL_OK ) {
1711    delete ptrTable;
1712    return TCL_ERROR;
1713  }
1714  ptrTable->CreateCommand(tblname);
1715 
1716  return TCL_OK;
1717}
1718
1719/*
1720 * Destroy a list of table cmd.
1721 *
1722 */
1723
1724int Tol_DestroyTable(Tcl_Interp * interp,
1725                     int objc, Tcl_Obj *CONST objv[],
1726                     Tcl_Obj * obj_result)
1727{
1728  Tcl_CmdInfo cmd_info;
1729  char * tbl_name;
1730 
1731  for (int i=0; i<objc; ++i) {
1732    tbl_name = Tcl_GetString( objv[i] );
1733    if ( Tcl_GetCommandInfo( interp, tbl_name, &cmd_info ) &&
1734         (cmd_info.objProc == Tol_Table::ObjCmd) ) {
1735      if ( Tcl_DeleteCommand( interp, tbl_name ) ) {
1736        Tcl_AppendStringsToObj( obj_result,
1737                                "could not delete \"", tbl_name, "\"", NULL);
1738        return TCL_ERROR;
1739      }
1740    } else {
1741      Tcl_AppendStringsToObj( obj_result,
1742                              "can't find table \"", tbl_name, "\"", NULL );
1743      return TCL_ERROR;
1744    }
1745  }
1746  Tcl_ResetResult(interp);
1747  return TCL_OK;
1748}
Note: See TracBrowser for help on using the repository browser.