/* FILE: if.cc                      -*-Mode: c++-*-
 *
 *	The OOMMF Image Formats extension.
 *
 *	This extension supplies classes which can manipulate
 * various image formats.  When the extension is loaded into
 * an interpreter in which Tk has been loaded, it registers
 * corresponding photo image formats with Tk.
 * 
 * NOTICE: Please see the file ../../LICENSE
 *
 * Last modified on: $Date: 2013/05/22 07:15:30 $
 * Last modified by: $Author: donahue $
 */

#include <assert.h>
#include <ctype.h>
#include <limits>
#include <stdio.h>
#include <string.h>

#define USE_OLD_IMAGE
#define USE_COMPOSITELESS_PHOTO_PUT_BLOCK
#include "oc.h"
#include "if.h"

/* End includes */     // Optional directive to pimake

#if OC_USE_TK

////////////////////////////////////////////////////////////////////////
// MsBitmap and related classes
struct If_RGBQuad {
  OC_BYTE Red;
  OC_BYTE Green;
  OC_BYTE Blue;
  OC_BYTE Reserved;
  int MSFill32(Tcl_Channel chan);  // Fills structure from chan
  /// of MS RGBQuad's, returning the number of bytes read (4),
  /// or 0 on error.
  inline int MSFill32(const unsigned char* carr); // Analogous
  /// to above, but takes input from a 4-byte long buffer.
  inline int MSFill24(const unsigned char* carr); // Analogous
  /// to above, but takes input from a 3-byte long buffer.
  inline int MSFill16_RGB555(const unsigned char* carr); // Fills
  /// from a 16-bit (2-byte) buffer, using a 5-5-5 RGB bit-mask.
  ///  Returns number of bytes read (i.e., 2).
  inline int MSFill16_RGB565(const unsigned char* carr); // Fills
  /// from a 16-bit (2-byte) buffer, using a 5-6-5 RGB bit-mask.
  ///  Returns number of bytes read (i.e., 2).
};

int If_RGBQuad::MSFill32(Tcl_Channel chan)
{ // Note: MS RGBQuad's are ordered "Blue Green Red Reserved"
  //       Assumes 8-8-8 RGB bit-mask.
  char carr[4];
  int count=Tcl_Read(chan,carr,4);
  if(count!=4) return 0;
  Blue=static_cast<OC_BYTE>(carr[0]);    Green=static_cast<OC_BYTE>(carr[1]);
  Red =static_cast<OC_BYTE>(carr[2]); Reserved=static_cast<OC_BYTE>(carr[3]);
  return count;
}

int If_RGBQuad::MSFill32(const unsigned char* carr)
{ // Note: MS RGBQuad's are ordered "Blue Green Red Reserved"
  Blue=carr[0];    Green=carr[1];
  Red=carr[2];     Reserved=carr[3];
  return 4;
}

int If_RGBQuad::MSFill24(const unsigned char* carr)
{ // Note: MS RGBQuad's are ordered "Blue Green Red Reserved"
  Blue=carr[0];    Green=carr[1];
  Red=carr[2];     Reserved=0;
  return 3;
}

int If_RGBQuad::MSFill16_RGB555(const unsigned char* carr)
{ // Note: MS RGBQuad's are ordered "Blue Green Red Reserved"
  // Uses 5-5-5 bit mask
  const unsigned int val = static_cast<unsigned int>(carr[0])
    + static_cast<unsigned int>(carr[1])*256u;
  const unsigned int rmask = 0x7C00;
  const unsigned int gmask = 0x03E0;
  const unsigned int bmask = 0x001F;
  Red   = static_cast<OC_BYTE>((val & rmask)>>7); //  7 == 10 - 3
  Green = static_cast<OC_BYTE>((val & gmask)>>2); //  2 ==  5 - 3
  Blue  = static_cast<OC_BYTE>((val & bmask)<<3); // -3 ==  0 - 3
  Reserved=0;
  return 2;
}

int If_RGBQuad::MSFill16_RGB565(const unsigned char* carr)
{ // Note: MS RGBQuad's are ordered "Blue Green Red Reserved"
  // Uses 5-5-5 bit mask
  const unsigned int val = static_cast<unsigned int>(carr[0])
    + static_cast<unsigned int>(carr[1])*256u;
  const unsigned int rmask = 0xF800;
  const unsigned int gmask = 0x07E0;
  const unsigned int bmask = 0x001F;
  Red   = static_cast<OC_BYTE>((val & rmask)>>8); //  8 == 11 - 3
  Green = static_cast<OC_BYTE>((val & gmask)>>3); //  3 ==  5 - 2
  Blue  = static_cast<OC_BYTE>((val & bmask)<<3); // -3 ==  0 - 3
  Reserved=0;
  return 2;
}

class If_MSBitmap;  // Forward declaration for typedef
typedef int (If_MSBitmap::*BmpConvert)(const unsigned char* read_buf,
				       If_RGBQuad* &pix,
				       OC_UINT4 startcol,
				       OC_UINT4 stopcol);

class If_MSBitmap {
private:
  OC_BYTE  Type[2];
  OC_UINT4 FileSize;
  OC_UINT2 Reserved1;
  OC_UINT2 Reserved2;
  OC_UINT4 OffBits;
  OC_UINT4 BmiSize;
  OC_UINT4 Width;
  OC_UINT4 Height;
  OC_UINT2 Planes;
  OC_UINT2 BitCount;
  OC_UINT4 Compression;
  OC_UINT4 SizeImage;
  OC_UINT4 XPelsPerMeter;
  OC_UINT4 YPelsPerMeter;
  OC_UINT4 ClrUsed;
  OC_UINT4 ClrImportant;
  If_RGBQuad* Palette;

  // Values for Compression field, as defined in WinGDI.h:
  //
  //    BI_RGB        0L
  //    BI_RLE8       1L
  //    BI_RLE4       2L
  //    BI_BITFIELDS  3L
  //    BI_JPEG       4L
  //    BI_PNG        5L
  //
  // NOTE on BitCount and Compression fields:
  // In Windows 3.x, the only supported values for BitCount
  // are 1, 2, 4, 8, and 24.  There is an extension (Win95?)
  // that allows BitCount to be in addition either 16 or 32.
  // These are both direct-mapped (no palette) formats.
  // If BitCount is 16 or 32, and Compression is set to
  // BI_RGB (==0), then the default format masks are used,
  // i.e., RGB555 for 16 bpp, and RGB888 for 32 bpp.  If
  // Compression is set to BI_BITFIELDS (==3), then 3 DWORDS
  // (DWORD = OC_UINT4) follow the header (where the palette
  // would usually be) that specify the RGB format masks.
  // For Win95, the only supported format masks are RGB555
  // and RGB565 for 16bpp, and RGB888 for 32bpp.

  int AllocPalette(OC_UINT4 size); // Returns 1 on success
  void FreePalette();

  int FillHeader(Tcl_Channel chan,OC_BOOL fillpalette);
  /// If 'fillpalette' is true, then fills all data members;
  /// If 'fillpalette' is 0, then fill everything *except*
  /// the palette and related members.
  ///   Returns 1 if successful, 0 if the input does not appear
  /// to be a valid MS bitmap.  Adjusts for alignment and byte
  /// ordering as needed.

  // Support variables, computed from the above
  // Calculate number of bytes in per row in file; by spec,
  // must be divisible by 4.
  OC_UINT4 FileRowSize;
  OC_UINT4 PaletteSize;

