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.97 by root, Sun Mar 11 00:18:45 2007 UTC vs.
Revision 1.102 by elmex, Sun Apr 15 11:43:03 2007 UTC

… …
4 4
5=cut 5=cut
6 6
7package Crossfire; 7package Crossfire;
8 8
9our $VERSION = '0.97'; 9our $VERSION = '0.98';
10 10
11use strict; 11use strict;
12 12
13use base 'Exporter'; 13use base 'Exporter';
14 14
… …
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 *ARCH TILESIZE $TILE *FACE editor_archs arch_extents
22); 22);
23 23
24use JSON::Syck (); #TODO#d# replace by JSON::PC when it becomes available == working 24use JSON::XS qw(from_json to_json);
25
26sub from_json($) {
27 $JSON::Syck::ImplicitUnicode = 1;
28 JSON::Syck::Load $_[0]
29}
30
31sub to_json($) {
32 $JSON::Syck::ImplicitUnicode = 0;
33 JSON::Syck::Dump $_[0]
34}
35 25
36our $LIB = $ENV{CROSSFIRE_LIBDIR}; 26our $LIB = $ENV{CROSSFIRE_LIBDIR};
37 27
38our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire" 28our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire"
39 : $ENV{AppData} ? "$ENV{APPDATA}/crossfire" 29 : $ENV{AppData} ? "$ENV{APPDATA}/crossfire"
… …
71 61
72our @FIELD_ORDER = (qw( 62our @FIELD_ORDER = (qw(
73 elevation 63 elevation
74 64
75 name name_pl custom_name attach title race 65 name name_pl custom_name attach title race
76 slaying skill msg lore other_arch face 66 slaying skill msg lore other_arch
77 #todo-events 67 is_animated animation face
78 animation is_animated 68 magicmap smoothlevel smoothface
79 str dex con wis pow cha int 69 str dex con wis pow cha int
80 hp maxhp sp maxsp grace maxgrace 70 hp maxhp sp maxsp grace maxgrace
81 exp perm_exp expmul 71 exp perm_exp expmul
82 food dam luck wc ac x y speed speed_left move_state attack_movement 72 food dam luck wc ac x y speed speed_left move_state attack_movement
83 nrof level direction type subtype attacktype 73 nrof level direction type subtype attacktype
… …
358 $ob->{magicmap} ||= delete $ob->{color_fg} if exists $ob->{color_fg}; 348 $ob->{magicmap} ||= delete $ob->{color_fg} if exists $ob->{color_fg};
359 349
360 # nuke outdated or never supported fields 350 # nuke outdated or never supported fields
361 delete @$ob{qw( 351 delete @$ob{qw(
362 can_knockback can_parry can_impale can_cut can_dam_armour 352 can_knockback can_parry can_impale can_cut can_dam_armour
363 can_apply pass_thru can_pass_thru color_bg 353 can_apply pass_thru can_pass_thru color_bg color_fg
364 )}; 354 )};
365 355
366 if (my $mask = delete $ob->{immune} ) { _add_resist $ob, $mask, 100; } 356 if (my $mask = delete $ob->{immune} ) { _add_resist $ob, $mask, 100; }
367 if (my $mask = delete $ob->{protected} ) { _add_resist $ob, $mask, 30; } 357 if (my $mask = delete $ob->{protected} ) { _add_resist $ob, $mask, 30; }
368 if (my $mask = delete $ob->{vulnerable}) { _add_resist $ob, $mask, -100; } 358 if (my $mask = delete $ob->{vulnerable}) { _add_resist $ob, $mask, -100; }
… …
893 }, sub { 883 }, sub {
894 read_arch "$LIB/archetypes" 884 read_arch "$LIB/archetypes"
895 }; 885 };
896} 886}
897 887
888sub construct_tilecache_pb {
889 my ($idx, $cache) = @_;
890
891 my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, 64 * TILESIZE, TILESIZE * int +($idx + 63) / 64;
892
893 while (my ($name, $tile) = each %$cache) {
894 my $tpb = delete $tile->{pb};
895 my $ofs = $tile->{idx};
896
897 for my $x (0 .. $tile->{w} - 1) {
898 for my $y (0 .. $tile->{h} - 1) {
899 my $idx = $ofs + $x + $y * $tile->{w};
900 $tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE,
901 $pb, ($idx % 64) * TILESIZE, TILESIZE * int $idx / 64);
902 }
903 }
904 }
905
906 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
907
908 $cache
909}
910
911sub use_tilecache {
912 my ($face) = @_;
913 $TILE = new_from_file Gtk2::Gdk::Pixbuf "$VARDIR/tilecache.png"
914 or die "$VARDIR/tilecache.png: $!";
915 *FACE = $_[0];
916}
917
898=item load_tilecache 918=item load_tilecache
899 919
900(Re-)Load %TILE and %FACE. 920(Re-)Load %TILE and %FACE.
901 921
902=cut 922=cut
903 923
904sub load_tilecache() { 924sub load_tilecache() {
905 require Gtk2; 925 require Gtk2;
906 926
927 if (-e "$LIB/crossfire.0") { # Crossfire1 version
907 cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", sub { 928 cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", \&use_tilecache,
908 $TILE = new_from_file Gtk2::Gdk::Pixbuf "$VARDIR/tilecache.png" 929 sub {
909 or die "$VARDIR/tilecache.png: $!";
910 *FACE = $_[0];
911 }, sub {
912 my $tile = read_pak "$LIB/crossfire.0"; 930 my $tile = read_pak "$LIB/crossfire.0";
913 931
914 my %cache; 932 my %cache;
915 933
916 my $idx = 0; 934 my $idx = 0;
917 935
918 for my $name (sort keys %$tile) { 936 for my $name (sort keys %$tile) {
919 my $pb = new Gtk2::Gdk::PixbufLoader; 937 my $pb = new Gtk2::Gdk::PixbufLoader;
920 $pb->write ($tile->{$name}); 938 $pb->write ($tile->{$name});
921 $pb->close; 939 $pb->close;
922 my $pb = $pb->get_pixbuf; 940 my $pb = $pb->get_pixbuf;
923 941
924 my $tile = $cache{$name} = { 942 my $tile = $cache{$name} = {
925 pb => $pb, 943 pb => $pb,
926 idx => $idx, 944 idx => $idx,
927 w => int $pb->get_width / TILESIZE, 945 w => int $pb->get_width / TILESIZE,
928 h => int $pb->get_height / TILESIZE, 946 h => int $pb->get_height / TILESIZE,
947 };
948
949 $idx += $tile->{w} * $tile->{h};
950 }
951
952 construct_tilecache_pb $idx, \%cache;
953
954 \%cache
929 }; 955 };
956
957 } else { # Crossfire+ version
958 cache_file "$LIB/facedata", "$VARDIR/tilecache.pst", \&use_tilecache,
959 sub {
960 my %cache;
961 my $facedata = Storable::retrieve "$LIB/facedata";
962
963 $facedata->{version} == 2
964 or die "$LIB/facedata: version mismatch, cannot proceed.";
965
966 my $faces = $facedata->{faceinfo};
967 my $idx = 0;
968
969 for (sort keys %$faces) {
970 my ($face, $info) = ($_, $faces->{$_});
971
972 my $pb = new Gtk2::Gdk::PixbufLoader;
973 $pb->write ($info->{data32});
974 $pb->close;
975 my $pb = $pb->get_pixbuf;
976
977 my $tile = $cache{$face} = {
978 pb => $pb,
979 idx => $idx,
980 w => int $pb->get_width / TILESIZE,
981 h => int $pb->get_height / TILESIZE,
930 982 };
931 983
932 $idx += $tile->{w} * $tile->{h}; 984 $idx += $tile->{w} * $tile->{h};
933 }
934
935 my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, 64 * TILESIZE, TILESIZE * int +($idx + 63) / 64;
936
937 while (my ($name, $tile) = each %cache) {
938 my $tpb = delete $tile->{pb};
939 my $ofs = $tile->{idx};
940
941 for my $x (0 .. $tile->{w} - 1) {
942 for my $y (0 .. $tile->{h} - 1) {
943 my $idx = $ofs + $x + $y * $tile->{w};
944 $tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE,
945 $pb, ($idx % 64) * TILESIZE, TILESIZE * int $idx / 64);
946 } 985 }
986
987 construct_tilecache_pb $idx, \%cache;
988
989 \%cache
947 } 990 };
948 }
949
950 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
951
952 \%cache
953 }; 991 }
954} 992}
955 993
956=head1 AUTHOR 994=head1 AUTHOR
957 995
958 Marc Lehmann <schmorp@schmorp.de> 996 Marc Lehmann <schmorp@schmorp.de>

Diff Legend

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