File: flir.c

package info (click to toggle)
libtk-img 1%3A2.0.1%2Bdfsg1-2
  • links: PTS, VCS
  • area: main
  • in suites: trixie
  • size: 47,852 kB
  • sloc: ansic: 224,696; sh: 20,589; tcl: 8,921; makefile: 2,272; cpp: 1,933; ada: 1,681; pascal: 1,139; cs: 879; awk: 794; asm: 587; python: 542; xml: 95
file content (767 lines) | stat: -rwxr-xr-x 28,722 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
/*
 * flir.c
 *
 * FLIR photo image type, Tcl/Tk package.
 *
 * A photo image handler for FLIR FPF Public Image format interpreted
 * as grayscale images.
 *
 * For a list of available format options see function ParseFormatOpts
 * and the documentation img-flir.
 *
 * Copyright (c) 2001-2024 Paul Obermeier <obermeier@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */

#include <stdlib.h>
#include <math.h>

/*
 * Generic initialization code, parameterized via CPACKAGE and PACKAGE.
 */

#include "init.c"

/* Header fields possible values. */
#define strShort   "short"
#define strInt     "int"
#define strFloat   "float"
#define strDouble  "double"
#define strUnknown "Unknown"

#define FPF_ID "FPF Public Image Format"

#define TYPE_SHORT  0
#define TYPE_INT    1
#define TYPE_FLOAT  2
#define TYPE_DOUBLE 3

/* Some general defines and typedefs. */
#define TRUE  1
#define FALSE 0

typedef unsigned char Boln;     /* Boolean value: TRUE or FALSE */
typedef unsigned char UByte;    /* Unsigned  8 bit integer */
typedef char  Byte;             /* Signed    8 bit integer */
typedef unsigned short UShort;  /* Unsigned 16 bit integer */
typedef short Short;            /* Signed   16 bit integer */
typedef unsigned int UInt;      /* Unsigned 32 bit integer */
typedef int Int;                /* Signed   32 bit integer */
typedef float Float;            /* IEEE     32 bit floating point */
typedef double Double;          /* IEEE     64 bit floating point */

#define FPF_STRING_LEN 32

/* FPF file header structure */
typedef struct {
    char   fpfId[FPF_STRING_LEN]; /* "FLIR Public Image Format" */
    UInt   version;               /* Should be 2 */
    UInt   imageDataOffset;       /* Offset to pixel values from start of fpfId. */
    UShort imageType;             /* Temperature: 0, Diff Temp: 2, Object Signal: 4, Diff Object Signal: 5 */
    UShort pixelType;             /* 0: 2-byte int, 1: 4-byte int, 2: 4-byte float, 3: 8-byte float */
    UShort width;                 /* Width of image */
    UShort height;                /* Height of image */
    UInt   triggerCount;          /* External trigger counter */
    UInt   frameCount;            /* Frame number in sequence */
    UInt   spare[16];
} FPF_IMAGE_DATA;

typedef struct {
    char  cameraName[FPF_STRING_LEN];      /* Camera name string */
    char  cameraPartNum[FPF_STRING_LEN];   /* Camera part number string */
    char  cameraSerialNum[FPF_STRING_LEN]; /* Scanner serial number string */
    Float cameraTempRangeMin;              /* Camera minimum temperature range */
    Float cameraTempRangeMax;              /* Camera maximum temperature range */
    char  lensName[FPF_STRING_LEN];        /* Lens name string */
    char  lensPartNum[FPF_STRING_LEN];     /* Lens part number string */
    char  lensSerialNum[FPF_STRING_LEN];   /* Lens serial number string */
    char  filterName[FPF_STRING_LEN];      /* Filter name string */
    char  filterPartNum[FPF_STRING_LEN];   /* Filter part number string */
    char  filterSerialNum[FPF_STRING_LEN]; /* Filter serial number string */
    UInt  spare[16];
} FPF_CAMERA_DATA;

typedef struct {
    Float emissivity;           /* Range: 0.0 - 1.0 */
    Float objectDistance;       /* Object distance in meters */
    Float ambientTemp;          /* Reflected ambient temperature in Kelvin */
    Float atmosphereTemp;       /* Atmospheric temperature in Kelvin */
    Float relativeHumidity;     /* Range: 0.0 - 1.0 */
    Float computedAtmTrans;     /* Computed atmospheric transmission.  Range: 0.0 - 1.0 */
    Float estimatedAtmTrans;    /* Estimated atmospheric transmission. Range: 0.0 - 1.0 */
    Float referenceTemp;        /* Reference temperature in Kelvin */
    Float extOpticsTemp;        /* Kelvin */
    Float extOpticsTrans;       /* Range: 0.0 - 1.0 */
    UInt  spare[16];
} FPF_OBJECT_PARAM;

