kgsueme/kgsueme/gtk.pl

package gtk;

use Carp;
use File::Temp;
use Gtk2;

# I have not yet found a way to simply default style properties
Gtk2::Rc->parse_string(<<EOF);

   style "base" {
      GtkTreeView::vertical_separator = 0
   }
   widget_class "*" style "base"

   style "whitestyle" {
      fg[NORMAL] = "#000000"
      bg[NORMAL] = "#ffffff"
   }
   style "blackstyle" {
      fg[NORMAL] = "#ffffff"
      bg[NORMAL] = "#000000"
   }

   widget "*.userpanel-0.*" style "blackstyle"
   widget "*.userpanel-1.*" style "whitestyle"

EOF

sub flush {
   do {
      flush Gtk2::Gdk;
      Glib::MainContext->default->iteration (0);
   } while Gtk2::Gdk->events_pending;
}

sub for_all($) {
   (
      $_[0],
      $_[0]->isa (Gtk2::Container)
         ? map for_all ($_), $_[0]->get_children
         : ()
   )
}

sub double_buffered {
   return;#d#
   my ($widget, $state) = @_;

   for (for_all $widget) {
      $_->set_double_buffered ($state);
      print "$_\n";#d#
   }
      print "<<<\n";#d#
}

our $text_renderer = new Gtk2::CellRendererText;
our $int_renderer  = new Gtk2::CellRendererText;
$int_renderer->set (xalign => 1);

our $state = $util::state->{gtk} ||= {};

# shows the properties of a glib object
sub info {
   my ($idx, $obj) = @_;
   return if $seen{$idx}++;
   print "\n$idx\n";
   for ($obj->list_properties) {
      printf "%-16s %-24s %-24s %s\n", $_->{name}, $_->{type}, (join ":", @{$_->{flags}}), $_->{descr};
   }
}

my %get = (
   window_size     => sub { [ ($_[0]->allocation->values)[2,3] ] },
   #window_pos     => sub { die KGS::Listener::Debug::dumpval [ $_[0]->get_root_origin ] },
   column_size     => sub { $_[0]->get("width") || $_[0]->get("fixed_width") },
   modelsortorder  => sub { [ $_[0]->get_sort_column_id ] },
);

my %set = (
   window_size     => sub { $_[0]->set_default_size (@{$_[1]}) },
   #window_pos     => sub { $_[0]->set_uposition (@{$_[1]}) if @{$_[1]} },
   column_size     => sub { $_[0]->set (fixed_width => $_[1]) },
   modelsortorder  => sub { $_[0]->set_sort_column_id (@{$_[1]}) },
);

my %widget;

sub state {
   my ($widget, $class, $instance, %attr) = @_;

   while (my ($k, $v) = each %attr) {
      my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);

      $v = $state->{$class}{"*"}{$get}
         if exists $state->{$class}{"*"} && exists $state->{$class}{"*"}{$get};

      $v = $state->{$class}{$instance}{$get}
         if defined $instance
         && exists $state->{$class}{$instance} && exists $state->{$class}{$instance}{$get};

      $set{$get} ? $set{$get}->($widget, $v) : $widget->set($set => $v);

      #my $vx = KGS::Listener::Debug::dumpval $v; $vx =~ s/\s+/ /g; warn "set $class ($instance) $set => $vx\n";#d#
   }

   #$widget->signal_connect(destroy => sub { delete $widget{$widget}; 0 });

   $widget{$widget} = [$widget, $class, $instance, \%attr];
   Scalar::Util::weaken $widget{$widget}[0];
}

sub save_state {
   for (grep $_, values %widget) {
      my ($widget, $class, $instance, $attr) = @$_;

      next unless $widget; # no destroy => widget may be undef

      $widget->realize if $widget->can("realize");

      while (my ($k, $v) = each %$attr) {
         my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
         $v = $get{$get} ? $get{$get}->($widget) : $widget->get($get);

         $state->{$class}{"*"}{$get}       = $v;
         $state->{$class}{$instance}{$get} = $v if defined $instance;

         #my $vx = KGS::Listener::Debug::dumpval $v; $vx =~ s/\s+/ /g; warn "get $class ($instance) $get => $vx\n";#d#
      }
   }
}

# string => Gtk2::Image
sub image_from_data {
   my ($data) = @_;
   my $img;
   
   if (defined $data) {
      # need to write to file first :/
      my ($fh, $filename) = File::Temp::tempfile ();
      syswrite $fh, $data;
      close $fh;
      $img = new_from_file Gtk2::Image $filename;
      unlink $filename;
   } else {
      $img = new_from_file Gtk2::Image KGS::Constants::findfile "KGS/kgsueme/images/default_userpic.png";
   }

   $img;
}

#############################################################################

