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;

         warn "dexxey $self $self->{binder}\n";#d#
         (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.2
Committed:	Sun Jul 2 18:52:05 2006 UTC (18 years ago) by root
Branch:	MAIN
Changes since 1.1:	+131 -18 lines
Log Message:	* empty log message *
#	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			warn "dexxey $self $self->{binder}\n";#d#
236			(delete $self->{binder})->destroy;
237			1
238			},
239			on_focus_out => sub {
240			# segfaults and worse :()
241			#(delete $self->{binder})->destroy if $self->{binder};
242			1
243			},
244			);
245	root	1.1
246	root	1.2	$entry->grab_focus;
247			$self->{binder}->show;
248	root	1.1	}
249
250			# $mod and $sym are the modifiers and key symbol
251			# $cmds is a array ref of strings (the commands)
252			# $cb is the callback that is executed on OK
253			# $ccb is the callback that is executed on CANCEL and
254			# when the binding was unsuccessful on OK
255			sub set_binding {
256			my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
257
258			$self->clear_command_list;
259			$self->{recording} = 0;
260			$self->{rec_btn}->set_text ("start recording");
261
262			$self->{binding} = [$mod, $sym];
263			$self->{commands} = $cmds;
264
265			$self->{binding_change} = $cb;
266			$self->{binding_cancel} = $ccb;
267
268			$self->update_binding_widgets;
269			}
270
271			# this is a shortcut method that asks for a binding
272			# and then just binds it.
273			sub do_quick_binding {
274			my ($self, $cmds, $end_cb) = @_;
275			$self->set_binding (undef, undef, $cmds, sub { $self->cfg_bind (@_) });
276			$self->ask_for_bind (1, $end_cb);
277			}
278
279			sub update_binding_widgets {
280			my ($self) = @_;
281			my ($mod, $sym, $cmds) = $self->get_binding;
282	root	1.2	$self->{keylbl}->set_text (keycombo_to_name ($mod, $sym));
283	root	1.1	$self->set_command_list ($cmds);
284			}
285
286			sub get_binding {
287			my ($self) = @_;
288			return (
289			$self->{binding}->[0],
290			$self->{binding}->[1],
291			[ grep { defined $_ } @{$self->{commands}} ]
292			);
293			}
294
295			sub clear_command_list {
296			my ($self) = @_;
297			$self->{cmdbox}->clear ();
298			}
299
300			sub set_command_list {
301			my ($self, $cmds) = @_;
302
303			$self->{cmdbox}->clear ();
304			$self->{commands} = $cmds;
305
306			my $idx = 0;
307
308			for (@$cmds) {
309			$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
310
311			my $i = $idx;
312			$hb->add (new CFClient::UI::Label text => $_);
313			$hb->add (new CFClient::UI::Button
314			text => "delete",
315			tooltip => "Deletes the action from the record",
316			on_activate => sub {
317			$self->{cmdbox}->remove ($hb);
318			$cmds->[$i] = undef;
319			});
320
321
322			$idx++
323			}
324			}
325
326			1