typedef struct {
    Int  year;
    Int  month;
    Int  day;
    Int  hour;
    Int  minute;
    Int  second;
    Int  millisecond;
    UInt spare[16];
} FPF_DATETIME;

typedef struct {
    Float cameraScaleMin;     /* Camera scale min, in current output */
    Float cameraScaleMax;     /* Camera scale max */
    Float calculatedScaleMin; /* Calculated min (almost true min) */
    Float calculatedScaleMax; /* Calculated max (almost true max) */
    Float actualScaleMin;     /* Scale min */
    Float actualScaleMax;     /* Scale max */
    UInt  spare[16];
} FPF_SCALING;

typedef struct {
    FPF_IMAGE_DATA   imgData;
    FPF_CAMERA_DATA  camData;
    FPF_OBJECT_PARAM objParam;
    FPF_DATETIME     datetime;
    FPF_SCALING      scaling;
    UInt             spare[32];
} FPF_HEADER;

/* Format options structure for use with ParseFormatOpts */
typedef struct {
    Int   mapMode;
    Float gamma;        /* IMG_MAP_MINMAX and IMG_MAP_AGC */
    Float minVal;       /* IMG_MAP_MINMAX */
    Float maxVal;       /* IMG_MAP_MINMAX */
    Float saturation;   /* IMG_MAP_AGC */
    Float cutOff;       /* IMG_MAP_AGC */
    Boln  verbose;
    Boln  printAgc;
} FMTOPT;

/* Structure to hold information about the image file being processed. */
typedef struct {
    FPF_HEADER th;
    UByte  *pixbuf;
    Double *doubleBuf;
    Float  *floatBuf;
    UInt   *uintBuf;
    UShort *ushortBuf;
} FPF_FILE;

static void fpfClose (FPF_FILE *tf)
{
    if (tf->pixbuf)    ckfree ((char *)tf->pixbuf);
    if (tf->doubleBuf) ckfree ((char *)tf->doubleBuf);
    if (tf->floatBuf)  ckfree ((char *)tf->floatBuf);
    if (tf->uintBuf)   ckfree ((char *)tf->uintBuf);
    if (tf->ushortBuf) ckfree ((char *)tf->ushortBuf);
    return;
}

static void printImgInfo (FPF_HEADER *th, FMTOPT *opts,
                          const char *filename, const char *msg)
{
    Tcl_Channel outChan;
    char str[256];

    outChan = Tcl_GetStdChannel (TCL_STDOUT);
    if (!outChan) {
        return;
    }
    tkimg_snprintf (str, 256, "%s %s\n", msg, filename);                                                       IMGOUT;
    tkimg_snprintf (str, 256, "\tSize in pixel    : %d x %d\n", th->imgData.width, th->imgData.height);        IMGOUT;
    tkimg_snprintf (str, 256, "\tPixel type       : %s\n",      (th->imgData.pixelType == TYPE_DOUBLE? strDouble:
                                                                (th->imgData.pixelType == TYPE_FLOAT?  strFloat:
                                                                (th->imgData.pixelType == TYPE_INT?    strInt:
                                                                (th->imgData.pixelType == TYPE_SHORT?  strShort:
                                                                                              strUnknown))))); IMGOUT;
    tkimg_snprintf (str, 256, "\tMapping mode     : %s\n",      (opts->mapMode == IMG_MAP_NONE?   IMG_MAP_NONE_STR:
                                                                (opts->mapMode == IMG_MAP_MINMAX? IMG_MAP_MINMAX_STR:
                                                                (opts->mapMode == IMG_MAP_AGC?    IMG_MAP_AGC_STR:
                                                                                              strUnknown))));  IMGOUT;
    if (opts->mapMode != IMG_MAP_NONE) {
        tkimg_snprintf (str, 256, "\tGamma correction : %f\n",       opts->gamma);                             IMGOUT;
        if (opts->mapMode == IMG_MAP_MINMAX) {
            tkimg_snprintf (str, 256, "\tMinimum map value: %f\n",   opts->minVal);                            IMGOUT;
            tkimg_snprintf (str, 256, "\tMaximum map value: %f\n",   opts->maxVal);                            IMGOUT;
        }
        if (opts->mapMode == IMG_MAP_AGC) {
            tkimg_snprintf (str, 256, "\tSaturation       : %f\n",   opts->saturation);                        IMGOUT;
            tkimg_snprintf (str, 256, "\tCutOff           : %f%%\n", opts->cutOff);                            IMGOUT;
        }
    }
    Tcl_Flush (outChan);
}

