Commits

camlspotter committed 7a64ea7 Merge

merge and clean

Comments (0)

Files changed (362)

0scripts/0CHECKOUT-SVN

-#!/bin/sh
-svn checkout http://caml.inria.fr/svn/ocaml/release/3.11.2 .
-

0scripts/0CLEANDIFF

-#!/usr/bin/perl
-
-while(<>){
-  START:
-    if( /^diff.*\/CVS\/.*/ ){
-	while(<>){
-	    if( /^diff/ ){
-		goto START;
-	    }
-	}
-    } 
-    print $_;
-}

0scripts/0CONFIGURE

-#!/bin/sh
-
-./configure \
-  -prefix /mnt/office/dev/opt/ocaml-spot/3.11.0/
-

0scripts/0CONFIGURE-home

-#!/bin/sh
-
-./configure \
-  -prefix /mnt/office/dev/opt/ocaml-spot/3.11.0/
-

0scripts/0INSTALL-home-old

-#!/bin/sh
-
-tar zxvf ../ocamlspot.tgz
-/bin/rm -rf boot 0MAKEDIFF* 0UPDATE*
-
-
-# # run this script placing itself and ocamlspot.tgz in a newly created directory
-# cvs -d :pserver:anoncvs@camlcvs.inria.fr:/caml co -r ocaml3110 ocaml 
-# mv ocaml/* ocaml/.[A-z]* .
-# rmdir ocaml
-
-tar zxvf ../ocaml-3.11.0.tar.gz
-mv ocaml-3.11.0/* ocaml-3.11.0/.[A-z]* .
-
-patch -p1 < ocamlspot.diff 
-
-./configure
-make core coreboot
-make world
-cp boot/myocamlbuild boot/myocamlbuild.boot
-make opt opt.opt

0scripts/0INSTALL-jane

-#!/bin/sh
-
-# run this script placing itself and ocamlspot.tgz in a newly created directory
-cvs -d :pserver:anoncvs@camlcvs.inria.fr:/caml co -r ocaml3110 ocaml 
-mv ocaml/* ocaml/.[A-z]* .
-rmdir ocaml
-
-# 2008-11-05 bug
-chmod +x ./build/mixed-boot.sh 
-
-tar zxvf ocamlspot.tgz
-rm .hgignore 0MAKEDIFF-home
-patch -p1 < ocamlspot.diff 
-
-./configure
-make core coreboot
-make world opt opt.opt
-

0scripts/0INSTALL_RELEASE

-#!/bin/sh
-
-tar zxvf ../ocaml-3.11.0.tar.gz
-mv ocaml-3.11.0/* ocaml-3.11.0/.[A-z]* .
-
-tar zxvf ../ocamlspotter-1.0.tgz
-mv ocamlspotter-1.0/* .
-patch -p1 < compiler_patch.diff 
-
-./configure
-make core coreboot
-make world
-cp boot/myocamlbuild boot/myocamlbuild.boot
-make opt opt.opt

0scripts/0MAKEDIFF

-#!/usr/bin/perl
-
-`/bin/cp ocamlspot/INSTALL-ocamlspot.txt .`;
-
-# ocaml3111 : 10f98a71c877
-
-`hg diff -r 10f98a71c877 -r tip > ocamlspot.diff`;
-
-open(IN, "ocamlspot.diff");
-
-@files = ("INSTALL-ocamlspot.txt", "ocamlspot.diff", "0MAKEDIFF", "0UPDATE-CVS");
-while(<IN>){
-    if( /^Binary file (.*) has changed/ ){
-	@files = (@files, $1);
-    }
-}
-
-$com = sprintf "tar zcvf ocamlspot.tgz %s", join(' ', @files);
-
-print STDERR "$com\n";
-`$com`;

0scripts/0MAKEDIFF-home

-#!/usr/bin/perl
-
-`/bin/cp ocamlspot/INSTALL-ocamlspot.txt .`;
-
-`hg diff -r be445a4d0c01 -r tip > ocamlspot.diff`;
-
-open(IN, "ocamlspot.diff");
-
-@files = ("INSTALL-ocamlspot.txt", "ocamlspot.diff", "0MAKEDIFF-home", "0UPDATE-CVS", "0INSTALL", ".hgignore");
-while(<IN>){
-    if( /^Binary file (.*) has changed/ ){
-	@files = (@files, $1);
-    }
-}
-
-$com = sprintf "tar zcvf ocamlspot.tgz %s", join(' ', @files);
-
-print STDERR "$com\n";
-`$com`;

0scripts/0MAKEDIFF-jane

-#!/usr/bin/perl
-
-`/bin/cp ocamlspot/INSTALL-ocamlspot.txt .`;
-
-
-`hg diff -r 772c88eaa4a5 -r tip -X CVS -X .hgignore -X 0MAKEDIFF -X 0UPDATE-CVS -X 0INSTALL > ocamlspot.diff`;
-
-open(IN, "ocamlspot.diff");
-
-@files = ("INSTALL-ocamlspot.txt", ".hgignore", "0MAKEDIFF", "0UPDATE-CVS", "0INSTALL", "ocamlspot.diff");
-while(<IN>){
-    if( /^Binary file (.*) has changed/ ){
-	@files = (@files, $1);
-    }
-}
-
-$com = sprintf "tar zcvf ocamlspot.tgz %s", join(' ', @files);
-
-print STDERR "$com\n";
-`$com`;

0scripts/0MAKERELEASE

-#!/usr/bin/perl
-
-$VERSION="1.05";
-$PURE_OCAML="10f98a71c877";
-
-`/bin/cp ocamlspot/INSTALL-ocamlspot.txt ocamlspot/BRAIN_DEAD_INSTALL.sh .`;
-
-`hg diff -r $PURE_OCAML -r tip -X "0*" -X ".hg[a-z]*" -X "ocamlspot" | ./0CLEANDIFF > compiler_patch.diff`;
-
-`cd ocamlspot; make clean`;
-@files = ("INSTALL-ocamlspot.txt", "BRAIN_DEAD_INSTALL.sh", "compiler_patch.diff", "ocamlspot");
-
-$com = sprintf "tar zcvf ocamlspotter-%s_uncleaned.tgz --exclude=\"*~\" %s", $VERSION, join(' ', @files);
-
-print STDERR "$com\n";
-`$com`;

0scripts/0UPDATE-J

-#!/bin/sh
-/bin/rm -rf [D-z]* Changes .depend .cvsignore
-(cd /usr/local/home/godi310/godi/build/godi/godi-ocaml-labltk/work/ocaml; tar cf - .) | tar xvf -
-
-

0scripts/0install

-#!/bin/sh
-
-./configure --prefix $PREFIX
-make clean core coreboot world opt opt.opt install
-cp ocamlspot/ocamlspot.el $MY_ELISP

camlp4/man/camlp4.help.tpl

-

man/ocaml.help

--   
-OCaml           # Objective Caml toplevel
-Usage: ocaml <options>
-options are:
-  -I <dir>  Add <dir> to the list of include directories
-  -unsafe  No bound checking on array and string access
-  -drawlambda  (undocumented)
-  -dlambda  (undocumented)
-  -dinstr  (undocumented)
-  -rectypes  (undocumented)
-
--   
-OCamlc          # Objective Caml compiler
-Usage: ocamlc <options> <files>
-Options are:
-  -a  Build a library
-  -c  Compile only (do not link)
-  -cc <comp>  Use <comp> as the C compiler and linker
-  -cclib <opt>  Pass option <opt> to the C linker
-  -ccopt <opt>  Pass option <opt> to the C compiler and linker
-  -g  Save debugging information
-  -i  Print the types
-  -I <dir>  Add <dir> to the list of include directories
-  -impl <file>  Compile <file> as a .ml file
-  -intf <file>  Compile <file> as a .mli file
-  -intf-suffix <file>  Suffix for interface file (default: .mli)
-  -intf_suffix <file>  (deprecated) same as -intf-suffix
-  -linkall  Link all modules, even unused ones
-  -make-runtime  Build a runtime system with given C objects and libraries
-  -make_runtime  (deprecated) same as -make-runtime
-  -noassert  Do not compile assertion checks
-  -o <file>  Set output file name to <file>
-  -output-obj Output a C object file instead of an executable
-  -pp <command>  Pipe sources through preprocessor <command>
-  -thread  Use thread-safe standard library
-  -unsafe  No bounds checking on array and string access
-  -use-runtime <path>  Generate bytecode for the given runtime system
-  -use_runtime <path>  (deprecated) same as -use-runtime
-  -v  Print compiler version number
-  -verbose  Print calls to external commands
-  -w <flags>  Enable or disable warnings according to <flags>:
-     A/a enable/disable all warnings
-     C/c enable/disable suspicious comment
-     F/f enable/disable partially applied function
-     M/m enable/disable overriden method
-     P/p enable/disable partial match
-     S/s enable/disable non-unit statement
-     U/u enable/disable unused match case
-     V/v enable/disable hidden instance variable
-     X/x enable/disable all other warnings
-     default setting is A (all warnings enabled)
-  -nopervasives  (undocumented)
-  -dparsetree  (undocumented)
-  -drawlambda  (undocumented)
-  -dlambda  (undocumented)
-  -dinstr  (undocumented)
-  -use-prims <file>  (undocumented)
-  -rectypes  (undocumented)
-  - <file>  Treat <file> as a file name (even if it starts with `-')
-
--   
-OCamlc-custom   # Objective Caml compiler for custom runtime mode
-Usage: ocamlc-custom <options> <files>
-Options are:
-  -a  Build a library
-  -c  Compile only (do not link)
-  -cc <comp>  Use <comp> as the C compiler and linker
-  -cclib <opt>  Pass option <opt> to the C linker
-  -ccopt <opt>  Pass option <opt> to the C compiler and linker
-  -g  Save debugging information
-  -i  Print the types
-  -I <dir>  Add <dir> to the list of include directories
-  -impl <file>  Compile <file> as a .ml file
-  -intf <file>  Compile <file> as a .mli file
-  -intf-suffix <file>  Suffix for interface file (default: .mli)
-  -intf_suffix <file>  (deprecated) same as -intf-suffix
-  -linkall  Link all modules, even unused ones
-  -make-runtime  Build a runtime system with given C objects and libraries
-  -make_runtime  (deprecated) same as -make-runtime
-  -noassert  Do not compile assertion checks
-  -o <file>  Set output file name to <file>
-  -output-obj Output a C object file instead of an executable
-  -pp <command>  Pipe sources through preprocessor <command>
-  -thread  Use thread-safe standard library
-  -unsafe  No bounds checking on array and string access
-  -use-runtime <path>  Generate bytecode for the given runtime system
-  -use_runtime <path>  (deprecated) same as -use-runtime
-  -v  Print compiler version number
-  -verbose  Print calls to external commands
-  -w <flags>  Enable or disable warnings according to <flags>:
-     A/a enable/disable all warnings
-     C/c enable/disable suspicious comment
-     F/f enable/disable partially applied function
-     M/m enable/disable overriden method
-     P/p enable/disable partial match
-     S/s enable/disable non-unit statement
-     U/u enable/disable unused match case
-     V/v enable/disable hidden instance variable
-     X/x enable/disable all other warnings
-     default setting is A (all warnings enabled)
-  -nopervasives  (undocumented)
-  -dparsetree  (undocumented)
-  -drawlambda  (undocumented)
-  -dlambda  (undocumented)
-  -dinstr  (undocumented)
-  -use-prims <file>  (undocumented)
-  -rectypes  (undocumented)
-  - <file>  Treat <file> as a file name (even if it starts with `-')
-
--   
-OCamlDep        # Objective Caml dependency generator
-Usage: ocamldep [-I <dir>] <files>
-  -I <dir>  Add <dir> to the list of include directories
-
--   
-OCamlLex        # Objective Caml lexer generator
-OCamlLex name.mll
-
--   
-OCamlRun        # Objective Caml bytecode interpreter
-OCamlRun [-v] file [arguments�]
-    -v                      # print GC messages
-
-Environment variable:
-Set -e OCamlRunParam "<option>=<value>,�"
-    h     # initial size of the major heap
-    i     # minimum size increment for the major heap
-    l     # maximum stack size
-    o     # major GC speed setting
-    O     # heap compaction trigger setting
-    s     # size of the minor heap
-    v     # verbosity flags for GC messages
-
--   
-OCamlYacc       # Objective Caml parser generator
-OCamlYacc [-v] [-b string] file.mly
-    -v                      # put verbose report in file.output
-    -b string               # name output files string.ml and string.mli

otherlibs/labltk/Makefile

 # Top Makefile for mlTk
 
-SUBDIRS=compiler support lib jpf frx tkanim examples_labltk \
+SUBDIRS=compiler support lib jpf frx examples_labltk \
 	examples_camltk browser
 SUBDIRS_GENERATED=camltk labltk
 
 	cd lib; $(MAKE)
 	cd jpf; $(MAKE)
 	cd frx; $(MAKE)
-	cd tkanim; $(MAKE)
 	cd browser; $(MAKE)
 
 allopt:
 	cd lib; $(MAKE) opt
 	cd jpf; $(MAKE) opt
 	cd frx; $(MAKE) opt
-	cd tkanim; $(MAKE) opt
 
 byte: all
 opt: allopt
 	cd compiler; $(MAKE) install
 	cd jpf; $(MAKE) install
 	cd frx; $(MAKE) install
-	cd tkanim; $(MAKE) install
 	cd browser; $(MAKE) install
 
 installopt:
 	cd camltk; $(MAKE) installopt
 	cd jpf; $(MAKE) installopt
 	cd frx; $(MAKE) installopt
-	cd tkanim; $(MAKE) installopt
 
 partialclean clean:
 	for d in $(SUBDIRS); do \

otherlibs/labltk/examples_camltk/eyes.ml

   pack [fw] [];
   let c = Canvas.create fw [Width (Pixels 200); Height (Pixels 200)] in
   let create_eye cx cy wx wy ewx ewy bnd =
-    let o2 =
+    let _o2 =
        Canvas.create_oval c
         (Pixels (cx - wx)) (Pixels (cy - wy))
         (Pixels (cx + wx)) (Pixels (cy + wy))

otherlibs/labltk/examples_camltk/tetris.ml

   let scorev = Textvariable.create ()
   and linev = Textvariable.create ()
   and levv = Textvariable.create ()
-  and namev = Textvariable.create ()
   in
   let f = Frame.create fw [BorderWidth (Pixels 2)] in
   let c = Canvas.create f [Width (Pixels (block_size * 10));

otherlibs/labltk/support/camltk.h

 /*                                                                       */
 /*************************************************************************/
 
