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 )