[ViewVC] Diff of: cvs/deliantra/Deliantra-Client/DC/UI.pm

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.72 by root, Tue Apr 11 18:00:45 2006 UTC vs.
Revision 1.83 by root, Wed Apr 12 12:16:58 2006 UTC

…		…
1	package CFClient::Widget;	1	package CFClient::UI;
2		2
3	use strict;	3	use strict;
4		4
5	use Scalar::Util;	5	use Scalar::Util ();
6		6	use List::Util ();
7	use SDL::OpenGL;
8	use SDL::OpenGL::Constants;
9		7
10	use CFClient;	8	use CFClient;
11		9
12	our ($FOCUS, $HOVER, $GRAB); # various widgets	10	our ($FOCUS, $HOVER, $GRAB); # various widgets
13		11
45		43
46	my $widget = $GRAB \|\| $TOPLEVEL->find_widget ($x, $y);	44	my $widget = $GRAB \|\| $TOPLEVEL->find_widget ($x, $y);
47		45
48	$BUTTON_STATE &= ~(1 << ($ev->button - 1));	46	$BUTTON_STATE &= ~(1 << ($ev->button - 1));
49		47
50	$GRAB->button_down ($ev, $GRAB->translate ($x, $y)) if $GRAB;	48	$GRAB->button_up ($ev, $GRAB->translate ($x, $y)) if $GRAB;
51		49
52	if (!$BUTTON_STATE) {	50	if (!$BUTTON_STATE) {
53	my $grab = $GRAB; undef $GRAB;	51	my $grab = $GRAB; undef $GRAB;
54	$grab->update if $grab;	52	$grab->update if $grab;
55	$GRAB->update if $GRAB;	53	$GRAB->update if $GRAB;
…		…
70	}	68	}
71		69
72	$HOVER->mouse_motion ($ev, $HOVER->translate ($x, $y)) if $HOVER;	70	$HOVER->mouse_motion ($ev, $HOVER->translate ($x, $y)) if $HOVER;
73	}	71	}
74		72
		73	#############################################################################
		74
		75	package CFClient::UI::Base;
		76
		77	use strict;
		78
		79	use SDL::OpenGL;
		80
75	sub new {	81	sub new {
76	my $class = shift;	82	my $class = shift;
77		83
78	bless {	84	my $self = bless {
79	x => 0,	85	x => 0,
80	y => 0,	86	y => 0,
81	z => 0,	87	z => 0,
		88	w => -1,
		89	h => -1,
82	@_	90	@_
83	}, $class	91	}, $class;
		92
		93	for (keys %$self) {
		94	if (/^connect_(.*)$/) {
		95	$self->connect ($1 => delete $self->{$_});
		96	}
		97	}
		98
		99	$self
84	}	100	}
85		101
86	sub move {	102	sub move {
87	my ($self, $x, $y, $z) = @_;	103	my ($self, $x, $y, $z) = @_;
88	$self->{x} = $x;	104	$self->{x} = $x;
…		…
97	sub size_request {	113	sub size_request {
98	require Carp;	114	require Carp;
99	Carp::confess "size_request is abtract";	115	Carp::confess "size_request is abtract";
100	}	116	}
101		117
102	sub size_allocate {	118	sub _size_allocate {
103	my ($self, $w, $h) = @_;	119	my ($self, $x, $y, $w, $h) = @_;
		120
		121	$self->{x} = $x;
		122	$self->{y} = $y;
		123
		124	return unless $self->{w} != $w \|\| $self->{h} != $h;
104		125
105	$self->{w} = $w;	126	$self->{w} = $w;
106	$self->{h} = $h;	127	$self->{h} = $h;
107	}
108		128
		129	1
		130	}
		131
		132	sub size_allocate {
		133	my ($self, $x, $y, $w, $h) = @_;
		134
		135	$self->_size_allocate ($x, $y, $w, $h);
		136	}
		137
109	# translate global koordinates to local coordinate system	138	# translate global coordinates to local coordinate system
110	sub translate {	139	sub translate {
111	my ($self, $x, $y) = @_;	140	my ($self, $x, $y) = @_;
112		141
113	$self->{parent}->translate ($x - $self->{x}, $y - $self->{y});	142	$self->{parent}->translate ($x - $self->{x}, $y - $self->{y});
114	}	143	}
…		…
158	glTranslate $self->{x}, $self->{y}, 0;	187	glTranslate $self->{x}, $self->{y}, 0;
159	$self->_draw;	188	$self->_draw;
160	glPopMatrix;	189	glPopMatrix;
161		190
162	if ($self == $HOVER) {	191	if ($self == $HOVER) {
163	my ($x, $y) = @$self->{qw(x y)};	192	my ($x, $y) = @$self{qw(x y)};
164		193
165	glColor 1, 1, 1, 0.1;	194	glColor 0, 0, 1, 0.2;
166	glEnable GL_BLEND;	195	glEnable GL_BLEND;
		196	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
167	glBegin GL_QUADS;	197	glBegin GL_QUADS;
168	glVertex $x , $y;	198	glVertex $x , $y;
169	glVertex $x + $self->{w}, $y;	199	glVertex $x + $self->{w}, $y;
170	glVertex $x + $self->{w}, $y + $self->{h};	200	glVertex $x + $self->{w}, $y + $self->{h};
171	glVertex $x , $y + $self->{h};	201	glVertex $x , $y + $self->{h};
…		…
178	my ($self) = @_;	208	my ($self) = @_;
179		209
180	warn "no draw defined for $self\n";	210	warn "no draw defined for $self\n";
181	}	211	}
182		212
183	sub bbox {
184	my ($self) = @_;
185	my ($w, $h) = $self->size_request;
186	(
187	$self->{x},
188	$self->{y},
189	$self->{x} = $w,
190	$self->{y} = $h
191	)
192	}
193
194	sub find_widget {	213	sub find_widget {
195	my ($self, $x, $y) = @_;	214	my ($self, $x, $y) = @_;
196		215
197	return $self	216	return $self
198	if $x >= $self->{x} && $x < $self->{x} + $self->{w}	217	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
199	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};	218	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
200		219
201	()	220	()
202	}	221	}
203		222
204	sub del_parent { $_[0]->{parent} = undef }
205
206	sub set_parent {	223	sub set_parent {
207	my ($self, $par) = @_;	224	my ($self, $par) = @_;
208		225
209	$self->{parent} = $par;	226	$self->{parent} = $par;
210	Scalar::Util::weaken $self->{parent};	227	Scalar::Util::weaken $self->{parent};
…		…
240	#$self->deactivate;	257	#$self->deactivate;
241	}	258	}
242		259
243	#############################################################################	260	#############################################################################
244		261
245	package CFClient::Widget::DrawBG;	262	package CFClient::UI::DrawBG;
246		263
247	our @ISA = CFClient::Widget::;	264	our @ISA = CFClient::UI::Base::;
248		265
249	use strict;	266	use strict;
250	use SDL::OpenGL;	267	use SDL::OpenGL;
251		268
252	sub new {	269	sub new {
253	my $class = shift;	270	my $class = shift;
254		271
255	# range [value, low, high, page]	272	# range [value, low, high, page]
256		273
257	$class->SUPER::new (	274	$class->SUPER::new (
258	bg => [0, 0, 0, 0.4],	275	bg => [0, 0, 0, 0.2],
259	active_bg => [1, 1, 1],	276	active_bg => [1, 1, 1, 0.5],
260	@_	277	@_
261	)	278	)
262	}	279	}
263		280
264	sub _draw {	281	sub _draw {
265	my ($self) = @_;	282	my ($self) = @_;
266		283
267	my ($w, $h) = @$self{qw(w h)};	284	my ($w, $h) = @$self{qw(w h)};
268		285
		286	glEnable GL_BLEND;
		287	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
269	glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} };	288	glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} };
		289
