NoonQuilt: makeQuilt.pl

#!/usr/bin/perl -w # This script is part of the NoonQuilt project: # # <insert URL> # # © Ali Graham, 1998 <mailto:agraham@hal9000.net.au> # # Start of makeQuilt.pl (Build the main quilt page) # make sure this is syntactically clear... use strict; use English; # ...and running under Perl5... require 5.001; # ################ DEFAULT VARIABLES ################## my %html_measure = ( # these set the values for building the quilt 'M_NumColumns' => 5, 'M_NumRows', => 7, 'M_NumIntCols' => 3, 'M_NumIntRows' => 3, ); my @layout = ( 1, 0, 0, 0, 2, 0, 0, 0, 3, ); # (reversed every second block)

I probably could have come up with something more extensible than the above scheme (and in fact I did try a number of different layout methods) but I decided that brevity was probably more improtant in this case....

# ##################################################### # Start of main() # include the external functions my $path = ""; if ( $OSNAME =~ /^mswin/i ) { $path = "d:\\Inetpub\\wwwroot\\quilt\\scripts\\"; chdir($path); }

(I needed to add the above lines to the start of every script, otherwise the Perl interpreter on Windows NT would not change to the directory the scripts were running in -- this is inconsistent with the behaviour on Unix, Amiga & Macintosh Perl, which did.)

(require $path."nq_config.pl") or (die "Can't open \"nq_config.pl\": $!\n"); (require $path."nq_dirstuff.pl") or (die "Can't open \"nq_dirstuff.pl\": $!\n"); (require $path."nq_mkpatch.pl") or (die "Can't open \"nq_mkpatch.pl\": $!\n"); # setup for quiltmaking... my $script_defs = &nqco_getScriptDefaults; my $html_defs = &nqco_getHTMLDefaults; &statusHeader; # get the list of files in the submissions directory my @patch_files = sort( &nqds_getDirList($script_defs->{'S_PatchDir'}) ); # delete all of the files in the patch HTML directory my @phtml_files = sort( &nqds_getDirList($script_defs->{'S_PatchHTMLDir'}) ); my $num_ph = $#phtml_files + 1; foreach my $patch ( @phtml_files ) { unlink "$script_defs->{'S_PatchHTMLDir'}$patch"; } print STDOUT "Deleted ( $num_ph ) patch HTML files", " from ( $script_defs->{'S_PatchHTMLDir'} ).\n<BR>\n<BR>\n"; my $quilt_num = 1; my @patch_buffer; until ( $#patch_files == -1 ) {

There are 105 patches per Quilt ([3 per cell] x [7 cells per row] x [5 rows]) so we need to pass that many to the subroutine that makes the quilt HTML - if there are less than 105 left, then all of them must be passed.

#split patch_files into 105-element sections @patch_buffer = splice(@patch_files, 0, 105); &nqmq_makeQuilt($quilt_num++, \@patch_buffer); } print STDOUT "makeQuilt.pl finished.\n"; print STDOUT "\n</BODY>\n\n</HTML>\n"; # End of main() # Start of statusHeader() sub statusHeader {

makeQuilt.pl outputs various progress information to the browser window as it is running....

print STDOUT <<End_Status_Header; Content-type: text/html <!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\"> <HTML> <HEAD> <TITLE>makeQuilt.pl Progress Report...</TITLE> </HEAD> <BODY BGCOLOR="#FFFFCE" TEXT="#313131"> End_Status_Header } # End of statusHeader() # Start of quiltHeader() sub quiltHeader {

The top of the HTML for the quilt.html page -- includes the JavaScript necessary to open a patch window.

print <<End_Of_Header; <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> <HTML> <HEAD> <TITLE>n o o n _ _ _ q u i l t</TITLE> <SCRIPT LANGUAGE="JavaScript"> </SCRIPT> </HEAD> End_Of_Header } # End of quiltHeader() # Start of nqmq_makeQuilt() sub nqmq_makeQuilt {

Most of this is relatively well commented, but it is not easy to see how it works. One tip is to have a look at the HTML generated by this script (go to, for example, this link, and 'View Source') and read through this side by side with an examination of this subroutine.