  // FillPhoto() bitmap->rgb conversion routines.
  int  Bmp1toRgbq(const unsigned char* read_buf,If_RGBQuad* &pix,
		  OC_UINT4 startcol,OC_UINT4 stopcol);        //  1 bit/pixel
  int  Bmp4toRgbq(const unsigned char* read_buf,If_RGBQuad* &pix,
		  OC_UINT4 startcol,OC_UINT4 stopcol);        //  4 bits/pixel
  int  Bmp8toRgbq(const unsigned char* read_buf,If_RGBQuad* &pix,
		  OC_UINT4 startcol,OC_UINT4 stopcol);        //  8 bits/pixel
  int  Bmp16toRgbq_RGB555(const unsigned char* read_buf,If_RGBQuad* &pix,
                 OC_UINT4 startcol,OC_UINT4 stopcol); // 16 bits/pixel, RGB555
  int  Bmp16toRgbq_RGB565(const unsigned char* read_buf,If_RGBQuad* &pix,
                 OC_UINT4 startcol,OC_UINT4 stopcol); // 16 bits/pixel, RGB565
  int  Bmp24toRgbq(const unsigned char* read_buf,If_RGBQuad* &pix,
		  OC_UINT4 startcol,OC_UINT4 stopcol);        // 24 bits/pixel
  int  Bmp32toRgbq(const unsigned char* read_buf,If_RGBQuad* &pix,
		  OC_UINT4 startcol,OC_UINT4 stopcol);        // 32 bits/pixel
  BmpConvert DataConvert;

public:
  If_MSBitmap();
  ~If_MSBitmap();
  int ReadCheck(Tcl_Channel chan,int& imagewidth,int& imageheight);
  /// Returns 1 if the file on chan looks like a Microsoft BMP
  /// file that we know how to read.

  int FillPhoto(Tcl_Interp*  interp,Tcl_Channel  chan,
	   char* fileName,Tk_PhotoHandle imageHandle,
	   int destX,int destY,int width,int height,int srcX,int srcY);
  /// Fills in imageHandle as requested, one row at a time.

  int WritePhoto(Tcl_Interp*  interp,const char* filename,
		 Tk_PhotoImageBlock* blockPtr);
  // Write PhotoImageBlock to file "filename" in Microsoft
  // 24 bits-per-pixel format.
};

int If_MSBitmap::AllocPalette(OC_UINT4 size)
{
  FreePalette();
  if((Palette=new If_RGBQuad[size])!=NULL) {
    PaletteSize=size;
    return 1;
  }
  return 0;
}

void If_MSBitmap::FreePalette()
{
  if(Palette!=NULL) { delete[] Palette; Palette=NULL; }
  PaletteSize=0;
}

If_MSBitmap::~If_MSBitmap() { FreePalette(); }

If_MSBitmap::If_MSBitmap() :
  FileSize(0),Reserved1(0),Reserved2(0),OffBits(0),
  BmiSize(0),Width(0),Height(0),Planes(0),BitCount(0),Compression(0),
  SizeImage(0),XPelsPerMeter(0),YPelsPerMeter(0),
  ClrUsed(0),ClrImportant(0),Palette(NULL),
  FileRowSize(0),PaletteSize(0),DataConvert(BmpConvert(NULL))
{
  Type[0]=Type[1]='\0';
}

int If_MSBitmap::FillHeader(Tcl_Channel chan,OC_BOOL fillpalette)
{ // Reads members one at a time to avoid differing packing
  // alignment restrictions on various machines.  Returns 1
  // on success.

  // Read and check signature
  Tcl_Read(chan,(char *)Type,2*sizeof(OC_BYTE));
  if(Type[0]!='B' || Type[1]!='M') return 0;

  // Read rest of header
  Tcl_Read(chan,(char *)&FileSize,sizeof(OC_UINT4));
  Tcl_Read(chan,(char *)&Reserved1,sizeof(OC_UINT2));
  Tcl_Read(chan,(char *)&Reserved2,sizeof(OC_UINT2));
  Tcl_Read(chan,(char *)&OffBits,sizeof(OC_UINT4));

  // MS Bitmap format is little-endian ordered;
  // Adjust byte ordering, if necessary.
#if OC_BYTEORDER != 4321
#if OC_BYTEORDER != 1234
#error "Unsupported byte-order format"
#endif
  Oc_Flip4(&FileSize);
  Oc_Flip2(&Reserved1); Oc_Flip2(&Reserved2);
  Oc_Flip4(&OffBits);
#endif

  // Check file size.  Is there no Tcl C interface to the 'file size'
  // proc???
  Oc_SeekPos bmistart=Tcl_Tell(chan);
  Oc_SeekPos real_size=Tcl_Seek(chan,0,SEEK_END);
  Tcl_Seek(chan,bmistart,SEEK_SET);
  if(real_size != static_cast<Oc_SeekPos>(-1) &&
     real_size != static_cast<Oc_SeekPos>(FileSize)) return 0;

  // Otherwise, read in rest of header
  Tcl_Read(chan,(char *)&BmiSize,sizeof(OC_UINT4));
  Tcl_Read(chan,(char *)&Width,sizeof(OC_UINT4));
  Tcl_Read(chan,(char *)&Height,sizeof(OC_UINT4));
  Tcl_Read(chan,(char *)&Planes,sizeof(OC_UINT2));
  Tcl_Read(chan,(char *)&BitCount,sizeof(OC_UINT2));
  Tcl_Read(chan,(char *)&Compression,sizeof(OC_UINT4));
  Tcl_Read(chan,(char *)&SizeImage,sizeof(OC_UINT4));
  Tcl_Read(chan,(char *)&XPelsPerMeter,sizeof(OC_UINT4));
  Tcl_Read(chan,(char *)&YPelsPerMeter,sizeof(OC_UINT4));
  Tcl_Read(chan,(char *)&ClrUsed,sizeof(OC_UINT4));
  Tcl_Read(chan,(char *)&ClrImportant,sizeof(OC_UINT4));

  // MS Bitmap format is little-endian ordered;
  // Adjust byte ordering, if necessary.
#if OC_BYTEORDER != 4321
#if OC_BYTEORDER != 1234
#error "Unsupported byte-order format"
#endif
  Oc_Flip4(&BmiSize);
  Oc_Flip4(&Width);          Oc_Flip4(&Height);
  Oc_Flip2(&Planes);         Oc_Flip2(&BitCount);
  Oc_Flip4(&Compression);    Oc_Flip4(&SizeImage);
  Oc_Flip4(&XPelsPerMeter);  Oc_Flip4(&YPelsPerMeter);
  Oc_Flip4(&ClrUsed);        Oc_Flip4(&ClrImportant);
#endif

  FileRowSize=4*((Width*BitCount+31)/32); // Rows lie on a 4-byte bdry.

  switch(BitCount)
    {
    case 1:   DataConvert = &If_MSBitmap::Bmp1toRgbq;        break;
    case 4:   DataConvert = &If_MSBitmap::Bmp4toRgbq;        break;
    case 8:   DataConvert = &If_MSBitmap::Bmp8toRgbq;        break;
    case 16:  DataConvert = &If_MSBitmap::Bmp16toRgbq_RGB555; break;
    case 24:  DataConvert = &If_MSBitmap::Bmp24toRgbq;       break;
    case 32:  DataConvert = &If_MSBitmap::Bmp32toRgbq;       break;
    default:  DataConvert = BmpConvert(NULL);  break;
    }

  // For BitCount == 16, the default color mask is RGB555.  However,
  // this code also supports RGB565, which is selected by setting the
  // Compression field to BI_BITFIELDS (==3) and putting the proper
  // mask values in the palette area.
  if(Compression == 3) {
    if(BitCount == 16) {
      Tcl_Seek(chan,bmistart+BmiSize,SEEK_SET);
      OC_UINT4 rmask,gmask,bmask;
      Tcl_Read(chan,(char *)&rmask,sizeof(OC_UINT4));
      Tcl_Read(chan,(char *)&gmask,sizeof(OC_UINT4));
      Tcl_Read(chan,(char *)&bmask,sizeof(OC_UINT4));
      if(rmask == 0x7C00 && gmask == 0x03E0 && bmask == 0x001F) {
        DataConvert = &If_MSBitmap::Bmp16toRgbq_RGB555;
      } else if(rmask == 0xF800 && gmask == 0x07E0 && bmask == 0x001F) {
        DataConvert = &If_MSBitmap::Bmp16toRgbq_RGB565;
      } else {
        DataConvert = BmpConvert(NULL); // Unsupported format
      }
    } else {
      DataConvert = BmpConvert(NULL); // Unsupported format
    }
  }

  // If requested, read palette info from file
  FreePalette();
  if(fillpalette) {
    // Position at end of BITMAPINFOHEADER
    Tcl_Seek(chan,bmistart+BmiSize,SEEK_SET);

    OC_UINT4 palsize=ClrUsed;
    if(palsize==0) {
      switch(BitCount)
	{
	case  1: palsize=2;    break;
	case  4: palsize=16;   break;
	case  8: palsize=256;  break;
	case 16: palsize=0;    break;  // High color
	case 24: palsize=0;    break;  // True color
	case 32: palsize=0;    break;  // True color
	default: return 0;     // Invalid BitCount value
	}
    }
    if(palsize>0 &&
       AllocPalette(palsize)!=0) {
      for(OC_UINT4m i=0;i<palsize;i++)
	Palette[i].MSFill32(chan);
    }
  }

  return 1;
}

