47 #define MAX( a, b ) ( ( ( a ) > ( b ) ) ? ( a ) : ( b ) )
50 #define MIN( a, b ) ( ( ( a ) < ( b ) ) ? ( a ) : ( b ) )
56 #define dbug_enter( a ) \
57 fprintf( stderr, "%s: Entered %s\n", __FILE__, a );
60 #define dbug_enter( a )
74 int dim,
int offs,
int nargs,
const char** args );
85 Tcl_Interp *
interp,
char *name1,
char *name2,
int flags );
95 MatrixPut_f( ClientData clientData, Tcl_Interp*
interp,
int index,
const char *
string );
98 MatrixGet_f( ClientData clientData, Tcl_Interp*
interp,
int index,
char *
string );
101 MatrixPut_i( ClientData clientData, Tcl_Interp*
interp,
int index,
const char *
string );
104 MatrixGet_i( ClientData clientData, Tcl_Interp*
interp,
int index,
char *
string );
127 int i, j, length,
new, index, persist = 0, initializer = 0;
136 Tcl_AppendResult( interp,
"wrong # args: should be \"", argv[0],
137 " ?-persist? var type dim1 ?dim2? ?dim3? ...\"", (
char *) NULL );
146 Tcl_InitHashTable( &
matTable, TCL_STRING_KEYS );
151 for ( i = 1; i <
argc; i++ )
154 length = (int) strlen( argv[i] );
158 if ( ( c ==
'-' ) && ( strncmp( argv[i],
"-persist", (
size_t) length ) == 0 ) )
162 for ( j = i; j <
argc; j++ )
163 argv[j] = argv[j + 1];
171 matPtr->
fdata = NULL;
172 matPtr->
idata = NULL;
185 if ( Tcl_GetCommandInfo( interp, argv[0], &infoPtr ) )
187 Tcl_AppendResult( interp,
"Matrix operator \"", argv[0],
188 "\" already in use", (
char *) NULL );
189 free( (
void *) matPtr );
193 if ( Tcl_GetVar( interp, argv[0], 0 ) != NULL )
195 Tcl_AppendResult( interp,
"Illegal name for Matrix operator \"",
196 argv[0],
"\": local variable of same name is active",
198 free( (
void *) matPtr );
202 matPtr->
name = (
char *) malloc( strlen( argv[0] ) + 1 );
203 strcpy( matPtr->
name, argv[0] );
209 length = (int) strlen( argv[0] );
211 if ( ( c ==
'f' ) && ( strncmp( argv[0],
"float", (
size_t) length ) == 0 ) )
217 else if ( ( c ==
'i' ) && ( strncmp( argv[0],
"int", (
size_t) length ) == 0 ) )
225 Tcl_AppendResult( interp,
"Matrix type \"", argv[0],
226 "\" not supported, should be \"float\" or \"int\"",
236 for (; argc > 0; argc--, argv++ )
240 if ( strcmp( argv[0],
"=" ) == 0 )
250 if ( matPtr->
dim > MAX_ARRAY_DIM )
252 Tcl_AppendResult( interp,
253 "too many dimensions specified for Matrix operator \"",
254 matPtr->
name,
"\"", (
char *) NULL );
262 index = matPtr->
dim - 1;
263 matPtr->
n[index] = atoi( argv[0] );
264 if ( matPtr->
n[index] < 1 )
266 Tcl_AppendResult( interp,
"invalid matrix dimension \"", argv[0],
267 "\" for Matrix operator \"", matPtr->
name,
"\"",
273 matPtr->
len *= matPtr->
n[index];
276 if ( matPtr->
dim < 1 )
278 Tcl_AppendResult( interp,
279 "insufficient dimensions given for Matrix operator \"",
280 matPtr->
name,
"\"", (
char *) NULL );
287 switch ( matPtr->
type )
291 for ( i = 0; i < matPtr->
len; i++ )
292 matPtr->
fdata[i] = 0.0;
297 for ( i = 0; i < matPtr->
len; i++ )
298 matPtr->
idata[i] = 0;
312 if ( Tcl_SetVar( interp, matPtr->
name,
313 "old_bogus_syntax_please_upgrade", 0 ) == NULL )
315 Tcl_AppendResult( interp,
"unable to schedule Matrix operator \"",
316 matPtr->
name,
"\" for automatic deletion", (
char *) NULL );
321 Tcl_TraceVar( interp, matPtr->
name, TCL_TRACE_UNSETS,
328 fprintf( stderr,
"Creating Matrix operator of name %s\n", matPtr->
name );
330 Tcl_CreateCommand( interp, matPtr->
name, (Tcl_CmdProc *)
MatrixCmd,
341 hPtr = Tcl_CreateHashEntry( &
matTable, matPtr->name, &
new );
344 Tcl_AppendResult( interp,
345 "Unable to create hash table entry for Matrix operator \"",
346 matPtr->name,
"\"", (
char *) NULL );
349 Tcl_SetHashValue( hPtr, matPtr );
351 Tcl_SetResult( interp, matPtr->name, TCL_VOLATILE );
381 hPtr = Tcl_FindHashEntry( &
matTable, matName );
384 Tcl_AppendResult( interp,
"No matrix operator named \"",
385 matName,
"\"", (
char *) NULL );
388 return (
tclMatrix *) Tcl_GetHashValue( hPtr );
426 fprintf( stderr,
"Installing a tclMatrix extension -> %s\n", cmd );
429 new->cmd = malloc( strlen( cmd ) + 1 );
430 strcpy( new->cmd, cmd );
441 tail = tail->
next =
new;
462 int dim,
int offs,
int nargs,
const char** args )
464 static int verbose = 0;
472 fprintf( stderr,
"level %d offset %d args %d\n", dim, offs, nargs );
476 for ( i = 0; i < nargs; i++ )
478 if ( Tcl_SplitList( interp, args[i], &numnewargs, (CONST
char ***) &newargs )
481 Tcl_AppendResult( interp,
"bad matrix initializer list form: ",
482 args[i], (
char *) NULL );
486 newoffs = offs * m->
n[dim - 1] + i;
490 matrixInitialize( interp, m, dim + 1, newoffs, numnewargs, (
const char **) newargs );
492 Tcl_Free( (
char *) newargs );
497 for ( i = 0; i < nargs; i++ )
499 newoffs = offs * m->
n[dim - 1] + i;
500 ( m->
put )( (ClientData) m,
interp, newoffs, args[i] );
502 fprintf( stderr,
"\ta[%d] = %s\n", newoffs, args[i] );
530 const char *
name = argv[0];
538 Tcl_AppendResult( interp,
"wrong # args, type: \"",
539 argv[0],
" help\" for more info", (
char *) NULL );
546 nmax[i] = matPtr->
n[i] - 1;
553 length = (int) strlen( argv[0] );
558 if ( ( c ==
'd' ) && ( strncmp( argv[0],
"dump", (
size_t) length ) == 0 ) )
560 for ( i = nmin[0]; i <= nmax[0]; i++ )
562 for ( j = nmin[1]; j <= nmax[1]; j++ )
564 for ( k = nmin[2]; k <= nmax[2]; k++ )
566 ( *matPtr->
get )( (ClientData) matPtr,
interp,
I3D( i, j, k ), tmp );
567 printf(
"%s ", tmp );
569 if ( matPtr->
dim > 2 )
572 if ( matPtr->
dim > 1 )
581 else if ( ( c ==
'd' ) && ( strncmp( argv[0],
"delete", (
size_t) length ) == 0 ) )
584 fprintf( stderr,
"Deleting array %s\n", name );
586 Tcl_DeleteCommand( interp, name );
593 else if ( ( c ==
'f' ) && ( strncmp( argv[0],
"filter", (
size_t) length ) == 0 ) )
600 Tcl_AppendResult( interp,
"wrong # args: should be \"",
601 name,
" ", argv[0],
" num-passes\"",
608 Tcl_AppendResult( interp,
"can only filter a 1d float matrix",
613 nfilt = atoi( argv[1] );
616 for ( ifilt = 0; ifilt < nfilt; ifilt++ )
620 j = 0; tmpMat[j] = matPtr->
fdata[0];
621 for ( i = 0; i < matPtr->
len; i++ )
623 j++; tmpMat[j] = matPtr->
fdata[i];
625 j++; tmpMat[j] = matPtr->
fdata[matPtr->
len - 1];
629 for ( i = 0; i < matPtr->
len; i++ )
632 matPtr->
fdata[i] = 0.25 * ( tmpMat[j - 1] + 2 * tmpMat[j] + tmpMat[j + 1] );
636 free( (
void *) tmpMat );
642 else if ( ( c ==
'h' ) && ( strncmp( argv[0],
"help", (
size_t) length ) == 0 ) )
644 Tcl_AppendResult( interp,
645 "Available subcommands:\n\
646 dump - return the values in the matrix as a string\n\
647 delete - delete the matrix (including the matrix command)\n\
648 filter - apply a three-point averaging (with a number of passes; ome-dimensional only)\n\
649 help - this information\n\
650 info - return the dimensions\n\
651 max - return the maximum value for the entire matrix or for the first N entries\n\
652 min - return the minimum value for the entire matrix or for the first N entries\n\
653 redim - resize the matrix (for one-dimensional matrices only)\n\
654 scale - scale the values by a given factor (for one-dimensional matrices only)\n\
656 Set and get values:\n\
657 matrix m f 3 3 3 - define matrix command \"m\", three-dimensional, floating-point data\n\
658 m 1 2 3 - return the value of matrix element [1,2,3]\n\
659 m 1 2 3 = 2.0 - set the value of matrix element [1,2,3] to 2.0 (do not return the value)\n\
660 m * 2 3 = 2.0 - set a slice consisting of all elements with second index 2 and third index 3 to 2.0",
667 else if ( ( c ==
'i' ) && ( strncmp( argv[0],
"info", (
size_t) length ) == 0 ) )
669 for ( i = 0; i < matPtr->
dim; i++ )
671 sprintf( tmp,
"%d", matPtr->
n[i] );
673 if ( i < matPtr->dim - 1 )
674 Tcl_AppendResult( interp, tmp,
" ", (
char *) NULL );
676 Tcl_AppendResult( interp, tmp, (
char *) NULL );
683 else if ( ( c ==
'm' ) && ( strncmp( argv[0],
"max", (
size_t) length ) == 0 ) )
686 if ( argc < 1 || argc > 2 )
688 Tcl_AppendResult( interp,
"wrong # args: should be \"",
689 name,
" ", argv[0],
" ?length?\"",
695 len = atoi( argv[1] );
699 switch ( matPtr->
type )
703 for ( i = 1; i < len; i++ )
706 Tcl_PrintDouble( interp, max, tmp );
707 Tcl_AppendResult( interp, tmp, (
char *) NULL );
712 for ( i = 1; i < len; i++ )
714 sprintf( tmp,
"%d", max );
715 Tcl_AppendResult( interp, tmp, (
char *) NULL );
724 else if ( ( c ==
'm' ) && ( strncmp( argv[0],
"min", (
size_t) length ) == 0 ) )
727 if ( argc < 1 || argc > 2 )
729 Tcl_AppendResult( interp,
"wrong # args: should be \"",
730 name,
" ", argv[0],
" ?length?\"",
736 len = atoi( argv[1] );
740 switch ( matPtr->
type )
744 for ( i = 1; i < len; i++ )
747 Tcl_PrintDouble( interp, min, tmp );
748 Tcl_AppendResult( interp, tmp, (
char *) NULL );
753 for ( i = 1; i < len; i++ )
755 sprintf( tmp,
"%d", min );
756 Tcl_AppendResult( interp, tmp, (
char *) NULL );
766 else if ( ( c ==
'r' ) && ( strncmp( argv[0],
"redim", (
size_t) length ) == 0 ) )
773 Tcl_AppendResult( interp,
"wrong # args: should be \"",
774 name,
" ", argv[0],
" length\"",
779 if ( matPtr->
dim != 1 )
781 Tcl_AppendResult( interp,
"can only redim a 1d matrix",
786 newlen = atoi( argv[1] );
787 switch ( matPtr->
type )
790 data = realloc( matPtr->
fdata, (
size_t) newlen * sizeof (
Mat_float ) );
793 Tcl_AppendResult( interp,
"redim failed!",
798 for ( i = matPtr->
len; i < newlen; i++ )
799 matPtr->
fdata[i] = 0.0;
803 data = realloc( matPtr->
idata, (
size_t) newlen * sizeof (
Mat_int ) );
806 Tcl_AppendResult( interp,
"redim failed!",
811 for ( i = matPtr->
len; i < newlen; i++ )
812 matPtr->
idata[i] = 0;
815 matPtr->
n[0] = matPtr->
len = newlen;
822 else if ( ( c ==
's' ) && ( strncmp( argv[0],
"scale", (
size_t) length ) == 0 ) )
828 Tcl_AppendResult( interp,
"wrong # args: should be \"",
829 name,
" ", argv[0],
" scale-factor\"",
834 if ( matPtr->
dim != 1 )
836 Tcl_AppendResult( interp,
"can only scale a 1d matrix",
841 scale = atof( argv[1] );
842 switch ( matPtr->
type )
845 for ( i = 0; i < matPtr->
len; i++ )
846 matPtr->
fdata[i] *= scale;
850 for ( i = 0; i < matPtr->
len; i++ )
861 for (; p; p = p->
next )
863 if ( ( c == p->
cmd[0] ) && ( strncmp( argv[0], p->
cmd, (
size_t) length ) == 0 ) )
866 printf(
"found a match, invoking %s\n", p->
cmd );
875 if ( argc < matPtr->dim )
877 Tcl_AppendResult( interp,
"not enough dimensions specified for \"",
878 name, (
char *) NULL );
881 for ( i = 0; i < matPtr->
dim; i++ )
883 if ( strcmp( argv[0],
"*" ) == 0 )
886 nmax[i] = matPtr->
n[i] - 1;
890 nmin[i] = atoi( argv[0] );
893 if ( nmin[i] < 0 || nmax[i] > matPtr->
n[i] - 1 )
895 sprintf( tmp,
"Array index %d out of bounds: %s; max: %d\n",
896 i, argv[0], matPtr->
n[i] - 1 );
897 Tcl_AppendResult( interp, tmp, (
char *) NULL );
908 if ( strcmp( argv[0],
"=" ) == 0 )
913 Tcl_AppendResult( interp,
"no value specified",
919 Tcl_AppendResult( interp,
"extra characters after value: \"",
920 argv[1],
"\"", (
char *) NULL );
926 Tcl_AppendResult( interp,
"extra characters after indices: \"",
927 argv[0],
"\"", (
char *) NULL );
935 for ( i = nmin[0]; i <= nmax[0]; i++ )
937 for ( j = nmin[1]; j <= nmax[1]; j++ )
939 for ( k = nmin[2]; k <= nmax[2]; k++ )
942 ( *matPtr->
put )( (ClientData) matPtr,
interp,
I3D( i, j, k ), argv[0] );
945 ( *matPtr->
get )( (ClientData) matPtr,
interp,
I3D( i, j, k ), tmp );
946 if ( i == nmax[0] && j == nmax[1] && k == nmax[2] )
947 Tcl_AppendResult( interp, tmp, (
char *) NULL );
949 Tcl_AppendResult( interp, tmp,
" ", (
char *) NULL );
978 matPtr->
fdata[index] = atof(
string );
988 Tcl_PrintDouble( interp, value,
string );
996 if ( ( strlen(
string ) > 2 ) && ( strncmp(
string,
"0x", 2 ) == 0 ) )
998 matPtr->
idata[index] = (
Mat_int) strtoul( &
string[2], NULL, 16 );
1001 matPtr->
idata[index] = atoi(
string );
1009 sprintf(
string,
"%d", matPtr->
idata[index] );
1032 Tcl_CmdInfo infoPtr;
1040 name = (
char *) malloc( strlen( matPtr->
name ) + 1 );
1041 strcpy( name, matPtr->
name );
1044 if ( Tcl_GetCommandInfo( matPtr->
interp, matPtr->
name, &infoPtr ) )
1046 if ( Tcl_DeleteCommand( matPtr->
interp, matPtr->
name ) == TCL_OK )
1047 fprintf( stderr,
"Deleted command %s\n", name );
1049 fprintf( stderr,
"Unable to delete command %s\n", name );
1052 if ( Tcl_GetCommandInfo( matPtr->
interp, matPtr->
name, &infoPtr ) )
1053 Tcl_DeleteCommand( matPtr->
interp, matPtr->
name );
1055 free( (
void *) name );
1057 return (
char *) NULL;
1086 Tcl_HashEntry *hPtr;
1091 fprintf( stderr,
"Freeing space associated with matrix %s\n", matPtr->
name );
1098 Tcl_DeleteHashEntry( hPtr );
1102 if ( matPtr->
fdata != NULL )
1104 free( (
void *) matPtr->
fdata );
1105 matPtr->
fdata = NULL;
1107 if ( matPtr->
idata != NULL )
1109 free( (
void *) matPtr->
idata );
1110 matPtr->
idata = NULL;
1117 if ( Tcl_VarTraceInfo( matPtr->
interp, matPtr->
name, TCL_TRACE_UNSETS,
1121 Tcl_UntraceVar( matPtr->
interp, matPtr->
name, TCL_TRACE_UNSETS,
1123 Tcl_UnsetVar( matPtr->interp, matPtr->name, 0 );
1129 if ( matPtr->
name != NULL )
1131 free( (
void *) matPtr->
name );
1132 matPtr->
name = NULL;
1138 free( (
void *) matPtr );
1141 fprintf( stderr,
"OOPS! You just lost %d bytes\n",
sizeof (
tclMatrix ) );