ZHUOWARE BACKYARD - NOTE INDEX|ZHUOWARE BACKYARD TOP|ZHUOWARE表ページ

AVI Writer in tcl/tk : pure v.s. native extension

Feb. 10, 2011 - Feb. 24, 2011 by Zhuo

Abstract

I have written an AVI writer module in tcl/tk, and a sample script to show the usage. Using this module, you can simply open a file, put image data one after another, set FPS (frame-per-second) value if you want, and close the file to have an AVI file with all the image data as frames.
It works, but very slowly. If you seriously look for a solution to generate an AVI file in tcl/tk, I would suggest saving the frame images to files, all numbered, and converting them into a single movie file using another utility application, such as ffmpeg or virtualdub (If you read Japanese, AVI Maker and ParaParaMangaDo can be considered as well).
Anyway, I leave the source codes here, so they may help somebody write a native extension for Tcl/Tk.
//
AVI writerモジュールをtcl/tkで書いてみました(使い方を示すサンプルスクリプトも). これを使えば,ファイルを開いて,画像データを次々つっこんで,必要ならfpsを指定して,closeすれば,AVIファイルで画像データが並んだものが作れます.
一応動きますが,動作は非常に遅いです.もしほんとうにtcl/tkでAVIファイルを生成したいということであれば,お勧めしたいのは,フレームをファイルに通し番号付きで保存し,他のアプリケーションでひとつのムービーファイルにすることです.ffmpeg, virtualdubなどが使えます.日本語okならば,AVI Maker, ぱらぱらマンガ道などもあります.
一応ソースコードを公開しておきます,Tcl/Tkのネイティブ拡張を書かれる方の参考にでもなれば幸いです.

Rev.0.3. native extension (Feb. 19, 2011)

I have written a native extension to provide a new command that takes an image data and returns a byte array filled with a scan-lined sequence of pixel values. Now dumping 60 images at the size of 640 x 480 pixels (in 24 bit color) takes about 5 seconds (30seconds in Rev.0.1, the pure Tcl script). Six times faster than pure script version.
Not bad, but not that fast as I expected: Discussions follow. //
C言語でTcl拡張を書き,コマンドにより imageデータを受けとって,スキャン順のピクセル値で埋め尽くしたバイト配列を返せるようにしました.その結果,60枚の, 640x 480ピクセル(24bitカラー)の画像の保存が,5秒で終わるようになりました(Tclのみの場合は30秒).Tclのみの場合の6倍の速さです.
悪くはありませんが,どうも期待したほどではありません.検討してみると:

Rev. 0.3. download

Rev. 0.3. contents

aviwriter.tcl
itcl class "AVIWriter", a pure tcl/tk script. This version tries to load dumpImage.dll at the beginning, and if successful, uses the new command "dumpImage". //
itclクラス "AVIWrite". tcl/tkだけで書かれたスクリプト.このバージョンでは,最初に dumpImage.dllのロードを試み,成功した場合はdumpImageコマンドを利用する.
aviwriter_test.tcl
A sample application that uses aviwrite.tcl. You can choose direct generation of an AVI file and generation of still image files. //
AVIWriter.tclの使用例.一箇所書き換えることで,dumpImageによる直接AVI生成と,1フレームごとの静止画像ファイルの連番保存とを選択できる.後者はツールでAVIファイルに変換できる.
dumpImage.c
C source code for binary extension, that takes image name and that generates binary data. //
imageを受け取りバイナリを生成する拡張のC言語ソースコード.
dumpImage.dll
DLL, built by compiling dumpImage.c using MinGW32. //
dumpImage.cをMinGW32でビルドしたDLL.
makefile
Thanks to this, just by typing "make" to command line you will have dumpImage.dll //
これでmakeとだけコマンドラインにタイプすればdumpImage.dllがビルドできるはず.

Rev.0.3. Hilights :-)

Hilight in aviwriter.tcl  // aviwriter.tclのポイント

