1. Is there a way..

I construct buttons with similar characteristics and only a few varying options. I could not find a way in Tk::Zinc(::Graphics) to do this, so I devised the following method:

sub ButtonFactory { 
  my ($custom_options, $shape, $text) = @_;
  $$custom_options{-items}{shape}  = $shape;
  $$custom_options{-items}{text}   = $text;
  return %{ merge( \%button_skeleton, $custom_options) };
}
# merge is Hash::Merge
[download]

So I can do stuff like

my %BUTTON = ButtonFactory(..);
for (1..20) {
  $BUTTON{option} = 'value';
  buildZincItem(.., .., $BUTTON);
}
[download]

Am I missing something here? Is there a better way to do this? And if not, exactly how poor is the method I devised, and is there any obvious slow/bad code in it?

See subs draw_workspace_select and draw_interface

2. Centering text within button

I need to create an atomic group with a roundedrectangle and a text item. The text item should be centered on the roundedrectangle. Horizontal alignment is ok, but I cannot find a reliable way of positioning it vertically.

# $BW = Button Width
# $BH = Button Height
# $aspect = Aspect ratio of sceen ie 1.666
  my %BUTTON = ButtonFactory( 
   { },
   { -coords => [[-(int $BW/2), 0], [(int $BW/2), $BH]], },
   { -coords => [ 0, int ($BH * $aspect ) / 5.5 ],
     -params => {
       -font => $H->{bigfont},
     } 
   },
  );
[download]

This absolute hack seems to work for my two monitors on my two resoutions (1920x1200 and 1280x1024) with the given button sizes. But obviously it is retarded - how can I do this reliably for any given 'container' size?

3. Delta x/y troubles

I tag some items with 'movable', which in turn has some mouse bindings that allow me to drag them around. This works perfectly, except if there is a scale translation active. In this case delta x/y does not take into account the scale factor, and the item is moved faster/slower than the mouse pointer instead of 1:1. I have tried various methods to compensate for this, but none work as expected.

To reproduce, start program, click 'add media', drag resulting item in workspace. Change scale factor (+/-) and try again. (see sub move_item_motion).

4. Did I miss something..?

I feel like I'm doing extra work maintaining information about the screen size and aspect and how to create items at the correct scale, and position them. (see sub interface_math)

Am I completely overlooking some feature set that allows me to do these things more accurately/cleaner?

Concluding remarks

I'd be very interested in all kinds of feedback regarding my POE/Zinc solution here. It is my first attempt, and I have already refactored it a number of times as I learn new stuff. Are there any obvious features of POE or Zinc that would have eased my implementation that I have yet to discover?

Looking forward to your input..

PS: Only tested on my Linux system. Requires Tk, POE, Tk::Zinc, Tk::Zinc::Graphics and Hash::Merge

Overview of bindings in below program

• Button 'add media' adds an item to current workspace
• Button 'add anchor' adds an anchor item to current workspace (fixed position, just a test)
• Button 1 click-and-drag on 'media' items (translates item)
• Button 1 click-and-drag on 'anchor' items (translates workspace)
• Hold Space+click and drag on workspace, translates workspace
• Click and hold button 1 on media item, then click and hold space - translates item AND workspace
• Arrows Up/Down/Left/Right - Translate view. Control-<arrow> for "long" version
• + / - changes scale. Control-plus/Control-minus for long zoom in/out

650 lines of code follow

#!/usr/bin/perl

use strict;
use warnings;
use Tk;
use POE;
use Tk::Zinc;
use Tk::Zinc::Graphics;
use Hash::Merge qw{ merge };
# Only one line has been changed from default RIGHT_PRECEDENT setting,
+ 
# avoid duplicates with array parameters such as -coords=>[], overwrit
+e them.

Hash::Merge::specify_behavior( {
  SCALAR => {
    SCALAR => sub { $_[1] },
    ARRAY  => sub { [ $_[0], @{$_[1]} ] },
    HASH   => sub { $_[1] } },
  ARRAY => {
    SCALAR => sub { $_[1] },
    ARRAY  => sub { $_[1] }, # <-- This one!
    HASH   => sub { $_[1] } },
  HASH => {
    SCALAR => sub { $_[1] },
    ARRAY  => sub { [ values %{$_[0]}, @{$_[1]} ] },
    HASH   => sub { Hash::Merge::_merge_hashes( $_[0], $_[1] ) } }
}, "SkeletonMerger" );

