[Bio] / SubsystemEditor / WebPage / ShowIllustrations.pm Repository:
ViewVC logotype

Annotation of /SubsystemEditor/WebPage/ShowIllustrations.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download) (as text)

1 : bartels 1.1 package SubsystemEditor::WebPage::ShowIllustrations;
2 :    
3 :     use strict;
4 :     use warnings;
5 :     use URI::Escape;
6 :     use HTML;
7 :     use Data::Dumper;
8 :     use WebComponent::WebGD;
9 :    
10 :     use FIG;
11 :    
12 :     use constant ROLE => ''; # 'index.cgi?action=ShowFunctionalRole&subsystem_name=<SUBSYSTEM>&role_abbr=<ROLE>';
13 :     use constant SUBSYSTEM => 'diagram.cgi?subsystem_name=<SUBSYSTEM>';
14 :     use constant MAX_WIDTH => 800;
15 :     use constant MAX_HEIGHT => 700;
16 :     use constant MIN_SCALE => 0.65;
17 :    
18 :     use base qw( WebPage );
19 :    
20 :     1;
21 :    
22 :     ##################################################
23 :     # Method for registering components etc. for the #
24 :     # application #
25 :     ##################################################
26 :     sub init {
27 :     my ( $self ) = @_;
28 :     }
29 :    
30 :     sub require_javascript {
31 :    
32 :     return [ './Html/showfunctionalroles.js' ];
33 :    
34 :     }
35 :    
36 :     ##############################################
37 :     # Website content is returned by this method #
38 :     ##############################################
39 :     sub output {
40 :     my ( $self ) = @_;
41 :    
42 :     my $fig = new FIG;
43 :     my $cgi = $self->application->cgi;
44 :    
45 :     my $name = $cgi->param( 'subsystem' );
46 :     my $ssname = $name;
47 :     $ssname =~ s/\_/ /g;
48 :    
49 :     # look if someone is logged in and can write the subsystem #
50 :     my $can_alter = 0;
51 :     my $user = $self->application->session->user;
52 :     if ( $user && $user->has_right( $self->application, 'edit', 'subsystem', $name ) ) {
53 :     $can_alter = 1;
54 :     }
55 :    
56 :     ######################
57 :     # Construct the menu #
58 :     ######################
59 :    
60 :     my $menu = $self->application->menu();
61 :    
62 :     # Build nice tab menu here
63 :     $menu->add_category( 'Subsystem Info', "SubsysEditor.cgi?page=ShowSubsystem&subsystem=$name" );
64 :     $menu->add_category( 'Functional Roles', "SubsysEditor.cgi?page=ShowFunctionalRoles&subsystem=$name" );
65 :     $menu->add_category( 'Diagram', "SubsysEditor.cgi?page=ShowDiagram&subsystem=$name" );
66 :     $menu->add_category( 'Illustrations', "SubsysEditor.cgi?page=ShowIllustrations&subsystem=$name" );
67 :     $menu->add_category( 'Spreadsheet', "SubsysEditor.cgi?page=ShowSpreadsheet&subsystem=$name" );
68 :     $menu->add_category( 'Show Check', "SubsysEditor.cgi?page=ShowCheck&subsystem=$name" );
69 :     $menu->add_category( 'Show Tree', "SubsysEditor.cgi?page=ShowTree&subsystem=$name" );
70 :    
71 :     my $error = '';
72 :     my $comment = '';
73 :    
74 :     ##############################
75 :     # Construct the page content #
76 :     ##############################
77 :    
78 :     my $content = "<H1>Subsystem Illustrations: $ssname</H1>";
79 :     $content .= "<P>Illustrations are general diagrams related to the subsystem that cannot be colored.</P>";
80 :    
81 :     my $diagram = $self->get_Diagram( $fig, $cgi, $can_alter );
82 :    
83 :     $content .= $diagram;
84 :    
85 :    
86 :     ###############################
87 :     # Display errors and comments #
88 :     ###############################
89 :    
90 :     if ( defined( $error ) && $error ne '' ) {
91 :     $self->application->add_message( 'warning', $error );
92 :     }
93 :     if ( defined( $comment ) && $comment ne '' ) {
94 :     $self->application->add_message( 'info', $comment );
95 :     }
96 :    
97 :     return $content;
98 :     }
99 :    
100 :    
101 :     sub get_data {
102 :    
103 :     my ( $fig, $subsystem_name ) = @_;
104 :     my $subsystem = $fig->get_subsystem( $subsystem_name );
105 :    
106 :     my $default_diagram;
107 :     my $newDiagrams;
108 :    
109 :     foreach my $d ( $subsystem->get_diagrams ) {
110 :     my ( $id, $name ) = @$d;
111 :     unless ( $subsystem->is_new_diagram( $id ) ) {
112 :     $newDiagrams->{ $id }->{ 'name' } = $name;
113 :     if ( !defined( $default_diagram ) ) {
114 :     $default_diagram = $id;
115 :     }
116 :     }
117 :     }
118 :    
119 :     return ( $subsystem, $newDiagrams, $default_diagram );
120 :     }
121 :    
122 :     sub get_Diagram {
123 :     my ( $self, $fig, $cgi, $can_alter ) = @_;
124 :    
125 :     # get the subsystem
126 :     unless ( $cgi->param( 'subsystem' ) ) {
127 :     return '<p>CGI Parameter missing.</p>';
128 :     }
129 :     my $subsystem_name = $cgi->param( 'subsystem' ) || '';
130 :     my $subsystem_pretty = $subsystem_name;
131 :     $subsystem_pretty =~ s/_/ /g;
132 :     my ( $subsystem, $newDiagrams, $defaultDiagram ) = get_data( $fig, $subsystem_name );
133 :    
134 :     # check subsystem
135 :     unless ( $subsystem ) {
136 :     return "<p>Unable to find a subsystem called '$subsystem_name'.</p>";
137 :     }
138 :    
139 :     #####################################
140 :     # get values for attribute coloring #
141 :     #####################################
142 :    
143 :     my $color_by_attribute = 0;
144 :     my $attribute = $cgi->param( 'attribute_selectbox' );
145 :    
146 :    
147 :     # if diagram.cgi is called without the CGI param diagram (the diagram id)
148 :     # it will try to load the first 'new' diagram from the subsystem and
149 :     # print out an error message if there is no 'new' diagram
150 :     my $diagram_id = $cgi->param( 'diagram' ) || $cgi->param( 'diagram_selectbox' ) || '';
151 :    
152 :     if ( defined( $cgi->param( 'Show this diagram' ) ) ) {
153 :     $diagram_id = $cgi->param( 'diagram_selectbox' );
154 :     }
155 :    
156 :     unless ( $diagram_id ) {
157 :     $diagram_id = $defaultDiagram;
158 :     }
159 :    
160 :     # check diagram id
161 :     my $errortext = '';
162 :    
163 :     if ( !( $diagram_id ) ) {
164 :     $errortext .= "<p><em>Unable to find a diagram for this subsystem.</em><p>";
165 :     }
166 :    
167 :     # initialise a status string (log)
168 :     my $status = '';
169 :    
170 :     # generate the content
171 :     my $content = $errortext;
172 :    
173 :     # start form #
174 :     $content .= $self->start_form( 'diagram_select_genome' );
175 :     $content .= "<TABLE><TR><TD>";
176 :    
177 :     my $choose = build_show_other_diagram( $fig, $cgi, $subsystem, $newDiagrams, $diagram_id );
178 :    
179 :     my $scale = 1;
180 :    
181 :     $content .= "<DIV id='controlpanel'>$choose</DIV></TD><TR><TR><TD>";
182 :    
183 :     if ( $diagram_id ) {
184 :     # fetch the diagram
185 :     my $diagram_dir = $subsystem->{dir}."/diagrams/$diagram_id/";
186 :    
187 :     my $d = $diagram_dir;
188 :     if ( -f $diagram_dir.'diagram.png' ) {
189 :     $d = $diagram_dir.'diagram.png';
190 :     }
191 :     elsif ( -f $diagram_dir.'diagram.jpg' ) {
192 :     $d = $diagram_dir.'diagram.jpg';
193 :     }
194 :     elsif ( -f $diagram_dir.'diagram.gif' ) {
195 :     $d = $diagram_dir.'diagram.gif';
196 :     }
197 :    
198 :     # print diagram
199 :     my $image = new WebGD( $d );
200 :     my ( $width, $height ) = ( $image->getBounds() );
201 :    
202 :     unless ( $cgi->param( 'dont_scale' ) ) {
203 :     ( $scale, $width, $height ) = calculate_scale( $width, $height );
204 :     }
205 :    
206 :     $content .= "<DIV><IMG SRC=\"".$image->image_src()."\" width=$width height=$height></DIV>";
207 :    
208 :     # add an info line about diagram scaling
209 :     my $scaling_info;
210 :     my $calculate_scale = 1;
211 :     my $scale = $calculate_scale * 100;
212 :     if ( $scale == 100 ) {
213 :     $scaling_info .= '<p><em>This diagram is not scaled.</em></p>';
214 :     }
215 :     else {
216 :     $scaling_info .= '<p><em>This diagram has been scaled to '.sprintf("%.2f", $scale).'%. ';
217 :     $scaling_info .= "(<a href='".$self->application->url()."?page=ShowDiagram&subsystem=$subsystem_name&diagram=$diagram_id&dont_scale=1'>".
218 :     "view in original size</a>)";
219 :     $scaling_info .= '</em></p>';
220 :     }
221 :     if ( $cgi->param( 'dont_scale' ) ) {
222 :     $scaling_info .= '<p><em>You have switched off scaling this diagram down. ';
223 :     $scaling_info .= "(<a href='".$self->application->url()."?page=ShowDiagram&subsystem=$subsystem_name&diagram=$diagram_id'>".
224 :     "Allow scaling</a>)";
225 :     $scaling_info .= '</em></p>';
226 :     }
227 :    
228 :     $content .= "</TD></TR><TR><TD>$scaling_info</TD></TR>";
229 :     }
230 :    
231 :     $content .= "<TR><TD><DIV id='controlpanel'>$choose";
232 :    
233 :     # upload diagram only if can_alter #
234 :     if ( $can_alter ) {
235 :     my $upload = $self->build_upload_diagram( $fig, $subsystem_name );
236 :     $content .= "$upload";
237 :     }
238 :    
239 :     $content .= "</DIV></TD><TR></TABLE>";
240 :    
241 :     # hiddens for subsystem, diagram, scale #
242 :     $content .= $cgi->hidden( -name => 'subsystem',
243 :     -value => $subsystem_name );
244 :     $content .= $cgi->hidden( -name => 'diagram',
245 :     -value => $diagram_id );
246 :    
247 :     $content .= $cgi->hidden( -name => 'dont_scale', -value => 1 )
248 :     if ( $cgi->param( 'dont_scale' ) );
249 :    
250 :     $content .= $self->end_form();
251 :    
252 :     return $content;
253 :     }
254 :    
255 :     #######################################
256 :     # build the little show other diagram #
257 :     #######################################
258 :     sub build_show_other_diagram {
259 :    
260 :     my ( $fig, $cgi, $subsystem, $diagrams, $default ) = @_;
261 :    
262 :     my $default_num;
263 :    
264 :     my @ids = sort keys %$diagrams;
265 :     my %names;
266 :     my $counter = 0;
267 :     foreach ( @ids ) {
268 :     if ( $_ eq $default ) {
269 :     $default_num = $counter;
270 :     }
271 :     $names{ $_ } = $diagrams->{ $_ }->{ 'name' };
272 :     $counter++;
273 :     }
274 :    
275 :     my $diagramchoose = "<H2>Choose other diagram</H2>\n";
276 :     if ( scalar( @ids ) == 1 ) {
277 :     $diagramchoose .= "<P>There is one illustration for this subsystem.</P>";
278 :     }
279 :     else {
280 :     $diagramchoose .= "<P>There are ".scalar( @ids )." illustrations for this subsystem.</P>";
281 :     }
282 :     $diagramchoose .= $cgi->popup_menu( -name => 'diagram_selectbox',
283 :     -values => \@ids,
284 :     -default => $default_num,
285 :     -labels => \%names,
286 :     -maxlength => 150,
287 :     );
288 :    
289 :     $diagramchoose .= $cgi->submit( -name => 'Show this diagram' );
290 :    
291 :     return $diagramchoose;
292 :     }
293 :    
294 :    
295 :     ###################################
296 :     # build the little upload diagram #
297 :     ###################################
298 :     sub build_upload_diagram {
299 :    
300 :     my ( $self, $fig, $subsystem_name ) = @_;
301 :    
302 :     my $diagramupload = "<H2>Upload new diagram</H2>\n";
303 :     $diagramupload .= "<A HREF='".$self->application->url()."?page=UploadDiagram&subsystem=$subsystem_name'>Upload a new diagram or change an existing one for this subsystem</A>";
304 :    
305 :     }
306 :    
307 :     sub calculate_scale {
308 :     my ( $width, $height ) = @_;
309 :    
310 :     my $scale = 1;
311 :     if ( $width > MAX_WIDTH ) {
312 :     $scale = MAX_WIDTH / $width;
313 :     }
314 :     if ( $height > MAX_HEIGHT and
315 :     (( MAX_HEIGHT / $height) < $scale) ) {
316 :     $scale = MAX_HEIGHT / $height;
317 :     }
318 :    
319 :     $scale = $scale < MIN_SCALE ? MIN_SCALE : $scale ;
320 :    
321 :     return ( $scale, $scale * $width, $scale * $height );
322 :     }
323 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3