| … | |
… | |
| 497 | } |
497 | } |
| 498 | |
498 | |
| 499 | for (split /\n/, $data) { |
499 | for (split /\n/, $data) { |
| 500 | my ($face, $visibility, $fg, $bg, $glyph) = split /\s+/; |
500 | my ($face, $visibility, $fg, $bg, $glyph) = split /\s+/; |
| 501 | |
501 | |
| 502 | $glyph =~ s/^?(?=.)//; # remove "autoglyph" flag |
502 | $glyph =~ s/^\?(?=.)//; # remove "autoglyph" flag |
| 503 | |
503 | |
| 504 | (my $fgi = $COLOR{$fg}) |
504 | (my $fgi = $COLOR{$fg}) |
| 505 | // warn "WARNING: $path: $face specifies unknown foreground colour '$fg'.\n"; |
505 | // warn "WARNING: $path: $face specifies unknown foreground colour '$fg'.\n"; |
| 506 | (my $bgi = $COLOR{$bg}) |
506 | (my $bgi = $COLOR{$bg}) |
| 507 | // warn "WARNING: $path: $face specifies unknown background colour '$bg'.\n"; |
507 | // warn "WARNING: $path: $face specifies unknown background colour '$bg'.\n"; |
| 508 | |
508 | |
| 509 | my $fi = $FACEINFO{$face} ||= { }; |
509 | my $fi = $FACEINFO{$face} ||= { }; |
| 510 | $fi->{visibility} = $visibility * 1; |
510 | $fi->{visibility} = $visibility * 1; |
| 511 | $fi->{magicmap} = $fgi; # foreground colour becomes magicmap |
511 | $fi->{magicmap} = $fgi; # foreground colour becomes magicmap |
| 512 | $fi->{glyph} = (chr $fgi) . (chr $bgi) . $glyph; |
512 | $fi->{glyph} = (chr $fgi) . (chr $bgi) . $glyph; |
|
|
513 | #$fi->{glyph} = (chr $fgi) . $glyph;#d#TOOD remove |
| 513 | # bg not used except for text clients |
514 | # bg not used except for text clients |
| 514 | } |
515 | } |
| 515 | } |
516 | } |
| 516 | |
517 | |
| 517 | sub process_arc { |
518 | sub process_arc { |
| … | |
… | |
| 866 | } |
867 | } |
| 867 | |
868 | |
| 868 | # remove base classes (by naming scheme, should use something like "baseclass xxx" to inherit |
869 | # remove base classes (by naming scheme, should use something like "baseclass xxx" to inherit |
| 869 | @ARC = grep $_->{_name} !~ /^(?:type|class)_/, @ARC; |
870 | @ARC = grep $_->{_name} !~ /^(?:type|class)_/, @ARC; |
| 870 | |
871 | |
|
|
872 | # fix up archetypes without names, where the archanme doesn't work at all |
|
|
873 | for (@ARC) { |
|
|
874 | if (!exists $_->{name} and $_->{_name} =~ /_/) { |
|
|
875 | for ($_->{name} = $_->{_name}) { |
|
|
876 | s/(?:_\d+)+$//; |
|
|
877 | s/_[nesw]+$//; |
|
|
878 | y/_/ /; |
|
|
879 | } |
|
|
880 | } |
|
|
881 | } |
|
|
882 | |
| 871 | print "generating plurals...\n" if $VERBOSE; |
883 | #print "generating plurals...\n" if $VERBOSE; |
| 872 | generate_plurals; |
884 | #generate_plurals; |
| 873 | |
885 | |
| 874 | printf "writing %d archetypes...\n", scalar @ARC if $VERBOSE; |
886 | printf "writing %d archetypes...\n", scalar @ARC if $VERBOSE; |
| 875 | open my $fh, ">:utf8", "$DATADIR/archetypes~" |
887 | open my $fh, ">:utf8", "$DATADIR/archetypes~" |
| 876 | or die "$DATADIR/archetypes~: $!"; |
888 | or die "$DATADIR/archetypes~: $!"; |
| 877 | print $fh Deliantra::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } @ARC]; |
889 | print $fh Deliantra::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } @ARC]; |
