Deliantra-Client/DC/BindingEditor.pm

package CFPlus::BindingEditor;

use strict;

use CFPlus::UI;

our @ISA = CFPlus::UI::Toplevel::;

my @ALLOWED_MODIFIER_KEYS = (
   CFPlus::SDLK_LSHIFT,
   CFPlus::SDLK_LCTRL ,
   CFPlus::SDLK_LALT  ,
   CFPlus::SDLK_LMETA ,

   CFPlus::SDLK_RSHIFT,
   CFPlus::SDLK_RCTRL ,
   CFPlus::SDLK_RALT  ,
   CFPlus::SDLK_RMETA ,
);

my %ALLOWED_MODIFIERS = (
   CFPlus::KMOD_LSHIFT => "LSHIFT",
   CFPlus::KMOD_LCTRL  => "LCTRL",
   CFPlus::KMOD_LALT   => "LALT",
   CFPlus::KMOD_LMETA  => "LMETA",

   CFPlus::KMOD_RSHIFT => "RSHIFT",
   CFPlus::KMOD_RCTRL  => "RCTRL",
   CFPlus::KMOD_RALT   => "RALT",
   CFPlus::KMOD_RMETA  => "RMETA",
);

my %DIRECT_BIND_CHARS = map { $_ => 1 } qw/0 1 2 3 4 5 6 7 8 9/;
my @DIRECT_BIND_KEYS = (
   CFPlus::SDLK_F1,
   CFPlus::SDLK_F2,
   CFPlus::SDLK_F3,
   CFPlus::SDLK_F4,
   CFPlus::SDLK_F5,
   CFPlus::SDLK_F6,
   CFPlus::SDLK_F7,
   CFPlus::SDLK_F8,
   CFPlus::SDLK_F9,
   CFPlus::SDLK_F10,
   CFPlus::SDLK_F11,
   CFPlus::SDLK_F12,
   CFPlus::SDLK_F13,
   CFPlus::SDLK_F14,
   CFPlus::SDLK_F15,
);

sub keycombo_to_name {
   my ($mod, $sym) = @_;

   my $mods = join '+',
                 map { $ALLOWED_MODIFIERS{$_} }
                    grep { ($_ + 0) & ($mod + 0) }
                       keys %ALLOWED_MODIFIERS;
   $mods .= "+" if $mods ne '';

   return $mods . CFPlus::SDL_GetKeyName ($sym);
}

sub new {
   my $class = shift;

   my $self = $class->SUPER::new (
      binding  => [],
      commands => [],
      title    => "Macro/Keybinding Recorder",
      @_
   );

   $self->add (my $vb = new CFPlus::UI::VBox);

   $vb->add ($self->{rec_btn} = new CFPlus::UI::Button
      text => "start recording",
      tooltip => "Start/Stops recording of actions."
                ."All subsequent actions after the recording started will be captured."
                ."The actions are displayed after the record was stopped."
                ."To bind the action you have to click on the 'Bind' button",
      on_activate => sub {
         unless ($self->{recording}) {
            $self->start;
         } else {
            $self->stop;
         }
      });

   $vb->add (new CFPlus::UI::Label text => "Actions:");
   $vb->add ($self->{cmdbox} = new CFPlus::UI::VBox);

   $vb->add (new CFPlus::UI::Label text => "Bound to: ");
   $vb->add (my $hb = new CFPlus::UI::HBox);
   $hb->add ($self->{keylbl} = new CFPlus::UI::Label expand => 1);
   $hb->add (new CFPlus::UI::Button
      text => "bind",
      tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
      on_activate => sub {
         $self->ask_for_bind;
      });

   $vb->add (my $hb = new CFPlus::UI::HBox);
   $hb->add (new CFPlus::UI::Button
      text => "OK",
      expand => 1,
      tooltip => "This closes the binding editor and saves the binding",
      on_activate => sub {
         (delete $self->{binder})->destroy if $self->{binder};
         $self->hide;
         $self->commit;
         0
      });

   $hb->add (new CFPlus::UI::Button
      text => "Cancel",
      expand => 1,
      tooltip => "This closes the binding editor without saving",
      on_activate => sub {
         (delete $self->{binder})->destroy if $self->{binder};
         $self->hide;
         $self->{binding_cancel}->()
            if $self->{binding_cancel};
         0
      });

   $self->update_binding_widgets;

   $self
}

sub cfg_bind {
   my ($self, $mod, $sym, $cmds) = @_;
   $::PROFILE->{bindings}{$mod}{$sym} = $cmds;
   ::update_bindings ();
}

