Distribusi-distribusi X Window, seperti misalkan XFree86, menyertakan Xlib API (Application Programming Interface) dan X Toolkit Intrinsic untuk keperluan pengembangan, namun pemrograman menggunakan Xlib sangat merepotkan karena banyak sekali detil tingkat rendah yang perlu dikontrol langsung oleh kode aplikasi. Sementara itu X Toolkit intrinsic atau Xt, yang satu tingkat di atas Xlib juga masih terlalu sulit untuk langsung dipakai membuat aplikasi GUI, dan biasanya Xt digunakan untuk membangun GUI toolkit. Beberapa toolkit yang sangat populer antara lain adalah MIT Athena Widget, OSF/Motif ataupun lesstif [1], Qt [2], GTK+ [3], dan Tk [4].

Toolkit-toolkit demikian menyediakan apa yang disebut sebagai widget, yaitu obyek user-interface seperti button, scrollbar, listbox, checkbutton, radiobutton, label, text, dan lain sebagainya. Widget mengenkapsulasi detil implementasi, dan untuk setiap widget juga sudah didefinisikan perilaku defaultnya, sehingga programmer dapat lebih berkonsentrasi pada logika aplikasinya. Dengan abstraksi tingkat tinggi seperti ini, pemakaian toolkit jauh lebih memudahkan pemrograman GUI.

Tk dan Perl/Tk

Toolkit biasanya dibuat sebagai library C yang independen, sehingga setiap bahasa yang mendukung interfacing ke C akan dapat memanfaatkannya. Sebagai contoh, skrip Perl dapat menggunakan Qt melalui modul PerlQt [5], dan GTK+ melalui modul Gtk-Perl [6]. Sayangnya tidak demikian halnya dengan Tk, karena toolkit yang satu ini bergantung pada bahasa Tcl. Solusi dari Nick Ing-Simmons [7] adalah dengan "mengeluarkan" Tk dari Tcl, sehingga diperoleh Tk yang independen, yang disebut dengan pTk (portable Tk). Tidak berhenti sampai di situ, Nick juga membuat antarmuka berorientasi objek dari Perl ke pTk ini, yaitu Perl/Tk [8].

Pemrograman Perl/Tk sangatlah luas, dan mengikuti tradisi Perl, distribusi Perl/Tk dilengkapi dengan dokumentasi (manual) yang sangat lengkap, disertai banyak contoh.

Di samping itu, juga dapat diperoleh FAQ (Frequently Asked Questions)-nya di CPAN [9], dan dukungan dari komunitas penggunanya melalui mailing list [10].

Tulisan ini hanya membahas beberapa hal dasar yang perlu dipahami untuk membuat aplikasi GUI, yaitu struktur aplikasi Perl/Tk, geometry manager, menu, dan event binding. Macam-macam class widget tidak dibahas satu persatu, namun diberikan contoh pembuatan aplikasi yang GUI-intensive, yaitu clone dari game jigsaw puzzle dari WindowsEntertainmentPack. Contoh disertai pembahasan sebuah aplikasi yang utuh seperti ini diharapkan lebih bermanfaat daripada contoh-contoh kode pemakaian widget, yang selain dapat dipelajari dari manual masing-masing widget juga dapat diperoleh dari FAQ dan distribusi Perl/Tk sendiri.

Struktur Aplikasi Perl/Tk

Contoh yang minimal seperti Hello World pada listing 1 membantu kita memahami struktur umum aplikasi-aplikasi Perl/Tk.

1| #!/usr/bin/perl

2| use Tk;

3| $mw = MainWindow->new;

Seperti biasa, baris 1 memanggil interpreter Perl, sedangkan baris 2 memuat modul Tk.

Baris 3 menciptakan window MainWindow yang kemudian disimpan ke dalam variabel $mw, dan baris 4 mengeset title-nya. Window MainWindow adalah window yang pertama diciptakan dalam aplikasi, dan bertindak sebagai parent bagi widget-widget yang diciptakan kemudian dalam aplikasi yang sama. Dalam contoh di atas, baris 5 menciptakan widgetLabel ($l), dan baris 6 menciptakan widgetButton ($b) dari $mw sebagai parent-nya, sekaligus mengatur teks yang ditampilkan pada masing-masing widget dengan opsi -text.

