ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/MapWidget.pm
Revision: 1.3
Committed: Wed Apr 19 20:46:44 2006 UTC (18 years, 1 month ago) by root
Branch: MAIN
Changes since 1.2: +22 -23 lines
Log Message:
got rid of base SDL perl module

File Contents

# Content
1 package CFClient::MapWidget;
2
3 use strict;
4
5 use List::Util qw(min max);
6
7 use SDL::OpenGL;
8
9 our @ISA = CFClient::UI::Base::;
10
11 sub new {
12 my $class = shift;
13
14 $class->SUPER::new (
15 z => -1,
16 can_focus => 1,
17 list => (glGenLists 1),
18 @_
19 )
20 }
21
22 sub key_down {
23 print "MAPKEYDOWN\n";
24 }
25
26 sub key_up {
27 }
28
29 sub button_down {
30 my ($self, $ev, $x, $y) = @_;
31
32 $self->focus_in;
33
34 if ($ev->button == 2) {
35 my ($ox, $oy) = ($ev->button_x, $ev->button_y);
36 my ($bw, $bh) = ($::CFG->{map_shift_x}, $::CFG->{map_shift_y});
37
38 $self->{motion} = sub {
39 my ($ev, $x, $y) = @_;
40
41 ($x, $y) = ($ev->motion_x, $ev->motion_y);
42
43 $::CFG->{map_shift_x} = $bw + $x - $ox;
44 $::CFG->{map_shift_y} = $bh + $y - $oy;
45
46 $self->update;
47 };
48 }
49 }
50
51 sub button_up {
52 my ($self, $ev, $x, $y) = @_;
53
54 delete $self->{motion};
55 }
56
57 sub mouse_motion {
58 my ($self, $ev, $x, $y) = @_;
59
60 $self->{motion}->($ev, $x, $y) if $self->{motion};
61 }
62
63 sub size_request {
64 (
65 1 + 32 * int $::WIDTH / 32,
66 1 + 32 * int $::HEIGHT / 32,
67 )
68 }
69
70 sub update {
71 my ($self) = @_;
72
73 $self->{need_update} = 1;
74 $self->SUPER::update;
75 }
76
77 sub draw {
78 my ($self) = @_;
79
80 if (delete $self->{need_update}) {
81 glNewList $self->{list}, GL_COMPILE;
82
83 if ($::MAP) {
84 my $sw = int $::WIDTH / 32;
85 my $sh = int $::HEIGHT / 32;
86
87 my $sx = $::CFG->{map_shift_x}; my $sx0 = $sx & 31; $sx = ($sx - $sx0) / 32;
88 my $sy = $::CFG->{map_shift_y}; my $sy0 = $sy & 31; $sy = ($sy - $sy0) / 32;
89
90 glTranslate $sx0 - 32, $sy0 - 32, 0;
91
92 my ($w, $h, $data) = $::MAP->draw ($sx, $sy, 0, 0, $sw + 1, $sh + 1);
93
94 if ($::CFG->{fow_enable}) {
95 if ($::CFG->{fow_smooth} && $CFClient::GL_VERSION >= 1.2) { # smooth fog of war
96 glConvolutionParameter (GL_CONVOLUTION_2D, GL_CONVOLUTION_BORDER_MODE, GL_CONSTANT_BORDER);
97 glConvolutionFilter2D (
98 GL_CONVOLUTION_2D,
99 GL_ALPHA,
100 3, 3,
101 GL_ALPHA, GL_FLOAT,
102 pack "f*",
103 0.1, 0.1, 0.1,
104 0.1, 0.2, 0.1,
105 0.1, 0.1, 0.1,
106 );
107 glEnable GL_CONVOLUTION_2D;
108 }
109
110 $self->{fow_texture} = new CFClient::Texture
111 w => $w,
112 h => $h,
113 data => $data,
114 internalformat => GL_ALPHA,
115 format => GL_ALPHA;
116
117 glDisable GL_CONVOLUTION_2D if $::CFG->{fow_smooth};
118
119 glEnable GL_BLEND;
120 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
121 glEnable GL_TEXTURE_2D;
122 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
123
124 glColor +($::CFG->{fow_intensity}) x 3, 1;
125 $self->{fow_texture}->draw_quad (0, 0, $w * 32, $h * 32);
126
127 glDisable GL_TEXTURE_2D;
128 glDisable GL_BLEND;
129 }
130
131 # HACK BEGIN
132 {
133 glTranslate -($sx0 - 32), -($sy0 - 32), 0;#remove
134 my ($w, $h) = (250, 250);
135
136 glEnable GL_BLEND;
137 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
138 glEnable GL_TEXTURE_2D;
139 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
140
141 $self->{mapmap_texture} =
142 new CFClient::Texture
143 w => $w,
144 h => $h,
145 data => $::MAP->mapmap ($w, $h),
146 type => $CFClient::GL_VERSION >= 1.2 ? GL_UNSIGNED_INT_8_8_8_8_REV : GL_UNSIGNED_BYTE;
147
148 $self->{mapmap_texture}->draw_quad (100, 100);
149
150 glDisable GL_TEXTURE_2D;
151 glDisable GL_BLEND;
152 }
153 # HACK END
154 }
155
156 glEndList;
157 }
158
159 glPushMatrix;
160 glCallList $self->{list};
161 glPopMatrix;
162
163 if ($CFClient::UI::FOCUS != $self) {
164 glColor 64/255, 64/255, 64/255;
165 glLogicOp GL_AND;
166 glEnable GL_COLOR_LOGIC_OP;
167 glBegin GL_QUADS;
168 glVertex 0, 0;
169 glVertex 0, $::HEIGHT;
170 glVertex $::WIDTH, $::HEIGHT;
171 glVertex $::WIDTH, 0;
172 glEnd;
173 glDisable GL_COLOR_LOGIC_OP;
174 }
175 }
176
177 my %DIR = (
178 CFClient::SDLK_KP8, [1, "north"],
179 CFClient::SDLK_KP9, [2, "northeast"],
180 CFClient::SDLK_KP6, [3, "east"],
181 CFClient::SDLK_KP3, [4, "southeast"],
182 CFClient::SDLK_KP2, [5, "south"],
183 CFClient::SDLK_KP1, [6, "southwest"],
184 CFClient::SDLK_KP4, [7, "west"],
185 CFClient::SDLK_KP7, [8, "northwest"],
186
187 CFClient::SDLK_UP, [1, "north"],
188 CFClient::SDLK_RIGHT, [3, "east"],
189 CFClient::SDLK_DOWN, [5, "south"],
190 CFClient::SDLK_LEFT, [7, "west"],
191 );
192
193 sub key_down {
194 my ($self, $ev) = @_;
195
196 my $mod = $ev->key_mod;
197 my $sym = $ev->key_sym;
198
199 if ($sym == CFClient::SDLK_KP5) {
200 $::CONN->user_send ("stay fire");
201 } elsif ($sym == ord "a") {
202 $::CONN->user_send ("apply");
203 } elsif ($sym == ord "'") {
204 $self->emit ('activate_console');
205 } elsif ($sym == ord "/") {
206 $self->emit ('activate_console' => '/');
207 } elsif (exists $DIR{$sym}) {
208 if ($mod & CFClient::KMOD_SHIFT) {
209 $self->{shft}++;
210 $::CONN->user_send ("fire $DIR{$sym}[0]");
211 } elsif ($mod & CFClient::KMOD_CTRL) {
212 $self->{ctrl}++;
213 $::CONN->user_send ("run $DIR{$sym}[0]");
214 } else {
215 $::CONN->user_send ("$DIR{$sym}[1]");
216 }
217 }
218 }
219
220 sub key_up {
221 my ($self, $ev) = @_;
222
223 my $mod = $ev->key_mod;
224 my $sym = $ev->key_sym;
225
226 if (!($mod & CFClient::KMOD_SHIFT) && delete $self->{shft}) {
227 $::CONN->user_send ("fire_stop");
228 }
229 if (!($mod & CFClient::KMOD_CTRL ) && delete $self->{ctrl}) {
230 $::CONN->user_send ("run_stop");
231 }
232 }
233
234 sub add_command {
235 my ($self, $command, $widget, $cb) = @_;
236
237 (my $abbrev = $command) =~ s/(\S)[^[:space:]_]*[[:space:]_]+/$1/g;
238 warn "$command|$abbrev|$widget\n";#d#
239 }
240
241 1