270	glBegin GL_QUADS;	290	glBegin GL_QUADS;
271	glVertex 0 , 0;	291	glVertex 0 , 0;
272	glVertex 0 , $h;	292	glVertex 0 , $h;
273	glVertex $w, $h;	293	glVertex $w, $h;
274	glVertex $w, 0;	294	glVertex $w, 0;
275	glEnd;	295	glEnd;
276	}
277		296
278	#############################################################################	297	glDisable GL_BLEND;
		298	}
279		299
		300	#############################################################################
		301
280	package CFClient::Widget::Empty;	302	package CFClient::UI::Empty;
281		303
282	our @ISA = CFClient::Widget::;	304	our @ISA = CFClient::UI::Base::;
283		305
284	sub size_request {	306	sub size_request {
285	(0, 0)	307	(0, 0)
286	}	308	}
287		309
288	sub draw { }	310	sub draw { }
289		311
290	#############################################################################	312	#############################################################################
291		313
292	package CFClient::Widget::Container;	314	package CFClient::UI::Container;
293		315
294	our @ISA = CFClient::Widget::;	316	our @ISA = CFClient::UI::Base::;
295		317
296	sub new {	318	sub new {
297	my ($class, %arg) = @_;	319	my ($class, %arg) = @_;
298		320
299	my $children = delete $arg{children} \|\| [];	321	my $children = delete $arg{children} \|\| [];
…		…
303		325
304	$self	326	$self
305	}	327	}
306		328
307	sub add {	329	sub add {
308	my ($self, $chld, $expand) = @_;	330	my ($self, $chld) = @_;
309		331
310	$chld->{expand} = $expand;
311	$chld->set_parent ($self);	332	$chld->set_parent ($self);
312		333
313	$self->{children} = [	334	$self->{children} = [
314	sort { $a->{z} <=> $b->{z} }	335	sort { $a->{z} <=> $b->{z} }
315	@{$self->{children}}, $chld	336	@{$self->{children}}, $chld
316	];	337	];
317		338
318	$self->size_allocate ($self->{w}, $self->{h})	339	$self->{w} = $self->{h} = -1;
319	if $self->{w}; #TODO: check for "realised state"	340	$self->update;
320	}	341	}
321		342
322	sub remove {	343	sub remove {
323	my ($self, $widget) = @_;	344	my ($self, $widget) = @_;
324		345
325	$self->{children} = [ grep $_ != $widget, @{ $self->{children} } ];	346	$self->{children} = [ grep $_ != $widget, @{ $self->{children} } ];
326		347
327	$self->size_allocate ($self->{w}, $self->{h});	348	$self->size_allocate (0, 0, $self->{w}, $self->{h});
328	}	349	}
329		350
330	sub find_widget {	351	sub find_widget {
331	my ($self, $x, $y) = @_;	352	my ($self, $x, $y) = @_;
332		353
…		…
349	$_->draw for @{$self->{children}};	370	$_->draw for @{$self->{children}};
350	}	371	}
351		372
352	#############################################################################	373	#############################################################################
353		374
354	package CFClient::Widget::Bin;	375	package CFClient::UI::Bin;
355		376
356	our @ISA = CFClient::Widget::Container::;	377	our @ISA = CFClient::UI::Container::;
357		378
358	sub new {	379	sub new {
359	my ($class, %arg) = @_;	380	my ($class, %arg) = @_;
360		381
361	my $child = (delete $arg{child}) \|\| new CFClient::Widget::Empty::;	382	my $child = (delete $arg{child}) \|\| new CFClient::UI::Empty::;
362		383
363	$class->SUPER::new (children => [$child], %arg)	384	$class->SUPER::new (children => [$child], %arg)
364	}	385	}
365		386
366	sub add {	387	sub add {
…		…
374	sub remove {	395	sub remove {
375	my ($self, $widget) = @_;	396	my ($self, $widget) = @_;
376		397
377	$self->SUPER::remove ($widget);	398	$self->SUPER::remove ($widget);
378		399
379	$self->{children} = [new CFClient::Widget::Empty]	400	$self->{children} = [new CFClient::UI::Empty]
380	unless @{$self->{children}};	401	unless @{$self->{children}};
381	}	402	}
382		403
383	sub child { $_[0]->{children}[0] }	404	sub child { $_[0]->{children}[0] }
384		405
385	sub size_request {	406	sub size_request {
386	$_[0]{children}[0]->size_request	407	$_[0]{children}[0]->size_request
387	}	408	}
388		409
389	sub size_allocate {	410	sub size_allocate {
390	my ($self, $w, $h) = @_;	411	my ($self, $x, $y, $w, $h) = @_;
391		412
392	return unless $self->{w} != $w \|\| $self->{h} != $h;	413	$self->_size_allocate ($x, $y, $w, $h) or return;
393		414
394	$self->SUPER::size_allocate ($w, $h);
395	$self->{children}[0]->size_allocate ($w, $h);	415	$self->{children}[0]->size_allocate (0, 0, $w, $h);
396	}	416	}
397		417
398	#############################################################################	418	#############################################################################
399		419
400	package CFClient::Widget::Window;	420	package CFClient::UI::Window;
401		421
402	our @ISA = CFClient::Widget::Bin::;	422	our @ISA = CFClient::UI::Bin::;
403		423
404	use SDL::OpenGL;	424	use SDL::OpenGL;
405		425
406	sub new {	426	sub new {
407	my ($class, %arg) = @_;	427	my ($class, %arg) = @_;
…		…
425	$self->{w}, $self->{h}, sub { $self->child->draw }	445	$self->{w}, $self->{h}, sub { $self->child->draw }
426	);	446	);
427	}	447	}
428		448
429	sub size_allocate {	449	sub size_allocate {
430	my ($self, $w, $h) = @_;	450	my ($self, $x, $y, $w, $h) = @_;
431		451
432	return unless $self->{w} != $w \|\| $self->{h} != $h;	452	$self->_size_allocate ($x, $y, $w, $h) or return;
433		453
434	$self->{w} = $w;
435	$self->{h} = $h;
436
437	$self->child->size_allocate ($w, $h);	454	$self->child->size_allocate (0, 0, $w, $h);
438		455
439	$self->render_chld;	456	$self->render_chld;
440	}	457	}
441		458
442	sub _draw {	459	sub _draw {
…		…
446		463
447	my $tex = $self->{texture}	464	my $tex = $self->{texture}
448	or return;	465	or return;
449		466
450	glEnable GL_BLEND;	467	glEnable GL_BLEND;
		468	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
451	glEnable GL_TEXTURE_2D;	469	glEnable GL_TEXTURE_2D;
452	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	470	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
453		471
454	$tex->draw_quad (0, 0, $w, $h);	472	$tex->draw_quad (0, 0, $w, $h);
455		473
…		…
457	glDisable GL_TEXTURE_2D;	475	glDisable GL_TEXTURE_2D;
458	}	476	}
459		477
460	#############################################################################	478	#############################################################################
461		479
462	package CFClient::Widget::Frame;	480	package CFClient::UI::Frame;
463		481
464	our @ISA = CFClient::Widget::Bin::;	482	our @ISA = CFClient::UI::Bin::;
465		483
466	use SDL::OpenGL;	484	use SDL::OpenGL;
467		485
468	sub size_request {	486	sub size_request {
469	my ($self) = @_;	487	my ($self) = @_;
…		…
474		492
475	map { $_ + 4 } $chld->size_request;	493	map { $_ + 4 } $chld->size_request;
476	}	494	}
477		495
478	sub size_allocate {	496	sub size_allocate {
479	my ($self, $w, $h) = @_;	497	my ($self, $x, $y, $w, $h) = @_;
480		498
481	return unless $self->{w} != $w \|\| $self->{h} != $h;	499	$self->_size_allocate ($x, $y, $w, $h) or return;
482		500
483	$self->{w} = $w;
484	$self->{h} = $h;
485
486	$self->child->size_allocate ($w - 4, $h - 4);	501	$self->child->size_allocate (2, 2, $w - 4, $h - 4);
487	$self->child->move (2, 2);
488	}	502	}
489		503
490	sub _draw {	504	sub _draw {
491	my ($self) = @_;	505	my ($self) = @_;
492		506
…		…
505	$chld->draw;	519	$chld->draw;
506	}	520	}
507		521
508	#############################################################################	522	#############################################################################
509		523
510	package CFClient::Widget::FancyFrame;	524	package CFClient::UI::FancyFrame;
511		525
512	our @ISA = CFClient::Widget::Bin::;	526	our @ISA = CFClient::UI::Bin::;
513		527
514	use SDL::OpenGL;	528	use SDL::OpenGL;
515		529
516	my @tex =	530	my @tex =
517	map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }	531	map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
518	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	532	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
519		533
520	sub size_request {	534	sub size_request {
521	my ($self) = @_;	535	my ($self) = @_;
		536
		537	return ($self->{user_w}, $self->{user_h}) if $self->{user_w} && $self->{user_h};
522		538
523	my ($w, $h) = $self->SUPER::size_request;	539	my ($w, $h) = $self->SUPER::size_request;
524		540
525	$h += $tex[1]->{h};	541	$h += $tex[1]->{h};
526	$h += $tex[4]->{h};	542	$h += $tex[4]->{h};
…		…
529		545
530	($w, $h)	546	($w, $h)
531	}	547	}
532		548
533	sub size_allocate {	549	sub size_allocate {
534	my ($self, $w, $h) = @_;	550	my ($self, $x, $y, $w, $h) = @_;
535		551
536	return unless $self->{w} != $w \|\| $self->{h} != $h;	552	$self->_size_allocate ($x, $y, $w, $h) or return;
537		553
538	$self->SUPER::size_allocate ($w, $h);
539
540	$h -= $tex[1]->{h};	554	$h -= $tex[1]{h};
541	$h -= $tex[4]->{h};	555	$h -= $tex[4]{h};
542	$w -= $tex[2]->{w};	556	$w -= $tex[2]{w};
543	$w -= $tex[3]->{w};	557	$w -= $tex[3]{w};
544		558
545	$h = $h < 0 ? 0 : $h;	559	$h = $h < 0 ? 0 : $h;
546	$w = $w < 0 ? 0 : $w;	560	$w = $w < 0 ? 0 : $w;
547		561
548	my $child = $self->child;	562	my $child = $self->child;
549		563
550	$child->size_allocate ($w, $h);
551	$child->move ($tex[3]->{w}, $tex[1]->{h});	564	$child->size_allocate ($tex[3]->{w}, $tex[1]->{h}, $w, $h);
		565	}
		566
		567	sub button_down {
		568	my ($self, $ev, $x, $y) = @_;
		569
		570	if ($x < $self->{w} && $x >= $self->{w} - $tex[2]{w}
		571	&& $y < $self->{h} && $y >= $self->{h} - $tex[4]{h}) {
		572
		573	my ($ox, $oy) = ($ev->button_x, $ev->button_y);
		574	my ($bw, $bh) = ($self->{w}, $self->{h});
		575
		576	$self->{motion} = sub {
		577	my ($ev, $x, $y) = @_;
		578
		579	($x, $y) = ($ev->motion_x, $ev->motion_y);
		580
		581	$self->{user_w} = $bw + $x - $ox;
		582	$self->{user_h} = $bh + $y - $oy;
		583	$self->update;
		584	};
		585
		586	} elsif ($x >= 0 && $x < $self->{w}
		587	&& $y >= 0 && $y < $tex[1]{h}) {
		588
		589	my ($ox, $oy) = ($ev->button_x, $ev->button_y);
		590	my ($bx, $by) = ($self->{x}, $self->{y});
		591
		592	$self->{motion} = sub {
		593	my ($ev, $x, $y) = @_;
		594
		595	($x, $y) = ($ev->motion_x, $ev->motion_y);
		596
		597	$self->move ($bx + $x - $ox, $by + $y - $oy);
		598	$self->update;
		599	};
		600	}
		601	}
		602
		603	sub button_up {
		604	my ($self, $ev, $x, $y) = @_;
		605
		606	delete $self->{motion};
		607	}
		608
		609	sub mouse_motion {
		610	my ($self, $ev, $x, $y) = @_;
		611
		612	$self->{motion}->($ev, $x, $y) if $self->{motion};
552	}	613	}
553		614
554	sub _draw {	615	sub _draw {
555	my ($self) = @_;	616	my ($self) = @_;
556		617
557	my ($w, $h) = ($self->{w}, $self->{h});	618	my ($w, $h) = ($self->{w}, $self->{h});
558	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	619	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});
559		620
560	glEnable GL_BLEND;	621	glEnable GL_BLEND;
		622	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