Agar dapat berinteraksi dengan user, aplikasi harus dapat merespon event-event yang dibangkitkan sebagai hasil dari aksi user pada widget tertentu, misalkan kombinasi penekanan tombol Alt dan O, klik tombol kiri mouse, gerakan mouse, dan lain sebagainya. Untuk melakukan ini, maka event pada widget tertentu perlu diasosiasikan dengan subrutin yang ditulis sebagai handler event tersebut. Langkah ini disebut dengan event binding. Baris 6 melakukan event binding pada $b dengan menggunakan opsi -command. Dengan opsi ini, subrutin yang didaftarkan akan dipanggil pada saat aplikasi menerima event tombol kiri mouse dilepas di atas widget tersebut. Ada cara lain di mana kita dapat mendefinisikan sendiri event-event yang diharapkan, yaitu dengan method bind() yang akan dijelaskan nanti pada bagian Event Binding.

Baris 7 dan 8 berturut-turut meletakkan $l dan $b dengan methodpack() di atas window $mw. Methodpack() adalah salah satu geometry manager yang berguna untuk menata letak widget-widget di atas sebuah window.

Setelah segala sesuatunya siap, aplikasi harus memantau event-event yang dibangkitkan, dan meneruskannya ke widget yang bersesuaian. Ini dilakukan melalui loop yang disebut dengan event loop. Fungsi Tk::MainLoop menjalankan event loop ini sekaligus menampilkan windowMainWindow ke layar. Baris 9 memanggil fungsi yang diekspor secara default ini.

Secara ringkas, aplikasi-aplikasi Perl/Tk umumnya ditulis sebagai berikut:

1.Buat windowMainWindow,

2.Buat widget-widget lainnya, dan atur tata letaknya menggunakan geometry manager,

3.Event binding,

4.Panggil fungsi MainLoop().

Geometry Manager

Geometry manager diperlukan untuk menata letak dan penampilan widget di atas sebuah window. Di antara macam-macam geometry manager, seperti place(), grid(), pack(), dan form(), pack() adalah yang paling banyak digunakan karena cocok untuk kebutuhan sebagian besar aplikasi.

Untuk mengatur letak widget apakah di bagian atas, kiri, kanan ataupun di bagian bawah window, gunakan opsi -side. Sebagai contoh adalah listing 2, dengan hasil seperti pada Gambar 1.

