~ubuntu-branches/debian/stretch/tcl-fitstcl/stretch
» Revision
8
: .pc/fix_spelling.patch/fitsCmds.c
« back to all changes in this revision
Viewing changes to .pc/fix_spelling.patch/fitsCmds.c
- browse files at revision 8
- compare with another revision
- download diff
- download tarball
- view history from revision 8
- Committer: Package Import Robot
- Author(s): Ole Streicher
- Date: 2015-06-10 17:35:43 UTC
- mfrom: (1.1.1)
- Revision ID: package-import@ubuntu.com-20150610173543-37jifpt0bjuocrr0
Tags: 2.4-1
New upstream version
- files removed:
- .pc/fix_fitsCmds.patch
- .pc/fix_spelling.patch
- files modified:
- .pc/applied-patches
added
removed
.pc/fix_spelling.patch/fitsCmds.c
1
/*
2
* fitsCmds.c --
3
*
4
* This holds the handlers for all of the fitsObj commands
5
*
6
*/
7
8
/*
9
* ------------------------------------------------------------
10
* MODIFICATION HISTORY:
11
* 2004-02-05 Ziqin Pan:
12
* Add the following commands:
13
* 1. delete row -rowrange rangelist
14
* 2. add column colName colForm ?expr? ?rowrange?
15
* 3. select rows -expr expression firstrow nrow
16
*
17
*
18
*/
19
20
#include "fitsTclInt.h"
21
22
#define ARGV_STR(x) Tcl_GetStringFromObj(argv[x],NULL)
23
24
/*
25
* ------------------------------------------------------------
26
*
27
* fitsDispatch --
28
*
29
* This is the dispatch routine for the Fits objects
30
*
31
* Results:
32
* Depends on argv[1].
33
*
34
* Side Effects:
35
* Depends on argv[1].
36
*
37
* ------------------------------------------------------------
38
*
39
*/
40
int fitsDispatch( ClientData clientData,
41
Tcl_Interp *interp,
42
int argc,
43
Tcl_Obj *const argv[] )
44
{
45
46
static char *commandList =
47
"Available commands:\n"
48
"close - close the file and delete this object\n"
49
"move ?+/-?n - move to HDU #n or forward/backward +/-n HDUs\n"
50
"dump ?-s/-e/-l? - return contents of the CHDU's header in various formats\n"
51
"info - get information about the CHDU \n"
52
"get - get various data from CHDU\n"
53
"put - change contents of CHDU: keywords or extension data\n"
54
"insert- insert KEYWORDs, COLUMNs, ROWs, or HDUs \n"
55
"delete- delete KEYWORDs, COLUMNs, ROWs, or HDUs \n"
56
"select- select ROWs \n"
57
"load - load image and table data into variables or pointers \n"
58
"free - free loaded data. **If the address is not the right one\n"
59
" returned from \"load xxx\", a core dump will occur** \n"
60
"flush ?clear? - flush dirty buffers to disk (also clear buffer contents?) \n"
61
"copy filename - copy the CHDU to a new file\n"
62
"sascii- save extension contents to an ascii file \n"
63
"sort - sort the CHDU according to supplied parameters \n"
64
"add - Append new columns and rows to table. Column may be filled\n"
65
" with the results of a supplied arithmetic expression\n"
66
"append filename - Append current HDU to indicated fits file\n"
67
"histogram - Create N-D histogram from table columns\n"
68
"smooth - Create a smoothed image from the original image.\n"
69
"checksum update|verify - Update or verify checksum keywords of the\n"
70
" current HDU. Verify: 1=good, -1=bad, 0=none\n"
71
;
72
73
int i, j, status;
74
FitsFD *curFile = (FitsFD *) clientData;
75
struct {
76
char *cmd;
77
int tclObjs;
78
int (*fct)(FitsFD*,int,Tcl_Obj*const[]);
79
} cmdLookup[] = {
80
{ "close", 1, fitsTcl_close },
81
{ "move", 1, fitsTcl_move },
82
{ "dump", 1, fitsTcl_dump },
83
{ "info", 0, fitsTcl_info },
84
{ "get", 0, fitsTcl_get },
85
{ "put", 1, fitsTcl_put },
86
{ "insert", 0, fitsTcl_insert },
87
{ "delete", 0, fitsTcl_delete },
88
{ "select", 0, fitsTcl_select },
89
{ "load", 0, fitsTcl_load },
90
{ "free", 1, fitsTcl_free },
91
{ "flush", 1, fitsTcl_flush },
92
{ "copy", 1, fitsTcl_copy },
93
{ "sascii", 0, fitsTcl_sascii },
94
{ "sort", 0, fitsTcl_sort },
95
{ "add", 0, fitsTcl_add },
96
{ "append", 1, fitsTcl_append },
97
{ "histogram",1, fitsTcl_histo },
98
{ "create", 1, fitsTcl_create },
99
{ "smooth", 1, fitsTcl_smooth },
100
{ "checksum", 1, fitsTcl_checksum },
101
{ "", 0, NULL }
102
};
103
char *cmd, **args;
104
105
/*
106
* If there are no arguments, return the help string
107
*/
108
109
if( argc==1 ) {
110
Tcl_SetResult(interp,commandList,TCL_STATIC);
111
return TCL_OK;
112
}
113
114
/*
115
* Search for the command and call its handler
116
*/
117
118
119
cmd = Tcl_GetStringFromObj( argv[1], NULL );
120
for( i=0; cmdLookup[i].cmd[0]; i++ ) {
121
if( !strcmp( cmdLookup[i].cmd, cmd ) ) {
122
123
if( cmdLookup[i].tclObjs ) {
124
status = (*cmdLookup[i].fct)(curFile, argc, argv);
125
} else {
126
127
/*
128
* Convert TCL_OBJs to strings
129
*/
130
131
args = (char **) ckalloc( argc * sizeof(char *) );
132
for( j=0; j<argc; j++ ) {
133
args[j] = Tcl_GetStringFromObj( argv[j], NULL );
134
}
135
status = (*cmdLookup[i].fct)(curFile, argc, (Tcl_Obj**)args);
136
ckfree( (char*) args );
137
}
138
139
return status;
140
}
141
}
142
143
/*
144
* NO SUCH COMMAND... Error
145
*/
146
147
Tcl_SetResult(interp, "Unrecognized command\n", TCL_STATIC);
148
Tcl_AppendResult(interp, commandList);
149
return TCL_ERROR;
150
}
151
152
153
154
/**********************
155
*
156
* Command Handlers....
157
*
158
**********************/
159
160
161
/******************************************************************
162
* Close
163
******************************************************************/
164
165
int fitsTcl_close( FitsFD *curFile, int argc, Tcl_Obj *const argv[] )
166
{
167
if ( argc != 2 ) {
168
Tcl_SetResult(curFile->interp,
169
"Wrong number of args: expected fits close",TCL_STATIC);
170
return TCL_ERROR;
171
}
172
if( Tcl_DeleteCommand( curFile->interp, curFile->handleName ) != TCL_OK ) {
173
return TCL_ERROR;
174
}
175
curFile->fptr = NULL;
176
curFile->handleName = NULL;
177
return TCL_OK;
178
}
179
180
181
/******************************************************************
182
* Move
183
******************************************************************/
184
185
int fitsTcl_move( FitsFD *curFile, int argc, Tcl_Obj *const argv[] )
186
{
187
static char *moveList = "\n"
188
"move nmove - moves the CHDU: \n"
189
" nmove = +- -> relative move, otherwise absolute\n"
190
" returns hdutype\n";
191
192
char *pStr;
193
int nmove;
194
int mSilent=0;
195
int status=0;
196
197
if ( 3 > argc ) {
198
Tcl_SetResult(curFile->interp, moveList, TCL_STATIC);
199
return TCL_OK;
200
}
201
202
/* Convert the nmove argument */
203
204
if( Tcl_GetIntFromObj(curFile->interp,argv[2],&nmove) != TCL_OK ) {
205
Tcl_SetResult(curFile->interp,"Wrong type for nmove",TCL_STATIC);
206
return TCL_ERROR;
207
}
208
209
if( argc == 4 ) {
210
pStr = Tcl_GetStringFromObj( argv[3], NULL );
211
if( !strcmp(pStr, "-s") ) {
212
mSilent = 1;
213
} else {
214
Tcl_SetResult(curFile->interp, "fitsTcl Error: "
215
"unkown option: -s for load without read header", TCL_STATIC);
216
return TCL_ERROR;
217
}
218
}
219
220
pStr = Tcl_GetStringFromObj( argv[2], NULL );
221
if( mSilent ) {
222
223
if ( strchr(pStr,'+') ) {
224
status = fitsJustMoveHDU(curFile, nmove, 1);
225
} else if ( strchr(pStr,'-') ) {
226
status = fitsJustMoveHDU(curFile, nmove,-1);
227
} else {
228
status = fitsJustMoveHDU(curFile, nmove, 0);
229
}
230
231
} else {
232
233
if ( strchr(pStr,'+') ) {
234
status = fitsMoveHDU(curFile, nmove, 1);
235
} else if ( strchr(pStr,'-') ) {
236
status = fitsMoveHDU(curFile, nmove,-1);
237
} else {
238
status = fitsMoveHDU(curFile, nmove, 0);
239
}
240
241
}
242
243
if ( status ) {
244
return TCL_ERROR;
245
}
246
247
/* Return the hdutype */
248
Tcl_SetObjResult(curFile->interp,
249
Tcl_NewIntObj( curFile->hduType ) );
250
return TCL_OK;
251
}
252
253
254
/******************************************************************
255
* Dump
256
******************************************************************/
257
258
int fitsTcl_dump( FitsFD *curFile, int argc, Tcl_Obj *const argv[] )
259
{
260
int status;
261
char *option;
262
263
if( argc == 2 ) {
264
265
status = fitsDumpHeader(curFile);
266
267
} else {
268
269
option = Tcl_GetStringFromObj( argv[2], NULL );
270
if( !strcmp("-l",option) ) {
271
status = fitsDumpKwdsToList(curFile);
272
} else if( !strcmp("-s",option) ) {
273
status = fitsDumpHeaderToKV(curFile);
274
} else if( !strcmp("-e",option) ) {
275
status = fitsDumpHeaderToCard(curFile);
276
} else {
277
Tcl_SetResult(curFile->interp,
278
"Usage: fitsFile dump ?-s/-e/-l?", TCL_STATIC);
279
return TCL_ERROR;
280
}
281
282
}
283
284
return status;
285
}
286
287
288
/******************************************************************
289
* Info
290
******************************************************************/
291
292
int fitsTcl_info( FitsFD *curFile, int argc, char *const argv[] )
293
{
294
static char *infoList = "\n"
295
"Available Commands:\n"
296
"\n"
297
"info chdu - returns the CHDU\n"
298
"info nhdu - returns the total number of hdu in the file\n"
299
"info filesize- returns the size of the file(in unit of 2880 byte)\n"
300
"info hdutype - returns the type of the CHDU\n"
301
"info imgType - returns the image type of the CHDU \n"
302
"info imgdim - returns the image dimension of the CHDU \n"
303
"info ncols - returns the number of columns in the CHDU\n"
304
"info nrows - returns the number of rows in the CHDU\n"
305
"info nkwds - returns the number of keywords in the CHDU\n"
306
"info column ?-exact? ?colNames? \n"
307
" with no argument, lists the columns,\n"
308
" otherwise gives more info about columns in colName\n"
309
" ?-minmax? colName firstElement ?rowRange? \n"
310
" min and max\n"
311
" ?-stat? colName firstElement ?rowRange? \n"
312
" statistics about the indicated column\n"
313
"\n";
314
315
int i, j, felem, numRange, *range=NULL;
316
int numCols, colTypes[FITS_COLMAX], colNums[FITS_COLMAX], strSize[FITS_COLMAX];
317
int status = 0;
318
char result[32];
319
char tmpStr[3][FLEN_VALUE]; /* Some general purpose string buffers */
320
char *mrgList[9], *pattern, *tmpStrPtr;
321
char errMsg[256], **colList;
322
Tcl_DString concatList;
323
324
if( argc < 3 ) {
325
Tcl_SetResult(curFile->interp, infoList, TCL_STATIC);
326
return TCL_OK;
327
}
328
329
330
/* check if the chdu has been loaded or not */
331
332
if( curFile->CHDUInfo.table.loadStatus != 1 ) {
333
334
Tcl_SetResult(curFile->interp,
335
"You need to load the CHDU first", TCL_STATIC);
336
return TCL_ERROR;
337
338
}
339
340
if( !strcmp("chdu",argv[2] ) ) {
341
342
sprintf(result,"%d",curFile->chdu);
343
Tcl_SetResult(curFile->interp, result, TCL_VOLATILE);
344
345
} else if( !strcmp("imgType",argv[2]) ) {
346
int bitpix = 0;
347
int naxis = 0;
348
long naxes[9];
349
350
fits_get_img_dim(curFile->fptr, &naxis, &status);
351
352
status = 0;
353
fits_get_img_size(curFile->fptr, naxis, naxes, &status);
354
355
status = 0;
356
fits_get_img_type(curFile->fptr, &bitpix, &status);
357
358
sprintf(result,"%d", bitpix);
359
Tcl_SetResult(curFile->interp, result, TCL_VOLATILE);
360
361
} else if( !strcmp("filesize",argv[2]) ) {
362
363
sprintf(result,"%lld",curFile->fptr->Fptr->filesize/2880);
364
Tcl_SetResult(curFile->interp, result, TCL_VOLATILE);
365
366
} else if( !strcmp("hdutype",argv[2]) ) {
367
368
switch ( curFile->hduType ) {
369
case IMAGE_HDU:
370
if( curFile->chdu )
371
tmpStrPtr = "Image extension";
372
else
373
tmpStrPtr = "Primary array";
374
break;
375
case ASCII_TBL:
376
tmpStrPtr = "ASCII Table";
377
break;
378
case BINARY_TBL:
379
tmpStrPtr = "Binary Table";
380
break;
381
default:
382
Tcl_SetResult(curFile->interp, "Unsupported hdu type", TCL_STATIC);
383
return TCL_ERROR;
384
}
385
386
Tcl_SetResult(curFile->interp, tmpStrPtr, TCL_STATIC);
387
388
} else if( !strcmp("nhdu", argv[2]) ) {
389
int nhdu;
390
391
ffthdu(curFile->fptr, &nhdu, &status);
392
if( status ) {
393
dumpFitsErrStack(curFile->interp, status);
394
return TCL_ERROR;
395
}
396
sprintf(result, "%d", nhdu);
397
Tcl_SetResult( curFile->interp, result, TCL_VOLATILE );
398
399
} else if( !strcmp("nkwds",argv[2] ) ) {
400
401
sprintf(result, "%-d", curFile->numKwds);
402
Tcl_SetResult( curFile->interp, result, TCL_VOLATILE );
403
404
} else if( !strcmp("ncols",argv[2] ) ) {
405
406
if (curFile->hduType == IMAGE_HDU ) {
407
Tcl_SetResult( curFile->interp,
408
"No columns for an Image extension", TCL_STATIC);
409
return TCL_ERROR;
410
}
411
sprintf(result, "%d", curFile->CHDUInfo.table.numCols);
412
Tcl_SetResult( curFile->interp, result, TCL_VOLATILE );
413
414
} else if( !strcmp("nrows",argv[2] ) ) {
415
416
if (curFile->hduType == IMAGE_HDU ) {
417
Tcl_SetResult( curFile->interp,
418
"No rows for an Image extension", TCL_STATIC );
419
return TCL_ERROR;
420
}
421
sprintf(result,"%lld",curFile->CHDUInfo.table.numRows);
422
Tcl_SetResult( curFile->interp, result, TCL_VOLATILE );
423
424
} else if( !strcmp("column",argv[2] ) ) {
425
426
if( curFile->hduType == IMAGE_HDU ) {
427
Tcl_SetResult( curFile->interp,
428
"No Columns in an image extension", TCL_STATIC );
429
return TCL_ERROR;
430
}
431
432
if( argc == 3 ) {
433
434
/***********************************
435
* Return a list of column names *
436
***********************************/
437
438
for ( i = 0; i < curFile->CHDUInfo.table.numCols; i++ ) {
439
Tcl_AppendElement(curFile->interp,
440
curFile->CHDUInfo.table.colName[i]);
441
}
442
443
} else {
444
445
/*******************************************
446
* Return info about one or more columns *
447
*******************************************/
448
449
if( !strcmp(argv[3], "-stat") ) {
450
451
if ( argc < 5 ) {
452
Tcl_SetResult(curFile->interp,
453
"Usage: info column -stat columnName ?felem? ?rows?",
454
TCL_STATIC);
455
return TCL_ERROR;
456
}
457
458
if( argc == 5 ) {
459
felem = 1;
460
} else if( Tcl_GetInt(curFile->interp, argv[5], &felem)
461
!= TCL_OK ) {
462
return TCL_ERROR;
463
}
464
465
if( argc >= 7 ) {
466
numRange = fitsParseRangeNum(argv[6])+1;
467
range = (int*) malloc(numRange*2*sizeof(int));
468
if( fitsParseRange(argv[6],&numRange,range,numRange,
469
1, curFile->CHDUInfo.table.numRows,errMsg)
470
!= TCL_OK ) {
471
Tcl_SetResult(curFile->interp,
472
"Error parsing row range:\n", TCL_STATIC);
473
Tcl_AppendResult(curFile->interp, errMsg, (char*)NULL);
474
return TCL_ERROR;
475
}
476
} else {
477
numRange = 1;
478
range = (int*) malloc(numRange*2*sizeof(int));
479
range[0] = 1;
480
range[1] = curFile->CHDUInfo.table.numRows ;
481
}
482
483
if( fitsTransColList( curFile, argv[4], &numCols,
484
colNums, colTypes, strSize) != TCL_OK )
485
return TCL_ERROR;
486
487
if( fitsColumnStatistics(curFile,colNums[0],felem,
488
numRange,range) != TCL_OK ) {
489
return TCL_ERROR;
490
}
491
492
} else if( !strcmp(argv[3], "-minmax") ) {
493
494
if ( argc < 5 ) {
495
Tcl_SetResult(curFile->interp,
496
"Usage: info column -minmax "
497
"columnName ?felem? ?rows?", TCL_STATIC);
498
return TCL_ERROR;
499
}
500
501
if( argc == 5 ) {
502
felem = 1;
503
} else if( Tcl_GetInt(curFile->interp, argv[5], &felem)
504
!= TCL_OK ) {
505
return TCL_ERROR;
506
}
507
508
if( argc >= 7 ) {
509
numRange = fitsParseRangeNum(argv[6])+1;
510
range = (int*) malloc(numRange*2*sizeof(int));
511
if( fitsParseRange(argv[6],&numRange,range,numRange,
512
1, curFile->CHDUInfo.table.numRows,errMsg)
513
!= TCL_OK ) {
514
Tcl_SetResult(curFile->interp,
515
"Error parsing row range:\n", TCL_STATIC);
516
Tcl_AppendResult(curFile->interp, errMsg, (char*)NULL);
517
return TCL_ERROR;
518
}
519
} else {
520
numRange = 1;
521
range = (int*) malloc(numRange*2*sizeof(int));
522
range[0] = 1;
523
range[1] = curFile->CHDUInfo.table.numRows ;
524
}
525
526
for ( i = 0; i < curFile->CHDUInfo.table.numCols; i++) {
527
if( !strcasecmp(argv[4],curFile->CHDUInfo.table.colName[i]) ) {
528
if( fitsColumnMinMax(curFile, i+1, felem, numRange, range)
529
!= TCL_OK ) {
530
return TCL_ERROR;
531
}
532
break;
533
}
534
}
535
536
} else if( !strcmp(argv[3], "-exact") ) {
537
538
/*************************************************************
539
* Return Info about Columns matching an exact column name *
540
*************************************************************/
541
542
if( argc != 5 ) {
543
Tcl_SetResult(curFile->interp,
544
"Usage: info column -exact columnNames",
545
TCL_STATIC);
546
return TCL_ERROR;
547
}
548
if( fitsTransColList( curFile, argv[4], &numCols,
549
colNums, colTypes, strSize) != TCL_OK )
550
return TCL_ERROR;
551
552
for ( i = 0; i < numCols; i++ ) {
553
j = colNums[i]-1;
554
mrgList[0] = curFile->CHDUInfo.table.colName[j];
555
mrgList[1] = curFile->CHDUInfo.table.colType[j];
556
mrgList[2] = curFile->CHDUInfo.table.colUnit[j];
557
mrgList[3] = curFile->CHDUInfo.table.colDisp[j];
558
mrgList[4] = curFile->CHDUInfo.table.colFormat[j];
559
sprintf(tmpStr[0], "%d",
560
curFile->CHDUInfo.table.colWidth[j]);
561
mrgList[5] = tmpStr[0];
562
sprintf(tmpStr[1], "%d",
563
curFile->CHDUInfo.table.colTzflag[j]);
564
mrgList[6] = tmpStr[1];
565
sprintf(tmpStr[2], "%d",
566
curFile->CHDUInfo.table.colTsflag[j]);
567
mrgList[7] = tmpStr[2];
568
mrgList[8] = curFile->CHDUInfo.table.colNull[j];
569
Tcl_AppendElement(curFile->interp,Tcl_Merge(9,mrgList));
570
}
571
572
} else if( argc==4 ) {
573
574
/***********************************************************
575
* Return Info about Columns matching regular expression *
576
***********************************************************/
577
578
Tcl_DStringInit(&concatList);
579
580
if( Tcl_SplitList(curFile->interp, argv[3], &numCols,
581
&colList) != TCL_OK ) {
582
return TCL_ERROR;
583
}
584
585
if( fitsMakeRegExp(curFile->interp, numCols, colList,
586
&concatList, 1)
587
== TCL_ERROR ) {
588
Tcl_SetResult(curFile->interp,
589
"Error making up reg expr", TCL_STATIC);
590
Tcl_DStringFree(&concatList);
591
ckfree((char*)colList);
592
return TCL_ERROR;
593
}
594
ckfree((char*)colList);
595
pattern = Tcl_DStringValue(&concatList);
596
for ( i = 0; i < curFile->CHDUInfo.table.numCols; i++) {
597
strToUpper(curFile->CHDUInfo.table.colName[i], &tmpStrPtr);
598
status = Tcl_RegExpMatch(curFile->interp, tmpStrPtr, pattern);
599
ckfree( (char*)tmpStrPtr );
600
if( status == 1 ) {
601
mrgList[0] = curFile->CHDUInfo.table.colName[i];
602
mrgList[1] = curFile->CHDUInfo.table.colType[i];
603
mrgList[2] = curFile->CHDUInfo.table.colUnit[i];
604
mrgList[3] = curFile->CHDUInfo.table.colDisp[i];
605
mrgList[4] = curFile->CHDUInfo.table.colFormat[i];
606
sprintf(tmpStr[0], "%d",
607
curFile->CHDUInfo.table.colWidth[i]);
608
mrgList[5] = tmpStr[0];
609
sprintf(tmpStr[1], "%d",
610
curFile->CHDUInfo.table.colTzflag[i]);
611
mrgList[6] = tmpStr[1];
612
sprintf(tmpStr[2], "%d",
613
curFile->CHDUInfo.table.colTsflag[i]);
614
mrgList[7] = tmpStr[2];
615
mrgList[8] = curFile->CHDUInfo.table.colNull[i];
616
Tcl_AppendElement(curFile->interp,Tcl_Merge(9,mrgList));
617
} else if( status == -1 ) {
618
Tcl_AppendResult(curFile->interp,"Error, ", pattern,
619
" not a Regular Expression.",
620
(char *) NULL);
621
Tcl_DStringFree(&concatList);
622
return TCL_ERROR;
623
}
624
}
625
Tcl_DStringFree(&concatList);
626
627
} else {
628
629
Tcl_SetResult(curFile->interp,
630
"Usage:\n"
631
" info column ?-exact? colNames \n"
632
" -minmax colName firstElement ?rowRange? \n"
633
" -stat colName firstElement ?rowRange? \n",
634
TCL_STATIC);
635
return TCL_ERROR;
636
637
}
638
}
639
640
/* End of 'info column' */
641
642
} else if( !strcmp("expr", argv[2]) ) {
643
644
if( curFile->hduType == IMAGE_HDU ) {
645
Tcl_SetResult(curFile->interp,"Not a table extension", TCL_STATIC);
646
return TCL_ERROR;
647
}
648
if( argc != 4 ) {
649
Tcl_SetResult(curFile->interp,
650
"Usage: info expr exprStr", TCL_STATIC);
651
return TCL_ERROR;
652
}
653
654
if( exprGetInfo( curFile, argv[3] ) ) {
655
return TCL_ERROR;
656
}
657
658
} else if( !strcmp("imgdim", argv[2]) ) {
659
660
if ( curFile->hduType != IMAGE_HDU ) {
661
Tcl_SetResult(curFile->interp,
662
"Current extension is not an image", TCL_STATIC);
663
return TCL_ERROR;
664
}
665
666
Tcl_ResetResult(curFile->interp);
667
for (i=0; i < curFile->CHDUInfo.image.naxes; i++) {
668
sprintf(tmpStr[0], "%lld", curFile->CHDUInfo.image.naxisn[i]);
669
Tcl_AppendElement(curFile->interp, tmpStr[0]);
670
}
671
672
} else {
673
674
Tcl_SetResult(curFile->interp,
675
"Unrecognized option to info", TCL_STATIC);
676
return TCL_ERROR;
677
678
}
679
680
if (range) free(range);
681
return TCL_OK;
682
}
683
684
685
/******************************************************************
686
* Get
687
******************************************************************/
688
689
int fitsTcl_get( FitsFD *curFile, int argc, char *const argv[] )
690
{
691
static char *getList = "\n"
692
"Available Commands:\n"
693
"get keyword ?keyName? - displays the keyword(s) keyname\n"
694
" - keywords are specified by reg. expression\n"
695
"get keyword -num keyNum - displays the num th keyword in the CHDU\n"
696
"get wcs ?RAcol DECcol?\n"
697
" - return a list of the WCS parameters for either a table or image:\n"
698
" {xrval yrval xrpix yrpix xinc yinc rot ctype}\n"
699
" For a table, supply RAcol and DECcol which are column names or \n"
700
" numbers of the RA column and DEC column\n"
701
"get header2str - get header and construct it into a string\n"
702
"get translatedKeywords - translated header keyword to normal one.\n"
703
"get dummy2str - create dummy fits image file and get header and construct it into a string\n"
704
"get image ?firstElem? ?numElem?\n"
705
" - return elements of an image\n"
706
"get table ?-c? ?-noformat? ?colList? ?rowList?\n"
707
" - return the elements rowList from list colList\n"
708
" - if no rowList is provided, give all rows\n"
709
" - if no colList is provided, give all columns\n"
710
" - use colList = * for all columns\n"
711
" - -c means return each column as a seperate list.\n"
712
"get vtable ?-noformat? colname firstelement ?rowList?\n"
713
" - get the firstelement-th vector element\n"
714
"\n";
715
716
char Comment[FLEN_COMMENT], Name[FLEN_KEYWORD], Value[FLEN_VALUE];
717
int numCols,colNums[FITS_COLMAX],colTypes[FITS_COLMAX],strSize[FITS_COLMAX];
718
int numRange, *range=NULL;
719
Tcl_HashEntry *newEntry;
720
Tcl_HashSearch search;
721
Tcl_DString concatList, regExpList;
722
Tcl_DString ** colDString;
723
FitsCardList *curCard;
724
Keyword *newKwd;
725
char errMsg[256];
726
int nmove,i,k,l,n;
727
int bycol,niters,fRow;
728
int ntodo,felem;
729
char ***strValArray;
730
char *pattern;
731
int status = 0;
732
char *header;
733
int nkeys;
734
735
Tcl_Obj *resObj, **valArray, *listObj, **listArray, *valObj;
736
737
listObj = Tcl_NewObj();
738
739
if ( argc == 2 ) {
740
Tcl_SetResult(curFile->interp, getList, TCL_STATIC);
741
return TCL_OK;
742
}
743
744
if( !strcmp("keyword", argv[2]) ) {
745
746
/* GET KEYWORD */
747
748
if( argc == 3 ) {
749
750
Tcl_DStringInit(&concatList);
751
752
newEntry = Tcl_FirstHashEntry(curFile->kwds,&search);
753
while ( newEntry ) {
754
newKwd = (Keyword *) Tcl_GetHashValue(newEntry);
755
Tcl_DStringStartSublist(&concatList);
756
Tcl_DStringAppendElement(&concatList,newKwd->name);
757
Tcl_DStringAppendElement(&concatList,newKwd->value);
758
Tcl_DStringAppendElement(&concatList,newKwd->comment);
759
Tcl_DStringEndSublist(&concatList);
760
newEntry = Tcl_NextHashEntry(&search);
761
}
762
Tcl_DStringResult(curFile->interp,&concatList);
763
764
} else if( !strcmp(argv[3],"-num") ) {
765
766
if ( 5 != argc ) {
767
Tcl_SetResult(curFile->interp,
768
"Wrong number of args, expected get keyword "
769
"-num number", TCL_STATIC);
770
return TCL_ERROR;
771
}
772
773
if( Tcl_GetInt(curFile->interp,argv[4],&nmove) != TCL_OK ) {
774
Tcl_AppendResult(curFile->interp,
775
"\nWrong type for nmove",(char *) NULL);
776
return TCL_ERROR;
777
}
778
779
/*
780
* First look through the comments and the history cards:
781
* remember the first card is always a dummy...
782
*/
783
784
curCard = (curFile->hisHead)->next;
785
while( curCard ) {
786
if ( curCard->pos == nmove ) {
787
Tcl_AppendElement(curFile->interp,"HISTORY");
788
Tcl_AppendElement(curFile->interp," ");
789
Tcl_AppendElement(curFile->interp,curCard->value);
790
return TCL_OK;
791
}
792
curCard = curCard->next;
793
}
794
795
curCard = (curFile->comHead)->next;
796
while( curCard ) {
797
if ( curCard->pos == nmove ) {
798
Tcl_AppendElement(curFile->interp,"COMMENT");
799
Tcl_AppendElement(curFile->interp," ");
800
Tcl_AppendElement(curFile->interp,curCard->value);
801
return TCL_OK;
802
}
803
curCard = curCard->next;
804
}
805
806
newEntry = Tcl_FirstHashEntry(curFile->kwds,&search);
807
while( newEntry ) {
808
newKwd = (Keyword *) Tcl_GetHashValue(newEntry);
809
if ( newKwd->pos == nmove ) {
810
Tcl_AppendElement(curFile->interp,newKwd->name);
811
Tcl_AppendElement(curFile->interp,newKwd->value);
812
Tcl_AppendElement(curFile->interp,newKwd->comment);
813
return TCL_OK;
814
}
815
newEntry = Tcl_NextHashEntry(&search);
816
}
817
818
/* The Hashes all failed (maybe duplicate keys in header. */
819
/* Go directly to file. */
820
ffgkyn( curFile->fptr, nmove, Name, Value, Comment, &status);
821
if( status ) {
822
dumpFitsErrStack(curFile->interp,status);
823
return TCL_ERROR;
824
}
825
Tcl_AppendElement(curFile->interp,Name);
826
Tcl_AppendElement(curFile->interp,Value);
827
Tcl_AppendElement(curFile->interp,Comment);
828
829
} else {
830
831
Tcl_DStringInit(®ExpList);
832
833
if( fitsMakeRegExp(curFile->interp, argc-3, argv+3, ®ExpList, 1)
834
== TCL_ERROR ) {
835
Tcl_SetResult(curFile->interp,
836
"Error building regular expression", TCL_STATIC);
837
Tcl_DStringFree(®ExpList);
838
return TCL_ERROR;
839
}
840
841
pattern = Tcl_DStringValue(®ExpList);
842
843
Tcl_DStringInit(&concatList);
844
845
niters = 0;
846
newEntry = Tcl_FirstHashEntry(curFile->kwds,&search);
847
while ( NULL != newEntry ) {
848
newKwd = (Keyword *) Tcl_GetHashValue(newEntry);
849
status = Tcl_RegExpMatch(curFile->interp,newKwd->name,pattern);
850
if ( status == 1 ) {
851
niters = 1;
852
Tcl_DStringStartSublist(&concatList);
853
Tcl_DStringAppendElement(&concatList,newKwd->name);
854
Tcl_DStringAppendElement(&concatList,newKwd->value);
855
Tcl_DStringAppendElement(&concatList,newKwd->comment);
856
Tcl_DStringEndSublist(&concatList);
857
newEntry = Tcl_NextHashEntry(&search);
858
} else if ( status == -1 ) {
859
Tcl_AppendResult(curFile->interp,"The Pattern: ",pattern,
860
" is not a regular expression."
861
,(char *) NULL);
862
Tcl_DStringFree(&concatList);
863
Tcl_DStringFree(®ExpList);
864
return TCL_ERROR;
865
} else {
866
newEntry = Tcl_NextHashEntry(&search);
867
}
868
}
869
870
if( !niters ) {
871
Tcl_SetResult(curFile->interp,
872
"No matching keywords found/or keyword not loaded",
873
TCL_STATIC);
874
Tcl_DStringFree(&concatList);
875
return TCL_ERROR;
876
}
877
878
Tcl_DStringResult(curFile->interp,&concatList);
879
}
880
881
} else if( !strcmp("wcs", argv[2]) ) {
882
883
/* Get WCS */
884
885
if ( curFile->hduType == IMAGE_HDU ) {
886
887
/* Get WCS from Image extension */
888
889
if( argc < 4 || argc > 5 ) {
890
Tcl_SetResult(curFile->interp,
891
"For image extension use, get wcs", TCL_STATIC);
892
return TCL_ERROR;
893
}
894
895
if ( argc == 5 && !strcmp("-m", argv[3]) ) {
896
if( fitsGetWcsMatrix(curFile, 0, NULL, argv[4][0]) != TCL_OK ) {
897
return TCL_ERROR;
898
}
899
} else {
900
if( fitsGetWcsPair(curFile,0,0, '\0') != TCL_OK ) {
901
return TCL_ERROR;
902
}
903
}
904
905
} else {
906
907
/* Get WCS from Table extension */
908
909
int i,j;
910
int nCols = 0;
911
int getMatrix = 0;
912
int columns[FITS_MAXDIMS];
913
914
if( argc>4 && !strcmp("-m", argv[3]) ) {
915
getMatrix = 1;
916
nCols = argc - 5;
917
if( nCols<1 ) {
918
Tcl_SetResult(curFile->interp,
919
"For table extension use, "
920
"get wcs -m dest Col1 ?Col2 ...?",
921
TCL_STATIC);
922
return TCL_ERROR;
923
} else if( nCols > FITS_MAXDIMS ) {
924
Tcl_SetResult(curFile->interp,
925
"Too many columns to obtain WCS information",
926
TCL_STATIC);
927
return TCL_ERROR;
928
}
929
} else {
930
nCols = 2;
931
if( argc != 7 ) {
932
Tcl_SetResult(curFile->interp,
933
"For table extension use, get wcs -m dest RAcol DecCol",
934
TCL_STATIC);
935
return TCL_ERROR;
936
}
937
}
938
939
for( j=0, i=argc-nCols; i<argc; i++,j++ ) {
940
941
if( Tcl_GetInt(curFile->interp, argv[i], columns+j) != TCL_OK ) {
942
Tcl_ResetResult(curFile->interp);
943
if( fitsTransColList( curFile, argv[i],
944
&numCols, colNums, colTypes, strSize)
945
!= TCL_OK ) {
946
Tcl_SetResult(curFile->interp,
947
"Unable to read column specifier", TCL_STATIC);
948
return TCL_ERROR;
949
}
950
if( numCols != 1 ) {
951
Tcl_SetResult(curFile->interp,
952
"Can only have column value", TCL_STATIC);
953
return TCL_ERROR;
954
}
955
columns[j] = colNums[0];
956
}
957
958
}
959
960
if( getMatrix ) {
961
if( fitsGetWcsMatrix(curFile, nCols, columns, argv[4][0]) != TCL_OK ) {
962
return TCL_ERROR;
963
}
964
} else {
965
if( fitsGetWcsPair(curFile, columns[0], columns[1], argv[4][0]) != TCL_OK ) {
966
return TCL_ERROR;
967
}
968
}
969
970
}
971
972
} else if( !strcmp("dummy2str", argv[2]) ) {
973
fitsfile *dummyptr;
974
int status = 0;
975
int bitpix = 8;
976
int naxis = 2;
977
long naxes[2];
978
int columns[FITS_MAXDIMS];
979
int nkeys;
980
char *header;
981
int i,j;
982
983
/* Pan Chai: there is only 2 columns */
984
int nCols = 2;
985
986
Tcl_Obj *data[5];
987
naxes[0] = 10;
988
naxes[1] = 10;
989
990
for( j=0, i=argc-nCols; i<argc; i++,j++ ) {
991
992
if( Tcl_GetInt(curFile->interp, argv[i], columns+j) != TCL_OK ) {
993
Tcl_ResetResult(curFile->interp);
994
if( fitsTransColList( curFile, argv[i],
995
&numCols, colNums, colTypes, strSize)
996
!= TCL_OK ) {
997
Tcl_SetResult(curFile->interp,
998
"Unable to read column specifier", TCL_STATIC);
999
return TCL_ERROR;
1000
}
1001
if( numCols != 1 ) {
1002
Tcl_SetResult(curFile->interp,
1003
"Can only have column value", TCL_STATIC);
1004
return TCL_ERROR;
1005
}
1006
columns[j] = colNums[0];
1007
}
1008
}
1009
1010
/* size of histogram is now known, so create temp output file */
1011
if (ffinit(&dummyptr, "mem://", &status) > 0)
1012
{
1013
ffpmsg("failed to create temp output file for dummy fits file");
1014
return(status);
1015
}
1016
1017
status = 0;
1018
/* create output FITS image HDU */
1019
if (ffcrim(dummyptr, bitpix, naxis, naxes, &status) > 0)
1020
{
1021
ffpmsg("failed to create output dummy FITS image");
1022
return(status);
1023
}
1024
1025
status = 0;
1026
1027
/* copy header keywords, converting pixel list WCS keywords to image WCS form */
1028
if (fits_copy_pixlist2image(curFile->fptr, dummyptr, 9, naxis, columns, &status) > 0)
1029
{
1030
ffpmsg("failed to copy pixel list keywords to new dummy header");
1031
return(status);
1032
}
1033
1034
status = 0;
1035
if ( ffhdr2str(dummyptr, 1, (char **)NULL, 0, &header, &nkeys, &status) > 0 ) {
1036
Tcl_SetResult(curFile->interp, "Failed to collect all the headers.", TCL_STATIC);
1037
return TCL_ERROR;
1038
}
1039
1040
/* since this is a dummy header, all relative reference starts with 1 */
1041
for (i = 0; i < naxis; i++) {
1042
columns[i] = i + 1;
1043
}
1044
1045
fitsFileGetWcsMatrix( curFile, dummyptr, naxis, columns, argv[3][0], data);
1046
1047
Tcl_ListObjAppendElement( curFile->interp, listObj, Tcl_NewStringObj(header, -1));
1048
Tcl_ListObjAppendElement( curFile->interp, listObj, Tcl_NewIntObj( nkeys ) );
1049
Tcl_ListObjAppendElement( curFile->interp, listObj, Tcl_NewListObj(5,data) );
1050
Tcl_SetObjResult(curFile->interp, listObj);
1051
1052
free( header);
1053
return TCL_OK;
1054
1055
} else if( !strcmp("translatedKeywords", argv[2]) ) {
1056
char outfile[FLEN_FILENAME];
1057
int status = 0;
1058
long rownum;
1059
fitsfile *newptr;
1060
1061
if ( argc != 5 ) {
1062
Tcl_SetResult(curFile->interp,
1063
"Usage: get translatedKeywords rownum colname",
1064
TCL_STATIC);
1065
return TCL_ERROR;
1066
}
1067
1068
strcpy(outfile, "mem://_1");
1069
1070
/* Copy the image into new primary array and open it as the current */
1071
/* fptr. This will close the table that contains the original image. */
1072
1073
/* create new empty file to hold copy of the image */
1074
if (ffinit(&newptr, outfile, &status) > 0)
1075
{
1076
ffpmsg("failed to create file for copy of image in table cell:");
1077
ffpmsg(outfile);
1078
return(status);
1079
}
1080
1081
rownum = atol(argv[4]);
1082
status = 0;
1083
if (fits_copy_cell2image(curFile->fptr, newptr, argv[3], rownum, &status) > 0)
1084
{
1085
int status2 = 0;
1086
ffpmsg("Failed to copy table cell to new primary array:");
1087
ffclos(curFile->fptr, &status2);
1088
curFile->fptr = 0; /* return null file pointer */
1089
return(status);
1090
}
1091
1092
if ( ffhdr2str(newptr, 1, (char **)NULL, 0, &header, &nkeys, &status) > 0 ) {
1093
Tcl_SetResult(curFile->interp, "Failed to collect all the headers.", TCL_STATIC);
1094
return TCL_ERROR;
1095
}
1096
1097
Tcl_ListObjAppendElement( curFile->interp, listObj, Tcl_NewStringObj(header, -1));
1098
Tcl_ListObjAppendElement( curFile->interp, listObj, Tcl_NewIntObj( nkeys ) );
1099
1100
if ( fitsGetWcsMatrixAlt(curFile, newptr, listObj, 0, NULL, '\0') > 0 ) {
1101
Tcl_SetResult(curFile->interp, "Failed to collect all the headers.", TCL_STATIC);
1102
return TCL_ERROR;
1103
}
1104
/*
1105
if ( fitsGetWcsPairAlt(curFile, newptr, listObj, 0, 0, '\0') > 0 ) {
1106
Tcl_SetResult(curFile->interp, "Failed to collect all the headers.", TCL_STATIC);
1107
return TCL_ERROR;
1108
}
1109
1110
Tcl_SetObjResult(curFile->interp, listObj);
1111
*/
1112
1113
free( header);
1114
return TCL_OK;
1115
1116
} else if( !strcmp("header2str", argv[2]) ) {
1117
/* int ffhdr2str( fitsfile *fptr, I - FITS file pointer */
1118
/* int exclude_comm, I - if TRUE, exclude commentary keywords */
1119
/* char **exclist, I - list of excluded keyword names */
1120
/* int nexc, I - number of names in exclist */
1121
/* char **header, O - returned header string */
1122
/* int *nkeys, O - returned number of 80-char keywords */
1123
/* int *status) IO - error status */
1124
1125
if ( ffhdr2str(curFile->fptr, 1, (char **)NULL, 0, &header, &nkeys, &status) > 0 ) {
1126
Tcl_SetResult(curFile->interp, "Failed to collect all the headers.", TCL_STATIC);
1127
return TCL_ERROR;
1128
}
1129
1130
Tcl_ListObjAppendElement( curFile->interp, listObj, Tcl_NewStringObj(header, -1));
1131
Tcl_ListObjAppendElement( curFile->interp, listObj, Tcl_NewIntObj( nkeys ) );
1132
Tcl_SetObjResult(curFile->interp, listObj);
1133
1134
free( header);
1135
return TCL_OK;
1136
1137
} else if( !strcmp("imgwcs", argv[2]) ) {
1138
1139
/* Get IMGWCS */
1140
1141
if ( curFile->hduType != IMAGE_HDU ) {
1142
Tcl_SetResult(curFile->interp,
1143
"Current extension is not an image", TCL_STATIC);
1144
return TCL_ERROR;
1145
}
1146
1147
if( fitsGetWcsPair(curFile,0,0,'\0') != TCL_OK ) {
1148
return TCL_ERROR;
1149
}
1150
1151
} else if( !strcmp("colwcs", argv[2]) ) {
1152
1153
/* Get COLWCS */
1154
1155
int ranum = 0;
1156
int decnum = 0;
1157
1158
if( curFile->hduType == IMAGE_HDU ) {
1159
Tcl_SetResult(curFile->interp,
1160
"Current extension is not a table", TCL_STATIC);
1161
return TCL_ERROR;
1162
}
1163
if( argc != 5 ) {
1164
Tcl_SetResult(curFile->interp,
1165
"get colwcs RAcol DECcol", TCL_STATIC);
1166
return TCL_ERROR;
1167
}
1168
1169
if( Tcl_GetInt(curFile->interp, argv[3], &ranum) != TCL_OK ) {
1170
Tcl_ResetResult(curFile->interp);
1171
if( fitsTransColList( curFile, argv[3],
1172
&numCols, colNums, colTypes, strSize)
1173
!= TCL_OK ) {
1174
Tcl_SetResult(curFile->interp,
1175
"Unable to read RAcol", TCL_STATIC);
1176
return TCL_ERROR;
1177
}
1178
if( numCols != 1 ) {
1179
Tcl_SetResult(curFile->interp,
1180
"Can only have 1 RAcol value", TCL_STATIC);
1181
return TCL_ERROR;
1182
}
1183
ranum = colNums[0];
1184
}
1185
1186
if( Tcl_GetInt(curFile->interp, argv[4], &decnum) != TCL_OK ) {
1187
Tcl_ResetResult(curFile->interp);
1188
if( fitsTransColList( curFile, argv[4],
1189
&numCols, colNums, colTypes, strSize)
1190
!= TCL_OK ) {
1191
Tcl_SetResult(curFile->interp,
1192
"Unable to read DecCol", TCL_STATIC);
1193
return TCL_ERROR;
1194
}
1195
if( numCols != 1 ) {
1196
Tcl_SetResult(curFile->interp,
1197
"Can only have 1 DecCol value", TCL_STATIC);
1198
return TCL_ERROR;
1199
}
1200
decnum = colNums[0];
1201
}
1202
1203
if( fitsTableGetWcsOld(curFile, ranum, decnum) != TCL_OK ) {
1204
return TCL_ERROR;
1205
}
1206
1207
} else if( !strcmp("image", argv[2]) ) {
1208
1209
long fElem, nElem;
1210
1211
if( argc < 3 || argc > 5 ) {
1212
Tcl_SetResult(curFile->interp,
1213
"get image firstElem numElem", TCL_STATIC);
1214
return TCL_ERROR;
1215
}
1216
1217
if( curFile->hduType != IMAGE_HDU ) {
1218
Tcl_SetResult(curFile->interp,
1219
"Current extension is not a table", TCL_STATIC);
1220
return TCL_ERROR;
1221
}
1222
1223
if( argc>3 ) {
1224
fElem = atol( argv[3] );
1225
if( argc>4 ) {
1226
nElem = atol( argv[4] );
1227
} else {
1228
nElem = 1;
1229
}
1230
} else {
1231
fElem = 1;
1232
nElem = 1;
1233
i = curFile->CHDUInfo.image.naxes;
1234
while( i-- )
1235
nElem *= curFile->CHDUInfo.image.naxisn[i];
1236
}
1237
1238
if( imageBlockLoad_1D(curFile, fElem, nElem) != TCL_OK ) {
1239
return TCL_ERROR;
1240
}
1241
1242
} else if ( !strcmp("imageblock", argv[2]) ) {
1243
1244
/* GET IMAGE in blocks */
1245
1246
long slice = 1;
1247
long cslice = 1;
1248
1249
if( argc < 8 || argc > 10 ) {
1250
Tcl_SetResult(curFile->interp,
1251
"FitsHandle get imageblock arrayName firstRow "
1252
"numRows firstCol numCols ?2D image slice? ?cube slice?", TCL_STATIC);
1253
return TCL_ERROR;
1254
}
1255
1256
if( curFile->hduType != IMAGE_HDU ) {
1257
Tcl_SetResult(curFile->interp,
1258
"Current extension is not an image.", TCL_STATIC);
1259
return TCL_ERROR;
1260
}
1261
1262
if( argc > 8 )
1263
slice = atol(argv[8]);
1264
1265
if( argc > 9 )
1266
cslice = atol(argv[9]);
1267
1268
if( imageBlockLoad(curFile, argv[3], atoll(argv[4]), atoll(argv[5]),
1269
atoll(argv[6]), atoll(argv[7]), slice, cslice )
1270
!= TCL_OK ) {
1271
return TCL_ERROR; /* Sets own error message */
1272
}
1273
1274
} else if( !strcmp("table",argv[2] ) ) {
1275
1276
int idx, format;
1277
1278
/* GET TABLE */
1279
1280
if ( curFile->hduType == IMAGE_HDU ) {
1281
Tcl_SetResult(curFile->interp,
1282
"Current extension is not a table", TCL_STATIC);
1283
return TCL_ERROR;
1284
}
1285
1286
if( curFile->CHDUInfo.table.loadStatus != 1 ) {
1287
Tcl_SetResult(curFile->interp,
1288
"Need to load the hdu first", TCL_STATIC);
1289
return TCL_ERROR;
1290
}
1291
1292
/*
1293
* Strip off the "-c" flag if present...
1294
*/
1295
1296
bycol = 0;
1297
format = 1;
1298
idx = 3;
1299
while( idx < argc && argv[idx][0]=='-' ) {
1300
if( !strcmp(argv[idx],"-c") ) {
1301
bycol = 1;
1302
} else if( !strcmp(argv[idx],"-noformat") ) {
1303
format = 0;
1304
} else {
1305
break;
1306
}
1307
idx++;
1308
}
1309
1310
if( argc-idx > 2 ) {
1311
Tcl_SetResult(curFile->interp,
1312
"Wrong number of arguments, need "
1313
"'get table ?-c? ?-noformat? ?columns? ?rows?'",
1314
TCL_STATIC);
1315
return TCL_ERROR;
1316
}
1317
1318
/* If no colList is given, or it is "*", use all the columns... */
1319
1320
if( TCL_OK !=
1321
fitsTransColList( curFile, ( argc==idx ? "*" : argv[idx] ),
1322
&numCols, colNums, colTypes, strSize) )
1323
return TCL_ERROR;
1324
1325
/*
1326
* Get the Row range parameter
1327
*/
1328
1329
idx++;
1330
if( argc <= idx ) {
1331
numRange = 1;
1332
range = (int*) malloc(numRange*2*sizeof(int));
1333
range[0] = 1;
1334
range[1] = curFile->CHDUInfo.table.numRows;
1335
} else {
1336
numRange =fitsParseRangeNum(argv[idx])+1;
1337
range = (int*) malloc(numRange*2*sizeof(int));
1338
if( fitsParseRange( argv[idx], &numRange, range, numRange,
1339
1, curFile->CHDUInfo.table.numRows, errMsg )
1340
!= TCL_OK ) {
1341
Tcl_SetResult(curFile->interp,
1342
"Error parsing row range:\n", TCL_STATIC);
1343
Tcl_AppendResult(curFile->interp, errMsg, (char*)NULL);
1344
return TCL_ERROR;
1345
}
1346
}
1347
1348
/* Now get the rows... */
1349
1350
if ( bycol ) {
1351
listArray = (Tcl_Obj**) ckalloc( numCols * sizeof(Tcl_Obj*) );
1352
for( k=0; k<numCols; k++ )
1353
listArray[k] = Tcl_NewListObj( 0, NULL );
1354
} else {
1355
valArray = (Tcl_Obj**) ckalloc( numCols * sizeof(Tcl_Obj*) );
1356
listObj = Tcl_NewListObj( 0, NULL );
1357
}
1358
1359
for (i = 0; i < numRange; i++ ) {
1360
fRow = range[i*2];
1361
while( fRow <= range[i*2+1] ) {
1362
ntodo = range[i*2+1] - fRow + 1;
1363
if( ntodo>FITS_CHUNKSIZE ) ntodo = FITS_CHUNKSIZE;
1364
status = tableBlockLoad( curFile, "", 1, fRow, ntodo,
1365
-99, numCols, colNums, format );
1366
1367
if( status != TCL_OK )
1368
break;
1369
fRow += ntodo;
1370
1371
resObj = Tcl_GetObjResult( curFile->interp );
1372
if ( bycol ) {
1373
for( k = 0; k < numCols; k++) {
1374
Tcl_ListObjIndex( curFile->interp, resObj,
1375
k, &listObj );
1376
Tcl_ListObjAppendList( curFile->interp,
1377
listArray[k],
1378
listObj );
1379
}
1380
} else {
1381
Tcl_ListObjGetElements( curFile->interp, resObj,
1382
&n, &listArray );
1383
for ( l = 0; l < ntodo; l++) {
1384
for( k = 0; k < numCols; k++) {
1385
Tcl_ListObjIndex( curFile->interp, listArray[k], l,
1386
valArray+k );
1387
}
1388
Tcl_ListObjAppendElement( curFile->interp, listObj,
1389
Tcl_NewListObj(numCols, valArray) );
1390
}
1391
}
1392
}
1393
}
1394
1395
if( status ) {
1396
1397
if ( bycol ) {
1398
ckfree( (char*) listArray );
1399
} else {
1400
ckfree( (char*) valArray );
1401
}
1402
1403
} else {
1404
1405
if ( bycol ) {
1406
Tcl_SetObjResult( curFile->interp,
1407
Tcl_NewListObj( numCols, listArray ) );
1408
} else {
1409
Tcl_SetObjResult( curFile->interp, listObj );
1410
}
1411
1412
}
1413
1414
if( status ) return TCL_ERROR;
1415
1416
} else if( !strcmp("vtable",argv[2]) ) {
1417
1418
int idx, format;
1419
1420
/* GET vector from the TABLE */
1421
1422
if( curFile->hduType == IMAGE_HDU ) {
1423
Tcl_SetResult(curFile->interp,
1424
"Current extension is not a table", TCL_STATIC);
1425
return TCL_ERROR;
1426
}
1427
1428
if( curFile->CHDUInfo.table.loadStatus != 1 ){
1429
Tcl_SetResult(curFile->interp,
1430
"Need to load the hdu first", TCL_STATIC);
1431
return TCL_ERROR;
1432
}
1433
1434
idx = 3;
1435
format = 1;
1436
if( idx<argc && !strcmp("-noformat",argv[idx]) ) {
1437
format = 0;
1438
idx++;
1439
}
1440
1441
if( argc-idx < 2 ) {
1442
Tcl_SetResult(curFile->interp,
1443
"Wrong number of arguments, need "
1444
"'get vtable ?-noformat? column felem ?rowList?'",
1445
TCL_STATIC);
1446
return TCL_ERROR;
1447
}
1448
1449
1450
if( fitsTransColList( curFile, argv[idx++],
1451
&numCols, colNums, colTypes, strSize )
1452
!= TCL_OK )
1453
return TCL_ERROR;
1454
if( numCols != 1 ) {
1455
Tcl_SetResult(curFile->interp,
1456
"Can only read one vector column of a table at a time",
1457
TCL_STATIC);
1458
return TCL_ERROR;
1459
}
1460
1461
felem = atoi(argv[idx++]);
1462
1463
/*
1464
* Get the Row range parameter
1465
*/
1466
1467
if( argc <= idx ) {
1468
numRange = 1;
1469
range = (int*) malloc(numRange*2*sizeof(int));
1470
range[0] = 1;
1471
range[1] = curFile->CHDUInfo.table.numRows;
1472
} else {
1473
numRange = fitsParseRangeNum(argv[idx])+1;
1474
range = (int*) malloc(numRange*2*sizeof(int));
1475
if( fitsParseRange( argv[idx++], &numRange, range, numRange,
1476
1, curFile->CHDUInfo.table.numRows, errMsg )
1477
!= TCL_OK ) {
1478
Tcl_SetResult(curFile->interp,
1479
"Error parsing row range:\n", TCL_STATIC);
1480
Tcl_AppendResult(curFile->interp, errMsg, (char*)NULL);
1481
return TCL_ERROR;
1482
}
1483
}
1484
1485
/* Now get the rows... */
1486
1487
listObj = Tcl_NewListObj( 0, NULL );
1488
1489
for (i = 0; i < numRange; i++ ) {
1490
fRow = range[i*2];
1491
while( fRow <= range[i*2+1] ) {
1492
ntodo = range[i*2+1] - fRow + 1;
1493
if( ntodo>FITS_CHUNKSIZE ) ntodo = FITS_CHUNKSIZE;
1494
1495
if( tableBlockLoad( curFile, "", felem, fRow, ntodo,
1496
-99, numCols, colNums, format ) != TCL_OK )
1497
return TCL_ERROR;
1498
1499
fRow += ntodo;
1500
if( Tcl_ListObjIndex( curFile->interp,
1501
Tcl_GetObjResult( curFile->interp ), 0,
1502
&resObj )
1503
!= TCL_OK )
1504
return TCL_ERROR;
1505
if( Tcl_ListObjAppendList( curFile->interp, listObj, resObj )
1506
!= TCL_OK )
1507
return TCL_ERROR;
1508
}
1509
}
1510
1511
Tcl_SetObjResult( curFile->interp, listObj );
1512
1513
} else {
1514
1515
Tcl_SetResult(curFile->interp,
1516
"ERROR: unrecognized command to get", TCL_STATIC);
1517
return TCL_ERROR;
1518
1519
}
1520
1521
if (range) free(range);
1522
return TCL_OK;
1523
}
1524
1525
1526
/******************************************************************
1527
* Put
1528
******************************************************************/
1529
1530
int fitsTcl_put( FitsFD *curFile, int argc, Tcl_Obj *const argv[] )
1531
{
1532
static char *putKeyList = "put keyword ?-num n? card ?formatFlag?";
1533
static char *putHisList = "put history string";
1534
static char *putTabList =
1535
"put table colName firstElem rowSpan listOfData\n";
1536
1537
static char *putImgList = "put image firstElem listOfData\n";
1538
1539
static char *putIhdList =
1540
"put ihd ?-p? ?bitpix naxis naxesList? \n"
1541
" - -p primary extension \n";
1542
1543
static char *putAhdList =
1544
"put ahd numRows numCols {colName} {colType} {colUnit} {tbCol}\n"
1545
" extname rowLength\n"
1546
" - colType: L(logical), X(bit), I(16 bit integer), "
1547
"J(32 bit integer)\n"
1548
" An(n Character), En(Single with n format), \n"
1549
" Dn(Double with n format), B(Unsigned) \n"
1550
" C(Complex), M(Double complex) ";
1551
1552
static char *putBhdList =
1553
"put bhd numRows numCols {colName} {colType} {colUnit} extname \n"
1554
" - colType: nL(logical),nX(bit), nI(16 bit integer), "
1555
"nJ(32 bit integer)\n"
1556
" nA(Character), nE(Single), nD(Double), nB(Unsigned) \n"
1557
" nC(Complex), M(Double complex) ";
1558
1559
int numCols,colNums[FITS_COLMAX],colTypes[FITS_COLMAX],strSize[FITS_COLMAX];
1560
int numRange, *range=NULL;
1561
char errMsg[256], *argStr, *cmd, **args;
1562
int i;
1563
1564
if ( argc == 2 ) {
1565
Tcl_SetResult(curFile->interp,"Available Commands:\n",TCL_STATIC);
1566
Tcl_AppendResult(curFile->interp, putKeyList,"\n", (char *)NULL);
1567
Tcl_AppendResult(curFile->interp, putTabList,"\n", (char *)NULL);
1568
Tcl_AppendResult(curFile->interp, putIhdList,"\n", (char *)NULL);
1569
Tcl_AppendResult(curFile->interp, putAhdList,"\n", (char *)NULL);
1570
Tcl_AppendResult(curFile->interp, putBhdList,"\n", (char *)NULL);
1571
return TCL_OK;
1572
}
1573
1574
cmd = Tcl_GetStringFromObj( argv[2], NULL );
1575
if( !strcmp( "keyword", cmd ) ) {
1576
1577
/* Write Keyword */
1578
1579
int format, cardNum=0, recLoc=3;
1580
1581
if( argc < 4 || argc > 7 ) {
1582
Tcl_SetResult(curFile->interp, putKeyList, TCL_STATIC);
1583
return TCL_ERROR;
1584
}
1585
1586
if( !strcmp(Tcl_GetStringFromObj(argv[3],NULL), "-num") ) {
1587
if( argc < 6 ) {
1588
Tcl_SetResult(curFile->interp, putKeyList, TCL_STATIC);
1589
return TCL_ERROR;
1590
}
1591
if( Tcl_GetIntFromObj(curFile->interp, argv[4], &cardNum) != TCL_OK ) {
1592
return TCL_ERROR;
1593
}
1594
recLoc += 2;
1595
}
1596
1597
if( recLoc+1 < argc ) {
1598
if( Tcl_GetIntFromObj(curFile->interp, argv[recLoc+1], &format)
1599
!= TCL_OK ) {
1600
return TCL_ERROR;
1601
}
1602
} else {
1603
format = 1;
1604
}
1605
1606
if( fitsPutKwds(curFile, cardNum,
1607
Tcl_GetStringFromObj(argv[recLoc],NULL),
1608
format)
1609
!= TCL_OK ) {
1610
return TCL_ERROR;
1611
}
1612
1613
} else if( !strcmp( "history", cmd ) ) {
1614
1615
/* Write History */
1616
1617
if( argc != 4 ) {
1618
Tcl_SetResult(curFile->interp, putHisList, TCL_STATIC);
1619
return TCL_ERROR;
1620
}
1621
1622
if( fitsPutHisKwd(curFile, Tcl_GetStringFromObj(argv[3],NULL) )
1623
!= TCL_OK ) {
1624
return TCL_ERROR;
1625
}
1626
1627
} else if( !strcmp ( "image", cmd ) ) {
1628
1629
/* Write Image */
1630
1631
int nElem;
1632
long fElem;
1633
Tcl_Obj **dataList;
1634
1635
if( curFile->hduType != IMAGE_HDU ) {
1636
Tcl_SetResult(curFile->interp,
1637
"Current extension is not an image", TCL_STATIC);
1638
return TCL_ERROR;
1639
}
1640
if( argc < 5 || argc > 6 ) {
1641
Tcl_SetResult(curFile->interp, putImgList, TCL_STATIC);
1642
return TCL_ERROR;
1643
}
1644
1645
if( Tcl_GetLongFromObj(curFile->interp, argv[3], &fElem) != TCL_OK ) {
1646
return TCL_ERROR;
1647
}
1648
1649
/* Skip to last argument... can get nElem directly from data list */
1650
1651
if( Tcl_ListObjGetElements( curFile->interp, argv[argc-1],
1652
&nElem, &dataList ) != TCL_OK ) {
1653
return TCL_ERROR;
1654
}
1655
1656
if( varSaveToImage( curFile, fElem, (long)nElem, dataList ) != TCL_OK ) {
1657
return TCL_ERROR;
1658
}
1659
1660
} else if( !strcmp( "table", cmd ) ) {
1661
1662
/* Write Table */
1663
1664
int nElem;
1665
long fElem;
1666
Tcl_Obj **dataElems;
1667
1668
if ( curFile->hduType == IMAGE_HDU ) {
1669
Tcl_SetResult(curFile->interp,
1670
"Current extension is not a table", TCL_STATIC);
1671
return TCL_ERROR;
1672
}
1673
1674
if ( argc != 7 ) {
1675
Tcl_SetResult(curFile->interp, putTabList, TCL_STATIC);
1676
return TCL_ERROR;
1677
}
1678
1679
/* parse the column name */
1680
1681
if( fitsTransColList(curFile, Tcl_GetStringFromObj(argv[3],NULL),
1682
&numCols,colNums,colTypes,strSize) != TCL_OK ) {
1683
return TCL_ERROR;
1684
}
1685
if( numCols != 1 ) {
1686
Tcl_SetResult(curFile->interp,
1687
"Can only write one column at a time", TCL_STATIC);
1688
return TCL_ERROR;
1689
}
1690
1691
/*
1692
* Get the Row range parameter
1693
*/
1694
1695
argStr = Tcl_GetStringFromObj( argv[5], NULL );
1696
numRange =fitsParseRangeNum(argStr)+1;
1697
range =(int*) malloc(numRange*2*sizeof(int));
1698
if( fitsParseRange(argStr,&numRange,range,numRange,
1699
1, curFile->CHDUInfo.table.numRows,errMsg)
1700
!= TCL_OK ) {
1701
Tcl_SetResult(curFile->interp,
1702
"Error parsing row range:\n", TCL_STATIC);
1703
Tcl_AppendResult(curFile->interp, errMsg, (char*)NULL);
1704
return TCL_ERROR;
1705
}
1706
if( numRange != 1 ) {
1707
Tcl_SetResult(curFile->interp,
1708
"Can only write one row range at a time", TCL_STATIC);
1709
return TCL_ERROR;
1710
}
1711
1712
if( Tcl_GetLongFromObj(curFile->interp,argv[4],&fElem) != TCL_OK ) {
1713
return TCL_ERROR;
1714
}
1715
1716
if ( Tcl_ListObjGetElements( curFile->interp, argv[6],
1717
&nElem, &dataElems ) != TCL_OK ) {
1718
return TCL_ERROR;
1719
}
1720
1721
if( varSaveToTable(curFile,
1722
colNums[0],
1723
range[0],
1724
fElem,
1725
range[1]-range[0]+1,
1726
(long)nElem,
1727
dataElems ) != TCL_OK ) {
1728
return TCL_ERROR;
1729
}
1730
1731
} else if( !strcmp( "ihd", cmd ) ) {
1732
1733
/* Write Image Header */
1734
1735
int isPrimary;
1736
if ( argc < 4 || argc > 7 ) {
1737
Tcl_SetResult(curFile->interp, putIhdList, TCL_STATIC);
1738
return TCL_ERROR;
1739
}
1740
1741
if( !strcmp( ARGV_STR(3), "-p" ) ) {
1742
isPrimary = 1;
1743
} else {
1744
isPrimary = 0;
1745
}
1746
1747
args = (char **) ckalloc( argc * sizeof(char *) );
1748
for( i=0; i<argc; i++ ) {
1749
args[i] = ARGV_STR(i);
1750
}
1751
1752
if( fitsPutReqKwds(curFile, isPrimary, IMAGE_HDU,
1753
argc-3-isPrimary, args+3+isPrimary)
1754
!=TCL_OK ) {
1755
ckfree( (char*)args );
1756
return TCL_ERROR;
1757
}
1758
ckfree( (char*)args );
1759
1760
} else if( !strcmp( "ahd", cmd ) ) {
1761
1762
/* Write ASCII Table Header */
1763
1764
char const *newArg[7];
1765
int j;
1766
1767
if( argc != 11 ) {
1768
Tcl_SetResult(curFile->interp, putAhdList, TCL_STATIC);
1769
return TCL_ERROR;
1770
}
1771
1772
/* Strip out the numCols[4] parameter... use colNames length instead */
1773
1774
for( j=0,i=3; i<11; i++ ) {
1775
if( i!=4 )
1776
newArg[j++] = ARGV_STR(i);
1777
}
1778
1779
if( fitsPutReqKwds(curFile, 0, ASCII_TBL, 7, (char **)newArg)
1780
!= TCL_OK ) {
1781
return TCL_ERROR;
1782
}
1783
1784
} else if( !strcmp( "bhd", cmd ) ) {
1785
1786
/* Write Binary Table Header */
1787
1788
char const *newArg[5];
1789
int j;
1790
1791
if( argc != 9 ) {
1792
Tcl_SetResult(curFile->interp, putBhdList, TCL_STATIC);
1793
return TCL_ERROR;
1794
}
1795
1796
/* Strip out the numCols[4] parameter... use colNames length instead */
1797
1798
for( j=0,i=3; i<9; i++ ) {
1799
if( i!=4 )
1800
newArg[j++] = ARGV_STR(i);
1801
}
1802
1803
if( fitsPutReqKwds(curFile, 0, BINARY_TBL, 5, (char **)newArg)
1804
!= TCL_OK ) {
1805
return TCL_ERROR;
1806
}
1807
1808
} else {
1809
1810
Tcl_SetResult(curFile->interp, "Unknown put function", TCL_STATIC);
1811
return TCL_ERROR;
1812
1813
}
1814
1815
if (range) free(range);
1816
return TCL_OK;
1817
}
1818
1819
1820
/******************************************************************
1821
* Insert
1822
******************************************************************/
1823
1824
int fitsTcl_insert( FitsFD *curFile, int argc, char *const argv[] )
1825
{
1826
static char *insertList[] = {
1827
"insert keyword index record ?formatflag?",
1828
"insert column index colName colForm",
1829
"insert row index numRows",
1830
"insert image ?-p? ?bitpix naxis naxesList? \n"
1831
" - -p primary extension, keywords optional if empty array",
1832
"insert table numRows {colNames} {colForms} ?{colUnits} extname?\n"
1833
" - colForm: nL(logical),nX(bit), nI(16 bit integer), "
1834
"nJ(32 bit integer)\n"
1835
" nA(Character), nE(Single), nD(Double), nB(Unsigned) \n"
1836
" nC(Complex), M(Double complex) \n"
1837
"insert table -ascii numRows {colNames} {colForms} ?{colUnits}\n"
1838
" {tbCols} extname rowWidth?\n"
1839
" - colForm: L(logical), X(bit), I(16 bit integer), "
1840
"J(32 bit integer)\n"
1841
" An(n Character), En(Single with n format), \n"
1842
" Dn(Double with n format), B(Unsigned) \n"
1843
" C(Complex), M(Double complex) " };
1844
1845
int index, format, numRows, i;
1846
1847
if( argc == 2 ) {
1848
Tcl_AppendResult(curFile->interp,
1849
"Available commands:\n",
1850
insertList[0], "\n",
1851
insertList[1], "\n",
1852
insertList[2], "\n",
1853
insertList[3], "\n",
1854
insertList[4], "\n",
1855
(char *)NULL);
1856
return TCL_ERROR;
1857
}
1858
1859
if( !strcmp( "keyword", argv[2] ) ) {
1860
1861
if( argc < 5 || argc > 6 ) {
1862
Tcl_SetResult(curFile->interp, insertList[0], TCL_STATIC);
1863
return TCL_OK;
1864
}
1865
1866
if( Tcl_GetInt(curFile->interp, argv[3], &index) != TCL_OK) {
1867
Tcl_SetResult(curFile->interp,
1868
"Failed to get integer index", TCL_STATIC);
1869
return TCL_ERROR;
1870
}
1871
1872
if( argc==6 ) {
1873
if ( Tcl_GetInt(curFile->interp, argv[5], &format) != TCL_OK) {
1874
Tcl_SetResult(curFile->interp,
1875
"Failed to get integer format flag", TCL_STATIC);
1876
return TCL_ERROR;
1877
}
1878
} else {
1879
format = 1;
1880
}
1881
1882
if( fitsInsertKwds(curFile, index, argv[4], format) != TCL_OK ) {
1883
return TCL_ERROR;
1884
}
1885
1886
} else if( !strcmp( "column", argv[2] ) ) {
1887
1888
if (argc != 6 ) {
1889
Tcl_SetResult(curFile->interp, insertList[1], TCL_STATIC);
1890
return TCL_ERROR;
1891
}
1892
1893
if( Tcl_GetInt(curFile->interp, argv[3], &index) != TCL_OK) {
1894
Tcl_SetResult(curFile->interp,
1895
"Failed to get integer index", TCL_STATIC);
1896
return TCL_ERROR;
1897
}
1898
1899
if( addColToTable(curFile,index,argv[4],argv[5]) != TCL_OK ) {
1900
return TCL_ERROR;
1901
}
1902
1903
} else if( !strcmp( "row", argv[2] ) ) {
1904
1905
if( argc != 5 ) {
1906
Tcl_SetResult(curFile->interp, insertList[2], TCL_STATIC);
1907
return TCL_ERROR;
1908
}
1909
1910
if( Tcl_GetInt(curFile->interp, argv[3], &index) != TCL_OK) {
1911
Tcl_SetResult(curFile->interp,
1912
"Failed to get integer index", TCL_STATIC);
1913
return TCL_ERROR;
1914
}
1915
1916
if( Tcl_GetInt(curFile->interp, argv[4], &numRows) != TCL_OK) {
1917
Tcl_SetResult(curFile->interp,
1918
"Failed to get integer numRows", TCL_STATIC);
1919
return TCL_ERROR;
1920
}
1921
if( addRowToTable(curFile,index-1,numRows) != TCL_OK ) {
1922
return TCL_ERROR;
1923
}
1924
1925
} else if( !strcmp( "image", argv[2] ) ) {
1926
1927
/* Write Image Header */
1928
1929
int isPrimary;
1930
if ( argc < 4 || argc > 7 ) {
1931
Tcl_SetResult(curFile->interp, insertList[3], TCL_STATIC);
1932
return TCL_ERROR;
1933
}
1934
1935
/*
1936
* Strip off the "-p" flag if present...
1937
*/
1938
1939
if( !strcmp(argv[3],"-p") ) {
1940
isPrimary = 1;
1941
} else {
1942
isPrimary = 0;
1943
}
1944
1945
if( fitsPutReqKwds(curFile, isPrimary, IMAGE_HDU,
1946
argc-3-isPrimary, argv+3+isPrimary)
1947
!=TCL_OK ) {
1948
return TCL_ERROR;
1949
}
1950
1951
} else if( !strcmp( "table", argv[2] ) ) {
1952
1953
/* Write Table Header */
1954
1955
int tabType;
1956
1957
if( argc>3 && !strcmp( "-ascii", argv[3] ) ) {
1958
1959
tabType = ASCII_TBL;
1960
if( argc < 7 || argc > 11 ) {
1961
Tcl_SetResult(curFile->interp, insertList[4], TCL_STATIC);
1962
return TCL_ERROR;
1963
}
1964
1965
} else {
1966
1967
tabType = BINARY_TBL;
1968
if( argc < 6 || argc > 8 ) {
1969
Tcl_SetResult(curFile->interp, insertList[4], TCL_STATIC);
1970
return TCL_ERROR;
1971
}
1972
1973
}
1974
1975
if( fitsPutReqKwds(curFile, 0, tabType,
1976
argc-3-(tabType==ASCII_TBL?1:0),
1977
argv+3+(tabType==ASCII_TBL?1:0))
1978
!= TCL_OK ) {
1979
return TCL_ERROR;
1980
}
1981
1982
} else {
1983
1984
Tcl_SetResult(curFile->interp, "No such insert command", TCL_STATIC);
1985
return TCL_ERROR;
1986
1987
}
1988
1989
return TCL_OK;
1990
}
1991
1992
/******************************************************************
1993
* Select
1994
******************************************************************/
1995
1996
int fitsTcl_select( FitsFD *curFile, int argc, char *const argv[] )
1997
{
1998
1999
static char *selRowList =
2000
"select rows -expr expression firstrow nrow\n ";
2001
2002
int numCols,colNums[FITS_COLMAX],colTypes[FITS_COLMAX],strSize[FITS_COLMAX];
2003
int fRow, nRows;
2004
char * row_status;
2005
long n_good_rows;
2006
int i;
2007
char result[32];
2008
Tcl_Obj *valObj, *listObj;
2009
2010
2011
if( argc == 2 ) {
2012
Tcl_AppendResult(curFile->interp, selRowList,(char *) NULL);
2013
return TCL_OK;
2014
}
2015
2016
2017
if( !strcmp("rows", argv[2]) ) {
2018
2019
if( argc != 7 ) {
2020
Tcl_SetResult(curFile->interp, selRowList, TCL_STATIC);
2021
return TCL_ERROR;
2022
}
2023
2024
if( !strcmp("-expr", argv[3]) ) {
2025
if( Tcl_GetInt(curFile->interp, argv[5], &fRow) != TCL_OK ) {
2026
return TCL_ERROR;
2027
}
2028
if( Tcl_GetInt(curFile->interp, argv[6], &nRows) != TCL_OK ) {
2029
return TCL_ERROR;
2030
}
2031
row_status = (char*) malloc((nRows+1)*sizeof(char));
2032
listObj = Tcl_NewObj();
2033
2034
if( fitsSelectRowsExpr(curFile, argv[4], fRow,nRows, &n_good_rows,row_status) == TCL_OK ) {
2035
/* for ( i=0 ; i< nRows; i++ ) {
2036
# if ( row_status[i] == 1 ) {
2037
# sprintf(result,"%d",i+fRow);
2038
# Tcl_AppendElement(curFile->interp,result);
2039
# }
2040
# }*/
2041
if (n_good_rows ) {
2042
for (i=0; i < nRows; i++) {
2043
if ( row_status[i] == 1 ) {
2044
valObj = Tcl_NewLongObj( i+fRow );
2045
Tcl_ListObjAppendElement( curFile->interp, listObj, valObj);
2046
}
2047
}
2048
Tcl_SetObjResult( curFile->interp, listObj);
2049
}
2050
2051
}
2052
else {
2053
if(row_status) free(row_status);
2054
return TCL_ERROR;
2055
}
2056
} else {
2057
Tcl_SetResult(curFile->interp, selRowList, TCL_STATIC);
2058
return TCL_ERROR;
2059
}
2060
2061
} else {
2062
Tcl_SetResult(curFile->interp,
2063
"Unrecognized option to select", TCL_STATIC);
2064
return TCL_ERROR;
2065
2066
}
2067
2068
2069
if(row_status) free(row_status);
2070
return TCL_OK;
2071
}
2072
2073
2074
2075
/******************************************************************
2076
* Delete
2077
******************************************************************/
2078
2079
int fitsTcl_delete( FitsFD *curFile, int argc, char *const argv[] )
2080
{
2081
static char *delKeyList =
2082
"delete keyword KeyList\n"
2083
" (KeyList can be a mix of keyword names and keyword numbers\n";
2084
2085
static char *delHduList =
2086
"delete chdu\n";
2087
2088
static char *delTabList =
2089
"delete cols colList\n ";
2090
2091
static char *delRowList =
2092
"delete rows -expr expression\n "
2093
"delete rows -range rangelist\n "
2094
"delete rows firstRow numRows\n ";
2095
2096
int numCols,colNums[FITS_COLMAX],colTypes[FITS_COLMAX],strSize[FITS_COLMAX];
2097
int fRow, nRows;
2098
2099
if( argc == 2 ) {
2100
Tcl_AppendResult(curFile->interp, delKeyList, delHduList, delTabList,
2101
delRowList, (char *) NULL);
2102
return TCL_OK;
2103
}
2104
2105
if( !strcmp("keyword", argv[2]) ) {
2106
2107
if( argc != 4 ) {
2108
Tcl_SetResult(curFile->interp, delKeyList, TCL_STATIC);
2109
return TCL_ERROR;
2110
}
2111
2112
if( fitsDeleteKwds(curFile, argv[3] ) != TCL_OK ) {
2113
return TCL_ERROR;
2114
}
2115
2116
} else if( !strcmp("cols", argv[2]) ) {
2117
2118
if( argc != 4 ) {
2119
Tcl_SetResult(curFile->interp, delTabList, TCL_STATIC);
2120
return TCL_ERROR;
2121
}
2122
if( fitsTransColList( curFile,argv[3],
2123
&numCols,colNums,colTypes,strSize) != TCL_OK )
2124
return TCL_ERROR;
2125
2126
if( fitsDeleteCols(curFile, colNums, numCols) != TCL_OK ) {
2127
return TCL_ERROR;
2128
}
2129
2130
} else if( !strcmp("rows", argv[2]) ) {
2131
2132
if( argc != 5 ) {
2133
Tcl_SetResult(curFile->interp, delRowList, TCL_STATIC);
2134
return TCL_ERROR;
2135
}
2136
2137
if( !strcmp("-expr", argv[3]) ) {
2138
if( fitsDeleteRowsExpr(curFile, argv[4]) != TCL_OK ) {
2139
return TCL_ERROR;
2140
}
2141
} else if (!strcmp("-range", argv[3]) ) {
2142
if( fitsDeleteRowsRange(curFile, argv[4]) != TCL_OK ) {
2143
return TCL_ERROR;
2144
}
2145
}
2146
else {
2147
if( Tcl_GetInt(curFile->interp, argv[3], &fRow) != TCL_OK ) {
2148
return TCL_ERROR;
2149
}
2150
if( Tcl_GetInt(curFile->interp, argv[4], &nRows) != TCL_OK ) {
2151
return TCL_ERROR;
2152
}
2153
if( fitsDeleteRows(curFile, fRow, nRows) != TCL_OK ) {
2154
return TCL_ERROR;
2155
}
2156
}
2157
2158
} else if( !strcmp("chdu", argv[2]) ) {
2159
2160
if( argc != 3 ) {
2161
Tcl_SetResult(curFile->interp, delHduList, TCL_STATIC);
2162
return TCL_ERROR;
2163
}
2164
if( fitsDeleteCHdu(curFile) != TCL_OK ) {
2165
return TCL_ERROR;
2166
}
2167
2168
} else {
2169
2170
Tcl_SetResult(curFile->interp,
2171
"Unrecognized option to delete", TCL_STATIC);
2172
return TCL_ERROR;
2173
2174
}
2175
2176
return TCL_OK;
2177
}
2178
2179
2180
/******************************************************************
2181
* Load
2182
******************************************************************/
2183
2184
int fitsTcl_load( FitsFD *curFile, int argc, char *const argv[] )
2185
{
2186
static char *loadList = "\n"
2187
"load arrayRow colName ?defaultNull? ?firstElement? - Load a row\n"
2188
"load column colName ?defaultNull? ?firstElement? - Load a column\n"
2189
"load vtable colName - Load all elements of a vector column into memory\n"
2190
"load tblock arrayName colList firstRow numRows colIndex ?felem?\n"
2191
" - load a chunk of table and set up an array \"arrayName\"\n"
2192
" with indices of (colIndex-1,firstRow-1), etc \n"
2193
"load copyto filename taget\n"
2194
"load image ?slice? ?rotate? - Load a 2D slice of an image into memory\n"
2195
" (rotate: number of 90deg ccw rotations to perform)\n"
2196
"load irows firstRow lastRow ?slice? - load mean value of rows\n"
2197
"load icols firstCol lastCol ?slice? - load mean value of columns\n"
2198
"load iblock arrayName firstRow numRows fitsCol numCols ?slice?\n"
2199
" - load 2d image slice into an array or memory\n"
2200
" if arrayName is --, then a pointer is returned\n"
2201
"load expr expression ?defaultNull?\n"
2202
"load keyword - load the header of CHDU into a hash table \n"
2203
"load chdu - load the CHDU (useful if you move to the CHDU with -s,\n"
2204
" which does't load the HDUInfo) \n";
2205
2206
int numCols,colNums[FITS_COLMAX],colTypes[FITS_COLMAX],strSize[FITS_COLMAX];
2207
int fRow, nRows;
2208
int fCol, felem=1;
2209
2210
fitsfile *infptr, *outfptr; /* FITS file pointers defined in fitsio.h */
2211
int status = 0, ii = 1, iteration = 0, single = 0, hdupos;
2212
int hdutype, bitpix, bytepix, naxis = 0, nkeys, datatype = 0, anynul;
2213
long naxes[9] = {1, 1, 1, 1, 1, 1, 1, 1, 1};
2214
long first, totpix = 0, npix;
2215
double *array, bscale = 1.0, bzero = 0.0, nulval = 0.;
2216
char card[81];
2217
int i, j;
2218
2219
if( argc == 2 ) {
2220
Tcl_SetResult(curFile->interp, loadList, TCL_STATIC);
2221
return TCL_OK;
2222
}
2223
2224
if( !strcmp("keyword", argv[2]) ) {
2225
2226
/* Now LOAD the kwds hash table... */
2227
2228
if( fitsLoadKwds(curFile) != TCL_OK ) {
2229
fitsCloseFile((ClientData) curFile);
2230
return TCL_ERROR;
2231
}
2232
2233
} else if( !strcmp("irows", argv[2]) ) {
2234
2235
long slice;
2236
2237
if( curFile->hduType != IMAGE_HDU ) {
2238
Tcl_SetResult(curFile->interp,
2239
"Current extension is not an image", TCL_STATIC);
2240
return TCL_ERROR;
2241
}
2242
2243
if( argc < 5 ) {
2244
Tcl_SetResult(curFile->interp,
2245
"FitsHandle load irows firstRow lastRows ?slice?",
2246
TCL_STATIC);
2247
return TCL_ERROR;
2248
}
2249
2250
if( argc == 5 ) {
2251
slice = 1;
2252
} else {
2253
slice = atol(argv[5]);
2254
}
2255
2256
if( imageRowsMeanToPtr(curFile,
2257
atol(argv[3]), /* first row */
2258
atol(argv[4]), /* last row*/
2259
slice ) != TCL_OK ) {
2260
Tcl_AppendResult(curFile->interp,
2261
"fitsTcl Error: cannot load irows", NULL);
2262
return TCL_ERROR;
2263
}
2264
2265
} else if( !strcmp("icols", argv[2]) ) {
2266
2267
long slice;
2268
2269
if( curFile->hduType != IMAGE_HDU ) {
2270
Tcl_SetResult(curFile->interp,
2271
"Current extension is not an image", TCL_STATIC);
2272
return TCL_ERROR;
2273
}
2274
2275
if( argc < 5 ) {
2276
Tcl_SetResult(curFile->interp,
2277
"FitsHandle load icols firstCol lastCols ?slice?",
2278
TCL_STATIC);
2279
return TCL_ERROR;
2280
}
2281
2282
if( argc == 5 ) {
2283
slice = 1;
2284
} else {
2285
slice = atol(argv[5]);
2286
}
2287
2288
if( imageColsMeanToPtr(curFile, atol(argv[3]),
2289
atol(argv[4]), slice) != TCL_OK ) {
2290
Tcl_AppendResult(curFile->interp,
2291
"\nfitsTcl Error: cannot load icols",
2292
NULL);
2293
return TCL_ERROR;
2294
}
2295
2296
} else if( !strcmp("iblock", argv[2]) ) {
2297
2298
char *varName="\0";
2299
LONGLONG slice = 1;
2300
LONGLONG cslice = 1;
2301
2302
if ( curFile->hduType != IMAGE_HDU ) {
2303
Tcl_SetResult(curFile->interp,
2304
"Current extension is not an image", TCL_STATIC);
2305
return TCL_ERROR;
2306
}
2307
2308
if( argc < 8 || argc > 10 ) {
2309
Tcl_SetResult(curFile->interp,
2310
"FitsHandle load iblock varName firstRow numRows "
2311
"firstCol numCols ?slice?", TCL_STATIC);
2312
return TCL_ERROR;
2313
}
2314
2315
if( argc > 8 )
2316
slice = atoll(argv[8]);
2317
2318
if( argc > 9 )
2319
cslice = atoll(argv[9]);
2320
2321
if( strcmp( argv[3], "--" ) )
2322
varName = argv[3];
2323
2324
if( imageBlockLoad(curFile, varName, atoll(argv[4]),
2325
atoll(argv[5]), atoll(argv[6]),
2326
atoll(argv[7]), slice, cslice )
2327
!= TCL_OK ) {
2328
return TCL_ERROR;
2329
}
2330
2331
} else if( !strcmp("tblock", argv[2]) ) {
2332
2333
int format=1;
2334
int idx;
2335
int varIdx;
2336
2337
if ( curFile->hduType == IMAGE_HDU ) {
2338
Tcl_SetResult(curFile->interp,
2339
"Current extension is not a table", TCL_STATIC);
2340
return TCL_ERROR;
2341
}
2342
2343
if (argc < 8 || argc > 11) {
2344
Tcl_SetResult(curFile->interp,
2345
"Usage: load tblock ?-noformat? arrayName colList "
2346
"firstRow numRows firstCol ?felem?", TCL_STATIC);
2347
return TCL_ERROR;
2348
}
2349
2350
idx = 3;
2351
if( !strcmp("-noformat", argv[idx]) ) {
2352
idx++;
2353
format=0;
2354
}
2355
varIdx = idx++;
2356
2357
/* parse column list */
2358
2359
if( fitsTransColList( curFile,argv[idx++],
2360
&numCols,colNums,colTypes,strSize) != TCL_OK )
2361
return TCL_ERROR;
2362
2363
/* get the firstRow and numRows */
2364
2365
if( Tcl_GetInt(curFile->interp, argv[idx++], &fRow) != TCL_OK )
2366
return TCL_ERROR;
2367
if( Tcl_GetInt(curFile->interp, argv[idx++], &nRows) != TCL_OK )
2368
return TCL_ERROR;
2369
if( Tcl_GetInt(curFile->interp, argv[idx++], &fCol) != TCL_OK )
2370
return TCL_ERROR;
2371
2372
/* Skip a possible obsolete value between fCol and last argument */
2373
2374
if( argc>idx ) { /* Read felem from very last argument */
2375
if( Tcl_GetInt(curFile->interp, argv[argc-1], &felem) != TCL_OK )
2376
return TCL_ERROR;
2377
}
2378
2379
if( tableBlockLoad(curFile, argv[varIdx], felem, fRow, nRows,
2380
fCol, numCols, colNums, format) != TCL_OK )
2381
return TCL_ERROR;
2382
2383
} else if( !strcmp("image", argv[2]) ) {
2384
2385
long slice = 1;
2386
int rotate = 0;
2387
2388
if ( curFile->hduType != IMAGE_HDU ) {
2389
Tcl_SetResult(curFile->interp,
2390
"Current extension is not an image", TCL_STATIC);
2391
return TCL_ERROR;
2392
}
2393
2394
/* starting element, increment of naxisn[0] x naxisn[1]
2395
to get different frames of a 3d image */
2396
2397
if( argc == 3 ) {
2398
; /* default to the first frame to allow backward compatible */
2399
} else if( curFile->CHDUInfo.image.naxes <= 2 ) {
2400
; /* two-d image */
2401
} else {
2402
2403
slice = atol(argv[3]);
2404
if( slice < 1 ) {
2405
Tcl_SetResult(curFile->interp,
2406
"fitsTcl Error: slice starts at 1", TCL_STATIC);
2407
return TCL_ERROR;
2408
}
2409
/*
2410
if( slice > curFile->CHDUInfo.image.naxisn[2] ) {
2411
Tcl_SetResult(curFile->interp,
2412
"fitsTcl Error: slice exceeds the 3rd dim",
2413
TCL_STATIC);
2414
return TCL_ERROR;
2415
}
2416
*/
2417
2418
if( argc == 5 ) {
2419
rotate = atoi(argv[4]);
2420
if( rotate<0 || rotate>3 ) {
2421
Tcl_SetResult(curFile->interp,
2422
"fitsTcl Error: Illegal rotate value",
2423
TCL_STATIC);
2424
return TCL_ERROR;
2425
}
2426
}
2427
2428
}
2429
2430
if( imageGetToPtr(curFile, slice, rotate) != TCL_OK ) {
2431
return TCL_ERROR;
2432
}
2433
2434
2435
2436
} else if( !strcmp("copyto", argv[2]) ) {
2437
2438
/* Open the input file and create output file */
2439
fits_open_file(&infptr, argv[3], READONLY, &status);
2440
fits_create_file(&outfptr, argv[4], &status);
2441
2442
if (status != 0) {
2443
fits_report_error(stderr, status);
2444
return(status);
2445
}
2446
2447
fits_get_hdu_num(infptr, &hdupos); /* Get the current HDU position */
2448
2449
/* Copy only a single HDU if a specific extension was given */
2450
if (hdupos != 1 || strchr(argv[3], '[')) single = 1;
2451
2452
for (; !status; hdupos++) /* Main loop through each extension */
2453
{
2454
2455
fits_get_hdu_type(infptr, &hdutype, &status);
2456
2457
if (hdutype == IMAGE_HDU) {
2458
2459
/* get image dimensions and total number of pixels in image */
2460
for (ii = 0; ii < 9; ii++)
2461
naxes[ii] = 1;
2462
2463
fits_get_img_param(infptr, 9, &bitpix, &naxis, naxes, &status);
2464
2465
totpix = naxes[0] * naxes[1] * naxes[2] * naxes[3] * naxes[4]
2466
* naxes[5] * naxes[6] * naxes[7] * naxes[8];
2467
}
2468
2469
if (hdutype != IMAGE_HDU || naxis == 0 || totpix == 0) {
2470
2471
/* just copy tables and null images */
2472
fits_copy_hdu(infptr, outfptr, 0, &status);
2473
2474
} else {
2475
2476
/* Explicitly create new image, to support compression */
2477
fits_create_img(outfptr, bitpix, naxis, naxes, &status);
2478
2479
/* copy all the user keywords (not the structural keywords) */
2480
fits_get_hdrspace(infptr, &nkeys, NULL, &status);
2481
2482
for (ii = 1; ii <= nkeys; ii++) {
2483
fits_read_record(infptr, ii, card, &status);
2484
if (fits_get_keyclass(card) > TYP_CMPRS_KEY)
2485
fits_write_record(outfptr, card, &status);
2486
}
2487
2488
switch(bitpix) {
2489
case BYTE_IMG:
2490
datatype = TBYTE;
2491
break;
2492
case SHORT_IMG:
2493
datatype = TSHORT;
2494
break;
2495
case LONG_IMG:
2496
datatype = TLONG;
2497
break;
2498
case FLOAT_IMG:
2499
datatype = TFLOAT;
2500
break;
2501
case DOUBLE_IMG:
2502
datatype = TDOUBLE;
2503
break;
2504
case LONGLONG_IMG:
2505
datatype = TLONGLONG;
2506
break;
2507
}
2508
2509
bytepix = abs(bitpix) / 8;
2510
2511
npix = totpix;
2512
iteration = 0;
2513
2514
/* try to allocate memory for the entire image */
2515
/* use double type to force memory alignment */
2516
array = (double *) calloc(npix, bytepix);
2517
2518
/* if allocation failed, divide size by 2 and try again */
2519
while (!array && iteration < 10) {
2520
iteration++;
2521
npix = npix / 2;
2522
array = (double *) calloc(npix, bytepix);
2523
}
2524
2525
if (!array) {
2526
fprintf(stdout,"Memory allocation error\n");
2527
return(0);
2528
}
2529
2530
/* turn off any scaling so that we copy the raw pixel values */
2531
fits_set_bscale(infptr, bscale, bzero, &status);
2532
fits_set_bscale(outfptr, bscale, bzero, &status);
2533
first = 1;
2534
while (totpix > 0 && !status)
2535
{
2536
/* read all or part of image then write it back to the output file */
2537
fits_read_img(infptr, datatype, first, npix,
2538
&nulval, array, &anynul, &status);
2539
2540
fits_write_img(outfptr, datatype, first, npix, array, &status);
2541
totpix = totpix - npix;
2542
first = first + npix;
2543
}
2544
free(array);
2545
}
2546
2547
if (single) break; /* quit if only copying a single HDU */
2548
fits_movrel_hdu(infptr, 1, NULL, &status); /* try to move to next HDU */
2549
}
2550
2551
if (status == END_OF_FILE) status = 0; /* Reset after normal error */
2552
2553
fits_close_file(outfptr, &status);
2554
fits_close_file(infptr, &status);
2555
2556
} else if( !strcmp("arrayRow", argv[2]) ) {
2557
2558
char *nullPtr = "NULL";
2559
long rowNum;
2560
long nelem;
2561
2562
if( curFile->hduType == IMAGE_HDU ) {
2563
Tcl_SetResult(curFile->interp,
2564
"Current extension is not a table", TCL_STATIC);
2565
return TCL_ERROR;
2566
}
2567
2568
if( argc < 4 || argc > 8 ) {
2569
Tcl_SetResult(curFile->interp,
2570
"fitsObj load arrayRow colName rowNumber numElement ?nulValue? ?firstelem?",
2571
TCL_STATIC);
2572
return TCL_ERROR;
2573
}
2574
2575
if( fitsTransColList( curFile, argv[3],
2576
&numCols, colNums, colTypes, strSize ) != TCL_OK )
2577
return TCL_ERROR;
2578
2579
if( numCols != 1 ) {
2580
Tcl_SetResult(curFile->interp,
2581
"Can only load one column at a time", TCL_STATIC);
2582
return TCL_ERROR;
2583
}
2584
2585
rowNum = atol(argv[4]);
2586
nelem = atol(argv[5]);
2587
2588
if( argc>6 )
2589
nullPtr = argv[6];
2590
2591
if( argc>7 )
2592
felem = atol(argv[7]);
2593
2594
if( tableRowGetToPtr(curFile, rowNum, colNums[0], nelem, nullPtr, felem) ) {
2595
return TCL_ERROR;
2596
}
2597
2598
} else if( !strcmp("column", argv[2]) ) {
2599
2600
char *nullPtr = "NULL";
2601
2602
if( curFile->hduType == IMAGE_HDU ) {
2603
Tcl_SetResult(curFile->interp,
2604
"Current extension is not a table", TCL_STATIC);
2605
return TCL_ERROR;
2606
}
2607
2608
if( argc < 4 || argc > 6 ) {
2609
Tcl_SetResult(curFile->interp,
2610
"load column colName ?nulValue? ?firstelem?",
2611
TCL_STATIC);
2612
return TCL_ERROR;
2613
}
2614
2615
if( fitsTransColList( curFile, argv[3],
2616
&numCols, colNums, colTypes, strSize ) != TCL_OK )
2617
return TCL_ERROR;
2618
2619
if( numCols != 1 ) {
2620
Tcl_SetResult(curFile->interp,
2621
"Can only load one column at a time", TCL_STATIC);
2622
return TCL_ERROR;
2623
}
2624
2625
if( argc>4 )
2626
nullPtr = argv[4];
2627
2628
if( argc>5 )
2629
felem = atol(argv[5]);
2630
2631
if( tableGetToPtr(curFile, colNums[0], nullPtr, felem) ) {
2632
return TCL_ERROR;
2633
}
2634
2635
} else if( !strcmp("vtable", argv[2]) ) {
2636
2637
char *nullPtr = "NULL";
2638
2639
if ( curFile->hduType == IMAGE_HDU ) {
2640
Tcl_SetResult(curFile->interp,
2641
"Current extension is not a table", TCL_STATIC);
2642
return TCL_ERROR;
2643
}
2644
2645
if( argc < 4 || argc > 5 ) {
2646
/* For backwards compatibility, allow for one extra parameter */
2647
/* ... formerly the vector size of column */
2648
/* PDW 12/06/99: Sacrifice backwards compat for adding defNull*/
2649
Tcl_SetResult(curFile->interp,
2650
"load vtable colName ?nulValue?", TCL_STATIC);
2651
return TCL_ERROR;
2652
}
2653
2654
if( fitsTransColList( curFile,argv[3],
2655
&numCols,colNums,colTypes,strSize) != TCL_OK )
2656
return TCL_ERROR;
2657
if( numCols != 1 ) {
2658
Tcl_SetResult( curFile->interp,
2659
"Can only load one column at a time", TCL_STATIC );
2660
return TCL_ERROR;
2661
}
2662
2663
if( argc>4 )
2664
nullPtr = argv[4];
2665
2666
if( vtableGetToPtr(curFile, colNums[0], nullPtr) ) {
2667
return TCL_ERROR;
2668
}
2669
2670
} else if( !strcmp("expr", argv[2]) ) {
2671
2672
char *nullPtr = "NULL", errMsg[256];
2673
int numRange, *range=NULL;
2674
int argOff=0;
2675
2676
if( curFile->hduType == IMAGE_HDU ) {
2677
Tcl_SetResult(curFile->interp,
2678
"Current extension is not a table", TCL_STATIC);
2679
return TCL_ERROR;
2680
}
2681
2682
if( !strcmp("-rows", argv[3]) && argc>4 ) {
2683
numRange = fitsParseRangeNum(argv[4])+1;
2684
range = (int*) malloc(numRange*2*sizeof(int));
2685
if( fitsParseRange(argv[4],&numRange,range,numRange,
2686
1, curFile->CHDUInfo.table.numRows,errMsg)
2687
!= TCL_OK ) {
2688
Tcl_SetResult(curFile->interp,
2689
"Error parsing row range:\n", TCL_STATIC);
2690
Tcl_AppendResult(curFile->interp, errMsg, (char*)NULL);
2691
return TCL_ERROR;
2692
}
2693
argOff = 2;
2694
} else {
2695
numRange = 1;
2696
range = (int*) malloc(numRange*2*sizeof(int));
2697
range[0] = 1;
2698
range[1] = curFile->CHDUInfo.table.numRows;
2699
}
2700
2701
if( argc < 4+argOff || argc-argOff > 5+argOff ) {
2702
Tcl_SetResult(curFile->interp,
2703
"Usage: load expr ?-rows range? exprStr ?nullVal?",
2704
TCL_STATIC);
2705
return TCL_ERROR;
2706
}
2707
2708
if( argc > 4+argOff )
2709
nullPtr = argv[4+argOff];
2710
2711
if( exprGetToPtr( curFile, argv[3+argOff], nullPtr, numRange, range ) ) {
2712
return TCL_ERROR;
2713
}
2714
2715
} else if( !strcmp("all", argv[2]) || !strcmp("chdu", argv[2]) ) {
2716
2717
/* load the current hdu */
2718
2719
if( fitsUpdateCHDU(curFile, curFile->hduType) != TCL_OK ) {
2720
Tcl_SetResult(curFile->interp,
2721
"fitsTcl Error: Cannot update current HDU",
2722
TCL_STATIC);
2723
return TCL_ERROR;
2724
}
2725
2726
if( fitsLoadHDU(curFile) != TCL_OK ) {
2727
return TCL_ERROR;
2728
}
2729
2730
} else {
2731
2732
Tcl_SetResult(curFile->interp,
2733
"Error in fitsTcl: unknown load function", TCL_STATIC);
2734
return TCL_ERROR;
2735
2736
}
2737
2738
return TCL_OK;
2739
}
2740
2741
2742
/******************************************************************
2743
* Free
2744
******************************************************************/
2745
2746
int fitsTcl_free( FitsFD *curFile, int argc, Tcl_Obj *const argv[] )
2747
{
2748
void *databuff;
2749
Tcl_Obj **addList;
2750
char *addStr;
2751
int nAdd;
2752
2753
if( argc == 2 ) {
2754
Tcl_SetResult(curFile->interp,
2755
"free addressList",
2756
TCL_STATIC);
2757
return TCL_OK;
2758
}
2759
2760
if( argc>4 ) {
2761
Tcl_SetResult(curFile->interp, "Too many arguments to free",
2762
TCL_STATIC);
2763
return TCL_ERROR;
2764
}
2765
2766
if( Tcl_ListObjGetElements(curFile->interp, argv[argc-1], &nAdd, &addList)
2767
!= TCL_OK ) {
2768
Tcl_SetResult(curFile->interp,
2769
"Cannot parse the address list", TCL_STATIC);
2770
return TCL_ERROR;
2771
}
2772
2773
while( nAdd-- ) {
2774
databuff = NULL;
2775
addStr = Tcl_GetStringFromObj( addList[nAdd], NULL );
2776
sscanf(addStr,PTRFORMAT,&databuff);
2777
if ( databuff == NULL) {
2778
Tcl_SetResult(curFile->interp,
2779
"Error interpretting pointer address", TCL_STATIC);
2780
return TCL_ERROR;
2781
}
2782
ckfree( (char *) databuff);
2783
}
2784
2785
return TCL_OK;
2786
}
2787
2788
2789
/******************************************************************
2790
* Flush
2791
******************************************************************/
2792
2793
int fitsTcl_flush( FitsFD *curFile, int argc, Tcl_Obj *const argv[] )
2794
{
2795
int status = 0;
2796
2797
if ( argc == 2 ) {
2798
ffflsh(curFile->fptr, 0, &status);
2799
} else if( argc == 3 ) {
2800
char *opt;
2801
opt = Tcl_GetStringFromObj( argv[2], NULL );
2802
if( !strcmp(opt, "clear") ) {
2803
ffflsh(curFile->fptr, 1, &status);
2804
} else {
2805
Tcl_SetResult(curFile->interp, "fitsFile flush ?clear?", TCL_STATIC);
2806
return TCL_ERROR;
2807
}
2808
} else {
2809
Tcl_SetResult(curFile->interp, "fitsFile flush ?clear?", TCL_STATIC);
2810
return TCL_ERROR;
2811
}
2812
2813
if( status ) {
2814
Tcl_SetResult(curFile->interp,
2815
"fitsTcl Error: cannot flush file\n", TCL_STATIC);
2816
dumpFitsErrStack(curFile->interp, status);
2817
return TCL_ERROR;
2818
}
2819
2820
return TCL_OK;
2821
}
2822
2823
2824
/******************************************************************
2825
* Copy
2826
******************************************************************/
2827
2828
int fitsTcl_copy( FitsFD *curFile, int argc, Tcl_Obj *const argv[] )
2829
{
2830
static char *copyList = "\n"
2831
"copy filename\n";
2832
if( argc == 2 ) {
2833
Tcl_SetResult(curFile->interp, copyList, TCL_STATIC);
2834
return TCL_OK;
2835
}
2836
2837
if( fitsCopyCHduToFile(curFile, Tcl_GetStringFromObj( argv[2], NULL ) )
2838
!= TCL_OK ) {
2839
return TCL_ERROR;
2840
}
2841
2842
return TCL_OK;
2843
}
2844
2845
2846
/******************************************************************
2847
* Sascii
2848
******************************************************************/
2849
2850
int fitsTcl_sascii( FitsFD *curFile, int argc, char *const argv[] )
2851
{
2852
static char *sasciiList =
2853
"sascii table filename fileMode firstRow numRows colList widthList\n"
2854
" ifFixedFormat ifCSV ifPrintRow sepString\n"
2855
"sascii image filename fileMode firstRow numRows firstCol\n"
2856
" numCols cellSize ifCSV ifPrintRow sepString ?slice?\n";
2857
2858
int numCols,colNums[FITS_COLMAX],colTypes[FITS_COLMAX],strSize[FITS_COLMAX];
2859
int fRow, nRows;
2860
int fCol, nCols, nWdths;
2861
int cellSize, i, baseColNum, ifVariableVec;
2862
int ifCSV, ifPrintRow, ifFixedFormat;
2863
char *sepString;
2864
char **listWid;
2865
2866
char *errMsg;
2867
2868
if( argc == 2 ) {
2869
Tcl_SetResult(curFile->interp, sasciiList, TCL_STATIC);
2870
return TCL_OK;
2871
}
2872
2873
if( !strcmp("table", argv[2]) ){
2874
2875
if( argc < 13 || argc > 14 ) {
2876
Tcl_SetResult(curFile->interp,
2877
"Wrong # of args to 'sascii table'", TCL_STATIC);
2878
return TCL_ERROR;
2879
}
2880
2881
if( Tcl_GetInt(curFile->interp, argv[5], &fRow) != TCL_OK ) {
2882
Tcl_SetResult(curFile->interp, "Cannot get first row", TCL_STATIC);
2883
return TCL_ERROR;
2884
}
2885
if( Tcl_GetInt(curFile->interp, argv[6], &nRows) != TCL_OK ) {
2886
Tcl_SetResult(curFile->interp, "Cannot get number of rows", TCL_STATIC);
2887
return TCL_ERROR;
2888
}
2889
2890
if( fitsTransColList( curFile,argv[7],
2891
&numCols,colNums,colTypes,strSize) != TCL_OK ) {
2892
Tcl_SetResult(curFile->interp, "Cannot parse the column list", TCL_STATIC);
2893
return TCL_ERROR;
2894
}
2895
2896
if( Tcl_SplitList(curFile->interp, argv[8], &nWdths, &listWid)
2897
!= TCL_OK ) {
2898
Tcl_SetResult(curFile->interp, "Cannot parse the width list", TCL_STATIC);
2899
ckfree( (char*)listWid );
2900
return TCL_ERROR;
2901
}
2902
2903
if( nWdths != numCols ) {
2904
Tcl_SetResult(curFile->interp, "Cell width array and Column list have different sizes", TCL_STATIC);
2905
ckfree( (char*)listWid );
2906
return TCL_ERROR;
2907
}
2908
2909
for( i=0; i< numCols; i++ ) {
2910
if( Tcl_GetInt(curFile->interp, listWid[i], strSize+i) != TCL_OK ) {
2911
Tcl_SetResult(curFile->interp, "Unable to parse the width list", TCL_STATIC);
2912
ckfree( (char*)listWid );
2913
return TCL_ERROR;
2914
}
2915
}
2916
ckfree( (char*)listWid );
2917
2918
if( Tcl_GetInt(curFile->interp, argv[9], &ifFixedFormat) != TCL_OK ) {
2919
Tcl_SetResult(curFile->interp, "Cannot get ifFixedFormat", TCL_STATIC);
2920
return TCL_ERROR;
2921
}
2922
2923
if( Tcl_GetInt(curFile->interp, argv[10], &ifCSV) != TCL_OK ) {
2924
Tcl_SetResult(curFile->interp, "Cannot get ifCSV", TCL_STATIC);
2925
return TCL_ERROR;
2926
}
2927
2928
if( Tcl_GetInt(curFile->interp, argv[11], &ifPrintRow) != TCL_OK ) {
2929
Tcl_SetResult(curFile->interp, "Cannot get ifPrintRow", TCL_STATIC);
2930
return TCL_ERROR;
2931
}
2932
2933
if( saveTableToAscii( curFile, argv[3], argv[4], 1, fRow, nRows,
2934
numCols, colTypes, colNums, strSize,
2935
ifFixedFormat, ifCSV, ifPrintRow, argv[12]) )
2936
return TCL_ERROR;
2937
2938
} else if( !strcmp("image", argv[2]) ) {
2939
2940
long slice = 1;
2941
2942
if( argc < 13 || argc > 14 ) {
2943
Tcl_SetResult(curFile->interp,
2944
"Wrong # of args to 'sascii image'", TCL_STATIC);
2945
return TCL_ERROR;
2946
}
2947
2948
if( argc == 14 )
2949
slice = atol(argv[13]);
2950
2951
if( Tcl_GetInt(curFile->interp, argv[5], &fRow) != TCL_OK ) {
2952
Tcl_SetResult(curFile->interp,
2953
"Cannot get first row", TCL_STATIC);
2954
return TCL_ERROR;
2955
}
2956
if( Tcl_GetInt(curFile->interp, argv[6], &nRows) != TCL_OK ) {
2957
Tcl_SetResult(curFile->interp,
2958
"Cannot get number of rows", TCL_STATIC);
2959
return TCL_ERROR;
2960
}
2961
if( Tcl_GetInt(curFile->interp, argv[7], &fCol) != TCL_OK ) {
2962
Tcl_SetResult(curFile->interp,
2963
"Cannot get first column", TCL_STATIC);
2964
return TCL_ERROR;
2965
}
2966
if( Tcl_GetInt(curFile->interp, argv[8], &nCols) != TCL_OK ) {
2967
Tcl_SetResult(curFile->interp,
2968
"Cannot get number of columns", TCL_STATIC);
2969
return TCL_ERROR;
2970
}
2971
if( Tcl_GetInt(curFile->interp, argv[9], &cellSize) != TCL_OK ) {
2972
Tcl_SetResult(curFile->interp,
2973
"Cannot get cellSize", TCL_STATIC);
2974
return TCL_ERROR;
2975
}
2976
2977
if( Tcl_GetInt(curFile->interp, argv[10], &ifCSV) != TCL_OK ) {
2978
Tcl_SetResult(curFile->interp,
2979
"Cannot get ifCSV", TCL_STATIC);
2980
return TCL_ERROR;
2981
}
2982
2983
if( Tcl_GetInt(curFile->interp, argv[11], &ifPrintRow) != TCL_OK ) {
2984
Tcl_SetResult(curFile->interp,
2985
"Cannot get ifPrintRow", TCL_STATIC);
2986
return TCL_ERROR;
2987
}
2988
2989
/*
2990
do error checking later
2991
sepString = argv[12];
2992
*/
2993
2994
if( saveImageToAscii( curFile, argv[3], argv[4], fRow, nRows,
2995
fCol, nCols, cellSize,
2996
ifCSV, ifPrintRow, argv[12], slice ) )
2997
return TCL_ERROR;
2998
2999
} else if( !strcmp("vector", argv[2]) ) {
3000
3001
ifVariableVec = atol(argv[13]);
3002
3003
if( Tcl_GetInt(curFile->interp, argv[5], &fRow) != TCL_OK ) {
3004
Tcl_SetResult(curFile->interp,
3005
"Cannot get first row", TCL_STATIC);
3006
return TCL_ERROR;
3007
}
3008
if( Tcl_GetInt(curFile->interp, argv[6], &nRows) != TCL_OK ) {
3009
Tcl_SetResult(curFile->interp,
3010
"Cannot get number of rows", TCL_STATIC);
3011
return TCL_ERROR;
3012
}
3013
if( Tcl_GetInt(curFile->interp, argv[7], &fCol) != TCL_OK ) {
3014
Tcl_SetResult(curFile->interp,
3015
"Cannot get first column", TCL_STATIC);
3016
return TCL_ERROR;
3017
}
3018
if( Tcl_GetInt(curFile->interp, argv[8], &nCols) != TCL_OK ) {
3019
Tcl_SetResult(curFile->interp,
3020
"Cannot get number of columns", TCL_STATIC);
3021
return TCL_ERROR;
3022
}
3023
3024
if( fitsTransColList( curFile,argv[9],
3025
&numCols,colNums,colTypes,strSize) != TCL_OK ) {
3026
Tcl_SetResult(curFile->interp, "Cannot parse the column list", TCL_STATIC);
3027
return TCL_ERROR;
3028
}
3029
3030
/* 1-based */
3031
baseColNum = colNums[0];
3032
3033
if( Tcl_GetInt(curFile->interp, argv[10], &ifCSV) != TCL_OK ) {
3034
Tcl_SetResult(curFile->interp,
3035
"Cannot get ifCSV", TCL_STATIC);
3036
return TCL_ERROR;
3037
}
3038
3039
if( Tcl_GetInt(curFile->interp, argv[11], &ifPrintRow) != TCL_OK ) {
3040
Tcl_SetResult(curFile->interp,
3041
"Cannot get ifPrintRow", TCL_STATIC);
3042
return TCL_ERROR;
3043
}
3044
3045
/*
3046
do error checking later
3047
sepString = argv[12];
3048
*/
3049
3050
if( saveVectorTableToAscii( curFile, argv[3], argv[4], fRow, nRows,
3051
fCol, nCols, baseColNum,
3052
ifCSV, ifPrintRow, argv[12], ifVariableVec ) )
3053
return TCL_ERROR;
3054
} else {
3055
3056
Tcl_SetResult(curFile->interp,
3057
"Unknown sascii command", TCL_STATIC);
3058
return TCL_ERROR;
3059
3060
}
3061
3062
return TCL_OK;
3063
}
3064
3065
3066
/******************************************************************
3067
* Sort
3068
******************************************************************/
3069
3070
int fitsTcl_sort( FitsFD *curFile, int argc, char *const argv[] )
3071
{
3072
static char *sortList =
3073
"sort ?-merge? colNameList ?isAscendFlagList? \n";
3074
3075
int numCols,colNums[FITS_COLMAX],colTypes[FITS_COLMAX],strSize[FITS_COLMAX];
3076
int i;
3077
int *isAscend;
3078
char *const *argPtr;
3079
char **listPtr;
3080
int listNum;
3081
int isMerge = 0;
3082
3083
if( argc == 2 ) {
3084
Tcl_SetResult(curFile->interp, sortList, TCL_STATIC);
3085
return TCL_OK;
3086
}
3087
3088
if( curFile->hduType == IMAGE_HDU ) {
3089
Tcl_SetResult(curFile->interp, "Cannot sort an image", TCL_STATIC);
3090
return TCL_ERROR;
3091
}
3092
3093
argc -= 2;
3094
argPtr = argv + 2;
3095
3096
if( !strcmp(argPtr[0], "-merge") ) {
3097
isMerge = 1;
3098
argc --;
3099
argPtr ++;
3100
}
3101
3102
if( fitsTransColList( curFile,argPtr[0],
3103
&numCols,colNums,colTypes,strSize) != TCL_OK ) {
3104
return TCL_ERROR;
3105
}
3106
3107
isAscend = (int *) ckalloc(numCols*sizeof(int));
3108
3109
/* if no isAscend specified, set as default ascend */
3110
3111
if (argc == 1) {
3112
3113
for (i=0; i < numCols; i++)
3114
isAscend[i] = 1;
3115
3116
} else {
3117
3118
if( Tcl_SplitList(curFile->interp, argPtr[1],
3119
&listNum, &listPtr) != TCL_OK ) {
3120
ckfree((char *) isAscend);
3121
return TCL_ERROR;
3122
}
3123
if( listNum != numCols ) {
3124
Tcl_SetResult(curFile->interp,
3125
"fitsTcl Error: number of flags and columns don't match",
3126
TCL_STATIC);
3127
ckfree((char *) isAscend);
3128
ckfree((char *) listPtr);
3129
return TCL_ERROR;
3130
}
3131
for (i=0; i< listNum; i++) {
3132
if( Tcl_GetInt(curFile->interp, listPtr[i], &isAscend[i]) != TCL_OK ) {
3133
ckfree((char*) isAscend);
3134
ckfree((char*) listPtr);
3135
Tcl_SetResult(curFile->interp,
3136
"fitsTcl Error: cannot parse sort flag", TCL_STATIC);
3137
return TCL_ERROR;
3138
}
3139
}
3140
ckfree((char *) listPtr);
3141
3142
}
3143
3144
if( fitsSortTable(curFile, numCols, colNums,
3145
strSize, isAscend, isMerge) != TCL_OK ) {
3146
ckfree ((char *) isAscend);
3147
return TCL_ERROR;
3148
}
3149
3150
ckfree ((char *) isAscend);
3151
return TCL_OK;
3152
}
3153
3154
3155
/******************************************************************
3156
* Add
3157
******************************************************************/
3158
3159
int fitsTcl_add( FitsFD *curFile, int argc, char *const argv[] )
3160
{
3161
static char *addColList =
3162
"add column colName colForm ?expr?\n"
3163
"add column colName colForm ?expr? ?rowrange?\n"
3164
" colForm: e.g.\n"
3165
" ASCII Table: A15, I10, E12.5, D20.10, F14.6 ... \n"
3166
" BINARY Table: 15A, 1I, 1J, 1E, 1D, 1L, 1X, 1B, 1C, 1M\n";
3167
static char *addRowList = "add row numRows\n";
3168
char result[16];
3169
int numCols,colNums[FITS_COLMAX],colTypes[FITS_COLMAX],strSize[FITS_COLMAX];
3170
int numRange,rangeBlock, *range=NULL;
3171
char errMsg[256];
3172
int i,j;
3173
3174
/* range = (int*) malloc(FITS_MAXRANGE*2*sizeof(int)); */
3175
if( argc == 2 ) {
3176
Tcl_AppendResult(curFile->interp, addColList, addRowList, (char*)NULL);
3177
return TCL_OK;
3178
}
3179
3180
if( !strcmp(argv[2], "column") ) {
3181
3182
if( argc == 5 ) {
3183
3184
if( addColToTable(curFile, FITS_COLMAX, argv[3], argv[4])
3185
!= TCL_OK ) {
3186
return TCL_ERROR;
3187
}
3188
3189
} else if( argc >= 6 ) {
3190
3191
char *tmpColName;
3192
int isNew;
3193
3194
strToUpper(argv[3], &tmpColName);
3195
if( fitsTransColList(curFile,tmpColName,
3196
&numCols,colNums,colTypes,strSize) != TCL_OK ) {
3197
3198
/* column name doesn't exist, add a new column*/
3199
3200
isNew = 1;
3201
} else if( numCols == 1 ) {
3202
isNew = 0;
3203
} else {
3204
Tcl_SetResult(curFile->interp,
3205
"Can only add one column at a time", TCL_STATIC);
3206
ckfree((char *) tmpColName);
3207
return TCL_ERROR;
3208
}
3209
ckfree((char *) tmpColName);
3210
3211
/* Feb 2004, Ziqin Pan add */
3212
if( argc >= 7 ) {
3213
numRange = fitsParseRangeNum(argv[6])+1;
3214
range = (int*) malloc(numRange*2*sizeof(int));
3215
if ( fitsParseRange(argv[6],&numRange,range,numRange, 1, curFile->CHDUInfo.table.numRows,errMsg)
3216
!= TCL_OK ) {
3217
Tcl_SetResult(curFile->interp,
3218
"Error parsing row range:\n", TCL_STATIC);
3219
Tcl_AppendResult(curFile->interp, errMsg, (char*)NULL);
3220
return TCL_ERROR;
3221
}
3222
if ( fitsCalculaterngColumn(curFile, argv[3], ( strcmp(argv[4],"default") ? argv[4] : NULL ),
3223
argv[5],numRange,range) != TCL_OK ) {
3224
return TCL_ERROR;
3225
}
3226
} else {
3227
if ( fitsCalculateColumn(curFile, argv[3], ( strcmp(argv[4],"default") ? argv[4] : NULL ),
3228
argv[5]) != TCL_OK ) {
3229
return TCL_ERROR;
3230
}
3231
}
3232
3233
sprintf(result,"%d",isNew);
3234
Tcl_SetResult(curFile->interp, result, TCL_VOLATILE);
3235
3236
} else {
3237
3238
Tcl_SetResult(curFile->interp, addColList, TCL_STATIC);
3239
return TCL_ERROR;
3240
3241
}
3242
3243
} else if( !strcmp(argv[2], "row") ) {
3244
3245
int numRows;
3246
3247
if( argc != 4 ) {
3248
Tcl_SetResult(curFile->interp, addRowList, TCL_STATIC);
3249
return TCL_ERROR;
3250
}
3251
if( Tcl_GetInt(curFile->interp, argv[3], &numRows) != TCL_OK) {
3252
Tcl_SetResult(curFile->interp,
3253
"Failed to get numRows parameter", TCL_STATIC);
3254
return TCL_ERROR;
3255
}
3256
if( addRowToTable(curFile, curFile->CHDUInfo.table.numRows,
3257
numRows) != TCL_OK ) {
3258
return TCL_ERROR;
3259
}
3260
3261
} else {
3262
3263
Tcl_SetResult(curFile->interp, "Unknown add command", TCL_STATIC);
3264
return TCL_ERROR;
3265
3266
}
3267
3268
if (range) free(range);
3269
return TCL_OK;
3270
}
3271
3272
3273
/******************************************************************
3274
* Append
3275
******************************************************************/
3276
3277
int fitsTcl_append( FitsFD *curFile, int argc, Tcl_Obj *const argv[] )
3278
{
3279
static char *appendList = "\n"
3280
"append filename \n"
3281
" -- append the chdu to another file\n";
3282
3283
if( argc < 3 ) {
3284
Tcl_SetResult(curFile->interp, appendList, TCL_STATIC);
3285
return TCL_OK;
3286
}
3287
3288
if( fitsAppendCHduToFile(curFile, Tcl_GetStringFromObj( argv[2], NULL ) )
3289
!= TCL_OK ) {
3290
return TCL_ERROR;
3291
}
3292
3293
return TCL_OK;
3294
}
3295
3296
3297
/******************************************************************
3298
* Histogram
3299
******************************************************************/
3300
3301
int fitsTcl_histo( FitsFD *curFile, int argc, Tcl_Obj *const argv[] )
3302
{
3303
static char *histoList = "\n"
3304
"histogram ?-weight w? ?-rows rowSpan? filename {col min max bin} ... \n";
3305
3306
int i, j, argNum, nRows;
3307
char *opt;
3308
int numRange, *range=NULL;
3309
char errMsg[256];
3310
Tcl_Obj **binList;
3311
3312
/* Args to ffhist */
3313
fitsfile *fptr;
3314
char *outfile;
3315
int imagetype = TINT;
3316
int naxis;
3317
char colname[4][FLEN_VALUE];
3318
double minin[4];
3319
double maxin[4];
3320
double binsizein[4];
3321
char minname[4][FLEN_VALUE];
3322
char maxname[4][FLEN_VALUE];
3323
char binname[4][FLEN_VALUE];
3324
double weightin;
3325
char wtcol[FLEN_VALUE];
3326
int recip=0;
3327
char *selectrow=NULL;
3328
int status=0;
3329
3330
if( argc == 2 ) {
3331
Tcl_SetResult(curFile->interp, histoList, TCL_STATIC);
3332
return TCL_OK;
3333
}
3334
3335
if( curFile->hduType == IMAGE_HDU ) {
3336
Tcl_SetResult(curFile->interp, "Cannot histogram an image", TCL_STATIC);
3337
return TCL_ERROR;
3338
}
3339
3340
/* Zero out all the parameters */
3341
3342
for( i=0; i<4; i++ ) {
3343
colname[i][0] = '\0';
3344
minname[i][0] = '\0'; minin[i] = DOUBLENULLVALUE;
3345
maxname[i][0] = '\0'; maxin[i] = DOUBLENULLVALUE;
3346
binname[i][0] = '\0'; binsizein[i] = DOUBLENULLVALUE;
3347
}
3348
wtcol[0] = '\0';
3349
3350
3351
/* Search for histogram options */
3352
3353
weightin = 1.0;
3354
nRows = curFile->CHDUInfo.table.numRows;
3355
argNum = 2;
3356
do { /* argc guaranteed to be at least 3 */
3357
3358
opt = Tcl_GetStringFromObj( argv[argNum++], NULL );
3359
if( opt[0]!='-' ) break;
3360
3361
if( !strcmp(opt,"-weight") ) {
3362
3363
if( argNum == argc ) {
3364
Tcl_SetResult(curFile->interp, histoList, TCL_STATIC);
3365
if( selectrow ) ckfree( (char*)selectrow );
3366
return TCL_ERROR;
3367
}
3368
if( Tcl_GetDoubleFromObj( curFile->interp, argv[argNum], &weightin )
3369
!= TCL_OK ) {
3370
strcpy( wtcol, Tcl_GetStringFromObj( argv[argNum], NULL ) );
3371
}
3372
imagetype = TFLOAT;
3373
argNum++;
3374
3375
} else if( !strcmp(opt,"-inverse") ) {
3376
3377
recip = 1;
3378
3379
} else if( !strcmp(opt,"-rows") ) {
3380
3381
if( argNum == argc ) {
3382
Tcl_SetResult(curFile->interp, histoList, TCL_STATIC);
3383
if( selectrow ) ckfree( (char*)selectrow );
3384
return TCL_ERROR;
3385
}
3386
opt = Tcl_GetStringFromObj( argv[argNum++], NULL );
3387
numRange = fitsParseRangeNum(opt)+1;
3388
range = (int*) malloc(numRange*2*sizeof(int));
3389
if( fitsParseRange( opt, &numRange, range, numRange,
3390
1, nRows, errMsg)
3391
!= TCL_OK ) {
3392
Tcl_SetResult(curFile->interp,
3393
"Error parsing row range:\n", TCL_STATIC);
3394
Tcl_AppendResult(curFile->interp, errMsg, (char*)NULL);
3395
if( selectrow ) ckfree( (char*)selectrow );
3396
return TCL_ERROR;
3397
}
3398
if( numRange>1 || range[0]!=1 || range[1]!=nRows ) {
3399
if( selectrow==NULL ) {
3400
selectrow = (char *)ckalloc( nRows * sizeof(char) );
3401
if( !selectrow ) {
3402
Tcl_SetResult( curFile->interp,
3403
"Unable to allocate row-selection array",
3404
TCL_STATIC );
3405
return TCL_ERROR;
3406
}
3407
for( i=0; i<nRows; i++ ) selectrow[i] = 0;
3408
}
3409
for( i=0; i<numRange; i++ ) {
3410
for( j=range[i*2]; j<=range[i*2+1]; j++ ) {
3411
selectrow[j-1] = 1;
3412
}
3413
}
3414
}
3415
3416
} else {
3417
break;
3418
}
3419
3420
if( argNum >= argc ) {
3421
/* Need at least a filename parameter */
3422
Tcl_SetResult( curFile->interp, histoList, TCL_STATIC );
3423
if( selectrow ) ckfree( (char*)selectrow );
3424
return TCL_ERROR;
3425
}
3426
3427
} while( 1 ); /* Exit by one of breaks... found non option */
3428
3429
/* opt should be pointing to the file name */
3430
3431
outfile = opt;
3432
3433
naxis = argc - argNum;
3434
if( naxis < 1 ) {
3435
if( selectrow ) ckfree( (char*)selectrow );
3436
Tcl_SetResult( curFile->interp, "Missing binning arguments",
3437
TCL_STATIC );
3438
return TCL_ERROR;
3439
}
3440
if( naxis > 4 ) {
3441
if( selectrow ) ckfree( (char*)selectrow );
3442
Tcl_SetResult( curFile->interp, "Histograms are limited to 4 dimensions",
3443
TCL_STATIC );
3444
return TCL_ERROR;
3445
}
3446
3447
/* Parse each of the binning lists */
3448
3449
for( i=0; i<naxis; i++, argNum++ ) {
3450
3451
if( Tcl_ListObjGetElements(curFile->interp, argv[argNum], &j, &binList)
3452
!= TCL_OK ) {
3453
Tcl_SetResult(curFile->interp,
3454
"Cannot parse the column binning parameters",
3455
TCL_STATIC);
3456
return TCL_ERROR;
3457
}
3458
if( j!=4 ) {
3459
if( selectrow ) ckfree( (char*)selectrow );
3460
Tcl_SetResult( curFile->interp,
3461
"Binning list should be {colName min max binsize}",
3462
TCL_STATIC );
3463
return TCL_ERROR;
3464
}
3465
3466
/* Get column name */
3467
opt = Tcl_GetStringFromObj( binList[0], &j );
3468
if( j<FLEN_VALUE ) {
3469
strcpy( colname[i], opt );
3470
} else {
3471
j = FLEN_VALUE-1;
3472
strncpy( colname[i], opt, j );
3473
colname[i][j] = '\0';
3474
}
3475
3476
/* Get min parameter ... can be number, "-", or keyword name */
3477
if( Tcl_GetDoubleFromObj( curFile->interp, binList[1], minin+i )
3478
!= TCL_OK ) {
3479
opt = Tcl_GetStringFromObj( binList[1], &j );
3480
if( strcmp(opt,"-") ) {
3481
/* Use supplied keyword name */
3482
if( j<FLEN_VALUE ) {
3483
strcpy( minname[i], opt );
3484
} else {
3485
j = FLEN_VALUE-1;
3486
strncpy( minname[i], opt, j );
3487
minname[i][j] = '\0';
3488
}
3489
}
3490
}
3491
3492
/* Get max parameter ... can be number, "-", or keyword name */
3493
if( Tcl_GetDoubleFromObj( curFile->interp, binList[2], maxin+i )
3494
!= TCL_OK ) {
3495
opt = Tcl_GetStringFromObj( binList[2], &j );
3496
if( strcmp(opt,"-") ) {
3497
/* Use supplied keyword name */
3498
if( j<FLEN_VALUE ) {
3499
strcpy( maxname[i], opt );
3500
} else {
3501
j = FLEN_VALUE-1;
3502
strncpy( maxname[i], opt, j );
3503
maxname[i][j] = '\0';
3504
}
3505
}
3506
}
3507
3508
/* Get bin parameter ... can be number, "-", or keyword name */
3509
if( Tcl_GetDoubleFromObj( curFile->interp, binList[3], binsizein+i )
3510
!= TCL_OK ) {
3511
opt = Tcl_GetStringFromObj( binList[3], &j );
3512
if( strcmp(opt,"-") ) {
3513
/* Use supplied keyword name */
3514
if( j<FLEN_VALUE ) {
3515
strcpy( binname[i], opt );
3516
} else {
3517
j = FLEN_VALUE-1;
3518
strncpy( binname[i], opt, j );
3519
binname[i][j] = '\0';
3520
}
3521
}
3522
}
3523
3524
}
3525
3526
ffreopen( curFile->fptr, &fptr, &status );
3527
ffmahd( fptr, curFile->chdu, &j, &status );
3528
ffhist2( &fptr,
3529
outfile,
3530
imagetype,
3531
naxis,
3532
colname,
3533
minin,
3534
maxin,
3535
binsizein,
3536
minname,
3537
maxname,
3538
binname,
3539
weightin,
3540
wtcol,
3541
recip,
3542
selectrow,
3543
&status );
3544
ffclos( fptr, &status );
3545
3546
if (range) free(range);
3547
if( status ) {
3548
dumpFitsErrStack(curFile->interp, status);
3549
return TCL_ERROR;
3550
}
3551
3552
Tcl_ResetResult(curFile->interp);
3553
return TCL_OK;
3554
}
3555
3556
3557
/******************************************************************
3558
* Create
3559
******************************************************************/
3560
3561
int fitsTcl_create( FitsFD *curFile, int argc, Tcl_Obj *const argv[] )
3562
{
3563
static char *createList= "\n"
3564
"create 2dhisto filename {colList} {xmin xmax xbin} {ymin ymax ybin} ?rows?\n"
3565
" 1dhisto filename {colList} {xmin xmax xbin} ?row?\n"
3566
" (DEPRECATED) Use 'objName histogram' command instead\n";
3567
3568
Tcl_Obj *newCmd[10];
3569
int newArgc, nelem, naxes, i;
3570
char *opt;
3571
3572
if( argc == 2 ) {
3573
Tcl_SetResult(curFile->interp, createList, TCL_STATIC);
3574
return TCL_OK;
3575
}
3576
3577
opt = Tcl_GetStringFromObj( argv[2], NULL );
3578
if( !strcmp("dhisto", opt+1) ) {
3579
3580
naxes = *opt - '0';
3581
3582
if( argc < 5 + naxes ) {
3583
Tcl_SetResult(curFile->interp, "Wrong # of args to 'create ndhisto'",
3584
TCL_STATIC);
3585
return TCL_ERROR;
3586
}
3587
3588
newArgc=0;
3589
newCmd[newArgc++] = argv[0];
3590
newCmd[newArgc++] = Tcl_NewStringObj("histogram",-1);
3591
3592
/* Look for a row span */
3593
if ( argc > 5 + naxes) {
3594
newCmd[newArgc++] = Tcl_NewStringObj("-rows",-1);
3595
newCmd[newArgc++] = argv[argc-1];
3596
}
3597
3598
/* Look for a weight argument */
3599
Tcl_ListObjLength( curFile->interp, argv[4], &nelem );
3600
if( nelem<naxes || nelem>naxes+1 ) {
3601
Tcl_SetResult(curFile->interp, "Need 2-3 columns to produce histogram",
3602
TCL_STATIC);
3603
return TCL_ERROR;
3604
}
3605
if( nelem==naxes+1 ) {
3606
newCmd[newArgc++] = Tcl_NewStringObj("-weight",-1);
3607
Tcl_ListObjIndex( curFile->interp, argv[4], naxes, newCmd+newArgc );
3608
newArgc++;
3609
}
3610
3611
/* Grab filename argument */
3612
newCmd[newArgc++] = argv[3];
3613
3614
/* Build axes bin parameter */
3615
for( i=0; i<naxes; i++ ) {
3616
Tcl_ListObjLength( curFile->interp, argv[5+i], &nelem );
3617
if( nelem != 3 ) {
3618
Tcl_SetResult(curFile->interp,
3619
"Incorrect axis binning parameters",
3620
TCL_STATIC);
3621
return TCL_ERROR;
3622
}
3623
Tcl_ListObjIndex( curFile->interp, argv[4], i, newCmd+newArgc );
3624
newCmd[newArgc] = Tcl_NewListObj(1,newCmd+newArgc);
3625
Tcl_ListObjAppendList( curFile->interp, newCmd[newArgc], argv[5+i] );
3626
newArgc++;
3627
}
3628
3629
if( fitsTcl_histo( curFile, newArgc, newCmd ) != TCL_OK ) {
3630
return TCL_ERROR;
3631
}
3632
3633
} else {
3634
Tcl_SetResult(curFile->interp, "Unknown 'create' command", TCL_STATIC);
3635
return TCL_ERROR;
3636
}
3637
3638
return TCL_OK;
3639
}
3640
3641
3642
/******************************************************************
3643
* Checksum
3644
******************************************************************/
3645
3646
int fitsTcl_checksum( FitsFD *curFile, int argc, Tcl_Obj *const argv[] )
3647
{
3648
static char *checksumList="\n"
3649
"checksum verify\n"
3650
"checksum update\n";
3651
3652
char result[16], *opt;
3653
int datastatus = 0;
3654
int hdustatus = 0;
3655
int status = 0;
3656
3657
if( argc < 3 ) {
3658
Tcl_SetResult(curFile->interp, checksumList, TCL_STATIC);
3659
return TCL_OK;
3660
}
3661
3662
opt = Tcl_GetStringFromObj( argv[2], NULL );
3663
3664
if( !strcmp("verify", opt) ) {
3665
3666
/* verify the checksum keyword. */
3667
/* return 1 OK, 0 checksum keyword not present, -1 wrong */
3668
3669
if( ffvcks(curFile->fptr, &datastatus, &hdustatus, &status) ) {
3670
dumpFitsErrStack(curFile->interp, status);
3671
return TCL_ERROR;
3672
}
3673
/* Return "minimum" checksum status */
3674
Tcl_SetObjResult(curFile->interp,
3675
Tcl_NewIntObj( hdustatus<datastatus
3676
? hdustatus : datastatus) );
3677
3678
} else if( !strcmp("update", opt) ) {
3679
3680
if( ffpcks(curFile->fptr, &status) ) {
3681
dumpFitsErrStack(curFile->interp, status);
3682
return TCL_ERROR;
3683
}
3684
3685
if( fitsUpdateFile(curFile) != TCL_OK ) {
3686
return TCL_ERROR;
3687
}
3688
3689
} else {
3690
3691
Tcl_SetResult(curFile->interp, "Unknown checksum option", TCL_STATIC);
3692
return TCL_ERROR;
3693
3694
}
3695
3696
return TCL_OK;
3697
}
3698
3699
/******************************************************************
3700
* Smooth
3701
******************************************************************/
3702
3703
int fitsTcl_smooth( FitsFD *curFile, int argc, Tcl_Obj *const argv[] )
3704
{
3705
static char *smoothList= "\n"
3706
"smooth {width height} filename ?inPrimary? \n";
3707
char *opt;
3708
int status = 0;
3709
int i,j,k,l;
3710
3711
int xwin, ywin;
3712
Tcl_Obj **winList;
3713
int nwin,len;
3714
fitsfile *infptr;
3715
fitsfile *outfptr;
3716
int xd,yd;
3717
int xl,yl,xh,yh;
3718
3719
char outfile[FLEN_FILENAME];
3720
3721
float *data; /* original data */
3722
float *sdata; /* smoothed data */
3723
int ndim;
3724
float nullval = -999; /* null value */
3725
int anynul = 0 ;
3726
int id;
3727
float sum;
3728
int npix;
3729
3730
int bitpix, naxis;
3731
int maxaxis = 4;
3732
long naxes[999];
3733
int canprimary = 0;
3734
3735
int hdunum, hdutype;
3736
char strtemp[FLEN_FILENAME];
3737
3738
3739
/* help */
3740
if( argc == 2 ) {
3741
Tcl_SetResult(curFile->interp, smoothList, TCL_STATIC);
3742
return TCL_OK;
3743
}
3744
3745
if( argc < 4 ) {
3746
Tcl_SetResult(curFile->interp, "Wrong # of args to 'smooth'",
3747
TCL_STATIC);
3748
return TCL_ERROR;
3749
}
3750
3751
if( curFile->hduType != IMAGE_HDU ) {
3752
Tcl_SetResult(curFile->interp, "Cannot smooth a table", TCL_STATIC);
3753
return TCL_ERROR;
3754
}
3755
3756
3757
/* Get the width and height parameters */
3758
if( Tcl_ListObjGetElements(curFile->interp, argv[2], &nwin, &winList)
3759
!= TCL_OK ) {
3760
Tcl_SetResult(curFile->interp,
3761
"Cannot parse the window parameters",
3762
TCL_STATIC);
3763
return TCL_ERROR;
3764
}
3765
3766
if( nwin!=2 ) {
3767
Tcl_SetResult( curFile->interp,
3768
"Window list should be {xwin ywin}",
3769
TCL_STATIC );
3770
return TCL_ERROR;
3771
}
3772
3773
/* Get the width/height parameters */
3774
if( Tcl_GetIntFromObj( curFile->interp, winList[0], &xwin)
3775
!= TCL_OK ) {
3776
Tcl_SetResult( curFile->interp,
3777
"Error reading the width parameter",
3778
TCL_STATIC );
3779
return TCL_ERROR;
3780
}
3781
if (xwin%2 == 0) {
3782
Tcl_SetResult( curFile->interp,
3783
"The width must be a odd number",
3784
TCL_STATIC );
3785
return TCL_ERROR;
3786
}
3787
3788
if( Tcl_GetIntFromObj( curFile->interp, winList[1], &ywin)
3789
!= TCL_OK ) {
3790
Tcl_SetResult( curFile->interp,
3791
"Error reading the height parameter",
3792
TCL_STATIC );
3793
return TCL_ERROR;
3794
}
3795
if (ywin%2 == 0) {
3796
Tcl_SetResult( curFile->interp,
3797
"The height must be a odd number",
3798
TCL_STATIC );
3799
return TCL_ERROR;
3800
}
3801
3802
/* Get the image output file name */
3803
opt = Tcl_GetStringFromObj( argv[3], NULL );
3804
len = strlen(opt);
3805
if( len < FLEN_FILENAME ) {
3806
strcpy(outfile, opt );
3807
} else {
3808
Tcl_SetResult( curFile->interp,
3809
"The length of filename is too long. ",
3810
TCL_STATIC );
3811
return TCL_ERROR;
3812
}
3813
3814
if( argc == 5 ) {
3815
if ( Tcl_GetBooleanFromObj( curFile->interp, argv[4], &canprimary )
3816
!= TCL_OK )
3817
return TCL_ERROR;
3818
}
3819
3820
/* open the input file */
3821
ffreopen( curFile->fptr, &infptr, &status );
3822
ffmahd( infptr, curFile->chdu, &j, &status );
3823
3824
/*get the image parameter */
3825
ffgipr(infptr, maxaxis, &bitpix, &naxis, naxes, &status);
3826
if (naxis < 2 ) {
3827
Tcl_SetResult( curFile->interp,
3828
"The smooth algorithm only supports 2-d images.",
3829
TCL_STATIC );
3830
return TCL_ERROR;
3831
}
3832
3833
for (i = 2; i < naxis; i++) {
3834
if (naxes[i] > 1 ) {
3835
Tcl_SetResult( curFile->interp,
3836
"The smooth algorithm only supports 2-d images.",
3837
TCL_STATIC );
3838
return TCL_ERROR;
3839
}
3840
}
3841
3842
ndim = (int)(naxes[0]*naxes[1]);
3843
data = (float *) ckalloc(ndim*sizeof(float ));
3844
sdata = (float *) ckalloc(ndim*sizeof(float ));
3845
3846
ffgpv(infptr,TFLOAT,1, naxes[0]*naxes[1],&nullval, data, &anynul, &status);
3847
xd = xwin / 2;
3848
yd = ywin / 2;
3849
3850
3851
/* iterate over y */
3852
yl = 0;
3853
yh = yd;
3854
for (i=0; i < naxes[1]; i++) {
3855
/* initialize the kernal for this row */
3856
sum = 0;
3857
npix = 0;
3858
xl = 0;
3859
xh = xd;
3860
for (k = yl; k <= yh; k++) {
3861
for ( l = xl; l <= xh; l++) {
3862
id = k * naxes[0] + l;
3863
if(data[id]!=nullval) {
3864
npix++;
3865
sum += data[id];
3866
}
3867
}
3868
}
3869
3870
/* iterate over x */
3871
for (j = 0; j < naxes[0]; j++) {
3872
id = i*naxes[0]+j;
3873
if(npix == 0) {
3874
sdata[id] = nullval;
3875
} else {
3876
sdata[id] = sum/(float )npix;
3877
}
3878
3879
/* increase the x by 1 */
3880
if(j - xl == xd ) {
3881
for ( k = yl; k <= yh; k++) {
3882
id = k*naxes[0]+xl;
3883
if(data[id]!=nullval) {
3884
npix--;
3885
sum -= data[id];
3886
}
3887
}
3888
xl++;
3889
}
3890
if(xh + 1< naxes[0] ) {
3891
xh++;
3892
for ( k = yl; k <= yh; k++) {
3893
id = k*naxes[0]+xh;
3894
if(data[id]!=nullval) {
3895
npix++;
3896
sum += data[id];
3897
}
3898
}
3899
}
3900
}
3901
3902
/* increase the y by 1 */
3903
if (i - yl == yd ) yl++;
3904
if (yh + 1 < naxes[1]) yh++;
3905
}
3906
3907
/* open the output file */
3908
ffopen(&outfptr, outfile,READWRITE, &status);
3909
if(status == FILE_NOT_OPENED) {
3910
status = 0;
3911
ffinit(&outfptr,outfile,&status);
3912
if(!canprimary)
3913
ffcrim(outfptr,FLOAT_IMG,0,NULL,&status);
3914
} else if (status) {
3915
strcpy(strtemp,"Error opening output file: ");
3916
strcat(strtemp,curFile->fileName);
3917
Tcl_SetResult( curFile->interp,
3918
strtemp,
3919
TCL_STATIC );
3920
return TCL_ERROR;
3921
}
3922
3923
3924
/* ffcrim(outfptr,FLOAT_IMG, naxis, naxes, &status); */
3925
ffcphd(infptr,outfptr,&status);
3926
3927
/* Update keywords */
3928
ffghdn(outfptr, &hdunum);
3929
i = FLOAT_IMG;
3930
ffuky(outfptr,TINT, "BITPIX",&i, NULL, &status);
3931
ffpky(outfptr,TINT, "XWIN",&xwin,"x-width of the smoothing window", &status);
3932
ffpky(outfptr,TINT, "YWIN",&ywin,"y-width of the smoothing window", &status);
3933
strcpy(strtemp,"Smoothed output of the image file: ");
3934
strcat(strtemp,curFile->fileName);
3935
ffpcom(outfptr,strtemp, &status);
3936
3937
/* write data*/
3938
ffppn(outfptr,TFLOAT,1,naxes[0]*naxes[1],sdata,&nullval,&status);
3939
3940
ckfree(data);
3941
ckfree(sdata);
3942
3943
/* close file */
3944
ffclos(infptr,&status);
3945
ffclos(outfptr,&status);
3946
3947
return TCL_OK;
3948
}
Loggerhead is a web-based interface for Breezy
Version: 2.0.1