1# -*- perl -*-
2
3#
4# $Id: BBBikeScribble.pm,v 1.6 2005/04/05 22:29:28 eserte Exp $
5# Author: Slaven Rezic
6#
7# Copyright (C) 2002 Slaven Rezic. All rights reserved.
8# This package is free software; you can redistribute it and/or
9# modify it under the same terms as Perl itself.
10#
11# Mail: slaven@rezic.de
12# WWW:  http://bbbike.sourceforge.net
13#
14
15package BBBikeScribble;
16
17use strict;
18use vars qw($VERSION);
19$VERSION = sprintf("%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/);
20
21package Tk::Babybike; # XXX
22no strict; # XXX make strict!!!
23
24use vars qw(
25	    $scribble_mode
26	    $scribble_frame $scribble_color @scribble_colors $show_scribble
27	    $show_scribble_labels
28	    $scribble_file $scribble_bbd $scribble_desc
29	   );
30
31use vars qw($IDX_SCRIBBLE $IDX_TIME $IDX_LABEL);
32$IDX_SCRIBBLE = 0;
33$IDX_TIME     = 1;
34$IDX_LABEL    = 2;
35
36use vars qw($lastitem);
37
38# init
39$scribble_color = 'blue'
40    if !defined $scribble_color;
41@scribble_colors = qw/red blue yellow3 green black white/
42    if !@scribble_colors;
43$show_scribble = 1
44    if !defined $show_scribble;
45$scribble_file = "/tmp/scribble.canvas"
46    if !defined $scribble_file;
47$scribble_bbd  = "/tmp/scribble.bbd"
48    if !defined $scribble_bbd;
49$scribble_desc  = "/tmp/scribble.desc"
50    if !defined $scribble_desc;
51$show_scribble_labels = 1
52    if !defined $show_scribble_labels;
53
54sub toggle_scribble_mode {
55    if ($scribble_mode) {
56	deselect_current_mode()
57	    if defined &deselect_current_mode;
58	if (defined &MM_SCRIBBLE) {
59	    $map_mode = MM_SCRIBBLE();
60	} else {
61	    $main::map_mode = main::MM_SCRIBBLE(); # XXX
62	}
63    } else {
64	if (defined &MM_BABYBIKE_SELECT) {
65	    $map_mode = MM_BABYBIKE_SELECT();
66	} else {
67	    $main::map_mode = main::MM_SEARCH(); # XXX
68	}
69    }
70
71    if ((defined &MM_SCRIBBLE && $map_mode == MM_SCRIBBLE()) ||
72	(!defined &MM_SCRIBBLE && $main::map_mode == main::MM_SCRIBBLE())) { # XXX
73	set_scribble_mode();
74    } else {
75	deselect_scribble_mode();
76    }
77}
78
79sub set_scribble_mode {
80    if (!$scribble_frame || !Tk::Exists($scribble_frame)) {
81	$scribble_frame = $c->Frame
82	    (-bg => '#c0c0c0');
83	foreach my $color_name (@scribble_colors, 'delete', 'label') {
84	    $scribble_frame->Radiobutton
85		(-text => $color_name,
86		 ($color_name !~ /^(delete|label)$/ ? (-fg => $color_name) : ()),
87		 -value => $color_name,
88		 -variable => \$scribble_color,
89		 -padx => 0, -pady => 0,
90		 -highlightthickness => 0,
91		 -anchor => 'w',
92		)->pack(-anchor => 'nw',
93			-fill => 'x');
94	}
95    }
96    $scribble_frame->idletasks;
97    $scribble_frame->place('-relx' => 1,
98			   '-x' => -$scribble_frame->reqwidth,
99			   '-rely' => 1,
100			   '-y' => -$scribble_frame->reqheight);
101    if (!$show_scribble) {
102	$show_scribble = 1;
103	set_show_scribble();
104    }
105    $c->configure(-cursor => "hand2");
106}
107
108sub deselect_scribble_mode {
109    if ($scribble_frame && Tk::Exists($scribble_frame)) {
110	$scribble_frame->placeForget;
111    }
112}
113
114sub set_show_scribble {
115    $c->itemconfigure('scribble',
116		      -state => ($show_scribble ? 'normal' : 'hidden'));
117}
118
119sub set_show_scribble_labels {
120    $c->itemconfigure('scribble-label',
121		      -state => ($show_scribble_labels ? 'normal' : 'hidden'));
122}
123
124sub load_scribble {
125    my $mw = $c->toplevel;
126    if ($c->find("withtag" => "scribble")) {
127	if ($mw->messageBox(-title => 'Delete?',
128			    -message => 'Delete existing scribble?',
129			    -icon => 'question',
130			    -type => 'YesNo') =~ /no/i) {
131	    return;
132	}
133    }
134    $mw->Busy(-recurse => 1);
135    eval {
136	$c->delete("scribble");
137	$c->load_canvas($scribble_file);
138    };
139    my $err = $@;
140    $mw->Unbusy;
141    warn $err if $err;
142}
143
144sub save_scribble {
145    my @items = $c->find("withtag" => "scribble");
146    if (!@items) {
147	common_dialog("No scribble to save");
148	return;
149    }
150
151    my $mw = $c->toplevel;
152    $mw->Busy(-recurse => 1);
153    eval {
154	$c->save_canvas($scribble_file, withtag => "scribble");
155	warn "OK, saved to $scribble_file";
156    };
157    my $err = $@;
158    eval {
159	$anti_transpose = \&main::anti_transpose if !$anti_transpose;
160	# XXX does not work with bbbike, only with tkbabybike
161	# XXX is this still true???
162	if (open(BBD, ">$scribble_bbd")) {
163	    foreach my $item (@items) {
164		my $color = $c->itemcget($item, -fill);
165		my @tags = $c->gettags($item);
166		(my $time  = $tags[$IDX_TIME]) =~ s/^T//;
167		(my $label = $tags[$IDX_LABEL]) =~ s/^L//;
168		my @coords = $c->coords($item);
169		print BBD $label . ($label ne '' ? ' ' : '') .
170		    scalar(localtime($time))."\t$color";
171		for(my $i=0; $i<$#coords; $i+=2) {
172		    my($x,$y) = $anti_transpose->($coords[$i],$coords[$i+1]);
173		    printf BBD " %d,%d", $x,$y;
174		}
175		print BBD "\n";
176	    }
177	    close BBD;
178
179	    if (open(DESC, ">$scribble_desc")) {
180		foreach my $color_name (@scribble_colors) {
181		    printf DESC "\$category_color{'$color_name'} = '#%02x%02x%02x';\n",
182			map { $_/256 } $mw->rgb($color_name);
183		}
184		close DESC;
185	    }
186	}
187    };
188    $err .= $@;
189    $mw->Unbusy;
190    main::status_message($err, "error") if $err;
191}
192
193sub handle_button1_scribble {
194    my($w,$e) = @_;
195    if ($scribble_color eq 'delete') {
196	my(@tags) = $c->gettags('current');
197	if (grep {$_ eq 'scribble'} @tags) {
198	    $c->delete('current');
199	}
200    } elsif ($scribble_color eq 'label') {
201	my(@tags) = $c->gettags('current');
202	if (grep {$_ eq 'scribble'} @tags) {
203	    @tags = map { $_ eq 'current' ? () : $_ } @tags;
204	    my $item = $c->find("withtag", "current");
205	    (my $label = $tags[$IDX_LABEL]) =~ s/^L//;
206	    my $mw = $c->toplevel;
207	    my $t = $mw->Toplevel(-title => "Label");
208	    $t->transient($mw);
209	    my $e = $t->Entry(-textvariable => \$label)->grid(-columnspan => 2);
210	    $e->focus;
211	    my $cont = 0;
212	    my $okcb = sub {
213		$c->dtag($item, $tags[$IDX_LABEL]);
214		$label =~ s/\s+/_/g;
215		$c->addtag("L$label",
216			   "withtag", $item,
217			  );
218		my(@c) = $c->coords($item);
219		$c->createText(@c[0,1], -text => $label, -anchor => "sw",
220			       -state => ($show_scribble_labels ? "normal" : "hidden"),
221			       -tags => ['scribble', 'scribble-label']);
222		# XXX deleting labels?
223		$cont++;
224	    };
225	    Tk::grid(my $okb = $t->Button
226		     (-text => 'OK',
227		      -command => $okcb),
228		     $t->Button
229		     (-text => 'Cancel',
230		      -command => sub { $cont++ }
231		     )
232		    );
233	    $e->bind("<Return>" => sub { $okcb->() });
234	    $t->waitVariable(\$cont);
235	    $t->destroy;
236	}
237    } else {
238	($lastx,$lasty) = ($c->canvasx($e->x), $c->canvasy($e->y));
239	$lastitem =
240	    $c->createLine($lastx,$lasty,$lastx,$lasty,
241			   -width => 2, -fill => $scribble_color,
242			   -capstyle => 'round',
243			   -tags => ['scribble', "T".time, "L"]);
244    }
245}
246
247sub handle_button1_motion_scribble {
248    my($w,$e) = @_;
249    my($cx,$cy) = ($c->canvasx($e->x), $c->canvasy($e->y));
250    if ($scribble_color eq 'delete') {
251	my(@items) = $c->find('overlapping', $cx-1,$cy-1,$cx+1,$cy+1);
252	foreach my $item (@items) {
253	    if (grep {$_ eq 'scribble'} $c->gettags($item)) {
254		$c->delete($item);
255	    }
256	}
257    } elsif ($scribble_color ne 'label') {
258	$c->createLine($lastx,$lasty,$cx,$cy,
259		       -width => 2, -fill => $scribble_color,
260		       -capstyle => 'round',
261		       -tags => ['scribble', "T".time, "L"]);
262	($lastx,$lasty) = ($cx,$cy);
263    }
264}
265
2661;
267
268__END__
269