view release on metacpan or  search on metacpan

lib/Image/Bitmap2Paths.pm  view on Meta::CPAN

  for my $y (0..$#$edge) {	# Effectively, “move” the position of the joint along the spur in MFork/Tail pairs from MFork to Tail
    next unless $edge->[$y];	# But only when there are exactly 3 edges (at Tail vertex, which is the branching point)
    for my $x ( 0..$#{ $edge->[$y] } ) {
      next unless $edge->[$y][$x] and my $t = $tailEdge->{$x,$y};
      my($dir, $rot) = @$t[2,3];
      next unless 3 == $cntedge->[$y][$x];						# was: ¤
      my @d = map +($dir+$_)%8, ($rot == 1) + 3, 5 - ($rot == -1);
      for my $branch (0, 1) {
        my $D = $d[$branch];
        my $x1 = $x + $dx[$D];
        my $y1 = $y + $dy[$D];						# special-case transversal of 2 edges leading into the branch point
        $nextEdge[$y1][$x1][($D+4)%8] = ($d[1-$branch] - $D - 4)%8;	# would special-case transversal of the spur later
      }
    }
  }
  for my $y (0..$#$edge) {	# For every directed-edge, find the next directed-edge.  If none, mark the opposite as end-edge.
    next unless $edge->[$y];			# Except for spurs of the MFork (special-cased later).
    for my $x ( 0..$#{ $edge->[$y] } ) {
      next unless $edge->[$y][$x]; 
      for my $dir ( 0..$#{ $edge->[$y][$x] } ) {
        next unless $edge->[$y][$x][$dir];
        $edges{$x,$y,$dir} = [$x,$y,$dir];
        my $x1 = $x + $dx[$dir];
        my $y1 = $y + $dy[$dir];
        if ($cntedge->[$y1][$x1] == 2) {
          my @o;
          push @o, $_ for grep $edge->[$y1][$x1][$_], 0..7;
          my @oo = grep $_ != -4, map {($_- $dir + 4) % 8 - 4} @o;	# find the other edge (is not it easier to find the sum???)
#warn "found dirs [@o] at ($x,$y) --> $x1 $y1 $dir --> rot=$oo[0]\n";
          $nextEdge[$y][$x][$dir] = $oo[0];
        } elsif ($tailEdge->{$x,$y}) {	# MFork, Tail; don't include in the end/nextEdge, special-case later
#	      } elsif ($rays[$y][$x][$dir][0] =~ /^([MT])/) {	# MFork, Tail; don't include in the end/nextEdge, special-case later
        } elsif ($tailEdge->{$x1,$y1}) {	# Do not start at tail attachment; $nextEdge already set
        } else {
          push(@endEdge, [$x1,$y1,($dir+4)%8]);	# Do not try to drive through junctions
        }
      }
    }
  }