static Boln readHeader (Tcl_Interp *interp, tkimg_Stream *handle, FPF_HEADER *th)
{
    if (tkimg_Read (handle, (char *)th, sizeof(FPF_HEADER)) != sizeof(FPF_HEADER)) {
        return FALSE;
    }

    if (strncmp (th->imgData.fpfId, FPF_ID, strlen (FPF_ID)) != 0) {
        Tcl_AppendResult (interp, "Invalid value for header field FPF_ID:",
                                  "Must be \"FPF Public Image Format\"\n", (char *)NULL);
        return FALSE;
    }

    if (th->imgData.width < 1) {
        Tcl_AppendResult (interp, "Invalid value for header field Width:",
                                  "Must be greater than zero\n", (char *)NULL);
        return FALSE;
    }

    if (th->imgData.height < 1) {
        Tcl_AppendResult (interp, "Invalid value for header field Height:",
                                  "Must be greater than zero\n", (char *)NULL);
        return FALSE;
    }

    if (th->imgData.pixelType != TYPE_SHORT &&
        th->imgData.pixelType != TYPE_INT &&
        th->imgData.pixelType != TYPE_FLOAT &&
        th->imgData.pixelType != TYPE_DOUBLE) {
        Tcl_AppendResult (interp, "Invalid value for header field PixelType:",
                                  "Must be 0, 1, 2 or 3", "\n", (char *)NULL);
        return FALSE;
    }
    return TRUE;
}

/*
 * Here is the start of the standard functions needed for every image format.
 */

/*
 * Prototypes for local procedures defined in this file:
 */

static int CommonMatch(Tcl_Interp *interp, tkimg_Stream *handle,
        Tcl_Obj *format, int *widthPtr, int *heightPtr,
        FPF_HEADER *fpfHeaderPtr);
static int CommonRead(Tcl_Interp *interp, tkimg_Stream *handle,
        const char *filename, Tcl_Obj *format,
        Tk_PhotoHandle imageHandle, int destX, int destY,
        int width, int height, int srcX, int srcY);

