view release on metacpan or  search on metacpan

lib/Algorithm/Networksort.pm  view on Meta::CPAN

	my @vcoord = vt_coords($inputs, %grset);
	my @hcoord = hz_coords($columns, %grset);

	my $xbound = $hcoord[$columns - 1] + $grset{hz_margin} + $grset{indent};
	my $ybound = $vcoord[$inputs - 1] + $grset{vt_margin};
	my $i_radius = $grset{inputradius};
	my $c_radius = $grset{compradius};

	my %clrset = colorswithdefaults();
	my $monotone = ismonotone(%clrset);

	map{$clrset{$_} = psrgbcolor($clrset{$_}) . " setrgbcolor"} keys %clrset;

	#
	# Create the necessary DSC, the arrays of vertical
	# and horizontal coordinates, and the left and right
	# margin definitions.
	#
	my $string =
		qq(%!PS-Adobe-3.0 EPSF-3.0\n%%BoundingBox: 0 0 $xbound $ybound\n) .
		qq(%%CreationDate: ) .  localtime() .
		qq(\n%%Creator: ) . $self->creator() .
		qq(\n%%Title: ) . $self->title() .
		qq(\n%%Pages: 1\n%%EndComments\n%%Page: 1 1\n) .

		qq(/vcoord [) .
		join("\n    ", semijoin(' ', 16, @vcoord)) . qq(] def\n\n) .
		qq(/hcoord [) .
		join("\n    ", semijoin(' ', 16, @hcoord)) . qq(] def\n\n) .
		qq(/leftmargin $grset{hz_margin} def\n) .
		qq(/rightmargin ) . ($xbound - $grset{hz_margin}) . qq( def\n\n);

	#
	# Define the input line procedure.
	#
	$string .= qq(%\n% inputline draw-inputline\n%\n) .
	qq(/draw-inputline {\n    vcoord exch get leftmargin exch\n) .
	qq(    dup rightmargin exch % x1 y1 x2 y1\n\n);

	$string .= qq(    4 copy\n) if ($i_radius > 0);
	$string .= qq(    $clrset{inputline}\n) unless ($monotone);

	$string .= qq(    newpath moveto lineto stroke\n);

	if ($i_radius > 0)
	{
		if ($monotone)
		{
			$string .= qq(    newpath 2 copy moveto $i_radius 0 360 arc fill ) .
				qq(newpath 2 copy moveto $i_radius 0 360 arc fill\n);
		}
		else
		{
			$string .= qq(    $clrset{inputend}\n) .
				qq(    newpath 2 copy moveto $i_radius 0 360 arc fill\n) .
				qq(    $clrset{inputbegin}\n) .
				qq(    newpath 2 copy moveto $i_radius 0 360 arc fill\n);
		}
	}

	$string .= qq(} bind def\n\n);

	#
	# Define the comparator procedure.
	#
	$string .= qq(%\n% column inputline1 inputline2 draw-comparatorline\n%\n) .
		qq(/draw-comparatorline {\n) .
    		qq(    vcoord exch get 3 1 roll vcoord exch get 3 1 roll\n) .
    		qq(    hcoord exch get 3 1 roll 2 index exch % now x1 y1 x1 y2\n\n);

	$string .= qq(    4 copy\n) if ($c_radius > 0);
	$string .= qq(    $clrset{compline}\n) unless ($monotone);

	$string .= qq(    newpath moveto lineto stroke\n);

	if ($c_radius > 0)
	{
		if ($monotone)
		{
			$string .= qq(    newpath 2 copy moveto $c_radius 0 360 arc fill ) .
				qq(newpath 2 copy moveto $c_radius 0 360 arc fill\n);
		}
		else
		{
			$string .= qq(    $clrset{compend}\n) .
				qq(    newpath 2 copy moveto $c_radius 0 360 arc fill\n) .
				qq(    $clrset{compbegin}\n) .
				qq(    newpath 2 copy moveto $c_radius 0 360 arc fill\n);
		}
	}

	$string .= qq(} bind def\n\n);

	#
	# Save the current graphics state, then change the drawing
	# coordinates (from (0,0) = lower left to (0,0) = upper left),
	# and the color if we're drawing in a single color.
	#
	$string .= qq(gsave\n0 $ybound translate\n1 -1 scale\n);
	$string .= qq($clrset{foreground}\n) if ($monotone);

	if (defined $clrset{background})
	{
		$string .= qq(\ngsave $clrset{background}\n);
		$string .= qq(0 0 moveto 0 $ybound lineto $xbound $ybound lineto $xbound 0 lineto closepath);
		$string .= qq(\nfill grestore\n);
	}

	#
	# Draw the input lines.
	#
	$string .= qq(\n%\n% Draw the input lines.\n%\n$grset{inputline} setlinewidth\n) .
		qq(0 1 ) . ($inputs-1) . qq( {draw-inputline} for\n);

	#
	# Draw our comparators.
	# Each member of a group of comparators is drawn in the same column.
	#
	$string .= qq(\n%\n% Draw the comparator lines.\n%\n$grset{compline} setlinewidth\n);
	my $hidx = 0;
	for my $group (@node_stack)
	{
		for my $comparator (@$group)
		{
			$string .= sprintf("%d %d %d draw-comparatorline\n", $hidx, @$comparator);
		}
		$hidx++;
	}

	$string .= qq(showpage\ngrestore\n% End of the EPS graph.\n);
	return $string;
}

=head3 graph_svg()

Returns a string that creates a Knuth diagram of a network.

    $nw = nwsrt(inputs => 4, algorithm => 'bitonic');
    $diagram = $nw->graph_svg();    # Using default attributes.

The string will consist of SVG drawing tags enclosed by E<lt>svgE<gt> and E<lt>/svgE<gt> tags.

The attributes of the diagram can be changed via colorsettings() and graphsettings().

    $nw = nwsrt_best(name => 'floyd09');   # See Algorithm::Networksort::Best

    $nw->colorsettings(compbegin => '#04c', compend => '#00c');
    $diagram = $nw->graph_svg();

=begin html

<p>Embedded in a web page, this will produce</p>