Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

building sequences like an odometer

by neniro (Priest)
on Nov 21, 2006 at 21:36 UTC ( #585361=snippet: print w/ replies, xml ) Need Help??

Description: This is some example code I wrote a few days ago. It's based on a odometer-class and a wheel-class. Maybe it's useful to someone. EDIT: the class-variable $DONE in the odometer-class is a bad idea and should be changed to an instance-variable.
#!/usr/bin/perl

use strict;
use warnings;

package Wheel;

sub new {
    my $class = shift;
    my @items = @_;
    my $self = {
        items       => \@items,
        position    => 0,
        notch       => [],
    };
    bless $self, $class;
    return $self;
}

sub on_notch {
    my $self = shift;
    my $call = shift || sub { print "Notch!\n" };
    push @{$self->{notch}}, $call;
}

sub succ {
    my $self = shift;
    if ($self->{position}++ < $#{$self->{items}}) {
        $self->{position} and return $self->{items}->[$self->{position
+}];
    } else {
        $self->{position} = 0;
        $_->() for @{$self->{notch}};
        return $self->{items}->[$self->{position}];
    }
    
}

sub to_s {
    my $self = shift;
    return $self->{items}->[$self->{position}];
}

package Odometer;
use Data::Dumper;

my $DONE = 0;

sub new {
    my $class = shift;
    my $self = [];
    return bless $self, $class;
}

sub add_wheel {
    my $self = shift;
    my @items = @_;
    my $w = Wheel->new(@items);
    push @$self, $w;
    $self->[$#$self-1]->on_notch(sub {$w->succ}) if $#$self > 0;
}

sub succ {
    my $self = shift;
    my $temp = $self->to_s;
    $self->[0]->succ;
    
    if ($DONE == 2) {
        return undef;
    } else {
        $DONE++ if $DONE;
        return $temp;
    }
}

sub to_s {
    my $self = shift;
    return join ' ', map { $_->to_s } reverse @$self;
}

sub add_termination {
    my $self = shift;
    $self->[-1]->on_notch( sub { $DONE = 1} );
}

package main;

my $o = Odometer->new;
$o->add_wheel(qw/foo bar buz/);
$o->add_wheel(qw/dark light/);
$o->add_wheel(qw/red green blue yellow/);
$o->add_termination;
while (my $cur = $o->succ) {
    print $cur . "\n";
};
Comment on building sequences like an odometer
Download Code
Re: building sequences like an odometer
by Roy Johnson (Monsignor) on Nov 21, 2006 at 23:59 UTC
      Thank you. This is another CPAN-module I've missed so far.

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://585361]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (3)
As of 2014-10-21 01:39 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (95 votes), past polls