/* 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: 2004/03/20 05:24:17 $
 * Last modified by: $Author: donahue $
 */

#include <stdio.h>
#include <stdlib.h>
#include <ctype.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

////////////////////////////////////////////////////////////////////////
// MsBitmap and related classes
struct RGBQuad {
  BYTE Red;
  BYTE Green;
  BYTE Blue;
  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 MSFill24(const unsigned char* carr); // Analogous to above,
  /// but takes input from a 3-byte long buffer.
};

int RGBQuad::MSFill32(Tcl_Channel chan)
{ // Note: MS RGBQuad's are ordered "Blue Green Red Reserved"
  char carr[4];
  int count=Tcl_Read(chan,carr,4);
  if(count!=4) return 0;
  Blue=carr[0];    Green=carr[1];
  Red=carr[2];     Reserved=carr[3];
  return count;
}

int 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;
}

class MSBitmap;  // Forward declaration for typedef
typedef int (MSBitmap::*BmpConvert)(const unsigned char* read_buf,
				    RGBQuad* &pix,
				    UINT4 startcol,
				    UINT4 stopcol);

class MSBitmap {
private:
  BYTE  Type[2];
  UINT4 FileSize;
  UINT2 Reserved1;
  UINT2 Reserved2;
  UINT4 OffBits;
  UINT4 BmiSize;
  UINT4 Width;
  UINT4 Height;
  UINT2 Planes;
  UINT2 BitCount;
  UINT4 Compression;
  UINT4 SizeImage;
  UINT4 XPelsPerMeter;
  UINT4 YPelsPerMeter;
  UINT4 ClrUsed;
  UINT4 ClrImportant;
  RGBQuad* Palette;

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

  int FillHeader(Tcl_Channel chan,BOOL fillpalette);
  /// If 'fillpallette' 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.
  UINT4 FileRowSize;
  UINT4 PaletteSize;

  // FillPhoto() bitmap->rgb conversion routines.
  int  Bmp1toRgbq(const unsigned char* read_buf,RGBQuad* &pix,
		  UINT4 startcol,UINT4 stopcol);        //  1 bit/pixel
  int  Bmp4toRgbq(const unsigned char* read_buf,RGBQuad* &pix,
		  UINT4 startcol,UINT4 stopcol);        //  4 bits/pixel
  int  Bmp8toRgbq(const unsigned char* read_buf,RGBQuad* &pix,
		  UINT4 startcol,UINT4 stopcol);        //  8 bits/pixel
  int  Bmp24toRgbq(const unsigned char* read_buf,RGBQuad* &pix,
		  UINT4 startcol,UINT4 stopcol);        // 24 bits/pixel
  BmpConvert DataConvert;

public:
  MSBitmap();
  ~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 MSBitmap::AllocPalette(int size)
{
  FreePalette();
  if((Palette=new RGBQuad[size])!=NULL) {
    PaletteSize=UINT4(size);
    return 1;
  }
  return 0;
}

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

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

MSBitmap::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 MSBitmap::FillHeader(Tcl_Channel chan,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(BYTE));
  if(Type[0]!='B' || Type[1]!='M') return 0;

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

  // MS Bitmap format is little-endian ordered;
  // Adjust byte ordering, if necessary.
#if BYTEORDER != 4321
#if 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);
  int real_size=Tcl_Seek(chan,0,SEEK_END);
  Tcl_Seek(chan,bmistart,SEEK_SET);
  if(real_size!=-1 && (UINT4)real_size!=FileSize) return 0;

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

  // MS Bitmap format is little-endian ordered;
  // Adjust byte ordering, if necessary.
#if BYTEORDER != 4321
#if 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 = &MSBitmap::Bmp1toRgbq;        break;
    case 4:   DataConvert = &MSBitmap::Bmp4toRgbq;        break;
    case 8:   DataConvert = &MSBitmap::Bmp8toRgbq;        break;
    case 24:  DataConvert = &MSBitmap::Bmp24toRgbq;       break;
    default:  DataConvert = BmpConvert(NULL);  break;
    }

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

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

  return 1;
}