int
If_MSBitmap::Bmp1toRgbq(const unsigned char* read_buf,If_RGBQuad* &pix,
		     OC_UINT4 startcol,OC_UINT4 stopcol)
{ // 1 bit per pixel, with palette
  OC_UINT4 jstart=8*(startcol/8);
  OC_UINT4 jstop=8*((stopcol+7)/8);
  OC_UINT4 j=jstart;
  If_RGBQuad offbit=Palette[0];
  If_RGBQuad onbit=Palette[1];
  while(j<jstop) {
    unsigned int datum=read_buf[j/8];
    for(unsigned int mask=0x80; mask!=0 ; mask>>=1) {
      // Note bit-order!
      if(j<stopcol && j>=startcol) {
	if((datum & mask)==0) pix[j-startcol]=offbit;
	else                  pix[j-startcol]=onbit;
      }
      j++;
    }
  }
  return 0;
}

int
If_MSBitmap::Bmp4toRgbq(const unsigned char* read_buf,If_RGBQuad* &pix,
		     OC_UINT4 startcol,OC_UINT4 stopcol)
{ // 4 bits per pixel, with palette
  OC_UINT4 jstart=2*(startcol/2);
  OC_UINT4 jstop=2*((stopcol+1)/2);
  OC_UINT4 j=jstart;
  while(j<jstop) {
    unsigned int datum=read_buf[j/2];
    OC_UINT4 index1= datum & 0x0F;        // Note bit-order!
    OC_UINT4 index0= (datum & 0xF0)>>4;
    if(startcol<=j) {
      if(index0>=PaletteSize) return 1;
      pix[j-startcol]=Palette[index0];
    }
    j++;
    if(j<stopcol) {
      if(index1>=PaletteSize) return 1;
      pix[j-startcol]=Palette[index1];
    }
    j++;
  }
  return 0;
}

int
If_MSBitmap::Bmp8toRgbq(const unsigned char* read_buf,If_RGBQuad* &pix,
		     OC_UINT4 startcol,OC_UINT4 stopcol)
{ // 8 bits per pixel, with palette
  for(OC_UINT4 j=startcol;j<stopcol;j++) {
    // Copy values from palette
    unsigned int index=read_buf[j];
    if(index>=PaletteSize) {
      return 1;
    }
    pix[j-startcol]=Palette[index];
  }
  return 0;
}

int
If_MSBitmap::Bmp16toRgbq_RGB555(const unsigned char* read_buf,
                 If_RGBQuad* &pix,OC_UINT4 startcol,OC_UINT4 stopcol)
{ // "High" color input file; 16 bits per pixel, no palette,
  // RGB555 color mask.
  const int data_width=2;
  for(OC_UINT4 j=startcol;j<stopcol;j++) {
    pix[j-startcol].MSFill16_RGB555(read_buf+j*data_width);
  }
  return 0;
}

int
If_MSBitmap::Bmp16toRgbq_RGB565(const unsigned char* read_buf,
                 If_RGBQuad* &pix,OC_UINT4 startcol,OC_UINT4 stopcol)
{ // "High" color input file; 16 bits per pixel, no palette,
  // RGB565 color mask.
  const int data_width=2;
  for(OC_UINT4 j=startcol;j<stopcol;j++) {
    pix[j-startcol].MSFill16_RGB565(read_buf+j*data_width);
  }
  return 0;
}

int
If_MSBitmap::Bmp24toRgbq(const unsigned char* read_buf,If_RGBQuad* &pix,
                         OC_UINT4 startcol,OC_UINT4 stopcol)
{ // True color input file; 24 bits per pixel, no palette
  const int data_width=3;
  for(OC_UINT4 j=startcol;j<stopcol;++j) {
    pix[j-startcol].MSFill24(read_buf+j*data_width);
  }
  return 0;
}

int
If_MSBitmap::Bmp32toRgbq(const unsigned char* read_buf,If_RGBQuad* &pix,
                         OC_UINT4 startcol,OC_UINT4 stopcol)
{ // True color input file; 24 bits per pixel, no palette
  const int data_width=4;
  for(OC_UINT4 j=startcol;j<stopcol;++j) {
    pix[j-startcol].MSFill32(read_buf+j*data_width);
  }
  return 0;
}

int If_MSBitmap::ReadCheck(Tcl_Channel chan,
			int& imagewidth,int& imageheight)
{ // Returns 1 if the file on chan looks like a Microsoft BMP file that
  // we know how to read.
  if(FillHeader(chan,0)==0) return 0; // Invalid header

  // Otherwise, looks like an MS bitmap file.  Check that it is a
  // subformat we support.
  if(Planes!=1         ||      // Only known value
     (Compression!=0 && Compression!=3) ||  // No compression
     DataConvert==BmpConvert(NULL)) { // Bits per pixel check
    return 0;
  }
  assert(Width<=INT_MAX && Height<=INT_MAX);
  imagewidth=static_cast<int>(Width);
  imageheight=static_cast<int>(Height);

  return 1;
}

