ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/pclient
(Generate patch)

Comparing deliantra/Deliantra-Client/bin/pclient (file contents):
Revision 1.4 by root, Thu Apr 6 20:34:15 2006 UTC vs.
Revision 1.50 by root, Sun Apr 9 21:05:50 2006 UTC

1#!/opt/bin/perl 1#!/opt/bin/perl
2 2
3use strict; 3use strict;
4use utf8;
4 5
5use Crossfire::Client; 6use Glib;
6use Crossfire::Protocol; 7use Gtk2 -init;
7
8package Crossfire::Client; # uh, yeah
9
10use strict;
11 8
12use SDL; 9use SDL;
13use SDL::App; 10use SDL::App;
14use SDL::Event; 11use SDL::Event;
15use SDL::Surface; 12use SDL::Surface;
16use SDL::OpenGL; 13use SDL::OpenGL;
17use SDL::OpenGL::Constants; 14use SDL::OpenGL::Constants;
18 15
19my $conn; 16use Crossfire;
20my $app; 17use Crossfire::Client;
18use Crossfire::Protocol;
21 19
22my $WIDTH = 640; 20use Crossfire::Client::Widget;
23my $HEIGHT = 480;
24 21
25sub glinit { 22our $FACECACHE;
26 # nuke all gl context data 23
27 24our $VERSION = '0.1';
25
26our %GL_EXT;
27
28our $CFG;
29our $CONN;
30
31our $WIDTH;
32our $HEIGHT;
33our $FULLSCREEN;
34
35our $FONTSIZE;
36
37our $SDL_TIMER;
38our $SDL_APP;
39our $SDL_EV = new SDL::Event;
40our %SDL_CB;
41
42our @GL_INIT; # hooks called on every gl init
43
44our $ALT_ENTER_MESSAGE;
45
46our $TOPLEVEL;
47
48our $tw; # Test widget #d#
49
50my $last_refresh;
51my %ANIMATE;
52my $refresh_handler;
53
54sub init_screen {
28 $app = new SDL::App 55 $SDL_APP = new SDL::App
56 -flags => SDL_ANYFORMAT | SDL_HWSURFACE,
29 -title => "Crossfire+ Client", 57 -title => "Crossfire+ Client",
30 -width => $WIDTH, 58 -width => $WIDTH,
31 -height => $HEIGHT, 59 -height => $HEIGHT,
32 -opengl => 1, 60 -opengl => 1,
33 -red_size => 8, 61 -red_size => 8,
34 -green_size => 8, 62 -green_size => 8,
35 -blue_size => 8, 63 -blue_size => 8,
36 -double_buffer => 1, 64 -double_buffer => 1,
65 -fullscreen => $FULLSCREEN,
37 -resizeable => 0; 66 -resizeable => 0;
67
68 $last_refresh = SDL::GetTicks;
69
70 %GL_EXT = map +($_ => 1), split /\s+/, Crossfire::Client::gl_extensions;
71
72 $GL_EXT{GL_ARB_texture_non_power_of_two}
73 or warn "WARNING: non-power-of-two opengl extension required";
74
75 $FONTSIZE = int $HEIGHT / 50;
76
77 $ALT_ENTER_MESSAGE = new Crossfire::Client::Widget::Label
78 0, $FONTSIZE, $HEIGHT - $FONTSIZE, $FONTSIZE,
79 "Use <b>Alt-Enter</b> to toggle fullscreen mode";
80 $ALT_ENTER_MESSAGE->move (0, $HEIGHT - ($ALT_ENTER_MESSAGE->size_request)[1]);
81 $TOPLEVEL->add ($ALT_ENTER_MESSAGE);
82
83 # Test code #d#
84 unless ($tw) { # haha...
85 $tw = new Crossfire::Client::Widget::Animator;
86 my $lbl1 = new Crossfire::Client::Widget::Label
87 0, 0, 10, $FONTSIZE, "<i>This</i> is a\n<u>TEST</u>!\nOf a themed\nFrame!";
88 my $lbl2 = new Crossfire::Client::Widget::Label
89 0, 0, 10, $FONTSIZE, "LBL2";
90
91 my $vb = new Crossfire::Client::Widget::VBox;
92 my $f = new Crossfire::Client::Widget::FancyFrame;
93 my $f2 = new Crossfire::Client::Widget::FancyFrame;
94 $f->add ($lbl1);
95 $f2->add ($lbl2);
96 $vb->add ($f);
97 $vb->add ($f2, 1);
98
99 $tw->add ($vb);
100 $tw->w (400);
101 $tw->h (300);
102 $tw->move ($WIDTH - 200, 0);
103 $tw->moveto (0, 0);
104 $TOPLEVEL->add ($tw);
105
106# $f->move ($WIDTH - 200, 0);
107# $TOPLEVEL->add ($f);
108 }
109
110 glClearColor 0, 0, 0, 0;
38 111
39 glEnable GL_TEXTURE_2D; 112 glEnable GL_TEXTURE_2D;
113 glEnable GL_COLOR_MATERIAL;
40 glShadeModel GL_FLAT; 114 glShadeModel GL_FLAT;
41 glDisable GL_DEPTH_TEST; 115 glDisable GL_DEPTH_TEST;
116 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
117
118 $_->() for @GL_INIT;
119}
120
121sub start_game {
122 $SDL_TIMER = add Glib::Timeout 1000/50, sub {
123 ($SDL_CB{$SDL_EV->type} || sub { warn "unhandled event ", $SDL_EV->type })->()
124 while $SDL_EV->poll;
125
126 1
127 };
128
129 $WIDTH = $CFG->{width};
130 $HEIGHT = $CFG->{height};
131 $FULLSCREEN = 0;
132
133 init_screen;
134
135 my $mapsize = List::Util::min 64, List::Util::max 11, int $HEIGHT * $CFG->{mapsize} * 0.01 / 32;
136
137 $CONN = new conn
138 host => $CFG->{host},
139 port => $CFG->{port},
140 user => $CFG->{user},
141 pass => $CFG->{password},
142 mapw => $mapsize,
143 maph => $mapsize,
144 ;
145
146 Crossfire::Client::lowdelay fileno $CONN->{fh};
147}
148
149sub stop_game {
150 remove Glib::Source $SDL_TIMER;
151 remove Glib::Source $refresh_handler;
152 undef $refresh_handler;
153
154 undef $SDL_APP;
155 undef $CONN;
156 SDL::Quit;
157}
158
159
160sub force_refresh {
161 glViewport 0, 0, $WIDTH, $HEIGHT;
162
42 glMatrixMode GL_PROJECTION; 163 glMatrixMode GL_PROJECTION;
43
44 glLoadIdentity; 164 glLoadIdentity;
45 glOrtho 0, $WIDTH / 32, $HEIGHT / 32, 0, -1 , 1; 165 glOrtho 0, $WIDTH, $HEIGHT, 0, -6000 , 6000;
166 glMatrixMode GL_MODELVIEW;
46 167
47 #glViewport 0, 0, $WIDTH, $HEIGHT; 168 glClear GL_COLOR_BUFFER_BIT;
48 # re-bind all textures 169
170 $TOPLEVEL->draw;
171
172 SDL::GLSwapBuffers;
49} 173}
50 174
51sub refresh { 175sub refresh {
52 glClearColor 0.5, 0.5, 0.7, 0; 176 $refresh_handler ||= add Glib::Idle sub {
53 glClear GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT; 177 return unless $SDL_APP;
54 178
55 my $map = $conn->{map}; 179 my $next_refresh = SDL::GetTicks;
180 my $interval = ($next_refresh - $last_refresh) * 0.001;
181 $last_refresh = $next_refresh;
56 182
57 for my $x (0 .. $conn->{mapw} - 1) { 183 force_refresh;
58 for my $y (0 .. $conn->{maph} - 1) { 184 $_->animate ($interval) for grep $_, values %ANIMATE;
59 185
60 my $cell = $map->[$x][$y] 186 if (%ANIMATE) {
61 or next;
62
63 for my $num (grep $_, $cell->[0], $cell->[1], $cell->[2]) {
64 my $tex = $conn->{face}[$num]{texture} || 0;
65
66 glBindTexture GL_TEXTURE_2D, $tex;
67
68 glBegin GL_QUADS;
69 glTexCoord 0, 0; glVertex $x, $y;
70 glTexCoord 1, 0; glVertex $x + 0.9, $y;
71 glTexCoord 1, 1; glVertex $x + 0.9, $y + 0.9;
72 glTexCoord 0, 1; glVertex $x, $y + 0.9;
73 glEnd;
74 } 187 1
188 } else {
189 undef $refresh_handler;
190 0
75 } 191 }
76 } 192 };
77
78 SDL::GLSwapBuffers;
79} 193}
80 194
81my $ev = new SDL::Event; 195sub animation_start {
82my %ev_cb; 196 my ($widget) = @_;
197 $ANIMATE{$widget} = $widget;
198 Scalar::Util::weaken $ANIMATE{$widget};
83 199
84sub event(&$) {
85 $ev_cb{$_[0]->()} = $_[1];
86}
87
88sub does(&) { shift }
89
90event {SDL_QUIT} does {
91 exit;
92};
93
94event {SDL_VIDEORESIZE} does {
95 print "resize\n";
96};
97
98event {SDL_VIDEOEXPOSE} does {
99 refresh; 200 refresh;
100}; 201}
101 202
102event {SDL_KEYDOWN} does { 203sub animation_stop {
103 print "keypress\n"; 204 my ($widget) = @_;
104}; 205 delete $ANIMATE{$widget};
206}
105 207
106event {SDL_KEYUP} does { 208%SDL_CB = (
107 print "keyup\n";#d# 209 SDL_QUIT() => sub {
108}; 210 main_quit Gtk2;
109 211 },
110event {SDL_MOUSEMOTION} does { 212 SDL_VIDEORESIZE() => sub {
111 print "motion\n"; 213 },
112}; 214 SDL_VIDEOEXPOSE() => sub {
113 215 refresh;
114event {SDL_MOUSEBUTTONDOWN} does { 216 },
115 print "button\n"; 217 SDL_KEYDOWN() => sub {
116}; 218 if ($SDL_EV->key_mod & KMOD_ALT && $SDL_EV->key_sym == SDLK_RETURN) {
117 219 # alt-enter
118event {SDL_MOUSEBUTTONUP} does { 220 $FULLSCREEN = !$FULLSCREEN;
119 print "buttup\n"; 221 init_screen;
120}; 222 } else {
121 223 Crossfire::Client::Widget::feed_sdl_key_down_event ($SDL_EV);
122event {SDL_ACTIVEEVENT} does { 224 }
225 },
226 SDL_KEYUP() => sub {
227 Crossfire::Client::Widget::feed_sdl_key_up_event ($SDL_EV);
228 },
229 SDL_MOUSEMOTION() => sub {
230 warn "sdl motion\n";#d#
231 },
232 SDL_MOUSEBUTTONDOWN() => sub {
233 Crossfire::Client::Widget::feed_sdl_button_down_event ($SDL_EV);
234 },
235 SDL_MOUSEBUTTONUP() => sub {
236 Crossfire::Client::Widget::feed_sdl_button_up_event ($SDL_EV);
237 },
238 SDL_ACTIVEEVENT() => sub {
123 print "active\n"; 239 warn "active\n";#d#
124}; 240 },
125 241);
126package Crossfire::Client;
127 242
128@conn::ISA = Crossfire::Protocol::; 243@conn::ISA = Crossfire::Protocol::;
129 244
130sub conn::map_update { 245sub conn::map_update {
131 my ($self, $dirty) = @_; 246 my ($self, $dirty) = @_;
134} 249}
135 250
136sub conn::map_scroll { 251sub conn::map_scroll {
137 my ($self, $dx, $dy) = @_; 252 my ($self, $dx, $dy) = @_;
138 253
139 refresh; 254# refresh;
140} 255}
141 256
142sub conn::map_clear { 257sub conn::map_clear {
143 my ($self) = @_; 258 my ($self) = @_;
144 259
145 refresh; 260# refresh;
261}
262
263sub conn::face_find {
264 my ($self, $face) = @_;
265
266 $FACECACHE->{"$face->{chksum},$face->{name}"}
146} 267}
147 268
148sub conn::face_update { 269sub conn::face_update {
149 my ($self, $num, $face) = @_; 270 my ($self, $face) = @_;
150 271
151 warn "up face $self,$num,$face\n";#d# 272 $FACECACHE->{"$face->{chksum},$face->{name}"} = $face->{image};
152 #TODO
153 open my $fh, ">:raw", "/tmp/x~";
154 syswrite $fh, $face->{image};
155 close $fh;
156 273
157 my $surface = new SDL::Surface -name => "/tmp/x~"; 274 $face->{texture} = new_from_image Crossfire::Client::Texture delete $face->{image};
275}
158 276
159 unlink "/tmp/x~"; 277sub conn::query {
278 my ($self, $flags, $prompt) = @_;
160 279
161 my ($tex) = @{glGenTextures 1}; 280 warn "<<<<QUERY:$flags:$prompt>>>\n";#d#
162 glGetError(); 281}
163 282
164 $face->{texture} = $tex; 283sub gtk_add_cfg_field {
284 my ($tbl, $cfg, $klbl, $key, $value) = @_;
285 my $i = $cfg->{_i}++;
286 $tbl->attach_defaults (my $lbl = Gtk2::Label->new ($klbl), 0, 1, $i, $i + 1);
287 $tbl->attach_defaults (my $ent = Gtk2::Entry->new, 1, 2, $i, $i + 1);
288 if ($key eq 'password') {
289 $ent->set_invisible_char ("*");
290 $ent->set (visibility => 0)
291 }
292 $ent->set_text ($value);
293 $ent->signal_connect (changed => sub {
294 my ($ent) = @_;
295 $cfg->{$key} = $ent->get_text;
296 # TODO: Mapsize should be a slider in the game gui
297 if ($key eq 'mapsize' and $cfg->{$key} > 100) {
298 $cfg->{$key} = 100;
299 } elsif ($key eq 'mapsize' and $cfg->{$key} < 50) {
300 $cfg->{$key} = 50;
301 }
302 });
303}
304
305sub run_config_dialog {
306 my (%events) = @_;
307
308 my $w = Gtk2::Window->new;
309
310 my @cfg = (
311 [qw/Host host/],
312 [qw/Port port/],
313 [qw/Mapsize% mapsize/],
314 [qw/Username user/],
315 [qw/Password password/],
165 316 );
166 glBindTexture GL_TEXTURE_2D, $tex; 317
167 my $glerr=glGetError(); die "a: ".gluErrorString($glerr)."\n" if $glerr; 318 my $cfg = {};
319
320 my $a = SDL::ListModes (0, SDL_FULLSCREEN|SDL_HWSURFACE);
321 my @modes = map { [SDL::RectW ($_), SDL::RectH ($_)] } @$a;
322
323 $w->add (my $vb = Gtk2::VBox->new);
324 $vb->pack_start (my $t = Gtk2::Table->new (2, scalar @cfg), 0, 0, 0);
325 my $selmode = $::CFG->{width} . 'x' . $::CFG->{height};
326 $t->attach_defaults (Gtk2::Label->new ("Modes"), 0, 1, 0, 1);
327 $t->attach_defaults (my $cb = Gtk2::ComboBox->new_text, 1, 2, 0, 1);
328 my $i = 0;
329 my $act = 0;
330 for (map { "$_->[0]x$_->[1]" } reverse @modes) {
331 if ($_ eq $selmode) { $act = $i }
332 $cb->append_text ($_);
333 $i++;
334 }
335 $cb->set_active ($act);
336 $cb->signal_connect (changed => sub {
337 my ($cb) = @_;
338 my $txt = $cb->get_active_text;
339 if ($txt =~ m/(\d+)x(\d+)/) {
340 $::CFG->{width} = $1;
341 $::CFG->{height} = $2;
168 342 }
169# glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR; 343 });
170# glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR;
171
172 $surface->rgba;
173 344
174 glTexImage2D GL_TEXTURE_2D, 0, 345 $cfg->{_i} = 1;
175 4, # components 346 for (@cfg) {
176 $surface->width, $surface->height, 347 gtk_add_cfg_field ($t, $cfg, $_->[0], $_->[1], $::CFG->{$_->[1]});
348 }
349
350 $vb->pack_start (my $hb = Gtk2::HBox->new, 0, 0, 0);
351 $hb->pack_start (my $cb = Gtk2::Button->new ("save"), 1, 1, 5);
352 $cb->signal_connect (clicked => sub {
353 for (keys %$cfg) {
354 $::CFG->{$_} = $cfg->{$_}
355 if $_ ne '_i';
177 0, 356 }
357 Crossfire::Client::write_cfg "$Crossfire::VARDIR/pclientrc";
358 });
359 $hb->pack_start (my $cb = Gtk2::Button->new ("login"), 1, 1, 5);
360 $cb->signal_connect (clicked => sub {
361 for (keys %$cfg) {
362 $::CFG->{$_} = $cfg->{$_}
363 if $_ ne '_i';
178 GL_RGBA, 364 }
179 GL_UNSIGNED_BYTE, 365 my $cb = $events{login} || sub {};
180 $surface->pixels; 366 $cb->($::CFG->{user}, $::CFG->{password});
181 my $glerr=glGetError(); die "Problem setting up 2d Texture (dimensions not a power of 2?)):".gluErrorString($glerr)."\n" if $glerr; 367 });
368 $hb->pack_start (my $cb = Gtk2::Button->new ("logout"), 1, 1, 5);
369 $cb->signal_connect (clicked => sub {
370 my $cb = $events{logout} || sub {};
371 $cb->();
372 });
373 $hb->pack_start (my $cb = Gtk2::Button->new ("quit"), 1, 1, 5);
374 $cb->signal_connect (clicked => sub { $w->destroy });
375
376 $w->show_all;
377
378 $w->signal_connect (destroy => sub { Gtk2->main_quit });
182} 379}
380
183 381
184############################################################################# 382#############################################################################
185 383
186use Event; 384SDL::Init SDL_INIT_EVERYTHING;
187 385
188glinit; 386$TOPLEVEL = Crossfire::Client::Widget::Toplevel->new;
189 387
190$conn = new conn 388my $mapwidget = Crossfire::Client::Widget::MapWidget->new;
389
390$TOPLEVEL->add ($mapwidget);
391$mapwidget->focus_in;
392
393Crossfire::Client::read_cfg "$Crossfire::VARDIR/pclientrc";
394
395$CFG ||= {
396 width => 640,
397 height => 480,
398 mapsize => 100,
399 fullscreen => 0,
191 host => "cf.schmorp.de", 400 host => "crossfire.schmorp.de",
192 port => 13327; 401 port => 13327,
193
194Event->timer (after => 0, interval => 1/20, hard => 1, cb => sub {
195 while ($ev->poll) {
196 ($ev_cb{$ev->type} || sub { warn "unhandled event ", $ev->type })->();
197 }
198}); 402};
199 403
200Event::loop; 404Crossfire::Client::set_font Crossfire::Client::find_rcfile "uifont.ttf";
201 405
406$FACECACHE = eval { Crossfire::load_ref "$Crossfire::VARDIR/pclient.faces" } || {};
202 407
408run_config_dialog
409 login => sub { start_game },
410 logout => sub { stop_game };
411
412main Gtk2;
413
414Crossfire::save_ref $FACECACHE, "$Crossfire::VARDIR/pclient.faces";

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines