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.99 by root, Fri Mar 23 18:25:24 2007 UTC vs.
Revision 1.104 by root, Mon Apr 16 12:32:30 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
61 61
62our @FIELD_ORDER = (qw( 62our @FIELD_ORDER = (qw(
63 elevation 63 elevation
64 64
65 name name_pl custom_name attach title race 65 name name_pl custom_name attach title race
66 slaying skill msg lore other_arch face 66 slaying skill msg lore other_arch
67 #todo-events
68 animation is_animated 67 face animation is_animated
68 magicmap smoothlevel smoothface
69 str dex con wis pow cha int 69 str dex con wis pow cha int
70 hp maxhp sp maxsp grace maxgrace 70 hp maxhp sp maxsp grace maxgrace
71 exp perm_exp expmul 71 exp perm_exp expmul
72 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
73 nrof level direction type subtype attacktype 73 nrof level direction type subtype attacktype
883 }, sub { 883 }, sub {
884 read_arch "$LIB/archetypes" 884 read_arch "$LIB/archetypes"
885 }; 885 };
886} 886}
887 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
888=item load_tilecache 918=item load_tilecache
889 919
890(Re-)Load %TILE and %FACE. 920(Re-)Load %TILE and %FACE.
891 921
892=cut 922=cut
893 923
894sub load_tilecache() { 924sub load_tilecache() {
895 require Gtk2; 925 require Gtk2;
896 926
927 if (-e "$LIB/crossfire.0") { # Crossfire1 version
897 cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", sub { 928 cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", \&use_tilecache,
898 $TILE = new_from_file Gtk2::Gdk::Pixbuf "$VARDIR/tilecache.png" 929 sub {
899 or die "$VARDIR/tilecache.png: $!";
900 *FACE = $_[0];
901 }, sub {
902 my $tile = read_pak "$LIB/crossfire.0"; 930 my $tile = read_pak "$LIB/crossfire.0";
903 931
904 my %cache; 932 my %cache;
905 933
906 my $idx = 0; 934 my $idx = 0;
907 935
908 for my $name (sort keys %$tile) { 936 for my $name (sort keys %$tile) {
909 my $pb = new Gtk2::Gdk::PixbufLoader; 937 my $pb = new Gtk2::Gdk::PixbufLoader;
910 $pb->write ($tile->{$name}); 938 $pb->write ($tile->{$name});
911 $pb->close; 939 $pb->close;
912 my $pb = $pb->get_pixbuf; 940 my $pb = $pb->get_pixbuf;
913 941
914 my $tile = $cache{$name} = { 942 my $tile = $cache{$name} = {
915 pb => $pb, 943 pb => $pb,
916 idx => $idx, 944 idx => $idx,
917 w => int $pb->get_width / TILESIZE, 945 w => int $pb->get_width / TILESIZE,
918 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
919 }; 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,
920 982 };
921 983
922 $idx += $tile->{w} * $tile->{h}; 984 $idx += $tile->{w} * $tile->{h};
923 }
924
925 my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, 64 * TILESIZE, TILESIZE * int +($idx + 63) / 64;
926
927 while (my ($name, $tile) = each %cache) {
928 my $tpb = delete $tile->{pb};
929 my $ofs = $tile->{idx};
930
931 for my $x (0 .. $tile->{w} - 1) {
932 for my $y (0 .. $tile->{h} - 1) {
933 my $idx = $ofs + $x + $y * $tile->{w};
934 $tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE,
935 $pb, ($idx % 64) * TILESIZE, TILESIZE * int $idx / 64);
936 } 985 }
986
987 construct_tilecache_pb $idx, \%cache;
988
989 \%cache
937 } 990 };
938 }
939
940 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
941
942 \%cache
943 }; 991 }
944} 992}
945 993
946=head1 AUTHOR 994=head1 AUTHOR
947 995
948 Marc Lehmann <schmorp@schmorp.de> 996 Marc Lehmann <schmorp@schmorp.de>

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines