Deliantra-Client/DC/BindingEditor.pm

package CFClient::BindingEditor;

use strict;

use CFClient::UI;

our @ISA = CFClient::UI::FancyFrame::;

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

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

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

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

my %DIRECT_BIND_CHARS = map { $_ => 1 } qw/0 1 2 3 4 5 6 7 8 9/;
my @DIRECT_BIND_KEYS = (
   CFClient::SDLK_F1,
   CFClient::SDLK_F2,
   CFClient::SDLK_F3,
   CFClient::SDLK_F4,
   CFClient::SDLK_F5,
   CFClient::SDLK_F6,
   CFClient::SDLK_F7,
   CFClient::SDLK_F8,
   CFClient::SDLK_F9,
   CFClient::SDLK_F10,
   CFClient::SDLK_F11,
   CFClient::SDLK_F12,
   CFClient::SDLK_F13,
   CFClient::SDLK_F14,
   CFClient::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 . CFClient::SDL_GetKeyName ($sym);
}

sub new {
   my $class = shift;

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

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

   $vb->add ($self->{rec_btn} = new CFClient::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 CFClient::UI::Label text => "Actions:");
   $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);

   $vb->add (new CFClient::UI::Label text => "Bound to: ");
   $vb->add (my $hb = new CFClient::UI::HBox);
   $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
   $hb->add (new CFClient::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 CFClient::UI::HBox);
   $hb->add (new CFClient::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 CFClient::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) = @_;
   $::CFG->{profile}{default}{bindings}{$mod}{$sym} = $cmds;
   ::update_bindings ();
}

