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