#!/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" ); ## 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 chain _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 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_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_buttons; # 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+$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_ENTRY','<1>', $S->postback('buttonclick_add_entry')); $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('', $S->postback('zoom_view' => 'in' ) ); $poe_main_window -> bind('', $S->postback('zoom_view' => 'out' ) ); $poe_main_window -> bind('', $S->postback('zoom_view' => 'long_in' ) ); $poe_main_window -> bind('', $S->postback('zoom_view' => 'long_out' ) ); # Pan (translation) controls $poe_main_window -> bind('', $S->postback('translate_view' => 'up' ) ); $poe_main_window -> bind('', $S->postback('translate_view' => 'down' ) ); $poe_main_window -> bind('', $S->postback('translate_view' => 'left' ) ); $poe_main_window -> bind('', $S->postback('translate_view' => 'right') ); $poe_main_window -> bind('', $S->postback('translate_view' => 'long_up' ) ); $poe_main_window -> bind('', $S->postback('translate_view' => 'long_down' ) ); $poe_main_window -> bind('', $S->postback('translate_view' => 'long_left' ) ); $poe_main_window -> bind('', $S->postback('translate_view' => 'long_right') ); # Mouse-pan (postback 'on' binds to B1-Motion, 'off' unbinds) $poe_main_window -> bind('', $S->postback('toggle_mouse_pans_view' => 'on' ) ); $poe_main_window -> bind('', $S->postback('toggle_mouse_pans_view' => 'off' ) ); # Select item if Ctrl-clicked $poe_main_window -> bind('', $S->postback('select_item') ); # Movable items $H->{zinc}->bind('movable', '<1>', $S->postback('move_item_start' ) ); $H->{zinc}->bind('movable', '', $S->postback('move_item_motion') ); $H->{zinc}->bind('movable', '',$S->postback('move_item_stop' ) ); # In case we lost focus, ALWAYS take it back.. $poe_main_window -> bind('', 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_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, '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 $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('', 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('', 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 # 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}{$current}{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}{spacing}) ); # 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 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) }; }