sub cfg_unbind {
   my ($self, $mod, $sym, $cmds) = @_;
   delete $::CFG->{profile}{default}{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 CFClient::UI::FancyFrame
      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 CFClient::UI::VBox);
   $vb->add (new CFClient::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 CFClient::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 == CFClient::KMOD_NONE
             and not $DIRECT_BIND_CHARS{chr ($ev->{unicode})}
             and not grep { $sym == $_ } @DIRECT_BIND_KEYS)
         {
            $::STATUSBOX->add (
               "Cannot bind key " . CFClient::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;

         (delete $self->{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 CFClient::UI::HBox);

      my $i = $idx;
      $hb->add (new CFClient::UI::Label text => $_);
      $hb->add (new CFClient::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.3
Committed:	Fri Jul 7 23:07:14 2006 UTC (17 years, 11 months ago) by elmex
Branch:	MAIN
Changes since 1.2:	+0 -1 lines
Log Message:	removed a debugging warning
#	User	Rev	Content
1	root	1.1	package CFClient::BindingEditor;
2
3	root	1.2	use strict;
4
5	root	1.1	use CFClient::UI;
6
7			our @ISA = CFClient::UI::FancyFrame::;
8
9	root	1.2	my @ALLOWED_MODIFIER_KEYS = (
10			CFClient::SDLK_LSHIFT,
11			CFClient::SDLK_LCTRL ,
12			CFClient::SDLK_LALT ,
13			CFClient::SDLK_LMETA ,
14
15			CFClient::SDLK_RSHIFT,
16			CFClient::SDLK_RCTRL ,
17			CFClient::SDLK_RALT ,
18			CFClient::SDLK_RMETA ,
19			);
20
21			my %ALLOWED_MODIFIERS = (
22			CFClient::KMOD_LSHIFT => "LSHIFT",
23			CFClient::KMOD_LCTRL => "LCTRL",
24			CFClient::KMOD_LALT => "LALT",
25			CFClient::KMOD_LMETA => "LMETA",
26
27			CFClient::KMOD_RSHIFT => "RSHIFT",
28			CFClient::KMOD_RCTRL => "RCTRL",
29			CFClient::KMOD_RALT => "RALT",
30			CFClient::KMOD_RMETA => "RMETA",
31			);
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			CFClient::SDLK_F1,
36			CFClient::SDLK_F2,
37			CFClient::SDLK_F3,
38			CFClient::SDLK_F4,
39			CFClient::SDLK_F5,
40			CFClient::SDLK_F6,
41			CFClient::SDLK_F7,
42			CFClient::SDLK_F8,
43			CFClient::SDLK_F9,
44			CFClient::SDLK_F10,
45			CFClient::SDLK_F11,
46			CFClient::SDLK_F12,
47			CFClient::SDLK_F13,
48			CFClient::SDLK_F14,
49			CFClient::SDLK_F15,
50			);
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			return $mods . CFClient::SDL_GetKeyName ($sym);
62			}
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			$self->add (my $vb = new CFClient::UI::VBox);
75
76			$vb->add ($self->{rec_btn} = new CFClient::UI::Button
77			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			$vb->add (new CFClient::UI::Label text => "Actions:");
91			$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
92
93			$vb->add (new CFClient::UI::Label text => "Bound to: ");
94			$vb->add (my $hb = new CFClient::UI::HBox);
95			$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
96			$hb->add (new CFClient::UI::Button
97			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			$vb->add (my $hb = new CFClient::UI::HBox);
104			$hb->add (new CFClient::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			$hb->add (new CFClient::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			$::CFG->{profile}{default}{bindings}{$mod}{$sym} = $cmds;
135			::update_bindings ();
136			}
137
138			sub cfg_unbind {
139			my ($self, $mod, $sym, $cmds) = @_;
140			delete $::CFG->{profile}{default}{bindings}{$mod}{$sym};
141			::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			$self->{binder} = new CFClient::UI::FancyFrame
190			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			$self->{binder}->add (my $vb = new CFClient::UI::VBox);
202			$vb->add (new CFClient::UI::Label
203			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			$vb->add (my $entry = new CFClient::UI::Entry
207			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			if ($mod == CFClient::KMOD_NONE
218			and not $DIRECT_BIND_CHARS{chr ($ev->{unicode})}
219			and not grep { $sym == $_ } @DIRECT_BIND_KEYS)
220			{
221			$::STATUSBOX->add (
222			"Cannot bind key " . CFClient::SDL_GetKeyName ($sym) . " directly without modifier, "
223			. "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			(delete $self->{binder})->destroy;
236			1
237			},
238			on_focus_out => sub {
239			# segfaults and worse :()
240			#(delete $self->{binder})->destroy if $self->{binder};
241			1
242			},
243			);
244	root	1.1
245	root	1.2	$entry->grab_focus;
246			$self->{binder}->show;
247	root	1.1	}
248
249			# $mod and $sym are the modifiers and key symbol
250			# $cmds is a array ref of strings (the commands)
251			# $cb is the callback that is executed on OK
252			# $ccb is the callback that is executed on CANCEL and
253			# when the binding was unsuccessful on OK
254			sub set_binding {
255			my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
256
257			$self->clear_command_list;
258			$self->{recording} = 0;
259			$self->{rec_btn}->set_text ("start recording");
260
261			$self->{binding} = [$mod, $sym];
262			$self->{commands} = $cmds;
263
264			$self->{binding_change} = $cb;
265			$self->{binding_cancel} = $ccb;
266
267			$self->update_binding_widgets;
268			}
269
270			# this is a shortcut method that asks for a binding
271			# and then just binds it.
272			sub do_quick_binding {
273			my ($self, $cmds, $end_cb) = @_;
274			$self->set_binding (undef, undef, $cmds, sub { $self->cfg_bind (@_) });
275			$self->ask_for_bind (1, $end_cb);
276			}
277
278			sub update_binding_widgets {
279			my ($self) = @_;
280			my ($mod, $sym, $cmds) = $self->get_binding;
281	root	1.2	$self->{keylbl}->set_text (keycombo_to_name ($mod, $sym));
282	root	1.1	$self->set_command_list ($cmds);
283			}
284
285			sub get_binding {
286			my ($self) = @_;
287			return (
288			$self->{binding}->[0],
289			$self->{binding}->[1],
290			[ grep { defined $_ } @{$self->{commands}} ]
291			);
292			}
293
294			sub clear_command_list {
295			my ($self) = @_;
296			$self->{cmdbox}->clear ();
297			}
298
299			sub set_command_list {
300			my ($self, $cmds) = @_;
301
302			$self->{cmdbox}->clear ();
303			$self->{commands} = $cmds;
304
305			my $idx = 0;
306
307			for (@$cmds) {
308			$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
309
310			my $i = $idx;
311			$hb->add (new CFClient::UI::Label text => $_);
312			$hb->add (new CFClient::UI::Button
313			text => "delete",
314			tooltip => "Deletes the action from the record",
315			on_activate => sub {
316			$self->{cmdbox}->remove ($hb);
317			$cmds->[$i] = undef;
318			});
319
320
321			$idx++
322			}
323			}
324
325			1