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