| 1 | #!/opt/bin/perl |
1 | #!/opt/bin/perl |
| 2 | |
2 | |
| 3 | #TODO: dwall3_3 => dwall_3_3 |
3 | #TODO: dwall3_3 => dwall_3_3 |
| 4 | #TODO: fix dialogue |
4 | #TODO: fix dialogue |
| 5 | #TODO: update file format version |
5 | #TODO: update file format version |
| 6 | #TODO: fix face names |
|
|
| 7 | |
6 | |
| 8 | # this script checks, fixes and simplifies @match expressions in a map |
7 | # this script checks, fixes and simplifies @match expressions in a map |
| 9 | |
8 | |
| 10 | use Deliantra::Map; |
9 | use Deliantra::Map; |
|
|
10 | |
|
|
11 | our $dirty; |
| 11 | |
12 | |
| 12 | sub fix_msg($) { |
13 | sub fix_msg($) { |
| 13 | my ($msg) = @_; |
14 | my ($msg) = @_; |
| 14 | |
15 | |
| 15 | local $_ = $msg; |
16 | local $_ = $msg; |
| … | |
… | |
| 38 | warn "$path ($_) unexpected characters in match\n" if /[\[\]]/; |
39 | warn "$path ($_) unexpected characters in match\n" if /[\[\]]/; |
| 39 | |
40 | |
| 40 | $_ |
41 | $_ |
| 41 | } |
42 | } |
| 42 | |
43 | |
| 43 | sub patch_perl { |
44 | sub patch_face($) { |
|
|
45 | if ($_[0]{face} =~ /\.[1-9]\d\d$/) { |
|
|
46 | $_[0]{face} =~ s/\.([2-9])\1\1$/.x1$1/; # 222, 333, 444 |
|
|
47 | $_[0]{face} =~ s/\.1(\d\d)$/.x$1/; # 1AB xAB |
|
|
48 | $dirty++; |
|
|
49 | } |
|
|
50 | } |
|
|
51 | |
|
|
52 | sub patch_inv($) { |
| 44 | my ($arch) = @_; |
53 | my ($arch) = @_; |
| 45 | |
|
|
| 46 | my $patched; |
|
|
| 47 | |
54 | |
| 48 | my $inv = $arch->{inventory} || []; |
55 | my $inv = $arch->{inventory} || []; |
| 49 | |
56 | |
| 50 | for (@$inv) { |
57 | for (@$inv) { |
|
|
58 | patch_face $_; |
|
|
59 | |
| 51 | if ($_->{type} == 116 || $_->{_name} =~ /^event_/) { |
60 | if ($_->{type} == 116 || $_->{_name} =~ /^event_/) { |
| 52 | # deliantra to old deliantra+ |
61 | # deliantra to old deliantra+ |
| 53 | if ($_->{slaying} eq '/python/IPO/send.py') { |
62 | if ($_->{slaying} eq '/python/IPO/send.py') { |
| 54 | $_->{title} = 'perl'; |
63 | $_->{title} = 'perl'; |
| 55 | $_->{slaying} = 'ipo'; |
64 | $_->{slaying} = 'ipo'; |
| 56 | $patched++ |
65 | $dirty++ |
| 57 | } elsif ($_->{slaying} eq '/python/IPO/receive.py') { |
66 | } elsif ($_->{slaying} eq '/python/IPO/receive.py') { |
| 58 | $_->{title} = 'perl'; |
67 | $_->{title} = 'perl'; |
| 59 | $_->{slaying} = 'ipo'; |
68 | $_->{slaying} = 'ipo'; |
| 60 | $patched++; |
69 | $dirty++; |
| 61 | } elsif ($_->{slaying} eq '/python/IPO/board.py') { |
70 | } elsif ($_->{slaying} eq '/python/IPO/board.py') { |
| 62 | $_ = { _name => 'event_apply', title => 'perl', slaying => 'board' }; |
71 | $_ = { _name => 'event_apply', title => 'perl', slaying => 'board' }; |
| 63 | $arch->{msg} = '@match *'."\n".'@eval board::command $who, $msg, $npc'."\n"; |
72 | $arch->{msg} = '@match *'."\n".'@eval board::command $who, $msg, $npc'."\n"; |
| 64 | $patched++; |
73 | $dirty++; |
| 65 | } elsif ($_->{slaying} eq '/python/IPO/say.py') { |
74 | } elsif ($_->{slaying} eq '/python/IPO/say.py') { |
| 66 | $arch->{msg} = '@match *'."\n".'@eval ipo::command $who, $msg, $npc'."\n"; |
75 | $arch->{msg} = '@match *'."\n".'@eval ipo::command $who, $msg, $npc'."\n"; |
| 67 | $_ = undef; |
76 | $_ = undef; |
| 68 | $patched++; |
77 | $dirty++; |
| 69 | } elsif ($_->{slaying} eq '/python/IPO/banksay.py') { |
78 | } elsif ($_->{slaying} eq '/python/IPO/banksay.py') { |
| 70 | $arch->{msg} = '@match *'."\n".'@eval bank::command $who, $msg, $npc'."\n"; |
79 | $arch->{msg} = '@match *'."\n".'@eval bank::command $who, $msg, $npc'."\n"; |
| 71 | $_ = undef; |
80 | $_ = undef; |
| 72 | $patched++; |
81 | $dirty++; |
| 73 | } |
82 | } |
| 74 | |
83 | |
| 75 | # old deliantra+ to new plug-in system |
84 | # old deliantra+ to new plug-in system |
| 76 | if ($_ && $_->{title} eq "perl") { |
85 | if ($_ && $_->{title} eq "perl") { |
| 77 | if ($_->{slaying} eq "board") { |
86 | if ($_->{slaying} eq "board") { |
| 78 | push @{$arch->{attach}}, ["board"]; |
87 | push @{$arch->{attach}}, ["board"]; |
| 79 | $_ = undef; |
88 | $_ = undef; |
| 80 | $patched++; |
89 | $dirty++; |
| 81 | } elsif ($_->{slaying} eq "ipo") { |
90 | } elsif ($_->{slaying} eq "ipo") { |
| 82 | if ($_->{_name} eq "event_close") { |
91 | if ($_->{_name} eq "event_close") { |
| 83 | push @{$arch->{attach}}, ["ipo_mailbox"]; |
92 | push @{$arch->{attach}}, ["ipo_mailbox"]; |
| 84 | } elsif ($_->{_name} eq "event_apply") { |
93 | } elsif ($_->{_name} eq "event_apply") { |
| 85 | # |
94 | # |
| 86 | } |
95 | } |
| 87 | $_ = undef; |
96 | $_ = undef; |
| 88 | $patched++; |
97 | $dirty++; |
| 89 | } elsif ($_->{slaying} eq "nimbus") { |
98 | } elsif ($_->{slaying} eq "nimbus") { |
| 90 | push @{$arch->{attach}}, ["nimbus_exit", { restore => $_->{name} eq "restore"}]; |
99 | push @{$arch->{attach}}, ["nimbus_exit", { restore => $_->{name} eq "restore"}]; |
| 91 | $_ = undef; |
100 | $_ = undef; |
| 92 | $patched++; |
101 | $dirty++; |
| 93 | } elsif ($_->{slaying} eq "minesweeper") { |
102 | } elsif ($_->{slaying} eq "minesweeper") { |
| 94 | push @{$arch->{attach}}, ["minesweeper", { split /(?:\s+|=)/, $_->{name} }]; |
103 | push @{$arch->{attach}}, ["minesweeper", { split /(?:\s+|=)/, $_->{name} }]; |
| 95 | $_ = undef; |
104 | $_ = undef; |
| 96 | $patched++; |
105 | $dirty++; |
| 97 | } elsif ($_->{slaying} eq "reseller") { |
106 | } elsif ($_->{slaying} eq "reseller") { |
| 98 | if ($_->{_name} eq "event_drop_on") { |
107 | if ($_->{_name} eq "event_drop_on") { |
| 99 | push @{$arch->{attach}}, ["reseller_floor"]; |
108 | push @{$arch->{attach}}, ["reseller_floor"]; |
| 100 | } elsif ($_->{_name} eq "event_trigger") { |
109 | } elsif ($_->{_name} eq "event_trigger") { |
| 101 | my ($a, $b, $c) = split /,/, $_->{name}; |
110 | my ($a, $b, $c) = split /,/, $_->{name}; |
| 102 | push @{$arch->{attach}}, ["reseller_shopmat", {npc_name => $a, npc_x => $b, npc_y => $c}]; |
111 | push @{$arch->{attach}}, ["reseller_shopmat", {npc_name => $a, npc_x => $b, npc_y => $c}]; |
| 103 | } |
112 | } |
| 104 | $_ = undef; |
113 | $_ = undef; |
| 105 | $patched++; |
114 | $dirty++; |
| 106 | } else { |
115 | } else { |
| 107 | warn "WARNING: unsupported perl event<$_->{slaying}>\n";#d# |
116 | warn "WARNING: unsupported perl event<$_->{slaying}>\n";#d# |
| 108 | } |
117 | } |
| 109 | } |
118 | } |
| 110 | } |
119 | } |
| 111 | } |
120 | } |
| 112 | |
121 | |
| 113 | $arch->{inventory} = [grep $_, @$inv]; |
122 | $arch->{inventory} = [grep $_, @$inv]; |
| 114 | |
|
|
| 115 | $patched |
|
|
| 116 | } |
123 | } |
| 117 | |
124 | |
| 118 | for $path (@ARGV) { |
125 | for $path (@ARGV) { |
| 119 | eval { |
126 | eval { |
| 120 | open my $fh, "<:raw:perlio:utf8", $path |
127 | open my $fh, "<:raw:perlio:utf8", $path |
| … | |
… | |
| 124 | or die "$path: not a deliantra map file\n"; |
131 | or die "$path: not a deliantra map file\n"; |
| 125 | |
132 | |
| 126 | my $map = new_from_file Deliantra::Map $path |
133 | my $map = new_from_file Deliantra::Map $path |
| 127 | or die "$path: file load error\n"; |
134 | or die "$path: file load error\n"; |
| 128 | |
135 | |
| 129 | my $dirty; |
136 | $dirty = 0; |
| 130 | |
137 | |
| 131 | for my $a (map @$_, grep $_, map @$_, grep $_, @{ $map->{map} }) { |
138 | for my $a (map @$_, grep $_, map @$_, grep $_, @{ $map->{map} }) { |
| 132 | if ($a->{inventory} and patch_perl ($a)) { |
139 | patch_face $a; |
| 133 | $dirty = 1; |
140 | |
| 134 | next; |
141 | patch_inv $a if $a->{inventory}; |
| 135 | } |
|
|
| 136 | |
142 | |
| 137 | next unless $a->{msg} =~ /^\@match /; |
143 | next unless $a->{msg} =~ /^\@match /; |
| 138 | |
144 | |
| 139 | my $old = $a->{msg}; |
145 | my $old = $a->{msg}; |
| 140 | |
146 | |