my %button_skeleton = (
  -itemtype    => 'group',
  -atomic    => 1,
  -sensitive    => 1,
  -coords    => [50, 500],
  -items    => {
    'shape'    => {
      -itemtype => 'roundedrectangle',
      -params    => {
        -closed        => 1, 
        -filled        => 1, 
        -fillcolor     => 'button',
        -linewidth     => 1,
        -linecolor     => '#ffffff',
        -priority      => 10,
      }
    },
    'text'    => {
      -itemtype => 'text',
      -params    => {
        -color     => '#ffffff',
        -anchor     => 'n',
        -alignment     => 'center',
        -priority     => 20,
      }
    }
  }
);

POE::Session->create(
  inline_states    => {
  # Initialize the application GUI, these are all called in one long c
+hain
    _start            => \&zinc_init,
    interface_math        => \&interface_math,
    init_workspaces        => \&init_workspaces,
    draw_decoration        => \&draw_decoration,
    draw_workspace_select     => \&draw_workspace_select,
    draw_interface        => \&draw_interface,
    set_bindings        => \&set_bindings,
    set_active_workspace    => \&set_active_workspace,

  # Button postbacks from Tk
    buttonclick_workspace     => \&buttonclick_workspace,
    buttonclick_add_media    => \&buttonclick_add_media,
    buttonclick_add_anchor    => \&buttonclick_add_anchor,
    buttonclick_quit        => \&buttonclick_quit,

  # GUI events
    translate_view        => \&translate_view,
    zoom_view            => \&zoom_view,
    mouse_pan_view        => \&mouse_pan_view,

  # Item is being dragged in workspace
    select_item            => \&select_item,
    move_item_start        => \&move_item_start,
    move_item_stop         => \&move_item_stop,
    move_item_motion        => \&move_item_motion,
  },
);

$poe_kernel -> run();

exit 0;

# zinc_init: POE state
# Initialize a Zinc widget on the $poe_main_window, create a
# few toplevel (Zinc) groups and then enters fullscreen.
sub zinc_init {
  my ($K, $H) = @_[ KERNEL, HEAP ];

  my %gradients = (
   'menu_background'=> '=path 48 48|#e7ffe7;20 0 70|#007900;20',
   'button_red'     => '=axial 250|#ff0000;20|#660000;30',
   'button_yellow'  => '=axial 250|#aeb320;20|#cfb316;30',
   'button'        => '=axial 250|#aaaaaa;50|#a8a8a8;30',
   'button_workspace_active' => '=axial 250|#aeb333;50|#cfb316;30',
   'button_workspace' => '=axial 250|#aaaaaa;50|#a8a8a8;30',
   'anchor'        => '=axial 220|#d100c5;50|#a221f1;30',
   
  );

  $H->{SX} = $poe_main_window -> screenwidth;
  $H->{SY} = $poe_main_window -> screenheight;
  $H->{zinc}     = $poe_main_window -> Zinc(
    -render    => 1,
    -width    => $H->{SX},
    -height    => $H->{SY},
    -borderwidth=> 0,
    -backcolor    => '#222222'
  ) -> pack;
  $K->signal_ui_destroy($H->{zinc});
  die "OpenGL required.\n" if ($H->{zinc}->cget(-render) < 1);

  &setGradients($H->{zinc}, \%gradients);

  $H->{_decoration_group} = $H->{zinc} -> add(
    'group', 1, 
    -atomic => 1, 
    -sensitive => 0, 
    -tags => ['decoration']
  );

  $H->{_button_group}       = $H->{zinc} -> add(
    'group', 1, 
    -atomic => 0, 
    -sensitive => 1, 
    -priority => 10, 
    -tags => ['ifacebutton']
  );

  $H->{_workspace_group}  = $H->{zinc} -> add(
    'group', 1, 
    -atomic => 0, 
    -sensitive => 1, 
    -priority => 20, 
    -tags => ['ifacebutton']
  );

  $poe_main_window -> focusForce;
  $poe_main_window -> FullScreen(1);
  $poe_main_window -> overrideredirect(0);
  $poe_main_window -> resizable(0,0);

  $K -> yield('interface_math');
}