int
If_MSBitmap::FillPhoto(Tcl_Interp*  interp,Tcl_Channel  chan,
		    char* fileName,Tk_PhotoHandle imageHandle,
		    int destX,int destY,int reqwidth,int reqheight,
		    int srcX,int srcY)
{ // Fills in imageHandle as requested, one row at a time.
  // Returns TCL_OK on success, TCL_ERROR on failure.

  if(FillHeader(chan,1) == 0) {
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp,"Header in file ",fileName,
                     " not recognized as a Microsoft .bmp header",
                     (char *)NULL);
    return TCL_ERROR;
  }

  // Looks like an MS bitmap file.  Check that it is a subformat
  // we support.
  if(Planes!=1         ||      // Only known value
     (Compression!=0 && Compression!=3) ||  // No compression
     DataConvert==BmpConvert(NULL)) { // Bits per pixel check
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp,"Sub-format of Microsoft .bmp file ",
                     fileName," is not currently supported.",
                     (char *)NULL);
    return TCL_ERROR;
  }

  // Deduce working control parameters
  assert(Height<=INT_MAX);
  int stoprow  = static_cast<int>(Height) - srcY;
  int startrow = stoprow - reqheight;
  if(startrow<0) { reqheight += startrow; startrow=0; }
  if(stoprow > static_cast<int>(Height)) {
    reqheight -= stoprow-Height;   // Safety
    stoprow = static_cast<int>(Height);
  }
  int startcol = srcX;
  int stopcol = startcol+reqwidth;
  if(startcol<0) { reqwidth += startcol; startcol=0; }
  assert(Width<=INT_MAX);
  if(stopcol>static_cast<int>(Width)) {
    reqwidth -= stopcol-Width;
    stopcol = static_cast<int>(Width);
  }
  if(startrow>=stoprow || startcol>=stopcol) {
    return TCL_OK; // Nothing to do
  }

  assert(reqwidth>=0);
  unsigned char *read_buf=new unsigned char[FileRowSize];
  If_RGBQuad *pix=new If_RGBQuad[size_t(reqwidth)];

  Tk_PhotoImageBlock pib;
  pib.pixelPtr=(unsigned char *)pix;
  pib.width=reqwidth;
  pib.height=1;
  pib.pitch=int(sizeof(If_RGBQuad)*Width);
  pib.pixelSize=sizeof(If_RGBQuad);
  pib.offset[0]=int(((unsigned char*)&pix[0].Red)   - (unsigned char*)pix);
  pib.offset[1]=int(((unsigned char*)&pix[0].Green) - (unsigned char*)pix);
  pib.offset[2]=int(((unsigned char*)&pix[0].Blue)  - (unsigned char*)pix);
#if (TK_MAJOR_VERSION > 8) \
	|| ((TK_MAJOR_VERSION == 8) && (TK_MINOR_VERSION >= 3))
  // Jan Nijtmans recommends this safe way to disable alpha processing
  pib.offset[3]=pib.offset[0];
#endif

  // Skip unrequested leading rows
  Tcl_Seek(chan,OffBits+startrow*FileRowSize,SEEK_SET);
  assert(FileRowSize <= INT_MAX);
  for(int i= startrow;i<stoprow;i++) {
    if(Tcl_Read(chan,(char *)read_buf,static_cast<int>(FileRowSize))==-1) {
      Tcl_ResetResult(interp);
      Tcl_AppendResult(interp,"Input error during read of"
                       " Microsoft .bmp file ",fileName,
                       " bitmap.",(char *)NULL);
      return TCL_ERROR;
    }
    assert(0<=startcol && startcol==int(OC_UINT4(startcol)));
    assert(0<=stopcol  &&  stopcol==int(OC_UINT4(stopcol)));
    switch((this->*DataConvert)(read_buf,pix,
                                OC_UINT4(startcol),OC_UINT4(stopcol)))
      {
      case 0:  break;
      default:
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp,"Input error during read of"
			 " Microsoft .bmp file ",fileName,
			 " bitmap: Illegal palette index",
			 (char *)NULL);
	return TCL_ERROR;
      }
    Tk_PhotoPutBlock(imageHandle,&pib,destX,destY+stoprow-i-1,
                     reqwidth,1);
  }
  delete[] pix;
  delete[] read_buf;

  return TCL_OK;
}

int If_MSBitmap::WritePhoto
(Tcl_Interp*  interp,
 const char* fileName,
 Tk_PhotoImageBlock* blockPtr)
{ // Write PhotoImageBlock to file "fileName" in Microsoft
  // 24 bits-per-pixel format.

  // Open Tcl channel to handle output
  Tcl_Channel chan
    = Tcl_OpenFileChannel(interp,OC_CONST84_CHAR(fileName),
			  OC_CONST84_CHAR("w"),0666);
  if(chan==NULL) return TCL_ERROR;
  int errcode = Tcl_SetChannelOption(interp,chan,
				     OC_CONST84_CHAR("-translation"),
                                     OC_CONST84_CHAR("binary"));
  if(errcode!=TCL_OK) {
    Tcl_Close(interp,chan);
    return errcode;
  }

  // Row buffer space
  char bgr[3];
  int padsize = (3*blockPtr->width) % 4; // Rows should end on
  if(padsize>0) padsize = 4 - padsize;        // 4-byte boundary.
  char padbgr[3];
  padbgr[0]=padbgr[1]=padbgr[2]='\0';

  // Fill BMP header
  const int headsize=54; // Header size; Don't use sizeof(head) because
  /// that can be influenced by machine-specific alignment restrictions
  assert(blockPtr->width>=0
         && blockPtr->width == int(OC_UINT4(blockPtr->width)));
  assert(blockPtr->height>=0 &&
         blockPtr->height == int(OC_UINT4(blockPtr->height)));
  Width     = static_cast<OC_UINT4>(blockPtr->width);
  Height    = static_cast<OC_UINT4>(blockPtr->height);
  Type[0]='B';  Type[1]='M';
  FileSize = (OC_UINT4(headsize) + Height*(3*Width + OC_UINT4(padsize)));
  Reserved1 = Reserved2 = 0;
  OffBits   = headsize;
  BmiSize   = headsize-14;
  Planes    = 1;
  BitCount  = 24;
  Compression = 0;
  SizeImage = FileSize - headsize;
  XPelsPerMeter = YPelsPerMeter = 0;  // Any better ideas?
  ClrUsed      = 0;
  ClrImportant = 0;
  // MS Bitmap format is little-endian ordered;
  // Adjust byte ordering, if necessary.
#if OC_BYTEORDER != 4321
#if OC_BYTEORDER != 1234
#error "Unsupported byte-order format"
#endif
  Oc_Flip4(&FileSize);
  Oc_Flip2(&Reserved1);      Oc_Flip2(&Reserved2);
  Oc_Flip4(&OffBits);        Oc_Flip4(&BmiSize);
  Oc_Flip4(&Width);          Oc_Flip4(&Height);
  Oc_Flip2(&Planes);         Oc_Flip2(&BitCount);
  Oc_Flip4(&Compression);    Oc_Flip4(&SizeImage);
  Oc_Flip4(&XPelsPerMeter);  Oc_Flip4(&YPelsPerMeter);
  Oc_Flip4(&ClrUsed);        Oc_Flip4(&ClrImportant);
#endif

  // Write header info
  if((-1 == Tcl_Write(chan,(char *)Type,sizeof(Type)))
     || (-1 == Tcl_Write(chan,(char *)&FileSize,sizeof(FileSize)))
     || (-1 == Tcl_Write(chan,(char *)&Reserved1,sizeof(Reserved1)))
     || (-1 == Tcl_Write(chan,(char *)&Reserved1,sizeof(Reserved2)))
     || (-1 == Tcl_Write(chan,(char *)&OffBits,sizeof(OffBits)))
     || (-1 == Tcl_Write(chan,(char *)&BmiSize,sizeof(BmiSize)))
     || (-1 == Tcl_Write(chan,(char *)&Width,sizeof(Width)))
     || (-1 == Tcl_Write(chan,(char *)&Height,sizeof(Height)))
     || (-1 == Tcl_Write(chan,(char *)&Planes,sizeof(Planes)))
     || (-1 == Tcl_Write(chan,(char *)&BitCount,sizeof(BitCount)))
     || (-1 == Tcl_Write(chan,(char *)&Compression,sizeof(Compression)))
     || (-1 == Tcl_Write(chan,(char *)&SizeImage,sizeof(SizeImage)))
     || (-1 == Tcl_Write(chan,(char *)&XPelsPerMeter,sizeof(XPelsPerMeter)))
     || (-1 == Tcl_Write(chan,(char *)&YPelsPerMeter,sizeof(YPelsPerMeter)))
     || (-1 == Tcl_Write(chan,(char *)&ClrUsed,sizeof(ClrUsed)))
     || (-1 == Tcl_Write(chan,(char *)&ClrImportant,sizeof(ClrImportant)))) {
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp,"Output error writing"
		     " Microsoft .bmp file ",fileName,
		     " header.",(char *)NULL);
    Tcl_Close(interp,chan);
    return TCL_ERROR;
  }

  // Write data, from bottom to top.
  for(int i = blockPtr->height;i>0;i--) {
    int pixoff = (i-1) * blockPtr->pitch;
    for(int j=0;j<blockPtr->width;j++,pixoff+=blockPtr->pixelSize) {
      bgr[0] = (char)blockPtr->pixelPtr[pixoff+blockPtr->offset[2]]; // blue
      bgr[1] = (char)blockPtr->pixelPtr[pixoff+blockPtr->offset[1]]; // green
      bgr[2] = (char)blockPtr->pixelPtr[pixoff+blockPtr->offset[0]]; // red
      if(Tcl_Write(chan,bgr,3)==-1) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp,"Output error writing"
			 " Microsoft .bmp file ",fileName,
			 " bitmap.",(char *)NULL);
	Tcl_Close(interp,chan);
	return TCL_ERROR;
      }
    }
    if(padsize>0) {
      if(Tcl_Write(chan,padbgr,padsize)==-1) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp,"Output error writing"
			 " Microsoft .bmp file ",fileName,
			 " bitmap.",(char *)NULL);
	Tcl_Close(interp,chan);
	return TCL_ERROR;
      }
    }
  }

  // Close channel and exit
  return Tcl_Close(interp,chan);
}