sub cfg_unbind {
   my ($self, $mod, $sym, $cmds) = @_;
   delete $::PROFILE->{bindings}{$mod}{$sym};
   ::update_bindings ();
}

sub commit {
   my ($self) = @_;

   my ($mod, $sym, $cmds) = $self->get_binding;

   if ($sym != 0 && @$cmds > 0) {
      $::STATUSBOX->add ("Bound actions to <i>" . keycombo_to_name ($mod, $sym) . "</i>. "
                       . "Do not forget to 'Save Config'!");
      $self->{binding_change}->($mod, $sym, $cmds)
         if $self->{binding_change};
   } else {
      $::STATUSBOX->add ("No action bound, no key or action specified!");
      $self->{binding_cancel}->()
         if $self->{binding_cancel};
   }
}

sub start {
   my ($self) = @_;

   $self->{rec_btn}->set_text ("stop recording");
   $self->{recording} = 1;
   $self->clear_command_list;
   $::CONN->start_record if $::CONN;
}

sub stop {
   my ($self) = @_;

   $self->{rec_btn}->set_text ("start recording");
   $self->{recording} = 0;

   my $rec;
   $rec = $::CONN->stop_record if $::CONN;
   return unless ref $rec eq 'ARRAY';
   $self->set_command_list ($rec);
}

sub ask_for_bind {
   my ($self, $commit, $end_cb) = @_;

   return if $self->{binder};

   Scalar::Util::weaken $self;

   $self->{binder} = new CFPlus::UI::Toplevel
      title => "Bind Action",
      x     => "center",
      y     => "center",
      z     => 1000,
      has_close_button => 1,
      on_delete => sub {
         (delete $self->{binder})->destroy;
         1
      },
   ;

   $self->{binder}->add (my $vb = new CFPlus::UI::VBox);
   $vb->add (new CFPlus::UI::Label
      text => "Press a modifier (CTRL, ALT and/or SHIFT) and a key."
            . "You can only bind 0-9 and F1-F15 without modifiers."
   );
   $vb->add (my $entry = new CFPlus::UI::Entry
      text => "",
      on_key_down => sub {
         my ($entry, $ev) = @_;

         my $mod = $ev->{mod};
         my $sym = $ev->{sym};

         # XXX: This seems a little bit hackisch to me, but I have to ignore them
         return if grep { $_ == $sym } @ALLOWED_MODIFIER_KEYS;

         if ($mod == CFPlus::KMOD_NONE
             and not $DIRECT_BIND_CHARS{chr ($ev->{unicode})}
             and not grep { $sym == $_ } @DIRECT_BIND_KEYS)
         {
            $::STATUSBOX->add (
               "Cannot bind key " . CFPlus::SDL_GetKeyName ($sym) . " directly without modifier, "
             . "as those keys are reserved for the command completer."
            );
            return;
         }

         $entry->grab_focus;

         $self->{binding} = [$mod, $sym];
         $self->update_binding_widgets;
         $self->commit if $commit;
         $end_cb->() if $end_cb;

         if (my $binder = delete $self->{binder}) {
            $binder->destroy;
         }
         1
      },
      on_focus_out => sub {
         # segfaults and worse :()
         #(delete $self->{binder})->destroy if $self->{binder};
         1
      },
   );

   $entry->grab_focus;
   $self->{binder}->show;
}

# $mod and $sym are the modifiers and key symbol
# $cmds is a array ref of strings (the commands)
# $cb is the callback that is executed on OK
# $ccb is the callback that is executed on CANCEL and 
# when the binding was unsuccessful on OK
sub set_binding {
   my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;

   $self->clear_command_list;
   $self->{recording} = 0;
   $self->{rec_btn}->set_text ("start recording");

   $self->{binding} = [$mod, $sym];
   $self->{commands} = $cmds;

   $self->{binding_change} = $cb;
   $self->{binding_cancel} = $ccb;

   $self->update_binding_widgets;
}

# this is a shortcut method that asks for a binding
# and then just binds it.
sub do_quick_binding {
   my ($self, $cmds, $end_cb) = @_;
   $self->set_binding (undef, undef, $cmds, sub { $self->cfg_bind (@_) });
   $self->ask_for_bind (1, $end_cb);
}

sub update_binding_widgets {
   my ($self) = @_;
   my ($mod, $sym, $cmds) = $self->get_binding;
   $self->{keylbl}->set_text (keycombo_to_name ($mod, $sym));
   $self->set_command_list ($cmds);
}