561	glEnable GL_TEXTURE_2D;	623	glEnable GL_TEXTURE_2D;
562	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
563	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	624	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
564		625
565	my $top = $tex[1];	626	my $top = $tex[1];
566	$top->draw_quad (0, 0, $w, $top->{h});	627	$top->draw_quad (0, 0, $w, $top->{h});
567		628
…		…
573		634
574	my $bottom = $tex[4];	635	my $bottom = $tex[4];
575	$bottom->draw_quad (0, $h - $bottom->{h}, $w, $bottom->{h});	636	$bottom->draw_quad (0, $h - $bottom->{h}, $w, $bottom->{h});
576		637
577	my $bg = $tex[0];	638	my $bg = $tex[0];
		639
578	glBindTexture GL_TEXTURE_2D, $bg->{name};	640	glBindTexture GL_TEXTURE_2D, $bg->{name};
579	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	641	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
580	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;
581	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;
582		642
583	my $rep_x = $cw / $bg->{w};	643	my $rep_x = $cw / $bg->{w};
584	my $rep_y = $ch / $bg->{h};	644	my $rep_y = $ch / $bg->{h};
585		645
586	$bg->draw_quad ($left->{w}, $top->{h}, $cw, $ch);	646	$bg->draw_quad ($left->{w}, $top->{h}, $cw, $ch);
587		647
		648	glDisable GL_TEXTURE_2D;
