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

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.107 by root, Wed May 9 11:44:40 2007 UTC vs.
Revision 1.116 by root, Thu Nov 8 01:21:54 2007 UTC

… …
4 4
5=cut 5=cut
6 6
7package Crossfire; 7package Crossfire;
8 8
9our $VERSION = '0.98'; 9our $VERSION = '1.11';
10 10
11use strict; 11use strict;
12 12
13use base 'Exporter'; 13use base 'Exporter';
14 14
… …
16use File::Spec; 16use File::Spec;
17use List::Util qw(min max); 17use List::Util qw(min max);
18use Storable qw(freeze thaw); 18use Storable qw(freeze thaw);
19 19
20our @EXPORT = qw( 20our @EXPORT = qw(
21 read_pak read_arch *ARCH TILESIZE $TILE *FACE editor_archs arch_extents 21 read_pak read_arch
22 *ARCH $TILE *FACE *FACEDATA
23 TILESIZE CACHESTRIDE
24 editor_archs arch_extents
22); 25);
23 26
24use JSON::XS qw(from_json to_json); 27use JSON::XS qw(from_json to_json);
25 28
26our $LIB = $ENV{CROSSFIRE_LIBDIR}; 29our $LIB = $ENV{CROSSFIRE_LIBDIR};
… …
29 : $ENV{AppData} ? "$ENV{APPDATA}/crossfire" 32 : $ENV{AppData} ? "$ENV{APPDATA}/crossfire"
30 : File::Spec->tmpdir . "/crossfire"; 33 : File::Spec->tmpdir . "/crossfire";
31 34
32mkdir $VARDIR, 0777; 35mkdir $VARDIR, 0777;
33 36
34sub TILESIZE (){ 32 } 37sub TILESIZE (){ 32 }
38sub CACHESTRIDE (){ 64 }
35 39
36our %ARCH; 40our %ARCH;
41our %FACE; # face32
37our %FACE; 42our %FACEDATA;
38our $TILE; 43our $TILE;
39 44
40our %FIELD_MULTILINE = ( 45our %FIELD_MULTILINE = (
41 msg => "endmsg", 46 msg => "endmsg",
42 lore => "endlore", 47 lore => "endlore",
… …
347 } else { 352 } else {
348 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n"; 353 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n";
349 } 354 }
350 } 355 }
351 356
357 # check whether attachment is the same as in the archetype
358 if (exists $ob->{attach}) {
359 my $arch = $ARCH{$ob->{_name}};
360 my $js = JSON::XS->new->utf8->canonical (1);
361
362 if (defined $arch->{attach}
363 && $js->encode ($js->decode ($ob->{attach})) eq $js->encode ($arch->{attach})) {
364 delete $ob->{attach}
365 }
366 }
367
352 # color_fg is used as default for magicmap if magicmap does not exist 368 # color_fg is used as default for magicmap if magicmap does not exist
353 $ob->{magicmap} ||= delete $ob->{color_fg} if exists $ob->{color_fg}; 369 $ob->{magicmap} ||= delete $ob->{color_fg} if exists $ob->{color_fg};
354 370
355 # nuke outdated or never supported fields 371 # nuke outdated or never supported fields
356 delete @$ob{qw( 372 delete @$ob{qw(
… …
792 808
793 my (%ignore); 809 my (%ignore);
794 my (@section_order, %section, @attr_order); 810 my (@section_order, %section, @attr_order);
795 811
796 while (my $type = shift @import) { 812 while (my $type = shift @import) {
813 push @import,
814 grep $_,
815 map $Crossfire::Data::TYPE{$_},
797 push @import, @{$type->{import} || []}; 816 @{$type->{import} || []};
798 817
799 $attr->{$_} ||= $type->{$_} 818 $attr->{$_} ||= $type->{$_}
800 for qw(name desc use); 819 for qw(name desc use);
801 820
802 for (@{$type->{ignore} || []}) { 821 for (@{$type->{ignore} || []}) {
… …
891} 910}
892 911
893sub construct_tilecache_pb { 912sub construct_tilecache_pb {
894 my ($idx, $cache) = @_; 913 my ($idx, $cache) = @_;
895 914
896 my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, 64 * TILESIZE, TILESIZE * int +($idx + 63) / 64; 915 my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, CACHESTRIDE * TILESIZE, TILESIZE * int +($idx + CACHESTRIDE - 1) / CACHESTRIDE;
897 916
898 while (my ($name, $tile) = each %$cache) { 917 while (my ($name, $tile) = each %$cache) {
899 my $tpb = delete $tile->{pb}; 918 my $tpb = delete $tile->{pb};
900 my $ofs = $tile->{idx}; 919 my $ofs = $tile->{idx};
901 920
902 for my $x (0 .. $tile->{w} - 1) { 921 for my $x (0 .. $tile->{w} - 1) {
903 for my $y (0 .. $tile->{h} - 1) { 922 for my $y (0 .. $tile->{h} - 1) {
904 my $idx = $ofs + $x + $y * $tile->{w}; 923 my $idx = $ofs + $x + $y * $tile->{w};
905 $tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE, 924 $tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE,
906 $pb, ($idx % 64) * TILESIZE, TILESIZE * int $idx / 64); 925 $pb, ($idx % CACHESTRIDE) * TILESIZE, TILESIZE * int $idx / CACHESTRIDE);
907 } 926 }
908 } 927 }
909 } 928 }
910 929
911 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1); 930 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
… …
927=cut 946=cut
928 947
929sub load_tilecache() { 948sub load_tilecache() {
930 require Gtk2; 949 require Gtk2;
931 950
932 if (-e "$LIB/crossfire.0") { # Crossfire1 version
933 cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", \&use_tilecache,
934 sub {
935 my $tile = read_pak "$LIB/crossfire.0";
936
937 my %cache;
938
939 my $idx = 0;
940
941 for my $name (sort keys %$tile) {
942 my $pb = new Gtk2::Gdk::PixbufLoader;
943 $pb->write ($tile->{$name});
944 $pb->close;
945 my $pb = $pb->get_pixbuf;
946
947 my $tile = $cache{$name} = {
948 pb => $pb,
949 idx => $idx,
950 w => int $pb->get_width / TILESIZE,
951 h => int $pb->get_height / TILESIZE,
952 };
953
954 $idx += $tile->{w} * $tile->{h};
955 }
956
957 construct_tilecache_pb $idx, \%cache;
958
959 \%cache
960 };
961
962 } else { # Crossfire+ version
963 cache_file "$LIB/facedata", "$VARDIR/tilecache.pst", \&use_tilecache, 951 cache_file "$LIB/facedata", "$VARDIR/tilecache.pst", \&use_tilecache,
964 sub { 952 sub {
965 my %cache; 953 my %cache;
966 my $facedata = Storable::retrieve "$LIB/facedata"; 954 my $facedata = Storable::retrieve "$LIB/facedata";
967 955
968 $facedata->{version} == 2 956 $facedata->{version} == 2
969 or die "$LIB/facedata: version mismatch, cannot proceed."; 957 or die "$LIB/facedata: version mismatch, cannot proceed.";
970 958
971 my $faces = $facedata->{faceinfo}; 959 my $faces = $facedata->{faceinfo};
972 my $idx = 0; 960 my $idx = 0;
973 961
974 for (sort keys %$faces) { 962 for (sort keys %$faces) {
975 my ($face, $info) = ($_, $faces->{$_}); 963 my ($face, $info) = ($_, $faces->{$_});
976 964
977 my $pb = new Gtk2::Gdk::PixbufLoader; 965 my $pb = new Gtk2::Gdk::PixbufLoader;
978 $pb->write ($info->{data32}); 966 $pb->write ($info->{data32});
979 $pb->close; 967 $pb->close;
980 my $pb = $pb->get_pixbuf; 968 my $pb = $pb->get_pixbuf;
981 969
982 my $tile = $cache{$face} = { 970 my $tile = $cache{$face} = {
983 pb => $pb, 971 pb => $pb,
984 idx => $idx, 972 idx => $idx,
985 w => int $pb->get_width / TILESIZE, 973 w => int $pb->get_width / TILESIZE,
986 h => int $pb->get_height / TILESIZE, 974 h => int $pb->get_height / TILESIZE,
987 }; 975 };
988 976
989 $idx += $tile->{w} * $tile->{h}; 977 $idx += $tile->{w} * $tile->{h};
990 } 978 }
991 979
992 construct_tilecache_pb $idx, \%cache; 980 construct_tilecache_pb $idx, \%cache;
993 981
994 \%cache 982 \%cache
995 }; 983 };
996 }
997} 984}
998 985
999=head1 AUTHOR 986=head1 AUTHOR
1000 987
1001 Marc Lehmann <schmorp@schmorp.de> 988 Marc Lehmann <schmorp@schmorp.de>
… …
1005 http://www.ta-sa.org/ 992 http://www.ta-sa.org/
1006 993
1007=cut 994=cut
1008 995
10091 9961
997

Diff Legend

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