diff -crN oommf11b2/app/mmdisp/scripts/avf2ppm.tcl oommf/app/mmdisp/scripts/avf2ppm.tcl *** oommf11b2/app/mmdisp/scripts/avf2ppm.tcl Wed Dec 31 15:58:03 2003 --- oommf/app/mmdisp/scripts/avf2ppm.tcl Wed Dec 13 03:39:24 2006 *************** *** 61,70 **** } {Post-processing programs to apply to output} Oc_CommandLine Option [Oc_CommandLine Switch] { ! {file {} {Input vector field file}} ! {{files list} {} {Additional input vector field files}} } { ! global infile; set infile [linsert $files 0 $file] } {End of options; next argument is file} Oc_CommandLine Parse $argv --- 61,69 ---- } {Post-processing programs to apply to output} Oc_CommandLine Option [Oc_CommandLine Switch] { ! {{file list} {} {Input vector field file(s)}} } { ! global infile; set infile $file } {End of options; next argument is file} Oc_CommandLine Parse $argv diff -crN oommf11b2/app/mmsolve/any2ppm.tcl oommf/app/mmsolve/any2ppm.tcl *** oommf11b2/app/mmsolve/any2ppm.tcl Wed Dec 24 12:53:35 2003 --- oommf/app/mmsolve/any2ppm.tcl Wed Dec 13 03:39:20 2006 *************** *** 60,90 **** # lowercase. This provides the conventional extension for # all the cases I know about. if {[string match jpeg* [string tolower $outFormat]]} { ! set ext jpg } elseif {[string match tiff* [string tolower $outFormat]]} { ! set ext tif } else { ! if {![regexp -nocase -- {^ *([a-z]+)} $outFormat dum ext]} { ! set ext ppm ;# Safety default ! } ! set ext [string tolower $ext] } set outname [file rootname $inname].$ext if {!$force_overwrite && [file exists $outname]} { ! set basename $outname ! set outname {} ! for {set i 1} {$i<100} {incr i} { ! set testname ${basename}-$i ! if {![file exists $testname]} { ! set outname $testname ! break ! } ! } } return $outname } ! proc write_ppm_chan { chanid pic } { # The Tk photo interface does not have a "write to channel" option. set width [image width $pic] ; set height [image height $pic] puts $chanid "P3" --- 60,90 ---- # lowercase. This provides the conventional extension for # all the cases I know about. if {[string match jpeg* [string tolower $outFormat]]} { ! set ext jpg } elseif {[string match tiff* [string tolower $outFormat]]} { ! set ext tif } else { ! if {![regexp -nocase -- {^ *([a-z]+)} $outFormat dum ext]} { ! set ext ppm ;# Safety default ! } ! set ext [string tolower $ext] } set outname [file rootname $inname].$ext if {!$force_overwrite && [file exists $outname]} { ! set basename $outname ! set outname {} ! for {set i 1} {$i<100} {incr i} { ! set testname ${basename}-$i ! if {![file exists $testname]} { ! set outname $testname ! break ! } ! } } return $outname } ! proc write_p3_chan { chanid pic } { # The Tk photo interface does not have a "write to channel" option. set width [image width $pic] ; set height [image height $pic] puts $chanid "P3" *************** *** 92,100 **** puts $chanid "255" set rtop [expr {$height-1}] ; set ctop [expr {$width-1}] for {set r 0} {$r<$height} {incr r} { ! for {set c 0} {$c<$width} {incr c} { ! puts $chanid [$pic get $c $r] ! } } flush $chanid } --- 92,100 ---- puts $chanid "255" set rtop [expr {$height-1}] ; set ctop [expr {$width-1}] for {set r 0} {$r<$height} {incr r} { ! for {set c 0} {$c<$width} {incr c} { ! puts $chanid [$pic get $c $r] ! } } flush $chanid } *************** *** 108,133 **** switch -exact -- $outSpec { {} {set outmode automatic} {-} { ! set outmode fixed ! set outname {} ! set outchan stdout ! fconfigure $outchan -translation auto \ ! -buffering full -buffersize $BUFSIZ } default { ! set outmode fixed ! set outname $outSpec ! if {$useChanOutput} { ! if {[catch {open $outname "w"} msg]} { ! puts stderr "Unable to open output file $outname: $msg" ! incr errcount ! exit $errcount ! } else { ! set outchan $msg ! fconfigure $outchan -translation auto \ ! -buffering full -buffersize $BUFSIZ ! } ! } } } --- 108,133 ---- switch -exact -- $outSpec { {} {set outmode automatic} {-} { ! set outmode fixed ! set outname {} ! set outchan stdout ! fconfigure $outchan -translation auto \ ! -buffering full -buffersize $BUFSIZ } default { ! set outmode fixed ! set outname $outSpec ! if {$useChanOutput} { ! if {[catch {open $outname "w"} msg]} { ! puts stderr "Unable to open output file $outname: $msg" ! incr errcount ! exit $errcount ! } else { ! set outchan $msg ! fconfigure $outchan -translation auto \ ! -buffering full -buffersize $BUFSIZ ! } ! } } } *************** *** 137,243 **** } foreach inname $inList { if {[string match {} $inname]} { ! # Read from stdin ! if {!$noinfo} { puts stderr "Processing input from stdin" } ! fconfigure stdin -translation binary ! set data [read stdin] ! if {[catch {set pic [image create photo -data $data]} errmsg]} { ! puts stderr "ERROR: $errmsg" ! incr errcount ! continue ! } } else { ! # Read from file ! if {![file readable $inname]} { ! puts stderr "Unable to open input file $inname; Skipping." ! incr errcount ! continue ! } ! if {!$noinfo} { puts stderr "Processing input file $inname" } ! if {[catch {set pic [image create photo -file $inname]} errmsg]} { ! puts stderr "ERROR: $errmsg" ! incr errcount ! continue ! } } if {!$noinfo} { puts stderr "Processing output..." } if {[string match automatic $outmode]} { ! if {[string match {} $inname]} { ! set outname {} ! set outchan stdout ! } else { ! set outname [make_ppm_name $inname] ! if {[string match {} $outname]} { ! puts stderr "Unable to generate unique output name; Skipping." ! incr errcount ! continue ! } ! if {$useChanOutput} { ! if {[catch {open $outname "w"} outchan]} { ! puts stderr "Unable to open output file $outname; Skipping." ! incr errcount ! continue ! } ! fconfigure $outchan -translation auto \ ! -buffering full -buffersize $BUFSIZ ! set loopOpen 1 ! } ! } } if {$useChanOutput} { ! # Use above PPM write to channel routine rather than Tk photo ! # write command, which writes to a file rather than a channel. ! if {[catch {write_ppm_chan $outchan $pic} errmsg]} { ! puts stderr " PPM WRITE ERROR: $errmsg" ! incr errcount ! } ! flush $outchan ! if {$loopOpen} { ! close $outchan ! unset outchan ! } } else { ! # Use Tk image photo write command. ! if {[string match {} $outname]} { ! # Use temporary file to fake stdout output ! Oc_TempFile New temp -stem any2ppm ! set tempname [$temp AbsoluteName] ! } else { ! set tempname $outname ! } ! if {[catch {$pic write $tempname -format $outFormat} errmsg]} { ! puts stderr " $outFormat WRITE ERROR: $errmsg" ! incr errcount ! if {![string match {} outname] && [file exists $outname]} { ! catch {file delete $outname} ! } ! exit [incr errcount] ! } ! if {[string match {} $outname]} { ! # Copy results from $tempname to $outchan ! # (which *should* be stdout!) ! set tempchan [$temp Handle] ! fconfigure $tempchan -translation binary ! fconfigure $outchan -translation binary ! if {[catch {fcopy $tempchan $outchan} msg]} { ! puts stderr "FATAL ERROR: $msg" ! exit [incr errcount] ! } ! $temp Delete ! flush $outchan ! } } if {!$noinfo} { ! if {[info exists outchan] && [string match stdout $outchan]} { ! puts stderr "Output written to " ! } elseif {[info exists outname]} { ! puts stderr "Output written to $outname" ! } else { ! puts stderr "Unknown output (programming error?)" ! } } } --- 137,268 ---- } foreach inname $inList { if {[string match {} $inname]} { ! # Read from stdin ! if {!$noinfo} { puts stderr "Processing input from stdin" } ! fconfigure stdin -translation binary ! set data [read stdin] ! if {[catch {set pic [image create photo -data $data]} errmsg]} { ! # Unable to process data using 'photo -data' option. Try ! # using the -file option instead ! Oc_TempFile New temp -stem any2ppm ! set tempname [$temp AbsoluteName] ! $temp Claim ! $temp Delete ! set tempchan [open $tempname w] ! fconfigure $tempchan -translation binary ! if {[catch {puts -nonewline $tempchan $data} msg]} { ! puts stderr "FATAL ERROR: $msg" ! catch {close $tempchan} ! catch {file delete $tempname} ! exit [incr errcount] ! } ! close $tempchan ! if {[catch {set pic [image create photo -file $tempname]} msg]} { ! puts stderr "ERROR: $errmsg" ! puts stderr "ERROR: $msg" ! incr errcount ! file delete $tempname ! continue ! } ! file delete $tempname ! } } else { ! # Read from file ! if {![file readable $inname]} { ! puts stderr "Unable to open input file $inname; Skipping." ! incr errcount ! continue ! } ! if {!$noinfo} { puts stderr "Processing input file $inname" } ! if {[catch {set pic [image create photo -file $inname]} errmsg]} { ! puts stderr "ERROR: $errmsg" ! incr errcount ! continue ! } } if {!$noinfo} { puts stderr "Processing output..." } if {[string match automatic $outmode]} { ! if {[string match {} $inname]} { ! set outname {} ! set outchan stdout ! } else { ! set outname [make_ppm_name $inname] ! if {[string match {} $outname]} { ! puts stderr "Unable to generate unique output name; Skipping." ! incr errcount ! continue ! } ! if {$useChanOutput} { ! if {[catch {open $outname "w"} outchan]} { ! puts stderr "Unable to open output file $outname;\ ! Skipping." ! incr errcount ! continue ! } ! fconfigure $outchan -translation auto \ ! -buffering full -buffersize $BUFSIZ ! set loopOpen 1 ! } ! } } if {$useChanOutput} { ! # Use above PPM P3 write proc to write to channel routine rather ! # than Tk photo write command, which writes to a file rather ! # than a channel, and apparently doesn't know P3 anyway. ! if {[catch {write_p3_chan $outchan $pic} errmsg]} { ! puts stderr " PPM P3 WRITE ERROR: $errmsg" ! incr errcount ! } ! flush $outchan ! if {$loopOpen} { ! close $outchan ! unset outchan ! } } else { ! # Use Tk image photo write command. ! if {[string match {} $outname]} { ! # Use temporary file to fake stdout output ! Oc_TempFile New temp -stem any2ppm ! set tempname [$temp AbsoluteName] ! $temp Claim ! $temp Delete ! } else { ! set tempname $outname ! } ! if {[catch {$pic write $tempname -format $outFormat} errmsg]} { ! puts stderr " $outFormat WRITE ERROR: $errmsg" ! incr errcount ! catch {file delete $tempname} ! exit [incr errcount] ! } ! if {[string match {} $outname]} { ! # Copy results from $tempname to $outchan ! # (which *should* be stdout!) ! set tempchan [open $tempname r] ! fconfigure $tempchan -translation binary ! fconfigure $outchan -translation binary ! if {[catch {fcopy $tempchan $outchan} msg]} { ! puts stderr "FATAL ERROR: $msg" ! catch {close $tempchan} ! catch {file delete $tempname} ! exit [incr errcount] ! } ! close $tempchan ! file delete $tempname ! flush $outchan ! } } if {!$noinfo} { ! if {[info exists outchan] && [string match stdout $outchan]} { ! puts stderr "Output written to " ! } elseif {[info exists outname]} { ! puts stderr "Output written to $outname" ! } else { ! puts stderr "Unknown output (programming error?)" ! } } } diff -crN oommf11b2/ext/if/if.cc oommf/ext/if/if.cc *** oommf11b2/ext/if/if.cc Thu Nov 20 17:41:28 2003 --- oommf/ext/if/if.cc Wed Dec 13 03:39:29 2006 *************** *** 9,20 **** * * NOTICE: Please see the file ../../LICENSE * ! * Last modified on: $Date: 2003/11/20 22:41:28 $ ! * Last modified by: $Author: dgp $ */ #include #include #define USE_OLD_IMAGE #define USE_COMPOSITELESS_PHOTO_PUT_BLOCK --- 9,22 ---- * * NOTICE: Please see the file ../../LICENSE * ! * Last modified on: $Date: 2004/03/20 05:24:17 $ ! * Last modified by: $Author: donahue $ */ #include #include + #include + #include #define USE_OLD_IMAGE #define USE_COMPOSITELESS_PHOTO_PUT_BLOCK *************** *** 23,28 **** --- 25,32 ---- /* End includes */ // Optional directive to pimake + //////////////////////////////////////////////////////////////////////// + // MsBitmap and related classes struct RGBQuad { BYTE Red; BYTE Green; *************** *** 31,37 **** 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 char* carr); // Analogous to above, /// but takes input from a 3-byte long buffer. }; --- 35,41 ---- 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. }; *************** *** 45,51 **** return count; } ! int RGBQuad::MSFill24(const char* carr) { // Note: MS RGBQuad's are ordered "Blue Green Red Reserved" Blue=carr[0]; Green=carr[1]; Red=carr[2]; Reserved=0; --- 49,55 ---- 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; *************** *** 53,59 **** } class MSBitmap; // Forward declaration for typedef ! typedef int (MSBitmap::*BmpConvert)(const char* read_buf, RGBQuad* &pix, UINT4 startcol, UINT4 stopcol); --- 57,63 ---- } class MSBitmap; // Forward declaration for typedef ! typedef int (MSBitmap::*BmpConvert)(const unsigned char* read_buf, RGBQuad* &pix, UINT4 startcol, UINT4 stopcol); *************** *** 96,108 **** UINT4 PaletteSize; // FillPhoto() bitmap->rgb conversion routines. ! int Bmp1toRgbq(const char* read_buf,RGBQuad* &pix, UINT4 startcol,UINT4 stopcol); // 1 bit/pixel ! int Bmp4toRgbq(const char* read_buf,RGBQuad* &pix, UINT4 startcol,UINT4 stopcol); // 4 bits/pixel ! int Bmp8toRgbq(const char* read_buf,RGBQuad* &pix, UINT4 startcol,UINT4 stopcol); // 8 bits/pixel ! int Bmp24toRgbq(const char* read_buf,RGBQuad* &pix, UINT4 startcol,UINT4 stopcol); // 24 bits/pixel BmpConvert DataConvert; --- 100,112 ---- 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; *************** *** 251,257 **** } int ! MSBitmap::Bmp1toRgbq(const char* read_buf,RGBQuad* &pix, UINT4 startcol,UINT4 stopcol) { // 1 bit per pixel, with palette UINT4 jstart=8*(startcol/8); --- 255,261 ---- } 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); *************** *** 274,280 **** } int ! MSBitmap::Bmp4toRgbq(const char* read_buf,RGBQuad* &pix, UINT4 startcol,UINT4 stopcol) { // 4 bits per pixel, with palette UINT4 jstart=2*(startcol/2); --- 278,284 ---- } 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); *************** *** 299,318 **** } int ! MSBitmap::Bmp8toRgbq(const char* read_buf,RGBQuad* &pix, UINT4 startcol,UINT4 stopcol) { // 8 bits per pixel, with palette for(UINT4 j=startcol;j=PaletteSize) return 1; pix[j-startcol]=Palette[index]; } return 0; } int ! MSBitmap::Bmp24toRgbq(const char* read_buf,RGBQuad* &pix, UINT4 startcol,UINT4 stopcol) { // True color input file; 24 bits per pixel, no palette const int data_width=3; --- 303,324 ---- } 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=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; *************** *** 390,396 **** } // ! char *read_buf=new char[FileRowSize]; RGBQuad *pix=new RGBQuad[reqwidth]; Tk_PhotoImageBlock pib; --- 396,402 ---- } // ! unsigned char *read_buf=new unsigned char[FileRowSize]; RGBQuad *pix=new RGBQuad[reqwidth]; Tk_PhotoImageBlock pib; *************** *** 412,418 **** Tcl_Seek(chan,OffBits+startrow*FileRowSize,SEEK_SET); for(UINT4 i= UINT4(startrow);i= 8) extern "C" { static Tk_ImageFileMatchProc bmpFileMatchProc; ! static Tk_ImageFileReadProc bmpFileReadProc; static Tk_ImageFileWriteProc bmpFileWriteProc; } --- 560,1069 ---- 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(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(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 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((red*255 + maxvalue/2)/maxvalue); + pix[3*j+1] + = static_cast((green*255 + maxvalue/2)/maxvalue); + pix[3*j+2] + = static_cast((blue*255 + maxvalue/2)/maxvalue); + } + // Write row + Tk_PhotoPutBlock(imageHandle,&pib,destX,destY+i,width,1); + // Skip through to next row + for(j=width;jimagewidth) { + 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 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((red*255 + maxvalue/2)/maxvalue); + pix[3*j+1] + = static_cast((green*255 + maxvalue/2)/maxvalue); + pix[3*j+2] + = static_cast((blue*255 + maxvalue/2)/maxvalue); + } + // Write row + Tk_PhotoPutBlock(imageHandle,&pib,destX,destY+i,width,1); + // Skip through to next row + for(j=width;jwidth; + 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;jpixelSize) { + 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;jpixelSize) { + 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; } *************** *** 615,620 **** --- 1116,1216 ---- 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 *************** *** 635,640 **** --- 1231,1237 ---- // 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) { diff -crN oommf11b2/ext/oc/oc.cc oommf/ext/oc/oc.cc *** oommf11b2/ext/oc/oc.cc Thu Nov 20 17:41:34 2003 --- oommf/ext/oc/oc.cc Wed Dec 13 03:39:36 2006 *************** *** 260,268 **** --- 260,273 ---- #endif // DEBUG_DISABLESTDIO // Disable future SIGHUP, SIGTIN and SIGTOU signals + #if 1 && (SYSTEM_TYPE==WINDOWS) + signal(SIGBREAK,SIG_IGN); + signal(SIGABRT,SIG_IGN); + #else signal(SIGHUP,SIG_IGN); signal(SIGTTIN,SIG_IGN); signal(SIGTTOU,SIG_IGN); + #endif } static int *************** *** 284,290 **** // a value outside this set. Note that signal() will correctly // return a TCL_ERROR if the value is outside the known set of // signals. ! #if 0 && (SYSTEM_TYPE==WINDOWS) if(signo!=SIGINT && signo!=SIGILL && signo!=SIGFPE && signo!=SIGSEGV && signo!=SIGTERM && signo!=SIGBREAK && signo!=SIGABRT) --- 289,295 ---- // a value outside this set. Note that signal() will correctly // return a TCL_ERROR if the value is outside the known set of // signals. ! #if 1 && (SYSTEM_TYPE==WINDOWS) if(signo!=SIGINT && signo!=SIGILL && signo!=SIGFPE && signo!=SIGSEGV && signo!=SIGTERM && signo!=SIGBREAK && signo!=SIGABRT) diff -crN oommf11b2/ext/oc/url.tcl oommf/ext/oc/url.tcl *** oommf11b2/ext/oc/url.tcl Wed Jun 13 12:46:45 2001 --- oommf/ext/oc/url.tcl Wed Dec 13 03:40:09 2006 *************** *** 231,237 **** set epcomps {} foreach pcomp $pcomps { set string [$class Escape $pcomp] ! regsub -all : $string %3a string regsub -all / $string %2f string regsub -all {;} $string %3b string regsub -all {[?]} $string %3f string --- 231,248 ---- set epcomps {} foreach pcomp $pcomps { set string [$class Escape $pcomp] ! # ! # It appears the IE 6 cannot load URLs like ! # file://localhost/C%3a/foo/bar.txt ! # Reviewing RFCs 1738 and 1808, I don't see ! # a requirement to escape the : character. ! # I can imagine in a relative URL, it might ! # cause confusion with the portion before the ! # first unescaped : being mistaken for a scheme, ! # but that's not relevant here because we're ! # constructing an absolute URL. Removing this ! # extra escape. ! #regsub -all : $string %3a string regsub -all / $string %2f string regsub -all {;} $string %3b string regsub -all {[?]} $string %3f string diff -crN oommf11b2/ext/ow/entryscale.tcl oommf/ext/ow/entryscale.tcl *** oommf11b2/ext/ow/entryscale.tcl Tue Nov 25 21:39:19 2003 --- oommf/ext/ow/entryscale.tcl Wed Dec 13 03:39:51 2006 *************** *** 372,384 **** private method UpdateMarkList {} { if {[string match {} $winscale]} { return } - # First hide all markwindows - set markwindows [winfo children $winscale] - foreach win $markwindows { - place forget $win - } - # Delete any excess mark windows if {[llength $markwindows] > [llength $marklist]} { # Remove extra windows from end. We have to disable # bindings on $winscale because otherwise Tk --- 372,379 ---- private method UpdateMarkList {} { if {[string match {} $winscale]} { return } # Delete any excess mark windows + set markwindows [winfo children $winscale] if {[llength $markwindows] > [llength $marklist]} { # Remove extra windows from end. We have to disable # bindings on $winscale because otherwise Tk *************** *** 424,433 **** } set id 0 foreach mark $slist { ! if {$mark<$scalemin || $mark>$scalemax} { continue } ! set xpos [lindex [$winscale coords $mark] 0] ! place $winscale.mark$id \ ! -x $xpos -y 0 -relheight 1 -anchor $anchor incr id } } --- 419,431 ---- } set id 0 foreach mark $slist { ! if {$mark<$scalemin || $mark>$scalemax} { ! place forget $winscale.mark$id ! } else { ! set xpos [lindex [$winscale coords $mark] 0] ! place $winscale.mark$id \ ! -x $xpos -y 0 -relheight 1 -anchor $anchor ! } incr id } } diff -crN oommf11b2/ext/ow/procs.tcl oommf/ext/ow/procs.tcl *** oommf11b2/ext/ow/procs.tcl Tue Nov 25 21:39:20 2003 --- oommf/ext/ow/procs.tcl Wed Dec 13 03:39:44 2006 *************** *** 439,444 **** --- 439,447 ---- # Routines to push/pop watch cursor onto all currently # existing toplevel windows. # + frame .owhiddencursorframe -cursor watch ;# Leave this unmapped; + ## the purpose is just to hold a reference to the watch cursor + ## as a workaround to an apparent X memory leak. set _watch_cursor_count 0 set _watch_cursor_safetyid {} proc Ow_PushWatchCursor {} { diff -bcrN oommf11b2/config/cache/wintel.tcl oommf/config/cache/wintel.tcl *** oommf11b2/config/cache/wintel.tcl Mon Dec 22 12:51:03 2003 --- oommf/config/cache/wintel.tcl Thu Jan 15 15:22:46 2004 *************** *** 60,69 **** # # Microsoft Visual C++ # ! $config SetValue program_compiler_c++ {cl /nologo /c /GX /GR} # # Intel C++ ! # $config SetValue program_compiler_c++ {icl /nologo /c /GX /GR} # # Borland C++ 5.5 Win32 command line tools. # --- 60,69 ---- # # Microsoft Visual C++ # ! # $config SetValue program_compiler_c++ {cl /nologo /c /GX /GR} # # Intel C++ ! $config SetValue program_compiler_c++ {icl /nologo /c /GX /GR} # # Borland C++ 5.5 Win32 command line tools. # diff -crN oommf11b2/config/cache/wintel.tcl oommf11b2-patched/config/cache/wintel.tcl *** oommf11b2/config/cache/wintel.tcl Thu Jan 15 15:22:46 2004 --- oommf11b2-patched/config/cache/wintel.tcl Tue Dec 12 17:49:23 2006 *************** *** 60,69 **** # # Microsoft Visual C++ # ! # $config SetValue program_compiler_c++ {cl /nologo /c /GX /GR} # # Intel C++ ! $config SetValue program_compiler_c++ {icl /nologo /c /GX /GR} # # Borland C++ 5.5 Win32 command line tools. # --- 60,69 ---- # # Microsoft Visual C++ # ! $config SetValue program_compiler_c++ {cl /nologo /c /GR} # # Intel C++ ! # $config SetValue program_compiler_c++ {icl /nologo /c /GX /GR} # # Borland C++ 5.5 Win32 command line tools. # *************** *** 102,107 **** --- 102,122 ---- # $config SetValue path_directory_temporary {C:\temp} # $config SetValue path_directory_temporary {C:\} + + ######################################################################## + # SUPPORT PROCEDURES + # + # Routine to guess the cl version + proc GuessClVersion { cl } { + set guess {} + catch {exec $cl} usage_str + if {[regexp -- {Version ([0-9]+)[.][0-9]+[.][0-9]+} \ + $usage_str dummy version]} { + set guess [expr {$version - 6}] + } + return $guess + } + ######################################################################## # ADVANCED CONFIGURATION *************** *** 113,118 **** --- 128,148 ---- } if {[string match cl $ccbasename]} { # ... for Microsoft Visual C++ + if {![info exists mvcpp_version]} { + set compilestr [$config GetValue program_compiler_c++] + set mvcpp_version [GuessClVersion [lindex $compilestr 0]] + unset compilestr + } + set opts {} + # Exception handling + if {![string match {} $mvcpp_version] && $mvcpp_version>7} { + # The exception handling specification switch "/GX" + # is deprecated in version 8. + # lappend opts /EHsc + lappend opts /EHac + } else { + lappend opts /GX + } # # Usually you'll want maximum optimzation for greater simulation # performance, so that is the default choice. However, you may *************** *** 122,136 **** # option, MSVC 5 was unable to compile the demag.cc file at all, # and other errors caused problems with auto-sizing of the display # in mmDisp. ! # Options: # Maximum optimization: /Ox # Enable runtime debug checks: /GZ # Optimize for Pentium processor: /G5 # Optimize for Pentium Pro: /G6 ! # No optimization: /Od ! #$config SetValue program_compiler_c++_option_opt {format "/Od"} ! #$config SetValue program_compiler_c++_option_opt {format "/GZ"} ! $config SetValue program_compiler_c++_option_opt {format "/Ox"} # NOTE: If you want good performance, be sure to edit ../options.tcl # or ../local/options.tcl to include the line # Oc_Option Add * Platform cflags {-def NDEBUG} --- 152,188 ---- # option, MSVC 5 was unable to compile the demag.cc file at all, # and other errors caused problems with auto-sizing of the display # in mmDisp. ! # ! # Options for VC++ 7 and earlier: ! # Disable optimizations: /Od # Maximum optimization: /Ox # Enable runtime debug checks: /GZ # Optimize for Pentium processor: /G5 # Optimize for Pentium Pro: /G6 ! # ! # Options for VC++ 8: ! # Disable optimizations: /Od ! # Maximum optimization: /Ox ! # Enable stack checks: /GZ ! # Require SSE2 support: /arch:SSE2 ! # Fast (less predictable) floating point: /fp:fast ! # Use portable but insecure lib fcns: /D_CRT_SECURE_NO_DEPRECATE ! # ! if {![string match {} $mvcpp_version] && $mvcpp_version<=7} { ! #lappend opts /GZ ! if {$mvcpp_version<6} { ! lappend opts /Od /G6 ! } else { ! lappend opts /Ox /G6 ! } ! } else { ! #lappend opts /GZ /fp:strict /D_CRT_SECURE_NO_DEPRECATE ! lappend opts /Ox /fp:fast /D_CRT_SECURE_NO_DEPRECATE ! lappend opts /wd4996 ! # /wd4996 disables warnings about deprecated function calls ! } ! $config SetValue program_compiler_c++_option_opt "format \"$opts\"" ! # NOTE: If you want good performance, be sure to edit ../options.tcl # or ../local/options.tcl to include the line # Oc_Option Add * Platform cflags {-def NDEBUG} *************** *** 149,160 **** # The program to run on this platform to create a single library file out # of many object files. # Microsoft Visual C++'s library maker ! $config SetValue program_libmaker {lib} # The program to run on this platform to link together object files and # library files to create an executable binary. # Microsoft Visual C++'s linker ! $config SetValue program_linker {link /DEBUG} } elseif {[string match icl $ccbasename]} { # ... for Intel C++ --- 201,215 ---- # The program to run on this platform to create a single library file out # of many object files. # Microsoft Visual C++'s library maker ! $config SetValue program_libmaker {link /lib} ! # If your link doesn't accept the /lib option, try this instead: ! # $config SetValue program_libmaker {lib} # The program to run on this platform to link together object files and # library files to create an executable binary. # Microsoft Visual C++'s linker ! $config SetValue program_linker {link} ! # $config SetValue program_linker {link /DEBUG} ;# For debugging } elseif {[string match icl $ccbasename]} { # ... for Intel C++ *************** *** 273,279 **** } else { set libbasename [file tail [lindex $libbasename 0]] } ! if {[string match lib $libbasename]} { # ...for Microsoft VC++ lib $config SetValue program_libmaker_option_obj {format \"%s\"} $config SetValue program_libmaker_option_out {format "\"/OUT:%s\""} --- 328,334 ---- } else { set libbasename [file tail [lindex $libbasename 0]] } ! if {[string match lib $libbasename] || [string match link $libbasename] } { # ...for Microsoft VC++ lib $config SetValue program_libmaker_option_obj {format \"%s\"} $config SetValue program_libmaker_option_out {format "\"/OUT:%s\""} diff -crN oommf11b2/app/mmpe/state.dat oommf/app/mmpe/state.dat *** oommf11b2/app/mmpe/state.dat Fri Jan 2 15:47:40 2004 --- oommf/app/mmpe/state.dat Wed Sep 5 14:08:20 2007 *************** *** 40,46 **** max iteration count: 1 min time step: 1 max time step: 1 ! field type:4 #add new data types for mif to pass to solver ABOVE this line field range count: 1 # Initial field + final field + numStep = 7... --- 40,46 ---- max iteration count: 1 min time step: 1 max time step: 1 ! field type:999 #add new data types for mif to pass to solver ABOVE this line field range count: 1 # Initial field + final field + numStep = 7... diff -bcrN oommf11b2/ext/oc/procs.tcl oommf/ext/oc/procs.tcl *** oommf11b2/ext/oc/procs.tcl Thu Nov 20 17:41:34 2003 --- oommf/ext/oc/procs.tcl Fri Jun 3 00:07:23 2011 *************** *** 639,645 **** set f "" set error [catch { set f [open tclIndex a] ! puts $f $index nonewline close $f cd $oldDir } msg] --- 639,645 ---- set f "" set error [catch { set f [open tclIndex a] ! puts -nonewline $f $index close $f cd $oldDir } msg]