static int ParseFormatOpts(
    Tcl_Interp *interp,
    Tcl_Obj *format,
    FMTOPT *opts,
    int mode
) {
    static const char *const readOptions[] = {
         "-verbose", "-min", "-max", "-gamma", "-map",
         "-saturation", "-cutoff", "-printagc", NULL
    };
    enum readEnums {
        R_VERBOSE, R_MIN, R_MAX, R_GAMMA, R_MAP,
        R_SATURATION, R_CUTOFF, R_PRINTAGC
    };
    Tcl_Size objc, i;
    int index;
    char *optionStr;
    Tcl_Obj **objv;
    int boolVal;
    double doubleVal;

    /* Initialize options with default values. */
    opts->verbose    = 0;
    opts->minVal     = -1.0;
    opts->maxVal     = -1.0;
    opts->gamma      = 1.0;
    opts->mapMode    = IMG_MAP_MINMAX;
    opts->saturation = -1.0;
    opts->cutOff     = 3.0;
    opts->printAgc   = 0;

    if (tkimg_ListObjGetElements (interp, format, &objc, &objv) == TCL_ERROR) {
        return TCL_ERROR;
    }
    for (i=1; i<objc; i++) {
        if (mode == IMG_READ) {
            if (Tcl_GetIndexFromObj(interp, objv[i], readOptions,
                    "format option", 0, &index) == TCL_ERROR) {
                return TCL_ERROR;
            }
        } else {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("No write functionality available."));
            return TCL_ERROR;
        }
        if (++i >= objc) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "No value specified for option \"%s\".", Tcl_GetString(objv[--i])));
            return TCL_ERROR;
        }
        optionStr = Tcl_GetString(objv[i]);
        if (mode == IMG_READ) {
            switch(index) {
                case R_VERBOSE: {
                    if (Tcl_GetBoolean(interp, optionStr, &boolVal) == TCL_ERROR) {
                        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                            "Invalid verbose mode \"%s\": must be 1 or 0, on or off, true or false.",
                            optionStr));
                        return TCL_ERROR;
                    }
                    opts->verbose = boolVal;
                    break;
                }
                case R_MIN: {
                    if (Tcl_GetDouble(interp, optionStr, &doubleVal) == TCL_ERROR) {
                        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                            "Invalid minimum map value \"%s\": must be a double value.",
                            optionStr));
                        return TCL_ERROR;
                    }
                    if (doubleVal >= 0.0) {
                        opts->minVal = doubleVal;
                    }
                    break;
                }
                case R_MAX: {
                    if (Tcl_GetDouble(interp, optionStr, &doubleVal) == TCL_ERROR) {
                        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                            "Invalid maximum map value \"%s\": must be a double value.",
                            optionStr));
                        return TCL_ERROR;
                    }
                    if (doubleVal >= 0.0) {
                        opts->maxVal = doubleVal;
                    }
                    break;
                }
                case R_GAMMA: {
                    if (Tcl_GetDouble(interp, optionStr, &doubleVal) == TCL_ERROR || doubleVal < 0.0) {
                        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                            "Invalid gamma value \"%s\": must be a double value greater or equal to zero.",
                            optionStr));
                        return TCL_ERROR;
                    }
                    if (doubleVal >= 0.0) {
                        opts->gamma = doubleVal;
                    }
                    break;
                }
                case R_MAP: {
                    if (!strncmp (optionStr, IMG_MAP_NONE_STR, strlen (IMG_MAP_NONE_STR))) {
                        opts->mapMode = IMG_MAP_NONE;
                    } else if (!strncmp (optionStr, IMG_MAP_MINMAX_STR, strlen (IMG_MAP_MINMAX_STR))) {
                        opts->mapMode = IMG_MAP_MINMAX;
                    } else if (!strncmp (optionStr, IMG_MAP_AGC_STR, strlen (IMG_MAP_AGC_STR))) {
                        opts->mapMode = IMG_MAP_AGC;
                    } else {
                        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                            "Invalid mapping mode \"%s\": must be none, minmax or agc.",
                            optionStr));
                        return TCL_ERROR;
                    }
                    break;
                }
                case R_SATURATION: {
                    if (Tcl_GetDouble(interp, optionStr, &doubleVal) == TCL_ERROR) {
                        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                            "Invalid saturation value \"%s\": must be a double value.",
                            optionStr));
                        return TCL_ERROR;
                    }
                    if (doubleVal >= 0.0) {
                        opts->saturation = doubleVal;
                    }
                    break;
                }
                case R_CUTOFF: {
                    if (Tcl_GetDouble(interp, optionStr, &doubleVal) == TCL_ERROR || doubleVal < 0.0) {
                        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                            "Invalid cutoff value \"%s\": must be a double value greater or equal to zero.",
                            optionStr));
                        return TCL_ERROR;
                    }
                    if (doubleVal >= 0.0) {
                        opts->cutOff = doubleVal;
                    }
                    break;
                }
                case R_PRINTAGC: {
                    if (Tcl_GetBoolean(interp, optionStr, &boolVal) == TCL_ERROR) {
                        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                            "Invalid printagc mode \"%s\": must be 1 or 0, on or off, true or false.",
                            optionStr));
                        return TCL_ERROR;
                    }
                    opts->printAgc = boolVal;
                    break;
                }
            }
        } else {
            /* No write functionality. */
        }
    }

    /* Convert minimum and maximum range values. */
    if (opts->minVal >= 0.0 && opts->maxVal >= 0.0 && opts->minVal >= opts->maxVal) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Invalid min and max values: Maximum must be grater than minimum."));
        return TCL_ERROR;
    }
    return TCL_OK;
}

static int FileMatch(
    Tcl_Channel chan,
    const char *filename,
    Tcl_Obj *format,
    int *widthPtr,
    int *heightPtr,
    Tcl_Interp *interp
) {
    tkimg_Stream handle;
    memset(&handle, 0, sizeof (tkimg_Stream));

    tkimg_ReadInitFile(&handle, chan);

    return CommonMatch (interp, &handle, format, widthPtr, heightPtr, NULL);
}

