Silicon-Chip
view release on metacpan or search on metacpan
lib/Silicon/Chip.pm view on Meta::CPAN
{my $ix = $p{$d->output}->x; # Position of input gate in x
my $nx = $W+$w; # Position of driven gate in x
$iBus[$ix][$ix] = '1'; # Mark position of driving input gate on input bus
$iBus[$ix][$nx] = '1'; # Mark position of pin on driven gate on input bus
$miw = max($miw, $ix+1, $nx+1); # Maximum width of input bus. Plus one because we must take into account the width of the input gate and the driven pins
}
$w++; # Next driver position
}
$p{$G} = newGatePosition(gate => $g, x => $W, y => $i, width =>$w); # Position non io gate
$W += $w; # Width of area needed for non io gates
}
for my $b(@iBus) # Represent the input bus lines as strings as they are easier to visualize
{$b = pad join('', map {$_ ? '1' : '0'} @$b), $miw, '0';
}
my @iBusLayout = layoutInputBus(@iBus); # Input bus line for each input gate
if (@iBusLayout) # Usually there are outer input pins - but not always.
{my $iBusHeight = 1 + max(@iBusLayout); # The height of the input bus area
#say STDERR "Improvement: ", scalar(@iBus) / $iBusHeight);
for my $i(keys @$iG) # Position of each input gate
{my $G = $$iG[$i]; # Gate name
my $L = $p{$G}; # Layout for input gate
my $B = $L->busLine = $iBusLayout[$i]; # Bus line for this input gate
my ($f, $l) = firstLastOne($iBus[$i]); # Limits on bus line for this input gate
$L->busStart = $f; $L->busEnd = $l; # Save limits on bus line for this input gate
my $y = 1/2 + $B; # Vertical position of input bus line
my $c = q(#DC143C); # B<Spanish Crimson> for horizontal input bus lines
if ($f != $l) # Horizontal input bar required for this gate
{$s->line(x1 => $f-1/2, x2 => $l-1/2, y1 => $y, y2 => $y, stroke => $c); # Draw level 2 input bus line
}
my $Lx = $L->x+1/2; my $Ly = 1/2 + $B; my @o = (opacity=>0.3);
$s->line (x1 => $Lx, x2 => $Lx, @o, stroke_width => 2*Fw, # Draw vertical level 1 input bus line
y1 => 1, y2 => $Ly, stroke => "blue");
$s->circle(cx => $Lx, cy => $Ly, r => 3*Fw, @o, fill => "blue"); # Draw circle connecting vertical level 1 input bus line to horizontal level 2
}
for my $i(keys @$nG) # Reposition the non io gates a little further down to make room for the input bus area
{my $G = $$nG[$i]; # Gate name
my $n = $p{$G}; # Layout for input gate
$n->y += $iBusHeight;
}
}
for my $i(keys @$oG) # Position each output gate
{my $G = $$oG[$i]; # Gate name
my $g = $$gates{$G}; # Gate
my %i = $g->inputs ? $g->inputs->%* : (); # Inputs to gate
my ($d) = values %i; # The one driver for this gate
next unless defined $p{$d};
my $y = $p{$d}->y;
$p{$G} = newGatePosition(gate=>$g, x=>$W, y=>$y, width=>1); # Position output gate
}
my $pageWidth = $W + 1; # Width of input, output and non io gates as laid out.
if (defined($title)) # Title if known
{$s->text(x=>$pageWidth, y=>0.5, fill=>"darkGreen", text_anchor=>"end",
stroke_width=>Fw, font_size=>Fs, z=>-1,
cdata=>$title);
}
if (defined($steps)) # Number of steps taken if known
{$s->text(x=>$pageWidth, y=>1.5, fill=>"darkGreen", text_anchor=>"end",
stroke_width=>Fw, font_size=>Fs, z=>-1,
cdata=>"$steps steps");
}
for my $P(sort keys %p) # Each gate with text describing it
{my $p = $p{$P};
my $x = $p->x;
my $y = $p->y;
my $w = $p->width;
my $g = $p->gate;
my $color = sub
{return "red" if $g->io == gateOuterOutput;
return "blue" if $g->io == gateOuterInput;
"green"
}->();
if ($g->io) # Circle for io pin
{$s->circle(cx=>$x+1/2, cy=>$y+1/2, r=>1/2, fill=>op0, stroke=>$color);
}
else # Rectangle for non io gate
{$s->rect(x=>$x, y=>$y, width=>$w, height=>1, fill=>op0, stroke=>$color);
}
if (defined(my $v = $$values{$g->output})) # Value of gate if known
{$s->text(
x => $g->io != gateOuterOutput ? $x : $x + 1,
y => $y,
fill =>"black",
stroke_width => Fw,
font_size => Fs,
text_anchor => $g->io != gateOuterOutput ? "start": "end",
dominant_baseline => "hanging",
cdata => $v ? "1" : "0");
}
if (defined(my $t = $$changed{$g->output}) and !$g->io) # Gate change time if known for a non io gate
{$s->text(
x => $w + ($g->io != gateOuterOutput ? $x : $x + 1),
y => 1 + $y,
fill =>"black",
stroke_width => fw,
font_size => fs,
text_anchor => "end",
cdata => $t+1);
}
my sub ot($$$$) # Output svg text
{my ($dy, $fill, $pos, $text) = @_;
$s->text(x => $x+$w/2,
y => $y+$dy,
fill => $fill,
text_anchor => "middle",
dominant_baseline => $pos,
cdata => $text);
}
ot(5/12, "red", "auto", $g->type); # Type of gate
ot(7/12, "darkblue", "hanging", $g->output);
if ($g->io != gateOuterInput) # Not an input pin
{my %i = $g->inputs ? $g->inputs->%* : ();
my @i = sort keys %i; # Connections to each gate
my $o = $g->output;
for my $i(keys @i) # Connections to each gate
{my $D = $i{$i[$i]}; # Driving gate name
my $P = $p{$D}; # Driving gate
defined($P) or confess <<"END";
No such gate as: '$D' on gate $o
END
my $X = $P->x; my $Y = $P->y; my $W = $P->width; my $G = $P->gate; # Position of source gate
my $dx = $i + 1/2;
my $dy = $Y < $y ? 0 : 1;
my $dX = $X < $x ? $W : 0;
my $dY = $Y < $y ? 0 : 0;
my $cx = $x+$dx; # Horizontal line corner x
my $cy = $Y+$dY+1/2; # Horizontal line corner y
my $xc = $X < $x ? q(black) : q(darkBlue); # Horizontal line color
my $x2 = $g->io == gateOuterOutput ? $cx - 1/2 : $cx;
if ($P->gate->io != gateOuterInput) # Not being driven by an outer input gate.
{$s->line(x1=>$X+$dX, x2=>$x2, y1=>$cy, y2=>$cy, stroke=>$xc); # Outgoing value along horizontal lines
}
my $yc = $Y < $y ? q(purple) : q(darkRed); # Vertical lines
if ($g->io != gateOuterOutput) # Not an output gate
{my $Cy = $cy;
$Cy = $P->busLine + 1/2 if $P->gate->io == gateOuterInput; # Connect to input level 2 horizontal bar if connecting to an outer input gate
$s->line (x1=>$cx, x2=>$cx, y1=>$Cy, y2=>$y+$dy, stroke=>$yc); # Incoming value along vertical line - not needed for outer output gates
$s->circle(cx=>$cx, cy=>$Cy, r=>0.06, fill=>"red"); # Line corner
$s->circle(cx=>$x2, cy=>$y+$dy, r=>0.04, fill=>"blue"); # Line entering gate
}
else # External output gate
{$s->circle(cx=>$x2, cy=>$y+$dy-1/2, r=>0.04, fill=>"blue"); # Line entering output
}
if ($P->gate->io != gateOuterInput) # Not an outer input gate
{$s->circle(cx=>$X+$W, cy=>$cy, r=>0.04, fill=>"red"); # Horizontal line exiting gate
}
if (defined(my $v = $$values{$G->output}) and $g->io != gateOuterOutput)# Value of gate if known except for output gates written else where
{my $bottom = $x > $X || $G->io == gateOuterInput;
my $Y = $y + $dy + fs;
$s->text(
x => $cx,
y => $Y,
fill => "black",
stroke_width => fw,
font_size => fs,
text_anchor => "middle",
$bottom ? () : (dominant_baseline=>"hanging"),
cdata => $v ? "1" : "0");
}
}
}
}
my $t = $s->print;
return owf(fpe($options{svg}, q(svg)), $t) if $options{svg};
$t
}
sub Silicon::Chip::Simulation::printSvg($%) # Print simulation results as svg.
{my ($sim, %options) = @_; # Simulation, options
printSvg($sim->chip, %options, values=>$sim->values);
}
my sub layoutAsFiberBundle($%) # Layout the gates as a fiber bundle collapsed down to as close to the gates as possible. The returned information is sufficient to draw an svg image of the fiber bundle...
{my ($chip, %options) = @_; # Chip, options
my %gates = $chip->gates->%*; # Gates on chip
my $changed = $options{changed}; # Step at which gate last changed in simulation
my $values = $options{values}; # Values of each gate if known
my @gates = sort {$gates{$a}->seq <=> $gates{$b}->seq} keys %gates; # Gates in definition order
if (my $c = $options{changed}) # Order non IO gates by last change time during simulation if possible
{@gates = sort {($$c{$a}//0) <=> ($$c{$b}//0)} @gates;
}
my @fibers; # Squares of the page, each of which can either be undefined or contain the name of the fiber crossing it from left to right or up and down
my @inPlay; # Squares of the page in play
my @positions; # Position of each gate indexed by position in layout
my %positions; # Position of each gate indexed by gate name
my $width = 1; # Width of page consumed so far until it becomes the page width.
my $height = 0; # Height of page consumed so far until it becomes the page height
for my $i(keys @gates) # Position each gate
{my $g = $gates{$gates[$i]}; # Gate details
my $s = $g->type =~ m(\A(input|one|output|zero)\Z); # These gates can be positioned without consuming more horizontal space
my %i = $g->inputs->%*; # Inputs hash for gate
my @i = sort keys %i; # Connections to each gate in pin order
my $w = $s ? 1 : scalar(@i); # Width of this gate
my $n = $g->output; # Name of gate
my sub color() # Color of gate
{return "red" if $g->io == gateOuterOutput;
return "blue" if $g->io == gateOuterInput;
"green"
}
my $x = $width; $x-- if $s; # Position of gate
my $y = $i;
my $p = genHash(__PACKAGE__."::GatePosition",
output => $g->output, # Gate name
x => $x, # Gate x position
y => $y, # Gate y position
width => $w, # Width of gate
fiber => 0, # Number of fibers running past this gate
position => $i, # Number of fibers running past this gate
type => $g->type, # Type of gate
value => $$values {$g->output}, # Value of gate if known
changed => $$changed{$g->output}, # Last change time of gate if known
inputs => [map {$i{$_}} @i], # Names of gates driving input pins on this gate
lib/Silicon/Chip.pm view on Meta::CPAN
fibers => \@fibers, # Fibers after collapse
inPlay => \@inPlay, # Squares in play for collapsing
height => $height, # Height of drawing
width => $width, # Width of drawing
steps => $options{steps}, # Steps in simulation
thickness => $t, # Width of the thickest fiber bundle
);
}
sub Silicon::Chip::Layout::draw($%) #P Draw a mask for the gates.
{my ($layout, %options) = @_; # Layout, options
my $chip = $layout->chip; # Chip being masked
my %gates = $chip->gates->%*; # Gates on chip
my @fibers = $layout->fibers->@*; # Squares of the page, each of which can either be undefined or contain the name of the fiber crossing it from left to right or up and down
my @inPlay = $layout->inPlay->@*; # Squares available for collapsing
my @positions = $layout->positionsArray->@*; # Position of each gate indexed by position in layout
my %positions = $layout->positionsHash ->%*; # Position of each gate indexed by gate name
my $width = $layout->width; # Width of mask
my $height = $layout->height; # Height of mask
my $steps = $layout->steps; # Number of steps to equilibrium
my $thickness = $layout->thickness; # Thickness of fiber bundle
my sub ts() {$height/64} my sub tw() {ts/16} my sub tl() {1.25 * ts} # Font sizes for titles
my sub Ts() {2*ts} my sub Tw() {2*tw} my sub Tl() {2*tl}
my sub fs() {1/6} my sub fw() {fs/16} my sub fl() {1.25 * fs} # Font sizes for gates
my sub Fs() {2*fs} my sub Fw() {2*fw} my sub Fl() {2*fl}
my @defaults = (defaults=> # Default values
{stroke_width => fw,
font_size => fs,
fill => q(transparent)});
my $svg = Svg::Simple::new(@defaults, %options, grid=>debugMask ? 1 : 0); # Draw each gate via Svg. Grid set to 1 produces a grid that can be helpful debugging layout problems
if (1) # Show squares in play with a small number of rectangles
{my @i = map {$_ ? [@$_] : $_} @inPlay; # Deep copy
for my $i(keys @i) # Each row
{for my $j(keys $i[$i]->@*) # Each column
{if ($i[$i][$j]) # Found a square in play
{my $w = 1; # Width of rectangle
for my $I($i+1..$#inPlay) # Extend as far as possible to the right
{if ($i[$I][$j])
{++$w;
$i[$I][$j] = undef; # Show that this square has been written - safe because we did a deep copy earlier
}
}
$svg->rect(x=>$i, y=>$j, width=>$w, height=>1,
fill=>"mistyrose", stroke=>"transparent");
}
}
}
}
my $py = 0;
my sub wt($;$) # Write titles on following lines
{my ($t, $T) = @_; # Value, title to write
if (defined($t)) # Value to write
{$py += Tl; # Position to write at
my $s = $t; $s .= " $T" if $T; # Text to write
$svg->text(x => $width, y => $py, cdata => $s, # Write text
fill=>"darkGreen", text_anchor=>"end", stroke_width=>Tw, font_size=>Ts);
}
}
wt($chip->title); # Title if known
wt($steps, "steps"); # Number of steps taken if known
wt($thickness, "thick"); # Thickness of bundle
wt($width, "wide"); # Width of page
for my $p(@positions) # Draw each gate
{my $x = $p->x; my $y = $p->y; my $w = $p->width; my $c = $p->color;
my $io = $p->inPin || $p->outPin;
$svg->circle(cx => $x+1/2, cy=>$y+1/2, r=>1/2, stroke=>$c) if $io; # Circle for io pin
$svg->rect(x=>$x, y=>$y, width=>$w, height=>1, stroke=>$c) if !$io; # Rectangle for non io gate
if (defined(my $v = $p->value)) # Value of gate if known
{$svg->text(
x => $p->x,
y => $p->y,
fill =>"black",
stroke_width => Fw,
font_size => Fs,
text_anchor => "start",
dominant_baseline => "hanging",
cdata => $v ? "1" : "0");
}
if (defined(my $t = $p->changed) and !$p->inPin and !$p->outPin) # Gate change time if known for a non io gate
{$svg->text(
x => $p->x + $p->width,
y => $p->y + 1,
fill => "darkBlue",
stroke_width => fw,
font_size => fs,
text_anchor => "end",
cdata => $t+1);
}
my sub ot($$$$) # Output svg text
{my ($dy, $fill, $pos, $text) = @_;
$svg->text(x => $p->x+$p->width/2,
y => $p->y+$dy,
fill => $fill,
text_anchor => "middle",
dominant_baseline => $pos,
cdata => $text);
}
ot(5/12, "red", "auto", $p->type); # Type of gate
ot(7/12, "darkblue", "hanging", $p->output);
my @i = $p->inputValues->@*;
for my $i(keys @i) # Draw input values to each pin on the gate
{next if $p->inPin or $p->outPin;
my $v = $p->inputValues->[$i];
if (defined($v))
{$svg->text(
x => $p->x + $i + 1/2,
y => $p->y,
fill => "darkRed",
stroke_width => fw,
font_size => fs,
text_anchor => "middle",
dominant_baseline => "hanging",
cdata => $v ? "1" : "0");
}
}
}
if (debugMask) # Show fiber names - useful when debugging bus lines
{for my $i(keys @fibers)
{for my $j(keys $fibers[$i]->@*)
{if (defined(my $n = $fibers[$i][$j][0])) # Horizontal
{$svg->text(
x => $i+1/2,
y => $j+1/2,
fill =>"black",
stroke_width => fw,
font_size => fs,
text_anchor => 'middle',
dominant_baseline => 'auto',
cdata => $n,
)# if $n eq "a4" || $n eq "a4";
}
if (defined(my $n = $fibers[$i][$j][1])) # Vertical
{$svg->text(
x => $i+1/2,
y => $j+1/2,
fill =>"red",
stroke_width => fw,
font_size => fs,
text_anchor => 'middle',
dominant_baseline => 'hanging',
cdata => $n,
)# if $n eq "a4" || $n eq "a4";
}
}
}
}
if (1) # Show fiber lines
{my @h = (stroke =>"darkgreen", stroke_width => Fw); # Fiber lines horizontal
my @v = (stroke =>"darkgreen", stroke_width => Fw); # Fiber lines vertical
my @f = @fibers;
my @i = @inPlay;
my @H; my @V; # Straight line cells
for my $i(keys @f)
{for my $j(keys $f[$i]->@*)
{my $h = $f[$i][$j][0]; # Horizontal
my $v = $f[$i][$j][1]; # Vertical
if (defined($h) and defined($v) and $h eq $v) # Cross
{my $l = !$i[$i-1][$j] || ($i[$i-1][$j] && ($f[$i-1][$j][0]//'') eq $h); # Left horizontal
my $r = $i[$i+1][$j] && ($f[$i+1][$j][0]//'') eq $h; # Right horizontal
my $a = $j > 0 && $i[$i][$j-1] && ($f[$i][$j-1][1]//'') eq $h; # Vertically above
my $b = $j >= $f[$i]->$#* || ($i[$i][$j+1] && ($f[$i][$j+1][1]//'') eq $h); # Vertically below
# | A --+ |C D
# +-- B | +-- --+--
# | |
my $D = $l && $r && $b;
my $C = $a && $r && $b;
my $A = $a && $r;
my $B = $l && $b;
my @B = my @A = (r=> Fw, fill=>"darkRed"); # Fiber connections
my @C = (r=>1.5*Fw, fill=>"darkRed");
if ($C)
{$svg->line(x1=>$i+1/2, y1=>$j, x2=>$i+1/2, y2=>$j+1, @h);
$svg->line(x1=>$i+1/2, y1=>$j+1/2, x2=>$i+1, y2=>$j+1/2, @h);
$svg->circle(cx=>$i+1/2, cy=>$j+1/2, @C);
}
elsif ($D)
{$svg->line(x1=>$i, y1=>$j+1/2, x2=>$i+1, y2=>$j+1/2, @h);
$svg->line(x1=>$i+1/2, y1=>$j+1/2, x2=>$i+1/2, y2=>$j+1, @h);
$svg->circle(cx=>$i+1/2, cy=>$j+1/2, @C);
}
elsif ($A) # Draw corners
{$svg->line (x1=>$i+1/2, y1=>$j, x2=>$i+1, y2=>$j+1/2, @h);
$svg->circle(cx=>$i+1/2, cy=>$j, @A);
$svg->circle(cx=>$i+1, cy=>$j+1/2, @A);
}
elsif ($B)
{$svg->line (x1=>$i, y1=>$j+1/2, x2=>$i+1/2, y2=>$j+1, @h);
$svg->circle(cx=>$i, cy=>$j+1/2, @B);
$svg->circle(cx=>$i+1/2, cy=>$j+1, @B);
}
}
else # Straight
{$H[$i][$j] = $h; # Horizontal
$V[$i][$j] = $v; # Vertical
( run in 1.953 second using v1.01-cache-2.11-cpan-39bf76dae61 )