1 | #!/opt/bin/perl |
1 | #!/opt/bin/perl |
2 | |
2 | |
3 | # usage: res2pm |
3 | # usage: res2pm |
4 | |
4 | |
5 | open STDOUT, ">:utf8", "Crossfire/Data.pm" |
5 | open STDOUT, ">:utf8", "Deliantra/Data.pm" |
6 | or die "Crossfire/Data.pm: $!"; |
6 | or die "Deliantra/Data.pm: $!"; |
7 | |
7 | |
8 | print <<EOF; |
8 | print <<EOF; |
9 | =head1 NAME |
9 | =head1 NAME |
10 | |
10 | |
11 | Crossfire::Data - various data structures useful for understanding archs and objects |
11 | Deliantra::Data - various data structures useful for understanding archs and objects |
12 | |
12 | |
13 | =head1 |
13 | =head1 |
14 | |
14 | |
15 | THIS FILE IS AUTOGENERATED, DO NOT EDIT! |
15 | THIS FILE IS AUTOGENERATED, DO NOT EDIT! |
16 | |
16 | |
… | |
… | |
22 | |
22 | |
23 | See F<res/README> for more info. |
23 | See F<res/README> for more info. |
24 | |
24 | |
25 | =cut |
25 | =cut |
26 | |
26 | |
27 | package Crossfire::Data; |
27 | package Deliantra::Data; |
28 | |
28 | |
29 | EOF |
29 | EOF |
30 | |
30 | |
31 | use Data::Dumper; |
31 | use Data::Dumper; |
|
|
32 | use XML::Grove::Builder; |
32 | use XML::Parser::Grove; |
33 | use XML::Parser::PerlSAX; |
|
|
34 | |
33 | |
35 | |
34 | sub dump_hash { |
36 | sub dump_hash { |
35 | my ($names, $refs) = @_; |
37 | my ($names, $refs) = @_; |
36 | |
38 | |
37 | $d = new Data::Dumper ($refs, [map "*$_", @$names]); |
39 | $d = new Data::Dumper ($refs, [map "*$_", @$names]); |
… | |
… | |
62 | |
64 | |
63 | print "our $sigil$name = $v;\n\n"; |
65 | print "our $sigil$name = $v;\n\n"; |
64 | } |
66 | } |
65 | } |
67 | } |
66 | |
68 | |
67 | my $type = XML::Parser->new (Style => 'grove')->parsefile ("res/types.xml"); |
69 | my $grove_builder = XML::Grove::Builder->new; |
|
|
70 | my $parser = XML::Parser::PerlSAX->new ( Handler => $grove_builder ); |
|
|
71 | my $type = $parser->parse ( Source => { SystemId => "res/types.xml" } ); |
68 | |
72 | |
69 | my %bitmask; |
73 | my %bitmask; |
70 | my %list; |
74 | my %list; |
71 | my %type; |
75 | my %type; |
72 | my %typename; |
76 | my %typename; |
… | |
… | |
75 | my %ignore_list; |
79 | my %ignore_list; |
76 | my %default_attr; |
80 | my %default_attr; |
77 | my %spell; |
81 | my %spell; |
78 | |
82 | |
79 | sub string($) { |
83 | sub string($) { |
80 | local $_ = join "", @{shift->contents}; |
84 | local $_ = join "", map $_->{Data}, @{shift->{Contents}}; |
81 | $_ =~ s/^\s+//; |
85 | $_ =~ s/^\s+//; |
82 | $_ =~ s/\s+$//; |
86 | $_ =~ s/\s+$//; |
83 | $_ =~ s/\s+/ /g; |
87 | $_ =~ s/\s+/ /g; |
84 | $_ |
88 | $_ |
85 | } |
89 | } |
86 | |
90 | |
87 | sub parse_attr { |
91 | sub parse_attr { |
88 | my ($e, $sect) = @_; |
92 | my ($e, $sect) = @_; |
89 | |
93 | |
90 | my $arch = { |
94 | my $arch = { |
91 | type => $e->attr ("type"), |
95 | type => $e->{Attributes}->{type}, |
92 | name => $e->attr ("editor"), |
96 | name => $e->{Attributes}->{editor}, |
93 | desc => string $e, |
97 | desc => string $e, |
94 | $e->attr("arch_begin") ? (end => $e->attr("arch_end")) : (), |
98 | $e->{Attributes}->{arch_begin} ? (end => $e->{Attributes}->{arch_end}) : (), |
95 | }; |
99 | }; |
96 | |
100 | |
97 | delete $arch->{name} unless defined $arch->{name}; |
101 | delete $arch->{name} unless defined $arch->{name}; |
98 | delete $arch->{desc} unless length $arch->{desc}; |
102 | delete $arch->{desc} unless length $arch->{desc}; |
99 | |
103 | |
100 | if ($arch->{type} =~ s/^(bitmask)_(.*)/$1/) { |
104 | if ($arch->{type} =~ s/^(bitmask)_(.*)/$1/) { |
101 | $arch->{value} = $bitmask{$2} ||= {}; |
105 | $arch->{value} = $bitmask{$2} ||= {}; |
102 | } elsif ($arch->{type} =~ s/^(list)_(.*)/$1/) { |
106 | } elsif ($arch->{type} =~ s/^(list)_(.*)/$1/) { |
103 | $arch->{value} = $list{$2} ||= {}; |
107 | $arch->{value} = $list{$2} ||= {}; |
104 | } elsif ($arch->{type} eq "fixed") { |
108 | } elsif ($arch->{type} eq "fixed") { |
105 | $arch->{value} = $e->attr ("value"); |
109 | $arch->{value} = $e->{Attributes}->{value}; |
106 | } elsif ($arch->{type} =~ s/^bool_special$/bool/) { |
110 | } elsif ($arch->{type} =~ s/^bool_special$/bool/) { |
107 | $arch->{value} = [$e->attr ("false"), $e->attr ("true")]; |
111 | $arch->{value} = [$e->{Attributes}->{false}, $e->{Attributes}->{true}]; |
108 | } |
112 | } |
109 | |
113 | |
110 | push @$sect, [$e->attr ("arch") || $e->attr("arch_begin"), $arch]; |
114 | push @$sect, [$e->{Attributes}->{arch} || $e->{Attributes}->{arch_begin}, $arch]; |
111 | } |
115 | } |
112 | |
116 | |
113 | sub parse_type { |
117 | sub parse_type { |
114 | my ($e, $type) = @_; |
118 | my ($e, $type) = @_; |
115 | |
119 | |
116 | my %main; |
120 | my %main; |
117 | |
121 | |
118 | for my $e (grep ref, @{$e->contents}) { |
122 | for my $e (grep { $_->isa ('XML::Grove::Element') } @{$e->{Contents}}) { |
119 | if ($e->name eq "required") { |
123 | if ($e->{Name} eq "required") { |
120 | # not used |
124 | # not used |
121 | #for my $i (grep ref, @{$e->contents}) { |
125 | #for my $i (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) { |
122 | # $type->{required}{$i->attr ("arch")} = $i->attr ("value"); |
126 | # $type->{required}{$i->{Attributes}->{arch}} = $i->{Attributes}->{value}; |
123 | #} |
127 | #} |
124 | } elsif ($e->name eq "attribute") { |
128 | } elsif ($e->{Name} eq "attribute") { |
125 | parse_attr $e, $type->{attr} ||= []; |
129 | parse_attr $e, $type->{attr} ||= []; |
126 | } elsif ($e->name eq "ignore") { |
130 | } elsif ($e->{Name} eq "ignore") { |
127 | for my $i (grep ref, @{$e->contents}) { |
131 | for my $i (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) { |
128 | if ($i->name eq "ignore_list") { |
132 | if ($i->{Name} eq "ignore_list") { |
129 | push @{$type->{ignore}}, $ignore_list{$i->attr ("name")} ||= []; |
133 | push @{$type->{ignore}}, $ignore_list{$i->{Attributes}->{name}} ||= []; |
130 | } elsif ($i->name eq "attribute") { |
134 | } elsif ($i->{Name} eq "attribute") { |
131 | push @{$type->{ignore}}, $i->attr ("arch"); |
135 | push @{$type->{ignore}}, $i->{Attributes}->{arch}; |
132 | } |
136 | } |
133 | } |
137 | } |
134 | } elsif ($e->name eq "import_type") { |
138 | } elsif ($e->{Name} eq "import_type") { |
135 | #push @{$type->{import}}, $type{$e->attr ("name")} ||= {}; |
139 | #push @{$type->{import}}, $type{$e->{Attributes}->{name}} ||= {}; |
136 | push @{$type->{import}}, $e->attr ("name"); |
140 | push @{$type->{import}}, $e->{Attributes}->{name}; |
137 | } elsif ($e->name eq "use") { |
141 | } elsif ($e->{Name} eq "use") { |
138 | $type->{use} = string $e; |
142 | $type->{use} = string $e; |
139 | } elsif ($e->name eq "description") { |
143 | } elsif ($e->{Name} eq "description") { |
140 | $type->{desc} = string $e; |
144 | $type->{desc} = string $e; |
141 | } elsif ($e->name eq "section") { |
145 | } elsif ($e->{Name} eq "section") { |
142 | my @attr; |
146 | my @attr; |
143 | for my $i (grep ref, @{$e->contents}) { |
147 | for my $i (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) { |
144 | parse_attr $i, \@attr; |
148 | parse_attr $i, \@attr; |
145 | } |
149 | } |
146 | push @{ $type->{section} }, [$e->attr ("name") => \@attr]; |
150 | push @{ $type->{section} }, [$e->{Attributes}->{name} => \@attr]; |
147 | } else { |
151 | } else { |
148 | warn "unknown types subelement ", $e->name; |
152 | warn "unknown types subelement ", $e->{Name}; |
149 | } |
153 | } |
150 | } |
154 | } |
151 | |
155 | |
152 | $type |
156 | $type |
153 | } |
157 | } |
154 | |
158 | |
155 | for my $e (grep ref, @{$type->root->contents}) { |
159 | for my $e (grep $_->isa ('XML::Grove::Element'), @{$type->root->{Contents}}) { |
156 | if ($e->name eq "bitmask") { |
160 | if ($e->{Name} eq "bitmask") { |
157 | my $bm = $bitmask{$e->attr ("name")} ||= {}; |
161 | my $bm = $bitmask{$e->{Attributes}->{name}} ||= {}; |
158 | for my $b (grep ref, @{$e->contents}) { |
162 | for my $b (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) { |
159 | $bm->{$b->attr ("bit")} = $b->attr ("name"); |
163 | $bm->{$b->{Attributes}->{bit}} = $b->{Attributes}->{name}; |
160 | } |
164 | } |
161 | } elsif ($e->name eq "list") { |
165 | } elsif ($e->{Name} eq "list") { |
162 | my $list = $list{$e->attr ("name")} ||= {}; |
166 | my $list = $list{$e->{Attributes}->{name}} ||= {}; |
163 | for my $b (grep ref, @{$e->contents}) { |
167 | for my $b (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) { |
164 | $list->{$b->attr ("value")} = $b->attr ("name"); |
168 | $list->{$b->{Attributes}->{value}} = $b->{Attributes}->{name}; |
165 | } |
169 | } |
166 | } elsif ($e->name eq "ignore_list") { |
170 | } elsif ($e->{Name} eq "ignore_list") { |
167 | my $list = $ignore_list{$e->attr ("name")} ||= []; |
171 | my $list = $ignore_list{$e->{Attributes}->{name}} ||= []; |
168 | for my $b (grep ref, @{$e->contents}) { |
172 | for my $b (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) { |
169 | push @$list, $b->attr ("arch"); |
173 | push @$list, $b->{Attributes}->{arch}; |
170 | } |
174 | } |
171 | } elsif ($e->name eq "default_type") { |
175 | } elsif ($e->{Name} eq "default_type") { |
172 | parse_type $e, \%default_attr; |
176 | parse_type $e, \%default_attr; |
173 | } elsif ($e->name eq "type") { |
177 | } elsif ($e->{Name} eq "type") { |
174 | my $type = $type{$e->attr ("name")} ||= {}; |
178 | my $type = $type{$e->{Attributes}->{name}} ||= {}; |
175 | |
179 | |
176 | $type->{name} = $e->attr ("name"); |
180 | $type->{name} = $e->{Attributes}->{name}; |
177 | |
181 | |
178 | parse_type $e, $type; |
182 | parse_type $e, $type; |
179 | |
183 | |
180 | if ($e->attr ("number") > 0) { |
184 | if ($e->{Attributes}->{number} > 0) { |
181 | $attr{$e->attr ("number")} = $type; |
185 | $attr{$e->{Attributes}->{number}} = $type; |
182 | } elsif ($e->attr ("name") eq "Misc") { |
186 | } elsif ($e->{Attributes}->{name} eq "Misc") { |
183 | delete $type->{required}; |
187 | delete $type->{required}; |
184 | } else { |
188 | } else { |
185 | push @attr0, $type; |
189 | push @attr0, $type; |
186 | } |
190 | } |
187 | |
191 | |
188 | } else { |
192 | } else { |
189 | warn "unknown types element ", $e->name; |
193 | warn "unknown types element ", $e->{Name}; |
190 | } |
194 | } |
191 | } |
195 | } |
192 | |
196 | |
193 | my $type = XML::Parser->new (Style => 'grove')->parsefile ("res/typenumbers.xml"); |
197 | my $type = $parser->parse ( Source => { SystemId => "res/typenumbers.xml" } ); |
194 | |
198 | |
195 | for (grep ref, @{$type->root->contents}) { |
199 | for (grep $_->isa ('XML::Grove::Element'), @{$type->root->{Contents}}) { |
196 | $typename{$_->attr ("number")} = $_->attr ("name"); |
200 | $typename{$_->{Attributes}->{number}} = $_->{Attributes}->{name}; |
197 | } |
201 | } |
198 | |
202 | |
199 | my $spell = XML::Parser->new (Style => 'grove')->parsefile ("res/spells.xml") |
203 | my $spell = $parser->parse ( Source => { SystemId => "res/spells.xml" } ) |
200 | or die; |
204 | or die; |
201 | |
205 | |
202 | for (grep ref, @{$spell->root->contents}) { |
206 | for (grep $_->isa ('XML::Grove::Element'), @{$spell->root->{Contents}}) { |
203 | $spell{$_->attr ("id")} = $_->attr ("name"); |
207 | $spell{$_->{Attributes}->{id}} = $_->{Attributes}->{name}; |
204 | } |
208 | } |
205 | |
209 | |
206 | dump_hash ["BITMASK", "LIST", "IGNORE_LIST", "DEFAULT_ATTR", "TYPE", "ATTR", "TYPENAME", "SPELL"], |
210 | dump_hash ["BITMASK", "LIST", "IGNORE_LIST", "DEFAULT_ATTR", "TYPE", "ATTR", "TYPENAME", "SPELL"], |
207 | [\%bitmask, \%list, \%ignore_list, \%default_attr, \%type, \%attr, \%typename, \%spell]; |
211 | [\%bitmask, \%list, \%ignore_list, \%default_attr, \%type, \%attr, \%typename, \%spell]; |
208 | |
212 | |