#!/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
$started = 0;
@data = ();
%slides =();
$i = 0;
while (<DATA>) {
chomp;
study;
# remove whitespace and comments
s/^\s+//;
s/\s+$//;
next if /^#/;
next if /^$/;
if ( s"\\$"" ) { #"
$_ .= <DATA>;
redo;
}
push(@data, $_);
}
$i = 0;
@group = ();
%group = ();
$in_group = undef;
$xoffset = $width/20;
# execute the commands and wait for events
while($i < @data) {
if ( $in_group ) {
if ( $data[$i] =~ /^end/ ) {
$in_group = undef;
$i++;
} else {
push(@{$group{$in_group}}, $data[$i++]);
}
next;
}
if ( @group ) {
$_ = shift(@group);
} else {
$_ = $data[$i++];
}
START:
study;
$fontsize = $font->ascent+$font->descent if defined $font;
# parse (escapes, variable substitution)
unless ( /^(eval|cmd)/ ) {
s/\$(\w+)/${$1}/g;
s/\\(.)/$1/g;
}
if (/^image\s+(\w+)\s+([^ \t]+)$/) {
$images{$1} = load_image Gtk::Gdk::ImlibImage($2);
if (!defined $images{$1}) {
$images{$1} = create_image_from_data Gtk::Gdk::ImlibImage("\xff\x00\x00" x 9, undef, 3, 3);
}
} elsif (/^image\s+(\w+)\s+([clrn])\s+(\d+)\s+(\d+)$/) {
my ($im) = $images{$1};
my ($ip);
if ( $2 eq 'c' ) {
$curx = $width/2 - $3/2;
} elsif ( $2 eq 'r' ) {
$curx = $width - $xoffset - $3;
} elsif ( $2 eq 'l' ) {
$curx = $xoffset;
}
#$im->render($3, $4);
#$ip = $im->move_image;
#$bp->draw_pixmap($gc, $ip, 0, 0, $curx, $cury, $3, $4);
$im->paste_image($bp, $curx, $cury, $3, $4);
$cury += $4 + int($fontsize/2+.5) unless ($2 eq 'n');
$curx += $3;
} elsif (/^font\s*(\w+)\s+(.+)$/) {
$fonts{$1} = [load Gtk::Gdk::Font($2), $2];
if (!defined $fonts{$1}->[0]) {
$fonts{$1} = [load Gtk::Gdk::Font("fixed"), "fixed"];
}
$font = $fonts{$1}->[0];
} elsif (/^font\s*(\w+)$/) {
$font = $fonts{$1}->[0];
} elsif (/^fg\s*(.+)$/) {
my ($c) = Gtk::Gdk::Color->parse_color($1);
$c = $colormap->color_alloc($c);
$gc->set_foreground($c);
} elsif (/^bg\s*(.+)$/) {
my ($c) = Gtk::Gdk::Color->parse_color($1);
$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);
}
$m->popup(undef, undef, 3, 0, undef);
}
__DATA__
################# load needed resources
eval $fsize = int ($height*.6)
eval $fssize = int ($height*.35)
eval $fixedsize = int ($height*.3)
eval $imsize = int ($height*.25)
# eval $title = "Gtk+ e Perl"
image tcl Xcamel.gif
image bullet bullet.png
image logo gtk-logo-rgb.gif
font std -freefont-baskerville-bold-r-normal-*-*-$fsize-*-*-p-*-iso8859-1
font small -freefont-baskerville-bold-r-normal-*-*-$fssize-*-*-p-*-iso8859-1
#font fixed -freefont-tekton-normal-r-normal-*-*-$fixedsize-*-*-p-*-iso8859-1
#font fixed -bitstream-terminal-medium-r-normal-*-*-$fixedsize-*-*-c-*-iso8859-1
#font std -bitstream-charter-*-*-*-*-*-$fsize-*-*-*-*-*-*
#font small -bitstream-charter-*-*-*-*-*-$fssize-*-*-*-*-*-*
font fixed -adobe-courier-*-*-*-*-*-$fixedsize-*-*-*-*-*-*
define slide
slide $title
fg white
rect f 0 0 $width $height
fg black
font std
put c $title
skip 0 $fontsize
font small
end
define comment
fg black
font small
end
define pcode
fg red
font fixed
end
define bullet
image bullet l $fontsize $fontsize
evalx "skip 0 -" . int($fontsize/2+.5)
evalx $arg?"put n $arg":""
end
define tab
eval $xoffset = int($width/20)*(defined $arg ? $arg : 1)
end
#########################################
cmd slide $title = "Gtk+ e Perl"
image logo c $imsize $imsize
#put l
put l Gtk+: una buona libreria grafica
put l Perl: un linguaggio di programmazione flessibile
fg steelblue
skip 0 $fontsize
put l Rapid prototyping
put l Sviluppo di piccole applicazioni
put l Applicazioni "verticali"
put l Scripting interattivo
skip 0 $fontsize
fg red
font fixed
put r http://www.perl.org
put r http://www.gtk.org
put r http://www.gnome.org
########################################
cmd slide $title = "Come si compila Perl/Gtk"
put l Le ultime versioni uscite sono:
put l Gtk 0.3 (stabile)
put l Gtk 0.4 e Gnome 0.3 (in sviluppo)
skip 0 $fontsize
put l Le librerie richieste sono:
put l glib, gtk+, gdkimlib, gnome.
skip 0 $fontsize
fg steelblue
font fixed
put l $ perl Makefile.PL --with-gnome --with-gdkimlib
put l $ make
put l $ make test
put l $ make install
# skip 0 $fontsize
#######################################
cmd slide $title = "I vantaggi (laziness)"
put l Sfrutta il design object oriented di gtk+,
put l quindi:
skip 0 $fontsize
cmd bullet niente casting
cmd bullet codice più corto
skip 0 $fontsize
font fixed
fg steelblue
put l button = gtk_button_new_with_label("Hello!");
put l gtk_container_add(GTK_CONTAINER(window), button);
skip 0 $fontsize
fg black
put c diventa
skip 0 $fontsize
fg red
put l $\button = new Gtk::Button ("Hello!");
put l $\window->add($\button);
#####################################
cmd slide $title = "I vantaggi (impatience)"
put l Il modulo permette di usare riferimenti a subroutine
put l dove il codice C richiede il puntatore a una funzione
put l (callback) ed è possibile passare più argomenti senza
put l dover costruire una struttura apposta.
skip 0 $fontsize
font fixed
fg steelblue
put l gtk_object_signal_connect(GTK_OBJECT(button),
put r "clicked", (GtkSignalFunc)gtk_main_quit, NULL);
skip 0 $fontsize
fg black
put c diventa
skip 0 $fontsize
fg red
put l $\button->signal_connect("clicked", sub {Gtk->main_quit});
####################################
cmd slide $title = "I vantaggi (hubris)"
put l Si può anche mescolare codice C e codice perl e si possono
put l creare nuovi widget in perl che saranno accessibili anche
put l alla parte C del programma.
skip 0 $fontsize
font fixed
fg red
put l package mywindow;
skip 0 $fontsize
put l @ISA = qw(Gtk::Window);
skip 0 $fontsize
put l sub new {
cmd tab 2
put l my($\class) = @_;
put l my($\self) = new Gtk::Window('toplevel');
put l $\self->set_title("a mywindow");
put l $\self->{"george"} = "bill";
put l bless $\self, $\class;
cmd tab
put l }
####################################
cmd slide $title = "Le differenze rispetto al C"
put c Namespace
skip 0 $fontsize
font fixed
fg steelblue
put l gtk_
put l gdk_
put l gdk_imlib_
put l gnome_
put l gtk_object_
put l gdk_font_
fg red
evalx "skip 0 -" . $fontsize*6
put r Gtk::
put r Gtk::Gdk::
put r Gtk::Gdk::ImlibImage::
put r Gtk::Gnome::
put r $\object->
put r $\font->
##################################
cmd slide $title = "Le differenze rispetto al C II"
put c Enumerazioni e flag
skip 0 $fontsize
font small
put l Al posto del valore di una enumerazione o di un flag
put l si usa rispettivamente una stringa e un riferimento ad
put l un array di stringhe.
skip 0 $fontsize
font fixed
fg steelblue
put l GTK_WINDOW_TOPLEVEL
put l GDK_INPUT_READ|GDK_INPUT_WRITE
fg red
evalx "skip 0 -" . $fontsize*2
put r "toplevel"
put r ['read', 'write']
skip 0 $fontsize
fg black
font small
put l Si può usare una stringa nel caso di un valore flag quando
put l questo è rappresentato da un solo item:
skip 0 $fontsize
font fixed
fg steelblue
put l GDK_DECOR_BORDER
skip 0 -$fontsize
fg red
put r "border"
#################################
cmd slide $title = "Passiamo agli esempi"
put l La creazione di una window: la differenza tra una
put l GdkWindow e una GtkWindow.
put l Quando serve "realizzare" o "costruire" una window.
skip 0 $fontsize
font fixed
fg red
put l use Gtk;
skip 0 $fontsize
put l init Gtk::Gdk::ImlibImage;
skip 0 $fontsize
put l $\gtkwin = new Gtk::Window -toplevel;
put l $\gtkwin->set_events(['button_press_mask', 'key_press_mask']);
put l $\width = $\height = 400;
put l $\gtkwin->set_usize($\width, $\height);
put l $\gtkwin->set_policy(0, 0, 0);
put l $\gtkwin->realize;
put l $\win = $\gtkwin->window;
################################
cmd slide $title = "Colori, font e immagini"
put l Come si inizializzano i colori:
skip 0 $fontsize
cmd pcode
put l Gtk::Gdk::Color->parse_color("steelblue");
put l $\color = $\colormap->color_alloc($\color);
put l $\gc->set_foreground($\color);
skip 0 $fontsize
cmd comment
put l I font:
skip 0 $fontsize
cmd pcode
put l load Gtk::Gdk::Font("fixed");
skip 0 $fontsize
cmd comment
put l Le immagini con gdkimlib:
skip 0 $fontsize
cmd pcode
put l $\image = load_image Gtk::Gdk::ImlibImage("logo.png");
put l $\im->render($\width, $\height);
put l $\ip = $\im->move_image;
put l $\bp->draw_pixmap($\gc, $\ip, 0, 0, $\x, $\y, $\width, $\height);
################################
cmd slide $title = "Preparare una backing pixmap"
put l E' una tecnica comunemente usata nella programmazione
put l nel sistema X Window: le operazioni di disegno vengono
put l eseguite su una pixmap (una immagine in memoria) e copiate
put l sulla finestra visibile sullo schermo solo quando è
put l necessario.
skip 0 $fontsize
font fixed
fg red
put l (undef, undef, undef, undef, $\depth) = $\win->get_geometry;
put l $\bp = new Gtk::Gdk::Pixmap($\win, $\width, $\height, $\depth);
put l $\gc = new Gtk::Gdk::GC ($\win);
put l $\colormap = $\win->get_colormap;
put l $\gc->set_foreground($\colormap->color_white());
put l $\bp->draw_rectangle($\gc, 1, 0, 0, $\width, $\height);
################################
cmd slide $title = "Programmazione event-driven"
put l La programmazione event-driven è un paradigma che si
put l adatta bene ai programmi in ambiente grafico.
skip 0 $fontsize
put l Il programmatore imposta delle callback che vengono
put l invocate quando si verificano determinati eventi.
skip 0 $fontsize
put l In aggiunta agli eventi generati dall'ambiente grafico
put l ogni widget (discendente da GtkObject) può definire e
put l generare
fg red
put n "signal"
fg black
put n : la generalizzazione di un evento.
################################
cmd slide $title = "La gestione degli eventi"
font fixed
fg red
put l $\gtkwin->signal_connect('button_press_event', sub {
cmd tab 2
put l my ($\w, $\e)= @_;
put l if ($\e->{'button'} == 1) {Gtk->main_quit;}
put l elsif ($\e->{'button'} == 2) {Gtk->exit(0);}
put l else {show_menu()}
cmd tab
put l });
skip 0 $fontsize
put l $\gtkwin->signal_connect('delete_event', sub {Gtk->exit(0);});
skip 0 $fontsize
put l $\gtkwin->signal_connect('expose_event', sub {
cmd tab 2
put l my ($\w, $\e) = @_;
put l my ($\x, $\y, $\wi, $\h) = @{$\e->{'area'}};
put l $\win->draw_pixmap($\gc, $\bp, $\x, $\y, $\x, $\y, $\wi, $\h);
cmd tab
put l });
################################
cmd slide $title = "Eventi di rete"
put l Anche la disponibilità di un file descriptor alla
put l lettura o scrittura sono considerati eventi
skip 0 $fontsize
put l Questo permette di integrare in una gestione unica
put l gli eventi delle connessioni di rete con gli eventi
put l dell'ambiente grafico in modo non-blocking.
skip 0 $fontsize
put l La chiave di questo è la funzione:
fg red
put n Gtk::Gdk::input_add.
fg black
skip 0 $fontsize
put l Cerchiamo di scrivere delle funzioni event-driven nella
put l implementazione, ma non nell'interfaccia.
################################
cmd slide $title = "Funzione: write_data"
font fixed
fg red
put l # $\sock is an IO::Socket object
skip 0 $fontsize
put l sub write_data {
cmd tab 2
put l my ($\sock, $\data) = @_;
put l my ($\id, $\len, $\written, $\res);
put l $\written=0;
put l $\len = length($\data);
put l $\id = Gtk::Gdk->input_add($\sock->fileno(), ['write'], sub {
cmd tab 3
put l $\res = shift->syswrite($\data, $\len, $\written);
put l $\written += $\res if defined $\res;
put l Gtk->main_quit if ($\written == $\len || !defined $\res);
cmd tab 2
put l }, $\sock);
put l Gtk->main;
put l Gtk::Gdk->input_remove($\id);
put l return $\written == $\len;
cmd tab
put l }
################################
cmd slide $title = "Funzione: read_data"
font fixed
fg red
put l sub read_data {
cmd tab 2
put l my ($\sock, $\eod) = @_;
put l my ($\data, $\id, $\res, $\read);
skip 0 $fontsize
put l $\eod = "\\n" unless defined $\eod;
put l $\id = Gtk::Gdk->input_add($\sock->fileno(), ['read'], sub {
cmd tab 3
put l $\res = shift->sysread($\data, 1, $\read);
put l $\read += $\res if defined $\res;
put l Gtk->main_quit if (rindex($\data, $\eod) != -1 || !defined $\res);
cmd tab 2
put l }, $\sock);
put l Gtk->main;
put l Gtk::Gdk->input_remove($\id);
put l return $\data;
cmd tab
put l }
################################
cmd slide $title = "Debug del modulo"
put l Il modulo deve essere compilato con l'opzione:
skip 0 $fontsize
font fixed
fg red
put l OPTIMIZE=-g
skip 0 $fontsize
fg black
font small
put l Con gdb si usa il binario /usr/bin/debugperl che
put l contiene informazioni di debug.
skip 0 $fontsize
put l Come impostare un breakpoint se il modulo viene
put l caricato dinamicamente?
################################
cmd slide $title = "Futuri sviluppi"
put l Supporto delle nuove features di gtk+ e Gnome.
skip 0 $fontsize
put l Sviluppo indipendente dei moduli aggiuntivi.
skip 0 $fontsize
put l Integrazione con gli altri moduli Perl (GL).
skip 0 $fontsize
put l Ottimizzazione dell'uso della memoria.
skip 0 $fontsize
put l Integrazione con ORBit (CORBA).
################################
cmd slide $title = "Risorse su internet"
image tcl c $imsize $imsize
font fixed
fg steelblue
put c http://www.gtk.org
put c http://www.perl.org
put c http://www.debian.org
put c http://www.lettere.unipd.it/~lupus/pluto-98
skip 0 $fontsize
put c CVSROOT=:pserver:anonymous@anoncvs.gimp.org:/cvs/gnome/
skip 0 $fontsize
put c lupus@pluto.linux.it
slide end