-/* $Id: camltk.h 9547 2010-01-22 12:48:24Z doligez $ */
+/* $Id: camltk.h 10230 2010-04-03 06:43:51Z furuse $ */
 
 #if defined(_WIN32) && defined(CAML_DLL) && defined(IN_CAMLTKSUPPORT)
 #define CAMLTKextern CAMLexport
 #define CONST84
 #endif
 
+/* if Tcl_GetStringResult is not defined, we use interp->result */
+#ifndef Tcl_GetStringResult
+#  define Tcl_GetStringResult(interp) (interp->result)
+#endif
+
 /* cltkMisc.c */
 /* copy a Caml string to the C heap. Must be deallocated with stat_free */
 extern char *string_to_c(value s);

otherlibs/labltk/support/cltkDMain.c

 /*                                                                       */
 /*************************************************************************/
 
-/* $Id: cltkDMain.c 8899 2008-07-01 09:55:52Z weis $ */
+/* $Id: cltkDMain.c 10230 2010-04-03 06:43:51Z furuse $ */
 
 #include <unistd.h>
 #include <fcntl.h>
       if (0 == access(f,R_OK))
         if (TCL_OK != Tcl_EvalFile(cltclinterp,f)) {
           stat_free(f);
-          tk_error(cltclinterp->result);
+          tk_error(Tcl_GetStringResult(cltclinterp));
         };
       stat_free(f);
     }