////////////////////////////////////////////////////////////////////////
// OOMMF If_PPM class
class If_PPM {
private:
  int ReadNumber(Tcl_Channel chan,int& number);
  char* ReadNumber(char* data,int& number);
  char* ReadHeader(char* data,
		   int& imagewidth,int& imageheight,int& maxval);
public:
  If_PPM() {}
  ~If_PPM() {}
  int ReadCheck(Tcl_Channel chan,int& imagewidth,int& imageheight);
  /// Returns 1 if the file on chan looks like a PPM P3.

  int FillPhoto(Tcl_Interp*  interp,Tcl_Channel  chan,
	   char* fileName,Tk_PhotoHandle imageHandle,
	   int destX,int destY,int width,int height,int srcX,int srcY);
  /// Fills in imageHandle as requested, one row at a time.

  int WritePhoto(Tcl_Interp*  interp,const char* filename,
		 Tk_PhotoImageBlock* blockPtr);
  // Write PhotoImageBlock to file "filename" in PPM P3 format.

  // String versions of the above
  int ReadCheck(char* data,int& imagewidth,int& imageheight);
  int FillPhoto(Tcl_Interp*  interp,char* data,Tk_PhotoHandle imageHandle,
		int destX,int destY,int width,int height,int srcX,int srcY);
  int WritePhoto(Tcl_Interp*  interp,Tcl_DString* dataPtr,
		 Tk_PhotoImageBlock* blockPtr);


private:
  int SprintColorValues(unsigned char* buf,
                        int red,int green,int blue);

};

int If_PPM::ReadNumber(Tcl_Channel chan,int& number)
{ // Consumes the next integer on chan, and also the first subsequent
  // non-number character, from chan.  Converts from text to int,
  // storing the result in the export "number". Returns 0 on success,
  // otherwise an errorcode>0.
  
  number = 0; // Safety

  // Pass over whitespace and comments
  char ch;
  while(1) {
    if(Tcl_Read(chan,&ch,sizeof(char))!=1) {
      // Premature EOF
      return 1;
    }
    if(!isspace(ch)) {
      if(ch!='#') break; // Start of number detected
      // Otherwise, comment detected; read to end of line
      while(Tcl_Read(chan,&ch,sizeof(char))==1 && ch!='\n') {}
    }
  }

  // At this point, ch should hold first non-whitespace
  // character outside of any comments.

  char buf[65]; // Should be big enough
  buf[0]=ch;
  int i=1;
  while(Tcl_Read(chan,buf+i,sizeof(char))==1 && isdigit(buf[i])) {
    i++;
    if( i >= static_cast<int>(sizeof(buf)-1) ) break;
  }
  buf[i]='\0';

  char* cptr;
  long int lnum = strtol(buf,&cptr,10);
  number = static_cast<int>(lnum);
  if(*cptr != '\0') return 2;
  return 0;
}

char* If_PPM::ReadNumber(char* data,int& number)
{ // After skipping leading whitespace and comments,
  // converts the first integer from text to int,
  // storing the result in the export "number".
  // On success, the return points to the first
  // character past the end of the converted number.
  // Returns NULL on failure

  number = 0; // Safety

  // Pass over whitespace and comments
  char* cptr = data;
  while(cptr!=NULL) {
    if(!isspace(*cptr)) {
      if(*cptr!='#') break; // Start of number detected
      // Otherwise, comment detected; read to end of line
      if((cptr = strchr(cptr,'\n'))==NULL) return NULL;
    }
    ++cptr;
  }

  // At this point, cptr should point to the first non-whitespace
  // character outside of any comments.
  long int lnum = strtol(cptr,&cptr,10);
  number = static_cast<int>(lnum);
  return cptr;
}

int If_PPM::ReadCheck
(Tcl_Channel chan,int& imagewidth,int& imageheight)
{ // Returns 1 if the file on chan looks like a PPM P3

  // Read and check signature
  char type[2];
  Tcl_Read(chan,type,2*sizeof(char));
  if(type[0]!='P' || type[1]!='3') return 0;

  if(ReadNumber(chan,imagewidth)!=0)  return 0;
  if(ReadNumber(chan,imageheight)!=0) return 0;
  
  return 1;
}

char* If_PPM::ReadHeader
(char* data,int& imagewidth,int& imageheight,int& maxval)
{ // Returns NULL if the data doesn't looks like PPM P3
  // data.  Otherwise, returns pointer to first byte
  // past header.

  // Check signature
  if(data[0]!='P' || data[1]!='3') return NULL;

  char* cptr = data + 2;
  if((cptr = ReadNumber(cptr,imagewidth))==NULL)  return NULL;
  if((cptr = ReadNumber(cptr,imageheight))==NULL) return NULL;
  if((cptr = ReadNumber(cptr,maxval))==NULL) return NULL;
  
  return cptr;
}

int If_PPM::ReadCheck
(char* data,int& imagewidth,int& imageheight)
{ // Returns 1 if the data looks like a PPM P3
  int maxval;
  if(ReadHeader(data,imagewidth,imageheight,maxval)==NULL) {
    return 0;
  }
  return 1;
}