# interface_math: POE state
# Calculate positions for elements of the GUI (as this varies from com
+puter
# to computer. This has NOT been extensively tested and probably conta
+ins
# a huge amount of bugs and/or unknown side-effects. 
sub interface_math {
  my ($K, $S, $H) = @_[ KERNEL, SESSION, HEAP ];

  my $aspect       = $H->{SX} / $H->{SY};
  my $widescreen   = $aspect  >= 1.5 ? 1 : 0; 
  my $menuheight   = int $H->{SX}/5;
  my $buttonwidth  = 170;
  my $buttonheight = 30;

  if ($widescreen) {
    $menuheight  = int $menuheight  * 0.8;
    $buttonwidth = int $buttonwidth * 1.2;
    $buttonheight= int $buttonheight* 1.3;
  } 

  if ($H->{SX} >= 1400) {
    $menuheight   = int $menuheight   * 1.2;
    $buttonwidth  = int $buttonwidth  * 1.2;
    $buttonheight = int $buttonheight * 1.2;
  }

  my @fontsize = (70,   95, 120);
  @fontsize    = (90,  110, 130) if ($H->{SX} >= 1024);
  @fontsize    = (100, 120, 140) if ($H->{SX} >= 1280);
  @fontsize    = (110, 150, 200) if ($H->{SX} >= 1600);

  my $basefont = '-adobe-arial-bold-r-normal--*-%d-*-*-*-*-*-*';
  $H->{smallfont} = sprintf($basefont, $fontsize[0]);
  $H->{font}       = sprintf($basefont, $fontsize[1]);
  $H->{bigfont}   = sprintf($basefont, $fontsize[2]);

  # Store results on the heap
  $H->{iface} = {
    'aspect'        => $aspect,
    'menuheight'     => $menuheight,
    'buttonwidth'    => $buttonwidth,
    'buttonheight'    => $buttonheight,
    'spacing'        => 5,  # don't go crazy
    'step_size'        => 10, # translation
  };

  $K -> yield('init_workspaces');
}

# init_workspaces: POE state
# Initialize workspaces, that is to say, the necessary Zinc groups to 
+hold 
# the workspace area, as well as define clipping area for each workspa
+ce.
sub init_workspaces {
  my ($K, $S, $H) = @_[ KERNEL, SESSION, HEAP ];

  # Shortcuts to interface calculations, at expense of clarity.
  my $SP = $H->{iface}->{spacing};
  my $MH = $H->{iface}->{menuheight};

  for (1..20) {
    # Add the toplevel 'page' group
    $H->{_ws}{$_}{page} = $H->{zinc}->add(
      'group', 
      $H->{_workspace_group},
      -atomic => 0,
      -sensitive => 1,
      -tags => ['WORKSPACE', $_, 'page']
    );

    # Create clipping area
    $H->{_ws}{$_}{clip} = $H->{zinc} -> add(
      'rectangle', 
      $H->{_ws}{$_}{page},
      [[ $SP, $MH+$SP ],
       [ $H->{SX}-$SP, $H->{SY}-$SP]],
      -linewidth => 1,
      -linecolor => '#000000',
      -filled    => 1,
      -fillcolor => '#000000;2',
      -visible => 0,
      -tags => ['WORKSPACE', $_, 'clip'],
    );

    # Add it to the page group
    $H->{zinc}->itemconfigure(
      $H->{_ws}{$_}{page}, 
      -clip => $H->{_ws}{$_}{clip},
    );
    
    # And finally create the content group
    $H->{_ws}{$_}{content} = $H->{zinc}->add(
      'group', 
      $H->{_ws}{$_}{page},
      -visible => 0,
      -tags => ['WORKSPACE', $_, 'content'],
    );
    
    # TEST - populate worksace
    $H->{zinc}->add('text', 
      $H->{_ws}{$_}{content},
      -position => [20, $H->{iface}{menuheight}+20],
      -font => $H->{bigfont},
      -text => "This is workspace number: $_",
      -color => '#ffffff',
      -tags => ['WORKSPACE', $_, 'item'],
    );

  } # 1..20
  $K -> yield('draw_decoration');
}

