Skip to content

Instantly share code, notes, and snippets.

@jgamble
Created April 17, 2018 01:37
Show Gist options
  • Select an option

  • Save jgamble/b28e3b7d49eb16d8fb1278d7c623f9ef to your computer and use it in GitHub Desktop.

Select an option

Save jgamble/b28e3b7d49eb16d8fb1278d7c623f9ef to your computer and use it in GitHub Desktop.
Create a list of bits according to the cyclic pattern you provide. The list may then be used as-is, joined to form a string, or packed into an integer.
#
# @bits = bitpattern($pattern, $length, $offset);
#
# Create a list of bits in a cyclic pattern.
#
# $pattern is an array reference containing the on (ones) and
# off (zeros) sequence of the pattern.
#
# $length is the length of the bitpattern to return.
#
# $offset is optional and defaults to zero. It is the
# distance into the pattern the sequence begins, found
# by adding up the elements of $pattern until $offset
# is reached. $offset may be negative.
#
# join("", bitpattern([], 16)); # "1111111111111111"
# join("", bitpattern([3], 16)); # "1110001110001110"
# join("", bitpattern([2,1], 16)); # "1101101101101101"
# join("", bitpattern([1,2,4], 16)); # "1001111011000010"
#
# join("", bitpattern([2], 16, 1)); # "1001100110011001"
# join("", bitpattern([3,5], 16, 6)); # "0011100000111000"
# join("", bitpattern([2,3], 16, 11)); # "1000110001100011"
#
# join("", bitpattern([2], 16, -1)); # "0110011001100110"
# join("", bitpattern([3,5], 16, -6)); # "1000001110000011"
# join("", bitpattern([2,3], 16, -11)); # "0110001100011000"
#
# This function is derived from the setdash operator
# in Adobe's Postscript language.
#
sub bitpattern
{
my($pattern, $length, $offset) = @_;
return (1) x $length if (!defined $pattern or @$pattern == 0);
my @cycle = map(int(abs($_)), @$pattern);
my($period) = 0;
map ($period += $_, @cycle);
return (1) x $length if ($period == 0);
#
# Get the offset within the period, taking into
# account machine-neutral handling of remainder
# operator with negative offsets, and that a
# period of one doesn't remainder well.
#
$offset //=0;
if ($period == 1)
{
$offset = abs($offset) % 2;
}
elsif ($offset < 0)
{
$offset = $period - (-$offset % $period);
}
elsif ($offset > 0)
{
$offset %= $period;
}
my($idx, $bit) = (0, 1);
my @bitpattern;
#
# Find how far into the cycle the offset puts us.
#
while ($cycle[$idx] < $offset)
{
$offset -= $cycle[$idx++];
$bit ^= 1;
}
if ($offset > 0)
{
@bitpattern = ($bit) x ($cycle[$idx++] - $offset);
$bit ^= 1;
}
while (@bitpattern < $length)
{
$idx = 0 if ($idx == @cycle);
push @bitpattern, ($bit) x $cycle[$idx++];
$bit ^= 1;
}
$#bitpattern = $length - 1;
return @bitpattern;
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment