ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra/res2pm
(Generate patch)

Comparing deliantra/Deliantra/res2pm (file contents):
Revision 1.2 by root, Wed Feb 22 21:20:19 2006 UTC vs.
Revision 1.3 by root, Wed Feb 22 21:57:29 2006 UTC

… …
28 28
29use Data::Dumper; 29use Data::Dumper;
30use XML::Parser::Grove; 30use XML::Parser::Grove;
31 31
32sub dump_hash { 32sub dump_hash {
33 my ($name, $ref) = @_; 33 my ($names, $refs) = @_;
34 require Data::Dumper; 34
35 $d = new Data::Dumper ([$ref], ["*$name"]); 35 $d = new Data::Dumper ($refs, [map "*$_", @$names]);
36 $d->Terse (1); 36 $d->Terse (1);
37 $d->Indent (1); 37 $d->Indent (1);
38 $d->Quotekeys (0); 38 $d->Quotekeys (0);
39 $d->Useqq (1); 39 $d->Useqq (0);
40 $d->Useperl(1);
40 $d->Sortkeys (sub { 41 $d->Sortkeys (sub {
41 [sort { 42 [sort {
42 $a > 0 && $b > 0 ? $a <=> $b 43 $a > 0 && $b > 0 ? $a <=> $b
43 : $a cmp $b 44 : $a cmp $b
44 } keys %{+shift}] 45 } keys %{+shift}]
45 }); 46 });
47
46 my $d = $d->Dump; 48 my @vals = $d->Dump;
49
50 while (@vals) {
51 my $v = shift @vals;
47 $d =~ s/^ /\t\t/gm; 52 $v =~ s/^ /\t\t/gm;
48 $d =~ s/^ /\t/gm; 53 $v =~ s/^ /\t/gm;
49 $d =~ s/\s+$//; 54 $v =~ s/\s+$//;
55
56 my $name = shift @$names;
57 my $ref = shift @$refs;
58
59 my $sigil = ref $ref eq "ARRAY" ? '@' : '%';
60
50 print "our %$name = $d;\n\n"; 61 print "our $sigil$name = $v;\n\n";
62 }
51} 63}
52 64
53my $type = XML::Parser->new (Style => 'grove')->parsefile ("res/types.xml"); 65my $type = XML::Parser->new (Style => 'grove')->parsefile ("res/types.xml");
54 66
55my %bitmask; 67my %bitmask;
56my %list; 68my %list;
57my %type; 69my %type;
70my %typename;
71my @attr0;
58my $attr; 72my %attr;
59my %ignore_list; 73my %ignore_list;
60my %default_attr; 74my %default_attr;
75my %spell;
61 76
62sub string($) { 77sub string($) {
63 local $_ = join "", @{shift->contents}; 78 local $_ = join "", @{shift->contents};
64 $_ =~ s/^\s+//; 79 $_ =~ s/^\s+//;
65 $_ =~ s/\s+$//; 80 $_ =~ s/\s+$//;
… …
69 84
70sub parse_attr { 85sub parse_attr {
71 my ($e, $sect) = @_; 86 my ($e, $sect) = @_;
72 87
73 my $arch = { 88 my $arch = {
89 type => $e->attr ("type"),
74 name => $e->attr ("editor"), 90 name => $e->attr ("editor"),
75 type => $e->attr ("type"),
76 desc => string $e, 91 desc => string $e,
77 $e->attr("arch_begin") ? (end => $e->attr("arch_end")) : (), 92 $e->attr("arch_begin") ? (end => $e->attr("arch_end")) : (),
78 }; 93 };
79 94
95 delete $arch->{name} unless defined $arch->{name};
96 delete $arch->{desc} unless length $arch->{desc};
97
80 if ($arch->{type} =~ s/^(bitmask)_(.*)/$1/) { 98 if ($arch->{type} =~ s/^(bitmask)_(.*)/$1/) {
99 $arch->{value} = $bitmask{$2} ||= {};
100 } elsif ($arch->{type} =~ s/^(list)_(.*)/$1/) {
81 $arch->{values} = $BITMASK{$2} ||= {}; 101 $arch->{value} = $list{$2} ||= {};
102 } elsif ($arch->{type} =~ s/^bool_special$/bool/) {
103 $arch->{value} = [$e->attr ("false"), $e->attr ("true")];
82 } 104 }
83 105
84 $sect->{$e->attr ("arch") || $e->attr("arch_begin")} = $arch; 106 $sect->{$e->attr ("arch") || $e->attr("arch_begin")} = $arch;
85} 107}
86 108
… …
101 } elsif ($i->name eq "attribute") { 123 } elsif ($i->name eq "attribute") {
102 push @{$type->{ignore}}, $i->attr ("arch"); 124 push @{$type->{ignore}}, $i->attr ("arch");
103 } 125 }
104 } 126 }
105 } elsif ($e->name eq "import_type") { 127 } elsif ($e->name eq "import_type") {
106 push @{$type->{import}}, $xtype{$e->attr ("name")} ||= {}; 128 push @{$type->{import}}, $type{$e->attr ("name")} ||= {};
107 } elsif ($e->name eq "use") { 129 } elsif ($e->name eq "use") {
108 $type->{use} = string $e; 130 $type->{use} = string $e;
109 } elsif ($e->name eq "description") { 131 } elsif ($e->name eq "description") {
110 $type->{desc} = string $e; 132 $type->{desc} = string $e;
111 } elsif ($e->name eq "section") { 133 } elsif ($e->name eq "section") {
… …
138 push @$list, $b->attr ("arch"); 160 push @$list, $b->attr ("arch");
139 } 161 }
140 } elsif ($e->name eq "default_type") { 162 } elsif ($e->name eq "default_type") {
141 parse_type $e, \%default_attr; 163 parse_type $e, \%default_attr;
142 } elsif ($e->name eq "type") { 164 } elsif ($e->name eq "type") {
143 my $type = $attr{$e->attr ("name")} ||= {}; 165 my $type = $type{$e->attr ("name")} ||= {};
144 parse_type $e, $type; 166 parse_type $e, $type;
145 unshift @{$type->{import}}, \%default_attr; 167 #unshift @{$type->{import}}, \%default_attr;
146 $type{$e->attr ("number")}{type}{$e->attr ("name")} = $type; 168
169 if ($e->attr ("number") > 0) {
170 $attr{$e->attr ("number")} = $type;
171 } elsif ($e->attr ("name") eq "Misc") {
172 delete $type->{required};
173 } else {
174 push @attr0, $type;
175 }
147 176
148 } else { 177 } else {
149 warn "unknown types element ", $e->name; 178 warn "unknown types element ", $e->name;
150 } 179 }
151} 180}
152 181
153my $type = XML::Parser->new (Style => 'grove')->parsefile ("res/typenumbers.xml"); 182my $type = XML::Parser->new (Style => 'grove')->parsefile ("res/typenumbers.xml");
154 183
155for (grep ref, @{$type->root->contents}) { 184for (grep ref, @{$type->root->contents}) {
156 $type{$_->attr ("number")}{name} = $_->attr ("name"); 185 $typename{$_->attr ("number")} = $_->attr ("name");
157} 186}
158
159dump_hash "TYPE", \%type;
160 187
161my $spell = XML::Parser->new (Style => 'grove')->parsefile ("res/spells.xml") 188my $spell = XML::Parser->new (Style => 'grove')->parsefile ("res/spells.xml")
162 or die; 189 or die;
163 190
164my %spell;
165
166for (grep ref, @{$spell->root->contents}) { 191for (grep ref, @{$spell->root->contents}) {
167 $spell{$_->attr ("id")} = $_->attr ("name"); 192 $spell{$_->attr ("id")} = $_->attr ("name");
168} 193}
169 194
170dump_hash "SPELL", \%spell; 195dump_hash ["BITMASK", "LIST", "IGNORE_LIST", "DEFAULT_ATTR", "TYPE", "ATTR0", "ATTR", "TYPENAME", "SPELL"],
196 [\%bitmask, \%list, \%ignore_list, \%default_attr, \%type, \@attr0, \%attr, \%typename, \%spell];
171 197
172print <<EOF; 198print <<EOF;
173 199
174=head1 AUTHOR 200=head1 AUTHOR
175 201

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines