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

##</code><code>##

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

##</code><code>##

# $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},
     } 
   },
  );

##</code><code>##

#!/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=>[], overwrite 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 chain
    _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 computer
# to computer. This has NOT been extensively tested and probably contains
# 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 workspace.
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_add_media'));
  $H->{zinc}->bind('BTN_ADD_ANCHOR','<1>', $S->postback('buttonclick_add_anchor'));
  $H->{zinc}->bind('BTNSET_WS',	   '<1>', $S->postback('buttonclick_workspace'));

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

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

  # Mouse-pan (postback 'on' binds to B1-Motion, 'off' unbinds)
  $poe_main_window -> bind('<Key-space>',  	  $S->postback('mouse_pan_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('select_item') );

  # Movable items
  $H->{zinc}->bind('movable', '<1>', 		  $S->postback('move_item_start' ) );
  $H->{zinc}->bind('movable', '<B1-Motion>',	  $S->postback('move_item_motion') );
  $H->{zinc}->bind('movable', '<ButtonRelease-1>',$S->postback('move_item_stop'  ) );

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

  
  $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, 'item'],
     } 
   },
  );
  &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 => 'button_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 into the first,
# forming an incomplete Tk::Zinc::Graphics tree. It is then merged with 
# %button_skeleton, providing a complete widget tree with custom options.
sub ButtonFactory {
  my ($custom_options, $shape, $text) = @_;
  $$custom_options{-items}{shape}  = $shape;
  $$custom_options{-items}{text}   = $text;
  return %{ merge( \%button_skeleton, $custom_options) };
}