int If_PPM::FillPhoto
(Tcl_Interp*  interp,Tcl_Channel  chan,
 char* fileName,Tk_PhotoHandle imageHandle,
 int destX,int destY,int width,int height,int srcX,int srcY)
{ // Fills in imageHandle as requested, one row at a time.
  // Returns TCL_OK on success, TCL_ERROR on failure.

  int imagewidth,imageheight;
  if(ReadCheck(chan,imagewidth,imageheight)==0) {
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp,"Header in file ",fileName,
                     " not recognized as a PPM P3 header.",
                     (char *)NULL);
    return TCL_ERROR;
  }

  int maxvalue;
  if(ReadNumber(chan,maxvalue)!=0) {
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp,"File ",fileName,
                     " doesn't conform to PPM P3 format (bad maxvalue).",
                     (char *)NULL);
    return TCL_ERROR;
  }

  // Safety checks
  if(srcX<0) { width += srcX; srcX=0; }
  if(srcX+width>imagewidth) {
    width = imagewidth-srcX;
  }
  if(srcY<0) {height += srcY; srcY=0; }
  if(srcY+height>imageheight) {
    height = imageheight-srcY;
  }
  if(width<1 || height<1) return TCL_OK; // Nothing to do


  // Skip through file until we get to (srcX,srcY)
  int i,j;
  int red,green,blue;
  for(i=0;i<srcY;i++) {
    for(j=0;j<imagewidth;j++) {
      int errcode = ReadNumber(chan,red);
      errcode += ReadNumber(chan,green);
      errcode += ReadNumber(chan,blue);
      if(errcode != 0) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp,"File ",fileName,
			 " doesn't conform to PPM P3 format (bad data).",
			 (char *)NULL);
	return TCL_ERROR;
      }
    }
  }
  for(j=0;j<srcX;j++) {
    int errcode = ReadNumber(chan,red);
    errcode += ReadNumber(chan,green);
    errcode += ReadNumber(chan,blue);
    if(errcode != 0) {
      Tcl_ResetResult(interp);
      Tcl_AppendResult(interp,"File ",fileName,
		       " doesn't conform to PPM P3 format (bad data).",
		       (char *)NULL);
      return TCL_ERROR;
    }
  }

  // Setup Tk_PhotoImageBlock for writing data
  assert(width>=0);
  unsigned char* pix=new unsigned char[3*size_t(width)];
  Tk_PhotoImageBlock pib;
  pib.pixelPtr=(unsigned char *)pix;
  pib.width=width;
  pib.height=1;
  pib.pixelSize = 3*sizeof(pix[0]);
  pib.pitch=int(pib.pixelSize*imagewidth);
  pib.offset[0]=int(((unsigned char*)&pix[0]) - (unsigned char*)pix);
  pib.offset[1]=int(((unsigned char*)&pix[1]) - (unsigned char*)pix);
  pib.offset[2]=int(((unsigned char*)&pix[2]) - (unsigned char*)pix);
#if (TK_MAJOR_VERSION > 8) \
	|| ((TK_MAJOR_VERSION == 8) && (TK_MINOR_VERSION >= 3))
  // Jan Nijtmans recommends this safe way to disable alpha processing
  pib.offset[3]=pib.offset[0];
#endif

  // Read and write data
  for(i=0;i<height;i++) {
    for(j=0;j<width;j++) {
      int errcode = ReadNumber(chan,red);
      errcode += ReadNumber(chan,green);
      errcode += ReadNumber(chan,blue);
      if(errcode != 0) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp,"File ",fileName,
			 " doesn't conform to PPM P3 format (bad data).",
			 (char *)NULL);
	delete[] pix;
	return TCL_ERROR;
      }
      // Convert to implicit(?) palette
      // NOTE: Potential overflow problems, if maxvalue*256 doesn't
      //  fit in a signed integer.  But since this event seems
      //  rather unlikely, so we'll just ignore that possibility 
      //  for now.
      pix[3*j]
	= static_cast<unsigned char>((red*255   + maxvalue/2)/maxvalue);
      pix[3*j+1]
	= static_cast<unsigned char>((green*255 + maxvalue/2)/maxvalue);
      pix[3*j+2]
	= static_cast<unsigned char>((blue*255  + maxvalue/2)/maxvalue);
    }
    // Write row
    Tk_PhotoPutBlock(imageHandle,&pib,destX,destY+i,width,1);
    // Skip through to next row
    for(j=width;j<imagewidth;j++) {
      int errcode = ReadNumber(chan,red);
      errcode += ReadNumber(chan,green);
      errcode += ReadNumber(chan,blue);
      if(errcode != 0) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp,"File ",fileName,
			 " doesn't conform to PPM P3 format (bad data).",
			 (char *)NULL);
	delete[] pix;
	return TCL_ERROR;
      }
    }
  }
  
  delete[] pix;
  return TCL_OK;
}

int If_PPM::FillPhoto
(Tcl_Interp*  interp,char* data,
 Tk_PhotoHandle imageHandle,
 int destX,int destY,int width,int height,int srcX,int srcY)
{ // Fills in imageHandle as requested, one row at a time.
  // Returns TCL_OK on success, TCL_ERROR on failure.

  int imagewidth,imageheight,maxvalue;
  char* cptr = ReadHeader(data,imagewidth,imageheight,maxvalue);
  if(cptr==NULL) {
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp,
		     "Data header not recognized as a PPM P3 header.",
                     (char *)NULL);
    return TCL_ERROR;
  }

  // Safety checks
  if(srcX<0) { width += srcX; srcX=0; }
  if(srcX+width>imagewidth) {
    width = imagewidth-srcX;
  }
  if(srcY<0) {height += srcY; srcY=0; }
  if(srcY+height>imageheight) {
    height = imageheight-srcY;
  }
  if(width<1 || height<1) return TCL_OK; // Nothing to do


  // Skip through file until we get to (srcX,srcY)
  int i,j;
  int red,green,blue;
  for(i=0;i<srcY;i++) {
    for(j=0;j<imagewidth;j++) {
      if((cptr = ReadNumber(cptr,red))==NULL
	 || (cptr = ReadNumber(cptr,green))==NULL
	 || (cptr = ReadNumber(cptr,blue))==NULL) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp,
			 "Data doesn't conform to PPM P3 format.",
			 (char *)NULL);
	return TCL_ERROR;
      }
    }
  }
  for(j=0;j<srcX;j++) {
    if((cptr = ReadNumber(cptr,red))==NULL
       || (cptr = ReadNumber(cptr,green))==NULL
       || (cptr = ReadNumber(cptr,blue))==NULL) {
      Tcl_ResetResult(interp);
      Tcl_AppendResult(interp,
		       "Data doesn't conform to PPM P3 format.",
		       (char *)NULL);
      return TCL_ERROR;
    }
  }

  // Setup Tk_PhotoImageBlock for writing data
  unsigned char* pix=new unsigned char[3*size_t(width)];
  Tk_PhotoImageBlock pib;
  pib.pixelPtr=(unsigned char *)pix;
  pib.width=width;
  pib.height=1;
  pib.pixelSize = 3*sizeof(pix[0]);
  pib.pitch=int(pib.pixelSize*imagewidth);
  pib.offset[0]=int(((unsigned char*)&pix[0]) - (unsigned char*)pix);
  pib.offset[1]=int(((unsigned char*)&pix[1]) - (unsigned char*)pix);
  pib.offset[2]=int(((unsigned char*)&pix[2]) - (unsigned char*)pix);
#if (TK_MAJOR_VERSION > 8) \
	|| ((TK_MAJOR_VERSION == 8) && (TK_MINOR_VERSION >= 3))
  // Jan Nijtmans recommends this safe way to disable alpha processing
  pib.offset[3]=pib.offset[0];
#endif

  // Read and write data
  for(i=0;i<height;i++) {
    for(j=0;j<width;j++) {
      if((cptr = ReadNumber(cptr,red))==NULL
	 || (cptr = ReadNumber(cptr,green))==NULL
	 || (cptr = ReadNumber(cptr,blue))==NULL) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp,
			 "Data doesn't conform to PPM P3 format.",
			 (char *)NULL);
	delete[] pix;
	return TCL_ERROR;
      }
      // Convert to implicit(?) palette
      // NOTE: Potential overflow problems, if maxvalue*256 doesn't
      //  fit in a signed integer.  But since this event seems
      //  rather unlikely, so we'll just ignore that possibility 
      //  for now.
      pix[3*j]
	= static_cast<unsigned char>((red*255   + maxvalue/2)/maxvalue);
      pix[3*j+1]
	= static_cast<unsigned char>((green*255 + maxvalue/2)/maxvalue);
      pix[3*j+2]
	= static_cast<unsigned char>((blue*255  + maxvalue/2)/maxvalue);
    }
    // Write row
    Tk_PhotoPutBlock(imageHandle,&pib,destX,destY+i,width,1);
    // Skip through to next row
    for(j=width;j<imagewidth;j++) {
      if((cptr = ReadNumber(cptr,red))==NULL
	 || (cptr = ReadNumber(cptr,green))==NULL
	 || (cptr = ReadNumber(cptr,blue))==NULL) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp,
			 "Data doesn't conform to PPM P3 format.",
			 (char *)NULL);
	delete[] pix;
	return TCL_ERROR;
      }
    }
  }

  delete[] pix;
  return TCL_OK;
}