#warn "found endEdges: ", scalar @endEdge, "\n";
  my(@calc, %inCalcEdge);
  for my $edge (@endEdge) {		# Find non-closed strokes (those having end-edge)
    my($x,$y,$dir) = @$edge;
    next if $seenEndEdge{$x,$y,$dir}++;
# warn "endEdge: $x,$y, $dir, $cntedge->[$y][$x].\n";
    my $stroke = traverse_stroke($x,$y,$dir,\%seenEndEdge,\@nextEdge,\%traversedEdges, $tailEdge);	# made of [$dir,$x,$y,$x1,$y1]
    my $closed = $stroke->[0][1] == $stroke->[-1][3] && $stroke->[0][2] == $stroke->[-1][4];
    if ($closed) {
      $closed = -2;			# -2 means smooth, 2 means has a corner.  Presume smooth (but with a junction)
      for my $i (0..$#$stroke) {
        $closed = 2, last unless abs(($stroke->[$i][0] - $stroke->[$i-1][0] + 4)%8 - 4) < 2; # At i=0, wraps back to the end
      }
    }
#	  $closed &&= -2 if abs(($stroke->[0][1] - $stroke->[-1][1] + 4)%8 - 4) < 2;
    my($breaks, $runs) = [0];
    if ($closed < 0) {		# loop known to be smooth; stroke_2_strokes() won't find anything except ends
      $runs = [[0],[$#$stroke+1]];		# fake corners at ends; [0] means: start at 0, no calculated lines until the next
    } else {
      ($runs, $breaks) = stroke_2_strokes($stroke, \%inCalcEdge, $closed);	# Meaning: $runs->[$break] starts a new sub-stroke
    }
    push @strokes, [$closed, !'blob', $stroke, $runs, $breaks];	# (strokes with endpoints: “open”)
  }
# warn "found open strokes: ", scalar @strokes, "\n";
  my(@closedStrokes, %edgesDone);
  my @E;
  for my $E (sort keys %$tailEdge) {	# Best place to cut a closed stroke — if present.
    my $edge = $tailEdge->{$E};		# Need to normalize order, since bugs in fontforge are sensitive to the order
    my($x,$y,$dir,$rot) = @$edge;
    my $D = ($dir+4)%8;
    my $x1 = $x + $dx[$dir];
    my $y1 = $y + $dy[$dir];				# the encountered MForks are marked as already visited (by traverse_stroke())
    push @E, [$x1,$y1,$D,!!'tip',$x,$y,$E,$rot];	# start with MFork end of the tail
  }							#	 (those already encoutnered are ignored by traverse_stroke() anyway)
  push @E, map [@$_,0], @edges{sort keys %edges};
  for my $e (@E) {				# Handle closed strokes (without end-edge, need to loop through all edges)
    my($x,$y,$dir,$T,$x1,$y1,$E,$rot) = @$e;	#      (Need to normalize order, since bugs in fontforge are sensitive to the order)
    next if $traversedEdges{$x,$y,$dir};
    if ($T) {						# starting at MFork; need to redo the structure of “next” edges; we 
      $nextEdge[$y][$x][$dir] = ($rot == 1 ? 0 : 7);	# 	go clockwise (same direction as blobs), assuming the tip is outside
      my $x2 = $x1 + $dx[($dir+($rot != -1))%8];	# (x,y,d) is tip→joint=(x1,y1); we continue same-dir, or 45° counter-clockw
      my $y2 = $y1 + $dy[($dir+($rot != -1))%8];
      $nextEdge[$y2][$x2][($dir+($rot != -1)+4)%8] = (($rot == -1 ? 0 : 7));	# at end of the loop, return to the tip (DUP???)
      delete $tailEdge->{$E};
    }
    push @closedStrokes, traverse_stroke($x,$y,$dir,\%seenEndEdge,\@nextEdge,\%traversedEdges, $tailEdge, $T);	# of [$dir,$x,$y,$x1,$y1]
    push @{ $closedStrokes[-1] }, !'blob';
  }
  my(@nextEdgeBlob, @entryPointBlob);	# With lastedge, includes ends of lines:
  find_blobs($blob, $width, $height, $pixels, $cntedge, $offs, $lastedge, $skipExtraBlob);
  for my $y (1..$height) {
    my $inner = 0;
    for my $x ( 1..$width ) {
      next unless !$blob->[$y][$x] == $inner;
      my $blobX = $x - $inner;
      $inner = 1 - $inner;
      my $dir = $inner ? 0 : 4;			# $dir - 2 is a direction to exit the blob
      next if $nextEdgeBlob[$dir][$y][$blobX];	# already passed through
      if ($coarse_blobs) {
        push @entryPointBlob, [$blobX, $y, $dir];
        $entryPointBlob[-1][3] = traverse_boundary($blobX, $y, $dir, $blob, \@nextEdgeBlob);
      } else {
        push @closedStrokes, _traverse_boundary($blobX, $y, $dir, $blob, \@nextEdgeBlob);
        push @{ $closedStrokes[-1] }, !!'blob';
      }
    }
  }
  for my $stroke (@closedStrokes) {
    my $is_blob = pop @$stroke;
    push(@strokes, [undef, !!'blob', $stroke, undef, [0]]), next
      if @$stroke == 1 and not defined $stroke->[0][0];
    # Try to restart it on а corner (if present)
    my($i,$corner) = (-1, 2);
    while (++$i <= $#$stroke) {
      my($d,$prevd) = ($stroke->[$i][0], $stroke->[$i-1][0]);	# At i=0, wraps back to the end
      last if abs((($d-$prevd) % 8) - 4) <= 2;			# 135° angle is not a corner
    }
    $i = $corner = 0 if $i > $#$stroke;
    $stroke = [@$stroke[$i..$#$stroke, 0..($i-1)]] if $i;
    my($breaks, $runs) = [0];
    if ($corner == 0) {		# loop known to be smooth; stroke_2_strokes() won't find anything except ends
      $runs = [[0],[$#$stroke+1]];		# fake corners at ends; [0] means: start at 0, no calculated lines until the next