| … | |
… | |
| 55 | |
55 | |
| 56 | use Deliantra; |
56 | use Deliantra; |
| 57 | |
57 | |
| 58 | $SIG{QUIT} = sub { Carp::cluck "QUIT" }; |
58 | $SIG{QUIT} = sub { Carp::cluck "QUIT" }; |
| 59 | |
59 | |
| 60 | sub WRITE_FACEINFO() { 0 } |
|
|
| 61 | |
|
|
| 62 | sub usage { |
60 | sub usage { |
| 63 | warn <<EOF; |
61 | warn <<EOF; |
| 64 | Usage: cfutil [-v] [-q] [--force] [--cache] |
62 | Usage: 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 |
| 503 | |
447 | |
| 504 | $fg = "white" if $fg eq "none"; # lots of faces have no fg colour yet |
448 | $fg = "white" if $fg eq "none"; # lots of faces have no fg colour yet |
| 505 | |
449 | |
| 506 | (my $fgi = $COLOR{$fg}) |
450 | (my $fgi = $COLOR{$fg}) |
| … | |
… | |
| 509 | // warn "WARNING: $path: $face specifies unknown background colour '$bg'.\n"; |
453 | // warn "WARNING: $path: $face specifies unknown background colour '$bg'.\n"; |
| 510 | |
454 | |
| 511 | my $fi = $FACEINFO{$face} ||= { }; |
455 | my $fi = $FACEINFO{$face} ||= { }; |
| 512 | $fi->{visibility} = $visibility * 1; |
456 | $fi->{visibility} = $visibility * 1; |
| 513 | $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 | |
|
|
461 | $fi->{glyph} = ""; |
|
|
462 | for (split //, $glyph, -1) { |
|
|
463 | utf8::encode $_; |
| 514 | $fi->{glyph} = (chr $fgi) . (chr $bgi) . $glyph; |
464 | $fi->{glyph} .= (chr $fgi) . (chr $bgi) . $_; |
| 515 | #$fi->{glyph} = (chr $fgi) . $glyph;#d#TOOD remove |
465 | } |
| 516 | # bg not used except for text clients |
|
|
| 517 | } |
466 | } |
| 518 | } |
467 | } |
| 519 | |
468 | |
| 520 | sub process_arc { |
469 | sub process_arc { |
| 521 | while (my ($dir, $file) = @{ $c_arc->get }) { |
470 | while (my ($dir, $file) = @{ $c_arc->get }) { |
| … | |
… | |
| 889 | open my $fh, ">:utf8", "$DATADIR/archetypes~" |
838 | open my $fh, ">:utf8", "$DATADIR/archetypes~" |
| 890 | or die "$DATADIR/archetypes~: $!"; |
839 | or die "$DATADIR/archetypes~: $!"; |
| 891 | print $fh Deliantra::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } @ARC]; |
840 | print $fh Deliantra::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } @ARC]; |
| 892 | } |
841 | } |
| 893 | |
842 | |
| 894 | if (WRITE_FACEINFO) { |
|
|
| 895 | my @table; |
|
|
| 896 | for my $face (sort keys %FACEINFO) { |
|
|
| 897 | my $v = $FACEINFO{$face}; |
|
|
| 898 | (my $xf = $face) =~ s/\+\d+\+\d+$//; |
|
|
| 899 | |
|
|
| 900 | $v->{magicmap} //= $FACEINFO{$xf}{magicmap}; |
|
|
| 901 | $v->{glyph} //= $FACEINFO{$xf}{glyph}; |
|
|
| 902 | |
|
|
| 903 | $v->{magicmap} =~ y/A-Z_\-/a-z/d; |
|
|
| 904 | |
|
|
| 905 | delete $v->{glyph} if $v->{glyph} =~ /^\?./; |
|
|
| 906 | |
|
|
| 907 | my $stem = $v->{stem}; |
|
|
| 908 | $v->{glyph} = $v->{glyph} // ("?" . (autoglyph $stem, $v)); |
|
|
| 909 | |
|
|
| 910 | push @table, [$face, $v->{visibility} || 0, $v->{magicmap} || "none", "none ", $v->{glyph}]; |
|
|
| 911 | } |
|
|
| 912 | use Text::Table; |
|
|
| 913 | my $tb = new Text::Table undef, { align => "num" }, undef, undef, undef; |
|
|
| 914 | $tb->load (@table); |
|
|
| 915 | open my $fh, ">:raw", "default.faceinfo"or die; |
|
|
| 916 | print $fh $tb; |
|
|
| 917 | print "default.faceinfo written, exiting.\n"; |
|
|
| 918 | exit 77; |
|
|
| 919 | } |
|
|
| 920 | |
|
|
| 921 | { |
843 | { |
| 922 | printf "writing treasures (%d octets)...\n", length $TRS if $VERBOSE; |
844 | printf "writing treasures (%d octets)...\n", length $TRS if $VERBOSE; |
| 923 | open my $fh, ">:utf8", "$DATADIR/treasures~" |
845 | open my $fh, ">:utf8", "$DATADIR/treasures~" |
| 924 | or die "$DATADIR/treasures~: $!"; |
846 | or die "$DATADIR/treasures~: $!"; |
| 925 | print $fh $TRS; |
847 | print $fh $TRS; |
| … | |
… | |
| 935 | make_hash $k, $v->{data64}, $v->{hash64}; |
857 | make_hash $k, $v->{data64}, $v->{hash64}; |
| 936 | |
858 | |
| 937 | #length $v->{data32} <= 10000 or warn "WARNING: face '$k' has face32 larger than 10000 bytes, will not work with crossfire client.\n"; |
859 | #length $v->{data32} <= 10000 or warn "WARNING: face '$k' has face32 larger than 10000 bytes, will not work with crossfire client.\n"; |
| 938 | #length $v->{data64} <= 10000 or warn "WARNING: face '$k' has face64 larger than 10000 bytes.\n"; |
860 | #length $v->{data64} <= 10000 or warn "WARNING: face '$k' has face64 larger than 10000 bytes.\n"; |
| 939 | |
861 | |
| 940 | exists $v->{visibility} |
|
|
| 941 | or warn "WARNING: face '$k' has no visibility info, missing faceinfo entry?\n"; |
|
|
| 942 | |
|
|
| 943 | my $stem = delete $v->{stem}; |
|
|
| 944 | $v->{glyph} // warn "WARNING: face '$k' has glyph, cannot autoglyph at the moment."; |
862 | $v->{glyph} // warn "WARNING: face '$k' has glyph."; |
| 945 | #$v->{glyph} //= autoglyph $stem, $v; |
863 | $v->{visibility} // warn "WARNING: face '$k' has no visibility info, missing faceinfo entry?\n"; |
|
|
864 | $v->{magicmap} // warn "WARNING: face '$k' has foreground colour."; |
| 946 | |
865 | |
| 947 | delete $v->{arc}; |
866 | delete @$v{qw(arc stem)}; # not used by the server |
| 948 | } |
867 | } |
| 949 | |
868 | |
| 950 | print "processing resources...\n" if $VERBOSE; |
869 | print "processing resources...\n" if $VERBOSE; |
| 951 | my $enc = JSON::XS->new->utf8->canonical->relaxed; |
870 | my $enc = JSON::XS->new->utf8->canonical->relaxed; |
| 952 | while (my ($k, $v) = each %RESOURCE) { |
871 | while (my ($k, $v) = each %RESOURCE) { |
