kgsueme/kgsueme/superchat.pl

package superchat;

# 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 }],
         [error       => { foreground => "#ff0000", event => 1 }],
         [header      => { 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);

   $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;

   $self->{l} = $self->{buffer}->create_mark (undef, $end, 1);
   $self->{buffer}->insert ($end, "\x{200d}");
   $self->{r} = $self->{buffer}->create_mark (undef, $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});
      }

      1;
   });

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

   $self->{buffer}->insert ($self->{buffer}->get_end_iter, "\n");
   $self->{buffer}->insert_with_tags ($self->{buffer}->get_end_iter, util::xmlto "\x{21f3} $header", $tag);

   $inlay = $self->new_inlay;

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

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

   $inlay->set_visible ($visible);

   $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 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;
   return unless $self->{visible};

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

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

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

1;

Revision:	1.5
Committed:	Sun May 23 02:13:29 2004 UTC (20 years ago) by pcg
Content type:	text/plain
Branch:	MAIN
Changes since 1.4:	+4 -2 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	pcg	1.1	package superchat;
2
3			# waaay cool widget. well... maybe at one point in the future
4
5			use Gtk2;
6
7			use Glib::Object::Subclass
8			Gtk2::VBox,
9			signals => {
10			command => {
11			flags => [qw/run-first/],
12			return_type => undef, # void return
13			param_types => [Glib::Scalar, Glib::Scalar],
14			},
15			};
16
17	pcg	1.2	sub INIT_INSTANCE {
18			my $self = shift;
19	pcg	1.1
20	pcg	1.2	my $tagtable = new Gtk2::TextTagTable;
21
22			{
23			my @tags = (
24			[default => { foreground => "black" }],
25			[node => { foreground => "#0000b0", event => 1 }],
26			[move => { foreground => "#0000b0", event => 1 }],
27			[user => { foreground => "#0000b0", event => 1 }],
28			[coord => { foreground => "#0000b0", event => 1 }],
29			[error => { foreground => "#ff0000", event => 1 }],
30			[header => { weight => 800, pixels_above_lines => 6 }],
31			[challenge => { weight => 800, pixels_above_lines => 6, background => "#ffffb0" }],
32			[description => { weight => 800, foreground => "blue" }],
33			[infoblock => { weight => 700, foreground => "blue" }],
34			);
35
36			for (@tags) {
37			my ($k, $v) = @$_;
38			my $tag = new Gtk2::TextTag $k;
39			if (delete $v->{event}) {
40			###
41			}
42			$tag->set (%$v);
43			$tagtable->add ($tag);
44	pcg	1.1	}
45			}
46
47	pcg	1.2	$self->{tagtable} = $tagtable;
48	pcg	1.1
49			$self->signal_connect (destroy => sub {
50			remove Glib::Source delete $self->{idle} if $self->{idle};
51			%{$_[0]} = ();
52			});
53
54	pcg	1.2	$self->{buffer} = new Gtk2::TextBuffer $self->{tagtable};
55	pcg	1.1
56			$self->{widget} = new Gtk2::ScrolledWindow;
57			$self->{widget}->set_policy("never", "always");
58			$self->pack_start ($self->{widget}, 1, 1, 0);
59
60			$self->{widget}->add ($self->{view} = new_with_buffer Gtk2::TextView $self->{buffer});
61			$self->{view}->set_wrap_mode ("word");
62			$self->{view}->set_cursor_visible (0);
63
64			$self->{view}->set_editable (0);
65
66			$self->{view}->signal_connect (motion_notify_event => sub {
67			my ($widget, $event) = @_;
68
69			my $window = $widget->get_window ("text");
70			if ($event->window == $window) {
71			my ($win, $x, $y, $mask) = $window->get_pointer;
72			# warn "TAG EVENT @_ ($window, $win, $x, $y, $mask)\n";
73			#gtk_text_view_window_to_buffer_coords (text_view,
74			# GTK_TEXT_WINDOW_TEXT,
75			# text_view->drag_start_x,
76			# text_view->drag_start_y,
77			# &buffer_x,
78			# &buffer_y);
79			#
80			# gtk_text_layout_get_iter_at_pixel (text_view->layout,
81			# &iter,
82			# buffer_x, buffer_y);
83			#
84			# gtk_text_view_start_selection_dnd (text_view, &iter, event);
85			# return TRUE;
86			}
87			0;
88			});
89
90			$self->pack_start (($self->{entry} = new Gtk2::Entry), 0, 1, 0);
91
92	pcg	1.2	$self->{entry}->signal_connect (activate => sub {
93	pcg	1.1	my ($entry) = @_;
94			my $text = $entry->get_text;
95			$entry->set_text("");
96
97			my ($cmd, $arg);
98
99			if ($text =~ /^\/(\S+)\s(.)$/) {
100			($cmd, $arg) = ($1, $2);
101			} else {
102			($cmd, $arg) = ("say", $text);
103			}
104
105			$self->signal_emit (command => $cmd, $arg);
106			});
107
108	pcg	1.2	$self->{end} = $self->{buffer}->create_mark (undef, $self->{buffer}->get_end_iter, 0);
109	pcg	1.1
110			$self->set_end;
111			}
112
113			sub do_command {
114			my ($self, $cmd, $arg, %arg) = @_;
115			}
116
117			sub set_end {
118			my ($self) = @_;
119
120			# this is probably also a hack...
121			$self->{idle} \|\|= add Glib::Idle sub {
122			$self->{view}->scroll_to_iter ($self->{buffer}->get_end_iter, 0, 0, 0, 0)
123			if $self->{view};
124			delete $self->{idle};
125			};
126			}
127
128			sub at_end {
129			my ($self) = @_;
130
131			# this is, maybe, a bad hack :/
132			my $adj = $self->{widget}->get_vadjustment;
133			$adj->value + $adj->page_size >= $adj->upper - 0.5;
134			}
135
136			sub append_text {
137			my ($self, $text) = @_;
138
139	pcg	1.2	$self->_append_text ($self->{end}, $text);
140			}
141
142			sub _append_text {
143			my ($self, $mark, $text) = @_;
144	pcg	1.1
145	pcg	1.5	my $at_end = $self->at_end;
146
147	pcg	1.1	$text = "<default>$text</default>";
148
149	pcg	1.2	my @tag;
150	pcg	1.1	# pseudo-simplistic-xml-parser
151			for (;;) {
152			$text =~ /\G<([^>]+)>/gc or last;
153			my $tag = $1;
154			if ($tag =~ s/^\///) {
155			pop @tag;
156			} else {
157			push @tag, $tag;
158			}
159
160			$text =~ /\G([^<]*)/gc or last;
161	pcg	1.2	$self->{buffer}->insert_with_tags_by_name ($self->{buffer}->get_iter_at_mark ($mark), util::xmlto $1, @tag)
162	pcg	1.1	if length $1;
163			}
164	pcg	1.5
165			$self->set_end if $at_end;
166	pcg	1.1	}
167
168			sub set_text {
169			my ($self, $text) = @_;
170
171			my $at_end = $self->at_end;
172
173			$self->{buffer}->set_text ("");
174			$self->append_text ($text);
175
176			$self->set_end if $at_end;
177			}
178
179	pcg	1.2	sub new_eventtag {
180			my ($self, $cb) = @_;
181
182			my $tag = new Gtk2::TextTag;
183			$tag->signal_connect (event => $cb);
184			$self->{tagtable}->add ($tag);
185
186			$tag
187			}
188
189			# create a new "subbuffer"
190			sub new_inlay {
191			my ($self) = @_;
192
193			my $end = $self->{buffer}->get_end_iter;
194
195			my $self = bless {
196			buffer => $self->{buffer},
197			parent => $self,
198			}, superchat::inlay;
199
200			$self->{l} = $self->{buffer}->create_mark (undef, $end, 1);
201			$self->{buffer}->insert ($end, "\x{200d}");
202			$self->{r} = $self->{buffer}->create_mark (undef, $self->{buffer}->get_iter_at_mark ($self->{l}), 0);
203
204			Scalar::Util::weaken $self->{buffer};
205			Scalar::Util::weaken $self->{parent};
206			$self;
207			}
208
209			sub new_switchable_inlay {
210			my ($self, $header, $cb, $visible) = @_;
211
212			my $inlay;
213
214			my $tag = $self->new_eventtag (sub {
215			my ($tag, $view, $event, $iter) = @_;
216
217			if ($event->type eq "button-press") {
218	pcg	1.4	$inlay->set_visible (!$inlay->{visible});
219	pcg	1.2	}
220
221			1;
222			});
223
224			$tag->set (background => "#e0e0ff");
225
226			$self->{buffer}->insert ($self->{buffer}->get_end_iter, "\n");
227	pcg	1.4	$self->{buffer}->insert_with_tags ($self->{buffer}->get_end_iter, util::xmlto "\x{21f3} $header", $tag);
228	pcg	1.2
229			$inlay = $self->new_inlay;
230
231	pcg	1.4	$inlay->{visible} = 0;
232	pcg	1.2	$inlay->{tag} = $tag;
233			$inlay->{cb} = $cb;
234
235	pcg	1.3	Scalar::Util::weaken $inlay->{tag};
236
237	pcg	1.4	$inlay->set_visible ($visible);
238	pcg	1.2
239			$inlay;
240			}
241
242			package superchat::inlay;
243
244			sub liter { $_[0]{buffer}->get_iter_at_mark ($_[0]{l}) }
245			sub riter { $_[0]{buffer}->get_iter_at_mark ($_[0]{r}) }
246
247			sub clear {
248			my ($self) = @_;
249			$self->{buffer}->delete ($self->liter, $self->riter);
250			}
251
252			sub append_text {
253			my ($self, $text) = @_;
254
255			$self->{parent}->_append_text ($self->{r}, $text);
256			}
257
258	pcg	1.4	sub visible { $_[0]{visible} }
259			sub set_visible {
260			my ($self, $visible) = @_;
261
262			return if $self->{visible} == $visible;
263			$self->{visible} = $visible;
264
265			$self->refresh;
266			}
267
268			sub refresh {
269			my ($self) = @_;
270
271			$self->clear;
272			return unless $self->{visible};
273
274			$self->{cb}->($self);
275			}
276
277	pcg	1.2	sub DESTROY {
278			my ($self) = @_;
279
280			$self->{parent}{tagtable}->remove (delete $self->{tag}) if $self->{tag};
281			}
282
283	pcg	1.1	1;
284