1
2package App::Asciio;
3
4$|++ ;
5
6use strict;
7use warnings;
8
9use Data::TreeDumper ;
10use Clone;
11use List::Util qw(min max) ;
12use List::MoreUtils qw(any minmax first_value) ;
13
14#-----------------------------------------------------------------------------
15
16sub connect_elements
17{
18my ($self, @elements) = @_ ;
19
20my @possible_connections = $self->get_possible_connections(@elements) ;
21#~ $self->show_dump_window(\@possible_connections, "\@possible_connections for @elements") ;
22
23$self->add_connections(@possible_connections) ;
24}
25
26#-----------------------------------------------------------------------------
27
28sub add_connections
29{
30my ($self, @connections) = @_ ;
31
32$self->flash_new_connections(@connections) ;
33
34push @{$self->{CONNECTIONS}}, @connections ;
35$self->{MODIFIED }++ ;
36}
37
38#-----------------------------------------------------------------------------
39
40sub get_possible_connections
41{
42my ($self, @elements) = @_ ;
43
44my @possible_connections ;
45my %connected_connectors ;
46
47for my $element (@elements)
48	{
49	my @connectors = $element->get_connector_points() ;
50
51	last unless @connectors ;
52
53	#optimize search by eliminating those elements that are too far
54	for my $connectee (reverse @{$self->{ELEMENTS}})
55		{
56		next if $connectee == $element ; # dont connect to self
57
58		for my $connector (@connectors)
59			{
60			my @connections = $connectee->match_connector
61										(
62										# translate coordinates to connectee reference
63										($element->{X} - $connectee->{X}) +  $connector->{X},
64										($element->{Y} - $connectee->{Y}) +  $connector->{Y},
65										) ;
66
67			# make connection if possible. connect to a single point
68			if(defined $connections[0] && ! exists $connected_connectors{$element.$connector->{NAME}})
69				{
70				push @possible_connections,
71					{
72					CONNECTED => $element,
73					CONNECTOR =>$connector,
74					CONNECTEE => $connectee,
75					CONNECTION => $connections[0],
76					} ;
77
78				$connected_connectors{$element.$connector->{NAME}}++ ;
79				next ;
80				}
81			}
82		}
83	}
84
85return(@possible_connections) ;
86}
87
88#-----------------------------------------------------------------------------
89
90sub get_connections_containing
91{
92my($self, @elements) = @_ ;
93
94my %elements_to_find = map {$_ => 1} @elements ;
95my @connections ;
96
97for my $connection (@{$self->{CONNECTIONS}})
98	{
99	if(exists $elements_to_find{$connection->{CONNECTED}} || exists $elements_to_find{$connection->{CONNECTEE}})
100		{
101		push @connections, $connection;
102		}
103	}
104
105return(@connections) ;
106}
107
108#-----------------------------------------------------------------------------
109
110sub delete_connections
111{
112my($self, @connections) = @_ ;
113
114my %connections_to_delete = map {$_ => 1} @connections ;
115
116for my $connection (@{$self->{CONNECTIONS}})
117	{
118	if(exists $connections_to_delete{$connection})
119		{
120		$connection = undef ;
121		}
122	}
123
124@{$self->{CONNECTIONS}} = grep { defined $_} @{$self->{CONNECTIONS}} ;
125
126$self->{MODIFIED }++ ;
127}
128
129#-----------------------------------------------------------------------------
130
131sub delete_connections_containing
132{
133my($self, @elements) = @_ ;
134
135for my $element(@elements)
136	{
137	for my $connection (@{$self->{CONNECTIONS}})
138		{
139		if($connection->{CONNECTED} == $element || $connection->{CONNECTEE} == $element)
140			{
141			$connection = undef ;
142			}
143		}
144	}
145
146@{$self->{CONNECTIONS}} = grep { defined $_} @{$self->{CONNECTIONS}} ;
147
148$self->{MODIFIED }++ ;
149}
150
151#-----------------------------------------------------------------------------
152
153sub is_connectee
154{
155my($self, $element) = @_ ;
156
157my $connectee = 0 ;
158
159for my $connection (@{$self->{CONNECTIONS}})
160	{
161	if($connection->{CONNECTEE} == $element)
162		{
163		$connectee++ ;
164		last
165		}
166	}
167
168return($connectee) ;
169}
170
171sub get_connected
172{
173my($self, $element) = @_ ;
174
175my(@connected) ;
176
177for my $connection (@{$self->{CONNECTIONS}})
178	{
179	if($connection->{CONNECTEE} == $element)
180		{
181		push @connected, $connection ;
182		}
183	}
184
185return(@connected) ;
186}
187
188#-----------------------------------------------------------------------------
189
190sub is_connected
191{
192my($self, $element) = @_ ;
193
194my $connected = 0 ;
195
196for my $connection (@{$self->{CONNECTIONS}})
197	{
198	if($connection->{CONNECTED} == $element)
199		{
200		$connected++ ;
201		last
202		}
203	}
204
205return($connected) ;
206}
207
208#-----------------------------------------------------------------------------
209
210sub flash_new_connections
211{
212my($self, @connections) = @_ ;
213
214push @{$self->{NEW_CONNECTIONS}}, @connections ;
215}
216
217#-----------------------------------------------------------------------------
218
219
2201 ;
221