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.106 by root, Mon Apr 23 19:09:48 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
… …
58 outdoor temp pressure humid windspeed winddir sky nosmooth 58 outdoor temp pressure humid windspeed winddir sky nosmooth
59 tile_path_1 tile_path_2 tile_path_3 tile_path_4 59 tile_path_1 tile_path_2 tile_path_3 tile_path_4
60)); 60));
61 61
62our @FIELD_ORDER = (qw( 62our @FIELD_ORDER = (qw(
63 inherit
64
63 elevation 65 elevation
64 66
65 name name_pl custom_name attach title race 67 name name_pl custom_name attach title race
66 slaying skill msg lore other_arch face 68 slaying skill msg lore other_arch
67 #todo-events
68 animation is_animated 69 face animation is_animated
70 magicmap smoothlevel smoothface
69 str dex con wis pow cha int 71 str dex con wis pow cha int
70 hp maxhp sp maxsp grace maxgrace 72 hp maxhp sp maxsp grace maxgrace
71 exp perm_exp expmul 73 exp perm_exp expmul
72 food dam luck wc ac x y speed speed_left move_state attack_movement 74 food dam luck wc ac x y speed speed_left move_state attack_movement
73 nrof level direction type subtype attacktype 75 nrof level direction type subtype attacktype
… …
128sub MOVE_FLY_LOW (){ 0x02 } 130sub MOVE_FLY_LOW (){ 0x02 }
129sub MOVE_FLY_HIGH (){ 0x04 } 131sub MOVE_FLY_HIGH (){ 0x04 }
130sub MOVE_FLYING (){ 0x06 } 132sub MOVE_FLYING (){ 0x06 }
131sub MOVE_SWIM (){ 0x08 } 133sub MOVE_SWIM (){ 0x08 }
132sub MOVE_BOAT (){ 0x10 } 134sub MOVE_BOAT (){ 0x10 }
135sub MOVE_SHIP (){ 0x20 }
133sub MOVE_KNOWN (){ 0x1f } # all of above 136sub MOVE_KNOWN (){ 0x3f } # all of above
134sub MOVE_ALL (){ 0x10000 } # very special value 137sub MOVE_ALL (){ 0x10000 } # very special value
135 138
136our %MOVE_TYPE = ( 139our %MOVE_TYPE = (
137 walk => MOVE_WALK, 140 walk => MOVE_WALK,
138 fly_low => MOVE_FLY_LOW, 141 fly_low => MOVE_FLY_LOW,
139 fly_high => MOVE_FLY_HIGH, 142 fly_high => MOVE_FLY_HIGH,
140 flying => MOVE_FLYING, 143 flying => MOVE_FLYING,
141 swim => MOVE_SWIM, 144 swim => MOVE_SWIM,
142 boat => MOVE_BOAT, 145 boat => MOVE_BOAT,
146 ship => MOVE_SHIP,
143 all => MOVE_ALL, 147 all => MOVE_ALL,
144); 148);
145 149
146our @MOVE_TYPE = qw(all walk flying fly_low fly_high swim boat); 150our @MOVE_TYPE = keys %MOVE_TYPE;
147 151
148{ 152{
149 package Crossfire::MoveType; 153 package Crossfire::MoveType;
150 154
151 use overload 155 use overload
… …
883 }, sub { 887 }, sub {
884 read_arch "$LIB/archetypes" 888 read_arch "$LIB/archetypes"
885 }; 889 };
886} 890}
887 891
892sub construct_tilecache_pb {
893 my ($idx, $cache) = @_;
894
895 my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, 64 * TILESIZE, TILESIZE * int +($idx + 63) / 64;
896
897 while (my ($name, $tile) = each %$cache) {
898 my $tpb = delete $tile->{pb};
899 my $ofs = $tile->{idx};
900
901 for my $x (0 .. $tile->{w} - 1) {
902 for my $y (0 .. $tile->{h} - 1) {
903 my $idx = $ofs + $x + $y * $tile->{w};
904 $tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE,
905 $pb, ($idx % 64) * TILESIZE, TILESIZE * int $idx / 64);
906 }
907 }
908 }
909
910 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
911
912 $cache
913}
914
915sub use_tilecache {
916 my ($face) = @_;
917 $TILE = new_from_file Gtk2::Gdk::Pixbuf "$VARDIR/tilecache.png"
918 or die "$VARDIR/tilecache.png: $!";
919 *FACE = $_[0];
920}
921
888=item load_tilecache 922=item load_tilecache
889 923
890(Re-)Load %TILE and %FACE. 924(Re-)Load %TILE and %FACE.
891 925
892=cut 926=cut
893 927
894sub load_tilecache() { 928sub load_tilecache() {
895 require Gtk2; 929 require Gtk2;
896 930
931 if (-e "$LIB/crossfire.0") { # Crossfire1 version
897 cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", sub { 932 cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", \&use_tilecache,
898 $TILE = new_from_file Gtk2::Gdk::Pixbuf "$VARDIR/tilecache.png" 933 sub {
899 or die "$VARDIR/tilecache.png: $!";
900 *FACE = $_[0];
901 }, sub {
902 my $tile = read_pak "$LIB/crossfire.0"; 934 my $tile = read_pak "$LIB/crossfire.0";
903 935
904 my %cache; 936 my %cache;
905 937
906 my $idx = 0; 938 my $idx = 0;
907 939
908 for my $name (sort keys %$tile) { 940 for my $name (sort keys %$tile) {
909 my $pb = new Gtk2::Gdk::PixbufLoader; 941 my $pb = new Gtk2::Gdk::PixbufLoader;
910 $pb->write ($tile->{$name}); 942 $pb->write ($tile->{$name});
911 $pb->close; 943 $pb->close;
912 my $pb = $pb->get_pixbuf; 944 my $pb = $pb->get_pixbuf;
913 945
914 my $tile = $cache{$name} = { 946 my $tile = $cache{$name} = {
915 pb => $pb, 947 pb => $pb,
916 idx => $idx, 948 idx => $idx,
917 w => int $pb->get_width / TILESIZE, 949 w => int $pb->get_width / TILESIZE,
918 h => int $pb->get_height / TILESIZE, 950 h => int $pb->get_height / TILESIZE,
951 };
952
953 $idx += $tile->{w} * $tile->{h};
954 }
955
956 construct_tilecache_pb $idx, \%cache;
957
958 \%cache
919 }; 959 };
960
961 } else { # Crossfire+ version
962 cache_file "$LIB/facedata", "$VARDIR/tilecache.pst", \&use_tilecache,
963 sub {
964 my %cache;
965 my $facedata = Storable::retrieve "$LIB/facedata";
966
967 $facedata->{version} == 2
968 or die "$LIB/facedata: version mismatch, cannot proceed.";
969
970 my $faces = $facedata->{faceinfo};
971 my $idx = 0;
972
973 for (sort keys %$faces) {
974 my ($face, $info) = ($_, $faces->{$_});
975
976 my $pb = new Gtk2::Gdk::PixbufLoader;
977 $pb->write ($info->{data32});
978 $pb->close;
979 my $pb = $pb->get_pixbuf;
980
981 my $tile = $cache{$face} = {
982 pb => $pb,
983 idx => $idx,
984 w => int $pb->get_width / TILESIZE,
985 h => int $pb->get_height / TILESIZE,
920 986 };
921 987
922 $idx += $tile->{w} * $tile->{h}; 988 $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 } 989 }
990
991 construct_tilecache_pb $idx, \%cache;
992
993 \%cache
937 } 994 };
938 }
939
940 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
941
942 \%cache
943 }; 995 }
944} 996}
945 997
946=head1 AUTHOR 998=head1 AUTHOR
947 999
948 Marc Lehmann <schmorp@schmorp.de> 1000 Marc Lehmann <schmorp@schmorp.de>

Diff Legend

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