static int StringMatch(
    Tcl_Obj *dataObj,
    Tcl_Obj *format,
    int *widthPtr,
    int *heightPtr,
    Tcl_Interp *interp
) {
    tkimg_Stream handle;
    memset(&handle, 0, sizeof (tkimg_Stream));

    if (!tkimg_ReadInitString(&handle, dataObj)) {
        return 0;
    }
    return CommonMatch (interp, &handle, format, widthPtr, heightPtr, NULL);
}

static int CommonMatch(
    Tcl_Interp *interp,
    tkimg_Stream *handle,
    Tcl_Obj *format,
    int *widthPtr,
    int *heightPtr,
    FPF_HEADER *fpfHeaderPtr
) {
    FPF_HEADER th;

    if (!readHeader (interp, handle, &th)) {
        return FALSE;
    }
    *widthPtr  = th.imgData.width;
    *heightPtr = th.imgData.height;
    if (fpfHeaderPtr) {
        *fpfHeaderPtr = th;
    }
    return TRUE;
}

static int FileRead(
    Tcl_Interp *interp,         /* Interpreter to use for reporting errors. */
    Tcl_Channel chan,           /* The image channel, open for reading. */
    const char *filename,       /* The name of the image file. */
    Tcl_Obj *format,            /* User-specified format object, or NULL. */
    Tk_PhotoHandle imageHandle, /* The photo image to write into. */
    int destX, int destY,       /* Coordinates of top-left pixel in
                                 * photo image to be written to. */
    int width, int height,      /* Dimensions of block of photo image to
                                 * be written to. */
    int srcX, int srcY          /* Coordinates of top-left pixel to be used
                                 * in image being read. */
) {
    tkimg_Stream handle;
    memset(&handle, 0, sizeof (tkimg_Stream));

    tkimg_ReadInitFile(&handle, chan);

    return CommonRead(interp, &handle, filename, format, imageHandle,
                      destX, destY, width, height, srcX, srcY);
}

static int StringRead(
    Tcl_Interp *interp,
    Tcl_Obj *dataObj,
    Tcl_Obj *format,
    Tk_PhotoHandle imageHandle,
    int destX, int destY,
    int width, int height,
    int srcX, int srcY
) {
    tkimg_Stream handle;
    memset(&handle, 0, sizeof (tkimg_Stream));

    if (!tkimg_ReadInitString(&handle, dataObj)) {
        return 0;
    }

    return CommonRead(interp, &handle, "InlineData", format, imageHandle,
                      destX, destY, width, height, srcX, srcY);
}

