ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/utils/cfutil.in
(Generate patch)

Comparing deliantra/server/utils/cfutil.in (file contents):
Revision 1.103 by root, Sat Oct 16 09:20:58 2010 UTC vs.
Revision 1.107 by root, Wed Oct 20 06:36:48 2010 UTC

… …
55 55
56use Deliantra; 56use Deliantra;
57 57
58$SIG{QUIT} = sub { Carp::cluck "QUIT" }; 58$SIG{QUIT} = sub { Carp::cluck "QUIT" };
59 59
60sub WRITE_FACEINFO() { 0 }
61
62sub usage { 60sub usage {
63 warn <<EOF; 61 warn <<EOF;
64Usage: cfutil [-v] [-q] [--force] [--cache] 62Usage: cfutil [-v] [-q] [--force] [--cache]
65 [--install-arch path] 63 [--install-arch path]
66 [--install-maps maps] 64 [--install-maps maps]
… …
166 "--exclude", "CVS", "--exclude", "/world-precomposed", 164 "--exclude", "CVS", "--exclude", "/world-precomposed",
167 "--delete", "--delete-excluded" 165 "--delete", "--delete-excluded"
168 and die "map installation failed.\n"; 166 and die "map installation failed.\n";
169 167
170 print "maps installed successfully.\n"; 168 print "maps installed successfully.\n";
171}
172
173{
174 no utf8; # == values are utf-8 encoded
175
176 our @WALL_SUFFIX = qw(⬤ ╹ ╺ ┗ ╻ ┃ ┏ ┣ ╸ ┛ ━ ┻ ┓ ┫ ┳ ╋);
177
178 # used to create crude text glyphs for text-based clients
179 sub autoglyph {
180 my ($stem, $face) = @_;
181
182 if ($stem =~ /^wall\/|Nimwall/) {
183 return $WALL_SUFFIX[hex $1]
184 if $stem =~ /(_[0-9A-F]).x11/;
185
186 "█"
187
188 } elsif ($stem =~ /^traps\//) {
189 "☠"
190
191 } elsif ($stem =~ /^armour\/shield/) {
192 "Ø"
193
194 } elsif ($stem =~ /^armour\//) {
195 "A"
196
197 } elsif ($stem =~ /^weapon\//) {
198 "†"
199
200 } elsif ($stem =~ /^readable\//) {
201 "✉"
202
203 } elsif ($stem =~ /^river\//) {
204 "~"
205
206 } elsif ($stem =~ /^floor\/|^ground\/|Nimfloor/) {
207 "·"
208
209 } elsif ($stem =~ /^spells\//) {
210 "!"
211
212 } elsif ($stem =~ /^exit\//) {
213 "⎆"
214
215 } elsif ($stem =~ /^construct\//) {
216 "⌂"
217
218 } elsif ($stem =~ /^player\//) {
219 "\@"
220
221 } elsif ($stem =~ /^(?:monster|misc|class|connect|gods|indoor|inorganic|mining|music|skills).*\/(.)/) {
222 $1
223
224 } else {
225 substr $stem, 0, 1
226 }
227 }
228} 169}
229 170
230{ 171{
231 our %ANIMINFO; 172 our %ANIMINFO;
232 our %FACEINFO; 173 our %FACEINFO;
… …
495 warn "$path: $!, skipping.\n"; 436 warn "$path: $!, skipping.\n";
496 return; 437 return;
497 } 438 }
498 439
499 for (split /\n/, $data) { 440 for (split /\n/, $data) {
441 chomp;
500 my ($face, $visibility, $fg, $bg, $glyph) = split /\s+/; 442 my ($face, $visibility, $fg, $bg, $glyph) = split /\s+/;
443 # bg not used except for text clients
501 444
445 utf8::decode $glyph;
502 $glyph =~ s/^?(?=.)//; # remove "autoglyph" flag 446 $glyph =~ s/^\?(?=.)//; # remove "autoglyph" flag
447
448 $fg = "white" if $fg eq "none"; # lots of faces have no fg colour yet
503 449
504 (my $fgi = $COLOR{$fg}) 450 (my $fgi = $COLOR{$fg})
505 // warn "WARNING: $path: $face specifies unknown foreground colour '$fg'.\n"; 451 // warn "WARNING: $path: $face specifies unknown foreground colour '$fg'.\n";
506 (my $bgi = $COLOR{$bg}) 452 (my $bgi = $COLOR{$bg})
507 // warn "WARNING: $path: $face specifies unknown background colour '$bg'.\n"; 453 // warn "WARNING: $path: $face specifies unknown background colour '$bg'.\n";
508 454
509 my $fi = $FACEINFO{$face} ||= { }; 455 my $fi = $FACEINFO{$face} ||= { };
510 $fi->{visibility} = $visibility * 1; 456 $fi->{visibility} = $visibility * 1;
511 $fi->{magicmap} = $fgi; # foreground colour becomes magicmap 457 $fi->{magicmap} = $fgi; # foreground colour becomes magicmap
458
459 $glyph .= " " if 2 > length $glyph; # TODO kanji
460 die "glyph $face too long" if 2 < length $glyph;
461
462 $fi->{glyph} = "";
463 for (split //, $glyph) {
464 utf8::encode $_;
512 $fi->{glyph} = (chr $fgi) . (chr $bgi) . $glyph; 465 $fi->{glyph} .= (chr $fgi) . (chr $bgi) . $_;
513 # bg not used except for text clients 466 }
514 } 467 }
515 } 468 }
516 469
517 sub process_arc { 470 sub process_arc {
518 while (my ($dir, $file) = @{ $c_arc->get }) { 471 while (my ($dir, $file) = @{ $c_arc->get }) {
… …
866 } 819 }
867 820
868 # remove base classes (by naming scheme, should use something like "baseclass xxx" to inherit 821 # remove base classes (by naming scheme, should use something like "baseclass xxx" to inherit
869 @ARC = grep $_->{_name} !~ /^(?:type|class)_/, @ARC; 822 @ARC = grep $_->{_name} !~ /^(?:type|class)_/, @ARC;
870 823
824 # fix up archetypes without names, where the archanme doesn't work at all
825 for (@ARC) {
826 if (!exists $_->{name} and $_->{_name} =~ /_/) {
827 for ($_->{name} = $_->{_name}) {
828 s/(?:_\d+)+$//;
829 s/_[nesw]+$//;
830 y/_/ /;
831 }
832 }
833 }
834
871 print "generating plurals...\n" if $VERBOSE; 835 #print "generating plurals...\n" if $VERBOSE;
872 generate_plurals; 836 #generate_plurals;
873 837
874 printf "writing %d archetypes...\n", scalar @ARC if $VERBOSE; 838 printf "writing %d archetypes...\n", scalar @ARC if $VERBOSE;
875 open my $fh, ">:utf8", "$DATADIR/archetypes~" 839 open my $fh, ">:utf8", "$DATADIR/archetypes~"
876 or die "$DATADIR/archetypes~: $!"; 840 or die "$DATADIR/archetypes~: $!";
877 print $fh Deliantra::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } @ARC]; 841 print $fh Deliantra::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } @ARC];
878 }
879
880 if (WRITE_FACEINFO) {
881 my @table;
882 for my $face (sort keys %FACEINFO) {
883 my $v = $FACEINFO{$face};
884 (my $xf = $face) =~ s/\+\d+\+\d+$//;
885
886 $v->{magicmap} //= $FACEINFO{$xf}{magicmap};
887 $v->{glyph} //= $FACEINFO{$xf}{glyph};
888
889 $v->{magicmap} =~ y/A-Z_\-/a-z/d;
890
891 delete $v->{glyph} if $v->{glyph} =~ /^\?./;
892
893 my $stem = $v->{stem};
894 $v->{glyph} = $v->{glyph} // ("?" . (autoglyph $stem, $v));
895
896 push @table, [$face, $v->{visibility} || 0, $v->{magicmap} || "none", "none ", $v->{glyph}];
897 }
898 use Text::Table;
899 my $tb = new Text::Table undef, { align => "num" }, undef, undef, undef;
900 $tb->load (@table);
901 open my $fh, ">:raw", "default.faceinfo"or die;
902 print $fh $tb;
903 print "default.faceinfo written, exiting.\n";
904 exit 77;
905 } 842 }
906 843
907 { 844 {
908 printf "writing treasures (%d octets)...\n", length $TRS if $VERBOSE; 845 printf "writing treasures (%d octets)...\n", length $TRS if $VERBOSE;
909 open my $fh, ">:utf8", "$DATADIR/treasures~" 846 open my $fh, ">:utf8", "$DATADIR/treasures~"
… …
921 make_hash $k, $v->{data64}, $v->{hash64}; 858 make_hash $k, $v->{data64}, $v->{hash64};
922 859
923 #length $v->{data32} <= 10000 or warn "WARNING: face '$k' has face32 larger than 10000 bytes, will not work with crossfire client.\n"; 860 #length $v->{data32} <= 10000 or warn "WARNING: face '$k' has face32 larger than 10000 bytes, will not work with crossfire client.\n";
924 #length $v->{data64} <= 10000 or warn "WARNING: face '$k' has face64 larger than 10000 bytes.\n"; 861 #length $v->{data64} <= 10000 or warn "WARNING: face '$k' has face64 larger than 10000 bytes.\n";
925 862
926 exists $v->{visibility}
927 or warn "WARNING: face '$k' has no visibility info, missing faceinfo entry?\n";
928
929 my $stem = delete $v->{stem};
930 $v->{glyph} // warn "WARNING: face '$k' has glyph, cannot autoglyph at the moment."; 863 $v->{glyph} // warn "WARNING: face '$k' has glyph.";
931 #$v->{glyph} //= autoglyph $stem, $v; 864 $v->{visibility} // warn "WARNING: face '$k' has no visibility info, missing faceinfo entry?\n";
865 $v->{magicmap} // warn "WARNING: face '$k' has foreground colour.";
932 866
933 delete $v->{arc}; 867 delete @$v{qw(arc stem)}; # not used by the server
934 } 868 }
935 869
936 print "processing resources...\n" if $VERBOSE; 870 print "processing resources...\n" if $VERBOSE;
937 my $enc = JSON::XS->new->utf8->canonical->relaxed; 871 my $enc = JSON::XS->new->utf8->canonical->relaxed;
938 while (my ($k, $v) = each %RESOURCE) { 872 while (my ($k, $v) = each %RESOURCE) {

Diff Legend

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