summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/drakxtools.spec10
-rw-r--r--perl-install/my_gtk.pm807
-rw-r--r--perl-install/ugtk.pm835
3 files changed, 853 insertions, 799 deletions
diff --git a/perl-install/drakxtools.spec b/perl-install/drakxtools.spec
index ecdf82e3d..4b0d7da7c 100644
--- a/perl-install/drakxtools.spec
+++ b/perl-install/drakxtools.spec
@@ -1,7 +1,7 @@
Summary: The drakxtools (XFdrake, diskdrake, keyboarddrake, mousedrake...)
Name: drakxtools
Version: 1.1.8
-Release: 15mdk
+Release: 16mdk
Url: http://www.linux-mandrake.com/en/drakx.php3
Source0: %name-%version.tar.bz2
License: GPL
@@ -263,6 +263,14 @@ file /etc/sysconfig/harddrake2/previous_hw | fgrep -q perl && \
%config(noreplace) %_sysconfdir/logrotate.d/drakxtools-http
%changelog
+* Thu Aug 1 2002 Thierry Vignaud <tvignaud@mandrakesoft.com> 1.1.8-16mdk
+- my_gtk:
+ o splitup it into my_gtk and ugtk as done by dams
+ o resync with dams
+ o increase the icon blinkage from 50ms to 100ms
+- harddrake:
+ o use new embedded managment
+
* Thu Aug 1 2002 Pixel <pixel@mandrakesoft.com> 1.1.8-15mdk
- harddrake (titi):
o add embedded mode for drakconf
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index 0333123bf..9b23d1ee4 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -7,17 +7,13 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $border);
@ISA = qw(Exporter);
%EXPORT_TAGS = (
helpers => [ qw(create_okcancel createScrolledWindow create_menu create_notebook create_packtable create_hbox create_vbox create_adjustment create_box_with_title create_treeitem) ],
- wrappers => [ qw(gtksignal_connect gtkradio gtkpack gtkpack_ gtkpack__ gtkpack2 gtkpack3 gtkpack2_ gtkpack2__ gtkpowerpack gtkset_editable gtksetstyle gtkset_text gtkcombo_setpopdown_strings gtkset_tip gtkappenditems gtkappend gtkset_shadow_type gtkset_layout gtkset_relief gtkadd gtkput gtktext_insert gtkset_usize gtksize gtkset_justify gtkset_active gtkset_sensitive gtkset_modal gtkset_border_width gtkmove gtkresize gtkshow gtkhide gtkdestroy gtkcolor gtkset_mousecursor gtkset_mousecursor_normal gtkset_mousecursor_wait gtkset_background gtkset_default_fontset gtkctree_children gtkxpm gtkpng create_pix_text get_text_coord fill_tiled gtkicons_labels_widget write_on_pixmap gtkcreate_xpm gtkcreate_png gtkbuttonset) ],
+ wrappers => [ qw(gtksignal_connect gtkradio gtkpack gtkpack_ gtkpack__ gtkpack2 gtkpack3 gtkpack2_ gtkpack2__ gtkpowerpack gtkset_editable gtksetstyle gtkset_tip gtkappenditems gtkappend gtkset_shadow_type gtkset_layout gtkset_relief gtkadd gtkput gtktext_insert gtkset_usize gtksize gtkset_justify gtkset_active gtkset_sensitive gtkset_modal gtkset_border_width gtkmove gtkresize gtkshow gtkhide gtkdestroy gtkcolor gtkset_mousecursor gtkset_mousecursor_normal gtkset_mousecursor_wait gtkset_background gtkset_default_fontset gtkctree_children gtkxpm gtkpng create_pix_text get_text_coord fill_tiled gtkicons_labels_widget write_on_pixmap gtkcreate_xpm gtkcreate_png gtkbuttonset gtkroot) ],
ask => [ qw(ask_warn ask_okcancel ask_yesorno ask_from_entry) ],
);
$EXPORT_TAGS{all} = [ map { @$_ } values %EXPORT_TAGS ];
@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
-use Gtk;
-use Gtk::Gdk::ImlibImage;
-use c;
-use log;
-use common;
+use ugtk qw(:all);
my $forgetTime = 1000; #- in milli-seconds
$border = 5;
@@ -25,12 +21,10 @@ $border = 5;
#-###############################################################################
#- OO stuff
#-###############################################################################
+
sub new {
my ($type, $title, %opts) = @_;
- Gtk->init;
- Gtk::Gdk::ImlibImage->init;
- Gtk->set_locale;
my $o = bless { %opts }, $type;
$o->_create_window($title);
while (my $e = shift @tempory::objects) { $e->destroy }
@@ -105,7 +99,7 @@ sub main {
my ($o, $completed, $canceled) = @_;
gtkset_mousecursor_normal();
my $timeout = Gtk->timeout_add(1000, sub { gtkset_mousecursor_normal(); 1 });
- my $b = before_leaving { Gtk->timeout_remove($timeout) };
+ my $b = MDK::Common::Func::before_leaving { Gtk->timeout_remove($timeout) };
$o->{rwindow}->window->set_events(['key_press_mask', 'key_release_mask', 'exposure_mask']) if $o->{rwindow}->window;
$o->show;
@@ -116,6 +110,7 @@ sub main {
$o->destroy;
$o->{retval}
}
+
sub show($) {
my ($o) = @_;
$o->{window}->show;
@@ -133,582 +128,7 @@ sub sync {
show($o);
flush();
}
-sub flush {
- Gtk->main_iteration while Gtk->events_pending;
-}
-
-sub gtkshow($) { $_[0]->show; $_[0] }
-sub gtkhide($) { $_[0]->hide; $_[0] }
-sub gtkdestroy($) { $_[0] and $_[0]->destroy }
-sub gtkset_usize($$$) { $_[0]->set_usize($_[1],$_[2]); $_[0] }
-sub gtksize($$$) { $_[0]->size($_[1],$_[2]); $_[0] }
-sub gtkset_justify($$) { $_[0]->set_justify($_[1]); $_[0] }
-sub gtkset_active($$) { $_[0]->set_active($_[1]); $_[0] }
-sub gtkset_modal { $_[0]->set_modal($_[1]); $_[0] }
-sub gtkset_sensitive { $_[0]->set_sensitive($_[1]); $_[0] }
-sub gtkset_border_width{ $_[0]->set_border_width($_[1]); $_[0] }
-sub gtkmove { $_[0]->window->move($_[1], $_[2]); $_[0] }
-sub gtkresize { $_[0]->window->resize($_[1], $_[2]); $_[0] }
-
-sub gtksignal_connect($@) {
- my $w = shift;
- $w->signal_connect(@_);
- $w
-}
-
-sub gtkradio {
- my $def = shift;
- my $radio;
- map { $radio = new Gtk::RadioButton($_, $radio ? $radio : ());
- $radio->set_active($_ eq $def); $radio } @_;
-}
-
-sub gtkpack_($@) { gtkpowerpack('arg', 1, @_) }
-sub gtkpack($@) { gtkpowerpack(1, 1, @_) }
-sub gtkpack__($@) { gtkpowerpack(0, 1, @_) }
-sub gtkpack2_($@) { gtkpowerpack('arg', 0, @_) }
-sub gtkpack2($@) { gtkpowerpack(1, 0, @_) }
-sub gtkpack2__($@) { gtkpowerpack(0, 0, @_) }
-sub gtkpack3 { gtkpowerpack($a?1:0, 0, @_) }
-
-sub gtkpowerpack {
- #- Get Default Attributes (if any). 2 syntaxes allowed :
- #- gtkpowerpack( {expand => 1, fill => 0}, $box...) : the attributes are picked from a specified hash ref
- #- gtkpowerpack(1,0,1, $box, ...) : the attributes are picked from the non-ref list, in the order (expand, fill, padding, pack_end).
- my $RefDefaultAttrs;
- if (ref($_[0]) eq 'HASH') { $RefDefaultAttrs = shift }
- elsif (!ref($_[0])) {
- $RefDefaultAttrs = {};
- foreach ("expand", "fill", "padding", "pack_end") {
- !ref($_[0]) ? $RefDefaultAttrs->{$_} = shift : last
- }
- }
- my $box = shift;
-
- while (@_) {
- #- Get attributes (if specified). 4 syntaxes allowed (default values are undef ie. false...) :
- #- gtkpowerpack({defaultattrs}, $box, $widget1, $widget2, ...) : the attrs are picked from the default ones (if they exist)
- #- gtkpowerpack($box, {fill=>1, expand=>0, ...}, $widget1, ...) : the attributes are picked from a specified hash ref
- #- gtkpowerpack($box, [1,0,1], $widget1, ...) : the attributes are picked from the array ref : (expand, fill, padding, pack_end).
- #- gtkpowerpack({attr=>'arg'}, $box, 1, $widget1, 0, $widget2, etc...) : the 'arg' value will tell gtkpowerpack to always read the
- #- attr value directly in the arg list (avoiding confusion between value 0 and Gtk::Label("0"). That can simplify some writings but
- #- this arg(s) MUST then be present...
- my %attr;
- my $RefAttrs;
- ref($_[0]) eq 'HASH' || ref($_[0]) eq 'ARRAY' and $RefAttrs = shift;
- foreach ("expand", "fill", "padding", "pack_end") {
- if ($RefDefaultAttrs->{$_} eq 'arg') {
- ref ($_[0]) and die "error in packing definition\n";
- $attr{$_} = shift;
- ref($RefAttrs) eq 'ARRAY' and shift @$RefAttrs;
- } elsif (ref($RefAttrs) eq 'HASH' && defined($RefAttrs->{$_})) {
- $attr{$_} = $RefAttrs->{$_};
- } elsif (ref($RefAttrs) eq 'ARRAY') {
- $attr{$_} = shift @$RefAttrs;
- } elsif (defined($RefDefaultAttrs->{$_})) {
- $attr{$_} = int $RefDefaultAttrs->{$_};
- } else {
- $attr{$_} = 0;
- }
- }
- #- Get and pack the widget (create it if necessary when it is a label...)
- my $widget = ref($_[0]) ? shift : new Gtk::Label(shift);
- if ($attr{pack_end}) { $box->pack_end($widget, $attr{expand}, $attr{fill}, $attr{padding})}
- else { $box->pack_start($widget, $attr{expand}, $attr{fill}, $attr{padding}) }
- $widget->show;
- }
- $box
-}
-
-sub gtkset_editable {
- my ($w, $e) = @_;
- $w->set_editable($e);
- $w;
-}
-
-sub gtksetstyle {
- my ($w, $s) = @_;
- $w->set_style($s);
- $w;
-}
-
-sub gtkset_text {
- my ($w, $s) = @_;
- $w->set_text($s);
- $w;
-}
-
-sub gtkcombo_setpopdown_strings ($@) {
- my $w = shift;
- $w->set_popdown_strings(@_);
- $w;
-}
-
-sub gtkappend_text {
- my ($w, $s) = @_;
- $w->append_text($s);
- $w;
-}
-
-sub gtkprepend_text {
- my ($w, $s) = @_;
- $w->prepend_text($s);
- $w;
-}
-
-sub gtkset_tip {
- my ($tips, $w, $tip) = @_;
- $tips->set_tip($w, $tip) if $tip;
- $w;
-}
-
-sub gtkappenditems {
- my $w = shift;
- map { gtkshow($_) } @_;
- $w->append_items(@_);
- $w
-}
-
-sub gtkappend($@) {
- my $w = shift;
- foreach (@_) {
- my $l = $_;
- ref $l or $l = new Gtk::Label($l);
- $w->append($l);
- $l->show;
- }
- $w
-}
-
-sub gtkset_shadow_type {
- $_[0]->set_shadow_type($_[1]);
- $_[0];
-}
-
-sub gtkset_layout {
- $_[0]->set_layout($_[1]);
- $_[0];
-}
-
-sub gtkset_relief {
- $_[0]->set_relief($_[1]);
- $_[0];
-}
-
-sub gtkadd($@) {
- my $w = shift;
- foreach (@_) {
- my $l = $_;
- ref $l or $l = new Gtk::Label($l);
- $w->add($l);
- $l->show;
- }
- $w
-}
-sub gtkput {
- my ($w, $w2, $x, $y) = @_;
- $w->put($w2, $x, $y);
- $w2->show;
- $w
-}
-
-sub gtktext_insert {
- my ($w, $t) = @_;
- $w->freeze;
- $w->backward_delete($w->get_length);
- $w->insert(undef, undef, undef, $t);
- #- DEPRECATED? needs \n otherwise in case of one line text the beginning is not shown (even with the vadj->set_value)
- $w->set_word_wrap(1);
-#- $w->vadj->set_value(0);
- $w->thaw;
- $w;
-}
-
-sub gtkroot {
- Gtk->init;
- Gtk->set_locale;
- Gtk::Gdk::Window->new_foreign(Gtk::Gdk->ROOT_WINDOW);
-}
-
-sub gtkcolor {
- my ($r, $g, $b) = @_;
-
- my $color = bless { red => $r, green => $g, blue => $b }, 'Gtk::Gdk::Color';
- gtkroot()->get_colormap->color_alloc($color);
-}
-
-sub gtkset_mousecursor {
- my ($type, $w) = @_;
- ($w || gtkroot())->set_cursor(Gtk::Gdk::Cursor->new($type));
-}
-sub gtkset_mousecursor_normal { gtkset_mousecursor(68, @_) }
-sub gtkset_mousecursor_wait { gtkset_mousecursor(150, @_) }
-
-sub gtkset_background {
- my ($r, $g, $b) = @_;
-
- my $root = gtkroot();
- my $gc = Gtk::Gdk::GC->new($root);
-
- my $color = gtkcolor($r, $g, $b);
- $gc->set_foreground($color);
- $root->set_background($color);
-
- my ($h, $w) = $root->get_size;
- $root->draw_rectangle($gc, 1, 0, 0, $w, $h);
-}
-
-sub gtkset_default_fontset {
- my ($fontset) = @_;
-
- my $style = Gtk::Widget->get_default_style;
- my $f = Gtk::Gdk::Font->fontset_load($fontset) or die '';
- $style->font($f);
- Gtk::Widget->set_default_style($style);
-}
-
-sub gtkctree_children {
- my ($node) = @_;
- my @l;
- $node or return;
- for (my $p = $node->row->children; $p; $p = $p->row->sibling) {
- push @l, $p;
- }
- @l;
-}
-
-my @icon_paths;
-sub add_icon_path { push @icon_paths, @_ }
-
-sub icon_paths {
- (@icon_paths, $ENV{SHARE_PATH}, "$ENV{SHARE_PATH}/icons", "$ENV{SHARE_PATH}/libDrakX/pixmaps", "/usr/lib/libDrakX/icons", "pixmaps", 'standalone/icons');
-}
-
-sub gtkcreate_xpm {
- my ($f) = @_;
- my $rw = gtkroot();
- $f =~ m|.xpm$| or $f = "$f.xpm";
- if ($f !~ /\//) { -e "$_/$f" and $f = "$_/$f", last foreach icon_paths() }
- my @l = Gtk::Gdk::Pixmap->create_from_xpm($rw, new Gtk::Style->bg('normal'), $f) or die "gtkcreate_xpm: missing pixmap file $f";
- @l;
-}
-
-sub gtkcreate_png {
- my ($f) = shift;
- $f =~ m|.png$| or $f = "$f.png";
- if ($f !~ /\//) { -e "$_/$f" and $f = "$_/$f", last foreach icon_paths() }
- my $im = Gtk::Gdk::ImlibImage->load_image($f) or die "gtkcreate_png: missing png file $f";
- $im->render($im->rgb_width, $im->rgb_height);
- ($im->move_image(), $im->move_mask);
-}
-
-sub gtkbuttonset {
- my ($button, $str) = @_;
- $button->child->destroy;
- $button->add(gtkshow(new Gtk::Label $str));
- $button;
-}
-
-sub xpm_d { my $w = shift; Gtk::Gdk::Pixmap->create_from_xpm_d($w->window, undef, @_) }
-sub gtkxpm { new Gtk::Pixmap(gtkcreate_xpm(@_)) }
-sub gtkpng { new Gtk::Pixmap(gtkcreate_png(@_)) }
-
-sub create_pix_text {
- #ref widget, txt, color_txt, [font], [width], [height], flag1, flag2, [background, backsize x y], centeredx, centeredy, bold
- my ($w, $text, $color_text, $font, $max_width, $max_height, $can_be_greater, $can_be_smaller, $background, $x_back, $y_back, $centeredx, $centeredy, $bold) = @_;
- my $color_background;
- my $backpix;
- if ($color_text =~ /#(\d+)#(\d+)#(\d+)/) { $color_text = gtkcolor(map{$_*65535/255}($1, $2, $3)) }
- if (ref($background) eq 'Gtk::Gdk::Color') { $color_background = $background }
- elsif ($background =~ /#(\d+)#(\d+)#(\d+)/) { $color_background = gtkcolor(map{$_*65535/255}($1, $2, $3)) }
- elsif (ref($background) eq 'Gtk::Gdk::Pixmap' && $x_back && $y_back) { $backpix = 1 }
- my $fake_darea = new Gtk::DrawingArea;
- my $style = $fake_darea->style->copy();
- if (ref($font) eq 'Gtk::Gdk::Font') {
- $style->font($font);
- } else {
- $font and $style->font(Gtk::Gdk::Font->fontset_load($font));
- }
- $fake_darea->set_style($style);
- my ($width, $height, $lines, $widths, $heights) = get_text_coord (
- $text, $fake_darea, $max_width, $max_height, $can_be_greater, $can_be_smaller, $centeredx, $centeredy);
- my $pix = new Gtk::Gdk::Pixmap($w->window, $width, $height);
-
- if ($backpix) {
- fill_tiled($w, $pix, $background, $x_back, $y_back, $width, $height);
- } else {
- $color_background ||= gtkcolor(65535, 65535, 65535);
- my $gc_background = new Gtk::Gdk::GC($w->window);
- $gc_background->set_foreground($color_background);
- $pix->draw_rectangle($gc_background, 1, 0, 0, $width, $height);
- }
- $color_text ||= gtkcolor(0, 0, 0);
- my $gc_text = new Gtk::Gdk::GC($w->window);
- $gc_text->set_foreground($color_text);
- my $i = 0;
- foreach (@{$lines}) {
- $pix->draw_string($style->font, $gc_text, ${$widths}[$i], ${$heights}[$i], $_);
- $bold and $pix->draw_string($style->font, $gc_text, ${$widths}[$i] + 1, ${$heights}[$i], $_);
- $i++;
- }
- ($pix, $width, $height);
-}
-
-sub get_text_coord {
-
- my ($text, $widget4style, $max_width, $max_height, $can_be_greater, $can_be_smaller, $centeredx, $centeredy, $wrap_char) = @_;
-
- $wrap_char ||= ' ';
- my $idx = 0;
- my $real_width = 0;
- my $real_height = 0;
- my @lines;
- my @widths;
- my @heights;
- my $height_elem = $widget4style->style->font->ascent + $widget4style->style->font->descent;
- $heights[0] = 0;
- my $max_width2 = $max_width;
- my $height = $heights[0] = $height_elem;
- my $width = 0;
- my $flag = 1;
- my @t = split($wrap_char, $text);
- my @t2;
- if ($::isInstall && $::o->{lang} =~ /ja|zh/) {
- @t = map { $_ . $wrap_char } @t;
- $wrap_char = '';
- foreach (@t) {
- my @c = split('');
- my $i = 0;
- my $el = '';
- while (1) {
- $i >= @c and last;
- $el .= $c[$i];
- if (ord($c[$i]) >= 128) { $el .= $c[$i+1]; $i++; push @t2, $el; $el = '' }
- $i++;
- }
- $el ne '' and push @t2, $el;
- }
- } else {
- @t2 = @t;
- }
- foreach (@t2) {
- my $l = $widget4style->style->font->string_width($_ . (!$flag ? $wrap_char : ''));
- if ($width + $l > $max_width2 && !$flag) {
- $flag = 1;
- $height += $height_elem + 1;
- $heights[$idx+1] = $height;
- $widths[$idx] = $centeredx && !$can_be_smaller ? (max($max_width2-$width, 0))/2 : 0;
- $width = 0;
- $idx++;
- }
- $lines[$idx] = $flag ? $_ : $lines[$idx] . $wrap_char . $_;
- $width += $l;
- $flag = 0;
- $l <= $max_width2 or $max_width2 = $l;
- $width <= $real_width or $real_width = $width;
- }
- $height += $height_elem;
- $widths[$idx] = $centeredx && !$can_be_smaller ? (max($max_width2-$width, 0))/2 : 0;
-
- $height < $real_height or $real_height = $height;
- $width = $max_width;
- $height = $max_height;
- $real_width < $max_width && $can_be_smaller and $width = $real_width;
- $real_width > $max_width && $can_be_greater and $width = $real_width;
- $real_height < $max_height && $can_be_smaller and $height = $real_height;
- $real_height > $max_height && $can_be_greater and $height = $real_height;
- if ($centeredy) {
- my $dh = ($height-$real_height)/2 + ($height_elem)/2;
- @heights = map { $_ + $dh } @heights;
- }
- ($width, $height, \@lines, \@widths, \@heights)
-}
-
-sub fill_tiled {
- my ($w, $pix, $bitmap, $x_back, $y_back, $width, $height) = @_;
- my ($x2, $y2) = (0, 0);
- while (1) {
- $x2 = 0;
- while (1) {
- $pix->draw_pixmap($w->style->bg_gc('normal'),
- $bitmap, 0, 0, $x2, $y2, $x_back, $y_back);
- $x2 += $x_back;
- $x2 >= $width and last;
- }
- $y2 += $y_back;
- $y2 >= $height and last;
- }
-}
-
-sub gtkicons_labels_widget {
- my ($args, $w, $color_text, $widget_for_font, $background, $x_back, $y_back, $x_round,
- $y_round, $x_back2, $y_back2, $icon_width, $icon_height, $exec_func, $exec_hash) = @_;
-
- my @tab;
- my $i = 0;
- my $cursor_hand = new Gtk::Gdk::Cursor 60;
- my $cursor_normal = new Gtk::Gdk::Cursor 68;
- foreach (@$args) {
- my $label = $_->[0];
- my $dbl_area;
- my $darea = new Gtk::DrawingArea;
- my ($icon, undef) = gtkcreate_png($_->[1]);
- my ($icon_h, undef) = gtkcreate_png("$_->[1]_highlight");
- $darea->{state} = 0;
- $darea->signal_connect(expose_event => sub {
- my ($dx, $dy) = ($darea->allocation->[2], $darea->allocation->[3]);
- if (!defined($dbl_area) || $darea->{state} != $dbl_area->{state}) {
- my $state = $darea->{state};
- my ($pix, $width, $height) = create_pix_text($darea, $label, $color_text, $widget_for_font->style->font, $x_round, 1,
- 1, 0, $background, $x_back2, $y_back2, 1, 0, $state);
- ($dx, $dy) = (max($width, $x_round), $y_round + $height);
- $darea->set_usize($dx, $dy);
- $dbl_area = new Gtk::Gdk::Pixmap($darea->window, max($width, $x_round), $y_round + $height);
- $dbl_area->{state} = $darea->{state};
- fill_tiled($darea, $dbl_area, $background, $x_back2, $y_back2, $dx, $dy);
- $dbl_area->draw_pixmap($darea->style->bg_gc('normal'),
- $darea->{state} ? $icon_h : $icon, 0, 0, ($dx - $icon_width)/2, 0, $icon_width, $icon_height);
- $dbl_area->draw_pixmap($darea->style->bg_gc('normal'),
- $pix, 0, 0, ($dx - $width)/2, $y_round, $width, $height);
-# $dbl_area->draw_rectangle($darea->style->black_gc, 0,
-# 0, 0, max($width, $x_round) - 1 , $y_round + $height - 1);
- }
- $darea->window->draw_pixmap($darea->style->bg_gc('normal'),
- $dbl_area, 0, 0, 0, 0, $dx, $dy);
-# $darea->window->draw_rectangle($darea->style->black_gc, 0,
-# 0, 0, $dx, $dy);
- ($darea->{dx}, $darea->{dy}) = ($dx, $dy);
- });
- $darea->set_events(['exposure_mask', 'enter_notify_mask', 'leave_notify_mask', 'button_press_mask', 'button_release_mask' ]);
- $darea->signal_connect(enter_notify_event => sub {
- if ($darea->{state} == 0) {
- $darea->{state} = 1;
- $darea->draw(undef);
- }
- });
- $darea->signal_connect(leave_notify_event => sub {
- if ($darea->{state} == 1) {
- $darea->{state} = 0;
- $darea->draw(undef);
- }
- });
- my $label_exec = $_->[0];
- $darea->signal_connect(button_release_event => sub {
- $darea->{state} = 0;
- $darea->draw(undef);
- $exec_func->($exec_hash->{$label_exec});
-# $exec_hash->{$label_exec}{function}->($exec_hash->{$label_exec}{arg});
- });
- $darea->signal_connect(realize => sub { $darea->window->set_cursor($cursor_hand) });
- $tab[$i] = $darea;
- $i++;
- }
- my $fixed = new Gtk::Fixed;
- foreach (@tab) { $fixed->put($_, 75, 65) }
- my $redraw_function = sub {
- $fixed->move(@$_) foreach compute_icons($fixed->allocation->[2], $fixed->allocation->[3], 40, 15, 20, @tab);
- };
- $fixed->signal_connect(expose_event => $redraw_function);
- $fixed->signal_connect(realize => sub {
- $fixed->window->set_back_pixmap($background, 0);
- $redraw_function->();
- });
- $fixed->{redraw_function} = $redraw_function;
- $fixed->show_all();
- my $w_ret = createScrolledWindow($fixed, ['automatic', 'automatic']);
-
- #- Ugly hacks, don't touch! ########
- my $timeout2 = Gtk->timeout_add(100, sub { $fixed->set_usize($w_ret->allocation->[2] - 22, 0); 0 });
- $w_ret->vscrollbar->set_usize(19, undef);
- gtkset_border_width($w_ret, -2); #- ok, this is very very ugly...
-}
-
-sub ctree_set_icon {
- my ($tree, $node, $icon_pixmap, $icon_mask) = @_;
-
- my ($text, $spacing, undef, undef, undef, undef, $isleaf, $expanded) = $tree->get_node_info($node);
- $tree->set_node_info($node, $text, $spacing, $icon_pixmap, $icon_mask, $icon_pixmap, $icon_mask, $isleaf, $expanded);
-}
-
-sub compute_icons {
- my ($fx, $fy, $decx, $decy, $interstice, @tab) = @_;
- my $nb = $#tab;
- my $nb_sav = $nb;
- my $index = 0;
- my @dx2;
- my @dx;
- my @dy;
- my $line_up = 0;
- bcl_init:
- @dx2 = undef;
- bcl:
- @dx = map{ $_->{dx} } @tab[$index..$index+$nb];
- $dy[$index] = max(map{ $_->{dy} } @tab[$index..$index+$nb]);
- foreach (0..$#dx) {
- if ($dx[$_] > $dx2[$_]) { $dx2[$_] = $dx[$_] } else { $dx[$_] = $dx2[$_] }
- }
- my $line_size = 0;
- $line_size = $decx + sum(@dx2) + $nb * $interstice;
- if ($line_size > $fx) {
- $index = 0; $nb--; goto bcl_init;
- }
- $nb and $line_up = ($fx-$line_size)/($nb+2);
- $index += $nb+1;
- $index <= $#tab and goto bcl;
- my @ret;
- my $n = 0;
- my $y = $decy;
- my $x = $decx/2 + $line_up;
- foreach (0..$nb_sav) {
- $ret[$_] = [$tab[$_], $x, $y];
- $x += $dx2[$n] + $interstice + $line_up;
- $n++;
- if ($n > $nb) {
- $n = 0;
- $x = $decx/2 + $line_up;
- $y += int($dy[$_-$nb]/5)*5 + 15;
- }
- }
- @ret;
-}
-
-sub write_on_pixmap {
- my ($pixmap, $x_pos, $y_pos, @text)=@_;
- my ($gdkpixmap, $gdkmask) = $pixmap->get();
- my ($width, $height) = (440, 250);
- my $gc = Gtk::Gdk::GC->new(gtkroot());
- $gc->set_foreground(gtkcolor(8448, 17664, 40191)); #- in hex : 33, 69, 157
-
- my $darea = new Gtk::DrawingArea();
- $darea->size($width, $height);
- $darea->set_usize($width, $height);
- my $draw = sub {
- my $style = new Gtk::Style;
- #- i18n : you can change the font.
- $style->font(Gtk::Gdk::Font->fontset_load(_("-adobe-times-bold-r-normal--17-*-100-100-p-*-iso8859-*,*-r-*")));
- my $y_pos2 = $y_pos;
- foreach (@text) {
- $darea->window->draw_string($style->font, $gc, $x_pos, $y_pos2, $_);
- $y_pos2 += 20;
- }
- };
- $darea->signal_connect(expose_event => sub { $darea->window->draw_rectangle($darea->style->white_gc, 1, 0, 0, $width, $height);
- $darea->window->draw_pixmap
- ($darea->style->white_gc,
- $gdkpixmap, 0, 0,
- ($darea->allocation->[2]-$width)/2, ($darea->allocation->[3]-$height)/2,
- $width, $height);
- &$draw();
- });
- $darea;
-}
-
-sub n_line_size {
- my ($nbline, $type, $widget) = @_;
- my $font = $widget->style->font;
- my $spacing = ${{ text => 0, various => 17 }}{$type};
- $nbline * ($font->ascent + $font->descent + $spacing) + 8;
-}
+sub flush { gtkflush() }
#-###############################################################################
#- createXXX functions
@@ -732,137 +152,6 @@ sub create_okcancel {
gtkadd(create_hbox($spread), @l);
}
-sub create_box_with_title($@) {
- my $o = shift;
-
- my $nbline = sum(map { round(length($_) / 60 + 1/2) } map { split "\n" } @_);
- my $box = new Gtk::VBox(0,0);
- return $box if $nbline == 0;
-
- $o->{box_size} = n_line_size($nbline, 'text', $box);
- if (@_ <= 2 && $nbline > 4) {
- $o->{icon} && !$::isWizard and
- eval { gtkpack__($box, gtkset_border_width(gtkpack_(new Gtk::HBox(0,0), 1, gtkpng($o->{icon})),5)) };
- my $wanted = $o->{box_size};
- $o->{box_size} = min(200, $o->{box_size});
- my $has_scroll = $o->{box_size} < $wanted;
-
- my $wtext = new Gtk::Text;
- $wtext->can_focus($has_scroll);
- chomp(my $text = join("\n", @_));
- my $scroll = createScrolledWindow(gtktext_insert($wtext, $text));
- $scroll->set_usize(400, $o->{box_size});
- gtkpack__($box, $scroll);
- } else {
- my $a = !$::no_separator;
- undef $::no_separator;
- if ($o->{icon} && !$::isWizard) {
- gtkpack__($box,
- gtkpack_(new Gtk::HBox(0,0),
- 0, gtkset_usize(new Gtk::VBox(0,0), 15, 0),
- 0, eval { gtkpng($o->{icon}) },
- 0, gtkset_usize(new Gtk::VBox(0,0), 15, 0),
- 1, gtkpack_($o->{box_title} = new Gtk::VBox(0,0),
- 1, new Gtk::HBox(0,0),
- (map {
- my $w = ref $_ ? $_ : new Gtk::Label($_);
- $::isWizard and $w->set_justify("left");
- $w->set_name("Title");
- (0, $w);
- } map { ref $_ ? $_ : warp_text($_) } @_),
- 1, new Gtk::HBox(0,0),
- )
- ),
- if_($a, new Gtk::HSeparator)
- )
- } else {
- gtkpack__($box,
- (map {
- my $w = ref $_ ? $_ : new Gtk::Label($_);
- $::isWizard and $w->set_justify("left");
- $w->set_name("Title");
- $w;
- } map { ref $_ ? $_ : warp_text($_) } @_),
- if_($a, new Gtk::HSeparator)
- )
- }
- }
-}
-
-sub createScrolledWindow {
- my ($W, $policy) = @_;
- my $w = new Gtk::ScrolledWindow(undef, undef);
- $policy ||= [ 'automatic', 'automatic'];
- $w->set_policy(@{$policy});
- member(ref $W, qw(Gtk::CList Gtk::CTree Gtk::Text)) ?
- $w->add($W) :
- $w->add_with_viewport($W);
- $W->can("set_focus_vadjustment") and $W->set_focus_vadjustment($w->get_vadjustment);
- $W->show;
- $w
-}
-
-sub create_menu($@) {
- my $title = shift;
- my $w = new Gtk::MenuItem($title);
- $w->set_submenu(gtkshow(gtkappend(new Gtk::Menu, @_)));
- $w
-}
-
-sub add2notebook {
- my ($n, $title, $book) = @_;
-
- my ($w1, $w2) = map { new Gtk::Label($_) } $title, $title;
- $book->{widget_title} = $w1;
- $n->append_page_menu($book, $w1, $w2);
- $book->show;
- $w1->show;
- $w2->show;
-}
-
-sub create_notebook(@) {
- my $n = new Gtk::Notebook;
- add2notebook($n, splice(@_, 0, 2)) while @_;
- $n
-}
-
-sub create_adjustment($$$) {
- my ($val, $min, $max) = @_;
- new Gtk::Adjustment($val, $min, $max + 1, 1, ($max - $min + 1) / 10, 1);
-}
-
-sub create_packtable($@) {
- my ($options, @l) = @_;
- my $w = new Gtk::Table(0, 0, $options->{homogeneous} || 0);
- map_index {
- my ($i, $l) = ($_[0], $_);
- map_index {
- my ($j) = @_;
- if ($_) {
- ref $_ or $_ = new Gtk::Label($_);
- $j != $#$l ?
- $w->attach($_, $j, $j + 1, $i, $i + 1, 'fill', 'fill', 5, 0) :
- $w->attach($_, $j, $j + 1, $i, $i + 1, 1|4, ref($_) eq 'Gtk::ScrolledWindow' ? 1|4 : 0, 0, 0);
- $_->show;
- }
- } @$l;
- } @l;
- $w->set_col_spacings($options->{col_spacings} || 0);
- $w->set_row_spacings($options->{row_spacings} || 0);
- $w
-}
-
-sub create_hbox {
- my $w = gtkset_border_width(new Gtk::HButtonBox, 3);
- $w->set_layout($_[0] || "spread");
- $w;
-}
-sub create_vbox {
- my $w = new Gtk::VButtonBox;
- $w->set_layout(-spread);
- $w;
-}
-
sub _create_window($$) {
my ($o, $title) = @_;
@@ -925,9 +214,9 @@ sub _create_window($$) {
0xffc9 => 'next',
0xffc8 => 'previous' }}{$_[1]{keyval}};
- if ($d eq 'help') {
+ if ($d eq "help") {
require install_gtk;
- install_gtk::create_big_help($::o) if !$o->{disallow_big_help};
+ install_gtk::create_big_help($::o);
} elsif ($::isInstall && $d eq 'screenshot') {
common::take_screenshot($o);
} elsif (chr($_[1]{keyval}) eq 'e' && $_[1]{state} & 8) {
@@ -969,84 +258,6 @@ sub _create_window($$) {
$table and $table->draw(undef);
}
-my ($next_child, $left, $right, $up, $down);
-{
- my $next_child = sub {
- my ($c, $dir) = @_;
-
- my @childs = $c->parent->children;
-
- my $i; for ($i = 0; $i < @childs; $i++) {
- last if $childs[$i] == $c || $childs[$i]->subtree == $c;
- }
- $i += $dir;
- 0 <= $i && $i < @childs ? $childs[$i] : undef;
- };
- $left = sub { &$next_child($_[0]->parent, 0) };
- $right = sub {
- my ($c) = @_;
- if ($c->subtree) {
- $c->expand;
- ($c->subtree->children)[0];
- } else {
- $c;
- }
- };
- $down = sub {
- my ($c) = @_;
- return &$right($c) if ref $c eq "Gtk::TreeItem" && $c->subtree && $c->expanded;
-
- if (my $n = &$next_child($c, 1)) {
- $n;
- } else {
- return if ref $c->parent ne 'Gtk::Tree';
- &$down($c->parent);
- }
- };
- $up = sub {
- my ($c) = @_;
- if (my $n = &$next_child($c, -1)) {
- $n = ($n->subtree->children)[-1] while ref $n eq "Gtk::TreeItem" && $n->subtree && $n->expanded;
- $n;
- } else {
- return if ref $c->parent ne 'Gtk::Tree';
- &$left($c);
- }
- };
-}
-
-sub create_treeitem($) {
- my ($name) = @_;
-
- my $w = new Gtk::TreeItem($name);
- $w->signal_connect(key_press_event => sub {
- my (undef, $e) = @_;
- local $_ = chr ($e->{keyval});
-
- if ($e->{keyval} > 0x100) {
- my $n;
- $n = &$left($w) if /[Q\xb4\x96]/;
- $n = &$right($w) if /[S\xb6\x98]/;
- $n = &$up($w) if /[R\xb8\x97]/;
- $n = &$down($w) if /[T\xb2\x99]/;
- if ($n) {
- $n->focus('up');
- $w->signal_emit_stop("key_press_event");
- }
- $w->expand if /[+\xab]/;
- $w->collapse if /[-\xad]/;
- do {
- $w->expanded ? $w->collapse : $w->expand;
- $w->signal_emit_stop("key_press_event");
- } if /[\r\x8d]/;
- }
- 1;
- });
- $w;
-}
-
-
-
#-###############################################################################
#- ask_XXX
@@ -1132,7 +343,7 @@ sub ask_browse_tree_info {
if ($common->{auto_deps}) {
gtkpack__($l, gtksignal_connect(gtkset_active(new Gtk::CheckButton($common->{auto_deps}), $common->{state}{auto_deps}),
- clicked => sub { invbool \$common->{state}{auto_deps} }));
+ clicked => sub { invbool $common->{state}{auto_deps} }));
}
$l->pack_end(my $status = new Gtk::Label, 0, 1, 20);
diff --git a/perl-install/ugtk.pm b/perl-install/ugtk.pm
new file mode 100644
index 000000000..c186606ee
--- /dev/null
+++ b/perl-install/ugtk.pm
@@ -0,0 +1,835 @@
+package ugtk;
+
+use diagnostics;
+use strict;
+use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $border);
+
+@ISA = qw(Exporter);
+%EXPORT_TAGS = (
+ helpers => [ qw(create_okcancel createScrolledWindow create_menu create_notebook create_packtable create_hbox create_vbox create_adjustment create_box_with_title create_treeitem) ],
+ wrappers => [ qw(gtksignal_connect gtkradio gtkpack gtkpack_ gtkpack__ gtkpack2 gtkpack3 gtkpack2_ gtkpack2__ gtkpowerpack gtkcombo_setpopdown_strings gtkset_editable gtksetstyle gtkset_text gtkset_tip gtkappenditems gtkappend gtkset_shadow_type gtkset_layout gtkset_relief gtkadd gtkput gtktext_insert gtkset_usize gtksize gtkset_justify gtkset_active gtkset_sensitive gtkset_modal gtkset_border_width gtkmove gtkresize gtkshow gtkhide gtkdestroy gtkflush gtkcolor gtkset_mousecursor gtkset_mousecursor_normal gtkset_mousecursor_wait gtkset_background gtkset_default_fontset gtkctree_children gtkxpm gtkpng create_pix_text get_text_coord fill_tiled gtkicons_labels_widget write_on_pixmap gtkcreate_xpm gtkcreate_png gtkbuttonset gtkroot) ],
+ various => [ qw(add2notebook add_icon_path n_line_size) ],
+);
+$EXPORT_TAGS{all} = [ map { @$_ } values %EXPORT_TAGS ];
+@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
+
+my $use_pixbuf;
+my $use_imlib;
+my $use_gnome;
+
+BEGIN {
+ eval { require Gtk::Gdk::Pixbuf; Gtk::Gdk::Pixbuf->init };
+ $use_pixbuf = $@ ? 0 : 1;
+ eval { require Gtk::Gdk::ImlibImage; Gtk::Gdk::ImlibImage->init };
+ $use_imlib = $@ ? 0 : 1;
+ eval { require Gnome };
+ $use_gnome = $@ ? 0 : 1;
+}
+
+use Gtk;
+Gtk->init;
+Gtk->set_locale;
+
+use c;
+use log;
+use common;
+
+my @icon_paths;
+sub add_icon_path { push @icon_paths, @_ }
+sub icon_paths {
+ (@icon_paths, $ENV{SHARE_PATH}, "$ENV{SHARE_PATH}/icons", "$ENV{SHARE_PATH}/libDrakX/pixmaps", "/usr/lib/libDrakX/icons", "pixmaps", 'standalone/icons');
+}
+
+#-#######################
+# gtk widgets wrappers
+#-#######################
+
+sub gtkdestroy($) { $_[0] and $_[0]->destroy }
+sub gtkflush { Gtk->main_iteration while Gtk->events_pending }
+sub gtkhide($) { $_[0]->hide; $_[0] }
+sub gtkmove { $_[0]->window->move($_[1], $_[2]); $_[0] }
+sub gtkpack($@) { gtkpowerpack(1, 1, @_) }
+sub gtkpack_($@) { gtkpowerpack('arg', 1, @_) }
+sub gtkpack__($@) { gtkpowerpack(0, 1, @_) }
+sub gtkpack2($@) { gtkpowerpack(1, 0, @_) }
+sub gtkpack2_($@) { gtkpowerpack('arg', 0, @_) }
+sub gtkpack2__($@) { gtkpowerpack(0, 0, @_) }
+sub gtkpack3 { gtkpowerpack($a?1:0, 0, @_) }
+sub gtkput { $_[0]->put(gtkshow($_[1]), $_[2], $_[3]); $_[0] }
+sub gtkpixmap { new Gtk::Pixmap(gdkpixmap(@_)) }
+sub gtkresize { $_[0]->window->resize($_[1], $_[2]); $_[0] }
+sub gtkset_active($$) { $_[0]->set_active($_[1]); $_[0] }
+sub gtkset_border_width { $_[0]->set_border_width($_[1]); $_[0] }
+sub gtkset_editable { $_[0]->set_editable($_[1]); $_[0] }
+sub gtkset_justify($$) { $_[0]->set_justify($_[1]); $_[0] }
+sub gtkset_layout { $_[0]->set_layout($_[1]); $_[0] }
+sub gtkset_modal { $_[0]->set_modal($_[1]); $_[0] }
+sub gtkset_mousecursor_normal { gtkset_mousecursor(68, @_) }
+sub gtkset_mousecursor_wait { gtkset_mousecursor(150, @_) }
+sub gtkset_relief { $_[0]->set_relief($_[1]); $_[0] }
+sub gtkset_sensitive { $_[0]->set_sensitive($_[1]); $_[0] }
+sub gtkset_tip { $_[0]->set_tip($_[1], $_[2]) if $_[2]; $_[1] }
+sub gtkset_shadow_type { $_[0]->set_shadow_type($_[1]); $_[0] }
+sub gtkset_style { $_[0]->set_style($_[1]); $_[0] }
+sub gtkset_usize($$$) { $_[0]->set_usize($_[1],$_[2]); $_[0] }
+sub gtkshow($) { $_[0]->show; $_[0] }
+sub gtksize($$$) { $_[0]->size($_[1],$_[2]); $_[0] }
+
+sub gdkpixmap {
+ my ($f, $w) = @_;
+ $f =~ m|.png$| and return gtkcreate_png($f);
+ $f =~ m|.xpm$| and return gtkcreate_xpm($w, $f);
+}
+
+sub gtkadd($@) {
+ my $w = shift;
+ foreach (@_) {
+ ref $_ or $_ = new Gtk::Label($_);
+ $w->add($_);
+ $_->show;
+ }
+ $w
+}
+
+sub gtkappend($@) {
+ my $w = shift;
+ foreach (@_) {
+ my $l = $_;
+ ref $l or $l = new Gtk::Label($l);
+ $w->append($l);
+ $l->show;
+ }
+ $w
+}
+
+sub gtkappenditems {
+ my $w = shift;
+ $_->show() foreach @_;
+ $w->append_items(@_);
+ $w
+}
+
+sub gtkbuttonset {
+ gtkdestroy($_[0]->child);
+ gtkadd($_[0], gtkshow($_[1]))
+}
+
+
+sub gtksetstyle {
+ my ($w, $s) = @_;
+ $w->set_style($s);
+ $w;
+}
+
+
+sub gtkcolor {
+ my ($r, $g, $b) = @_;
+ my $color = bless { red => $r, green => $g, blue => $b }, 'Gtk::Gdk::Color';
+ gtkroot()->get_colormap->color_alloc($color);
+}
+
+sub gtkradio {
+ my $def = shift;
+ my $radio;
+ map { $radio = new Gtk::RadioButton($_, $radio ? $radio : ());
+ $radio->set_active($_ eq $def); $radio } @_;
+}
+
+sub gtkroot {
+# Gtk->init;
+# Gtk->set_locale;
+ Gtk::Gdk::Window->new_foreign(Gtk::Gdk->ROOT_WINDOW);
+}
+
+sub gtkset_background {
+ my ($r, $g, $b) = @_;
+ my $root = gtkroot();
+ my $gc = Gtk::Gdk::GC->new($root);
+ my $color = gtkcolor($r, $g, $b);
+ $gc->set_foreground($color);
+ $root->set_background($color);
+ my ($h, $w) = $root->get_size;
+ $root->draw_rectangle($gc, 1, 0, 0, $w, $h);
+}
+
+sub gtktext_insert {
+ my ($w, $t) = @_;
+ $w->freeze;
+ $w->backward_delete($w->get_length);
+ $w->insert(undef, undef, undef, $t);
+ #- DEPRECATED? needs \n otherwise in case of one line text the beginning is not shown (even with the vadj->set_value)
+ $w->set_word_wrap(1);
+#- $w->vadj->set_value(0);
+ $w->thaw;
+ $w;
+}
+
+sub gtkset_text {
+ my ($w, $s) = @_;
+ $w->set_text($s);
+ $w;
+}
+
+sub gtkcombo_setpopdown_strings ($@) {
+ my $w = shift;
+ $w->set_popdown_strings(@_);
+ $w;
+}
+
+sub gtkappend_text {
+ my ($w, $s) = @_;
+ $w->append_text($s);
+ $w;
+}
+
+sub gtkprepend_text {
+ my ($w, $s) = @_;
+ $w->prepend_text($s);
+ $w;
+}
+
+sub gtkset_mousecursor {
+ my ($type, $w) = @_;
+ ($w || gtkroot())->set_cursor(Gtk::Gdk::Cursor->new($type));
+}
+
+sub gtksignal_connect($@) {
+ my $w = shift;
+ $w->signal_connect(@_);
+ $w;
+}
+
+#-#######################
+# create widgets wrappers
+#-#######################
+
+sub create_adjustment($$$) {
+ my ($val, $min, $max) = @_;
+ new Gtk::Adjustment($val, $min, $max + 1, 1, ($max - $min + 1) / 10, 1);
+}
+
+sub create_box_with_title($@) {
+ my $o = shift;
+
+ my $nbline = sum(map { round(length($_) / 60 + 1/2) } map { split "\n" } @_);
+ my $box = new Gtk::VBox(0,0);
+ return $box if $nbline == 0;
+
+ $o->{box_size} = n_line_size($nbline, 'text', $box);
+ if (@_ <= 2 && $nbline > 4) {
+ $o->{icon} && !$::isWizard and
+ eval { gtkpack__($box, gtkset_border_width(gtkpack_(new Gtk::HBox(0,0), 1, gtkpng($o->{icon})),5)) };
+ my $wanted = $o->{box_size};
+ $o->{box_size} = min(200, $o->{box_size});
+ my $has_scroll = $o->{box_size} < $wanted;
+
+ my $wtext = new Gtk::Text;
+ $wtext->can_focus($has_scroll);
+ chomp(my $text = join("\n", @_));
+ my $scroll = createScrolledWindow(gtktext_insert($wtext, $text));
+ $scroll->set_usize(400, $o->{box_size});
+ gtkpack__($box, $scroll);
+ } else {
+ my $a = !$::no_separator;
+ undef $::no_separator;
+ if ($o->{icon} && !$::isWizard) {
+ gtkpack__($box,
+ gtkpack_(new Gtk::HBox(0,0),
+ 0, gtkset_usize(new Gtk::VBox(0,0), 15, 0),
+ 0, eval { gtkpng($o->{icon}) },
+ 0, gtkset_usize(new Gtk::VBox(0,0), 15, 0),
+ 1, gtkpack_($o->{box_title} = new Gtk::VBox(0,0),
+ 1, new Gtk::HBox(0,0),
+ (map {
+ my $w = ref $_ ? $_ : new Gtk::Label($_);
+ $::isWizard and $w->set_justify("left");
+ $w->set_name("Title");
+ (0, $w);
+ } map { ref $_ ? $_ : warp_text($_) } @_),
+ 1, new Gtk::HBox(0,0),
+ )
+ ),
+ if_($a, new Gtk::HSeparator)
+ )
+ } else {
+ gtkpack__($box,
+ (map {
+ my $w = ref $_ ? $_ : new Gtk::Label($_);
+ $::isWizard and $w->set_justify("left");
+ $w->set_name("Title");
+ $w;
+ } map { ref $_ ? $_ : warp_text($_) } @_),
+ if_($a, new Gtk::HSeparator)
+ )
+ }
+ }
+}
+
+sub create_hbox { gtkset_layout(gtkset_border_width(new Gtk::HButtonBox, 3), $_[0] || 'spread') }
+
+sub create_menu($@) {
+ my $title = shift;
+ my $w = new Gtk::MenuItem($title);
+ $w->set_submenu(gtkshow(gtkappend(new Gtk::Menu, @_)));
+ $w
+}
+
+sub create_notebook(@) {
+ my $n = new Gtk::Notebook;
+ add2notebook($n, splice(@_, 0, 2)) while @_;
+ $n
+}
+
+sub create_packtable($@) {
+ my ($options, @l) = @_;
+ my $w = new Gtk::Table(0, 0, $options->{homogeneous} || 0);
+ map_index {
+ my ($i, $l) = ($_[0], $_);
+ map_index {
+ my ($j) = @_;
+ if ($_) {
+ ref $_ or $_ = new Gtk::Label($_);
+ $j != $#$l ?
+ $w->attach($_, $j, $j + 1, $i, $i + 1, 'fill', 'fill', 5, 0) :
+ $w->attach($_, $j, $j + 1, $i, $i + 1, 1|4, ref($_) eq 'Gtk::ScrolledWindow' ? 1|4 : 0, 0, 0);
+ $_->show;
+ }
+ } @$l;
+ } @l;
+ $w->set_col_spacings($options->{col_spacings} || 0);
+ $w->set_row_spacings($options->{row_spacings} || 0);
+ $w
+}
+
+sub createScrolledWindow {
+ my ($W, $policy) = @_;
+ my $w = new Gtk::ScrolledWindow(undef, undef);
+ $policy ||= [ 'automatic', 'automatic'];
+ $w->set_policy(@{$policy});
+ member(ref $W, qw(Gtk::CList Gtk::CTree Gtk::Text)) ?
+ $w->add($W) :
+ $w->add_with_viewport($W);
+ $W->can("set_focus_vadjustment") and $W->set_focus_vadjustment($w->get_vadjustment);
+ $W->show;
+ $w
+}
+
+sub create_treeitem($) {
+ my ($name) = @_;
+
+ my ($next_child, $left, $right, $up, $down);
+ $next_child = sub {
+ my ($c, $dir) = @_;
+ my @childs = $c->parent->children;
+ my $i; for ($i = 0; $i < @childs; $i++) { last if $childs[$i] == $c || $childs[$i]->subtree == $c }
+ $i += $dir;
+ 0 <= $i && $i < @childs ? $childs[$i] : undef;
+ };
+ $left = sub { &$next_child($_[0]->parent, 0) };
+ $right = sub { my ($c) = @_; $c->subtree and $c->expand, return ($c->subtree->children)[0]; $c };
+ $down = sub {
+ my ($c) = @_;
+ return &$right($c) if ref $c eq "Gtk::TreeItem" && $c->subtree && $c->expanded;
+ if (my $n = &$next_child($c, 1)) {
+ $n;
+ } else {
+ return if ref $c->parent ne 'Gtk::Tree';
+ &$down($c->parent);
+ }
+ };
+ $up = sub {
+ my ($c) = @_;
+ if (my $n = &$next_child($c, -1)) {
+ $n = ($n->subtree->children)[-1] while ref $n eq "Gtk::TreeItem" && $n->subtree && $n->expanded;
+ $n;
+ } else {
+ return if ref $c->parent ne 'Gtk::Tree';
+ &$left($c);
+ }
+ };
+ my $w = new Gtk::TreeItem($name);
+ $w->signal_connect(key_press_event => sub {
+ my (undef, $e) = @_;
+ local $_ = chr ($e->{keyval});
+
+ if ($e->{keyval} > 0x100) {
+ my $n;
+ $n = &$left($w) if /[Q\xb4\x96]/;
+ $n = &$right($w) if /[S\xb6\x98]/;
+ $n = &$up($w) if /[R\xb8\x97]/;
+ $n = &$down($w) if /[T\xb2\x99]/;
+ if ($n) {
+ $n->focus('up');
+ $w->signal_emit_stop("key_press_event");
+ }
+ $w->expand if /[+\xab]/;
+ $w->collapse if /[-\xad]/;
+ do {
+ $w->expanded ? $w->collapse : $w->expand;
+ $w->signal_emit_stop("key_press_event");
+ } if /[\r\x8d]/;
+ }
+ 1;
+ });
+ $w;
+}
+
+sub create_vbox { gtkset_layout(new Gtk::VButtonBox, $_[0] || 'spread') }
+
+#-#######################
+# public gtk routines
+#-#######################
+
+sub add2notebook {
+ my ($n, $title, $book) = @_;
+ my ($w1, $w2) = map { new Gtk::Label($_) } $title, $title;
+ $book->{widget_title} = $w1;
+ $n->append_page_menu($book, $w1, $w2);
+ $book->show;
+ $w1->show;
+ $w2->show;
+}
+
+
+sub ctree_set_icon {
+ my ($tree, $node, $icon_pixmap, $icon_mask) = @_;
+
+ my ($text, $spacing, undef, undef, undef, undef, $isleaf, $expanded) = $tree->get_node_info($node);
+ $tree->set_node_info($node, $text, $spacing, $icon_pixmap, $icon_mask, $icon_pixmap, $icon_mask, $isleaf, $expanded);
+}
+
+sub get_text_coord {
+ my ($text, $widget4style, $max_width, $max_height, $can_be_greater, $can_be_smaller, $centeredx, $centeredy, $wrap_char) = @_;
+ $wrap_char ||= ' ';
+ my $idx = 0;
+ my $real_width = 0;
+ my $real_height = 0;
+ my @lines;
+ my @widths;
+ my @heights;
+ my $height_elem = $widget4style->style->font->ascent + $widget4style->style->font->descent;
+ $heights[0] = 0;
+ my $max_width2 = $max_width;
+ my $height = $heights[0] = $height_elem;
+ my $width = 0;
+ my $flag = 1;
+ my @t = split($wrap_char, $text);
+ my @t2;
+ if ($::isInstall && $::o->{lang} =~ /ja|zh/) {
+ @t = map { $_ . $wrap_char } @t;
+ $wrap_char = '';
+ foreach (@t) {
+ my @c = split('');
+ my $i = 0;
+ my $el = '';
+ while (1) {
+ $i >= @c and last;
+ $el .= $c[$i];
+ if (ord($c[$i]) >= 128) { $el .= $c[$i+1]; $i++; push @t2, $el; $el = '' }
+ $i++;
+ }
+ $el ne '' and push @t2, $el;
+ }
+ } else {
+ @t2 = @t;
+ }
+ foreach (@t2) {
+ my $l = $widget4style->style->font->string_width($_ . (!$flag ? $wrap_char : ''));
+ if ($width + $l > $max_width2 && !$flag) {
+ $flag = 1;
+ $height += $height_elem + 1;
+ $heights[$idx+1] = $height;
+ $widths[$idx] = $centeredx && !$can_be_smaller ? (max($max_width2-$width, 0))/2 : 0;
+ $width = 0;
+ $idx++;
+ }
+ $lines[$idx] = $flag ? $_ : $lines[$idx] . $wrap_char . $_;
+ $width += $l;
+ $flag = 0;
+ $l <= $max_width2 or $max_width2 = $l;
+ $width <= $real_width or $real_width = $width;
+ }
+ $height += $height_elem;
+ $widths[$idx] = $centeredx && !$can_be_smaller ? (max($max_width2-$width, 0))/2 : 0;
+
+ $height < $real_height or $real_height = $height;
+ $width = $max_width;
+ $height = $max_height;
+ $real_width < $max_width && $can_be_smaller and $width = $real_width;
+ $real_width > $max_width && $can_be_greater and $width = $real_width;
+ $real_height < $max_height && $can_be_smaller and $height = $real_height;
+ $real_height > $max_height && $can_be_greater and $height = $real_height;
+ if ($centeredy) {
+ my $dh = ($height-$real_height)/2 + ($height_elem)/2;
+ @heights = map { $_ + $dh } @heights;
+ }
+ ($width, $height, \@lines, \@widths, \@heights)
+}
+
+sub gtkicons_labels_widget {
+ my ($args, $w, $color_text, $widget_for_font, $background, $x_back, $y_back, $x_round,
+ $y_round, $x_back2, $y_back2, $icon_width, $icon_height, $exec_func, $exec_hash) = @_;
+
+ my @tab;
+ my $i = 0;
+ my $cursor_hand = new Gtk::Gdk::Cursor 60;
+ my $cursor_normal = new Gtk::Gdk::Cursor 68;
+ foreach (@$args) {
+ my $label = $_->[0];
+ my $dbl_area;
+ my $darea = new Gtk::DrawingArea;
+ my ($icon, undef) = gtkcreate_png($_->[1]);
+ my ($icon_h, undef) = gtkcreate_png("$_->[1]_highlight");
+
+ my $imlib_icon_h;
+ my $imlib_counter = 0;
+ my $imlib_counter_add = 1;
+ my $imlib_icon_h_width;
+ my $imlib_icon_h_height;
+ my $imlib_render;
+ my $imlib_timeout;
+
+ if ($use_imlib) {
+ $imlib_icon_h = gtkcreate_imlib("$_->[1]_highlight");
+ $imlib_icon_h_width = $imlib_icon_h->rgb_width;
+ $imlib_icon_h_height = $imlib_icon_h->rgb_height;
+ $imlib_render = sub {
+ $imlib_icon_h->set_image_modifier({'gamma' => 256 + $imlib_counter * 30, 'contrast' => 256, 'brightness' => 256});
+ $imlib_icon_h->render($imlib_icon_h_width, $imlib_icon_h_height);
+ $imlib_counter += $imlib_counter_add;
+ $imlib_counter == 5 || $imlib_counter == 0 and $imlib_counter_add = -$imlib_counter_add;
+ $imlib_icon_h->move_image;
+ };
+ }
+
+ $darea->{state} = 0;
+ $darea->signal_connect(expose_event => sub {
+ my ($dx, $dy) = ($darea->allocation->[2], $darea->allocation->[3]);
+ if (!defined($dbl_area) || $darea->{state} != $dbl_area->{state}) {
+ my $state = $darea->{state};
+ my ($pix, $width, $height) = create_pix_text($darea, $label, $color_text, $widget_for_font->style->font, $x_round, 1,
+ 1, 0, $background, $x_back2, $y_back2, 1, 0, $state);
+ ($dx, $dy) = (max($width, $x_round), $y_round + $height);
+ $darea->set_usize($dx, $dy);
+ $dbl_area = new Gtk::Gdk::Pixmap($darea->window, max($width, $x_round), $y_round + $height);
+ $dbl_area->{state} = $darea->{state};
+ fill_tiled($darea, $dbl_area, $background, $x_back2, $y_back2, $dx, $dy);
+ $use_imlib and $icon_h = $imlib_render->();
+ $dbl_area->draw_pixmap($darea->style->bg_gc('normal'),
+ $darea->{state} ? $icon_h : $icon, 0, 0, ($dx - $icon_width)/2, 0, $icon_width, $icon_height);
+ $dbl_area->draw_pixmap($darea->style->bg_gc('normal'),
+ $pix, 0, 0, ($dx - $width)/2, $y_round, $width, $height);
+# $dbl_area->draw_rectangle($darea->style->black_gc, 0,
+# 0, 0, max($width, $x_round) - 1 , $y_round + $height - 1);
+ }
+ $darea->window->draw_pixmap($darea->style->bg_gc('normal'),
+ $dbl_area, 0, 0, 0, 0, $dx, $dy);
+# $darea->window->draw_rectangle($darea->style->black_gc, 0,
+# 0, 0, $dx, $dy);
+ ($darea->{dx}, $darea->{dy}) = ($dx, $dy);
+ });
+ $darea->set_events(['exposure_mask', 'enter_notify_mask', 'leave_notify_mask', 'button_press_mask', 'button_release_mask' ]);
+ $darea->signal_connect(enter_notify_event => sub {
+ if ($darea->{state} == 0) {
+ $darea->{state} = 1;
+ $darea->draw(undef);
+ $imlib_counter = 0;
+ $imlib_counter_add = 1;
+ $use_imlib and $imlib_timeout = Gtk->timeout_add(100, sub { $dbl_area = undef; $darea->draw(undef); 1; });
+ }
+ });
+ $darea->signal_connect(leave_notify_event => sub {
+ if ($darea->{state} == 1) {
+ $darea->{state} = 0;
+ $darea->draw(undef);
+ $use_imlib and Gtk->timeout_remove($imlib_timeout);
+ }
+ });
+ my $label_exec = $_->[0];
+ $darea->signal_connect(button_release_event => sub {
+ $darea->{state} = 0;
+ $darea->draw(undef);
+ $exec_func->($exec_hash->{$label_exec});
+# $exec_hash->{$label_exec}{function}->($exec_hash->{$label_exec}{arg});
+ });
+ $darea->signal_connect(realize => sub { $darea->window->set_cursor($cursor_hand) });
+ $tab[$i] = $darea;
+ $i++;
+ }
+ my $fixed = new Gtk::Fixed;
+ foreach (@tab) { $fixed->put($_, 75, 65) }
+ my $redraw_function = sub {
+ $fixed->move(@$_) foreach compute_icons($fixed->allocation->[2], $fixed->allocation->[3], 40, 15, 20, @tab);
+ };
+ $fixed->signal_connect(expose_event => $redraw_function);
+ $fixed->signal_connect(realize => sub {
+ $fixed->window->set_back_pixmap($background, 0);
+ $redraw_function->();
+ });
+ $fixed->{redraw_function} = $redraw_function;
+ $fixed->show_all();
+ my $w_ret = createScrolledWindow($fixed, ['automatic', 'automatic']);
+
+ #- Ugly hacks, don't touch! ########
+ my $timeout2 = Gtk->timeout_add(100, sub { $fixed->set_usize($w_ret->allocation->[2] - 22, 0); 0 });
+ $w_ret->vscrollbar->set_usize(19, undef);
+ gtkset_border_width($w_ret, -2); #- ok, this is very very ugly...
+}
+
+sub n_line_size {
+ my ($nbline, $type, $widget) = @_;
+ my $font = $widget->style->font;
+ my $spacing = ${{ text => 0, various => 17 }}{$type};
+ $nbline * ($font->ascent + $font->descent + $spacing) + 8;
+}
+
+sub write_on_pixmap {
+ my ($pixmap, $x_pos, $y_pos, @text)=@_;
+ my ($gdkpixmap, $gdkmask) = $pixmap->get();
+ my ($width, $height) = (440, 250);
+ my $gc = Gtk::Gdk::GC->new(gtkroot());
+ $gc->set_foreground(gtkcolor(8448, 17664, 40191)); #- in hex : 33, 69, 157
+
+ my $darea = new Gtk::DrawingArea();
+ $darea->size($width, $height);
+ $darea->set_usize($width, $height);
+ my $draw = sub {
+ my $style = new Gtk::Style;
+ #- i18n : you can change the font.
+ $style->font(Gtk::Gdk::Font->fontset_load(_("-adobe-times-bold-r-normal--17-*-100-100-p-*-iso8859-*,*-r-*")));
+ my $y_pos2 = $y_pos;
+ foreach (@text) {
+ $darea->window->draw_string($style->font, $gc, $x_pos, $y_pos2, $_);
+ $y_pos2 += 20;
+ }
+ };
+ $darea->signal_connect(expose_event => sub { $darea->window->draw_rectangle($darea->style->white_gc, 1, 0, 0, $width, $height);
+ $darea->window->draw_pixmap
+ ($darea->style->white_gc,
+ $gdkpixmap, 0, 0,
+ ($darea->allocation->[2]-$width)/2, ($darea->allocation->[3]-$height)/2,
+ $width, $height);
+ &$draw();
+ });
+ $darea;
+}
+
+#-#######################
+# kind of private gtk routines
+#-#######################
+
+sub create_pix_text {
+ #ref widget, txt, color_txt, [font], [width], [height], flag1, flag2, [background, backsize x y], centeredx, centeredy, bold
+ my ($w, $text, $color_text, $font, $max_width, $max_height, $can_be_greater, $can_be_smaller, $background, $x_back, $y_back, $centeredx, $centeredy, $bold) = @_;
+ my $color_background;
+ my $backpix;
+ if ($color_text =~ /#(\d+)#(\d+)#(\d+)/) { $color_text = gtkcolor(map{$_*65535/255}($1, $2, $3)) }
+ if (ref($background) eq 'Gtk::Gdk::Color') { $color_background = $background }
+ elsif ($background =~ /#(\d+)#(\d+)#(\d+)/) { $color_background = gtkcolor(map{$_*65535/255}($1, $2, $3)) }
+ elsif (ref($background) eq 'Gtk::Gdk::Pixmap' && $x_back && $y_back) { $backpix = 1 }
+ my $fake_darea = new Gtk::DrawingArea;
+ my $style = $fake_darea->style->copy();
+ if (ref($font) eq 'Gtk::Gdk::Font') {
+ $style->font($font);
+ } else {
+ $font and $style->font(Gtk::Gdk::Font->fontset_load($font));
+ }
+ $fake_darea->set_style($style);
+ my ($width, $height, $lines, $widths, $heights) = get_text_coord (
+ $text, $fake_darea, $max_width, $max_height, $can_be_greater, $can_be_smaller, $centeredx, $centeredy);
+ my $pix = new Gtk::Gdk::Pixmap($w->window, $width, $height);
+
+ if ($backpix) {
+ fill_tiled($w, $pix, $background, $x_back, $y_back, $width, $height);
+ } else {
+ $color_background ||= gtkcolor(65535, 65535, 65535);
+ my $gc_background = new Gtk::Gdk::GC($w->window);
+ $gc_background->set_foreground($color_background);
+ $pix->draw_rectangle($gc_background, 1, 0, 0, $width, $height);
+ }
+ $color_text ||= gtkcolor(0, 0, 0);
+ my $gc_text = new Gtk::Gdk::GC($w->window);
+ $gc_text->set_foreground($color_text);
+ my $i = 0;
+ foreach (@{$lines}) {
+ $pix->draw_string($style->font, $gc_text, ${$widths}[$i], ${$heights}[$i], $_);
+ $bold and $pix->draw_string($style->font, $gc_text, ${$widths}[$i] + 1, ${$heights}[$i], $_);
+ $i++;
+ }
+ ($pix, $width, $height);
+}
+
+sub gtkctree_children {
+ my ($node) = @_;
+ my @l;
+ $node or return;
+ for (my $p = $node->row->children; $p; $p = $p->row->sibling) {
+ push @l, $p;
+ }
+ @l;
+}
+
+
+
+
+sub gtkpowerpack {
+ #- Get Default Attributes (if any). 2 syntaxes allowed :
+ #- gtkpowerpack( {expand => 1, fill => 0}, $box...) : the attributes are picked from a specified hash ref
+ #- gtkpowerpack(1,0,1, $box, ...) : the attributes are picked from the non-ref list, in the order (expand, fill, padding, pack_end).
+ my $RefDefaultAttrs;
+ if (ref($_[0]) eq 'HASH') { $RefDefaultAttrs = shift }
+ elsif (!ref($_[0])) {
+ $RefDefaultAttrs = {};
+ foreach ("expand", "fill", "padding", "pack_end") {
+ !ref($_[0]) ? $RefDefaultAttrs->{$_} = shift : last
+ }
+ }
+ my $box = shift;
+
+ while (@_) {
+ #- Get attributes (if specified). 4 syntaxes allowed (default values are undef ie. false...) :
+ #- gtkpowerpack({defaultattrs}, $box, $widget1, $widget2, ...) : the attrs are picked from the default ones (if they exist)
+ #- gtkpowerpack($box, {fill=>1, expand=>0, ...}, $widget1, ...) : the attributes are picked from a specified hash ref
+ #- gtkpowerpack($box, [1,0,1], $widget1, ...) : the attributes are picked from the array ref : (expand, fill, padding, pack_end).
+ #- gtkpowerpack({attr=>'arg'}, $box, 1, $widget1, 0, $widget2, etc...) : the 'arg' value will tell gtkpowerpack to always read the
+ #- attr value directly in the arg list (avoiding confusion between value 0 and Gtk::Label("0"). That can simplify some writings but
+ #- this arg(s) MUST then be present...
+ my %attr;
+ my $RefAttrs;
+ ref($_[0]) eq 'HASH' || ref($_[0]) eq 'ARRAY' and $RefAttrs = shift;
+ foreach ("expand", "fill", "padding", "pack_end") {
+ if ($RefDefaultAttrs->{$_} eq 'arg') {
+ ref ($_[0]) and die "error in packing definition\n";
+ $attr{$_} = shift;
+ ref($RefAttrs) eq 'ARRAY' and shift @$RefAttrs;
+ } elsif (ref($RefAttrs) eq 'HASH' && defined($RefAttrs->{$_})) {
+ $attr{$_} = $RefAttrs->{$_};
+ } elsif (ref($RefAttrs) eq 'ARRAY') {
+ $attr{$_} = shift @$RefAttrs;
+ } elsif (defined($RefDefaultAttrs->{$_})) {
+ $attr{$_} = int $RefDefaultAttrs->{$_};
+ } else {
+ $attr{$_} = 0;
+ }
+ }
+ #- Get and pack the widget (create it if necessary when it is a label...)
+ my $widget = ref($_[0]) ? shift : new Gtk::Label(shift);
+ if ($attr{pack_end}) { $box->pack_end($widget, $attr{expand}, $attr{fill}, $attr{padding})}
+ else { $box->pack_start($widget, $attr{expand}, $attr{fill}, $attr{padding}) }
+ $widget->show;
+ }
+ $box
+}
+
+sub gtkset_default_fontset {
+ my ($fontset) = @_;
+ my $style = Gtk::Widget->get_default_style;
+ my $f = Gtk::Gdk::Font->fontset_load($fontset) or die '';
+ $style->font($f);
+ Gtk::Widget->set_default_style($style);
+}
+
+sub gtkcreate_imlib {
+ my ($f) = shift;
+ $f =~ m|.png$| or $f="$f.png";
+ if ( $f !~ /\//) { -e "$_/$f" and $f="$_/$f", last foreach icon_paths() }
+ Gtk::Gdk::ImlibImage->load_image($f);
+}
+
+sub gtkxpm { new Gtk::Pixmap(gtkcreate_xpm(@_)) }
+sub gtkpng { new Gtk::Pixmap(gtkcreate_png(@_)) }
+sub gtkcreate_xpm {
+ my ($f) = @_;
+ my $rw = gtkroot();
+ $f =~ m|.xpm$| or $f = "$f.xpm";
+ if ($f !~ /\//) { -e "$_/$f" and $f = "$_/$f", last foreach icon_paths() }
+ my @l = Gtk::Gdk::Pixmap->create_from_xpm($rw, new Gtk::Style->bg('normal'), $f) or die "gtkcreate_xpm: missing pixmap file $f";
+ @l;
+}
+
+sub gtkcreate_png {
+ my ($f) = shift;
+ $f =~ m|.png$| or $f="$f.png";
+ if ($f !~ /\//) { -e "$_/$f" and $f="$_/$f", last foreach icon_paths() }
+ if ($use_pixbuf) {
+ print " - ugtk - INFO : rendering using gdkpixbuff\n";
+ my $pixbuf = Gtk::Gdk::Pixbuf->new_from_file($f) or die "gtkcreate_png: missing png file $f";
+ my ($width, $height) = ($pixbuf->get_width(), $pixbuf->get_height);
+ my $rw = gtkroot();
+ my $pix = new Gtk::Gdk::Pixmap($rw, $width, $height, 16);
+ $pixbuf->render_to_drawable_alpha($pix, 0, 0, 0, 0, $width, $height, 'bilevel', 127, 'normal', 0, 0);
+ my $bit = new Gtk::Gdk::Bitmap($rw, $width, $height, 1);
+ $pixbuf->render_threshold_alpha($bit, 0, 0, 0, 0, $width, $height, '127');
+ return ($pix, $bit);
+ } elsif ($use_imlib) {
+ print " - ugtk - INFO : rendering using imlib1\n";
+ my $im = Gtk::Gdk::ImlibImage->load_image($f) or die "gtkcreate_png: missing png file $f";
+ $im->render($im->rgb_width, $im->rgb_height);
+ return ($im->move_image(), $im->move_mask);
+ } else {
+ print " - ugtk - CRITICAL : no suitable library found\n";
+ die "gtkcreate_png: cannot find a suitable library for rendering png (imlib1 or gdk_pixbuf)";
+ }
+}
+
+sub xpm_d { my $w = shift; Gtk::Gdk::Pixmap->create_from_xpm_d($w->window, undef, @_) }
+
+sub fill_tiled {
+ my ($w, $pix, $bitmap, $x_back, $y_back, $width, $height) = @_;
+ my ($x2, $y2) = (0, 0);
+ while (1) {
+ $x2 = 0;
+ while (1) {
+ $pix->draw_pixmap($w->style->bg_gc('normal'),
+ $bitmap, 0, 0, $x2, $y2, $x_back, $y_back);
+ $x2 += $x_back;
+ $x2 >= $width and last;
+ }
+ $y2 += $y_back;
+ $y2 >= $height and last;
+ }
+}
+
+sub compute_icons {
+ my ($fx, $fy, $decx, $decy, $interstice, @tab) = @_;
+ my $nb = $#tab;
+ my $nb_sav = $nb;
+ my $index = 0;
+ my @dx2;
+ my @dx;
+ my @dy;
+ my $line_up = 0;
+ bcl_init:
+ @dx2 = undef;
+ bcl:
+ @dx = map{ $_->{dx} } @tab[$index..$index+$nb];
+ $dy[$index] = max(map{ $_->{dy} } @tab[$index..$index+$nb]);
+ foreach (0..$#dx) {
+ if ($dx[$_] > $dx2[$_]) { $dx2[$_] = $dx[$_] } else { $dx[$_] = $dx2[$_] }
+ }
+ my $line_size = 0;
+ $line_size = $decx + sum(@dx2) + $nb * $interstice;
+ if ($line_size > $fx) {
+ $index = 0; $nb--; goto bcl_init;
+ }
+ $nb and $line_up = ($fx-$line_size)/($nb+2);
+ $index += $nb+1;
+ $index <= $#tab and goto bcl;
+ my @ret;
+ my $n = 0;
+ my $y = $decy;
+ my $x = $decx/2 + $line_up;
+ foreach (0..$nb_sav) {
+ $ret[$_] = [$tab[$_], $x, $y];
+ $x += $dx2[$n] + $interstice + $line_up;
+ $n++;
+ if ($n > $nb) {
+ $n = 0;
+ $x = $decx/2 + $line_up;
+ $y += int($dy[$_-$nb]/5)*5 + 15;
+ }
+ }
+ @ret;
+}
+
+1;