static int CommonRead(
    Tcl_Interp *interp,         /* Interpreter to use for reporting errors. */
    tkimg_Stream *handle,        /* The image file, open for reading. */
    const char *filename,       /* The name of the image file. */
    Tcl_Obj *format,            /* User-specified format object, or NULL. */
    Tk_PhotoHandle imageHandle, /* The photo image to write into. */
    int destX, int destY,       /* Coordinates of top-left pixel in
                                 * photo image to be written to. */
    int width, int height,      /* Dimensions of block of photo image to
                                 * be written to. */
    int srcX, int srcY          /* Coordinates of top-left pixel to be used
                                 * in image being read. */
) {
    Tk_PhotoImageBlock block;
    Int y, c;
    Int fileWidth = 0, fileHeight = 0;
    Double minVals[IMG_MAX_CHANNELS], maxVals[IMG_MAX_CHANNELS];
    int stopY, outY, outWidth, outHeight;
    FPF_FILE tf;
    FMTOPT opts;
    UByte  *pixbufPtr;
    Double *doubleBufPtr;
    Float  *floatBufPtr;
    UInt   *uintBufPtr;
    UShort *ushortBufPtr;
    Double gtable[IMG_GAMMA_TABLE_SIZE];
    int result = TCL_OK;
    int nChans = 1;
    Boln swapBytes = FALSE;

    memset (&tf, 0, sizeof (FPF_FILE));

    if (!CommonMatch (interp, handle, format, &fileWidth, &fileHeight, &tf.th)) {
        return TCL_ERROR;
    }

    if (ParseFormatOpts (interp, format, &opts, IMG_READ) == TCL_ERROR) {
        return TCL_ERROR;
    }

    if (opts.verbose) {
        printImgInfo (&tf.th, &opts, filename, "Reading image:");
    }

    if ((srcX + width) > fileWidth) {
        outWidth = fileWidth - srcX;
    } else {
        outWidth = width;
    }
    if ((srcY + height) > fileHeight) {
        outHeight = fileHeight - srcY;
    } else {
        outHeight = height;
    }
    if ((outWidth <= 0) || (outHeight <= 0)
        || (srcX >= fileWidth) || (srcY >= fileHeight)) {
        Tcl_AppendResult(interp, "Width or height are negative", (char *) NULL);
        return TCL_ERROR;
    }

    tkimg_CreateGammaTable (opts.gamma, gtable);

    switch (tf.th.imgData.pixelType) {
        case TYPE_DOUBLE: {
            tf.doubleBuf = (Double *)attemptckalloc (fileWidth*fileHeight*nChans*sizeof (Double));
            if (tf.doubleBuf == NULL) {
                Tcl_AppendResult (interp, "Unable to allocate memory for image data.", (char *) NULL);
                return TCL_ERROR;
            }
            tkimg_ReadDoubleFile (handle, tf.doubleBuf, fileWidth, fileHeight, nChans,
                                  swapBytes, opts.verbose, opts.mapMode != IMG_MAP_NONE,
                                  minVals, maxVals, opts.saturation);
            break;
        }
        case TYPE_FLOAT: {
            tf.floatBuf = (Float *)attemptckalloc (fileWidth*fileHeight*nChans*sizeof (Float));
            if (tf.floatBuf == NULL) {
                Tcl_AppendResult (interp, "Unable to allocate memory for image data.", (char *) NULL);
                return TCL_ERROR;
            }
            tkimg_ReadFloatFile (handle, tf.floatBuf, fileWidth, fileHeight, nChans,
                                 swapBytes, opts.verbose, opts.mapMode != IMG_MAP_NONE,
                                 minVals, maxVals, opts.saturation);
            break;
        }
        case TYPE_INT: {
            tf.uintBuf = (UInt *)attemptckalloc (fileWidth*fileHeight*nChans*sizeof (UInt));
            if (tf.uintBuf == NULL) {
                Tcl_AppendResult (interp, "Unable to allocate memory for image data.", (char *) NULL);
                return TCL_ERROR;
            }
            tkimg_ReadUIntFile (handle, tf.uintBuf, fileWidth, fileHeight, nChans,
                                swapBytes, opts.verbose, opts.mapMode != IMG_MAP_NONE,
                                minVals, maxVals, opts.saturation);
            break;
        }
        case TYPE_SHORT: {
            tf.ushortBuf = (UShort *)attemptckalloc (fileWidth*fileHeight*nChans*sizeof (UShort));
            if (tf.ushortBuf == NULL) {
                Tcl_AppendResult (interp, "Unable to allocate memory for image data.", (char *) NULL);
                return TCL_ERROR;
            }
            tkimg_ReadUShortFile (handle, tf.ushortBuf, fileWidth, fileHeight, nChans,
                                  swapBytes, opts.verbose, opts.mapMode != IMG_MAP_NONE,
                                  minVals, maxVals, opts.saturation);
            break;
        }
        default: {
            Tcl_AppendResult (interp, "Invalid value for pixel type.",
                              "Only short, int, float and double values supported.\n", (char *)NULL);
            return TCL_ERROR;
        }
    }
    switch (opts.mapMode) {
        case IMG_MAP_NONE: {
            for (c=0; c<nChans; c++) {
                minVals[c] = 0.0;
                maxVals[c] = 255.0;
            }
            break;
        }
        case IMG_MAP_MINMAX: {
            if (opts.minVal >= 0.0) {
                for (c=0; c<nChans; c++) {
                    minVals[c] = opts.minVal;
                }
            }
            if (opts.maxVal >= 0.0) {
                for (c=0; c<nChans; c++) {
                    maxVals[c] = opts.maxVal;
                }
            }
            break;
        }
        case IMG_MAP_AGC: {
            /* Nothing to do. Saturation is considered on tkimg_ReadFloatFile. */
            break;
        }
    }

    switch (tf.th.imgData.pixelType) {
        case TYPE_DOUBLE: {
            tkimg_RemapDoubleValues (
                tf.doubleBuf, fileWidth, fileHeight, nChans,
                minVals, maxVals, opts.mapMode == IMG_MAP_AGC? opts.cutOff: -1.0,
                opts.printAgc
            );
            break;
        }
        case TYPE_FLOAT: {
            tkimg_RemapFloatValues (
                tf.floatBuf, fileWidth, fileHeight, nChans,
                minVals, maxVals, opts.mapMode == IMG_MAP_AGC? opts.cutOff: -1.0,
                opts.printAgc
            );
            break;
        }
        case TYPE_INT: {
            tkimg_RemapUIntValues (
                tf.uintBuf, fileWidth, fileHeight, nChans,
                minVals, maxVals, opts.mapMode == IMG_MAP_AGC? opts.cutOff: -1.0,
                opts.printAgc
            );
            break;
        }
        case TYPE_SHORT: {
            tkimg_RemapUShortValues (
                tf.ushortBuf, fileWidth, fileHeight, nChans,
                minVals, maxVals, opts.mapMode == IMG_MAP_AGC? opts.cutOff: -1.0,
                opts.printAgc
            );
            break;
        }
    }

    if (Tk_PhotoExpand (interp, imageHandle, destX + outWidth, destY + outHeight) == TCL_ERROR) {
        fpfClose (&tf);
        return TCL_ERROR;
    }

    tf.pixbuf = (UByte *) attemptckalloc (fileWidth * nChans);
    if (tf.pixbuf == NULL) {
        fpfClose (&tf);
        Tcl_AppendResult (interp, "Unable to allocate memory for image data.", (char *) NULL);
        return TCL_ERROR;
    }

    block.pixelSize = nChans;
    block.pitch = fileWidth * nChans;
    block.width = outWidth;
    block.height = 1;
    block.offset[0] = 0;
    block.offset[1] = (nChans > 1? 1: 0);
    block.offset[2] = (nChans > 2? 2: 0);
    block.offset[3] = (nChans > 3? 3: 0);
    block.pixelPtr = tf.pixbuf + srcX * nChans;

    stopY = srcY + outHeight;
    outY = destY;

    for (y=0; y<stopY; y++) {
        pixbufPtr = tf.pixbuf;
        switch (tf.th.imgData.pixelType) {
            case TYPE_DOUBLE: {
                doubleBufPtr = tf.doubleBuf + y * fileWidth * nChans;
                tkimg_DoubleToUByte (fileWidth * nChans, doubleBufPtr,
                                     opts.gamma != 1.0? gtable: NULL, pixbufPtr);
                doubleBufPtr += fileWidth * nChans;
                break;
            }
            case TYPE_FLOAT: {
                floatBufPtr = tf.floatBuf + y * fileWidth * nChans;
                tkimg_FloatToUByte (fileWidth * nChans, floatBufPtr,
                                    opts.gamma != 1.0? gtable: NULL, pixbufPtr);
                floatBufPtr += fileWidth * nChans;
                break;
            }
            case TYPE_INT: {
                uintBufPtr = tf.uintBuf + y * fileWidth * nChans;
                tkimg_UIntToUByte (fileWidth * nChans, uintBufPtr,
                                   opts.gamma != 1.0? gtable: NULL, pixbufPtr);
                uintBufPtr += fileWidth * nChans;
                break;
            }
            case TYPE_SHORT: {
                ushortBufPtr = tf.ushortBuf + y * fileWidth * nChans;
                tkimg_UShortToUByte (fileWidth * nChans, ushortBufPtr,
                                     opts.gamma != 1.0? gtable: NULL, pixbufPtr);
                ushortBufPtr += fileWidth * nChans;
                break;
            }
        }
        if (y >= srcY) {
            if (Tk_PhotoPutBlock(interp, imageHandle, &block, destX, outY,
                                 width, 1, TK_PHOTO_COMPOSITE_SET) == TCL_ERROR) {
                result = TCL_ERROR;
                break;
            }
            outY++;
        }
    }
    fpfClose (&tf);
    return result;
}

static int FileWrite(
    Tcl_Interp *interp,
    const char *filename,
    Tcl_Obj *format,
    Tk_PhotoImageBlock *blockPtr
) {
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("Writing not supported for format %s", sImageFormat.name));
    return TCL_ERROR;
}

static int StringWrite(
    Tcl_Interp *interp,
    Tcl_Obj *format,
    Tk_PhotoImageBlock *blockPtr
) {
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("Writing not supported for format %s", sImageFormat.name));
    return TCL_ERROR;
}