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