Gtk-Perl
view release on metacpan or search on metacpan
Gtk/samples/gslide.pl view on Meta::CPAN
#!/usr/bin/perl -w
# Copyright 1998 Paolo Molaro <lupus@debian.org>
# This is GPL'ed code.
# TITLE: Slide
# REQUIRES: Gtk GkdImlib
use Gtk;
use Gtk::Gdk::ImlibImage;
use Gtk::Keysyms;
use Getopt::Std;
sub update_all;
sub do_page;
$opt_w = 640;
$opt_h = 480;
getopts('w:h:d:');
init Gtk;
init Gtk::Gdk::ImlibImage;
%images = ();
%fonts = ();
# get a window
$gtkwin = new Gtk::Window -toplevel;
$gtkwin->set("GtkWidget::app_paintable" => 1);
$gtkwin->set_events(['button_press_mask', 'key_press_mask']);
$width = $opt_w;
$height = $opt_h;
$gtkwin->set_usize($width, $height);
$gtkwin->set_uposition(0, 0);
$gtkwin->realize;
$gtkwin->set_policy(0, 0, 0);
$win = $gtkwin->window;
$win->set_decorations('border');
# Setup a backing pixmap and the GC to use when drawing
(undef, undef, undef, undef, $depth) = $win->get_geometry;
$bp = new Gtk::Gdk::Pixmap($win, $width, $height, $depth);
$gc = new Gtk::Gdk::GC ($win);
$colormap = $win->get_colormap;
$gc->set_foreground($colormap->color_white());
$bp->draw_rectangle($gc, 1, 0, 0, $width, $height);
# Events we care about
$gtkwin->signal_connect('button_press_event', sub {
my ($w, $e)= @_;
if ($e->{'button'} == 1) {Gtk->main_quit;}
elsif ($e->{'button'} == 2) {Gtk->exit(0);}
else {show_menu()}
return 1;
});
$gtkwin->signal_connect('key_press_event', sub {
my ($w, $e)= @_;
# little test for Gtk::Keysyms
print "Got control\n" if $e->{'keyval'} == $Gtk::Keysyms{'Control_L'};
my ($c) = chr($e->{'keyval'});
if ($c eq "n" || $c eq " ") {Gtk->main_quit;}
elsif ($c eq "q") {Gtk->exit(0);}
else {show_menu()}
return 1;
});
$gtkwin->signal_connect('delete_event', sub {Gtk->exit(0);});
$gtkwin->signal_connect('expose_event', sub {
my ($w, $e) = @_;
my ($x, $y, $wi, $h) = @{$e->{'area'}};
$win->draw_pixmap($gc, $bp, $x, $y, $x, $y, $wi, $h);
});
# preprocess slide data
Gtk/samples/gslide.pl view on Meta::CPAN
$c = $colormap->color_alloc($c);
$gc->set_background($c);
} elsif (/^evalx\s*(.+)/) {
$_ = eval $1;
if ( $@ ) {
warn $@;
} else {
goto START;
}
} elsif (/^eval\s*(.+)/) {
eval $1;
warn $@ if $@;
} elsif (/^define\s+(\w+)/) {
$in_group = $1;
$group{$in_group} = [];
} elsif (/^cmd\s+(\w+)(\s+(.*))?/) {
push(@group, @{$group{$1}});
$arg = $3;
eval $3;
warn $@ if $@;
} elsif (/^slide\s+(.+)?/) {
$slides{$i - 1} = $1;
$curx = $cury = 0;
if ( !$started ) {
$started = 1;
$gtkwin->show;
} else {
update_all();
do_page;
}
$gtkwin->set_title($1) if defined $1;
} elsif (/^rect\s*([fe])\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)$/) {
$bp->draw_rectangle($gc, $1 eq 'f', $2, $3, $4, $5);
} elsif (/^line\s*(\d+)\s+(\d+)\s+(\d+)\s+(\d+)$/) {
$bp->draw_line($gc, $1, $2, $3, $4);
} elsif (/^skip\s*([+-]?\d+)\s+([+-]?\d+)$/) {
$curx += $1;
$cury += $2;
} elsif (/^put\s*([clrn])\s+(.*)/) {
$cury += $font->ascent + $font->descent unless ($1 eq 'n');
my ($sw) = $font->string_width($2);
if ( $1 eq 'c' ) {
$curx = $width/2 - $sw/2;
} elsif ( $1 eq 'r' ) {
$curx = $width - $xoffset - $sw;
} elsif ( $1 eq 'l' ) {
$curx = $xoffset;
}
$bp->draw_string($font, $gc, $curx, $cury, $2);
$curx += $sw+$font->string_width(" ");
} elsif (/^puts\s*(\d+)\s+(\d+)\s+(.*)/) {
$bp->draw_string($font, $gc, $1, $2, $3);
} else {
warn "Command not understood: $_\n"
}
}
do_page;
Gtk->exit(0);
sub update_all {
$win->draw_pixmap($gc, $bp, 0, 0, 0, 0, $width, $height);
}
sub do_page {
$page = $i; # FIXME
if ( defined $opt_d ) {
print "Running convert ". $win->XWINDOW . " to $opt_d\n";
system("convert x:". $win->XWINDOW ." slide$page.$opt_d");
}
Gtk->main;
}
sub set_font {
my ($w, $n) = @_;
my ($fs) = new Gtk::FontSelectionDialog("Changing font: $n");
$fs->set_font_name($fonts{$n}->[1]);
$fs->cancel_button->signal_connect('clicked', sub {$fs->destroy});
$fs->ok_button->signal_connect('clicked', sub {
$fonts{$n} = [$fs->get_font, $fs->get_font_name];
$fs->destroy
});
$fs->show;
}
sub get_fonts {
my ($m, $mi, $i);
$m = new Gtk::Menu;
foreach $i (sort keys %fonts) {
$mi = new Gtk::MenuItem($i);
$mi->show;
$m->append($mi);
$mi->signal_connect('activate', \&set_font, $i);
}
return $m;
}
sub show_menu {
my ($x, $y, $button) = @_;
my ($m, $mi, $index);
$m = new Gtk::Menu;
$mi = new Gtk::MenuItem('Quit');
$mi->show;
$mi->signal_connect('activate', sub {Gtk->exit(0)});
$m->append($mi);
$mi = new Gtk::MenuItem('Fonts');
$mi->show;
$mi->set_submenu(get_fonts());
$m->append($mi);
$mi = new Gtk::MenuItem();
$mi->show;
$mi->set_sensitive(0);
$m->append($mi);
foreach $index ( sort {$a <=> $b} keys %slides) {
$mi = new Gtk::MenuItem($slides{$index});
$mi->show;
$mi->signal_connect('activate', sub {
$i = $index;
$started = 0;
Gtk->main_quit;
});
$m->append($mi);
( run in 4.473 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )