kgsueme/kgsueme/chat.pl

use utf8;

package chat;

# waaay cool widget. well... maybe at one point in the future

use Gtk2;

use Glib::Object::Subclass
   Gtk2::VBox,
   signals => {
      command => {
         flags       => [qw/run-first/],
         return_type => undef, # void return
         param_types => [Glib::Scalar, Glib::Scalar],
      },
   };

sub INIT_INSTANCE {
   my $self = shift;

   my $tagtable = new Gtk2::TextTagTable;

   {
      my @tags = (
         [default     => { foreground => "black" }],
         [node        => { foreground => "#0000b0", event => 1 }],
         [move        => { foreground => "#0000b0", event => 1 }],
         [user        => { foreground => "#0000b0", event => 1 }],
         [coord       => { foreground => "#0000b0", event => 1 }],
         [score       => { foreground => "#0000b0", event => 1 }],
         [error       => { foreground => "#ff0000", event => 1 }],
         [leader      => { }],
         [header      => { weight => 800, pixels_above_lines => 6 }],
         [undo        => { foreground => "#ffff00", background => "#ff0000", weight => 800, pixels_above_lines => 6 }],
         [challenge   => { weight => 800, pixels_above_lines => 6, background => "#ffffb0" }],
         [description => { weight => 800, foreground => "blue" }],
         [infoblock   => { weight => 700, foreground => "blue" }],
      );

      for (@tags) {
         my ($k, $v) = @$_;
         my $tag = new Gtk2::TextTag $k;
         if (delete $v->{event}) {
            ###
         }
         $tag->set (%$v);
         $tagtable->add ($tag);
      }
   }

   $self->{tagtable} = $tagtable;

   $self->signal_connect (destroy => sub {
      remove Glib::Source delete $self->{idle} if $self->{idle};
      %{$_[0]} = ();
   });

   $self->{buffer} = new Gtk2::TextBuffer $self->{tagtable};

   $self->{widget} = new Gtk2::ScrolledWindow;
   $self->{widget}->set_policy("never", "always");
   $self->pack_start ($self->{widget}, 1, 1, 0);

   $self->{widget}->add ($self->{view} = new_with_buffer Gtk2::TextView $self->{buffer});
   $self->{view}->set_wrap_mode ("word");
   $self->{view}->set_cursor_visible (0);

   $self->{view}->set_editable (0);

   $self->{view}->signal_connect (motion_notify_event => sub {
      my ($widget, $event) = @_;

      my $window = $widget->get_window ("text");
      if ($event->window == $window) {
         my ($win, $x, $y, $mask) = $window->get_pointer;
          #     warn "TAG EVENT @_ ($window, $win, $x, $y, $mask)\n";
          #gtk_text_view_window_to_buffer_coords (text_view,
          #                                       GTK_TEXT_WINDOW_TEXT,
          #                                       text_view->drag_start_x,
          #                                       text_view->drag_start_y,
          #                                       &buffer_x,
          #                                       &buffer_y);
#
#          gtk_text_layout_get_iter_at_pixel (text_view->layout,
#                                             &iter,
#                                             buffer_x, buffer_y);
#
#          gtk_text_view_start_selection_dnd (text_view, &iter, event);
#          return TRUE;
      }
      0;
   });

   $self->pack_start (($self->{entry} = new Gtk2::Entry), 0, 1, 0);

   $self->{entry}->signal_connect (activate => sub {
      my ($entry) = @_;
      my $text = $entry->get_text;
      $entry->set_text("");

      my ($cmd, $arg);

      if ($text =~ /^\/(\S+)\s*(.*)$/) {
         ($cmd, $arg) = ($1, $2);
      } else {
         ($cmd, $arg) = ("say", $text);
      }

      $self->signal_emit (command => $cmd, $arg);
   });

   #$self->{end} = $self->{buffer}->create_mark (undef, $self->{buffer}->get_end_iter, 0);#d##todo# use this one for gtk-1.050+
   $self->{end} = $self->{buffer}->create_mark (++$USELESSNAME, $self->{buffer}->get_end_iter, 0); # workaround for gtk-perl bug

   $self->set_end;
}

