1=pod
2
3=head1 NAME
4
5examples/dock.pl - Docking widgets
6
7=head1 FEATURES
8
9This is the demonstration of Prima::Dock and Prima::DockManager
10modules. The window created is docking client, and it's able
11to accept toolbars and panels, and toolbars in turn accept buttons.
12buttons are very samplish; there are two panels, Edit and Banner,
13that are docked in different ways.
14Note the following unevident features:
15
16=over 4
17
18=item popup on the border of the window ( and the Customize command there)
19
20=item dragging of buttons on the window and the extreior
21
22=item dragging panels and toolbar to the exterior
23
24=item storing of the geometry in the ~/.demo_dock file
25
26=back
27
28=cut
29
30use strict;
31use warnings;
32
33use Prima;
34use Prima::Application;
35use Prima::Edit;
36use Prima::Buttons;
37use Prima::DockManager;
38use Prima::Utils;
39
40package dmfp;
41use constant Edit       => 0x100000;
42use constant Vertical   => 0x200000;
43use constant Horizontal => 0x400000;
44
45# This is the main window. it's responsible for
46# command handling and bar visiblity;
47# NB - bars are not owned by this window when undocked.
48
49package Prima::Dock::BasicWindow;
50use vars qw(@ISA);
51@ISA = qw(Prima::Window);
52
53sub profile_default
54{
55	my $def = $_[0]-> SUPER::profile_default;
56	my %prf = (
57		instance => undef,
58	);
59	@$def{keys %prf} = values %prf;
60	return $def;
61}
62
63sub init
64{
65	my  $self = shift;
66	my %profile = $self-> SUPER::init( @_);
67	$self-> $_($profile{$_}) for qw(instance);
68	$self-> {toolBarPopup} = $self-> insert( Popup =>
69		autoPopup  => 0,
70		items      => $self-> make_popupitems(),
71	);
72	$self-> {mainDock} = $self-> insert( FourPartDocker =>
73		rect        => [ 0, 0, $self-> size],
74		fingerprint => dmfp::Tools|dmfp::Toolbar|dmfp::Edit|dmfp::Horizontal|dmfp::Vertical,
75		dockup      => $self-> instance,
76		dockerCommonProfile => {
77			hasPocket => 0,
78			onPopup => sub { # all dockers would render this popup
79				my ( $me, $btn, $x, $y) = @_;
80				( $x, $y) = $self-> screen_to_client( $me-> client_to_screen($x, $y));
81				$self-> {toolBarPopup}-> popup( $x, $y);
82				$me-> clear_event;
83			}
84		},
85		dockerProfileClient => { # allow docking only to Edit
86			fingerprint => dmfp::Edit,
87		},
88		dockerProfileLeft   => { fingerprint => dmfp::Vertical|dmfp::Tools|dmfp::Toolbar },
89		dockerProfileRight  => { fingerprint => dmfp::Vertical|dmfp::Tools|dmfp::Toolbar },
90		dockerProfileTop    => { fingerprint => dmfp::Horizontal|dmfp::Tools|dmfp::Toolbar },
91		dockerProfileBottom => { fingerprint => dmfp::Horizontal|dmfp::Tools|dmfp::Toolbar },
92	);
93	$self-> instance-> add_notification( 'ToolbarChange', \&on_toolbarchange, $self);
94	$self-> instance-> add_notification( 'PanelChange',   \&on_toolbarchange, $self);
95	$self-> instance-> add_notification( 'Command',   \&on_command, $self);
96	return %profile;
97}
98
99sub make_popupitems
100{
101	my $items = $_[0]-> instance-> toolbar_menuitems( \&Menu_Check_Toolbars);
102	# actually DockManager doesn't care if panel CLSID and toolbar name intermix.
103	# this is the demonstration of resolving that clash
104	$$_[0] .= ',toolbar' for @$items;
105	push ( @$items, []);
106	push ( @$items, @{$_[0]-> instance-> panel_menuitems( \&Menu_Check_Panels)});
107	push ( @$items, []);
108	push ( @$items, ['customize' => "~Customize..." => q(open_dockmanaging)]);
109	return $items;
110}
111
112
113sub Menu_Check_Toolbars
114{
115	my ( $self, $var) = @_;
116	my $toolname = $var;
117	$toolname =~ s/\,toolbar$//;
118	$self-> instance-> toolbar_visible(
119		$self-> instance-> toolbar_by_name($toolname),
120		$self-> {toolBarPopup}-> toggle( $var)
121	);
122}
123
124sub Menu_Check_Panels
125{
126	my ( $self, $var) = @_;
127	$self-> instance-> panel_visible(
128		$var, $self-> {toolBarPopup}-> toggle( $var));
129}
130
131sub instance
132{
133	return $_[0]-> {instance} unless $#_;
134	$_[0]-> {instance} = $_[1];
135}
136
137
138sub on_toolbarchange
139{
140	$_[0]-> {toolBarPopup}-> items( $_[0]-> make_popupitems());
141}
142
143sub on_command
144{
145	my ( $self, $instance, $command) = @_;
146	$command =~ s/\://g;
147	my $x = $self-> can( $command);
148	return unless $x;
149	$x-> ( $self);
150}
151
152# we'll take our actions we need to reflect the state.
153sub open_dockmanaging
154{
155	my $self = $_[0];
156	my $i = $self-> instance;
157	return if $i-> interactiveDrag;
158	my $wpanel = Prima::Window-> create(
159		name => 'Customize tools',
160		size => [ 400, 100],
161		designScale => [ 7, 16 ],
162		onClose => sub {
163			$self-> {toolBarPopup}-> customize-> enabled(1);
164			$i-> interactiveDrag(0);
165		},
166	);
167	$i-> create_manager( $wpanel,  dockerProfile => {
168		hint => 'Drag here unneeded buttons',
169	});
170	$i-> interactiveDrag(1);
171	$self-> {toolBarPopup}-> customize-> enabled(0);
172}
173
174sub get_docks
175{
176	my $self = $_[0];
177	my @docks = ( $self-> {mainDock});
178	my $sid = $self-> {mainDock}-> open_session({
179		self => $self-> {mainDock},
180		sizes => [[0,0]],
181		sizeable => [1,1],
182	});
183	if ( $sid) {
184		while ( 1) {
185			my $x = $self-> {mainDock}-> next_docker( $sid);
186			last unless $x;
187			next if $x-> isa(q(Prima::DockManager::LaunchPad));
188			push ( @docks, $x);
189		}
190		$self-> {mainDock}-> close_session( $sid);
191	}
192	return @docks;
193}
194
195sub init_read
196{
197	my ( $self, $fd) = @_;
198	my $last = undef;
199	my @docks = $self-> get_docks;
200	my $state;
201	my %docks = map { my $x = $_-> name; $x =~ s/(\W)/\%sprintf("%02x",$1)/; $x => $_} @docks;
202
203	while ( <$fd>) {
204		$state = 1, last if m/^DOCK_STMT_START/;
205	}
206	return unless $state;
207	my $i = $self-> instance;
208	my %audocks;
209	tie %audocks, 'Tie::RefHash';
210
211
212	while ( <$fd>) {
213		chomp;
214		last if m/^DOCK_STMT_END/;
215		if ( m/^MYSELF\[(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\]/) {
216			$self-> rect( $1,$2,$3,$4);
217			next;
218		}
219		if ( m/^TOOLBAR\:(\w*)\:(\d)\:(\d)\:\[(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\]\:(.*)$/) {
220			my ( $dockID, $vertical, $visible, $x1, $y1, $x2, $y2, $name) =
221				($1,$2,$3,$4,$5,$6,$7,$8);
222			my $auto = $name =~ /^ToolBar/;
223
224			my ( $x, $xcl) = $i-> create_toolbar(
225				visible   => $visible,
226				vertical  => $vertical,
227				dock      => $docks{$dockID},
228				rect      => [ $x1, $y1, $x2, $y2],
229				name      => $name,
230				autoClose => $auto,
231			);
232			$last = $xcl;
233			$name =~ s/(\W)/\%sprintf("%02x",$1)/;
234			$docks{$name} = $xcl;
235			next;
236		} elsif ( m/^TOOL\:([^\s]+)\s\[(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\]/) {
237			my ( $CLSID, $x1, $y1, $x2, $y2) = ($1,$2,$3,$4,$5);
238			next unless $last;
239			my $ctrl = $i-> create_tool( $last, $CLSID, $x1, $y1, $x2, $y2);
240			next unless $ctrl;
241			push @{$audocks{$last}}, $ctrl;
242			next;
243		} elsif ( m/^PANEL\:(\w*)\:([^\s]+)\s\[(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\]/) {
244			my ( $dockID, $CLSID, $x1, $y1, $x2, $y2) = ($1,$2,$3,$4,$5,$6);
245			my ( $x, $xcl) = $i-> create_panel( $CLSID, dockerProfile => {
246				dock => $docks{$dockID},
247				origin => [$x1, $y1], # because original profile uses size
248				size   => [$x2 - $x1, $y2 - $y1], # this is hack to override it
249				rect   => [ $x1, $y1, $x2, $y2],
250			});
251			next;
252		}
253	}
254	$_-> dock_bunch( @{$audocks{$_}}) for keys %audocks;
255	$i-> notify(q(ToolbarChange));
256}
257
258sub init_write
259{
260	my ( $self, $fd) = @_;
261	print $fd "DOCK_STMT_START\n";
262	my @rc = $self-> rect;
263	print $fd "MYSELF[@rc]\n";
264	for ( $self-> instance-> toolbars) {
265		my $p = $_;
266		my $x = $_-> childDocker;
267		my ( $e, $n);
268		my @rect = $x-> rect;
269		if ( $p-> dock) {
270			$e = $p;
271			$n = $p-> dock-> name;
272			$n =~ s/(\W)/\%sprintf("%02x",$1)/g;
273			@rect = $p-> dock-> screen_to_client( $p-> client_to_screen( @rect));
274		} else {
275			$n = '';
276			$e = $p-> externalDocker;
277			@rect = $x-> client_to_screen( @rect);
278		}
279		my $vis  = $e-> visible ? 1 : 0;
280		my $ver  = $x-> vertical ? 1 : 0;
281		print $fd "TOOLBAR:$n:$ver:$vis:[@rect]:".$p-> text."\n";
282		for ( $x-> docklings) {
283			@rect = $_-> rect;
284			my $ena = $_-> enabled;
285			my $CLSID = $_-> {CLSID};
286			next unless defined $CLSID;
287			print $fd "TOOL:$CLSID [@rect]:$ena\n";
288		}
289	}
290	for ( $self-> instance-> panels) {
291		my @r = $_-> dock() ? $_-> rect : $_-> externalDocker-> rect;
292		my $n = '';
293		if ( $_-> dock) {
294			$n = $_-> dock-> name;
295			$n =~ s/(\W)/\%sprintf("%02x",$1)/g;
296		}
297		my $CLSID = $_-> {CLSID};
298		print $fd "PANEL:$n:$CLSID [@r]\n";
299	}
300	print $fd "DOCK_STMT_END\n";
301}
302
303sub FileOpen
304{
305	$_[0]-> open_dockmanaging;
306}
307
308sub FileClose
309{
310	$_[0]-> close;
311}
312
313package Banner;
314use vars qw(@ISA);
315@ISA = qw(Prima::Widget);
316
317sub on_create
318{
319	my $self = $_[0];
320	$self-> {offset} = 0;
321	$self-> text( "Visit www.prima.eu.org");
322	$self-> font-> size( 18);
323	$self-> {maxOffset} = $self-> width;
324	$self-> {textLen} = $self-> get_text_width( $self-> text);
325	$self-> insert( Timer => timeout => 100 => onTick => sub {
326		$self-> {offset} = $self-> {maxOffset}
327			if ( $self-> {offset} -= 5) < -$self-> {textLen};
328		$self-> repaint;
329	})-> start;
330}
331
332sub on_size
333{
334	my ( $self, $ox, $oy, $x, $y) = @_;
335	$self-> {maxOffset} = $x;
336}
337
338sub on_paint
339{
340	my ( $self, $canvas) = @_;
341	$canvas-> clear;
342	my @sz = $self-> size;
343	$canvas-> text_out( $self-> text,
344		$self-> {offset}, ( $sz[1] - $canvas-> font-> height) / 2);
345}
346
347package X;
348
349# createing the docking instance with predefined command state
350my $i = Prima::DockManager-> create(
351	commands  => {
352		'Edit::OK' => 0,
353		'Edit::Cancel' => 0,
354	},
355);
356
357# registering buttons
358sub reg
359{
360	my ( $id, $name, $hint, %profile) = @_;
361	$i-> register_tool( Prima::DockManager::S::SpeedButton::class( "sysimage.gif:$id",
362		$name, hint => $hint, %profile));
363}
364
365reg( sbmp::SFolderOpened, 'File::Open',  'Rearrange buttons');
366reg( sbmp::SFolderClosed, 'File::Close', 'Close document');
367reg( sbmp::GlyphOK,       'Edit::OK',    'OK', glyphs => 2);
368reg( sbmp::GlyphCancel,   'Edit::Cancel','Cancel', glyphs => 2);
369reg( sbmp::DriveFloppy,   'Drive::Floppy', 'Floppy disk');
370reg( sbmp::DriveHDD,      'Drive::HDD'   , 'Hard disk');
371reg( sbmp::DriveNetwork,  'Drive::Network','Network connection');
372reg( sbmp::DriveCDROM,    'Drive::CDROM',  'CD-ROM device');
373reg( sbmp::DriveMemory,   'Drive::Memory', 'Memory-mapped drive');
374reg( sbmp::DriveUnknown,  'Drive::Unknown','FAT-64');
375
376# registering panels
377$i-> register_panel( 'Edit' => {
378	class => 'Prima::Edit',
379	text  => 'Edit window',
380	dockerProfile => {
381		fingerprint => dmfp::Edit,
382		growMode    => gm::Client,
383	},
384	profile => {
385		vScroll => 1,
386		text    => '',
387	},
388});
389$i-> register_panel( 'Banner' => {
390	class => 'Banner',
391	text  => 'Banner window',
392	dockerProfile => {
393		fingerprint => dmfp::Horizontal,
394		size => [ 200, 30]
395	},
396});
397
398
399my $resFile = Prima::Utils::path('demo_dock');
400
401# after all that, creating window ( the window itself is of small importance...)
402
403my $ww = Prima::Dock::BasicWindow -> create(
404	instance => $i,
405	onClose => sub {
406		if ( open F, "> $resFile") {
407			$_[0]-> init_write( *F);
408			close F;
409		} else {
410			warn "Cannot open $resFile:$!\n";
411		};
412	},
413	onDestroy => sub {
414		$::application-> destroy;
415	},
416	size      => [ 400, 400],
417	text       => 'Docking example',
418	onActivate    => sub { $i-> activate; },
419	onWindowState => sub { $i-> windowState( $_[1]); },
420);
421
422
423# opening predefined bars
424if ( open F, $resFile) {
425	$ww-> init_read(*F);
426	close F;
427} else {
428	$i-> predefined_panels( "Edit" => $ww-> {mainDock}-> ClientDocker);
429}
430
431$i-> predefined_toolbars( {
432	name => "File",
433	list => ["File::Open", "File::Close"],
434	dock => $ww-> {mainDock}-> TopDocker,
435	origin => [ 0, 0],
436}, {
437	name => "Edit",
438	list => [ "Edit::OK", "Edit::Cancel", ],
439	dock => $ww-> {mainDock}-> TopDocker,
440	origin => [ 0, 0],
441});
442
443#$ww-> open_dockmanaging; # uncomment this for Customize window popup immediately
444
445run Prima;
446
4471;
448