otherlibs/labltk/support/cltkEval.c

 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: cltkEval.c 8899 2008-07-01 09:55:52Z weis $ */
+/* $Id: cltkEval.c 10230 2010-04-03 06:43:51Z furuse $ */
 
 #include <stdlib.h>
 #include <string.h>
 
   switch (code) {
   case TCL_OK:
-    return tcl_string_to_caml(cltclinterp->result);
+    return tcl_string_to_caml(Tcl_GetStringResult(cltclinterp));
   case TCL_ERROR:
-    tk_error(cltclinterp->result);
+    tk_error(Tcl_GetStringResult(cltclinterp));
   default:  /* TCL_BREAK, TCL_CONTINUE, TCL_RETURN */
     tk_error("bad tcl result");
   }
 
   switch (result) {
   case TCL_OK:
-    return tcl_string_to_caml (cltclinterp->result);
+    return tcl_string_to_caml (Tcl_GetStringResult(cltclinterp));
   case TCL_ERROR:
-    tk_error(cltclinterp->result);
+    tk_error(Tcl_GetStringResult(cltclinterp));
   default:  /* TCL_BREAK, TCL_CONTINUE, TCL_RETURN */
     tk_error("bad tcl result");
   }

otherlibs/labltk/support/cltkMain.c

 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: cltkMain.c 8899 2008-07-01 09:55:52Z weis $ */
+/* $Id: cltkMain.c 10230 2010-04-03 06:43:51Z furuse $ */
 
 #include <string.h>
 #include <tcl.h>
     }
 
     if (Tcl_Init(cltclinterp) != TCL_OK)
-      tk_error(cltclinterp->result);
+      tk_error(Tcl_GetStringResult(cltclinterp));
     Tcl_SetVar(cltclinterp, "argv0", String_val (argv0), TCL_GLOBAL_ONLY);
 
     { /* Sets argv */
       }
     }
     if (Tk_Init(cltclinterp) != TCL_OK)
-      tk_error(cltclinterp->result);
+      tk_error(Tcl_GetStringResult(cltclinterp));
 
     /* Retrieve the main window */
     cltk_mainWindow = Tk_MainWindow(cltclinterp);
 
     if (NULL == cltk_mainWindow)
-      tk_error(cltclinterp->result);
+      tk_error(Tcl_GetStringResult(cltclinterp));
 
     Tk_GeometryRequest(cltk_mainWindow,200,200);
   }
       if (0 == access(f,R_OK))
         if (TCL_OK != Tcl_EvalFile(cltclinterp,f)) {
           stat_free(f);
-          tk_error(cltclinterp->result);
+          tk_error(Tcl_GetStringResult(cltclinterp));
         };
       stat_free(f);
     }

otherlibs/labltk/support/cltkMisc.c

 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: cltkMisc.c 9547 2010-01-22 12:48:24Z doligez $ */
+/* $Id: cltkMisc.c 10230 2010-04-03 06:43:51Z furuse $ */
 
 #include <string.h>
 #include <tcl.h>
   case TCL_ERROR:
   default:
     stat_free( utf );
-    tk_error(cltclinterp->result);
+    tk_error(Tcl_GetStringResult(cltclinterp));
   }
 }
 

otherlibs/labltk/support/cltkVar.c

 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: cltkVar.c 9547 2010-01-22 12:48:24Z doligez $ */
+/* $Id: cltkVar.c 10230 2010-04-03 06:43:51Z furuse $ */
 
 /* Alternative to tkwait variable */
 #include <string.h>
   stat_free(stable_var);
 
   if (s == NULL)
-    tk_error(cltclinterp->result);
-  else
+    tk_error(Tcl_GetStringResult(cltclinterp));
+  else 
     return(tcl_string_to_caml(s));
 }
 
   stat_free(utf_contents);
 
   if (s == NULL)
-    tk_error(cltclinterp->result);
-  else
+    tk_error(Tcl_GetStringResult(cltclinterp));
+  else 
     return(Val_unit);
 }
 
                    (ClientData) (Long_val(cbid)))
                    != TCL_OK) {
     stat_free(cvar);
-    tk_error(cltclinterp->result);
+    tk_error(Tcl_GetStringResult(cltclinterp));
   };
   stat_free(cvar);
   return Val_unit;

otherlibs/labltk/support/cltkWait.c

 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: cltkWait.c 9547 2010-01-22 12:48:24Z doligez $ */