sub optionmenu {
   my ($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;
      }
   });

   $widget;
}

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

   my $widget = new Gtk2::Entry;
   $widget->set (text => $$ref, width_chars => $width);
   $widget->signal_connect (changed => sub {
      $$ref = $_[0]->get_text;
      $cb->($$ref) if $cb;
   });

   $widget;
}

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

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

   $widget;
}

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

   my $widget = new Gtk2::Entry;
   $widget->set (text => util::format_time $$ref, width_chars => $width, xalign => 1);
   $widget->signal_connect (changed => sub {
      $$ref = util::parse_time $_[0]->get_text;
      $cb->($$ref) if $cb;
   });

   $widget;
}

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

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

   $widget;
}

1;

Revision:	1.35
Committed:	Tue Jun 8 17:35:00 2004 UTC (19 years, 11 months ago) by root
Content type:	text/plain
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.34:	+2 -4 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	pcg	1.1	package gtk;
2
3	pcg	1.3	use Carp;
4	pcg	1.15	use File::Temp;
5			use Gtk2;
6	pcg	1.3
7	pcg	1.26	# I have not yet found a way to simply default style properties
8	pcg	1.24	Gtk2::Rc->parse_string(<<EOF);
9
10			style "base" {
11			GtkTreeView::vertical_separator = 0
12			}
13			widget_class "*" style "base"
14
15	root	1.34	style "whitestyle" {
16			fg[NORMAL] = "#000000"
17			bg[NORMAL] = "#ffffff"
18			}
19			style "blackstyle" {
20			fg[NORMAL] = "#ffffff"
21			bg[NORMAL] = "#000000"
22			}
23
24			widget ".userpanel-0." style "blackstyle"
25			widget ".userpanel-1." style "whitestyle"
26
27	pcg	1.24	EOF
28
29	root	1.31	sub flush {
30			do {
31			flush Gtk2::Gdk;
32			Glib::MainContext->default->iteration (0);
33			} while Gtk2::Gdk->events_pending;
34			}
35
36			sub for_all($) {
37			(
38			$_[0],
39			$_[0]->isa (Gtk2::Container)
40			? map for_all ($_), $_[0]->get_children
41			: ()
42			)
43			}
44
45			sub double_buffered {
46			return;#d#
47			my ($widget, $state) = @_;
48
49			for (for_all $widget) {
50			$_->set_double_buffered ($state);
51			print "$_\n";#d#
52			}
53			print "<<<\n";#d#
54			}
55
56	pcg	1.1	our $text_renderer = new Gtk2::CellRendererText;
57			our $int_renderer = new Gtk2::CellRendererText;
58			$int_renderer->set (xalign => 1);
59
60	pcg	1.5	our $state = $util::state->{gtk} \|\|= {};
61	pcg	1.1
62			# shows the properties of a glib object
63	pcg	1.3	sub info {
64	pcg	1.1	my ($idx, $obj) = @_;
65	pcg	1.5	return if $seen{$idx}++;
66	pcg	1.1	print "\n$idx\n";
67			for ($obj->list_properties) {
68			printf "%-16s %-24s %-24s %s\n", $_->{name}, $_->{type}, (join ":", @{$_->{flags}}), $_->{descr};
69			}
70			}
71
72			my %get = (
73			window_size => sub { [ ($_[0]->allocation->values)[2,3] ] },
74			#window_pos => sub { die KGS::Listener::Debug::dumpval [ $_[0]->get_root_origin ] },
75	pcg	1.5	column_size => sub { $_[0]->get("width") \|\| $_[0]->get("fixed_width") },
76	pcg	1.10	modelsortorder => sub { [ $_[0]->get_sort_column_id ] },
77	pcg	1.1	);
78
79			my %set = (
80	pcg	1.8	window_size => sub { $_[0]->set_default_size (@{$_[1]}) },
81			#window_pos => sub { $_[0]->set_uposition (@{$_[1]}) if @{$_[1]} },
82			column_size => sub { $_[0]->set (fixed_width => $_[1]) },
83	pcg	1.10	modelsortorder => sub { $_[0]->set_sort_column_id (@{$_[1]}) },
84	pcg	1.1	);
85
86	pcg	1.5	my %widget;
87
88	pcg	1.1	sub state {
89			my ($widget, $class, $instance, %attr) = @_;
90
91			while (my ($k, $v) = each %attr) {
92			my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
93	pcg	1.9
94			$v = $state->{$class}{"*"}{$get}
95			if exists $state->{$class}{""} && exists $state->{$class}{""}{$get};
96
97			$v = $state->{$class}{$instance}{$get}
98			if defined $instance
99			&& exists $state->{$class}{$instance} && exists $state->{$class}{$instance}{$get};
100
101	pcg	1.1	$set{$get} ? $set{$get}->($widget, $v) : $widget->set($set => $v);
102	pcg	1.9
103	pcg	1.26	#my $vx = KGS::Listener::Debug::dumpval $v; $vx =~ s/\s+/ /g; warn "set $class ($instance) $set => $vx\n";#d#
104	pcg	1.1	}
105
106	pcg	1.8	#$widget->signal_connect(destroy => sub { delete $widget{$widget}; 0 });
107	pcg	1.1
108	pcg	1.5	$widget{$widget} = [$widget, $class, $instance, \%attr];
109			Scalar::Util::weaken $widget{$widget}[0];
110	pcg	1.1	}
111
112			sub save_state {
113	pcg	1.5	for (grep $_, values %widget) {
114			my ($widget, $class, $instance, $attr) = @$_;
115
116	pcg	1.8	next unless $widget; # no destroy => widget may be undef
117
118	pcg	1.5	$widget->realize if $widget->can("realize");
119
120			while (my ($k, $v) = each %$attr) {
121			my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
122			$v = $get{$get} ? $get{$get}->($widget) : $widget->get($get);
123
124			$state->{$class}{"*"}{$get} = $v;
125			$state->{$class}{$instance}{$get} = $v if defined $instance;
126	pcg	1.9
127	pcg	1.26	#my $vx = KGS::Listener::Debug::dumpval $v; $vx =~ s/\s+/ /g; warn "get $class ($instance) $get => $vx\n";#d#
128	pcg	1.1	}
129			}
130	pcg	1.15	}
131
132			# string => Gtk2::Image
133			sub image_from_data {
134			my ($data) = @_;
135	pcg	1.18	my $img;
136	pcg	1.15
137	pcg	1.18	if (defined $data) {
138			# need to write to file first :/
139			my ($fh, $filename) = File::Temp::tempfile ();
140			syswrite $fh, $data;
141			close $fh;
142			$img = new_from_file Gtk2::Image $filename;
143			unlink $filename;
144			} else {
145	pcg	1.29	$img = new_from_file Gtk2::Image KGS::Constants::findfile "KGS/kgsueme/images/default_userpic.png";
146	pcg	1.18	}
147	pcg	1.15
148			$img;
149	pcg	1.1	}
150
151	root	1.32	#############################################################################
152
153			sub optionmenu {
154			my ($ref, @entry) = @_;
155
156			my @vals;
157
158			my $widget = new Gtk2::OptionMenu;
159			$widget->set (menu => my $menu = new Gtk2::Menu);
160
161			my $idx = 0;
162
163			while (@entry >= 2) {
164			my $value = shift @entry;
165			my $label = shift @entry;
166
167			$menu->append (new Gtk2::MenuItem $label);
168			push @vals, $value;
169
170			if ($value eq $$ref && $idx >= 0) {
171			$widget->set_history ($idx);
172			$idx = -1e6;
173			}
174			$idx++;
175			}
176
177			my $cb = shift @entry;
178
179			$widget->signal_connect (changed => sub {
180			my $new = $vals[$_[0]->get_history];
181
182			if ($new ne $$ref) {
183			$$ref = $new;
184			$cb->($new) if $cb;
185			}
186			});
187
188			$widget;
189			}
190
191			sub textentry {
192			my ($ref, $width, $cb) = @_;
193
194			my $widget = new Gtk2::Entry;
195			$widget->set (text => $$ref, width_chars => $width);
196			$widget->signal_connect (changed => sub {
197			$$ref = $_[0]->get_text;
198			$cb->($$ref) if $cb;
199			});
200
201			$widget;
202			}
203
204			sub numentry {
205			my ($ref, $width, $cb) = @_;
206
207			my $widget = new Gtk2::Entry;
208	root	1.35	$widget->set (text => $$ref, width_chars => $width, xalign => 1);
209	root	1.32	$widget->signal_connect (changed => sub {
210			$$ref = $_[0]->get_text;
211			$cb->($$ref) if $cb;
212			});
213
214			$widget;
215			}
216
217			sub timeentry {
218			my ($ref, $width, $cb) = @_;
219
220			my $widget = new Gtk2::Entry;
221	root	1.35	$widget->set (text => util::format_time $$ref, width_chars => $width, xalign => 1);
222	root	1.32	$widget->signal_connect (changed => sub {
223			$$ref = util::parse_time $_[0]->get_text;
224			$cb->($$ref) if $cb;
225			});
226
227			$widget;
228			}
229
230			sub button {
231			my ($label, $cb) = @_;
232
233			my $widget = new_with_label Gtk2::Button $label;
234			$widget->signal_connect (clicked => sub { $cb->() if $cb });
235
236			$widget;
237			}
238
239	pcg	1.1	1;
240