# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # # $Id: dock.pl,v 1.10 2005/10/13 17:22:53 dk Exp $ # =pod =item NAME Docking widgets =item FEATURES This is the demonstration of Prima::Dock and Prima::DockManager modules. The window created is docking client, and it's able to accept toolbars and panels, and toolbars in turn accept buttons. buttons are very samplish; there are two panels, Edit and Banner, that are docked in different ways. Note the following unevident features: - popup on the border of the window ( and the Customize command there) - dragging of buttons on the window and the extreior - dragging panels and toolbar to the exterior - storing of the geometry in the ~/.demo_dock file =cut use strict; use Prima; use Prima::Application; use Prima::Edit; use Prima::Buttons; use Prima::DockManager; use Prima::Utils; package dmfp; use constant Edit => 0x100000; use constant Vertical => 0x200000; use constant Horizontal => 0x400000; # This is the main window. it's responsible for # command handling and bar visiblity; # NB - bars are not owned by this window when undocked. package Prima::Dock::BasicWindow; use vars qw(@ISA); @ISA = qw(Prima::Window); sub profile_default { my $def = $_[0]-> SUPER::profile_default; my %prf = ( instance => undef, ); @$def{keys %prf} = values %prf; return $def; } sub init { my $self = shift; my %profile = $self-> SUPER::init( @_); $self-> $_($profile{$_}) for qw(instance); $self-> {toolBarPopup} = $self-> insert( Popup => autoPopup => 0, items => $self-> make_popupitems(), ); $self-> {mainDock} = $self-> insert( FourPartDocker => rect => [ 0, 0, $self-> size], fingerprint => dmfp::Tools|dmfp::Toolbar|dmfp::Edit|dmfp::Horizontal|dmfp::Vertical, dockup => $self-> instance, dockerCommonProfile => { hasPocket => 0, onPopup => sub { # all dockers would render this popup my ( $me, $btn, $x, $y) = @_; ( $x, $y) = $self-> screen_to_client( $me-> client_to_screen($x, $y)); $self-> {toolBarPopup}-> popup( $x, $y); $me-> clear_event; } }, dockerProfileClient => { # allow docking only to Edit fingerprint => dmfp::Edit, }, dockerProfileLeft => { fingerprint => dmfp::Vertical|dmfp::Tools|dmfp::Toolbar }, dockerProfileRight => { fingerprint => dmfp::Vertical|dmfp::Tools|dmfp::Toolbar }, dockerProfileTop => { fingerprint => dmfp::Horizontal|dmfp::Tools|dmfp::Toolbar }, dockerProfileBottom => { fingerprint => dmfp::Horizontal|dmfp::Tools|dmfp::Toolbar }, ); $self-> instance-> add_notification( 'ToolbarChange', \&on_toolbarchange, $self); $self-> instance-> add_notification( 'PanelChange', \&on_toolbarchange, $self); $self-> instance-> add_notification( 'Command', \&on_command, $self); return %profile; } sub make_popupitems { my $items = $_[0]-> instance-> toolbar_menuitems( \&Menu_Check_Toolbars); # actually DockManager doesn't care if panel CLSID and toolbar name intermix. # this is the demonstration of resolving that clash $$_[0] .= ',toolbar' for @$items; push ( @$items, []); push ( @$items, @{$_[0]-> instance-> panel_menuitems( \&Menu_Check_Panels)}); push ( @$items, []); push ( @$items, ['customize' => "~Customize..." => q(open_dockmanaging)]); return $items; } sub Menu_Check_Toolbars { my ( $self, $var) = @_; my $toolname = $var; $toolname =~ s/\,toolbar$//; $self-> instance-> toolbar_visible( $self-> instance-> toolbar_by_name($toolname), $self-> {toolBarPopup}-> toggle( $var) ); } sub Menu_Check_Panels { my ( $self, $var) = @_; $self-> instance-> panel_visible( $var, $self-> {toolBarPopup}-> toggle( $var)); } sub instance { return $_[0]-> {instance} unless $#_; $_[0]-> {instance} = $_[1]; } sub on_toolbarchange { $_[0]-> {toolBarPopup}-> items( $_[0]-> make_popupitems()); } sub on_command { my ( $self, $instance, $command) = @_; $command =~ s/\://g; my $x = $self-> can( $command); return unless $x; $x-> ( $self); } # we'll take our actions we need to reflect the state. sub open_dockmanaging { my $self = $_[0]; my $i = $self-> instance; return if $i-> interactiveDrag; my $wpanel = Prima::Window-> create( name => 'Customize tools', size => [ 400, 100], onClose => sub { $self-> {toolBarPopup}-> customize-> enabled(1); $i-> interactiveDrag(0); }, ); $i-> create_manager( $wpanel, dockerProfile => { hint => 'Drag here unneeded buttons', }); $i-> interactiveDrag(1); $self-> {toolBarPopup}-> customize-> enabled(0); } sub get_docks { my $self = $_[0]; my @docks = ( $self-> {mainDock}); my $sid = $self-> {mainDock}-> open_session({ self => $self-> {mainDock}, sizes => [[0,0]], sizeable => [1,1], }); if ( $sid) { while ( 1) { my $x = $self-> {mainDock}-> next_docker( $sid); last unless $x; next if $x-> isa(q(Prima::DockManager::LaunchPad)); push ( @docks, $x); } $self-> {mainDock}-> close_session( $sid); } return @docks; } sub init_read { my ( $self, $fd) = @_; my $last = undef; my @docks = $self-> get_docks; my $state; my %docks = map { my $x = $_-> name; $x =~ s/(\W)/\%sprintf("%02x",$1)/; $x => $_} @docks; while ( <$fd>) { $state = 1, last if m/^DOCK_STMT_START/; } return unless $state; my $i = $self-> instance; my %audocks; tie %audocks, 'Tie::RefHash'; while ( <$fd>) { chomp; last if m/^DOCK_STMT_END/; if ( m/^MYSELF\[(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\]/) { $self-> rect( $1,$2,$3,$4); next; } if ( m/^TOOLBAR\:(\w*)\:(\d)\:(\d)\:\[(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\]\:(.*)$/) { my ( $dockID, $vertical, $visible, $x1, $y1, $x2, $y2, $name) = ($1,$2,$3,$4,$5,$6,$7,$8); my $auto = $name =~ /^ToolBar/; my ( $x, $xcl) = $i-> create_toolbar( visible => $visible, vertical => $vertical, dock => $docks{$dockID}, rect => [ $x1, $y1, $x2, $y2], name => $name, autoClose => $auto, ); $last = $xcl; $name =~ s/(\W)/\%sprintf("%02x",$1)/; $docks{$name} = $xcl; next; } elsif ( m/^TOOL\:([^\s]+)\s\[(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\]/) { my ( $CLSID, $x1, $y1, $x2, $y2) = ($1,$2,$3,$4,$5); next unless $last; my $ctrl = $i-> create_tool( $last, $CLSID, $x1, $y1, $x2, $y2); next unless $ctrl; push @{$audocks{$last}}, $ctrl; next; } elsif ( m/^PANEL\:(\w*)\:([^\s]+)\s\[(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\]/) { my ( $dockID, $CLSID, $x1, $y1, $x2, $y2) = ($1,$2,$3,$4,$5,$6); my ( $x, $xcl) = $i-> create_panel( $CLSID, dockerProfile => { dock => $docks{$dockID}, origin => [$x1, $y1], # because original profile uses size size => [$x2 - $x1, $y2 - $y1], # this is hack to override it rect => [ $x1, $y1, $x2, $y2], }); next; } } $_-> dock_bunch( @{$audocks{$_}}) for keys %audocks; $i-> notify(q(ToolbarChange)); } sub init_write { my ( $self, $fd) = @_; print $fd "DOCK_STMT_START\n"; my @rc = $self-> rect; print $fd "MYSELF[@rc]\n"; for ( $self-> instance-> toolbars) { my $p = $_; my $x = $_-> childDocker; my ( $e, $n); my @rect = $x-> rect; if ( $p-> dock) { $e = $p; $n = $p-> dock-> name; $n =~ s/(\W)/\%sprintf("%02x",$1)/g; @rect = $p-> dock-> screen_to_client( $p-> client_to_screen( @rect)); } else { $n = ''; $e = $p-> externalDocker; @rect = $x-> client_to_screen( @rect); } my $vis = $e-> visible ? 1 : 0; my $ver = $x-> vertical ? 1 : 0; print $fd "TOOLBAR:$n:$ver:$vis:[@rect]:".$p-> text."\n"; for ( $x-> docklings) { @rect = $_-> rect; my $ena = $_-> enabled; my $CLSID = $_-> {CLSID}; next unless defined $CLSID; print $fd "TOOL:$CLSID [@rect]:$ena\n"; } } for ( $self-> instance-> panels) { my @r = $_-> dock() ? $_-> rect : $_-> externalDocker-> rect; my $n = ''; if ( $_-> dock) { $n = $_-> dock-> name; $n =~ s/(\W)/\%sprintf("%02x",$1)/g; } my $CLSID = $_-> {CLSID}; print $fd "PANEL:$n:$CLSID [@r]\n"; } print $fd "DOCK_STMT_END\n"; } sub FileOpen { $_[0]-> open_dockmanaging; } sub FileClose { $_[0]-> close; } package Banner; use vars qw(@ISA); @ISA = qw(Prima::Widget); sub on_create { my $self = $_[0]; $self-> {offset} = 0; $self-> text( "Visit www.prima.eu.org"); $self-> font-> size( 18); $self-> {maxOffset} = $self-> width; $self-> {textLen} = $self-> get_text_width( $self-> text); $self-> insert( Timer => timeout => 100 => onTick => sub { $self-> {offset} = $self-> {maxOffset} if ( $self-> {offset} -= 5) < -$self-> {textLen}; $self-> repaint; })-> start; } sub on_size { my ( $self, $ox, $oy, $x, $y) = @_; $self-> {maxOffset} = $x; } sub on_paint { my ( $self, $canvas) = @_; $canvas-> clear; my @sz = $self-> size; $canvas-> text_out( $self-> text, $self-> {offset}, ( $sz[1] - $canvas-> font-> height) / 2); } package X; # createing the docking instance with predefined command state my $i = Prima::DockManager-> create( commands => { 'Edit::OK' => 0, 'Edit::Cancel' => 0, }, ); # registering buttons sub reg { my ( $id, $name, $hint, %profile) = @_; $i-> register_tool( Prima::DockManager::S::SpeedButton::class( "sysimage.gif:$id", $name, hint => $hint, %profile)); } reg( sbmp::SFolderOpened, 'File::Open', 'Rearrange buttons'); reg( sbmp::SFolderClosed, 'File::Close', 'Close document'); reg( sbmp::GlyphOK, 'Edit::OK', 'OK', glyphs => 2); reg( sbmp::GlyphCancel, 'Edit::Cancel','Cancel', glyphs => 2); reg( sbmp::DriveFloppy, 'Drive::Floppy', 'Floppy disk'); reg( sbmp::DriveHDD, 'Drive::HDD' , 'Hard disk'); reg( sbmp::DriveNetwork, 'Drive::Network','Network connection'); reg( sbmp::DriveCDROM, 'Drive::CDROM', 'CD-ROM device'); reg( sbmp::DriveMemory, 'Drive::Memory', 'Memory-mapped drive'); reg( sbmp::DriveUnknown, 'Drive::Unknown','FAT-64'); # registering panels $i-> register_panel( 'Edit' => { class => 'Prima::Edit', text => 'Edit window', dockerProfile => { fingerprint => dmfp::Edit, growMode => gm::Client, }, profile => { vScroll => 1, text => '', }, }); $i-> register_panel( 'Banner' => { class => 'Banner', text => 'Banner window', dockerProfile => { fingerprint => dmfp::Horizontal, size => [ 200, 30] }, }); my $resFile = Prima::Utils::path('demo_dock'); # after all that, creating window ( the window itself is of small importance...) my $ww = Prima::Dock::BasicWindow -> create( instance => $i, onClose => sub { if ( open F, "> $resFile") { $_[0]-> init_write( *F); close F; } else { warn "Cannot open $resFile:$!\n"; }; }, onDestroy => sub { $::application-> destroy; }, size => [ 400, 400], text => 'Docking example', onActivate => sub { $i-> activate; }, onWindowState => sub { $i-> windowState( $_[1]); }, ); # opening predefined bars if ( open F, $resFile) { $ww-> init_read(*F); close F; } else { $i-> predefined_panels( "Edit" => $ww-> {mainDock}-> ClientDocker); } $i-> predefined_toolbars( { name => "File", list => ["File::Open", "File::Close"], dock => $ww-> {mainDock}-> TopDocker, origin => [ 0, 0], }, { name => "Edit", list => [ "Edit::OK", "Edit::Cancel", ], dock => $ww-> {mainDock}-> TopDocker, origin => [ 0, 0], }); #$ww-> open_dockmanaging; # uncomment this for Customize window popup immediately run Prima; 1;