588	glDisable GL_BLEND;	649	glDisable GL_BLEND;
589	glDisable GL_TEXTURE_2D;
590		650
591	$self->child->draw;	651	$self->child->draw;
592		652
593	}	653	}
594		654
595	#############################################################################	655	#############################################################################
596		656
597	package CFClient::Widget::Table;	657	package CFClient::UI::Table;
598		658
599	our @ISA = CFClient::Widget::;	659	our @ISA = CFClient::UI::Base::;
		660
		661	use List::Util qw(max sum);
600		662
601	use SDL::OpenGL;	663	use SDL::OpenGL;
		664
		665	sub new {
		666	my $class = shift;
		667
		668	$class->SUPER::new (
		669	col_expand => [],
		670	@_
		671	)
		672	}
602		673
603	sub add {	674	sub add {
604	my ($self, $x, $y, $chld) = @_;	675	my ($self, $x, $y, $chld) = @_;
605	my $old_chld = $self->{children}[$y][$x];
606		676
607	$self->{children}[$y][$x] = $chld;	677	$self->{children}[$y][$x] = $chld;
608	$chld->set_parent ($self);	678	$chld->set_parent ($self);
		679
		680	$self->{w} = $self->{h} = -1;
609	$self->update;	681	$self->update;
610	}	682	}
611		683
612	sub max_row_height {	684	sub get_wh {
613	my ($self, $row) = @_;	685	my ($self) = @_;
614		686
615	my $hs = 0;	687	my (@w, @h);
616	for (my $xi = 0; $xi <= $#{$self->{children}->[$row] \|\| []}; $xi++) {	688
		689	for my $y (0 .. $#{$self->{children}}) {
617	my $c = $self->{children}->[$row]->[$xi];	690	my $row = $self->{children}[$y]
618	if ($c) {	691	or next;
		692
		693	for my $x (0 .. $#$row) {
		694	my $widget = $row->[$x]
		695	or next;
619	my ($w, $h) = $c->size_request;	696	my ($w, $h) = $widget->size_request;
620	if ($hs < $h) { $hs = $h }	697
		698	$w[$x] = max $w[$x], $w;
		699	$h[$y] = max $h[$y], $h;
621	}	700	}
622	}	701	}
623	return $hs;
624	}
625		702
626	sub max_col_width {	703	(\@w, \@h)
		704	}
		705
		706	sub size_request {
627	my ($self, $col) = @_;	707	my ($self) = @_;
628		708
		709	my ($ws, $hs) = $self->get_wh;
		710
		711	(
		712	(sum @$ws),
		713	(sum @$hs),
		714	)
		715	}
		716
		717	sub size_allocate {
		718	my ($self, $x, $y, $w, $h) = @_;
		719
		720	$self->_size_allocate ($x, $y, $w, $h) or return;
		721
		722	my ($ws, $hs) = $self->get_wh;
		723
		724	my $req_w = sum @$ws;
		725	my $req_h = sum @$hs;
		726
		727	# TODO: nicer code && do row_expand
		728	my @col_expand = @{$self->{col_expand}};
		729	@col_expand = (1) x @$ws unless @col_expand;
		730	my $col_expand = (sum @col_expand) \|\| 1;
		731
		732	# linearly scale sizes
		733	$ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
		734	$hs->[$_] = 1 $h / $req_h for 0 .. $#$hs;
		735
		736	my $y;
		737
		738	for my $r (0 .. $#{$self->{children}}) {
		739	my $row = $self->{children}[$r]
		740	or next;
		741
629	my $ws = 0;	742	my $x = 0;
630	for (my $yi = 0; $yi <= $#{$self->{children} \|\| []}; $yi++) {	743	my $row_h = $hs->[$r];
631	my $c = ($self->{children}->[$yi] \|\| [])->[$col];	744
632	if ($c) {	745	for my $c (0 .. $#$row) {
633	my ($w, $h) = $c->size_request;	746	my $col_w = $ws->[$c];
634	if ($ws < $w) { $ws = $w }	747
		748	if (my $widget = $row->[$c]) {
		749	$widget->size_allocate ($x, $y, $col_w, $row_h);
		750	}
		751
		752	$x += $col_w;
635	}	753	}
		754
		755	$y += $row_h;
636	}	756	}
637	return $ws;	757
638	}	758	}
		759
		760	sub find_widget {
		761	my ($self, $x, $y) = @_;
		762
		763	$x -= $self->{x};
		764	$y -= $self->{y};
		765
		766	my $res;
		767
		768	for (grep $_, map @$_, grep $_, @{ $self->{children} }) {
		769	$res = $_->find_widget ($x, $y)
		770	and return $res;
		771	}
		772
		773	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
		774	}
		775
		776	sub _draw {
		777	my ($self) = @_;
		778
		779	for (grep $_, @{$self->{children}}) {
		780	$_->draw for grep $_, @$_;
		781	}
		782	}
		783
		784	#############################################################################
		785
		786	package CFClient::UI::HBox;
		787
		788	# TODO: wrap into common Box base class
		789
		790	our @ISA = CFClient::UI::Container::;