int If_PPM::SprintColorValues(unsigned char* buf,
                              int red,int green,int blue) {
  // Code assumes 0<=red,green,blue<=999, and that the character
  // values for 0,1,...,9 are consecutive.

  unsigned char* cptr=buf;

  // Red part
  int rh = red/100;     // Hundreds
  int rtmp = red - rh*100;
  int rt = rtmp/10;      // Tens
  int ro = rtmp - rt*10; // Ones
  if(rh>0)         *(cptr++) = static_cast<unsigned char>('0' + rh);
  if(rh>0 || rt>0) *(cptr++) = static_cast<unsigned char>('0' + rt);
  *(cptr++) = static_cast<unsigned char>('0' + ro);
  *(cptr++) = ' ';

  // Green part
  int gh = green/100;     // Hundreds
  int gtmp = green - gh*100;
  int gt = gtmp/10;      // Tens
  int go = gtmp - gt*10; // Ones
  if(gh>0)         *(cptr++) = static_cast<unsigned char>('0' + gh);
  if(gh>0 || gt>0) *(cptr++) = static_cast<unsigned char>('0' + gt);
  *(cptr++) = static_cast<unsigned char>('0' + go);
  *(cptr++) = ' ';

  // Blue part
  int bh = blue/100;     // Hundreds
  int btmp = blue - bh*100;
  int bt = btmp/10;      // Tens
  int bo = btmp - bt*10; // Ones
  if(bh>0)         *(cptr++) = static_cast<unsigned char>('0' + bh);
  if(bh>0 || bt>0) *(cptr++) = static_cast<unsigned char>('0' + bt);
  *(cptr++) = static_cast<unsigned char>('0' + bo);
  *(cptr++) = '\n';

  return static_cast<int>(cptr-buf);
}

int If_PPM::WritePhoto
(Tcl_Interp*  interp,const char* filename,
 Tk_PhotoImageBlock* blockPtr)
{ // Write PhotoImageBlock to file "fileName" in PPM P3 format.

  // Open Tcl channel to handle output
  Tcl_Channel chan
    = Tcl_OpenFileChannel(interp,OC_CONST84_CHAR(filename),
			  OC_CONST84_CHAR("w"),0666);
  if(chan==NULL) return TCL_ERROR;
  int errcode = Tcl_SetChannelOption(interp,chan,
				     OC_CONST84_CHAR("-translation"),
                                     OC_CONST84_CHAR("auto"));
  if(errcode!=TCL_OK) {
    Tcl_Close(interp,chan);
    return errcode;
  }
  errcode = Tcl_SetChannelOption(interp,chan,OC_CONST84_CHAR("-buffering"),
                                 OC_CONST84_CHAR("full"));
  if(errcode!=TCL_OK) {
    Tcl_Close(interp,chan);
    return errcode;
  }
  errcode = Tcl_SetChannelOption(interp,chan,OC_CONST84_CHAR("-buffersize"),
                                 OC_CONST84_CHAR("131072"));
  if(errcode!=TCL_OK) {
    Tcl_Close(interp,chan);
    return errcode;
  }

  // Buffer space
# define IF_PPM_MAXCHUNKSIZE (3*4) // Max length of string repr. for pixel
# define IF_PPM_WPBUFSIZE (4096*IF_PPM_MAXCHUNKSIZE)
  unsigned char buf[IF_PPM_WPBUFSIZE+1];
  /// Space for minimum of IF_PPM_WPBUFSIZE/IF_PPM_MAXCHUNKSIZE pixels,
  /// + 1 (safety).
  assert(IF_PPM_WPBUFSIZE>IF_PPM_MAXCHUNKSIZE); // Otherwise
  /// ::SprintColorValues will overflow buffer.

  // Header info
  int width  = blockPtr->width;
  int height = blockPtr->height;
  int maxval = 255; // Assumed

  // Write header
  Oc_Snprintf(reinterpret_cast<char *>(buf),
              sizeof(buf),"P3\n%d %d\n%d\n",
	      width,height,maxval);
  size_t buf_strlen = strlen(reinterpret_cast<char *>(buf));
  assert(buf_strlen<=INT_MAX);
  if(Tcl_Write(chan,reinterpret_cast<char *>(buf),
               static_cast<int>(buf_strlen))==-1) {
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp,"Output error writing"
		     " PPM P3 file: \"",filename,
		     "\"",(char *)NULL);
    Tcl_Close(interp,chan);
    return TCL_ERROR;
  }

  // Write data, from top to bottom.
  int bufoff = 0;
  for(int i = 0 ; i < height ; i++) {
    int pixoff = i * blockPtr->pitch;
    for(int j=0;j<width;j++,pixoff+=blockPtr->pixelSize) {
      int red   = blockPtr->pixelPtr[pixoff+blockPtr->offset[0]];
      int green = blockPtr->pixelPtr[pixoff+blockPtr->offset[1]];
      int blue  = blockPtr->pixelPtr[pixoff+blockPtr->offset[2]];
      if(bufoff + IF_PPM_MAXCHUNKSIZE >= IF_PPM_WPBUFSIZE) {
        // Flush buffer
        if(Tcl_Write(chan,(char*)buf,bufoff)==-1) {
          Tcl_ResetResult(interp);
          Tcl_AppendResult(interp,"Output error writing"
                           " PPM P3 file: \"",filename,
                           "\"",(char *)NULL);
          Tcl_Close(interp,chan);
          return TCL_ERROR;
        }
        bufoff=0;
      }
      bufoff += SprintColorValues(buf+bufoff,
                                  red,green,blue);
    }
  }
  if(bufoff>0) {
    // Flush buffer
    if(Tcl_Write(chan,(char*)buf,bufoff)==-1) {
      Tcl_ResetResult(interp);
      Tcl_AppendResult(interp,"Output error writing"
                       " PPM P3 file: \"",filename,
                       "\"",(char *)NULL);
      Tcl_Close(interp,chan);
      return TCL_ERROR;
    }
  }
# undef IF_PPM_WPBUFSIZE
# undef IF_PPM_MAXCHUNKSIZE

  // Close channel and exit
  return Tcl_Close(interp,chan);
}

int If_PPM::WritePhoto
(Tcl_Interp* /* interp */,Tcl_DString* dataPtr,
 Tk_PhotoImageBlock* blockPtr)
{ // Write PhotoImageBlock to data string in PPM P3 format.

  // Buffer space
  char buf[64*4];
  assert(sizeof(buf)>3*4); // Otherwise ::SprintColorValues will
     /// overflow buffer.
  int outlen; // Length of string in buffer

  // Header info
  int width  = blockPtr->width;
  int height = blockPtr->height;
  int maxval = 255; // Assumed

  // Write header
  outlen = (int)Oc_Snprintf(buf,sizeof(buf),"P3\n%d %d\n%d\n",
                            width,height,maxval);
  Tcl_DStringInit(dataPtr);
  Tcl_DStringAppend(dataPtr,buf,outlen);

  // Write data, from top to bottom.
  for(int i = 0 ; i < height ; i++) {
    int pixoff = i * blockPtr->pitch;
    for(int j=0;j<width;j++,pixoff+=blockPtr->pixelSize) {
      int red   = blockPtr->pixelPtr[pixoff+blockPtr->offset[0]];
      int green = blockPtr->pixelPtr[pixoff+blockPtr->offset[1]];
      int blue  = blockPtr->pixelPtr[pixoff+blockPtr->offset[2]];
      outlen = (int)SprintColorValues((unsigned char*)buf,red,green,blue);
      Tcl_DStringAppend(dataPtr,buf,outlen);
    }
  }

  return TCL_OK;
}