my $quilt_num = $ARG[0]; my $ptchlist_ref = $ARG[1]; # declare local variable(s) my $layout_mode = 0; my $num_rows = $html_measure{'M_NumRows'}; my $num_cols = $html_measure{'M_NumColumns'}; my $num_irows = $html_measure{'M_NumIntRows'}; my $num_icols = $html_measure{'M_NumIntCols'}; my $patch_file; my $image_count = 0; my $next_patch; my $prev_patch; my $quilt_defs = &nqco_getQuiltDefaults($quilt_num); my @patch_images = sort( &nqds_getDirList($quilt_defs->{'S_PatchImgDir'}) ); my @small_images = sort( &nqds_getDirList($quilt_defs->{'S_SmallImgDir'}) ); print STDOUT "Generating quilt", " ( $quilt_defs->{'S_QuiltFile'} ).\n<BR>\n<BR>\n<PRE>\n"; open(QUILT_HANDLE, ">$quilt_defs->{'S_QuiltFile'}") || die("Could not write to ( $quilt_defs->{'S_QuiltFile'} ) -- try again soon.\n"); # make sure all output goes to the proper file select(QUILT_HANDLE); &quiltHeader; print "<BODY BGCOLOR=\"$quilt_defs->{'H_QuiltBGColour'}\">\n\n"; print "\n\n<DIV ALIGN=CENTER>\n\n"; # start the HTML table my $table_width = ($num_cols * ($num_icols * 38)) + (($num_cols + 1) * 19); my $total_cols = ($num_cols + ($num_cols + 1)) + 2; print "\n", "<TABLE CELLPADDING=0 CELLSPACING=0 BORDER=0 WIDTH=$table_width>", "\n"; # do the dark frame &frame_Horizontal($total_cols); # first row of stitch graphics &stitch_Horizontal(1); for my $row (1 .. $num_rows) { print "\n", "<TR>", "\n"; # do the dark frame &frame_Vertical; # vertical stitch graphics &stitch_Vertical; for my $col (1 .. $num_cols) { print "\n", "<TD>", "\n"; print "\n", "<TABLE CELLPADDING=0 CELLSPACING=0 BORDER=0>", "\n"; my $current_cell = 0; my %row_desc; for my $irow (1 .. $num_irows) { # start internal row $row_desc{$irow} .= "\n<TR>\n"; for my $icol (1 .. $num_icols) { # start internal column $row_desc{$irow} .= "\n<TD>"; if ( $layout[$current_cell] ) { if ( defined($patch_file) ) { $prev_patch = $patch_file; } $patch_file = shift @$ptchlist_ref; if ( defined($patch_file) ) { $next_patch = shift @$ptchlist_ref; unshift(@$ptchlist_ref, $next_patch); } my $image_file; $image_file = $quilt_defs->{'H_PatchImgDir'}."/". "patch_images[$image_count]; if ( defined($patch_file) ) { # extract parameters from submission file my $params = &nqco_readParameters( "$script_defs->{'S_PatchDir'}$patch_file" ); $params->{'I_FileName'}{'Value'} = $patch_file; &patch_Render($row_desc{$irow}, $image_file, $params); # make the patch HTML file $params->{'P_ParentQuilt'}{'Value'} = $quilt_defs->{'P_QuiltFile'}; $params->{'P_StitchDir'}{'Value'} = $quilt_defs->{'P_StitchImageDir'}; $params->{'P_NextPatch'}{'Value'} = $next_patch; $params->{'P_PrevPatch'}{'Value'} = $prev_patch; $params->{'P_SmallImage'}{'Value'} = $quilt_defs->{'P_SmallImgDir'}."/"; $params->{'P_SmallImage'}{'Value'} .= $small_images[rand($#small_images+1)]; my $file_name = $script_defs->{'S_PatchHTMLDir'}; $file_name .= $patch_file.".htm"; if ( open(PATCH_HANDLE, ">$file_name") ) { &nqmp_makePatch($params, \*PATCH_HANDLE); close(PATCH_HANDLE); print STDOUT " *"; } else { print STDOUT " !"; } } else { &patch_Render($row_desc{$irow}, $image_file); print STDOUT " ."; } $image_count += 1; if ($image_count > $#patch_images) { $image_count = 0; } } else { &patch_Digit($row_desc{$irow}); } # end internal column $row_desc{$irow} .= "</TD>\n"; $current_cell += 1; } # end internal row $row_desc{$irow} .= "\n</TR>\n"; } # print out the internal rows.... if ($layout_mode == 0) {

The internal rows (i.e. the block of 9 within a cell -- 3 patches and 6 1's and 0's) need to be stored because half the time they need to be printed out backwards in order to achieve the /\/\/\ effect and still scan from left to right in the correct order.

for my $irow (1 .. $num_irows) { print $row_desc{$irow}; } $layout_mode = 1; } elsif ($layout_mode == 1) { for (my $irow = $num_irows; $irow > 0; $irow--) { print $row_desc{$irow}; } $layout_mode = 0; } print "\n", "</TABLE>", "\n"; # end the current column... print "</TD>", "\n"; &stitch_Vertical; } # do the dark frame &frame_Vertical; # end the current row... print "\n", "</TR>", "\n"; # ... and a row for the stitch graphics... &stitch_Horizontal( ($row == $num_rows) ); # ensure the <PRE> output looks OK print STDOUT "\n"; } # do the dark frame &frame_Horizontal($total_cols); # end the HTML table print "\n", "</TABLE>", "\n"; print "\n\n</DIV>\n\n"; # end the HTML page print "\n</BODY>\n\n</HTML>\n"; close(QUILT_HANDLE); select(STDOUT); print STDOUT "\n</PRE>\n\n<BR>\n<BR>\n"; } # End of nqmq_makeQuilt() # Start of patch_Render(str_to_add, image, [params]) sub patch_Render {