639		791
640	sub size_request {	792	sub size_request {
641	my ($self) = @_;	793	my ($self) = @_;
642		794
		795	my @alloc = map [$_->size_request], @{$self->{children}};
		796
		797	(
		798	(List::Util::sum map $_->[0], @alloc),
		799	(List::Util::max map $_->[1], @alloc),
		800	)
		801	}
		802
		803	sub size_allocate {
		804	my ($self, $x, $y, $w, $h) = @_;
		805
		806	$self->_size_allocate ($x, $y, $w, $h) or return;
		807
		808	return unless $self->{w};
		809
643	my ($hs, $ws) = (0, 0);	810	($h, $w) = ($w, $h);
644		811
645	for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {	812	my $children = $self->{children};
646	$hs += $self->max_row_height ($yi);
647	}
648		813
649	for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {	814	my @h = map +($_->size_request)[0], @$children;
650	my $wm = 0;	815
651	for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) {	816	my $req_h = List::Util::sum @h;
652	$wm += $self->max_col_width ($xi)	817
		818	if ($req_h > $h) {
		819	# ah well, not enough space
		820	$_ *= $h / $req_h for @h;
		821	} else {
		822	my $exp = List::Util::sum map $_->{expand}, @$children;
		823	$exp \|\|= 1;
		824
		825	for (0 .. $#$children) {
		826	my $child = $children->[$_];
		827
		828	my $alloc_h = $h[$_];
		829	$alloc_h += ($h - $req_h) * $child->{expand} / $exp;
		830	$h[$_] = $alloc_h;
653	}	831	}
654	if ($ws < $wm) { $ws = $wm }
655	}	832	}
656
657	return ($ws, $hs);
658	}
659
660	sub _draw {
661	my ($self) = @_;
662		833
663	my $y = 0;	834	my $y = 0;
664	for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {	835	for (0 .. $#$children) {
		836	my $child = $children->[$_];
665	my $x = 0;	837	my $h = $h[$_];
		838	$child->size_allocate ($y, 0, $h, $w);
666		839
667	for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) {	840	$y += $h;
668
669	my $c = $self->{children}->[$yi]->[$xi];
670	if ($c) {
671	$c->move ($x, $y, 0); #TODO: Move to size_request
672	$c->draw if $c;
673	}
674
675	$x += $self->max_col_width ($xi);
676	}
677
678	$y += $self->max_row_height ($yi);
679	}	841	}
680	}	842	}
681		843
682	#############################################################################	844	#############################################################################
683		845
684	package CFClient::Widget::VBox;	846	package CFClient::UI::VBox;
685		847
		848	# TODO: wrap into common Box base class
		849