sub do_command {
   my ($self, $cmd, $arg, %arg) = @_;
}

sub set_end {
   my ($self) = @_;

   # this is probably also a hack...
   $self->{idle} ||= add Glib::Idle sub {
      $self->{view}->scroll_to_iter ($self->{buffer}->get_end_iter, 0, 0, 0, 0)
         if $self->{view};
      delete $self->{idle};
   };
}

sub at_end {
   my ($self) = @_;

   # this is, maybe, a bad hack :/
   my $adj = $self->{widget}->get_vadjustment;
   $adj->value + $adj->page_size >= $adj->upper - 0.5;
}

sub append_text {
   my ($self, $text) = @_;

   $self->_append_text ($self->{end}, $text);
}

sub _append_text {
   my ($self, $mark, $text) = @_;

   my $at_end = $self->at_end;

   $text = "<default>$text</default>";

   my @tag;
   # pseudo-simplistic-xml-parser
   for (;;) {
      $text =~ /\G<([^>]+)>/gc or last;
      my $tag = $1;
      if ($tag =~ s/^\///) {
         pop @tag;
      } else {
         push @tag, $tag;
      }

      $text =~ /\G([^<]*)/gc or last;
      $self->{buffer}->insert_with_tags_by_name ($self->{buffer}->get_iter_at_mark ($mark), util::xmlto $1, @tag)
         if length $1;
   }

   $self->set_end if $at_end;
}

sub set_text {
   my ($self, $text) = @_;

   my $at_end = $self->at_end;
           
   $self->{buffer}->set_text ("");
   $self->append_text ($text);

   $self->set_end if $at_end;
}

sub new_eventtag {
   my ($self, $cb) = @_;

   my $tag = new Gtk2::TextTag;
   $tag->signal_connect (event => $cb);
   $self->{tagtable}->add ($tag);

   $tag
}

# create a new "subbuffer"
sub new_inlay {
   my ($self) = @_;

   my $end = $self->{buffer}->get_end_iter;

   my $self = bless {
      buffer  => $self->{buffer},
      parent  => $self,
   }, superchat::inlay;

   # $USELESSNAME is a Gtk-perl < 1.042 workaround
   $self->{l} = $self->{buffer}->create_mark (++$USELESSNAME, $end, 1);
   $self->{buffer}->insert ($end, "\x{200d}");
   $self->{r} = $self->{buffer}->create_mark (++$USELESSNAME, $self->{buffer}->get_iter_at_mark ($self->{l}), 0);

   Scalar::Util::weaken $self->{buffer};
   Scalar::Util::weaken $self->{parent};
   $self;
}

sub new_switchable_inlay {
   my ($self, $header, $cb, $visible) = @_;

   my $inlay;

   my $tag = $self->new_eventtag (sub {
      my ($tag, $view, $event, $iter) = @_;

      if ($event->type eq "button-press") {
         $inlay->set_visible (!$inlay->{visible});
         return 1;
      }

      0;
   });

   $tag->set (background => "#e0e0ff");

   $inlay = $self->new_inlay;

   $inlay->{visible} = $visible;
   $inlay->{header}  = $header;
   $inlay->{tag}     = $tag;
   $inlay->{cb}      = $cb;

   Scalar::Util::weaken $inlay->{tag};

   $inlay->refresh;

   $inlay;
}

package superchat::inlay;

sub liter { $_[0]{buffer}->get_iter_at_mark ($_[0]{l}) }
sub riter { $_[0]{buffer}->get_iter_at_mark ($_[0]{r}) }

sub clear {
   my ($self) = @_;
   $self->{buffer}->delete ($self->liter, $self->riter);
}