# draw_decoration: POE state
# Draws static interface decoration (on init)
sub draw_decoration {
  my ($K, $S, $H) = @_[ KERNEL, SESSION, HEAP ];

  my $MH = $H->{iface}->{menuheight};
  
  &buildZincItem($H->{zinc}, $H->{_decoration_group},
    -itemtype    => 'roundedrectangle',
    -coords    => [ [0, 0], [$H->{SX}, $MH] ],
    -trunc    => 'right',
    -params    => { 
      -closed         => 1, 
      -filled         => 1,
      -fillcolor     => 'menu_background',
      -linewidth    => 1,
      -linecolor     => '#ffffff',
      -priority         => 10,
      -sensitive    => 0,
    });

  $K->yield('draw_workspace_select');
}


# draw_workspace_select: POE state
# Draws a matrix of 4x5 buttons that select active workspace
sub draw_workspace_select {
  my ($K, $S, $H) = @_[ KERNEL, SESSION, HEAP ];

  my $SP = $H->{iface}->{spacing};
  my $BH = ($H->{iface}->{menuheight} - 8*$SP) / 5;
  my $BW = $BH * 1.5 ;

  my %BUTTON = ButtonFactory(
   { },
   { -coords => [[-(int $BW/2), 0], [(int $BW/2), $BH]], },
   { -coords => [ 0, int ($BH * $H->{iface}->{aspect} ) / 5.5 ], 
     -params => {
       -font => $H->{bigfont}, 
     } 
   },
  );

  my $row = 0;
  
  # Construct a matrix of 20 %BUTTONs, with changing options...
  for (1..20) {
    $BUTTON{-coords} = 
      [ int ( $BW/2  + $SP*3  )+$row*($BW+$SP),
        int (($_ - 1)-($row*5))*($SP+$BH)+$SP*2 ];

    $BUTTON{-items}{shape}{-params}{-fillcolor} = 'button_workspace';
    $BUTTON{-items}{shape}{-params}{-tags} = ['BTNSET_WS', $_, 'shape'
+];
    $BUTTON{-items}{text} {-params}{-tags} = ['BTNSET_WS', $_, 'text' 
+];
    $BUTTON{-items}{text} {-params}{-text} = $_;

    &buildZincItem($H->{zinc}, $H->{_button_group}, %BUTTON);

    $row++ if ($_ % 5 == 0);
  }

  $H->{iface}{selectorwidth} = $SP*3 + ( ($BW+$SP)*4 );

  $K->yield('draw_interface');
}

# draw_interface: POE state
# Draws elements on the GUI  
sub draw_interface {
  my ($K, $S, $H) = @_[ KERNEL, SESSION, HEAP ];

  # Shortcuts to interface calculations, at expense of clarity.
  my $BW = $H->{iface}->{buttonwidth};
  my $SP = $H->{iface}->{spacing};
  my $SW = $H->{iface}->{selectorwidth};

  # Ad-hoc data structure with only the options we need.
  my @vertical_buttons = (
    ['Add Media',    'button_yellow',    'BTN_ADD_MEDIA' ],
    ['Add Anchor',     'button_yellow',    'BTN_ADD_ANCHOR'],
    ['Test',         'button_red',        'VOID'],
    ['Test',         'button_red',        'VOID'],
    ['Test',         'button_red',        'VOID'],
    ['Exit',         'button_yellow',    'BTNQUIT'],
  );

  my $BH = ($H->{iface}{menuheight} - 9*$SP) / 6;
  # Send our custom options to the magic sub..
  my %BUTTON = ButtonFactory(
   { },
   { -coords => [[-(int $BW/2), 0], [(int $BW/2), $BH]], },
   { -coords => [ 0, int ($BH * $H->{iface}->{aspect} ) / 5.5 ], 
     -params => { -font => $H->{bigfont}, } 
   },
  );

  my $i=0;
  # Vertical buttons
  foreach (@vertical_buttons) {
    my ($text, $gradient, $tag) = @{$_};
    $BUTTON{-coords} = [ ($SW + int $BW/2)+$SP*3, $i*($SP+$BH)+$SP*2 ]
+;
    $BUTTON{-items}{shape}{-params}{-fillcolor} = $gradient;
    $BUTTON{-items}{shape}{-params}{-tags} = [$tag, $_, 'shape'];
    $BUTTON{-items}{text} {-params}{-tags} = [$tag, $_, 'text' ];
    $BUTTON{-items}{text} {-params}{-text} = $text;

    &buildZincItem($H->{zinc}, $H->{_button_group}, %BUTTON);
    $i++;
  }

  $K->yield('set_bindings');
}