686	our @ISA = CFClient::Widget::Container::;	850	our @ISA = CFClient::UI::Container::;
687
688	use SDL::OpenGL;
689		851
690	sub size_request {	852	sub size_request {
691	my ($self) = @_;	853	my ($self) = @_;
692		854
693	my @alloc = map [$_->size_request], @{$self->{children}};	855	my @alloc = map [$_->size_request], @{$self->{children}};
…		…
697	(List::Util::sum map $_->[1], @alloc),	859	(List::Util::sum map $_->[1], @alloc),
698	)	860	)
699	}	861	}
700		862
701	sub size_allocate {	863	sub size_allocate {
702	my ($self, $w, $h) = @_;	864	my ($self, $x, $y, $w, $h) = @_;
703		865
704	return unless $self->{w} != $w \|\| $self->{h} != $h;	866	$self->_size_allocate ($x, $y, $w, $h) or return;
705
706	$self->{w} = $w;
707	$self->{h} = $h;
708		867
709	return unless $self->{h};	868	return unless $self->{h};
710		869
711	my $children = $self->{children};	870	my $children = $self->{children};
712		871
…		…
714		873
715	my $req_h = List::Util::sum @h;	874	my $req_h = List::Util::sum @h;
716		875
717	if ($req_h > $h) {	876	if ($req_h > $h) {
718	# ah well, not enough space	877	# ah well, not enough space
719	$_ = $h[$_] * $h / $req_h for @h;	878	$_ *= $h / $req_h for @h;
720	} else {	879	} else {
721	my @exp = grep $_->{expand}, @$children;	880	my $exp = List::Util::sum map $_->{expand}, @$children;
722	@exp = @$children unless @exp;	881	$exp \|\|= 1;
723		882
724	my %exp = map +($_ => 1), @exp;
725
726	for (0 .. $#$children) {	883	for (0 .. $#$children) {
727	my $child = $children->[$_];	884	my $child = $children->[$_];
728		885
729	my $alloc_h = $h[$_];	886	$h[$_] += ($h - $req_h) * $child->{expand} / $exp;
730	$alloc_h += ($h - $req_h) / @exp if $exp{$child};
731	$h[$_] = $alloc_h;
732	}	887	}
733	}	888	}
734		889
735	my $y = 0;	890	my $y = 0;
736	for (0 .. $#$children) {	891	for (0 .. $#$children) {
737	my $child = $children->[$_];	892	my $child = $children->[$_];
738	my $h = $h[$_];	893	my $h = $h[$_];
739	$child->move (0, $y);
740	$child->size_allocate ($w, $h);	894	$child->size_allocate (0, $y, $w, $h);
741		895
742	$y += $h;	896	$y += $h;
743	}	897	}
744	}	898	}
745		899
746	#############################################################################	900	#############################################################################
747		901
748	package CFClient::Widget::Label;	902	package CFClient::UI::Label;
749		903
750	our @ISA = CFClient::Widget::;	904	our @ISA = CFClient::UI::Base::;
751		905
752	use SDL::OpenGL;	906	use SDL::OpenGL;
753		907
754	sub new {	908	sub new {
755	my ($class, %arg) = @_;	909	my ($class, %arg) = @_;
756		910
757	my $self = $class->SUPER::new (	911	my $self = $class->SUPER::new (
758	fg => [1, 1, 1],	912	fg => [1, 1, 1],
759	height => $::FONTSIZE,	913	height => $::FONTSIZE,
760	text => "",	914	text => "",
761	align => -1,	915	align => -1,
		916	padding => 2,
762	layout => new CFClient::Layout,	917	layout => new CFClient::Layout,
763	%arg	918	%arg
764	);	919	);
765		920
766	$self->set_text ($self->{text});	921	$self->set_text ($self->{text});
767		922
…		…
783		938
784	$self->{text} = $text;	939	$self->{text} = $text;
785	$self->{layout}->set_markup ($text);	940	$self->{layout}->set_markup ($text);
786		941
787	delete $self->{texture};	942	delete $self->{texture};
		943	# $self->{w} = $self->{h} = -1;
788	$self->update;	944	$self->update;
789	}	945	}
790		946
791	sub get_text {	947	sub get_text {
792	my ($self, $text) = @_;	948	my ($self, $text) = @_;
…		…
797	sub size_request {	953	sub size_request {
798	my ($self) = @_;	954	my ($self) = @_;
799		955
800	$self->{layout}->set_width;	956	$self->{layout}->set_width;
801	$self->{layout}->set_height ($self->{height});	957	$self->{layout}->set_height ($self->{height});
802	$self->{layout}->size	958	my ($w, $h) = $self->{layout}->size;
803	# if ($self->{texture}{w} > 1 && $self->{texture}{height} > 1) { #TODO: hack	959
804	# (	960	(
805	# $self->{texture}{w},	961	$w + $self->{padding} * 2,
806	# $self->{texture}{h},	962	$h + $self->{padding} * 2,
807	# )	963	)
808	# } else {
809	# my ($w, $h, $data) = CFClient::font_render "Yy", $self->{h};
810	#
811	# ($w, $h)
812	# }
813	}	964	}
814		965
815	sub size_allocate {	966	sub size_allocate {
816	my ($self, $w, $h) = @_;	967	my ($self, $x, $y, $w, $h) = @_;
817		968
818	return unless $self->{w} != $w \|\| $self->{h} != $h;	969	$self->_size_allocate ($x, $y, $w, $h) or return;
819		970
820	$self->SUPER::size_allocate ($w, $h);
821	delete $self->{texture};	971	delete $self->{texture};
822	}	972	}
823		973
824	sub update {	974	sub update {
825	my ($self) = @_;	975	my ($self) = @_;
…		…
831	sub _draw {	981	sub _draw {
832	my ($self) = @_;	982	my ($self) = @_;
833		983
834	my $tex = $self->{texture} \|\|= do {	984	my $tex = $self->{texture} \|\|= do {
835	$self->{layout}->set_width ($self->{w});	985	$self->{layout}->set_width ($self->{w});
		986	$self->{layout}->set_height (List::Util::min $self->{h} - $self->{padding} * 2, $self->{height});
836	new_from_layout CFClient::Texture $self->{layout};	987	new_from_layout CFClient::Texture $self->{layout}
837	};	988	};
838		989
839	glEnable GL_BLEND;	990	glEnable GL_BLEND;
		991	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
840	glEnable GL_TEXTURE_2D;	992	glEnable GL_TEXTURE_2D;
841	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
842	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	993	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
843		994
844	glColor @{$self->{fg}};	995	glColor @{$self->{fg}};
845		996
846	my $x =	997	my $x =
847	$self->{align} < 0 ? 0	998	$self->{align} < 0 ? $self->{padding}
848	: $self->{align} > 0 ? $self->{w} - $self->{texture}{w}	999	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}
849	: ($self->{w} + $self->{texture}{w}) * 0.5;	1000	: ($self->{w} - $tex->{w}) * 0.5;
850		1001
		1002	glTranslate $x, $self->{padding}, 0;
851	$tex->draw_quad ($x, 0);	1003	$tex->draw_quad (0, 0);
852		1004
		1005	glDisable GL_TEXTURE_2D;
853	glDisable GL_BLEND;	1006	glDisable GL_BLEND;
854	glDisable GL_TEXTURE_2D;
855	}	1007	}
856		1008
857	#############################################################################	1009	#############################################################################
858		1010
859	package CFClient::Widget::Entry;	1011	package CFClient::UI::Entry;
860		1012
861	our @ISA = CFClient::Widget::Label::;	1013	our @ISA = CFClient::UI::Label::;
862		1014
863	use SDL;	1015	use SDL;
864	use SDL::OpenGL;	1016	use SDL::OpenGL;
865		1017
866	sub new {	1018	sub new {
867	my $class = shift;	1019	my $class = shift;
868		1020
869	$class->SUPER::new (	1021	$class->SUPER::new (
870	fg => [1, 1, 1],	1022	fg => [1, 1, 1],
871	bg => [0, 0, 0, 0.4],	1023	bg => [0, 0, 0, 0.2],
872	active_bg => [1, 1, 1],	1024	active_bg => [1, 1, 1, 0.5],
873	active_fg => [0, 0, 0],	1025	active_fg => [0, 0, 0],
874	@_	1026	@_
875	)	1027	)
876	}	1028	}
877		1029
…		…
880		1032
881	$self->{last_activity} = $::NOW;	1033	$self->{last_activity} = $::NOW;
882		1034
883	$self->{text} = $text;	1035	$self->{text} = $text;
884	$self->{layout}->set_width ($self->{w});	1036	$self->{layout}->set_width ($self->{w});
		1037	$self->{layout}->set_height (List::Util::min $self->{h} - $self->{padding} * 2, $self->{height});
885		1038
886	$text =~ s/./*/g if $self->{hidden};	1039	$text =~ s/./*/g if $self->{hidden};
887		1040
888
889	$self->{layout}->set_markup ($self->escape_text ($text));	1041	$self->{layout}->set_markup ($self->escape_text ($text) . " ");
890		1042
891	$text = substr $text, 0, $self->{cursor};	1043	$text = substr $text, 0, $self->{cursor};
892	utf8::encode $text;	1044	utf8::encode $text;
893		1045
894	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text);	1046	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text);
…		…
901		1053
902	($w + 1, $h) # add 1 for cursor	1054	($w + 1, $h) # add 1 for cursor
903	}	1055	}
904		1056
905	sub size_allocate {	1057	sub size_allocate {
906	my ($self, $w, $h) = @_;	1058	my ($self, $x, $y, $w, $h) = @_;
907		1059
908	return unless $self->{w} != $w \|\| $self->{h} != $h;
909
910	$self->SUPER::size_allocate ($w, $h);	1060	$self->SUPER::size_allocate ($x, $y, $w, $h);
911		1061
912	$self->_set_text ($self->{text});	1062	$self->_set_text ($self->{text});
913	}	1063	}
914		1064
915	sub set_text {	1065	sub set_text {
…		…
936	substr $text, $self->{cursor}, 1, "";	1086	substr $text, $self->{cursor}, 1, "";
937	} elsif ($sym == SDLK_LEFT) {	1087	} elsif ($sym == SDLK_LEFT) {
938	--$self->{cursor} if $self->{cursor};	1088	--$self->{cursor} if $self->{cursor};
939	} elsif ($sym == SDLK_RIGHT) {	1089	} elsif ($sym == SDLK_RIGHT) {
940	++$self->{cursor} if $self->{cursor} < length $self->{text};	1090	++$self->{cursor} if $self->{cursor} < length $self->{text};
		1091	} elsif ($sym == SDLK_HOME) {
		1092	$self->{cursor} = 0;
		1093	} elsif ($sym == SDLK_END) {
		1094	$self->{cursor} = length $text;
941	} elsif ($uni) {	1095	} elsif ($uni) {
942	substr $text, $self->{cursor}++, 0, chr $uni;	1096	substr $text, $self->{cursor}++, 0, chr $uni;
943	}	1097	}
944		1098
945	$self->_set_text ($text);	1099	$self->_set_text ($text);
…		…
960	$self->SUPER::button_down ($ev, $x, $y);	1114	$self->SUPER::button_down ($ev, $x, $y);
961		1115
962	my $idx = $self->{layout}->xy_to_index ($x, $y);	1116	my $idx = $self->{layout}->xy_to_index ($x, $y);
963		1117
964	# byte-index to char-index	1118	# byte-index to char-index
965	my $text = $self->{layout};	1119	my $text = $self->{text};
966	utf8::encode $text;	1120	utf8::encode $text;
967	$self->{cursor} = length substr $text, 0, $idx;	1121	$self->{cursor} = length substr $text, 0, $idx;
968		1122
969	$self->_set_text ($self->{text});	1123	$self->_set_text ($self->{text});
970	$self->update;	1124	$self->update;
…		…
985	$self->{fg} = $self->{active_fg};	1139	$self->{fg} = $self->{active_fg};
986	} else {	1140	} else {
987	glColor @{$self->{bg}};	1141	glColor @{$self->{bg}};
988	}	1142	}
989		1143
		1144	glEnable GL_BLEND;
		1145	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
