in reply to Re^3: Total Newbies TkZinc questions
in thread Total Newbies TkZinc questions

There is a (somewhat subtle) bug in the previous code. Indeed, drag does work at any scale factor, but you'll see it clearly once you understand what I mean:

  1. Start the program and add a media item (no scaling!)
  2. Position pointer in the exact center of the media item, click and drag it somewhere on the stage.
  3. Notice that when you release the item from drag, the pointer is still located in the exact position of the media item that you initiated drag from. In other words the item is translated exactly 1:1 with the mouse pointer.
  4. Hit "+" five times.
  5. Position the pointer in the exact center of media item, and drag it to the far side of the screen. You will notice that, while the item has been dragged, the pointer has offset from the point at which it was located when you first grabbed the item.

Once I understand why, it's completely logical ;-)

Try the updated version below, with good text centering, (visually) correct dragging and possibly other minor experiments.

#!/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" );

## Definition of a Tk::Zinc button (group)
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     => 'center',
#        -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_selector     => \&draw_workspace_selector,
    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_entry    => \&buttonclick_add_entry,
    buttonclick_add_anchor    => \&buttonclick_add_anchor,
    buttonclick_quit        => \&buttonclick_quit,

  # GUI events
    translate_view        => \&translate_view,
    zoom_view            => \&zoom_view,
    toggle_mouse_pans_view        => \&toggle_mouse_pans_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',
   'entrypoint'        => '=radial -15 -20|#23fa21;50|#44df44;90',
  );

  $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 cont
+ains
# 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_selector');
}


# draw_workspace_selector: POE state
# Draws a matrix of 4x5 buttons that select active workspace
sub draw_workspace_selector {
  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), -($BH/2)], [(int $BW/2), ($BH/2)] ], 
+},
   { -coords => [ 0, 0 ], 
     -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),
        ($BH/2)+(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'],
    ['Test',         'button_red',        'VOID'],
    ['Add Entrypoint',    'button_yellow',    'BTN_ADD_ENTRY' ],
    ['Exit',         'button_yellow',    'BTNQUIT'],
  );

  # Magically scale buttons to fit menu area..
  my $BH = ( $H->{iface}{menuheight} - 
             (3 + scalar @vertical_buttons)*$SP ) / scalar @vertical_b
