Statistics
| Branch: | Revision:

root / src / tkenv / tcl2c.pl @ fbe00e73

History | View | Annotate | Download (1.25 KB)

1 01873262 Georg Kunz
#
2
#   Utility for embedding Tcl code into C/C++ as a large string literal.
3
#   Output is somewhat scrambled so that the Tcl code is not directly
4
#   readable inside the resulting binary.
5
#
6
7
if (@ARGV eq "") {
8
    print STDERR "usage: tcl2c output-c-file input-tcl-files";
9
    exit 1;
10
}
11
12
$result = "static unsigned char tcl_code[] = {";
13
14
$outfile = shift @ARGV;
15
16
while (@ARGV)
17
{
18
    $arg = shift @ARGV;
19
20
    foreach $infile (glob($arg)) {
21
        $txt = readTextFile($infile);
22
        $result .= "\n  /* $infile */\n  ";
23
        for ($i=0; $i<length($txt); $i++) {
24
           $a = ord(substr($txt, $i, 1));
25
           $a = 255 - $a;
26
           $result .= "$a,";
27
           $result .= "\n  " if ($i%20 == 19);
28
        }
29
    }
30
}
31
32
$result .= "0\n};\n\n";
33
34
$result .=
35
    "/* decoding part */\n" .
36
    "{\n" .
37
    "  int i;\n" .
38
    "  unsigned char *s = tcl_code;\n" .
39
    "  for (i=0; i<(int)sizeof(tcl_code)-1; i++,s++) {\n" .
40
    "    *s = 255-(*s);\n" .
41
    "  }\n" .
42
    "}\n";
43
44
45
open(OUT, ">$outfile");
46
print OUT $result || die "cannot write $outfile";
47
close OUT;
48
49
exit 0;
50
51
sub readTextFile($)
52
{
53
    my($file) = @_;
54
    open(INFILE, $file) || die "cannot open $file";
55
    read(INFILE, $content, 1000000) || die "cannot read $file";
56
    $content =~ s/\r$//mg;
57
    return $content;
58
}