990	glBegin GL_QUADS;	1146	glBegin GL_QUADS;
991	glVertex 0 , 0;	1147	glVertex 0 , 0;
992	glVertex 0 , $self->{h};	1148	glVertex 0 , $self->{h};
993	glVertex $self->{w}, $self->{h};	1149	glVertex $self->{w}, $self->{h};
994	glVertex $self->{w}, 0;	1150	glVertex $self->{w}, 0;
995	glEnd;	1151	glEnd;
		1152	glDisable GL_BLEND;
996		1153
997	$self->SUPER::_draw;	1154	$self->SUPER::_draw;
998		1155
999	#TODO: force update every cursor change :(	1156	#TODO: force update every cursor change :(
1000	if ($FOCUS == $self && (($::NOW - $self->{last_activity}) & 1023) < 600) {	1157	if ($FOCUS == $self && (($::NOW - $self->{last_activity}) & 1023) < 600) {
…		…
1006	}	1163	}
1007	}	1164	}
1008		1165
1009	#############################################################################	1166	#############################################################################
1010		1167
1011	package CFClient::Widget::Slider;	1168	package CFClient::UI::Button;
1012		1169
1013	use strict;	1170	our @ISA = CFClient::UI::Label::;
1014		1171
		1172	use SDL;
1015	use SDL::OpenGL;	1173	use SDL::OpenGL;
1016	use SDL::OpenGL::Constants;
1017
1018	our @ISA = CFClient::Widget::DrawBG::;
1019
1020	sub size_request {
1021	my ($self) = @_;
1022
1023	my $w = 50;
1024	my $h = 10;
1025
1026	$self->{vertical} ? ($h, $w) : ($w, $h)
1027	}
1028		1174
1029	sub new {	1175	sub new {
1030	my $class = shift;	1176	my $class = shift;
1031		1177
		1178	$class->SUPER::new (
		1179	padding => 4,
		1180	fg => [1, 1, 1],
		1181	bg => [1, 1, 1, 0.2],
		1182	active_bg => [0, 0, 0, 0.5],
		1183	active_fg => [1, 1, 0],
		1184	border_fg => [1, 1, 0],
		1185	@_
		1186	)
		1187	}
		1188
		1189	sub button_up {
		1190	my ($self, $ev, $x, $y) = @_;
		1191
		1192	if ($x >= 0 && $x < $self->{w}
		1193	&& $y >= 0 && $y < $self->{h}) {
		1194	$self->emit ("activate");
		1195	}
		1196	}
		1197
		1198	sub _draw {
		1199	my ($self) = @_;
		1200
		1201	local $self->{fg} = $self->{fg};
		1202
		1203	glEnable GL_BLEND;
		1204	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
		1205
		1206	glTranslate 0.375, 0.375, 0; # make line and polyogon coordinates behave similarly
		1207
		1208	glBegin GL_LINE_LOOP;
		1209	glColor @{$self->{border_fg}};
		1210	glVertex 1 , 1;
		1211	glVertex 1 , $self->{h} - 2;
		1212	glVertex $self->{w} - 2, $self->{h} - 2;
		1213	glVertex $self->{w} - 2, 1;
		1214	glEnd;
		1215
		1216	if ($GRAB == $self) {
		1217	glColor @{$self->{active_bg}};
		1218	$self->{fg} = $self->{active_fg};
		1219	} else {
		1220	glColor @{$self->{bg}};
		1221	}
		1222
		1223	glBegin GL_QUADS;
		1224	glVertex 2 , 2;
		1225	glVertex 2 , $self->{h} - 2;
		1226	glVertex $self->{w} - 2, $self->{h} - 2;
		1227	glVertex $self->{w} - 2, 2;
		1228	glEnd;
		1229	glDisable GL_BLEND;
		1230
		1231	$self->SUPER::_draw;
		1232	}
		1233
		1234	#############################################################################
		1235
		1236	package CFClient::UI::Slider;
		1237
		1238	use strict;
		1239
		1240	use SDL::OpenGL;
		1241
		1242	our @ISA = CFClient::UI::DrawBG::;
		1243
		1244	sub new {
		1245	my $class = shift;
		1246
1032	# range [value, low, high, page]	1247	# range [value, low, high, page]
1033		1248
1034	$class->SUPER::new (	1249	my $self = $class->SUPER::new (
1035	fg => [1, 1, 1],	1250	fg => [1, 1, 1],
1036	active_fg => [0, 0, 0],	1251	active_fg => [0, 0, 0],
1037	range => [0, 0, 100, 10],	1252	range => [0, 0, 100, 10],
		1253	req_w => 40,
		1254	req_h => 10,
1038	vertical => 1,	1255	vertical => 0,
1039	@_	1256	@_
1040	)	1257	);
		1258
		1259	$self
		1260	}
		1261
		1262	sub size_request {
		1263	my ($self) = @_;
		1264
		1265	my $w = $self->{req_w};
		1266	my $h = $self->{req_h};
		1267
		1268	$self->{vertical} ? ($h, $w) : ($w, $h)
1041	}	1269	}
1042		1270
1043	sub button_down {	1271	sub button_down {
1044	my ($self, $ev, $x, $y) = @_;	1272	my ($self, $ev, $x, $y) = @_;
1045		1273
…		…
1090	$value = int +($value - $lo) * $w / ($hi - $lo);	1318	$value = int +($value - $lo) * $w / ($hi - $lo);
1091		1319
1092	$w -= $page;	1320	$w -= $page;
1093	$page &= ~1;	1321	$page &= ~1;
1094	glTranslate $page * 0.5, 0, 0;	1322	glTranslate $page * 0.5, 0, 0;
		1323	$page \|\|= 2;
1095		1324
1096	glColor @$fg;	1325	glColor @$fg;
1097	glBegin GL_LINES;	1326	glBegin GL_LINES;
1098	glVertex 0, 0; glVertex 0, $h;	1327	glVertex 0, 0; glVertex 0, $h;
1099	glVertex $w - 1, 0; glVertex $w - 1, $h;	1328	glVertex $w - 1, 0; glVertex $w - 1, $h;
…		…
1120	glEnd;	1349	glEnd;
1121	}	1350	}
1122		1351
1123	#############################################################################	1352	#############################################################################
1124		1353
1125	package CFClient::Widget::MapWidget;	1354	package CFClient::UI::MapWidget;
1126		1355
1127	use strict;	1356	use strict;
1128		1357
1129	use List::Util qw(min max);	1358	use List::Util qw(min max);
1130		1359
1131	use SDL;	1360	use SDL;
1132	use SDL::OpenGL;	1361	use SDL::OpenGL;
1133	use SDL::OpenGL::Constants;
1134		1362
1135	our @ISA = CFClient::Widget::;	1363	our @ISA = CFClient::UI::Base::;
1136		1364
1137	sub new {	1365	sub new {
1138	my $class = shift;	1366	my $class = shift;
1139		1367
1140	$class->SUPER::new (	1368	$class->SUPER::new (
…		…
1151	sub key_up {	1379	sub key_up {
1152	}	1380	}
1153		1381
1154	sub size_request {	1382	sub size_request {
1155	(	1383	(
1156	1 + int $::WIDTH / 32,	1384	1 + 32 * int $::WIDTH / 32,
1157	1 + int $::HEIGHT / 32,	1385	1 + 32 * int $::HEIGHT / 32,
1158	)	1386	)
1159	}	1387	}
1160		1388
1161	sub update {	1389	sub update {
1162	my ($self) = @_;	1390	my ($self) = @_;
1163		1391
1164	$self->{need_update} = 1;	1392	$self->{need_update} = 1;
		1393	$self->SUPER::update;
1165	}	1394	}
1166		1395
1167	sub _draw {	1396	sub draw {
1168	my ($self) = @_;	1397	my ($self) = @_;
1169		1398
1170	if (delete $self->{need_update}) {	1399	if (delete $self->{need_update}) {
1171	glNewList $self->{list}, GL_COMPILE;	1400	glNewList $self->{list}, GL_COMPILE;
1172		1401
…		…
1192	$yofs = $self->{yofs} = min $my, max $my + $::CONN->{maph} - $sh + 1, $self->{yofs};	1421	$yofs = $self->{yofs} = min $my, max $my + $::CONN->{maph} - $sh + 1, $self->{yofs};
1193	}	1422	}
1194		1423
1195	glEnable GL_TEXTURE_2D;	1424	glEnable GL_TEXTURE_2D;
1196	glEnable GL_BLEND;	1425	glEnable GL_BLEND;
		1426	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1197	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1427	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1198		1428
1199	my $sw4 = ($sw + 3) & ~3;	1429	my $sw4 = ($sw + 3) & ~3;
1200	my $darkness = "\x00" x ($sw4 * $sh);	1430	my $darkness = "\x00" x ($sw4 * $sh);
1201		1431
…		…
1231	#	1461	#
1232	# $lighting = $pb->get_pixels;	1462	# $lighting = $pb->get_pixels;
1233	# $lighting =~ s/(.)../$1/gs;	1463	# $lighting =~ s/(.)../$1/gs;
1234	# }	1464	# }
1235		1465
1236	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1237	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1466	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1238		1467
1239	$darkness = new CFClient::Texture	1468	$darkness = new CFClient::Texture
1240	width => $sw4,	1469	w => $sw4,
1241	height => $sh,	1470	h => $sh,
1242	data => $darkness,	1471	data => $darkness,
1243	internalformat => GL_ALPHA,	1472	internalformat => GL_ALPHA,
1244	format => GL_ALPHA;	1473	format => GL_ALPHA;
1245		1474
1246	glColor 0.45, 0.45, 0.45, 1;	1475	glColor 0.45, 0.45, 0.45, 1;
…		…
1306	}	1535	}
1307	}	1536	}
1308		1537
1309	#############################################################################	1538	#############################################################################
1310		1539
1311	package CFClient::Widget::Animator;	1540	package CFClient::UI::Animator;
1312		1541
1313	use SDL::OpenGL;	1542	use SDL::OpenGL;
1314		1543
1315	our @ISA = CFClient::Widget::Bin::;	1544	our @ISA = CFClient::UI::Bin::;
1316		1545
1317	sub moveto {	1546	sub moveto {
1318	my ($self, $x, $y) = @_;	1547	my ($self, $x, $y) = @_;
1319		1548
1320	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];	1549	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
…		…
1348	glPopMatrix;	1577	glPopMatrix;
1349	}	1578	}
1350		1579
1351	#############################################################################	1580	#############################################################################
1352		1581
1353	package CFClient::Widget::Toplevel;	1582	package CFClient::UI::Toplevel;
1354		1583
1355	our @ISA = CFClient::Widget::Container::;	1584	our @ISA = CFClient::UI::Container::;
1356		1585
1357	sub size_request {	1586	sub size_request {
1358	($::WIDTH, $::HEIGHT)	1587	($::WIDTH, $::HEIGHT)
1359	}	1588	}
1360		1589
1361	sub size_allocate {	1590	sub size_allocate {
1362	my ($self, $w, $h) = @_;	1591	my ($self, $x, $y, $w, $h) = @_;
1363		1592
1364	$self->SUPER::size_allocate ($w, $h);	1593	$self->_size_allocate ($x, $y, $w, $h);
1365		1594
1366	$_->size_allocate ($_->size_request)	1595	$_->size_allocate ($_->{x}, $_->{y}, $_->size_request)
1367	for @{$self->{children}};	1596	for @{$self->{children}};
1368	}	1597	}
1369		1598
1370	sub translate {	1599	sub translate {
1371	my ($self, $x, $y) = @_;	1600	my ($self, $x, $y) = @_;
…		…
1374	}	1603	}
1375		1604
1376	sub update {	1605	sub update {
1377	my ($self) = @_;	1606	my ($self) = @_;
1378		1607
1379	$self->size_allocate ($self->size_request);	1608	$self->size_allocate (0, 0, $::WIDTH, $::HEIGHT);
1380	::refresh ();	1609	::refresh ();
1381	}	1610	}
1382		1611
1383	sub add {	1612	sub add {
1384	my ($self, $widget) = @_;	1613	my ($self, $widget) = @_;
1385		1614
1386	$self->SUPER::add ($widget);	1615	$self->SUPER::add ($widget);
1387		1616
1388	$widget->size_allocate ($widget->size_request);	1617	$widget->size_allocate ($widget->{x}, $widget->{y}, $widget->size_request);
1389	}	1618	}
1390		1619
1391	sub draw {	1620	sub draw {
1392	my ($self) = @_;	1621	my ($self) = @_;
1393		1622
1394	$self->_draw;	1623	$self->_draw;
1395	}	1624	}
1396		1625
1397	#############################################################################	1626	#############################################################################
1398		1627
1399	package CFClient::Widget;	1628	package CFClient::UI;
1400		1629
1401	$TOPLEVEL = new CFClient::Widget::Toplevel;	1630	$TOPLEVEL = new CFClient::UI::Toplevel;
1402		1631
1403	1	1632	1
1404		1633

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents): Revision 1.72 by root, Tue Apr 11 18:00:45 2006 UTC vs. Revision 1.83 by root, Wed Apr 12 12:16:58 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.72 by root, Tue Apr 11 18:00:45 2006 UTC vs.
Revision 1.83 by root, Wed Apr 12 12:16:58 2006 UTC