sub set_bindings {
  my ($K, $S, $H) = @_[ KERNEL, SESSION, HEAP ];


  # Interface buttons, each with its own POE state
  $H->{zinc}->bind('BTNQUIT',        '<1>', $S->postback('buttonclick_
+quit')     );
  $H->{zinc}->bind('BTN_ADD_MEDIA','<1>', $S->postback('buttonclick_ad
+d_media'));
  $H->{zinc}->bind('BTN_ADD_ANCHOR','<1>', $S->postback('buttonclick_a
+dd_anchor'));
  $H->{zinc}->bind('BTNSET_WS',       '<1>', $S->postback('buttonclick
+_workspace'));

  # Zoom controls
  $poe_main_window -> bind('<plus>',              $S->postback('zoom_v
+iew' => 'in'        ) );
  $poe_main_window -> bind('<minus>',              $S->postback('zoom_
+view' => 'out'       ) );
  $poe_main_window -> bind('<Control-Key-plus>',  $S->postback('zoom_v
+iew' => 'long_in'   ) );
  $poe_main_window -> bind('<Control-Key-minus>', $S->postback('zoom_v
+iew' => 'long_out'  ) );

  # Pan (translation) controls
  $poe_main_window -> bind('<KeyPress-Up>',       $S->postback('transl
+ate_view' => 'up'   ) );
  $poe_main_window -> bind('<KeyPress-Down>',     $S->postback('transl
+ate_view' => 'down' ) );
  $poe_main_window -> bind('<KeyPress-Left>',     $S->postback('transl
+ate_view' => 'left' ) );
  $poe_main_window -> bind('<KeyPress-Right>',    $S->postback('transl
+ate_view' => 'right') );
  $poe_main_window -> bind('<Control-KeyPress-Up>',    $S->postback('t
+ranslate_view' => 'long_up'   ) );
  $poe_main_window -> bind('<Control-KeyPress-Down>',  $S->postback('t
+ranslate_view' => 'long_down' ) );
  $poe_main_window -> bind('<Control-KeyPress-Left>',  $S->postback('t
+ranslate_view' => 'long_left' ) );
  $poe_main_window -> bind('<Control-KeyPress-Right>', $S->postback('t
+ranslate_view' => 'long_right') );

  # Mouse-pan (postback 'on' binds to B1-Motion, 'off' unbinds)
  $poe_main_window -> bind('<Key-space>',        $S->postback('mouse_p
+an_view' => 'on'   ) );
  $poe_main_window -> bind('<KeyRelease-space>',  $S->postback('mouse_
+pan_view' => 'off'  ) );

  # Select item if Ctrl-clicked
  $poe_main_window -> bind('<Double-ButtonPress-1>', $S->postback('sel
+ect_item') );

  # Movable items
  $H->{zinc}->bind('movable', '<1>',           $S->postback('move_item
+_start' ) );
  $H->{zinc}->bind('movable', '<B1-Motion>',      $S->postback('move_i
+tem_motion') );
  $H->{zinc}->bind('movable', '<ButtonRelease-1>',$S->postback('move_i
+tem_stop'  ) );

  # In case we lost focus, ALWAYS take it back..
  $poe_main_window -> bind('<ButtonPress-1>',  sub{$poe_main_window->f
+ocusForce;});

  
  $poe_main_window -> focusForce;

  # Activate workspace 1 
  $H->{zinc}->itemconfigure('(BTNSET_WS && shape && 1)', -fillcolor =>
+ 'button_workspace_active');
  $K->yield('set_active_workspace', 1);
}

# set_active_workspace: POE state
# Lowers all workspaces and raises selection
sub set_active_workspace {
  my ($H, $id) = @_[ HEAP, ARG0 ];
  $H->{zinc}->itemconfigure('(WORKSPACE && content)', -visible => 0);
  $H->{zinc}->itemconfigure('(WORKSPACE && clip)',    -visible => 0);
  $H->{zinc}->itemconfigure("(WORKSPACE && $id && clip)",    -visible 
+=> 1);
  $H->{zinc}->itemconfigure("(WORKSPACE && $id && content)", -visible 
+=> 1);
  $H->{zinc}->lower("WORKSPACE");
  $H->{zinc}->raise("(WORKSPACE && $id)");

  $H->{_ws}{current} = $id;
  return;
}

# ---------------------------------------------------------
# ---           END OF INITIALIZATION CHAIN             ---
# --- EVERYTHING FROM HERE ON IS BASED ON GUI CALLBACKS ---
# ---------------------------------------------------------

# buttonclick_quit: POE postback from 'Quit' button
sub buttonclick_quit {
  my ($K, $S, $H) = @_[ KERNEL, SESSION, HEAP ];
  $poe_main_window -> destroy($H->{zinc});
  return;  
}

# buttonclick_add_media: POE postback from 'Add media' button
# Should add a new 'Media' item to the workspace..
sub buttonclick_add_media {
  my ($H) = $_[ HEAP ];
  my $current = $H->{_ws}{current};

  my %BUTTON = ButtonFactory(
   { -coords => [ 500, 500 ], 
     -params => {
       -tags    => ['movable', 'WORKSPACE', $current, 'group'],
     }
   },
   { -coords => [[ 0, 0 ], [100, 50]], 
     -params => { 
       -fillcolor => 'button' ,
       -tags   => ['movable', 'WORKSPACE', $current, 'item'],
     },
   },
   { -coords => [ 0,-5 ], 
     -params => { 
       -text=>'-MEDIA-',-font => $H->{bigfont}, 
       -tags   => ['selectable', 'movable', 'WORKSPACE', $current, 'it
+em'],
     } 
   },
  );
  &buildZincItem($H->{zinc},$H->{_ws}{$current}{content}, %BUTTON);
}

sub buttonclick_add_anchor {
  my ($H) = $_[ HEAP ];
  my $current = $H->{_ws}{current};

  my %BUTTON = ButtonFactory(
   { -coords => [ $H->{SX}/2, ($H->{SY}+ $H->{iface}{menuheight})/2], 
     -params => {
       -tags    => ['movable', 'anchor', 'WORKSPACE', $current, 'group
+'],
     }
   },
   { -coords => [[ 0, 0 ], [50, 50]], 
     -params => { 
       -fillcolor => 'anchor' ,
       -tags   => ['movable', 'anchor', 'WORKSPACE', $current ],
     },
   },
   { -coords => [ 0,-5 ], 
     -params => { 
       -text=>'-ANCHOR-',-font => $H->{bigfont}, 
       -tags   => ['movable', 'anchor', 'WORKSPACE', $current ],
     } 
   },
  );

  &buildZincItem($H->{zinc},$H->{_ws}{$current}{content}, %BUTTON);


}

# buttonclick_workspace: POE postback from Workspace Selector
# Activates corresponding button in the matrix and then raise
# the workspace by yielding set_active_workspace
sub buttonclick_workspace {
  my ($K, $H) = @_[ KERNEL, HEAP ];
  my ($id)   = grep (/^[0-9]+/, $H->{zinc}->itemcget('current', -tags)
+);
  $H->{zinc}->itemconfigure('(BTNSET_WS && shape)', -fillcolor => 'but
+ton_workspace');
  $H->{zinc}->itemconfigure("(BTNSET_WS && shape && $id)", -fillcolor 
+=> 'button_workspace_active');
  $K->yield('set_active_workspace', $id);
}

# translate_view: POE postback
# Translates (pans) current workspace up/down/left/right
sub translate_view {
  my ($H, $dir) = @_[ HEAP, ARG0 ];
  $dir = shift @{$dir};

  my $current = $H->{_ws}{current};
  my $SZ = $H->{iface}{step_size};

  my $dx = ($dir eq 'left') ? $SZ : ($dir eq 'right') ? -$SZ : 0;
  my $dy = ($dir eq 'up'  ) ? $SZ : ($dir eq 'down' ) ? -$SZ : 0;
     $dx = ($dir eq 'long_left') ? $SZ*10 : ($dir eq 'long_right') ? -
+($SZ*10) : $dx;
     $dy = ($dir eq 'long_up'  ) ? $SZ*10 : ($dir eq 'long_down' ) ? -
+($SZ*10) : $dy;

  $H->{zinc}->translate($H->{_ws}{$current}{content}, $dx, $dy);
}

# zoom_view: POE postback
# Zooms current workspace in/long_in or out/long_out 
# FIXME: Breaks dx/dy on movable items
sub zoom_view {
  my ($K, $H, $dir, $long) = @_[ KERNEL, HEAP, ARG0, ARG1 ];
  $dir  = shift @{$dir};
  $long = shift @{$long};
  my $current = $H->{_ws}{current};
  my ($scale) = $H->{zinc}->tget($H->{_ws}{$current}{content}, 'scale'
+);

  my $factor = ($dir eq 'long_in') ? 1.5 : ($dir eq 'long_out') ? 0.5 
+: undef;
     $factor = ($dir eq 'in')      ? 1.1 : ($dir eq 'out')      ? 0.9 
+: $factor;
  print "Zoom $dir - $scale - $factor\n";  
     
  $H->{zinc}->scale($H->{_ws}{$current}{content}, $factor, $factor);
}

# mouse_pan_view: POE postback, posted by Key-Space
# Toggles whether B1-Motion pans current workspace (bound to key-space
+)
sub mouse_pan_view {
  my ($K, $H, $tog ) = @_[ KERNEL, HEAP, ARG0 ];
  $tog = shift @{$tog};

  # Toggle ON - bind anon sub to B1-Motion
  if ($tog eq 'on' and not $H->{_panning}) {

    $H->{_panning}      = $poe_main_window->pointerxy;
    $poe_main_window->bind('<B1-Motion>', sub {
      my $current = $H->{_ws}->{current};
      my $ev      = $H->{zinc}->XEvent;
        $H->{zinc}->translate(
          $H->{_ws}{$current}{content}, 
          ( $ev->x - $H->{_panning}[0] ),
          ( $ev->y - $H->{_panning}[1] ),
        );
      $H->{_panning} = [$ev->x, $ev->y];
    } );
  # Space was released, turn panning off
  } elsif ($tog eq 'off' and defined($H->{_panning})) {
    $poe_main_window->bind('<B1-Motion>', undef);
    delete $H->{_panning};
  }
}

# move_item_start: POE postback
# Is bound to all items with 'movable' tag, star
sub move_item_start {
  my ($H) = $_[HEAP];
  # Do not allow moving item if Panning is in progress
  return if defined($H->{_panning});

  my $current = $H->{_ws}{current};
  my $ev      = $H->{zinc}->XEvent;
  $H->{_ws}{$current}{_dragging} = [$ev->x, $ev->y];

}

# move_item_motion: POE postback
# <B1-Motion> on a movable object, handles repositioning
# BUG: dx/dy breaks if workspace is zoomed!!
sub move_item_motion {
  my ($H) = $_[HEAP];
  my $current   = $H->{_ws}{current};
  return unless defined($H->{_ws}{$current}{_dragging});

  my $ev        = $H->{zinc}->XEvent;
  my ($dx, $dy) = @{ $H->{_ws}{$current}{_dragging} };
  my $group     = $H->{zinc}->group('current');
 
  if (grep(/^anchor$/, $H->{zinc}->itemcget('current', -tags)) ) {
    $group = $H->{zinc}->group($group);
  } 
 
  $H->{zinc}->translate($group, 
    ($ev->x - ($dx)), 
    ($ev->y - ($dy)),
  );

  $H->{_ws}{$current}{_dragging} = [$ev->x, $ev->y];
}
# move_item_stop: POE postback
# B1-Motion on movable item is finished.
sub move_item_stop {
  my ($H) = $_[HEAP];
  my $current = $H->{_ws}{current};
  delete $H->{_ws}{$current}{_dragging};
  return;
}

sub select_item {
  my ($H) = $_[HEAP];
  my $current = $H->{_ws}{current};
  my $ev      = $H->{zinc}->XEvent;
  #Stub
}


# Takes three (hash) arguments, the latter two are merged directly int
+o the first,
# forming an incomplete Tk::Zinc::Graphics tree. It is then merged wit
+h 
# %button_skeleton, providing a complete widget tree with custom optio
+ns.
sub ButtonFactory {
  my ($custom_options, $shape, $text) = @_;
  $$custom_options{-items}{shape}  = $shape;
  $$custom_options{-items}{text}   = $text;
  return %{ merge( \%button_skeleton, $custom_options) };
}
[download]