1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
#!/usr/bin/env perl
use strict;
my @args;
my $in = *STDIN;
if ($ARGV[0]) {
open $in, $ARGV[0];
}
my $out = *STDOUT;
if ($ARGV[1]) {
open $out, "> $ARGV[1]";
}
print $out "extern (C) {\n";
while (<$in>) {
s/const //g;
if (parseArgs("D_CPP_CLASS")) {
my $class = shift @args;
my $name = shift @args;
print $out "alias int $name;\n";
}
if (parseArgs("D_CPP_NEW_\\d")) {
my $class = shift @args;
my $name = shift @args;
my $args = join ', ', @args;
print $out "int* $name($args);\n";
}
if (parseArgs("D_CPP_DELETE")) {
my $class = shift @args;
my $name = shift @args;
print $out "void $name(int*);\n";
}
if (parseArgs("D_CPP_METHOD_\\d")) {
my $class = shift @args;
my $method = shift @args;
my $name = shift @args;
my $ret = shift @args;
my $args = join ', ', @args;
if ($args) {
$args = ", $args";
}
print $out "$ret $name(int* $args);\n";
}
if (parseArgs("D_CPP_STATIC_METHOD_\\d")) {
my $class = shift @args;
my $method = shift @args;
my $name = shift @args;
my $ret = shift @args;
my $args = join ', ', @args;
print $out "$ret $name($args);\n";
}
if (parseArgs("D_CPP_VIRTUAL_METHOD_SETTER_\\d")) {
my $class = shift @args;
my $method = shift @args;
my $name = shift @args;
my $ret = shift @args;
my $args = join ', ', @args;
if ($args) {
$args = ", $args";
}
print $out "void $name(int*, $ret (*fp) (int* $args)); \n";
}
if (parseArgs("D_CPP_D_DECLARE")) {
my $declare = shift @args;
$declare =~ s/^\"//;
$declare =~ s/\"$//;
print $out "$declare\n";
}
}
print $out "}\n";
sub parseArgs {
my $name = shift;
if (/$name\s*\(([^\)]*)\)/) {
@args = split /\s*,\s*/, $1;
return 1;
}
else {
return 0;
}
}
|