beginning: try to load dumpImage.dll. // 冒頭でdumpImage.dllを読みこもうとする.
 :

itcl::class AVIWriter {
	private common dumpImageNoAccel_
	set dumpImageNoAccel_ [catch {load "dumpImage.dll"} msg]
 :


invocation: // 実行部分.dllが読めていたときはそれを呼び出す.
		if { $dumpImageNoAccel_ } {
			#have ppm binary image in variable "ppm"
			$pane_ copy $imageName -subsample 1 -1
			set ppm [::base64::decode [$pane_ data -format ppm]]
			scan $ppm "%s%s%s%s%n" dum_fmt dum_w dum_h dum_max headerLength

			#dump the binary to outbin
			set loc0 [expr $headerLength + 1]
			set loc1 [expr $headerLength + 2]
			set loc2 [expr $headerLength + 3]
			set locEnd [expr $loc0 + $width_ * $height_ * 3]
			set outbin_ ""
			while { $loc0 < $locEnd } {
				append outbin_ [string index $ppm $loc2] [string index $ppm $loc1] [string index $ppm $loc0] \0
				incr loc0 3
				incr loc1 3
				incr loc2 3
			}
		} else {
			# use user-defined command "dumpImage"
			dumpImage -format bgr0 -reverse $imageName outbin_
		}

dataImage.c // dataImage.c 
/************************************************************************
  dumpImage.c:   Tcl command "dumpImage" that returns a binary
                array of scan-lined RGBA values of an image data.

  Rev. 0.3.  Feb. 18, 2011   zhuo. varname to reuse the memory area
  Rev. 0.2.  Feb. 18, 2011   zhuo. 
  Rev. 0.1.  Feb. 13, 2011   zhuo

  Tcl command to be implemented:

  dumpImage ?-format Format? ?-reverse? imgName ?varName?

  Return value: When varName is not specified, it returns a binary
  array of scan-lined RGBA values of an image data.
  When varName is specified, the values are overwritten.

  Format : A string consisting of "r", "g", "b", "a", or "0".
  	   r : red,  g : green,  b : blue,  a : alpha,  0 : zero.
	   It specifies the order of the output stream.
	   Example: 
	     "r" :    generates only red channel values,
	     "rgb" :  generates red, green, and blue values for each
	              pixel.
	     "rgb0" : red, green, blue followed by zero. 
	     "rgba" : by default.

  -reverse : When specified, the scan starts from the bottom line.
	   

  Reference:
    handling binary data
      http://www.geocities.co.jp/SiliconValley/4137/dir4/tapi40.html
    C function
      http://www.geocities.co.jp/SiliconValley/4137/dir4/tapi41.html
    Access to Photo 
      http://www.geocities.co.jp/SiliconValley/4137/dir4/tkcmfg.html

***********************************************************************/

#include <tcl.h>
#include <tk.h>
#include <string.h>



typedef struct {
    /* system argument */
    Tcl_Interp* interp;
    int objc;
    Tcl_Obj* CONST * objv;

    /* argument */
    char* strFormat;
    char* strImageName;
    char* strVarName;
    int reverse;

    /* format parameters */
    int formatLen;
    int* formatOffsets;

    /* image data */
    Tk_PhotoImageBlock imageBlock;

    /* output */
    enum { ExistingVar, NonexistingVar, ReturnValue } outStyle;
    unsigned char* pOutBin;
} DumpImage;


static void init( DumpImage* d, Tcl_Interp* interp, int objc, Tcl_Obj* CONST objv[] ) {
	d->interp = interp;
	d->objc = objc;
	d->objv = objv;
	d->strFormat = "rgb";
	d->strImageName = "";
	d->strVarName = "";
	d->reverse = 0;
	d->formatLen = 0;
	d->formatOffsets = 0;
	d->pOutBin = NULL;
}
	

static int setArgParams( DumpImage* d ) {
	int argCnt = 0;
	if ( d->objc < 2 ) {
		Tcl_WrongNumArgs( d->interp, 1, d->objv, "?-format format? ?-reverse? imageName ?varName?" );
		return TCL_ERROR;
	}

	/* parse arguments and options */
	while ( --(d->objc) >= 1 ) {
		char * pArg = Tcl_GetString( *++(d->objv) );
		if ( ! strcmp( pArg, "-format" ) ) {
			if ( --(d->objc) < 1 ) {
				Tcl_AddErrorInfo( d->interp, "-format option needs a format string." );
				return TCL_ERROR;
			}
			d->strFormat = Tcl_GetString( *++(d->objv) );
		} else if ( ! strcmp( pArg, "-reverse" ) ) {
			d->reverse = 1;
		} else if ( *pArg == '-' ) {
			Tcl_AddErrorInfo( d->interp, "unknown option encountered." );
			return TCL_ERROR;
		} else {
			switch ( ++argCnt ) {
			  case 1:
			    d->strImageName = pArg;
			    break;
			  case 2:
			    d->strVarName = pArg;
			    break;
			  default:
			    Tcl_AddErrorInfo( d->interp, "extra argument specified." );
			    return TCL_ERROR;
			}
		}
	}
	return TCL_OK;
}



static int setImageBlock( DumpImage* d ) {
	Tk_PhotoHandle imageHandle = 0;

	if ( !strcmp( d->strImageName, "" ) ) {
		Tcl_AddErrorInfo( d->interp, "image name not specified." );
		return TCL_ERROR;
	}
	if ( ! (imageHandle = Tk_FindPhoto( d->interp, d->strImageName )) ) {
		Tcl_AddErrorInfo( d->interp, "the image name does not exist." );
		return TCL_ERROR;
	}
	Tk_PhotoGetImage( imageHandle, &(d->imageBlock) );
	return TCL_OK;
}



static int setFormatOffsets( DumpImage* d ) {
	int idx;
	d->formatLen = strlen( d->strFormat );
	d->formatOffsets = (int*)Tcl_Alloc( sizeof(int) * d->formatLen );
	if ( ! d->formatOffsets ) {
		Tcl_AddErrorInfo( d->interp, "internal memory full." );
		return TCL_ERROR;
	}
	for ( idx = 0; idx < d->formatLen; ++idx ) {
		switch ( d->strFormat[idx] ) {
		  case 'r' :
		    d->formatOffsets[idx] = d->imageBlock.offset[ 0 ];
		    break;
		  case 'g' :
		    d->formatOffsets[idx] = d->imageBlock.offset[ 1 ];
		    break;
		  case 'b' :
		    d->formatOffsets[idx] = d->imageBlock.offset[ 2 ];
		    break;
		  case 'a' :
		    d->formatOffsets[idx] = d->imageBlock.offset[ 3 ];
		    break;
		  case '0' :
		    d->formatOffsets[idx] = -1;
		    break;
		  default :
		    Tcl_AddErrorInfo( d->interp, "invalid format character encountered." );
		    return TCL_ERROR;
		}
	}
	return TCL_OK;
}	



static int setOutputArea( DumpImage* d ) {
	unsigned int len = sizeof(char) * d->imageBlock.width * d->imageBlock.height * d->formatLen;

	/* When varname is specified, and when it exists, prepare overwriting the existing area. */
	if ( *(d->strVarName) != '\0' ) {
		Tcl_Obj* pObj = Tcl_GetVar2Ex( d->interp, d->strVarName, NULL, 0 );
		if ( pObj ) {
			d->pOutBin = Tcl_SetByteArrayLength( pObj, len );
			d->outStyle = ExistingVar;
			return TCL_OK;
		}
	}
	/* When varname not specified, or non-existent */
	d->outStyle = ( *(d->strVarName) == '\0' ) ? ReturnValue : NonexistingVar;
	d->pOutBin = (unsigned char*)Tcl_Alloc( len );
	if ( ! (d->pOutBin) ) {
		Tcl_AddErrorInfo( d->interp, "internal memory full." );
		return TCL_ERROR;
	}
	return TCL_OK;
}



static int scan( DumpImage* d ) {
	const int width = d->imageBlock.width;
	const int height = d->imageBlock.height;
	const int pixelSize = d->imageBlock.pixelSize;
	const int* const fmtOffs = d->formatOffsets;
	const int fmtLen = d->formatLen;
	int linePitch = d->imageBlock.pitch;
	unsigned char* pLineTop = d->imageBlock.pixelPtr;
	int lineCount; 
	unsigned char* pOutCur = d->pOutBin;

	Tcl_Obj* pOutObj;

	if ( d->reverse ) {
		pLineTop += (height - 1) * linePitch;
		linePitch *= -1;
	}

	for ( lineCount = height; --lineCount >= 0; pLineTop += linePitch ) {
		unsigned char* pLineCur;
		unsigned char* pLineEnd;
		for ( pLineCur = pLineTop, pLineEnd = pLineTop + width * pixelSize;
		      pLineCur < pLineEnd;
		      pLineCur += pixelSize ) {
			int fmtIdx;
			for ( fmtIdx = 0; fmtIdx < fmtLen; ++fmtIdx ) {
				*pOutCur++ = (fmtOffs[ fmtIdx ] < 0) ? 0 :
				  pLineCur[ fmtOffs[ fmtIdx ] ];
			}
		}
	}

	if ( d->outStyle == ExistingVar ) {
		return TCL_OK;
	}
	pOutObj = Tcl_NewByteArrayObj( d->pOutBin, width * height * fmtLen );
	if ( d->outStyle == ReturnValue ) {
		Tcl_SetObjResult( d->interp, pOutObj );
	} else {
		Tcl_SetVar2Ex( d->interp, d->strVarName, 0, pOutObj, 0 );
	}
	return TCL_OK;
}



static void final( DumpImage* d ) {
	if ( d->formatOffsets ) Tcl_Free( (char*)(d->formatOffsets) );
}



static int dumpImageCmd(ClientData data, Tcl_Interp* interp,
		      int objc, Tcl_Obj* CONST objv[]){
	DumpImage d;
	int status = TCL_ERROR;

	init( &d, interp, objc, objv );
	if ( (setArgParams( &d ) == TCL_OK) &&
	     (setImageBlock( &d ) == TCL_OK) && 
	     (setFormatOffsets( &d ) == TCL_OK) && 
	     (setOutputArea( &d ) == TCL_OK) && 
	     (scan( &d ) == TCL_OK) ) {
		status = TCL_OK;
	}
	final( &d );
	return status;
}





/*
  TIPS: The DLLEXPORT function name below must
  consist of only alphabet letters (not numbers)
  and must be capitalized.
*/
DLLEXPORT int Dumpimage_Init(Tcl_Interp* interp){
#ifdef USE_TCL_STUBS
  Tcl_InitStubs( interp, "8.1", 0 );
#endif
#ifdef USE_TK_STUBS
  Tk_InitStubs( interp, "8.1", 0 );
#endif
  Tcl_CreateObjCommand(interp, "dumpImage", dumpImageCmd, NULL, NULL);
  return Tcl_PkgProvide(interp, "dumpImage", "0.1");
}
#
# makefile to build dumpImage
#
# Feb. 13, 2011   zhuo
#

TARGET	= dumpImage

INCPATH	= "C:/Tcl/include"
LIBPATH	= "C:/Tcl/lib"
CFLAGS	= -I${INCPATH} -O3 -Wall
LDFLAGS	= -L${LIBPATH} -ltcl84 -ltk84

CC	= gcc

.SUFFIX: .c .o
.c.o:
	${CC} -c ${CFLAGS} $<

${TARGET}.dll: ${TARGET}.o
	${CC} -shared -o $@ $< ${LDFLAGS}

clean:
	- ${RM} *.*~
	- ${RM} *~
	- ${RM} ${TARGET}.o
	- ${RM} ${TARGET}.dll

Rev.0.1. pure Tcl script version (Feb. 13, 2011)

The first attempt is made as a pure Tcl script. It works but very slowly: Dumping 60 images at the size of 640 x 480 pixels (in 24 bit color) takes about 30 seconds :-( --- because of the massive data processing in the script level (although I tried to avoid some inefficiency).
//
最初の試みは,tclスクリプトのみで行ないました.一応動きますが...非常に遅いです.640x480の画像を60枚書き出すのに約30秒かかります :-( ---スクリプトで大量のデータ処理をしているので仕方ありません(これでも,明らかな無駄は避けたんですが...)

Rev. 0.1. download

Rev. 0.1. contents:-)

Actually the zip archive above is very small -- so I just paste them here :-)

Rev. 0.1. readme.txt

aviwriter.tcl: An Experimental Tcl/Tk Script to Generate a AVI File Directly

Feb. 12, 2011    zhuo

Abstract

I wrote aviwriter.tcl. This is an itcl class that can generate an AVI
file directly from image data in Tcl/Tk.

It works, but very slowly, regardless of efforts for efficiency. 
If you seriously look for a means to do this, I recommend that you
write the image data to files, and that you use a conversion tool
to merge the image files into a movie file. 


How to try

0. OS: I tested this on Windows XP  --- Not sure if this works on 
   other platforms. 

1. Be sure to have Itcl, Tk, Img, and base64 packages ready on your
Tcl environment. Installing Active Tcl is an easy way to clear this
requirement.

2. Anyway, type to the command line:
   % tclsh aviwriter_test.tcl
   (Or, double-click on the icon for it)

   ... then you will see a window, and after a while a huge avi file
   will appear in "out" directory.

3. Open aviwriter_test.tcl by a text editor.

4. Modify line 13 from:
      set DirectAvi 1
   to:
      set DirectAvi 0
   and save.

5. Run the script again:
   % tclsh aviwriter_test.tcl
   (Or, double-click on the icon for it)

   ... this time 60 image files are generated in "out" directory
   much faster.

6. Find and use a converter to combine the image files to a single
   movie file.  As far as I know, "virtualdub" does the job.
  
   ... I recommend this approach because it is much faster, and
   you can choose from among many encoders for AVI files
   (Note that  this aviwriter.tcl supports only uncompressed raw
   format. )

Have Fun!

zhuo
----

Rev. 0.1. aviwriter.tcl

#
# aviwriter.tcl
#
# A sample script to create AVI file by giving a sequence of images.
#
# Warning:
# * There is no guarranty. 
#
# * This script runs very slowly. This is not practical.
#
#   Instead of the inefficient pixel-by-pixel traversal of nested loops,
#   binary data dump by "image data -format ppm" is used for efficiency.
#   Yet, remaining extra processings such as
#     top-bottom flip, base64-decoding, r-g-b flip,  0 insertion...
#   still slow down the operation badly.
#
# * I suggest saving images to files and using a converter application
#   to generate a movie out of them.
#
# Usage:
#     source "aviwriter.tcl"
#     set aw [AVIWriter \#auto]
#     $aw fopen "output.avi"
#     $aw putFrame image1  <= the first image determine the width and the height
#     $aw putFrame image2
#     :
#     $aw setFPS 30        <= FPS can be set at any locations before fclose.
#     $aw fclose
#
# Rev. 0.1. Feb. 12, 2011  zhuo
#

package require Itcl
package require Tk
package require Img
package require base64

# avi header section snapshot
# "R I F F <=size> A V I   L I S T"
# "sz=c0h  h d r l a v i h sz=38h "
# "IFRAME  MAXDR   align   flags  ", iframe = interval of frame, in usec. 1000000/FPS. here,33333.
# "NFRAME  begfr   nstrm   BUFSZ"      *maxdr : W x H x 4 x FPS.
# "WIDTH   HEIGHT  resv    resv"       *NFRAME : total num frame
# "resv    resv    L I S T sz=74h "    *BUFSZ : W x H x 4
# "s t r l s t r h sz=38h  v i d s"
# "fcch    Flag    lang    intfram" ,   fcch = "DIB "
# "SCALE   rate    start   NFRAME ",    SCALE=IFRAME=0x8235=33333, RATE=40420f=1000000; 
# "BUFSZ   quality samplsz (pad)  "
# "(pad)   s t r f sz=28h  sz=28h "
# "WIDTH   HEIGHT  pln/bitcnt compr"
# "SZIMAGE XPels/M YPels/M  ClrUsd"
# "ClrImpt L I S T  m o v i"
#
# one image:
# "0 0 d b SZIMAGE (b)(g)(r)0....."
#
# index:
# "i d x 1  0 0 d b sz=10h "
# "loc.    SZIMAGE 0 0 d b sz=10h "
# "loc.    SZIMAGE ....

#A1 : size of RIFF
#A2 : Interval of Frame, in usec
#A3 : number of frames
#A4 : BUFSZ=SZIMAGE 
#A5 : Width.
#A6 : Height:
#A7 : size of LIST for movi's 
#A8 : max data rate

itcl::class AVIWriter {
    private common headerTemplateBin_
    set headerTemplateBin_ [binary format H* [join [split "
    52 49 46 46 A1 A1 A1 A1 41 56 49 20 4c 49 53 54
    c0 00 00 00 68 64 72 6c 61 76 69 68 38 00 00 00
    A2 A2 A2 A2 A8 A8 A8 A8 00 00 00 00 10 08 00 00
    A3 A3 A3 A3 00 00 00 00 01 00 00 00 A4 A4 A4 A4
    A5 A5 A5 A5 A6 A6 A6 A6 00 00 00 00 00 00 00 00
    00 00 00 00 00 00 00 00 4c 49 53 54 74 00 00 00
    73 74 72 6c 73 74 72 68 38 00 00 00 76 69 64 73
    44 49 42 20 00 00 00 00 00 00 00 00 00 00 00 00
    A2 A2 A2 A2 40 42 0f 00 00 00 00 00 A3 A3 A3 A3
    A4 A4 A4 A4 ff ff ff ff 00 00 00 00 00 00 00 00
    A5 A5 A6 A6 73 74 72 66 28 00 00 00 28 00 00 00
    A5 A5 A5 A5 A6 A6 A6 A6 01 00 20 00 00 00 00 00
    A4 A4 A4 A4 00 00 00 00 00 00 00 00 00 00 00 00
    00 00 00 00 4c 49 53 54 A7 A7 A7 A7 6d 6f 76 69" ] "" ] ]
	private variable fps_

	private variable fd_
	private variable fname_

	private variable nFrames_

	private variable width_
	private variable height_
	private variable imageSize_
	private variable imageHeaderBin_
	private variable pane_

	constructor {} { setFPS 30 }

	method setFPS { fps } { set fps_ $fps }

	method fopen { fname } {
		set fd_ [open $fname "w"]
		fconfigure $fd_ -translation binary
		set fname_ $fname
		puts -nonewline $fd_ $headerTemplateBin_
		set nFrames_ 0

		set width_ 0
		set height_ 0
		set imageSize_ 0
		set imageHeaderBin_ ""
		return 1
	}

	method putFrame { imageName } {
		set thisWidth [image width $imageName]
		set thisHeight [image height $imageName]

		if { $nFrames_ == 0 } {
			set width_ $thisWidth
			set height_ $thisHeight
			set imageSize_ [expr {$width_ * $height_ * 4}]
			set imageHeaderBin_ [binary format "a4i" "00db" $imageSize_]
			set pane_ [image create photo -width $width_ -height $height_]
		} else {
			if { $width_ != $thisWidth } { return 0 }
			if { $height_ != $thisHeight } { return 0 }
		}				

		#have ppm binary image in variable "ppm"
		$pane_ copy $imageName -subsample 1 -1
		set ppm [::base64::decode [$pane_ data -format ppm]]
		scan $ppm "%s%s%s%s%n" dum_fmt dum_w dum_h dum_max headerLength

		#dump the binary to outbin
		set loc0 [expr $headerLength + 1]
		set loc1 [expr $headerLength + 2]
		set loc2 [expr $headerLength + 3]
		set locEnd [expr $loc0 + $width_ * $height_ * 3]
		while { $loc0 < $locEnd } {
			append outbin [string index $ppm $loc2] [string index $ppm $loc1] [string index $ppm $loc0] \0
			incr loc0 3
			incr loc1 3
			incr loc2 3
		}
		puts -nonewline $fd_ $imageHeaderBin_
		puts -nonewline $fd_ $outbin
		incr nFrames_
		return 1
	}

	method fclose {} {
		# generate index chunk
		puts -nonewline $fd_ [binary format "a4" "idx1"]
		puts -nonewline $fd_ [binary format "i" [expr {0x10 * $nFrames_}]]
		set loc 4
		for { set i 0 } { $i < $nFrames_ } { incr i } {
			puts -nonewline $fd_ [binary format "a4iii" "00db" 16 $loc $imageSize_]
			incr loc $imageSize_
			incr loc 8
		}

		# fill in the size fields
		set frameInterval [expr {int(1000000.0 / $fps_ )}]
		set maxDataRate [expr {int($imageSize_ * $fps_)}]
		set MoviListSize [expr {$nFrames_ * ($imageSize_ + 8) + 4}]
		set RIFFBodySize [expr {(0xe0 - 4 + $MoviListSize - 8) + (8 + $nFrames_ * 0x10) }]

		putInt32At $RIFFBodySize 0x04 
		putInt32At $frameInterval 0x20
		putInt32At $maxDataRate 0x24
		putInt32At $nFrames_ 0x30
		putInt32At $imageSize_ 0x3c
		putInt32At $width_ 0x40
		putInt32At $height_ 0x44
		putInt32At $frameInterval 0x80
		putInt32At $nFrames_ 0x8c
		putInt32At $imageSize_ 0x90
		putInt16At $width_ 0xa0
		putInt16At $height_ 0xa2
		putInt32At $width_ 0xb0
		putInt32At $height_ 0xb4
		putInt32At $imageSize_ 0xc0
		putInt32At $MoviListSize 0xd8
		close $fd_
		
		image delete $pane_
	}

	private method putInt32At { val offset } {
		seek $fd_ $offset start
		puts -nonewline $fd_ [binary format i $val]
	}

	private method putInt16At { val offset } {
		seek $fd_ $offset start
		puts -nonewline $fd_ [binary format s $val]
	}
}

Rev. 0.1. aviwriter_test.tcl

#
# test code for aviwriter.tcl
#
# Rev.0.1   Feb. 12, 2011   by zhuo
#

source "aviwriter.tcl"

set W 640
set H 480

# 1: generate avi directly.   0: generate numbered png files.
set DirectAvi 1
# in both cases, files are created in $outdir.
set outdir "out"


# image display window
set pane [image create photo -width $W -height $H]
pack [label .l -image $pane]
update

# preparation
file mkdir $outdir
if { $DirectAvi } {
	set aw [AVIWriter \#auto]
	$aw fopen [format "%s/t01_%sx%s.avi" $outdir $W $H]
	$aw setFPS 30
}

# sequence generation
for { set i 0 } { $i < 60 } { incr i } {
	$pane put -to 0 0 [expr $W-1] [expr $H-1] \#804040
	$pane put -to $i $i [expr {$i+5}] [expr {$i+5}] \#c0c0ff
	update

	if { $DirectAvi } {
		$aw putFrame $pane
	} else {
		$pane write [format "%s/img%05d.png" $outdir $i] -format png -background \#804040
	}
}

# wrap up
if { $DirectAvi } {
	$aw fclose
}

destroy .