sub append_text {
   my ($self, $text) = @_;

   $self->{parent}->_append_text ($self->{r}, $text);
}

sub append_widget {
   my ($self, $widget) = @_;

   $widget->show_all;

   my $anchor = $self->{buffer}->create_child_anchor ($self->riter);
   $self->{parent}{view}->add_child_at_anchor ($widget, $anchor);
}

sub append_optionmenu {
   my ($self, $ref, @entry) = @_;

   my @vals;

   my $widget = new Gtk2::OptionMenu;
   $widget->set (menu => my $menu = new Gtk2::Menu);

   my $idx = 0;

   while (@entry >= 2) {
      my $value = shift @entry;
      my $label = shift @entry;

      $menu->append (new Gtk2::MenuItem $label);
      push @vals, $value;

      if ($value eq $$ref && $idx >= 0) {
         $widget->set_history ($idx);
         $idx = -1e6;
      }
      $idx++;
   }

   my $cb = shift @entry;

   $widget->signal_connect (changed => sub {
      my $new = $vals[$_[0]->get_history];

      if ($new ne $$ref) {
         $$ref = $new;
         $cb->($new) if $cb;
      }
   });

   $self->append_widget ($widget);

   $widget;
}

sub append_entry {
   my ($self, $ref, $width, $cb) = @_;

   my $widget = new Gtk2::Entry;
   $widget->set (text => $$ref, width_chars => $width);
   eval { $widget->set (xalign => 1) }; # workaround für 2.2
   $widget->signal_connect (changed => sub {
      $$ref = $_[0]->get_text;
      $cb->($$ref) if $cb;
   });

   $self->append_widget ($widget);
   $widget;
}

sub append_button {
   my ($self, $label, $cb) = @_;

   my $widget = new_with_label Gtk2::Button $label;
   $widget->signal_connect (clicked => sub { $cb->() if $cb });

   $self->append_widget ($widget);
   $widget;
}

sub visible { $_[0]{visible} }

sub set_visible {
   my ($self, $visible) = @_;

   return if $self->{visible} == $visible;
   $self->{visible} = $visible;

   $self->refresh;
}

sub refresh {
   my ($self) = @_;

   $self->clear;

   my $arrow = $self->{visible} ? "⊟" : "⊞";

   $self->{buffer}->insert ($self->riter, "\n");
   $self->{buffer}->insert_with_tags ($self->riter, util::xmlto "$arrow $self->{header}", $self->{tag});

   return unless $self->{visible};

   $self->{cb}->($self);
}

sub destroy {
   my ($self) = @_;

   return if !$self->{l} || !$self->{buffer} || $self->{l}->get_deleted;

   $self->clear if $self->{buffer};

   delete $self->{parent};
   delete $self->{buffer};
   delete $self->{l};
   delete $self->{r};
}

sub DESTROY {
   my $self = shift;

   $self->{parent}{tagtable}->remove (delete $self->{tag}) if $self->{tag} && $self->{parent};
   #&destroy;
}

1;

