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";
};
Replies are listed 'Best First'.
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.
Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://585361]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (6)
As of 2016-12-10 19:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    On a regular basis, I'm most likely to spy upon:













    Results (164 votes). Check out past polls.