// The C interface for extending the photo image formats changed
// incompatibly between versions 4 and 8 of Tk.  May want to code a
// workaround eventually.  For now, the bmp and ppm p3 photo image
// formats are simply not available in pre-8.0 interpreters.
#if (TK_MAJOR_VERSION >= 8)
extern "C" {
  Tk_ImageFileMatchProc bmpFileMatchProc;
  Tk_ImageFileReadProc  bmpFileReadProc;
  Tk_ImageFileWriteProc bmpFileWriteProc;
}


static char bmpnamestr[] = "BMP";

extern "C" int
bmpFileMatchProc(Tcl_Channel chan,
                 char*        /* fileName */,
                 char*        /* formatString */,
                 int         *widthPtr,
                 int         *heightPtr)
{
  If_MSBitmap msb;
  return msb.ReadCheck(chan,*widthPtr,*heightPtr);
}

extern "C" int
bmpFileReadProc(Tcl_Interp*  interp,
                Tcl_Channel  chan,
                char*        fileName,
                char*        /* formatString */,
                Tk_PhotoHandle imageHandle,
                int destX,int destY,
                int width,int height,
                int srcX,int srcY)
{
  If_MSBitmap msb;
  return msb.FillPhoto(interp,chan,fileName,imageHandle,
		       destX,destY,width,height,srcX,srcY);
}

extern "C" int
bmpFileWriteProc(Tcl_Interp* interp,
		 char* fileName,
		 char* /* format */,
		 Tk_PhotoImageBlock* blockPtr)
{
  If_MSBitmap msb;
  return msb.WritePhoto(interp,fileName,blockPtr);
}

static Tk_PhotoImageFormat bmpformat = 
{
  bmpnamestr,             // Format name
  bmpFileMatchProc,       // File format identifier routine
  NULL,                   // String format id routine
  bmpFileReadProc,        // File read routine
  NULL,                   // String read routine
  bmpFileWriteProc,       // File write routine
  NULL,                   // String write routine
  NULL			  // NULL nextPtr to be overwritten by Tk
};

extern "C" {
  Tk_ImageFileMatchProc   ppmFileMatchProc;
  Tk_ImageFileReadProc    ppmFileReadProc;
  Tk_ImageFileWriteProc   ppmFileWriteProc;
  Tk_ImageStringMatchProc ppmStringMatchProc;
  Tk_ImageStringReadProc  ppmStringReadProc;
  Tk_ImageStringWriteProc ppmStringWriteProc;
}


static char ppmnamestr[] = "P3";

extern "C" int
ppmFileMatchProc(Tcl_Channel chan,
                 char*        /* filename */,
                 char*        /* formatString */,
                 int*         widthPtr,
                 int*         heightPtr)
{
  If_PPM ppm;
  return ppm.ReadCheck(chan,*widthPtr,*heightPtr);
}

extern "C" int
ppmFileReadProc(Tcl_Interp*  interp,
                Tcl_Channel  chan,
                char*        filename,
                char*        /* formatString */,
                Tk_PhotoHandle imageHandle,
                int destX, int destY,
                int width, int height,
                int srcX,  int srcY)
{
  If_PPM ppm;
  return ppm.FillPhoto(interp,chan,filename,imageHandle,
		       destX,destY,width,height,srcX,srcY);
}

extern "C" int
ppmFileWriteProc(Tcl_Interp* interp,
		 char* filename,
		 char* /* format */,
		 Tk_PhotoImageBlock* blockPtr)
{
  If_PPM ppm;
  return ppm.WritePhoto(interp,filename,blockPtr);
}

extern "C" int
ppmStringMatchProc(char* data,
		   char* /* formatString */,
		   int* widthPtr,
		   int* heightPtr)
{
  If_PPM ppm;
  return ppm.ReadCheck(data,*widthPtr,*heightPtr);
}

extern "C" int
ppmStringReadProc(Tcl_Interp *interp,
		  char* data,
		  char* /* formatString */,
		  Tk_PhotoHandle imageHandle,
		  int destX, int destY,
		  int width, int height,
		  int srcX,  int srcY)
{
  If_PPM ppm;
  return ppm.FillPhoto(interp,data,imageHandle,
		       destX,destY,width,height,srcX,srcY);
}

extern "C" int
ppmStringWriteProc(Tcl_Interp* interp,
		   Tcl_DString* dataPtr,
		   char* /* formatString */,
		   Tk_PhotoImageBlock* blockPtr)
{
  If_PPM ppm;
  return ppm.WritePhoto(interp,dataPtr,blockPtr);
}


static Tk_PhotoImageFormat ppmformat = 
{
  ppmnamestr,             // Format name
  ppmFileMatchProc,       // File format identifier routine
  ppmStringMatchProc,     // String format id routine
  ppmFileReadProc,        // File read routine
  ppmStringReadProc,      // String read routine
  ppmFileWriteProc,       // File write routine
  ppmStringWriteProc,     // String write routine
  NULL			  // NULL nextPtr to be overwritten by Tk
};
#endif

int 
If_Init(Tcl_Interp *interp)
{
#define RETURN_TCL_ERROR                                               \
    Tcl_AddErrorInfo(interp, OC_CONST84_CHAR("\n    (in If_Init())")); \
    return TCL_ERROR

    if (Tcl_PkgPresent(interp, OC_CONST84_CHAR("Oc"),
		       OC_CONST84_CHAR("2"), 0) == NULL) {
        Tcl_AppendResult(interp,
		OC_CONST84_CHAR("\n\t(If " IF_VERSION " needs Oc 2)"),
                NULL);
        RETURN_TCL_ERROR;
    }

// See note above.
#if (TK_MAJOR_VERSION >= 8)
# if 0
    // As of 2007-10-30, the BMP handler in this file handles
    // some 16-bit BMP formats not inside Img, so we load our
    // BMP code regardless.
    if(Tcl_PkgPresent(interp,OC_CONST84_CHAR("Img"),NULL,0)==NULL) {
      // The Img package provides support for BMP, so
      // don't load our BMP handler if Img is already
      // loaded.
      Tk_CreatePhotoImageFormat(&bmpformat);
    }
# else
    Tk_CreatePhotoImageFormat(&bmpformat);
# endif
    Tk_CreatePhotoImageFormat(&ppmformat);
#endif

    if (Tcl_PkgProvide(interp, OC_CONST84_CHAR("If"),
		       OC_CONST84_CHAR(IF_VERSION)) != TCL_OK) {
        RETURN_TCL_ERROR;
    }

/*
 * Currently there is no Tcl part to the If extension
 *
    if (Oc_InitScript(interp, "If", IF_VERSION) != TCL_OK) {
        RETURN_TCL_ERROR;
    }
 *
 */

    return TCL_OK;

#undef RETURN_TCL_ERROR
}

#else /* !OC_USE_TK */

int 
If_Init(Tcl_Interp *interp)
{
  Tcl_AppendResult(interp,
                   OC_CONST84_CHAR("\n\t(If " IF_VERSION
                     " requires Tk (this is a no-Tk build of OOMMF)"),
                   NULL);
  Tcl_AddErrorInfo(interp, OC_CONST84_CHAR("\n    (in If_Init())"));
  return TCL_ERROR;
}

#endif /* OC_USE_TK */