Generates the HTML within quilt.htm for an individual patch, reading from the parameters associated with that patch.

my $params; my $image; $image = $ARG[1]; if ( defined($ARG[2]) ) { $params = $ARG[2]; } if ( $params ) { my $name; $name = $params->{'F_UserName'}{'Value'}; $ARG[0] .= "\n<A HREF=\"javascript:open_patch('"; $ARG[0] .= "$html_defs->{'H_PatchHTMLDir'}/"; $ARG[0] .= "$params->{'I_FileName'}{'Value'}.htm')\" "; $ARG[0] .= "onMouseOver=\"window.status='$name'; return true\" "; $ARG[0] .= "onMouseOut=\"window.status=''; return true\">"; } $ARG[0] .= "\n<IMG SRC=\"$image\" ALT=\"ptch\" "; $ARG[0] .= "WIDTH=38 HEIGHT=38 BORDER=0>"; if ( $params ) { $ARG[0] .= "</A>"; } } # End of patch_Render() # Start of patch_Digit(str_to_add) sub patch_Digit {

Generates the HTML for a random 1 or 0 <IMG> tag.

my $num = int(rand(2)); my $image_file = ( $num == 0 ) ? "white0.gif" : "white1.gif"; $ARG[0] .= "<IMG SRC=\"$html_defs->{'H_StitchImageDir'}/$image_file\" "; $ARG[0] .= "ALT=\"$num\" WIDTH=38 HEIGHT=38 BORDER=0>"; } # End of patch_Digit() # Start of stitch_Horizontal(external) sub stitch_Horizontal {

Handles the HTML for all of the horizontal stitch graphics.

my $num_cols = $html_measure{'M_NumColumns'}; my $num_icols = $html_measure{'M_NumIntCols'}; my $image_dir = $html_defs->{'H_StitchImageDir'}; my $external = $ARG[0]; print "\n", "<TR>", "\n"; # do the dark frame &frame_Vertical; print "\n", "<TD WIDTH=19>", "<IMG SRC=\"$image_dir/grey_squ.gif\" ", "ALT=\"st\" WIDTH=19 HEIGHT=19 BORDER=0>", "</TD>", "\n"; foreach my $col (1 .. $num_cols) { print "\n", "<TD>"; foreach my $icol (1 .. $num_icols) { print "<IMG SRC=\"$image_dir/grey_hor.gif\" ALT=\"stitch\" ", "WIDTH=38 HEIGHT=19 BORDER=0>"; } print "</TD>", "\n"; # empty cell (or square image if on external border) print "\n", "<TD WIDTH=19"; if ( $external || ($col == $num_cols) ) { print "><IMG SRC=\"$image_dir/grey_squ.gif\" ALT=\"st\" ", "WIDTH=19 HEIGHT=19 BORDER=0>"; # the (rather ugly) black squares :) # } else { # print " BGCOLOR=\"#212121\">"; } print "</TD>", "\n"; if ( $col == $num_cols ) { # do the dark frame &frame_Vertical; } } print "\n", "</TR>", "\n"; } # End of stitch_Horizontal() # Start of stitch_Vertical() sub stitch_Vertical {

Handles the HTML for all of the vertical stitch graphics.

my $num_irows = $html_measure{'M_NumIntRows'}; my $image_dir = $html_defs->{'H_StitchImageDir'}; print "\n", "<TD WIDTH=19>"; foreach my $irow (1 .. $num_irows) { print "<IMG SRC=\"$image_dir/grey_vert.gif\" ALT=\"st\" ", "WIDTH=19 HEIGHT=38 BORDER=0>"; } print "</TD>", "\n"; } # End of stitch_Vertical()

These last two handle the HTML for the black border, or 'frame' -- no, not an HTML frame -- around the quilt. Netscape didn't react quite as well as IE (or, indeed, as well as AWeb, the Amiga browser I tested it on) and insisted on making the top border more than 4 pixels high....

# Start of frame_Horizontal(col_span) sub frame_Horizontal { my $image_dir = $html_defs->{'H_StitchImageDir'}; print "<TR>", "\n"; print "\n<TD HEIGHT=4 COLSPAN=$ARG[0] BGCOLOR=\"#212121\">", "\n<IMG SRC=\"$image_dir/blank.gif\" ALT=\" \" WIDTH=4 HEIGHT=4 BORDER=0>", "\n</TD>\n"; print "</TR>", "\n\n"; } # End of frameHorizontal() # Start of frame_Vertical() sub frame_Vertical { print "\n", "<TD WIDTH=4 BGCOLOR=\"#212121\">", "\n", " ", "\n</TD>\n\n"; } # End of frameVertical() # End of makeQuilt.pl

(back to the source index)	commented source