sub get_binding {
   my ($self) = @_;
   return (
      $self->{binding}->[0],
      $self->{binding}->[1],
      [ grep { defined $_ } @{$self->{commands}} ]
   );
}

sub clear_command_list {
   my ($self) = @_;
   $self->{cmdbox}->clear ();
}

sub set_command_list {
   my ($self, $cmds) = @_;

   $self->{cmdbox}->clear ();
   $self->{commands} = $cmds;

   my $idx = 0;

   for (@$cmds) {
      $self->{cmdbox}->add (my $hb = new CFPlus::UI::HBox);

      my $i = $idx;
      $hb->add (new CFPlus::UI::Label text => $_);
      $hb->add (new CFPlus::UI::Button
         text => "delete",
         tooltip => "Deletes the action from the record",
         on_activate => sub {
            $self->{cmdbox}->remove ($hb);
            $cmds->[$i] = undef;
         });


      $idx++
   }
}

1
Revision:	1.7
Committed:	Sun Oct 1 14:48:51 2006 UTC (17 years, 7 months ago) by root
Branch:	MAIN
CVS Tags:	rel-0_53
Changes since 1.6:	+2 -2 lines
Log Message:	support for grabbing win32 proxy
#	User	Rev	Content
1	root	1.4	package CFPlus::BindingEditor;
2	root	1.1
3	root	1.2	use strict;
4
5	root	1.4	use CFPlus::UI;
6	root	1.1
7	root	1.5	our @ISA = CFPlus::UI::Toplevel::;
8	root	1.1
9	root	1.2	my @ALLOWED_MODIFIER_KEYS = (
10	root	1.4	CFPlus::SDLK_LSHIFT,
11			CFPlus::SDLK_LCTRL ,
12			CFPlus::SDLK_LALT ,
13			CFPlus::SDLK_LMETA ,
14
15			CFPlus::SDLK_RSHIFT,
16			CFPlus::SDLK_RCTRL ,
17			CFPlus::SDLK_RALT ,
18			CFPlus::SDLK_RMETA ,
19	root	1.2	);
20
21			my %ALLOWED_MODIFIERS = (
22	root	1.4	CFPlus::KMOD_LSHIFT => "LSHIFT",
23			CFPlus::KMOD_LCTRL => "LCTRL",
24			CFPlus::KMOD_LALT => "LALT",
25			CFPlus::KMOD_LMETA => "LMETA",
26
27			CFPlus::KMOD_RSHIFT => "RSHIFT",
28			CFPlus::KMOD_RCTRL => "RCTRL",
29			CFPlus::KMOD_RALT => "RALT",
30			CFPlus::KMOD_RMETA => "RMETA",
31	root	1.2	);
32
33			my %DIRECT_BIND_CHARS = map { $_ => 1 } qw/0 1 2 3 4 5 6 7 8 9/;
34			my @DIRECT_BIND_KEYS = (
35	root	1.4	CFPlus::SDLK_F1,
36			CFPlus::SDLK_F2,
37			CFPlus::SDLK_F3,
38			CFPlus::SDLK_F4,
39			CFPlus::SDLK_F5,
40			CFPlus::SDLK_F6,
41			CFPlus::SDLK_F7,
42			CFPlus::SDLK_F8,
43			CFPlus::SDLK_F9,
44			CFPlus::SDLK_F10,
45			CFPlus::SDLK_F11,
46			CFPlus::SDLK_F12,
47			CFPlus::SDLK_F13,
48			CFPlus::SDLK_F14,
49			CFPlus::SDLK_F15,
50	root	1.2	);
51
52			sub keycombo_to_name {
53			my ($mod, $sym) = @_;
54
55			my $mods = join '+',
56			map { $ALLOWED_MODIFIERS{$_} }
57			grep { ($_ + 0) & ($mod + 0) }
58			keys %ALLOWED_MODIFIERS;
59			$mods .= "+" if $mods ne '';
60
61	root	1.4	return $mods . CFPlus::SDL_GetKeyName ($sym);
62	root	1.2	}
63
64	root	1.1	sub new {
65			my $class = shift;
66
67			my $self = $class->SUPER::new (
68			binding => [],
69			commands => [],
70			title => "Macro/Keybinding Recorder",
71			@_
72			);
73
74	root	1.4	$self->add (my $vb = new CFPlus::UI::VBox);
75	root	1.1
76	root	1.4	$vb->add ($self->{rec_btn} = new CFPlus::UI::Button
77	root	1.1	text => "start recording",
78			tooltip => "Start/Stops recording of actions."
79			."All subsequent actions after the recording started will be captured."
80			."The actions are displayed after the record was stopped."
81			."To bind the action you have to click on the 'Bind' button",
82			on_activate => sub {
83			unless ($self->{recording}) {
84			$self->start;
85			} else {
86			$self->stop;
87			}
88			});
89
90	root	1.4	$vb->add (new CFPlus::UI::Label text => "Actions:");
91			$vb->add ($self->{cmdbox} = new CFPlus::UI::VBox);
92	root	1.1
93	root	1.4	$vb->add (new CFPlus::UI::Label text => "Bound to: ");
94			$vb->add (my $hb = new CFPlus::UI::HBox);
95			$hb->add ($self->{keylbl} = new CFPlus::UI::Label expand => 1);
96			$hb->add (new CFPlus::UI::Button
97	root	1.1	text => "bind",
98			tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
99			on_activate => sub {
100			$self->ask_for_bind;
101			});
102
103	root	1.4	$vb->add (my $hb = new CFPlus::UI::HBox);
104			$hb->add (new CFPlus::UI::Button
105	root	1.2	text => "OK",
106	root	1.1	expand => 1,
107			tooltip => "This closes the binding editor and saves the binding",
108			on_activate => sub {
109	root	1.2	(delete $self->{binder})->destroy if $self->{binder};
110	root	1.1	$self->hide;
111			$self->commit;
112	root	1.2	0
113	root	1.1	});
114
115	root	1.4	$hb->add (new CFPlus::UI::Button
116	root	1.2	text => "Cancel",
117	root	1.1	expand => 1,
118			tooltip => "This closes the binding editor without saving",
119			on_activate => sub {
120	root	1.2	(delete $self->{binder})->destroy if $self->{binder};
121	root	1.1	$self->hide;
122			$self->{binding_cancel}->()
123			if $self->{binding_cancel};
124	root	1.2	0
125	root	1.1	});
126
127			$self->update_binding_widgets;
128
129			$self
130			}
131
132			sub cfg_bind {
133			my ($self, $mod, $sym, $cmds) = @_;
134	root	1.7	$::PROFILE->{bindings}{$mod}{$sym} = $cmds;
135	root	1.1	::update_bindings ();
136			}
137
138			sub cfg_unbind {
139			my ($self, $mod, $sym, $cmds) = @_;
140	root	1.7	delete $::PROFILE->{bindings}{$mod}{$sym};
141	root	1.1	::update_bindings ();
142			}
143
144			sub commit {
145			my ($self) = @_;
146	root	1.2
147	root	1.1	my ($mod, $sym, $cmds) = $self->get_binding;
148	root	1.2
149	root	1.1	if ($sym != 0 && @$cmds > 0) {
150	root	1.2	$::STATUSBOX->add ("Bound actions to <i>" . keycombo_to_name ($mod, $sym) . "</i>. "
151			. "Do not forget to 'Save Config'!");
152	root	1.1	$self->{binding_change}->($mod, $sym, $cmds)
153			if $self->{binding_change};
154			} else {
155			$::STATUSBOX->add ("No action bound, no key or action specified!");
156			$self->{binding_cancel}->()
157			if $self->{binding_cancel};
158			}
159			}
160
161			sub start {
162			my ($self) = @_;
163
164			$self->{rec_btn}->set_text ("stop recording");
165			$self->{recording} = 1;
166			$self->clear_command_list;
167			$::CONN->start_record if $::CONN;
168			}
169
170			sub stop {
171			my ($self) = @_;
172
173			$self->{rec_btn}->set_text ("start recording");
174			$self->{recording} = 0;
175
176			my $rec;
177			$rec = $::CONN->stop_record if $::CONN;
178			return unless ref $rec eq 'ARRAY';
179			$self->set_command_list ($rec);
180			}
181
182	root	1.2	sub ask_for_bind {
183			my ($self, $commit, $end_cb) = @_;
184
185			return if $self->{binder};
186	root	1.1
187	root	1.2	Scalar::Util::weaken $self;
188
189	root	1.5	$self->{binder} = new CFPlus::UI::Toplevel
190	root	1.2	title => "Bind Action",
191			x => "center",
192			y => "center",
193			z => 1000,
194			has_close_button => 1,
195			on_delete => sub {
196			(delete $self->{binder})->destroy;
197			1
198			},
199			;
200
201	root	1.4	$self->{binder}->add (my $vb = new CFPlus::UI::VBox);
202			$vb->add (new CFPlus::UI::Label
203	root	1.2	text => "Press a modifier (CTRL, ALT and/or SHIFT) and a key."
204			. "You can only bind 0-9 and F1-F15 without modifiers."
205			);
206	root	1.4	$vb->add (my $entry = new CFPlus::UI::Entry
207	root	1.2	text => "",
208			on_key_down => sub {
209			my ($entry, $ev) = @_;
210
211			my $mod = $ev->{mod};
212			my $sym = $ev->{sym};
213
214			# XXX: This seems a little bit hackisch to me, but I have to ignore them
215			return if grep { $_ == $sym } @ALLOWED_MODIFIER_KEYS;
216
217	root	1.4	if ($mod == CFPlus::KMOD_NONE
218	root	1.2	and not $DIRECT_BIND_CHARS{chr ($ev->{unicode})}
219			and not grep { $sym == $_ } @DIRECT_BIND_KEYS)
220			{
221			$::STATUSBOX->add (
222	root	1.4	"Cannot bind key " . CFPlus::SDL_GetKeyName ($sym) . " directly without modifier, "
223	root	1.2	. "as those keys are reserved for the command completer."
224			);
225			return;
226			}
227
228			$entry->grab_focus;
229	root	1.1
230	root	1.2	$self->{binding} = [$mod, $sym];
231			$self->update_binding_widgets;
232			$self->commit if $commit;
233			$end_cb->() if $end_cb;
234
235	root	1.6	if (my $binder = delete $self->{binder}) {
236			$binder->destroy;
237			}
238	root	1.2	1
239			},
240			on_focus_out => sub {
241			# segfaults and worse :()
242			#(delete $self->{binder})->destroy if $self->{binder};
243			1
244			},
245			);
246	root	1.1
247	root	1.2	$entry->grab_focus;
248			$self->{binder}->show;
249	root	1.1	}
250
251			# $mod and $sym are the modifiers and key symbol
252			# $cmds is a array ref of strings (the commands)
253			# $cb is the callback that is executed on OK
254			# $ccb is the callback that is executed on CANCEL and
255			# when the binding was unsuccessful on OK
256			sub set_binding {
257			my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
258
259			$self->clear_command_list;
260			$self->{recording} = 0;
261			$self->{rec_btn}->set_text ("start recording");
262
263			$self->{binding} = [$mod, $sym];
264			$self->{commands} = $cmds;
265
266			$self->{binding_change} = $cb;
267			$self->{binding_cancel} = $ccb;
268
269			$self->update_binding_widgets;
270			}
271
272			# this is a shortcut method that asks for a binding
273			# and then just binds it.
274			sub do_quick_binding {
275			my ($self, $cmds, $end_cb) = @_;
276			$self->set_binding (undef, undef, $cmds, sub { $self->cfg_bind (@_) });
277			$self->ask_for_bind (1, $end_cb);
278			}
279
280			sub update_binding_widgets {
281			my ($self) = @_;
282			my ($mod, $sym, $cmds) = $self->get_binding;
283	root	1.2	$self->{keylbl}->set_text (keycombo_to_name ($mod, $sym));
284	root	1.1	$self->set_command_list ($cmds);
285			}
286
287			sub get_binding {
288			my ($self) = @_;
289			return (
290			$self->{binding}->[0],
291			$self->{binding}->[1],
292			[ grep { defined $_ } @{$self->{commands}} ]
293			);
294			}
295
296			sub clear_command_list {
297			my ($self) = @_;
298			$self->{cmdbox}->clear ();
299			}
300
301			sub set_command_list {
302			my ($self, $cmds) = @_;
303
304			$self->{cmdbox}->clear ();
305			$self->{commands} = $cmds;
306
307			my $idx = 0;
308
309			for (@$cmds) {
310	root	1.4	$self->{cmdbox}->add (my $hb = new CFPlus::UI::HBox);
311	root	1.1
312			my $i = $idx;
313	root	1.4	$hb->add (new CFPlus::UI::Label text => $_);
314			$hb->add (new CFPlus::UI::Button
315	root	1.1	text => "delete",
316			tooltip => "Deletes the action from the record",
317			on_activate => sub {
318			$self->{cmdbox}->remove ($hb);
319			$cmds->[$i] = undef;
320			});
321
322
323			$idx++
324			}
325			}
326
327			1