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

Comparing deliantra/Deliantra/res2pm (file contents):
Revision 1.1 by root, Wed Feb 22 20:33:05 2006 UTC vs.
Revision 1.7 by root, Thu Mar 9 19:09:48 2006 UTC

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

Diff Legend

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