Revision:	1.6
Committed:	Wed Jun 2 04:55:57 2004 UTC (19 years, 11 months ago) by root
Content type:	text/plain
Branch:	MAIN
Changes since 1.5:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.4	use utf8;
2
3	pcg	1.1	package chat;
4
5	root	1.4	# waaay cool widget. well... maybe at one point in the future
6
7	pcg	1.1	use Gtk2;
8
9			use Glib::Object::Subclass
10			Gtk2::VBox,
11			signals => {
12			command => {
13			flags => [qw/run-first/],
14			return_type => undef, # void return
15			param_types => [Glib::Scalar, Glib::Scalar],
16			},
17			};
18
19	root	1.4	sub INIT_INSTANCE {
20			my $self = shift;
21	pcg	1.1
22	root	1.4	my $tagtable = new Gtk2::TextTagTable;
23
24			{
25			my @tags = (
26			[default => { foreground => "black" }],
27			[node => { foreground => "#0000b0", event => 1 }],
28			[move => { foreground => "#0000b0", event => 1 }],
29			[user => { foreground => "#0000b0", event => 1 }],
30			[coord => { foreground => "#0000b0", event => 1 }],
31			[score => { foreground => "#0000b0", event => 1 }],
32			[error => { foreground => "#ff0000", event => 1 }],
33	root	1.6	[leader => { }],
34	root	1.4	[header => { weight => 800, pixels_above_lines => 6 }],
35			[undo => { foreground => "#ffff00", background => "#ff0000", weight => 800, pixels_above_lines => 6 }],
36			[challenge => { weight => 800, pixels_above_lines => 6, background => "#ffffb0" }],
37			[description => { weight => 800, foreground => "blue" }],
38			[infoblock => { weight => 700, foreground => "blue" }],
39			);
40
41			for (@tags) {
42			my ($k, $v) = @$_;
43			my $tag = new Gtk2::TextTag $k;
44			if (delete $v->{event}) {
45			###
46			}
47			$tag->set (%$v);
48			$tagtable->add ($tag);
49	pcg	1.1	}
50			}
51
52	root	1.4	$self->{tagtable} = $tagtable;
53	pcg	1.1
54	pcg	1.3	$self->signal_connect (destroy => sub {
55			remove Glib::Source delete $self->{idle} if $self->{idle};
56			%{$_[0]} = ();
57			});
58
59	root	1.4	$self->{buffer} = new Gtk2::TextBuffer $self->{tagtable};
60	pcg	1.1
61			$self->{widget} = new Gtk2::ScrolledWindow;
62			$self->{widget}->set_policy("never", "always");
63			$self->pack_start ($self->{widget}, 1, 1, 0);
64
65			$self->{widget}->add ($self->{view} = new_with_buffer Gtk2::TextView $self->{buffer});
66			$self->{view}->set_wrap_mode ("word");
67			$self->{view}->set_cursor_visible (0);
68
69			$self->{view}->set_editable (0);
70
71			$self->{view}->signal_connect (motion_notify_event => sub {
72			my ($widget, $event) = @_;
73
74			my $window = $widget->get_window ("text");
75			if ($event->window == $window) {
76			my ($win, $x, $y, $mask) = $window->get_pointer;
77			# warn "TAG EVENT @_ ($window, $win, $x, $y, $mask)\n";
78			#gtk_text_view_window_to_buffer_coords (text_view,
79			# GTK_TEXT_WINDOW_TEXT,
80			# text_view->drag_start_x,
81			# text_view->drag_start_y,
82			# &buffer_x,
83			# &buffer_y);
84			#
85			# gtk_text_layout_get_iter_at_pixel (text_view->layout,
86			# &iter,
87			# buffer_x, buffer_y);
88			#
89			# gtk_text_view_start_selection_dnd (text_view, &iter, event);
90			# return TRUE;
91			}
92			0;
93			});
94
95			$self->pack_start (($self->{entry} = new Gtk2::Entry), 0, 1, 0);
96
97	root	1.4	$self->{entry}->signal_connect (activate => sub {
98	pcg	1.1	my ($entry) = @_;
99			my $text = $entry->get_text;
100			$entry->set_text("");
101
102			my ($cmd, $arg);
103
104			if ($text =~ /^\/(\S+)\s(.)$/) {
105			($cmd, $arg) = ($1, $2);
106			} else {
107	pcg	1.2	($cmd, $arg) = ("say", $text);
108	pcg	1.1	}
109
110			$self->signal_emit (command => $cmd, $arg);
111			});
112
113	root	1.4	#$self->{end} = $self->{buffer}->create_mark (undef, $self->{buffer}->get_end_iter, 0);#d##todo# use this one for gtk-1.050+
114			$self->{end} = $self->{buffer}->create_mark (++$USELESSNAME, $self->{buffer}->get_end_iter, 0); # workaround for gtk-perl bug
115	pcg	1.1
116			$self->set_end;
117			}
118
119			sub do_command {
120			my ($self, $cmd, $arg, %arg) = @_;
121			}
122
123			sub set_end {
124			my ($self) = @_;
125
126			# this is probably also a hack...
127			$self->{idle} \|\|= add Glib::Idle sub {
128			$self->{view}->scroll_to_iter ($self->{buffer}->get_end_iter, 0, 0, 0, 0)
129			if $self->{view};
130			delete $self->{idle};
131			};
132			}
133
134			sub at_end {
135			my ($self) = @_;
136
137			# this is, maybe, a bad hack :/
138			my $adj = $self->{widget}->get_vadjustment;
139			$adj->value + $adj->page_size >= $adj->upper - 0.5;
140			}
141
142			sub append_text {
143			my ($self, $text) = @_;
144
145	root	1.4	$self->_append_text ($self->{end}, $text);
146			}
147
148			sub _append_text {
149			my ($self, $mark, $text) = @_;
150
151	pcg	1.1	my $at_end = $self->at_end;
152
153			$text = "<default>$text</default>";
154
155	root	1.4	my @tag;
156	pcg	1.1	# pseudo-simplistic-xml-parser
157			for (;;) {
158			$text =~ /\G<([^>]+)>/gc or last;
159			my $tag = $1;
160			if ($tag =~ s/^\///) {
161			pop @tag;
162			} else {
163			push @tag, $tag;
164			}
165
166			$text =~ /\G([^<]*)/gc or last;
167	root	1.4	$self->{buffer}->insert_with_tags_by_name ($self->{buffer}->get_iter_at_mark ($mark), util::xmlto $1, @tag)
168	pcg	1.1	if length $1;
169			}
170
171			$self->set_end if $at_end;
172			}
173
174			sub set_text {
175			my ($self, $text) = @_;
176
177			my $at_end = $self->at_end;
178
179			$self->{buffer}->set_text ("");
180			$self->append_text ($text);
181
182			$self->set_end if $at_end;
183	root	1.4	}
184
185			sub new_eventtag {
186			my ($self, $cb) = @_;
187
188			my $tag = new Gtk2::TextTag;
189			$tag->signal_connect (event => $cb);
190			$self->{tagtable}->add ($tag);
191
192			$tag
193			}
194
195			# create a new "subbuffer"
196			sub new_inlay {
197			my ($self) = @_;
198
199			my $end = $self->{buffer}->get_end_iter;
200
201			my $self = bless {
202			buffer => $self->{buffer},
203			parent => $self,
204			}, superchat::inlay;
205
206			# $USELESSNAME is a Gtk-perl < 1.042 workaround
207			$self->{l} = $self->{buffer}->create_mark (++$USELESSNAME, $end, 1);
208			$self->{buffer}->insert ($end, "\x{200d}");
209			$self->{r} = $self->{buffer}->create_mark (++$USELESSNAME, $self->{buffer}->get_iter_at_mark ($self->{l}), 0);
210
211			Scalar::Util::weaken $self->{buffer};
212			Scalar::Util::weaken $self->{parent};
213			$self;
214			}
215
216			sub new_switchable_inlay {
217			my ($self, $header, $cb, $visible) = @_;
218
219			my $inlay;
220
221			my $tag = $self->new_eventtag (sub {
222			my ($tag, $view, $event, $iter) = @_;
223
224			if ($event->type eq "button-press") {
225			$inlay->set_visible (!$inlay->{visible});
226			return 1;
227			}
228
229			0;
230			});
231
232			$tag->set (background => "#e0e0ff");
233
234			$inlay = $self->new_inlay;
235
236			$inlay->{visible} = $visible;
237			$inlay->{header} = $header;
238			$inlay->{tag} = $tag;
239			$inlay->{cb} = $cb;
240
241			Scalar::Util::weaken $inlay->{tag};
242
243			$inlay->refresh;
244
245			$inlay;
246			}
247
248			package superchat::inlay;
249
250			sub liter { $_[0]{buffer}->get_iter_at_mark ($_[0]{l}) }
251			sub riter { $_[0]{buffer}->get_iter_at_mark ($_[0]{r}) }
252
253			sub clear {
254			my ($self) = @_;
255			$self->{buffer}->delete ($self->liter, $self->riter);
256			}
257
258			sub append_text {
259			my ($self, $text) = @_;
260
261			$self->{parent}->_append_text ($self->{r}, $text);
262			}
263
264			sub append_widget {
265			my ($self, $widget) = @_;
266
267			$widget->show_all;
268
269			my $anchor = $self->{buffer}->create_child_anchor ($self->riter);
270			$self->{parent}{view}->add_child_at_anchor ($widget, $anchor);
271			}
272
273			sub append_optionmenu {
274			my ($self, $ref, @entry) = @_;
275
276			my @vals;
277
278			my $widget = new Gtk2::OptionMenu;
279			$widget->set (menu => my $menu = new Gtk2::Menu);
280
281			my $idx = 0;
282
283			while (@entry >= 2) {
284			my $value = shift @entry;
285			my $label = shift @entry;
286
287			$menu->append (new Gtk2::MenuItem $label);
288			push @vals, $value;
289
290			if ($value eq $$ref && $idx >= 0) {
291			$widget->set_history ($idx);
292			$idx = -1e6;
293			}
294			$idx++;
295			}
296
297			my $cb = shift @entry;
298
299			$widget->signal_connect (changed => sub {
300			my $new = $vals[$_[0]->get_history];
301
302			if ($new ne $$ref) {
303			$$ref = $new;
304			$cb->($new) if $cb;
305			}
306			});
307
308			$self->append_widget ($widget);
309
310			$widget;
311			}
312
313			sub append_entry {
314			my ($self, $ref, $width, $cb) = @_;
315
316			my $widget = new Gtk2::Entry;
317			$widget->set (text => $$ref, width_chars => $width);
318			eval { $widget->set (xalign => 1) }; # workaround für 2.2
319			$widget->signal_connect (changed => sub {
320			$$ref = $_[0]->get_text;
321			$cb->($$ref) if $cb;
322			});
323
324			$self->append_widget ($widget);
325			$widget;
326			}
327
328			sub append_button {
329			my ($self, $label, $cb) = @_;
330
331			my $widget = new_with_label Gtk2::Button $label;
332			$widget->signal_connect (clicked => sub { $cb->() if $cb });
333
334			$self->append_widget ($widget);
335			$widget;
336			}
337
338			sub visible { $_[0]{visible} }
339
340			sub set_visible {
341			my ($self, $visible) = @_;
342
343			return if $self->{visible} == $visible;
344			$self->{visible} = $visible;
345
346			$self->refresh;
347			}
348
349			sub refresh {
350			my ($self) = @_;
351
352			$self->clear;
353
354			my $arrow = $self->{visible} ? "⊟" : "⊞";
355
356			$self->{buffer}->insert ($self->riter, "\n");
357			$self->{buffer}->insert_with_tags ($self->riter, util::xmlto "$arrow $self->{header}", $self->{tag});
358
359			return unless $self->{visible};
360
361			$self->{cb}->($self);
362			}
363
364			sub destroy {
365			my ($self) = @_;
366
367			return if !$self->{l} \|\| !$self->{buffer} \|\| $self->{l}->get_deleted;
368
369			$self->clear if $self->{buffer};
370
371			delete $self->{parent};
372			delete $self->{buffer};
373			delete $self->{l};
374			delete $self->{r};
375			}
376
377			sub DESTROY {
378			my $self = shift;
379
380			$self->{parent}{tagtable}->remove (delete $self->{tag}) if $self->{tag} && $self->{parent};
381			#&destroy;
382	pcg	1.1	}
383
384			1;
385