int
MSBitmap::Bmp1toRgbq(const unsigned char* read_buf,RGBQuad* &pix,
		     UINT4 startcol,UINT4 stopcol)
{ // 1 bit per pixel, with palette
  UINT4 jstart=8*(startcol/8);
  UINT4 jstop=8*((stopcol+7)/8);
  UINT4 j=jstart;
  RGBQuad offbit=Palette[0];
  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
MSBitmap::Bmp4toRgbq(const unsigned char* read_buf,RGBQuad* &pix,
		     UINT4 startcol,UINT4 stopcol)
{ // 4 bits per pixel, with palette
  UINT4 jstart=2*(startcol/2);
  UINT4 jstop=2*((stopcol+1)/2);
  UINT4 j=jstart;
  while(j<jstop) {
    unsigned int datum=read_buf[j/2];
    UINT4 index1= datum & 0x0F;        // Note bit-order!
    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
MSBitmap::Bmp8toRgbq(const unsigned char* read_buf,RGBQuad* &pix,
		     UINT4 startcol,UINT4 stopcol)
{ // 8 bits per pixel, with palette
  for(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
MSBitmap::Bmp24toRgbq(const unsigned char* read_buf,RGBQuad* &pix,
		      UINT4 startcol,UINT4 stopcol)
{ // True color input file; 24 bits per pixel, no palette
  const int data_width=3;
  for(UINT4 j=startcol;j<stopcol;j++) {
    pix[j-startcol].MSFill24(read_buf+j*data_width);
  }
  return 0;
}

int 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    ||      // No compression
     DataConvert==BmpConvert(NULL)) { // Bits per pixel check
    return 0;
  }

  imagewidth=Width;
  imageheight=Height;

  return 1;
}

int
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    ||      // No compression
     DataConvert==BmpConvert(NULL)) {
    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
  int stoprow  = Height - srcY;
  int startrow = stoprow - reqheight;
  if(startrow<0) { reqheight += startrow; startrow=0; }
  if(UINT4(stoprow)>Height) {
    reqheight -= stoprow-Height;   // Safety
    stoprow = Height;
  }
  int startcol = srcX;
  int stopcol = startcol+reqwidth;
  if(startcol<0) { reqwidth += startcol; startcol=0; }
  if(UINT4(stopcol)>Width) {
    reqwidth -= stopcol-Width;
    stopcol = Width;
  }
  if(startrow>=stoprow || startcol>=stopcol) {
    return TCL_OK; // Nothing to do
  }

  // 
  unsigned char *read_buf=new unsigned char[FileRowSize];
  RGBQuad *pix=new RGBQuad[reqwidth];

  Tk_PhotoImageBlock pib;
  pib.pixelPtr=(unsigned char *)pix;
  pib.width=reqwidth;
  pib.height=1;
  pib.pitch=int(sizeof(RGBQuad)*Width);
  pib.pixelSize=sizeof(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);

  for(UINT4 i= UINT4(startrow);i<UINT4(stoprow);i++) {
    if(Tcl_Read(chan,(char *)read_buf,FileRowSize)==-1) {
      Tcl_ResetResult(interp);
      Tcl_AppendResult(interp,"Input error during read of"
                       " Microsoft .bmp file ",fileName,
                       " bitmap.",(char *)NULL);
      return TCL_ERROR;
    }
    switch((this->*DataConvert)(read_buf,pix,UINT4(startcol),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 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_AutoBuf(fileName),"w",0666);
  if(chan==NULL) return TCL_ERROR;
  int errcode = Tcl_SetChannelOption(interp,chan,"-translation","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 influenced by machine-specific alignment restrictions
  Type[0]='B';  Type[1]='M';
  FileSize  = headsize + blockPtr->height*(3*blockPtr->width + padsize);
  Reserved1 = Reserved2 = 0;
  OffBits   = headsize;
  BmiSize   = headsize-14;
  Width     = blockPtr->width;
  Height    = blockPtr->height;
  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 BYTEORDER != 4321
#if 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] = blockPtr->pixelPtr[pixoff+blockPtr->offset[2]]; // blue
      bgr[1] = blockPtr->pixelPtr[pixoff+blockPtr->offset[1]]; // green
      bgr[2] = 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:
  UINT4m Width;
  UINT4m Height;
  UINT4m Maxvalue;

  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() : Width(0), Height(0), Maxvalue(0) {}
  ~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);

};

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>=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
  unsigned char* pix=new unsigned char[3*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*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::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_AutoBuf(filename),"w",0666);
  if(chan==NULL) return TCL_ERROR;
  int errcode = Tcl_SetChannelOption(interp,chan,"-translation","auto");
  if(errcode!=TCL_OK) {
    Tcl_Close(interp,chan);
    return errcode;
  }

  // Buffer space
  char buf[64*4];

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

  // Write header
  Oc_Snprintf(buf,sizeof(buf),"P3\n%d %d\n%d\n",
	      width,height,maxval);
  if(Tcl_Write(chan,buf,strlen(buf))==-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.
  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]];
      int outlen
	= Oc_Snprintf(buf,sizeof(buf),"%d %d %d\n",red,green,blue);
      if(Tcl_Write(chan,buf,outlen)==-1) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp,"Output error writing"
			 " PPM P3 file: \"",filename,
			 "\"",(char *)NULL);
	Tcl_Close(interp,chan);
	return TCL_ERROR;
      }
    }
  }

  // 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 file "fileName" in PPM P3 format.

  // Buffer space
  char buf[64*4];
  int outlen; // Length of string in buffer

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

  // Write header
  outlen = 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
	= Oc_Snprintf(buf,sizeof(buf),"%d %d %d\n",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" {
  static Tk_ImageFileMatchProc bmpFileMatchProc;
  static Tk_ImageFileReadProc  bmpFileReadProc;
  static Tk_ImageFileWriteProc bmpFileWriteProc;
}


static char bmpnamestr[] = "bmp";

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

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)
{
  MSBitmap msb;
  return msb.FillPhoto(interp,chan,fileName,imageHandle,
		       destX,destY,width,height,srcX,srcY);
}

int bmpFileWriteProc(Tcl_Interp* interp,
		     char* fileName,
		     char* /* format */,
		     Tk_PhotoImageBlock* blockPtr)
{
  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" {
  static Tk_ImageFileMatchProc   ppmFileMatchProc;
  static Tk_ImageFileReadProc    ppmFileReadProc;
  static Tk_ImageFileWriteProc   ppmFileWriteProc;
  static Tk_ImageStringMatchProc ppmStringMatchProc;
  static Tk_ImageStringReadProc  ppmStringReadProc;
  static Tk_ImageStringWriteProc ppmStringWriteProc;
}


static char ppmnamestr[] = "P3";

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

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);
}

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

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

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);
}

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, ab("\n    (in If_Init())"));              \
    return TCL_ERROR

    Oc_AutoBuf ab, ab0, ab1, ab2, ab3;

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

// See note above.
#if (TK_MAJOR_VERSION >= 8)
    Tk_CreatePhotoImageFormat(&bmpformat);
    Tk_CreatePhotoImageFormat(&ppmformat);
#endif

    if (Tcl_PkgProvide(interp, ab("If"), ab1(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
}