1| for (qw/left top right bottom/) {

Method pack() mengalokasikan daerah berbentuk segiempat untuk ditempati widget yang memanggilnya. Daerah ini tidak nampak, dan secara default widget ditempatkan di tengah daerah ini.

Kita dapat membuat widget mengisi daerah alokasi tersebut dengan opsi -fill. Jika pada listing 1 kita tambahkan -fill => 'both' pada opsi pack(), maka keempat widget Button akan memenuhi daerah alokasi tersebut, seperti terlihat pada gambar 2.

Urutan pemanggilan pack() dengan -side yang berbeda-beda menghasilkan daerah alokasi yang berbeda. Sebagai contoh jika pada listing 1 keempat widget di-pack() dengan urutan -side: top, bottom, left, right, maka hasil yang diperoleh seperti pada gambar 3.

Pedoman yang dapat dipakai di sini adalah pack() berusaha mengalokasikan daerah seluas mungkin bagi widget yang memanggilnya. Untuk -side top dan bottom, ruang yang tersedia dalam arah horisontal akan diambil, sedangkan untuk -side left dan right, ruang pada arah vertikal diambil.

Informasi lengkap mengenai geometry manager dapat dilihat pada manual Tk::pack, Tk::form, Tk::place, dan Tk::grid (untuk membaca manual modul-modul Perl, pada prompt shell ketikkan man diikuti nama modul tersebut, misalkan: man Tk::pack).

Menu

Menu dapat dibuat dengan widget class Menu. Pada listing 3 dapat dilihat contoh pembuatan menu.

1| #!/usr/bin/perl

2| use Tk;

3| $mw = MainWindow->new(-title => "Contoh Menu");

4| $menu = $mw->Menu;

Baris 4 menciptakan widget Menu dan disimpan dalam variabel $menu. Baris 5 sampai 26 mengkonfigurasi widget tersebut, dan baris 27 "memasang" $menu pada $mw.

Menu yang dibuat adalah seperti pada gambar 4.

Sebuah menu berisi sejumlah entri, dan ada beberapa macam entri menu, yaitu cascade, command, checkbutton, radiobutton, separator, dan tear-off. Pada entri cascade dapat diasosiasikan widget menu yang lain untuk dijadikan submenu. Dalam contoh di atas, baris 5 dan 6 berturut-turut membuat entri cascade $file_m dan $opt_m. Pada baris 19, entri $file_m diasosiasikan dengan menu lain yaitu $file_submenu yang dibuat pada baris 7 sampai 18. Entri-entri yang menyusun $file_submenu ini dibuat melalui opsi -menuitems, sedangkan entri tear-off dihilangkan dengan opsi -tearoff => 0. Widget $file_submenu ini nampak seperti pada gambar 5.

Pada baris 26, entri cascade yang kedua, yaitu $opt_m diasosiasikan dengan $opt_submenu. Widget $opt_submenu ini memiliki sejumlah entri checkbutton yang juga dibuat melalui opsi -menuitems pada baris 20 sampai 25, dan dapat dilihat pada gambar 6.

Satu hal yang menyenangkan dengan widget class Menu ini adalah kemudahan membuat event binding, yaitu cukup dengan membubuhkan tilde (~) di depan karakter yang dimaksud. Sebagai contoh, pada baris 5 kita melihat opsi -label => '~File', yang mengakibatkan kombinasi penekanan Alt dan F akan membuka submenu dari entri cascade tersebut.

Informasi lebih lanjut mengenai menu dapat dilihat pada manual Tk::Menu, dan Tk::Menubutton.

Event Binding

Sebagian widgetclass telah menyediakan cara yang mudah untuk membuat event binding, seperti opsi -command pada widget class Button dan Menu, dan pemakaian karakter tilde pada Menu. Namun seringkali kita perlu mendefinisikan sendiri event binding yang kita inginkan. Untuk ini kita dapat menggunakan methodbind():

$widget->bind(event sequence, callback);

Callback adalah reference ke subrutin yang adalah event handler bagi event X Window yang bersesuaian. Widget yang memanggil fungsi callback tersebut selalu dilewatkan sebagai argumen pertama fungsi tersebut. Dengan memanggil method XEvent() pada argumen pertama ini, kita mendapatkan objek XEvent yang berguna untuk mengetahui informasi berkaitan dengan event yang sedang diterima.

Event sequence adalah string yang mendefinisikan event X Window yang diharapkan, dan format penulisannya adalah sebagai berikut: event-detail>, di mana event utama (yang dicetak tebal) harus ada, sedangkan lainnya opsional. Macam-macam event utama misalkan: Button (ada penekanan tombol mouse), ButtonRelease (ada tombol mouse yang dilepas), Motion (mouse sedang digerakkan), Enter, Key (tombol keyboard ditekan), KeyRelease (tombol keyboard dilepas).

Modifier digunakan jika ada event lain yang menyertai event utama. Misalkan jika tombol o ditekan sementara Alt juga ditekan, maka event sequence-nya menjadi , atau pada klik ganda tombol kiri mouse, event sequence-nya adalah

. Modifier-modifier lainnya misalkan: Shift, Control, Lock.

Detail digunakan jika binding dilakukan pada event yang lebih spesifik lagi. Sebagai contoh, jika mau melakukan binding pada penekanan tombol kiri mouse (bukan sembarang tombol mouse), maka event sequence-nya menjadi: .

Dalam listing 4 diberikan contoh event binding pada penekanan sembarang tombol keyboard dan mouse. Anda dapat mencoba mengubah event sequence pada baris 15 menjadi untuk melihat efek dari penggunaan detail.

1| #!/usr/bin/perl

2| use Tk;

3| $mw = MainWindow->new(-title => "Contoh Event Binding");
4| $mw->geometry("200x200");

5| $mw->bind('' => sub {
6| my $c = shift;
7| my $e = $c->XEvent;
8| print "Tombol keyboard ditekan: ";
9| print " x = ".$e->x." ";
10| print " y = ".$e->y." ";
11| print " keysim = ".$e->K." ";
12| print " ASCII = ".$e->k." ";
13| print " Alphanum = ".$e->A." ";
14| });

15| $mw->bind('' => sub {
16| my $c = shift;
17| print "Tombol mouse ditekan: ";
18| print " Koord window: ".$Tk::event->x.", ".$Tk::event->y." ";
19| print " Koord XRoot : ".$Tk::event->X.", ".$Tk::event->Y." ";
20| });

21| MainLoop();

Listing 4. event

Contoh output yang dicetak di terminal X:

$ ./event

Tombol mouse ditekan:

Koord window: 26, 40

Koord XRoot : 503, 164

Tombol keyboard ditekan:

x = 26

y = 40

keysim = j

ASCII = 44

Alphanum = j

Tombol keyboard ditekan:

x = 26

y = 40

keysim = Alt_L

ASCII = 64

Alphanum =

Untuk menghapus binding, gunakan method bind() dengan string kosong ('') sebagai ganti callback.

Informasi lebih lengkap mengenai event binding dapat dilihat pada manual Tk::bind, dan Tk::callbacks.

Contoh GUI: JigSawed Clone

Logika aplikasi ini sangat sederhana: pecah sebuah gambar ke dalam 16 buah potongan, catat koordinat masing-masing potongan, lalu letakkan potongan-potongan tersebut secara acak. Sebagian besar kode adalah untuk menangani GUI, yaitu menu, file selection dialog box, implementasi drag 'n drop, status bar, dan animasi untuk mengembalikan potongan gambar ke posisi semula.

Selain modul Tk, modul lain yang digunakan adalah Tk::JPEG [11] dan Tk::Clock [12]. Tk::JPEG diperlukan agar Tk::Photo mendukung format JPEG. Jika Anda bermaksud menggunakan file PNG, gunakan juga Tk::PNG [13]. Tk::Clock di sini hanya sebagai pemanis saja, karena sebetulnya yang lebih diperlukan adalah timer untuk menunjukkan pemakaian waktu selama permainan berlangsung. Kode permainan jigsawpuzzle ini dapat dilihat pada listing 5, dan screenshot-nya dapat dilihat pada gambar 7.

1| #!/usr/bin/perl -w

2| use Tk;
3| use Tk::Image;
4| use Tk::FBox;
5| use Tk::JPEG;
6| use Tk::Clock;

7| use strict;
8| use vars qw($opt_w $opt_o $opt_t $opt_s $mw);
9| use constant TLRNCE => 4;

10| BEGIN {
11| $SIG{__WARN__} = sub {
12| if (defined $mw) {
13| $mw->messageBox(
14| -title => "JigSawed Warning",
15| -text => $_[0],
16| -icon => 'error',
17| );
18| }
19| else {
20| print STDOUT join( " ", @_ ), " " ;
21| }
22| };
23| }

24| my ($WIDTH, $HEIGHT);
25| my (%pieces, %iinfo, $game_submenu);
26| my ($puzzle_c, $img_file);
27| my ($off_x, $off_y);
28| my ($status, $start_time);
29| my ($photo, @pieces_p);
30| my $step = 4;

31| sub init_window {
32| $mw = MainWindow->new;
33| $mw->withdraw;

34| $WIDTH = $mw->screenwidth;
35| $HEIGHT = $mw->screenheight;

36| $mw->title("JigSawed");

37| init_menu();
38| init_playground();
39| init_status_bar();

40| $mw->raise;
41| window_centre();
42| $mw->deiconify;
43| do_about();
44| }

45| sub init_menu {
46| my $menu_bar = $mw->Menu;
47| $mw->configure(-menu => $menu_bar);

48| my $game_m = $menu_bar->cascade(-label => '~Game', -tearoff => 0);
49| $game_submenu = $mw->Menu(-tearoff => 0, -menuitems => [
50| [command => '~Open',
51| -command => [&do_open]],
52| "-",
53| [command => '~Scramble',
54| -state => 'disabled',
55| -command => [&do_scramble]],
56| [command => 'Sol~ve',
57| -state => 'disabled',
58| -command => [&do_solve]],
59| [command => '~Fast Solve',
60| -state => 'disabled',
61| -command => [&do_fast_solve]],
62| [command => '~Hint',
63| -state => 'disabled',
64| -command => [&do_hint]],
65| "-",
66| [command => 'E~xit',
67| -command => [&do_exit]]
68| ]);
69| $game_m->configure(-menu => $game_submenu);

70| my $options_m = $menu_bar->cascade(-label => '~Options', -tearoff => 0);
71| $options_m->checkbutton(
72| -label => 'Show Sc~rambling',
73| -variable => $opt_w,);
74| $options_m->checkbutton(
75| -label => 'S~cramble on Open',
76| -variable => $opt_o,);
77| $options_m->checkbutton(
78| -label => '~Timer',
79| -variable => $opt_t,);
80| $options_m->checkbutton(
81| -label => '~Sound',
82| -variable => $opt_s,);
83| $options_m->separator;
84| $options_m->command(
85| -label => 'Sa~ve Options',
86| -command => [&do_save_options]);

87| my $help_m = $menu_bar->cascade(-label => '~Help', -tearoff => 0);
88| $help_m->command(
89| -label => '~About',
90| -command => [&do_about]);
91| }

92| sub init_playground {
93| my $puzzle_s = $mw->Scrolled(
94| 'Canvas',
95| -width => 0.8 * $WIDTH,
96| -height => 0.8 * $HEIGHT,
97| -relief => 'sunken',
98| -borderwidth => 2,
99| -scrollbars => 'osoe',
100| -background => 'black',
101| -scrollregion => [0, 0, $WIDTH, $HEIGHT],
102| )->pack(-fill => 'both');

103| # the working canvas..
104| $puzzle_c = $puzzle_s->Subwidget("canvas");

105| # create empty photos..
106| $photo = $puzzle_c->Photo;
107| for (0..15) {
108| $pieces_p[$_] = $puzzle_c->Photo;
109| }
110| }

111| sub load_picture {
112| my $file = shift;
113| $img_file = $file;

114| cleanup_playground();
115| $puzzle_c->delete('outline');
116| $photo->read($file, -shrink);

117| $off_x = int(($WIDTH - $photo->width) / 2);
118| $off_y = int(($HEIGHT - $photo->height) / 2);

119| $puzzle_c->xview(moveto => 0.1);
120| $puzzle_c->yview(moveto => 0.1);

121| $puzzle_c->createRectangle(
122| $off_x - 3, $off_y - 3, $photo->width + $off_x, $photo->height + $off_y,
123| -outline => 'white',
124| -width => 3,
125| -tags => 'outline');

126| $mw->configure(-title => "JigSawed: $file");
127| unless ($opt_o) {
128| $puzzle_c->createImage(
129| $off_x,
130| $off_y,
131| -anchor => 'nw',
132| -image => $photo,
133| -tags => "image");

134| $status = "Picture is loaded..";
135| for ("Solve", "Fast Solve", "Hint") {
136| $game_submenu->entryconfigure($_, -state => 'disabled');
137| }
138| } else {
139| do_scramble();
140| }
141| }

142| sub do_scramble {
143| cleanup_playground();

144| my $width = $photo->width;
145| my $height = $photo->height;

146| my $w = ($width -= $width % 4) / 4;
147| my $h = ($height -= $height % 4) / 4;

148| my ($i, $y) = (0, 0);

149| srand time;
150| for (1..4) {
151| my $x = 0;
152| for (1..4) {
153| $pieces_p[$i]->copy($photo, -shrink,
154| -from => $x, $y, $x + $w, $y + $h);
155| $puzzle_c->createImage(
156| int rand($WIDTH - $w),
157| int rand($HEIGHT - $h),
158| -image => $pieces_p[$i],
159| -anchor => 'nw',
160| -tags => ["pieces", "p_$i"]);
161| $pieces{"p_$i"} = {x => $off_x + $x, y => $off_y + $y};
162| $i++;
163| $x += $w;
164| }
165| $y += $h;
166| }
167| $status = "Picture is scrambled..";
168| for ("Solve", "Fast Solve", "Hint") {
169| $game_submenu->entryconfigure($_, -state => 'normal');
170| }
171| bind_events();
172| $start_time = time;
173| }

174| sub init_status_bar {
175| my $status_f = $mw->Frame('-relief' => "raised", '-bd' => 2);
176| $status_f->Label(
177| -relief => 'sunken',
178| -textvariable => $status,
179| -anchor => 'w',
180| )->pack(-side => 'left', -expand => 'yes', -fill => 'both');

181| my $c = $status_f->Clock(-background => "Black");
182| $c->config (
183| useAnalog => 0,
184| tickColor => "Orange",
185| handColor => "Red",
186| secsColor => "Green",
187| timeColor => "lightBlue",
188| dateColor => "Gold",
189| timeFont => "-misc-fixed-medium-r-normal--13-*-75-75-c-*-iso8859-1",
190| );
191| $c->pack;
192| $status_f->pack(-fill => 'both');
193| }

194| sub cleanup_playground {
195| if ($puzzle_c->find('withtag', 'image')) {
196| $puzzle_c->delete("image");
197| }
198| if ($puzzle_c->find('withtag', 'pieces')) {
199| $puzzle_c->delete("pieces");
200| }
201| }

202| sub do_solve {
203| for ("Open", "Scramble", "Solve", "Fast Solve", "Hint") {
204| $game_submenu->entryconfigure($_, -state => 'disabled');
205| }
206| tick();
207| }

208| sub do_fast_solve {
209| $puzzle_c->delete("pieces");

210| my $x = ($WIDTH - $photo->width) / 2;
211| my $y = ($HEIGHT - $photo->height) / 2;

212| $puzzle_c->createImage(
213| $x,
214| $y,
215| -anchor => 'nw',
216| -image => $photo,
217| -tags => "image");

218| for ("Solve", "Fast Solve", "Hint") {
219| $game_submenu->entryconfigure($_, -state => 'disabled');
220| }
221| $status = "Puzzle is fast solved";
222| }

223| sub do_hint {
224| for ("Open", "Scramble", "Solve", "Fast Solve", "Hint") {
225| $game_submenu->entryconfigure($_, -state => 'disabled');
226| }
227| tick_hint();
228| }

229| sub do_exit { exit }

230| sub bind_events {
231| $puzzle_c->bind('pieces', '<1>' => sub {
232| my($c) = @_;
233| my $e = $c->XEvent;
234| items_start_drag($c, $e->x, $e->y, \%iinfo);
235| });
236| $puzzle_c->CanvasBind('' =>
237| sub {items_drag( shift, $Tk::event->x, $Tk::event->y, \%iinfo)});

238| $puzzle_c->bind('pieces', '' =>
239| sub {items_end_drag( shift, $Tk::event->x, $Tk::event->y, \%iinfo)});
240| }

241| sub items_start_drag {
242| my($c, $x, $y, $iinfo) = @_;

243| $iinfo->{last_x} = $c->canvasx($x);
244| $iinfo->{last_y} = $c->canvasy($y);
245| $c->raise('current', 'pieces');
246| my ($piece_id) = grep /^p_/, $c->gettags('current');
247| $iinfo->{piece_id} = $piece_id;
248| }

249| sub items_drag {
250| my($c, $x, $y, $iinfo) = @_;
251| return unless $iinfo->{piece_id};

252| $x = $c->canvasx($x);
253| $y = $c->canvasy($y);
254| $c->move('current', $x-$iinfo->{last_x}, $y-$iinfo->{last_y});
255| $iinfo->{last_x} = $x;
256| $iinfo->{last_y} = $y;
257| }

258| sub items_end_drag {
259| my($c, $x, $y, $iinfo) = @_;
260| return unless $iinfo->{piece_id};

261| my $cx = $c->canvasx($x);
262| my $cy = $c->canvasy($y);
263| is_match($iinfo->{piece_id});
264| $iinfo->{piece_id} = undef;
265| do_solved_dialog(time) if is_solved();
266| }

267| sub window_centre {
268| $mw->update ;
269| my $x = int(($mw->screenwidth - $mw->width) / 2);
270| my $y = int(($mw->screenheight - ($mw->height + 62)) / 2);
271| $mw->geometry("+$x+$y");
272| }

273| sub tick {
274| my $piece_id;

275| if (is_solved()) {
276| $status = "Picture is loaded";
277| return;
278| } else {
279| $piece_id = (keys %pieces)[0];
280| }

281| move_piece($piece_id);
282| is_match($piece_id);
283| $mw->after(1, &tick);
284| }

285| sub tick_hint {
286| my $piece_id = (keys %pieces)[0];
287| move_piece($piece_id);

288| if (is_match($piece_id)) {
289| unless (is_solved()) {
290| for ("Open", "Scramble", "Solve", "Fast Solve", "Hint") {
291| $game_submenu->entryconfigure($_, -state => 'normal');
292| }
293| }
294| return;
295| }
296| $mw->after(1, &tick_hint);
297| }

298| sub move_piece {
299| my $piece_id = shift;
300| my $dir;

301| my ($coord_x, $coord_y) = $puzzle_c->coords($piece_id);

302| my $delt_x = $coord_x - $pieces{$piece_id}->{x};
303| my $delt_y = $coord_y - $pieces{$piece_id}->{y};

304| if (abs($delt_x) > $step - 0.5) {
305| $dir = $coord_x < $pieces{$piece_id}->{x} ? 1 : -1;
306| $puzzle_c->raise($piece_id, 'pieces');
307| $puzzle_c->move($piece_id, $dir * $step, 0);
308| } elsif (abs($delt_y) > $step - 0.5) {
309| $dir = $coord_y < $pieces{$piece_id}->{y} ? 1 : -1;
310| $puzzle_c->raise($piece_id, 'pieces');
311| $puzzle_c->move($piece_id, 0, $dir * $step);
312| }
313| }

314| sub is_match {
315| my $p_idx = shift;
316| my ($x, $y) = $puzzle_c->coords($p_idx);

317| if (abs($pieces{$p_idx}->{x} - $x) < TLRNCE and
318| abs($pieces{$p_idx}->{y} - $y) < TLRNCE) {
319| $puzzle_c->coords($p_idx,
320| $pieces{$p_idx}->{x},
321| $pieces{$p_idx}->{y});
322| $puzzle_c->bell if $opt_s;

323| delete $pieces{$p_idx};
324| $puzzle_c->dtag($p_idx);

325| return 1;
326| } else { return 0 }
327| }

328| sub is_solved {
329| unless (%pieces) {
330| $puzzle_c->bind('pieces', '<1>' => '');
331| $puzzle_c->CanvasBind('' => '');
332| $puzzle_c->bind('pieces', '' => '');
333| for ("Solve", "Fast Solve", "Hint") {
334| $game_submenu->entryconfigure($_, -state => 'disabled');
335| }
336| for ("Open", "Scramble") {
337| $game_submenu->entryconfigure($_, -state => 'normal');
338| }
339| return 1;
340| } else { return 0 }
341| }

342| sub do_about {
343| my $text = <<__EOT__ ;
344| TkJigSawed v 0.9

345| Copyright (c) Edwin Pratomo 2000/1.
346| All Rights Reserved.

347| May be used/distributed under the same terms as Perl.
348| __EOT__

349| $mw->messageBox(
350| -title => "About JigSawed",
351| -text => $text,
352| -icon => 'Tk',
353| );
354| }

355| sub do_open {
356| my @types =
357| (
358| ["Image Files", ['.gif', '.jpeg', '.jpg']],
359| ["All files", '*']
360| );
361| my $file = $mw->getOpenFile(-filetypes => @types);
362| if (defined $file and $file ne '') {
363| load_picture($file);
364| $game_submenu->entryconfigure("Scramble", -state => 'normal');
365| }
366| }

367| sub do_solved_dialog {
368| my $end_time = shift;
369| $status = "Puzzle has been solved";
370| my $text =
371| "You have solved the puzzle in ".
372| timediff($end_time, $start_time);

373| $mw->messageBox(
374| -title => "Puzzle Solved",
375| -text => $text,
376| -icon => 'info',
377| );
378| }

379| sub timediff {
380| my ($t2, $t1) = @_;
381| my $d = $t2 - $t1;
382| my $text = '';
383| my $u;
384| if ($u = int ($d / 3600)) {
385| $text = "$u hour ";
386| $d -= $u * 3600;
387| }
388| if ($u = int ($d / 60)) {
389| $text .= "$u min ";
390| $d -= $u * 60;
391| }
392| $text .= "$d seconds";
393| }

394| init_window;
395| MainLoop;

Listing 5. jigsawed

Gambar 7. Screenshot

Baris 2 sampai 6 memuat modul-modul yang diperlukan. Modul Tk::Image dan Tk::FBox sudah disertakan dalam distribusi Perl/Tk, sehingga tidak perlu diinstall tersendiri. Tk::Image diperlukan untuk pengolahan image, dan Tk::FBox untuk membuat file selection dialog box.

Baris 7 menghidupkan pragma strict, dan baris 8 mendeklarasikan sejumlah variabel global. Variabel $mw yang nantinya digunakan untuk menyimpan window MainWindow dibuat global karena diperlukan dalam handler sinyal __WARN__ (baris 11), sedangkan $opt_w, $opt_t, $opt_o, dan $opt_s yang digunakan untuk menyimpan setting dari menu "Options" dibuat global dengan pertimbangan untuk pengembangan mendatang di mana setting tersebut dapat ditentukan melalui opsi command-line.

Baris 9 mendeklarasikan konstanta TLRNCE yang digunakan sebagai nilai ambang kedekatan posisi sebuah potongan gambar dengan posisi awal potongan tersebut.

Baris 10 sampai 23 adalah blok BEGIN di mana diinstall handler untuk sinyal __WARN__. Handler ini mencetak pesan warning pada message box (baris 13).

Baris 24 sampai 30 mendeklarasikan sejumlah variabel leksikal.

Mulai dari sini pembahasan akan lebih mengikuti struktur program, dan tidak selalu mengikuti nomor baris.

Fungsi yang pertama-tama dijalankan adalah init_window() pada baris 394, yang langsung dilanjutkan dengan memanggil MainLoop() pada baris 395. Fungsi init_window() didefinisikan pada baris 31 sampai 44. Fungsi ini membuat windowMainWindow, mengambil informasi ukuran layar, dan lalu berturut-turut memanggil init_menu() untuk inisialisasi menu, init_playground() untuk inisialisasi kanvas, init_status_bar() untuk inisialisasi status bar, dan window_centre() untuk meletakkan $mw di tengah layar.

Fungsi init_menu() didefinisikan pada baris 45 sampai 91. Baris 49 membuat widgetMenu dengan cara seperti yang sudah dibahas pada bagian M