45 #define MAX( a, b ) ( ( ( a ) > ( b ) ) ? ( a ) : ( b ) )
48 #define MIN( a, b ) ( ( ( a ) < ( b ) ) ? ( a ) : ( b ) )
54 #define dbug_enter( a ) \
55 fprintf( stderr, "%s: Entered %s\n", __FILE__, a );
58 #define dbug_enter( a )
72 int dim,
int offs,
int nargs,
const char** args );
83 Tcl_Interp *
interp,
char *name1,
char *name2,
int flags );
93 MatrixPut_f( ClientData clientData, Tcl_Interp*
interp,
int index,
const char *
string );
96 MatrixGet_f( ClientData clientData, Tcl_Interp*
interp,
int index,
char *
string );
99 MatrixPut_i( ClientData clientData, Tcl_Interp*
interp,
int index,
const char *
string );
102 MatrixGet_i( ClientData clientData, Tcl_Interp*
interp,
int index,
char *
string );
125 int i, j, length,
new, index, persist = 0, initializer = 0;
134 Tcl_AppendResult( interp,
"wrong # args: should be \"", argv[0],
135 " ?-persist? var type dim1 ?dim2? ?dim3? ...\"", (
char *) NULL );
144 Tcl_InitHashTable( &
matTable, TCL_STRING_KEYS );
149 for ( i = 1; i <
argc; i++ )
152 length = (int) strlen( argv[i] );
156 if ( ( c ==
'-' ) && ( strncmp( argv[i],
"-persist", (
size_t) length ) == 0 ) )
160 for ( j = i; j <
argc; j++ )
161 argv[j] = argv[j + 1];
169 matPtr->
fdata = NULL;
170 matPtr->
idata = NULL;
183 if ( Tcl_GetCommandInfo( interp, argv[0], &infoPtr ) )
185 Tcl_AppendResult( interp,
"Matrix operator \"", argv[0],
186 "\" already in use", (
char *) NULL );
187 free( (
void *) matPtr );
191 if ( Tcl_GetVar( interp, argv[0], 0 ) != NULL )
193 Tcl_AppendResult( interp,
"Illegal name for Matrix operator \"",
194 argv[0],
"\": local variable of same name is active",
196 free( (
void *) matPtr );
200 matPtr->
name = (
char *) malloc( strlen( argv[0] ) + 1 );
201 strcpy( matPtr->
name, argv[0] );
207 length = (int) strlen( argv[0] );
209 if ( ( c ==
'f' ) && ( strncmp( argv[0],
"float", (
size_t) length ) == 0 ) )
215 else if ( ( c ==
'i' ) && ( strncmp( argv[0],
"int", (
size_t) length ) == 0 ) )
223 Tcl_AppendResult( interp,
"Matrix type \"", argv[0],
224 "\" not supported, should be \"float\" or \"int\"",
234 for (; argc > 0; argc--, argv++ )
238 if ( strcmp( argv[0],
"=" ) == 0 )
248 if ( matPtr->
dim > MAX_ARRAY_DIM )
250 Tcl_AppendResult( interp,
251 "too many dimensions specified for Matrix operator \"",
252 matPtr->
name,
"\"", (
char *) NULL );
260 index = matPtr->
dim - 1;
261 matPtr->
n[index] = atoi( argv[0] );
262 if ( matPtr->
n[index] < 1 )
264 Tcl_AppendResult( interp,
"invalid matrix dimension \"", argv[0],
265 "\" for Matrix operator \"", matPtr->
name,
"\"",
271 matPtr->
len *= matPtr->
n[index];
274 if ( matPtr->
dim < 1 )
276 Tcl_AppendResult( interp,
277 "insufficient dimensions given for Matrix operator \"",
278 matPtr->
name,
"\"", (
char *) NULL );
285 switch ( matPtr->
type )
289 for ( i = 0; i < matPtr->
len; i++ )
290 matPtr->
fdata[i] = 0.0;
295 for ( i = 0; i < matPtr->
len; i++ )
296 matPtr->
idata[i] = 0;
310 if ( Tcl_SetVar( interp, matPtr->
name,
311 "old_bogus_syntax_please_upgrade", 0 ) == NULL )
313 Tcl_AppendResult( interp,
"unable to schedule Matrix operator \"",
314 matPtr->
name,
"\" for automatic deletion", (
char *) NULL );
319 Tcl_TraceVar( interp, matPtr->
name, TCL_TRACE_UNSETS,
326 fprintf( stderr,
"Creating Matrix operator of name %s\n", matPtr->
name );
328 Tcl_CreateCommand( interp, matPtr->
name, (Tcl_CmdProc *)
MatrixCmd,
339 hPtr = Tcl_CreateHashEntry( &
matTable, matPtr->name, &
new );
342 Tcl_AppendResult( interp,
343 "Unable to create hash table entry for Matrix operator \"",
344 matPtr->name,
"\"", (
char *) NULL );
347 Tcl_SetHashValue( hPtr, matPtr );
349 Tcl_SetResult( interp, matPtr->name, TCL_VOLATILE );
379 hPtr = Tcl_FindHashEntry( &
matTable, matName );
382 Tcl_AppendResult( interp,
"No matrix operator named \"",
383 matName,
"\"", (
char *) NULL );
386 return (
tclMatrix *) Tcl_GetHashValue( hPtr );
424 fprintf( stderr,
"Installing a tclMatrix extension -> %s\n", cmd );
427 new->cmd = malloc( strlen( cmd ) + 1 );
428 strcpy( new->cmd, cmd );
439 tail = tail->
next =
new;
460 int dim,
int offs,
int nargs,
const char** args )
462 static int verbose = 0;
470 fprintf( stderr,
"level %d offset %d args %d\n", dim, offs, nargs );
474 for ( i = 0; i < nargs; i++ )
476 if ( Tcl_SplitList( interp, args[i], &numnewargs, (CONST
char ***) &newargs )
479 Tcl_AppendResult( interp,
"bad matrix initializer list form: ",
480 args[i], (
char *) NULL );
484 newoffs = offs * m->
n[dim - 1] + i;
488 matrixInitialize( interp, m, dim + 1, newoffs, numnewargs, (
const char **) newargs );
490 Tcl_Free( (
char *) newargs );
495 for ( i = 0; i < nargs; i++ )
497 newoffs = offs * m->
n[dim - 1] + i;
498 ( m->
put )( (ClientData) m,
interp, newoffs, args[i] );
500 fprintf( stderr,
"\ta[%d] = %s\n", newoffs, args[i] );
528 const char *
name = argv[0];
536 Tcl_AppendResult( interp,
"wrong # args, type: \"",
537 argv[0],
" help\" for more info", (
char *) NULL );
544 nmax[i] = matPtr->
n[i] - 1;
551 length = (int) strlen( argv[0] );
556 if ( ( c ==
'd' ) && ( strncmp( argv[0],
"dump", (
size_t) length ) == 0 ) )
558 for ( i = nmin[0]; i <= nmax[0]; i++ )
560 for ( j = nmin[1]; j <= nmax[1]; j++ )
562 for ( k = nmin[2]; k <= nmax[2]; k++ )
564 ( *matPtr->
get )( (ClientData) matPtr,
interp,
I3D( i, j, k ), tmp );
565 printf(
"%s ", tmp );
567 if ( matPtr->
dim > 2 )
570 if ( matPtr->
dim > 1 )
579 else if ( ( c ==
'd' ) && ( strncmp( argv[0],
"delete", (
size_t) length ) == 0 ) )
582 fprintf( stderr,
"Deleting array %s\n", name );
584 Tcl_DeleteCommand( interp, name );
591 else if ( ( c ==
'f' ) && ( strncmp( argv[0],
"filter", (
size_t) length ) == 0 ) )
598 Tcl_AppendResult( interp,
"wrong # args: should be \"",
599 name,
" ", argv[0],
" num-passes\"",
606 Tcl_AppendResult( interp,
"can only filter a 1d float matrix",
611 nfilt = atoi( argv[1] );
614 for ( ifilt = 0; ifilt < nfilt; ifilt++ )
618 j = 0; tmpMat[j] = matPtr->
fdata[0];
619 for ( i = 0; i < matPtr->
len; i++ )
621 j++; tmpMat[j] = matPtr->
fdata[i];
623 j++; tmpMat[j] = matPtr->
fdata[matPtr->
len - 1];
627 for ( i = 0; i < matPtr->
len; i++ )
630 matPtr->
fdata[i] = 0.25 * ( tmpMat[j - 1] + 2 * tmpMat[j] + tmpMat[j + 1] );
634 free( (
void *) tmpMat );
640 else if ( ( c ==
'h' ) && ( strncmp( argv[0],
"help", (
size_t) length ) == 0 ) )
642 Tcl_AppendResult( interp,
643 "Available subcommands:\n\
644 dump - return the values in the matrix as a string\n\
645 delete - delete the matrix (including the matrix command)\n\
646 filter - apply a three-point averaging (with a number of passes; ome-dimensional only)\n\
647 help - this information\n\
648 info - return the dimensions\n\
649 max - return the maximum value for the entire matrix or for the first N entries\n\
650 min - return the minimum value for the entire matrix or for the first N entries\n\
651 redim - resize the matrix (for one-dimensional matrices only)\n\
652 scale - scale the values by a given factor (for one-dimensional matrices only)\n\
654 Set and get values:\n\
655 matrix m f 3 3 3 - define matrix command \"m\", three-dimensional, floating-point data\n\
656 m 1 2 3 - return the value of matrix element [1,2,3]\n\
657 m 1 2 3 = 2.0 - set the value of matrix element [1,2,3] to 2.0 (do not return the value)\n\
658 m * 2 3 = 2.0 - set a slice consisting of all elements with second index 2 and third index 3 to 2.0",
665 else if ( ( c ==
'i' ) && ( strncmp( argv[0],
"info", (
size_t) length ) == 0 ) )
667 for ( i = 0; i < matPtr->
dim; i++ )
669 sprintf( tmp,
"%d", matPtr->
n[i] );
671 if ( i < matPtr->dim - 1 )
672 Tcl_AppendResult( interp, tmp,
" ", (
char *) NULL );
674 Tcl_AppendResult( interp, tmp, (
char *) NULL );
681 else if ( ( c ==
'm' ) && ( strncmp( argv[0],
"max", (
size_t) length ) == 0 ) )
684 if ( argc < 1 || argc > 2 )
686 Tcl_AppendResult( interp,
"wrong # args: should be \"",
687 name,
" ", argv[0],
" ?length?\"",
693 len = atoi( argv[1] );
697 switch ( matPtr->
type )
701 for ( i = 1; i < len; i++ )
704 Tcl_PrintDouble( interp, max, tmp );
705 Tcl_AppendResult( interp, tmp, (
char *) NULL );
710 for ( i = 1; i < len; i++ )
712 sprintf( tmp,
"%d", max );
713 Tcl_AppendResult( interp, tmp, (
char *) NULL );
722 else if ( ( c ==
'm' ) && ( strncmp( argv[0],
"min", (
size_t) length ) == 0 ) )
725 if ( argc < 1 || argc > 2 )
727 Tcl_AppendResult( interp,
"wrong # args: should be \"",
728 name,
" ", argv[0],
" ?length?\"",
734 len = atoi( argv[1] );
738 switch ( matPtr->
type )
742 for ( i = 1; i < len; i++ )
745 Tcl_PrintDouble( interp, min, tmp );
746 Tcl_AppendResult( interp, tmp, (
char *) NULL );
751 for ( i = 1; i < len; i++ )
753 sprintf( tmp,
"%d", min );
754 Tcl_AppendResult( interp, tmp, (
char *) NULL );
764 else if ( ( c ==
'r' ) && ( strncmp( argv[0],
"redim", (
size_t) length ) == 0 ) )
771 Tcl_AppendResult( interp,
"wrong # args: should be \"",
772 name,
" ", argv[0],
" length\"",
777 if ( matPtr->
dim != 1 )
779 Tcl_AppendResult( interp,
"can only redim a 1d matrix",
784 newlen = atoi( argv[1] );
785 switch ( matPtr->
type )
788 data = realloc( matPtr->
fdata, (
size_t) newlen * sizeof (
Mat_float ) );
791 Tcl_AppendResult( interp,
"redim failed!",
796 for ( i = matPtr->
len; i < newlen; i++ )
797 matPtr->
fdata[i] = 0.0;
801 data = realloc( matPtr->
idata, (
size_t) newlen * sizeof (
Mat_int ) );
804 Tcl_AppendResult( interp,
"redim failed!",
809 for ( i = matPtr->
len; i < newlen; i++ )
810 matPtr->
idata[i] = 0;
813 matPtr->
n[0] = matPtr->
len = newlen;
820 else if ( ( c ==
's' ) && ( strncmp( argv[0],
"scale", (
size_t) length ) == 0 ) )
826 Tcl_AppendResult( interp,
"wrong # args: should be \"",
827 name,
" ", argv[0],
" scale-factor\"",
832 if ( matPtr->
dim != 1 )
834 Tcl_AppendResult( interp,
"can only scale a 1d matrix",
839 scale = atof( argv[1] );
840 switch ( matPtr->
type )
843 for ( i = 0; i < matPtr->
len; i++ )
844 matPtr->
fdata[i] *= scale;
848 for ( i = 0; i < matPtr->
len; i++ )
859 for (; p; p = p->
next )
861 if ( ( c == p->
cmd[0] ) && ( strncmp( argv[0], p->
cmd, (
size_t) length ) == 0 ) )
864 printf(
"found a match, invoking %s\n", p->
cmd );
873 if ( argc < matPtr->dim )
875 Tcl_AppendResult( interp,
"not enough dimensions specified for \"",
876 name, (
char *) NULL );
879 for ( i = 0; i < matPtr->
dim; i++ )
881 if ( strcmp( argv[0],
"*" ) == 0 )
884 nmax[i] = matPtr->
n[i] - 1;
888 nmin[i] = atoi( argv[0] );
891 if ( nmin[i] < 0 || nmax[i] > matPtr->
n[i] - 1 )
893 sprintf( tmp,
"Array index %d out of bounds: %s; max: %d\n",
894 i, argv[0], matPtr->
n[i] - 1 );
895 Tcl_AppendResult( interp, tmp, (
char *) NULL );
906 if ( strcmp( argv[0],
"=" ) == 0 )
911 Tcl_AppendResult( interp,
"no value specified",
917 Tcl_AppendResult( interp,
"extra characters after value: \"",
918 argv[1],
"\"", (
char *) NULL );
924 Tcl_AppendResult( interp,
"extra characters after indices: \"",
925 argv[0],
"\"", (
char *) NULL );
933 for ( i = nmin[0]; i <= nmax[0]; i++ )
935 for ( j = nmin[1]; j <= nmax[1]; j++ )
937 for ( k = nmin[2]; k <= nmax[2]; k++ )
940 ( *matPtr->
put )( (ClientData) matPtr,
interp,
I3D( i, j, k ), argv[0] );
943 ( *matPtr->
get )( (ClientData) matPtr,
interp,
I3D( i, j, k ), tmp );
944 if ( i == nmax[0] && j == nmax[1] && k == nmax[2] )
945 Tcl_AppendResult( interp, tmp, (
char *) NULL );
947 Tcl_AppendResult( interp, tmp,
" ", (
char *) NULL );
976 matPtr->
fdata[index] = atof(
string );
986 Tcl_PrintDouble( interp, value,
string );
994 if ( ( strlen(
string ) > 2 ) && ( strncmp(
string,
"0x", 2 ) == 0 ) )
996 matPtr->
idata[index] = (
Mat_int) strtoul( &
string[2], NULL, 16 );
999 matPtr->
idata[index] = atoi(
string );
1007 sprintf(
string,
"%d", matPtr->
idata[index] );
1030 Tcl_CmdInfo infoPtr;
1038 name = (
char *) malloc( strlen( matPtr->
name ) + 1 );
1039 strcpy( name, matPtr->
name );
1042 if ( Tcl_GetCommandInfo( matPtr->
interp, matPtr->
name, &infoPtr ) )
1044 if ( Tcl_DeleteCommand( matPtr->
interp, matPtr->
name ) == TCL_OK )
1045 fprintf( stderr,
"Deleted command %s\n", name );
1047 fprintf( stderr,
"Unable to delete command %s\n", name );
1050 if ( Tcl_GetCommandInfo( matPtr->
interp, matPtr->
name, &infoPtr ) )
1051 Tcl_DeleteCommand( matPtr->
interp, matPtr->
name );
1053 free( (
void *) name );
1055 return (
char *) NULL;
1084 Tcl_HashEntry *hPtr;
1089 fprintf( stderr,
"Freeing space associated with matrix %s\n", matPtr->
name );
1096 Tcl_DeleteHashEntry( hPtr );
1100 if ( matPtr->
fdata != NULL )
1102 free( (
void *) matPtr->
fdata );
1103 matPtr->
fdata = NULL;
1105 if ( matPtr->
idata != NULL )
1107 free( (
void *) matPtr->
idata );
1108 matPtr->
idata = NULL;
1115 if ( Tcl_VarTraceInfo( matPtr->
interp, matPtr->
name, TCL_TRACE_UNSETS,
1119 Tcl_UntraceVar( matPtr->
interp, matPtr->
name, TCL_TRACE_UNSETS,
1121 Tcl_UnsetVar( matPtr->interp, matPtr->name, 0 );
1127 if ( matPtr->
name != NULL )
1129 free( (
void *) matPtr->
name );
1130 matPtr->
name = NULL;
1136 free( (
void *) matPtr );
1139 fprintf( stderr,
"OOPS! You just lost %d bytes\n",
sizeof (
tclMatrix ) );