+/* $Id: cltkWait.c 10230 2010-04-03 06:43:51Z furuse $ */
 
 #include <tcl.h>
 #include <tk.h>
   vis->win = Tk_NameToWindow(cltclinterp, String_val(win), cltk_mainWindow);
   if (vis -> win == NULL) {
     stat_free((char *)vis);
-    tk_error(cltclinterp->result);
+    tk_error(Tcl_GetStringResult(cltclinterp));
   };
   vis->cbid = Int_val(cbid);
   Tk_CreateEventHandler(vis->win, VisibilityChangeMask,
   vis->win = Tk_NameToWindow(cltclinterp, String_val(win), cltk_mainWindow);
   if (vis -> win == NULL) {
     stat_free((char *)vis);
-    tk_error(cltclinterp->result);
+    tk_error(Tcl_GetStringResult(cltclinterp));
   };
   vis->cbid = Int_val(cbid);
   Tk_CreateEventHandler(vis->win, StructureNotifyMask,

otherlibs/labltk/tkanim/.cvsignore

-gifanimtest
-gifanimtest-static
-*.so
-*.a

otherlibs/labltk/tkanim/.depend

-tkanim.cmo: tkanim.cmi
-tkanim.cmx: tkanim.cmi

otherlibs/labltk/tkanim/Makefile

-# tkAnimGIF.c used the function Tk_ImageObjCmd, which is not available
-# in a plain Tk installation. Should we disable this subdirectory ?
-
-include ../support/Makefile.common
-
-COMPFLAGS=-I ../support -I ../camltk -I ../../unix -I ../../win32unix
-CCFLAGS=-I../../../byterun -I../support $(TK_DEFS) $(SHAREDCCCOMPOPTS)
-
-all: tkanim.cma libtkanim.$(A)
-opt: tkanim.cmxa libtkanim.$(A)
-example: gifanimtest$(EXE)
-
-OBJS=tkanim.cmo
-COBJS= cltkaniminit.$(O) tkAnimGIF.$(O)
-
-tkanim.cma: $(OBJS)
-	$(MKLIB) -ocamlc '$(CAMLCB)' -o tkanim $(OBJS)
-
-tkanim.cmxa: $(OBJS:.cmo=.cmx)
-	$(MKLIB) -ocamlopt '$(CAMLOPTB)' -o tkanim $(OBJS:.cmo=.cmx)
-
-libtkanim.$(A): $(COBJS)
-	$(MKLIB) -o tkanim $(COBJS)
-
-gifanimtest-static$(EXE): all gifanimtest.cmo
-	$(CAMLC) -custom -o $@ -I ../lib -I ../support -I ../../win32unix -I ../../unix -dllpath ../support -dllpath . unix.cma -ccopt -L. $(LIBNAME).cma tkanim.cma gifanimtest.cmo
-
-# dynamic loading
-gifanimtest$(EXE): all gifanimtest.cmo
-	$(CAMLC) -o $@ -I ../lib -I ../support  -I ../../win32unix -I ../../unix -dllpath ../support -dllpath . unix.cma $(LIBNAME).cma tkanim.cma gifanimtest.cmo
-
-#animwish: $(TKANIM_LIB) tkAppInit.o
-#	$(CC) -o $@  tkAppInit.o $(TK_LINK) $(X11_LINK) \
-#		-L. -ltkanim $(LIBS)
-
-$(OBJS) $(OBJS:.cmo=.cmi): ../lib/$(LIBNAME).cma
-
-$(OBJS:.cmo=.cmx): ../lib/$(LIBNAME).cmxa
-
-clean:
-	rm -f *.cm* *.$(O) *.$(A) dlltkanim$(EXT_DLL) gifanimtest$(EXE) gifanimtest-static$(EXE)
-
-.SUFFIXES :
-.SUFFIXES : .mli .ml .cmi .cmo .mlp .cmx .c .$(O)
-
-.mli.cmi:
-	$(CAMLCOMP) $(COMPFLAGS) $<
-
-.ml.cmo:
-	$(CAMLCOMP) $(COMPFLAGS) $<
-
-.ml.cmx:
-	$(CAMLOPT) -c $(COMPFLAGS) $<
-
-.c.$(O):
-	$(BYTECC) $(BYTECCCOMPOPTS) $(CCFLAGS) -c $<
-
-
-install:
-	cp tkanim.cma *.cmi *.mli libtkanim.$(A) $(INSTALLDIR)
-	if [ -f dlltkanim$(EXT_DLL) ]; then \
-		cp dlltkanim$(EXT_DLL) $(STUBLIBDIR)/; \
-	fi
-
-installopt:
-	cp tkanim.cmxa tkanim.$(A) $(INSTALLDIR)
-
-depend: tkanim.ml
-	$(CAMLDEP) *.mli *.ml > .depend
-
-include .depend

otherlibs/labltk/tkanim/Makefile.nt

-include Makefile

otherlibs/labltk/tkanim/README

-This ML code is an interface for Tkanim Tcl/Tk extension. Unfortunately
-it is still test implementation. Look example directory for an example.
-
-The codes under this directory are mainly written by Jun Furuse
-(Jun.Furuse@inria.fr).

otherlibs/labltk/tkanim/cltkaniminit.c

-/***********************************************************************/
-/*                                                                     */
-/*                 MLTk, Tcl/Tk interface of Objective Caml            */
-/*                                                                     */
-/*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    */
-/*               projet Cristal, INRIA Rocquencourt                    */
-/*            Jacques Garrigue, Kyoto University RIMS                  */
-/*                                                                     */
-/*  Copyright 2002 Institut National de Recherche en Informatique et   */
-/*  en Automatique and Kyoto University.  All rights reserved.         */
-/*  This file is distributed under the terms of the GNU Library        */
-/*  General Public License, with the special exception on linking      */
-/*  described in file LICENSE found in the Objective Caml source tree. */
-/*                                                                     */
-/***********************************************************************/
-#include <tk.h>
-#include <mlvalues.h>
-#include "camltk.h"
-
-extern int Tkanim_Init(Tcl_Interp *);
-
-CAMLprim value tkanim_init (rien) /* ML */
-     value rien;
-{
-  if (Tkanim_Init(cltclinterp) != TCL_OK)
-    tk_error ("Can't initialize TkAnim");
-  return Val_unit;
-}

otherlibs/labltk/tkanim/gifanimtest.ml

-(***********************************************************************)
-(*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
-(*                                                                     *)
-(*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
-(*               projet Cristal, INRIA Rocquencourt                    *)
-(*            Jacques Garrigue, Kyoto University RIMS                  *)
-(*                                                                     *)
-(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
-(*  en Automatique and Kyoto University.  All rights reserved.         *)
-(*  This file is distributed under the terms of the GNU Library        *)
-(*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
-(*                                                                     *)
-(***********************************************************************)
-open Camltk
-open Widget
-open Tkanim
-open Tk
-
-let main () =
-  let file = ref "" in
-    Arg.parse [] (fun s -> file := s)
-      "usage: gifanimtest file (animated gif)\n\
-       \tbutton 1 toggles the animation,\n\
-       \tbutton 2 displays the next frame,\n\
-       \tbutton 3 quits.";
-    let t = openTk () in
-
-      (* First of all, you must initialize the extension. *)
-      Tkanim.init ();
-
-      prerr_endline !file;
-
-      (* Then load the animated gif. *)
-      let anim = Tkanim.create !file in
-      prerr_endline "load done";
-
-      (* Check it is really animated or not. *)
-      match anim with
-      | Still x ->
-          (* Use whatever you want in CamlTk with this ImagePhoto. *)
-          prerr_endline "Sorry, it is not an animated GIF."
-
-      | Animated x ->
-          (* OK, let's animate it. *)
-          let l = Label.create t [] in
-            pack [l] [];
-
-            (* animate returns an interface function. *)
-            let f = animate l x in
-
-              (* Button1 toggles the animation *)
-              bind l [[], ButtonPressDetail 1] (BindSet ([], (fun _ ->
-                f false)));
-
-              (* Button2 displays the next frame. *)
-              bind l [[], ButtonPressDetail 2] (BindSet ([], (fun _ ->
-                f true)));
-
-              (* Button3 quits. *)
-              bind l [[], ButtonPressDetail 3] (BindSet ([], (fun _ ->
-                closeTk ())));
-
-              (* start the animation *)
-              f false;
-
-              (* Go to the main loop. *)
-              mainLoop ()
-
-let _ = Printexc.print main ()

otherlibs/labltk/tkanim/libtkanim.clib

-cltkaniminit.o tkAnimGIF.o

otherlibs/labltk/tkanim/mmm.anim.gif

Removed
Old image

otherlibs/labltk/tkanim/tkAnimGIF.c

-/***********************************************************************/
-/*                                                                     */
-/*                 MLTk, Tcl/Tk interface of Objective Caml            */
-/*                                                                     */
-/*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    */
-/*               projet Cristal, INRIA Rocquencourt                    */
-/*            Jacques Garrigue, Kyoto University RIMS                  */
-/*                                                                     */
-/*  Copyright 2002 Institut National de Recherche en Informatique et   */
-/*  en Automatique and Kyoto University.  All rights reserved.         */
-/*  This file is distributed under the terms of the GNU Library        */
-/*  General Public License, with the special exception on linking      */
-/*  described in file LICENSE found in the Objective Caml source tree. */
-/*                                                                     */
-/***********************************************************************/
-#define TKANIM_VERSION "1.0"
-/* #define TKANIM_DEBUG */
-
-#include <tk.h>
-#include <string.h>
-
-/*
- * The format record for the Animated GIF file format:
- */
-
-static int      FileMatchGIF _ANSI_ARGS_((FILE *f, char *fileName,
-                    char *formatString, int *widthPtr, int *heightPtr));
-static int      FileReadGIF  _ANSI_ARGS_((Tcl_Interp *interp,
-                    FILE *f, char *fileName, char *formatString));
-
-#define INTERLACE               0x40
-#define LOCALCOLORMAP           0x80
-#define BitSet(byte, bit)       (((byte) & (bit)) == (bit))
-#define MAXCOLORMAPSIZE         256
-#define CM_RED                  0
-#define CM_GREEN                1
-#define CM_BLUE                 2
-#define MAX_LWZ_BITS            12
-#define LM_to_uint(a,b)         (((b)<<8)|(a))
-#define ReadOK(file,buffer,len) (fread(buffer, len, 1, file) != 0)
-
-/*
- * Prototypes for local procedures defined in this file:
- */
-
-static int              DoExtension _ANSI_ARGS_((FILE *fd, int label,
-                            int *transparent, int *delay, int *loop));
-static int              GetCode _ANSI_ARGS_((FILE *fd, int code_size,
-                            int flag));
-static int              GetDataBlock _ANSI_ARGS_((FILE *fd,
-                            unsigned char *buf));
-static int              LWZReadByte _ANSI_ARGS_((FILE *fd, int flag,
-                            int input_code_size));
-static int              ReadColorMap _ANSI_ARGS_((FILE *fd, int number,
-                            unsigned char buffer[3][MAXCOLORMAPSIZE]));
-static int              ReadGIFHeader _ANSI_ARGS_((FILE *f, int *widthPtr,
-                            int *heightPtr));
-static int              ReadImage _ANSI_ARGS_((Tcl_Interp *interp,
-                            char *imagePtr, FILE *fd, int len, int height,
-                            unsigned char cmap[3][MAXCOLORMAPSIZE],
-                            int interlace, int transparent));
-
-static int
-FileMatchGIF(f, fileName, formatString, widthPtr, heightPtr)
-    FILE *f;                    /* The image file, open for reading. */
-    char *fileName;             /* The name of the image file. */
-    char *formatString;         /* User-specified format string, or NULL. */
-    int *widthPtr, *heightPtr;  /* The dimensions of the image are
-                                 * returned here if the file is a valid
-                                 * raw GIF file. */
-{
-        return ReadGIFHeader(f, widthPtr, heightPtr);
-}
-
-static int
-FileReadGIF(interp, f, fileName, formatString)
-    Tcl_Interp *interp;         /* Interpreter to use for reporting errors. */
-    FILE *f;                    /* The image file, open for reading. */
-    char *fileName;             /* The name of the image file. */
-    char *formatString;         /* User-specified format string, or NULL. */
-{
-    int logicalWidth, logicalHeight;
-    int nBytes;
-    Tk_PhotoImageBlock block;
-    unsigned char buf[100];
-    int bitPixel;
-    unsigned int colorResolution;
-    unsigned int background;
-    unsigned int aspectRatio;
-    unsigned char localColorMap[3][MAXCOLORMAPSIZE];
-    unsigned char colorMap[3][MAXCOLORMAPSIZE];
-    int useGlobalColormap;
-    int transparent = -1;
-    int delay = 0;
-    Tk_Window winPtr;
-    int imageLeftPos, imageTopPos, imageWidth, imageHeight;
-    Tk_PhotoHandle photoHandle;
-
-    char widthbuf[32], heightbuf[32];
-    Tcl_DString resultbuf;
-
-    char newresbuf[640];
-    char *imageName;
-    char *resultptr;
-    int loop = -1;
-
-    if((winPtr = Tk_MainWindow(interp)) == NULL){
-        return TCL_ERROR;
-    }
-
-#ifdef TKANIM_DEBUG
-    fprintf(stderr, "\n\t\tHeader check...");
-#endif
-    if (!ReadGIFHeader(f, &logicalWidth, &logicalHeight)) {
-        Tcl_AppendResult(interp, "couldn't read GIF header from file \"",
-                fileName, "\"", NULL);
-        return TCL_ERROR;
-    }
-#ifdef TKANIM_DEBUG
-    fprintf(stderr, "done ");
-#endif
-    if ((logicalWidth <= 0) || (logicalHeight <= 0)) {
-        Tcl_AppendResult(interp, "GIF image file \"", fileName,
-                "\" has dimension(s) <= 0", (char *) NULL);
-        return TCL_ERROR;
-    }
-
-    if (fread(buf, 1, 3, f) != 3) {
-        return TCL_OK;
-    }
-    bitPixel = 2<<(buf[0]&0x07);
-    colorResolution = (((buf[0]&0x70)>>3)+1);
-    background = buf[1];
-    aspectRatio = buf[2];
-
-    if (BitSet(buf[0], LOCALCOLORMAP)) {    /* Global Colormap */
-        if (!ReadColorMap(f, bitPixel, colorMap)) {
-            Tcl_AppendResult(interp, "error reading color map",
-                    (char *) NULL);
-            return TCL_ERROR;
-        }
-    }
-
-#ifdef TKANIM_DEBUG
-    fprintf(stderr, "\n\t\tReading frames ");
-    prevpos = ftell(f);
-#endif
-    sprintf( widthbuf, "%d ", logicalWidth);
-    sprintf( heightbuf, "%d ", logicalHeight);
-
-    Tcl_DStringInit(&resultbuf);
-    Tcl_DStringAppend(&resultbuf, widthbuf, -1);
-    Tcl_DStringAppend(&resultbuf, " ", -1);
-    Tcl_DStringAppend(&resultbuf, heightbuf, -1);
-    Tcl_DStringAppend(&resultbuf, " ", -1);
-    Tcl_DStringAppend(&resultbuf, "{", -1);
-
-    while (1) {
-        if (fread(buf, 1, 1, f) != 1) {
-            /*
-             * Premature end of image.  We should really notify
-             * the user, but for now just show garbage.
-             */
-#ifdef TKANIM_DEBUG
-    fprintf(stderr, "Premature end of image");
-#endif
-
-            break;
-        }
-
-        if (buf[0] == ';') {
-            /*
-             * GIF terminator.
-             */
-#ifdef TKANIM_DEBUG
-    fprintf(stderr, ";");
-    prevpos = ftell(f);
-#endif
-
-            break;
-        }
-
-        if (buf[0] == '!') {
-            /*
-             * This is a GIF extension.
-             */
-#ifdef TKANIM_DEBUG
-    fprintf(stderr, "!");
-    prevpos = ftell(f);
-#endif
-
-            if (fread(buf, 1, 1, f) != 1) {
-                Tcl_AppendResult( interp,
-                 "error reading extension function code in GIF image", NULL );
-/*
-                interp->result =
-                        "error reading extension function code in GIF image";
-*/
-                goto error;
-            }
-            if (DoExtension(f, buf[0], &transparent, &delay, &loop) < 0) {
-                Tcl_AppendResult( interp,
-                 "error reading extension in GIF image", NULL );
-/*
-                interp->result = "error reading extension in GIF image";
-*/              goto error;
-            }
-            continue;
-        }
-
-        if (buf[0] == '\0') {
-            /*
-             * Not a valid start character; ignore it.
-             */
-#ifdef TKANIM_DEBUG
-            fprintf(stderr, "0", buf[0]);
-            prevpos = ftell(f);
-#endif
-            continue;
-        }
-
-        if (buf[0] != ',') {
-            /*
-             * Not a valid start character; ignore it.
-             */
-#ifdef TKANIM_DEBUG
-    fprintf(stderr, "?(%c)", buf[0]);
-    prevpos = ftell(f);
-#endif
-            continue;
-        }
-
-        if (fread(buf, 1, 9, f) != 9) {
-            Tcl_AppendResult( interp,
-                "couldn't read left/top/width/height in GIF image", NULL );
-/*
-            interp->result = "couldn't read left/top/width/height in GIF image";
-*/
-            goto error;
-        }
-
-        useGlobalColormap = ! BitSet(buf[8], LOCALCOLORMAP);
-
-        bitPixel = 1<<((buf[8]&0x07)+1);
-
-        imageLeftPos= LM_to_uint(buf[0], buf[1]);
-        imageTopPos=  LM_to_uint(buf[2], buf[3]);
-        imageWidth=   LM_to_uint(buf[4], buf[5]);
-        imageHeight=  LM_to_uint(buf[6], buf[7]);
-
-        block.width = imageWidth;
-        block.height = imageHeight;
-        block.pixelSize = 3;
-        block.pitch = 3 * imageWidth;
-        block.offset[0] = 0;
-        block.offset[1] = 1;
-        block.offset[2] = 2;
-        block.offset[3] = 3;
-        nBytes = imageHeight * block.pitch;
-        block.pixelPtr = (unsigned char *) ckalloc((unsigned) nBytes);
-
-        sprintf(widthbuf, "%d", imageWidth);
-        sprintf(heightbuf, "%d", imageHeight);
-
-        /* save result */
-
-        {
-#if (TK_MAJOR_VERSION >= 8 && TK_MINOR_VERSION >= 1)
-          Tcl_Obj *argv[7];
-          int i;
-
-          argv[0] = Tcl_NewStringObj("image", -1);
-          argv[1] = Tcl_NewStringObj("create", -1);
-          argv[2] = Tcl_NewStringObj("photo", -1);
-          argv[3] = Tcl_NewStringObj("-width", -1);
-          argv[4] = Tcl_NewStringObj(widthbuf, -1);
-          argv[5] = Tcl_NewStringObj("-height", -1);
-          argv[6] = Tcl_NewStringObj(heightbuf, -1);
-
-          for(i=0; i<7; i++){ Tcl_IncrRefCount(argv[i]); }
-
-          if( Tk_ImageObjCmd((ClientData) winPtr, interp,
-                        /* "image create photo -width <imageWidth>
-                           -height <imageHeight>" */
-                             7, argv) == TCL_ERROR ){
-            return TCL_ERROR;
-          }
-
-        for(i=0; i<7; i++){ Tcl_DecrRefCount(argv[i]); }
-
-#else
-        char *argv[7] = {"image", "create", "photo", "-width", NULL,
-                         "-height", NULL};
-        argv[4] = widthbuf;
-        argv[6] = heightbuf;
-#ifdef TKANIM_DEBUG
-    fprintf(stderr, "\n\t\timage creation (%s %s %s %s %s %s %s)",
-            argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]);
-#endif
-        if( Tk_ImageCmd((ClientData) winPtr, interp,
-                        /* "image create photo -width <imageWidth>
-                           -height <imageHeight>" */
-                        7, argv) == TCL_ERROR ){
-            return TCL_ERROR;
-        }
-#endif
-
-#ifdef TKANIM_DEBUG
-    fprintf(stderr, " done ");
-#endif
-        }
-
-        imageName = interp->result;
-#if (TK_MAJOR_VERSION < 8)
-        photoHandle = Tk_FindPhoto(interp->result);
-#else
-        photoHandle = Tk_FindPhoto(interp, interp->result);
-#endif
-        if (!useGlobalColormap) {
-            if (!ReadColorMap(f, bitPixel, localColorMap)) {
-                    Tcl_AppendResult(interp, "error reading color map",
-                            (char *) NULL);
-                    goto error;
-            }
-            if (ReadImage(interp, (char *) block.pixelPtr, f, imageWidth,
-                    imageHeight, localColorMap, BitSet(buf[8], INTERLACE),
-                    transparent) != TCL_OK) {
-                goto error;
-            }
-        } else {
-            if (ReadImage(interp, (char *) block.pixelPtr, f, imageWidth,
-                    imageHeight, colorMap, BitSet(buf[8], INTERLACE),
-                    transparent) != TCL_OK) {
-                goto error;
-            }
-        }
-        Tk_PhotoPutBlock(
-#if (TK_MAJOR_VERSION == 8 && TK_MINOR_VERSION >= 5 || TK_MAJOR_VERSION > 8)
-        NULL,
-#endif
-photoHandle, &block, 0, 0, imageWidth, imageHeight
-#if (TK_MAJOR_VERSION == 8 && TK_MINOR_VERSION >= 4 || TK_MAJOR_VERSION > 8)
-                   , TK_PHOTO_COMPOSITE_SET
-#endif
-          );
-#ifdef TKANIM_DEBUG
-    fprintf(stderr, " Retrieving result\n");
-#endif
-        /* retrieve result */
-        sprintf(newresbuf, "{%s %d %d %d %d %d} ",
-                imageName, imageWidth, imageHeight, imageLeftPos, imageTopPos,
-                delay);
-#ifdef TKANIM_DEBUG
-    fprintf(stderr, " newresbuf = %s\n", newresbuf);
-#endif
-        ckfree((char *) block.pixelPtr);
-#ifdef TKANIM_DEBUG
-    fprintf(stderr, " free done (now append result)");
-#endif
-        Tcl_DStringAppend( &resultbuf, newresbuf, -1 );
-#ifdef TKANIM_DEBUG
-        fprintf(stderr, "\n\t\tFrame done (%d)", ftell(f) - prevpos);
-        prevpos = ftell(f);
-#endif
-    }
-    sprintf( widthbuf, "%d", loop );
-    Tcl_DStringAppend( &resultbuf, "} ", -1 );
-    resultptr = Tcl_DStringAppend( &resultbuf, widthbuf, -1 );
-#ifdef TKANIM_DEBUG
-    fprintf(stderr, "\nResult = %s\n", resultptr);
-#endif
-    Tcl_ResetResult(interp);
-    Tcl_AppendResult(interp, resultptr, NULL);
-    Tcl_DStringFree(&resultbuf);
-    return TCL_OK;
-
-    error:
-    Tcl_DStringFree(&resultbuf);
-    ckfree((char *) block.pixelPtr);
-    return TCL_ERROR;
-
-}
-
-static int
-DoExtension(fd, label, transparent, delay, loop)
-FILE    *fd;
-int label;
-int     *transparent;
-int     *delay;
-int     *loop;
-{
-        static unsigned char buf[256];
-        int count = 0;
-
-        switch (label) {
-                case 0x01:      /* Plain Text Extension */
-                        break;
-
-                case 0xff:      /* Application Extension */
-                        count = GetDataBlock(fd, (unsigned char*) buf);
-                        if( count < 0){
-                            return 1;
-                        }
-                        if( !strncmp (buf, "NETSCAPE", 8) ) {
-                            /* we ignore check of "2.0" */
-                            count = GetDataBlock (fd, (unsigned char*) buf);
-                            if( count < 0){
-                                return 1;
-                            }
-                            if( buf[0] != 1 ){
-                                fprintf(stderr, "??? %d", buf[0]);
-                            }
-                            *loop = LM_to_uint(buf[1], buf[2]);
-                        }
-                        do {
-                                count = GetDataBlock(fd, (unsigned char*) buf);
-                        } while (count > 0);
-                        return count;
-                        break;
-
-                case 0xfe:      /* Comment Extension */
-                        do {
-                                count = GetDataBlock(fd, (unsigned char*) buf);
-                        } while (count > 0);
-                        return count;
-
-                case 0xf9:      /* Graphic Control Extension */
-                        count = GetDataBlock(fd, (unsigned char*) buf);
-                        if (count < 0) {
-                                return 1;
-                        }
-                        if ((buf[0] & 0x1) != 0) {
-                                *transparent = buf[3];
-                        }
-
-                        /* Delay time */
-                        *delay = LM_to_uint(buf[1],buf[2]);
-
-                        do {
-                            count = GetDataBlock(fd, (unsigned char*) buf);
-                        } while (count > 0);
-                        return count;
-        }
-
-        do {
-            count = GetDataBlock(fd, (unsigned char*) buf);
-        } while (count > 0);
-        return count;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ReadGIFHeader --
- *
- *      This procedure reads the GIF header from the beginning of a
- *      GIF file and returns the dimensions of the image.
- *
- * Results:
- *      The return value is 1 if file "f" appears to start with
- *      a valid GIF header, 0 otherwise.  If the header is valid,
- *      then *widthPtr and *heightPtr are modified to hold the
- *      dimensions of the image.
- *
- * Side effects:
- *      The access position in f advances.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ReadGIFHeader(f, widthPtr, heightPtr)
-    FILE *f;                    /* Image file to read the header from */
-    int *widthPtr, *heightPtr;  /* The dimensions of the image are
-                                 * returned here. */
-{
-    unsigned char buf[7];
-
-    if ((fread(buf, 1, 6, f) != 6)
-            || ((strncmp("GIF87a", (char *) buf, 6) != 0)
-            && (strncmp("GIF89a", (char *) buf, 6) != 0))) {
-        return 0;
-    }
-
-    if (fread(buf, 1, 4, f) != 4) {
-        return 0;
-    }
-
-    *widthPtr = LM_to_uint(buf[0],buf[1]);
-    *heightPtr = LM_to_uint(buf[2],buf[3]);
-    return 1;
-}
-
-/*
- *-----------------------------------------------------------------
- * The code below is copied from the giftoppm program and modified
- * just slightly.
- *-----------------------------------------------------------------
- */
-
-static int
-ReadColorMap(fd,number,buffer)
-FILE        *fd;
-int     number;
-unsigned char   buffer[3][MAXCOLORMAPSIZE];
-{
-        int     i;
-        unsigned char   rgb[3];
-
-        for (i = 0; i < number; ++i) {
-                if (! ReadOK(fd, rgb, sizeof(rgb)))
-                        return 0;
-
-                buffer[CM_RED][i] = rgb[0] ;
-                buffer[CM_GREEN][i] = rgb[1] ;
-                buffer[CM_BLUE][i] = rgb[2] ;
-        }
-        return 1;
-}
-
-
-
-static int ZeroDataBlock = 0;
-
-static int
-GetDataBlock(fd, buf)
-FILE        *fd;
-unsigned char   *buf;
-{
-        unsigned char   count;
-
-        if (! ReadOK(fd,&count,1)) {
-                return -1;
-        }
-
-        ZeroDataBlock = count == 0;
-
-        if ((count != 0) && (! ReadOK(fd, buf, count))) {
-                return -1;
-        }
-
-        return count;
-}
-
-
-static int
-ReadImage(interp, imagePtr, fd, len, height, cmap, interlace, transparent)
-Tcl_Interp *interp;
-char    *imagePtr;
-FILE    *fd;
-int len, height;
-unsigned char   cmap[3][MAXCOLORMAPSIZE];
-int interlace;
-int transparent;
-{
-        unsigned char   c;
-        int     v;
-        int     xpos = 0, ypos = 0, pass = 0;
-        char    *colStr;
-
-
-        /*
-         *  Initialize the Compression routines
-         */
-        if (! ReadOK(fd,&c,1))  {
-            Tcl_AppendResult(interp, "error reading GIF image: ",
-                    Tcl_PosixError(interp), (char *) NULL);
-            return TCL_ERROR;
-        }
-
-        if (LWZReadByte(fd, 1, c) < 0) {
-            interp->result = "format error in GIF image";
-            return TCL_ERROR;
-        }
-
-        if (transparent!=-1 &&
-                (colStr = Tcl_GetVar(interp, "TRANSPARENT_GIF_COLOR", 0L))) {
-                XColor *colorPtr;
-                colorPtr = Tk_GetColor(interp, Tk_MainWindow(interp),
-                                                          Tk_GetUid(colStr));
-                if (colorPtr) {
-/*
-                        printf("color is %d %d %d\n",
-                                        colorPtr->red >> 8,
-                                        colorPtr->green >> 8,
-                                        colorPtr->blue >> 8);
-*/
-                        cmap[CM_RED][transparent] = colorPtr->red >> 8;
-                        cmap[CM_GREEN][transparent] = colorPtr->green >> 8;
-                        cmap[CM_BLUE][transparent] = colorPtr->blue >> 8;
-                        Tk_FreeColor(colorPtr);
-                }
-        }
-
-        while ((v = LWZReadByte(fd,0,c)) >= 0 ) {
-
-                imagePtr[ (xpos*3)  +  (ypos *len*3)] = cmap[CM_RED][v];
-                imagePtr[ (xpos*3)  +  (ypos *len*3) +1] = cmap[CM_GREEN][v];
-                imagePtr[ (xpos*3)  +  (ypos *len*3) +2] = cmap[CM_BLUE][v];
-
-                ++xpos;
-                if (xpos == len) {
-                        xpos = 0;
-                        if (interlace) {
-                                switch (pass) {
-                                        case 0:
-                                        case 1:
-                                                ypos += 8; break;
-                                        case 2:
-                                                ypos += 4; break;
-                                        case 3:
-                                                ypos += 2; break;
-                                }
-
-                                if (ypos >= height) {
-                                        ++pass;
-                                        switch (pass) {
-                                                case 1:
-                                                        ypos = 4; break;
-                                                case 2:
-                                                        ypos = 2; break;
-                                                case 3:
-                                                        ypos = 1; break;
-                                                default:
-                                                        return TCL_OK;
-                                        }
-                                }
-                        } else {
-                                ++ypos;
-                        }
-                }
-                if (ypos >= height)
-                        break;
-        }
-        return TCL_OK;
-}
-
-static int
-LWZReadByte(fd, flag, input_code_size)
-FILE    *fd;
-int flag;
-int input_code_size;
-{
-        static int  fresh = 0;
-        int     code, incode;
-        static int  code_size, set_code_size;
-        static int  max_code, max_code_size;
-        static int  firstcode, oldcode;
-        static int  clear_code, end_code;
-        static int  table[2][(1<< MAX_LWZ_BITS)];
-        static int  stack[(1<<(MAX_LWZ_BITS))*2], *sp;
-        register int    i;
-
-
-        if (flag) {
-
-                set_code_size = input_code_size;
-                code_size = set_code_size+1;
-                clear_code = 1 << set_code_size ;
-                end_code = clear_code + 1;
-                max_code_size = 2*clear_code;
-                max_code = clear_code+2;
-
-                GetCode(fd, 0, 1);
-
-                fresh = 1;
-
-                for (i = 0; i < clear_code; ++i) {
-                        table[0][i] = 0;
-                        table[1][i] = i;
-                }
-                for (; i < (1<<MAX_LWZ_BITS); ++i) {
-                        table[0][i] = table[1][0] = 0;
-                }
-
-                sp = stack;
-
-                return 0;
-
-        } else if (fresh) {
-
-                fresh = 0;
-                do {
-                        firstcode = oldcode = GetCode(fd, code_size, 0);
-                } while (firstcode == clear_code);
-                return firstcode;
-        }
-
-        if (sp > stack)
-                return *--sp;
-
-        while ((code = GetCode(fd, code_size, 0)) >= 0) {
-                if (code == clear_code) {
-                        for (i = 0; i < clear_code; ++i) {
-                                table[0][i] = 0;
-                                table[1][i] = i;
-                        }
-
-                        for (; i < (1<<MAX_LWZ_BITS); ++i) {
-                                table[0][i] = table[1][i] = 0;
-                        }
-
-                        code_size = set_code_size+1;
-                        max_code_size = 2*clear_code;
-                        max_code = clear_code+2;
-                        sp = stack;
-                        firstcode = oldcode = GetCode(fd, code_size, 0);
-                        return firstcode;
-
-        } else if (code == end_code) {
-                int     count;
-                unsigned char   buf[260];
-
-                if (ZeroDataBlock)
-                        return -2;
-
-                while ((count = GetDataBlock(fd, buf)) > 0)
-                        ;
-
-                if (count != 0)
-                        return -2;
-        }
-
-        incode = code;
-
-        if (code >= max_code) {
-                *sp++ = firstcode;
-                code = oldcode;
-        }
-
-        while (code >= clear_code) {
-                *sp++ = table[1][code];
-                if (code == table[0][code]) {
-                        return -2;
-
-                        fprintf(stderr, "circular table entry BIG ERROR\n");
-                        /*
-                         * Used to be this instead, Steve Ball suggested
-                         * the change to just return.
-
-                        printf("circular table entry BIG ERROR\n");
-                        */
-                }
-                code = table[0][code];
-        }
-
-        *sp++ = firstcode = table[1][code];
-
-        if ((code = max_code) <(1<<MAX_LWZ_BITS)) {
-
-                table[0][code] = oldcode;
-                table[1][code] = firstcode;
-                ++max_code;
-                if ((max_code>=max_code_size) && (max_code_size < (1<<MAX_LWZ_BITS))) {
-                        max_code_size *= 2;
-                        ++code_size;
-                }
-        }
-
-        oldcode = incode;
-
-        if (sp > stack)
-                return *--sp;
-        }
-        return code;
-}
-
-
-static int
-GetCode(fd, code_size, flag)
-FILE    *fd;
-int code_size;
-int flag;
-{
-        static unsigned char    buf[280];
-        static int      curbit, lastbit, done, last_byte;
-        int         i, j, ret;
-        unsigned char       count;
-