+uttons;
             
  # Send our custom global options to the magic sub..
  my %BUTTON = ButtonFactory(
   { },
   { -coords => [[-(int $BW/2), -(int $BH/2)], [(int $BW/2), ($BH/2)]]
+, },
   { -coords => [ 0, 0], 
     -params => { -font => $H->{bigfont}, } 
   },
  );

  my $i=0;
  # Vertical buttons
  foreach (@vertical_buttons) {
    my ($text, $gradient, $tag) = @{$_};
    $BUTTON{-coords} = [ ($SW + int $BW/2)+$SP*3, ($BH/2)+ ($i*($SP+$B
+H)+$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_ENTRY','<1>', $S->postback('buttonclick_ad
+d_entry'));
  $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('toggle_
+mouse_pans_view' => 'on'   ) );
  $poe_main_window -> bind('<KeyRelease-space>',  $S->postback('toggle
+_mouse_pans_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_entry {
  my ($H) = $_[ HEAP ];
  my $current = $H->{_ws}{current};

  my %BUTTON = ButtonFactory(
   { -coords => [ 500, 500 ], 
     -params => {
       -tags => ['movable', 'WORKSPACE', $current, 'group'],
     }
   },
   { -itemtype => 'polygone',
     -numsides => 3,
     -radius    => 50,
     -corner_radius => 10,
     -startangle => 0,
     -coords => [ 0, 0 ], 
     -params => { 
       -fillcolor => 'entrypoint' ,
       -tags   => ['movable', 'WORKSPACE', $current, 'item'],
     },
   },
   { -coords => [ 0,0 ], 
     -params => { 
       -text=>'ENTRY',-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 
+=> '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 $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;

  my $current = $H->{_ws}{current};
  $H->{zinc}->scale($H->{_ws}{$current}{content}, $factor, $factor);
}

# toggle_mouse_pans_view: POE postback, posted by Key-Space
# Toggles whether B1-Motion pans current workspace (bound to key-space
+)
# BUG: This does not take scale into account
sub toggle_mouse_pans_view {
  my ($H, $tog ) = @_[ 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;

  my ($t1, $t2) = $H->{zinc}->transform(1, $H->{_ws}{$current}{content
+}, [$ev->x, $ev->y] );

  # If current item is an anchor, store global event coordinates
  # instead of coordinates transformed to the (scaled) workspace.
  if (grep(/^anchor$/, $H->{zinc}->itemcget('current', -tags)) ) {
    $H->{_ws}{$current}{_dragging} = [$ev->x, $ev->y];
  } else {
    $H->{_ws}{$current}{_dragging} = [$t1, $t2];
  }
}

# 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 ($out_dx, $out_dy);
  my $group     = $H->{zinc}->group('current');
  my $ev        = $H->{zinc}->XEvent;
  my ($dx, $dy) = @{ $H->{_ws}{$current}{_dragging} };

  # Transform the event coordinates to (scaled) workspace coords
  my ($tr_ev_x, $tr_ev_y) = $H->{zinc}->transform(1, $H->{_ws}{$curren
+t}{content}, [$ev->x, $ev -> y]);

  # If the current item is an anchor, use the global coordinates
  # for delta x/y.
  if (grep(/^anchor$/, $H->{zinc}->itemcget('current', -tags)) ) {
    $group = $H->{zinc}->group($group); # Translate parent
    $out_dx = ($ev->x - $dx); 
    $out_dy = ($ev->y - $dy);
    $H->{_ws}{$current}{_dragging} = [$ev->x, $ev->y];
  } else {
    # If it's not an anchor, then it must be a movable object in
    # the workspace. So use the transformed coordinate to ensure
    # it always moves 1:1 with the mouse pointer.
    $out_dx = ($tr_ev_x-$dx);
    $out_dy = ($tr_ev_y-$dy);
    $H->{_ws}{$current}{_dragging} = [$tr_ev_x, $tr_ev_y];
  }


  # Prevent dragging items out of the application (otherwise VERY
  # strange effects if you have multi-monitor and drag an item
  # to second display
  # - BUG: Clearly needs work, should take pointerxy into account
#  $out_dx = 0 if ($ev->x >= ($H->{SX} - $H->{iface}{spacing} ) );
#  $out_dx = 0 if ($ev->x <= $H->{iface}{spacing}               );
#  $out_dy = 0 if ($ev->y >= ($H->{SY} - $H->{iface}{spacing} ) );
#  $out_dy = 0 if ($ev->y <= ($H->{iface}{menuheight} - $H->{iface}{sp
+acing}) );

#  print "Translating: $out_dx, $out_dy\n";
#  print "Event X/Y: ", $ev->x, ", ", $ev->y;

  $H->{zinc}->translate($group, $out_dx, $out_dy );
}

# 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]

Replies are listed 'Best First'.
Re^5: Total Newbies TkZinc questions
by zentara (Cardinal) on Oct 22, 2008 at 19:05 UTC
    Yeah, I see it now, it was very subtle. There was some slippage due to the slowness of my computer, and I didn't swing in a wide circle. I was mistaking the slippage as normal, but I can see your bug now. I was also confused because if I added an anchor, not a media, there is no bug !!

    Oh well, thanks for figuring it out, and will save the correction factor for later reference.

    Once I understand why, it's completely logical ;-)

    I'm glad someone knows what they are doing. :-)

    I'm not really a human, but I play one on earth Remember How Lucky You Are
[reply]

In Section Seekers of Perl Wisdom