| 1 |
package GCE::AttachEditor; |
| 2 |
|
| 3 |
=head1 NAME |
| 4 |
|
| 5 |
GCE::AttachEditor - this is a editor for attachments for maps and objects |
| 6 |
|
| 7 |
=cut |
| 8 |
|
| 9 |
use Gtk2; |
| 10 |
use Gtk2::Gdk::Keysyms; |
| 11 |
use Gtk2::SimpleMenu; |
| 12 |
|
| 13 |
use Deliantra; |
| 14 |
|
| 15 |
use GCE::Util; |
| 16 |
|
| 17 |
use Glib::Object::Subclass Gtk2::Window; |
| 18 |
|
| 19 |
use Storable qw/dclone/; |
| 20 |
|
| 21 |
use strict; |
| 22 |
|
| 23 |
sub try_add_known_attachment { |
| 24 |
my ($self, $att) = @_; |
| 25 |
|
| 26 |
unless ($::CFG->{known_attachments}->{$att}) { |
| 27 |
$self->{attach_combobox}->append_text ($att); |
| 28 |
$::CFG->{known_attachments}->{$att} = 1; |
| 29 |
} |
| 30 |
} |
| 31 |
|
| 32 |
sub save_layout { |
| 33 |
my ($self) = @_; |
| 34 |
$::CFG->{attach_editor} = ::get_pos_and_size ($self); |
| 35 |
} |
| 36 |
|
| 37 |
sub INIT_INSTANCE { |
| 38 |
my ($self) = @_; |
| 39 |
$self->set_title ("deliantra editor - attachment editor"); |
| 40 |
::set_pos_and_size ($self, $::CFG->{attach_editor}, 400, 400, 200, 0); |
| 41 |
|
| 42 |
$self->add (my $vb = Gtk2::VBox->new); |
| 43 |
$vb->pack_start (my $hb = Gtk2::HBox->new, 0, 1, 0); |
| 44 |
$hb->pack_start ($self->{attach_combobox} = Gtk2::ComboBoxEntry->new_text, 0, 1, 0); |
| 45 |
$hb->pack_start (my $btn = Gtk2::Button->new ("new"), 0, 1, 0); |
| 46 |
$btn->signal_connect (clicked => sub { |
| 47 |
my $ent = $self->{attach_combobox}->child->get_text; |
| 48 |
$self->add_attachment ($ent); |
| 49 |
}); |
| 50 |
|
| 51 |
$vb->pack_start ($self->{attachbox} = Gtk2::VBox->new, 1, 1, 0); |
| 52 |
|
| 53 |
$self->{attach_combobox}->append_text ($_) |
| 54 |
for keys %{$::CFG->{known_attachments} || {}}; |
| 55 |
} |
| 56 |
|
| 57 |
sub add_attachment { |
| 58 |
my ($self, $name, $args) = @_; |
| 59 |
|
| 60 |
return if $name =~ /^\s*$/; |
| 61 |
|
| 62 |
$self->try_add_known_attachment ($name); |
| 63 |
push @{$self->{attach}}, [$name, $args]; |
| 64 |
$self->{ntbook}->append_page (my $pg = $self->make_page ($name, $args), $name); |
| 65 |
$pg->show_all; |
| 66 |
|
| 67 |
$self->{upd_cb}->($self->{attach}); |
| 68 |
} |
| 69 |
|
| 70 |
sub update_attachments { |
| 71 |
my ($self, $name, $args) = @_; |
| 72 |
|
| 73 |
for (@{$self->{attach}}) { |
| 74 |
if ($_->[0] eq $name) { |
| 75 |
@$_ = ($name, $args); |
| 76 |
$name = undef; |
| 77 |
last; |
| 78 |
} |
| 79 |
} |
| 80 |
|
| 81 |
$name and warn "Couldn't find attachment '$name', this is a bug!"; |
| 82 |
|
| 83 |
$self->{upd_cb}->($self->{attach}); |
| 84 |
} |
| 85 |
|
| 86 |
sub kill_attachment { |
| 87 |
my ($self, $pos) = @_; |
| 88 |
my $name = $self->{ntbook}->get_tab_label_text ($self->{ntbook}->get_nth_page ($pos)); |
| 89 |
$self->{ntbook}->remove_page ($pos); |
| 90 |
@{$self->{attach}} = grep { $_->[0] ne $name } @{$self->{attach}}; |
| 91 |
$self->{upd_cb}->($self->{attach}); |
| 92 |
} |
| 93 |
|
| 94 |
sub set_attachment { |
| 95 |
my ($self, $attach, $update_cb) = @_; |
| 96 |
$self->{upd_cb} = $update_cb |
| 97 |
or die "No update callback given!"; |
| 98 |
|
| 99 |
my $ntbook = $self->{ntbook} = Gtk2::Notebook->new; |
| 100 |
$ntbook->set_scrollable (1); |
| 101 |
$self->add_attachment (@$_) for @$attach; |
| 102 |
|
| 103 |
$self->{attachbox}->remove ($_) for $self->{attachbox}->get_children; |
| 104 |
$self->{attachbox}->add ($ntbook); |
| 105 |
$self->{attachbox}->show_all; |
| 106 |
} |
| 107 |
|
| 108 |
sub add_attachment_key { |
| 109 |
my ($self, $name, $key, $args) = @_; |
| 110 |
|
| 111 |
my $tbl = $self->{table}; |
| 112 |
my $i = $tbl->get ('n-rows'); |
| 113 |
$tbl->resize ($i + 1, $self->{table}->get ('n-columns')); |
| 114 |
|
| 115 |
$args->{$key} = "" unless defined $args->{$key}; |
| 116 |
|
| 117 |
$tbl->attach (my $ed = Gtk2::Entry->new, 0, 1, $i, $i + 1, ['fill'], 'fill', 0, 0); |
| 118 |
$ed->set_editable (0); |
| 119 |
$ed->set_text ($key); |
| 120 |
# $ed->signal_connect (changed => sub { |
| 121 |
# my ($ed) = @_; |
| 122 |
# my $newkey = $ed->get_text; |
| 123 |
# my $val = delete $args->{$ed->{key}}; |
| 124 |
# $args->{$ed->{key} = $newkey} = $val; |
| 125 |
# $self->update_attachments ($name, $args); |
| 126 |
# 0 |
| 127 |
# }); |
| 128 |
|
| 129 |
$tbl->attach (my $ed2 = Gtk2::Entry->new, 1, 2, $i, $i + 1, ['fill', 'expand'], 'fill', 0, 0); |
| 130 |
$ed2->set_text ($ed2->{value} = $args->{$key}); |
| 131 |
$ed2->signal_connect (changed => sub { |
| 132 |
my ($ed2) = @_; |
| 133 |
$args->{$key} = $ed2->get_text; |
| 134 |
$self->update_attachments ($name, $args); |
| 135 |
0 |
| 136 |
}); |
| 137 |
|
| 138 |
$tbl->attach (my $b = Gtk2::Button->new ("X"), 2, 3, $i, $i + 1, 'fill', 'fill', 0, 0); |
| 139 |
$b->signal_connect (clicked => sub { |
| 140 |
delete $args->{$key}; |
| 141 |
$self->rebuild_key_table ($name, $args); |
| 142 |
0 |
| 143 |
}); |
| 144 |
|
| 145 |
$tbl->show_all; |
| 146 |
} |
| 147 |
|
| 148 |
sub rebuild_key_table { |
| 149 |
my ($self, $name, $args) = @_; |
| 150 |
my $tbl = $self->{table}; |
| 151 |
$tbl->resize (scalar keys %$args, $tbl->get ('n-columns')); |
| 152 |
$tbl->remove ($_) for $tbl->get_children; |
| 153 |
$self->add_attachment_key ($name, $_, $args) for keys %$args; |
| 154 |
} |
| 155 |
|
| 156 |
|
| 157 |
sub make_page { |
| 158 |
my ($self, $name, $args) = @_; |
| 159 |
|
| 160 |
my $vb = Gtk2::VBox->new; |
| 161 |
|
| 162 |
$vb->pack_start (my $kb = Gtk2::Button->new ("remove attachment"), 0, 1, 0); |
| 163 |
$kb->signal_connect (clicked => sub { |
| 164 |
$self->kill_attachment ($self->{ntbook}->page_num ($vb)); |
| 165 |
1 |
| 166 |
}); |
| 167 |
|
| 168 |
$vb->pack_start (my $sw = Gtk2::ScrolledWindow->new, 1, 1, 0); |
| 169 |
$sw->set_policy (qw/automatic automatic/); |
| 170 |
$sw->add_with_viewport ($self->{table} = Gtk2::Table->new (1, 3)); |
| 171 |
|
| 172 |
$self->add_attachment_key ($name, $_, $args) for keys %$args; |
| 173 |
|
| 174 |
$vb->pack_start (my $hb = Gtk2::HBox->new, 0, 1, 0); |
| 175 |
$hb->pack_start (my $ed = Gtk2::Entry->new, 1, 1, 0); |
| 176 |
$hb->pack_start (my $kb = Gtk2::Button->new ("new key"), 0, 1, 0); |
| 177 |
$kb->signal_connect (clicked => sub { |
| 178 |
my $newkey = $ed->get_text; |
| 179 |
return 0 if exists $args->{$newkey}; |
| 180 |
$self->update_attachments ($name, $args); |
| 181 |
$self->add_attachment_key ($name, $newkey, $args); |
| 182 |
0 |
| 183 |
}); |
| 184 |
|
| 185 |
|
| 186 |
$vb |
| 187 |
} |
| 188 |
|
| 189 |
=head1 AUTHOR |
| 190 |
|
| 191 |
Robin Redeker <elmex@ta-sa.org> |
| 192 |
http://www.ta-sa.org/ |
| 193 |
|
| 194 |
=cut |
| 195 |
1; |
| 196 |
|
