Early OO self-taught using Petals Around the Rose

This is some code I wrote a Loooooong time ago. Ok, not so long ago that it was in the age when Larry First Spake The Word. By a long time ago, I mean a qualitative long time ago along my trail of learning Perl. This was so long ago that I hadn't learnt yet to use strict, much less received BrowserUK's lesson on use warnings. I post as-is, no warranty without corrections. The point of sharing is to show the kind of fun project that motivates me to hack around with Perl.

The thing I was fascinated by was the game "Petals Around the Rose". Here's a link to a funny story about the game: Lloyd Borrett - Computing - Petals - Bill Gates plays Petals Around the Rose.

This is one of those games where those in the know show the game to those not in the know, and the game is to figure out what's going on. If you're not in the know on this game, I recommend you either read the link, above, or just download it and run it without deconstructing the code too much until you are in the know. It's kind of a fun game.

One of the things I was trying to teach myself was Getopt::Long. There's nothing exciting here, in fact it's not even good.

The other thing I was trying to teach myself was OO programming in Perl. To that end I've implepmented it once with simple procedural code and once as an OO program.

Here's the procedural version. I actually tried this and the usage shows with /?, -help, --h, etc. If you're not in the know, start here with usage and play the game 'til you get it.

# implements the game Petals Around the Rose
# no arguments will roll 5 six sided die and report the score
# help will report the three things that a human is allowed to tell a 
+human player:
#     1) The name of the game is Petals Around the Rose. 
#     2) The name of the game is important. 
#     3) The score will always be zero or an even number. 
#     and report that the goal is to work out how to calculate the sco
+re 


use Getopt::Long;
my @args;
@args = [@ARGV];
Getopt::Long::Configure("prefix_pattern=--|-|\/");
my $opt_help='';
GetOptions('help|?'=>\$opt_help);
usage() if $opt_help;

=begin comment

#example command parsing 

Getopt::Long::Configure("prefix_pattern=\/|-|--");
my $opt_chas='';
my $opt_help='';

GetOptions('chas'=>\$opt_chas, 'help|?'=>\$opt_help);

print "chaswashere\n" if $opt_chas;
usage() if $opt_help;

=end comment

=cut

#print "hello, world\n";
my $i;
my $roll;
my @aDie;
my @Dice;
my $answer;
$answer = 0;
for $i (1..5) {
    $roll= int(rand(6))+1;
    $answer += $roll -1 if int($roll / 2) != ($roll / 2);
    $aDie = getDie($roll);
    #print @aDie;
    #for $linenum ( 0..$#{$aDie} ){print ${$aDie}[$linenum],"\n";};
    for $linenum ( 0..$#{$aDie} ){$Dice[$linenum][++$#{$Dice[$linenum]
+}] = ${$aDie}[$linenum]; };
    
}

my $line;
$line="";
my $DieNum;
for $linenum ( 0..$#Dice ){ 
    for $DieNum (0..$#{$Dice[$linenum]}) {
        $line .= $Dice[$linenum][$DieNum];
    }
    print $line,"\n";
    $line="";
}

print "\nThe score is ",$answer,"\n";
#exit $answer;

sub getDie {
my $retrefval;
$dicenum = shift(@_);
@dice[1..6]=(
           ["/---\\",
            "|   |",
            "| * |",
            "|   |",
           "\\---/"],

           ["/---\\",
            "|  *|",
            "|   |",
            "|*  |",
           "\\---/"],
           ["/---\\",
           
            "|  *|",
            "| * |",
            "|*  |",
           "\\---/"],
           
           ["/---\\",
            "|* *|",
            "|   |",
            "|* *|",
           "\\---/"],
           
           ["/---\\",
            "|* *|",
            "| * |",
            "|* *|",
           "\\---/"],
           
           ["/---\\",
            "|* *|",
            "|* *|",
            "|* *|",
           "\\---/"]
        );
#for $linenum ( 0..$#{$dice[$dicenum]} ){print $dice[$dicenum][$linenu
+m],"\n";};
$retrefval = $dice[$dicenum];
# print "there are ", $#{$retrefval}, " elements in the return array\n
+";
# for $linenum ( 0..$#{$retrefval} ){print ${$retrefval}[$linenum],"\n
+";};
# print ${$retrefval}[0],"\n",${$retrefval}[1],"\n",${$retrefval}[2],"
+\n",${$retrefval}[3],"\n",${$retrefval}[4],"\n";
return $retrefval;
#print $dice[1][0],"\n",$dice[1][1],"\n",$dice[1][2],"\n",$dice[1][3],
+"\n",$dice[1][4],"\n";
}

sub usage {
print "\nUsage: \n";
print "\t",$0," [/?]\n\n";
print <<ENDUSAGE

This usage text can be got with the argument \"?\" and can be
indicated as a swith only with \"/\".  
    
With no arguments, you just play the game.  I can only tell you 3 thin
+gs:    
    1) The name of the game is Petals Around the Rose. 
    2) The name of the game is important. 
    3) The score will always be zero or an even number. 
    
The goal is to work out how to calculate the score.    

Here's your first try:
ENDUSAGE
}
[download]

Next comes the OO stuff. This is A_Die.pm. In part I was trying to create something that separates presentation from logic. To that end, it supports both a toString and a toTextArt method. On my todo list (still) was to add a toGIF method or something to make it "prettier", but that wasn't my priority.

package A_Die;


sub new{
    my $class = shift;
    my $self = {};
    $self->{VALUE} = int(rand(5)) + 1;
    $self->{NUM_ROLLS} = 1;
    $self->{HISTORY} = [];
    bless ($self, $class);
    return $self;
}


sub value {
    my $self = shift;
    return $self->{VALUE};
 
}
sub num_rolls {
    my $self = shift;
    return $self->{NUM_ROLLS};
 
}
sub history {
    my $self = shift;
    return @{ $self->{HISTORY} };
}

sub roll {
    my $self = shift;
    $self->{HISTORY}[$self->num_rolls - 1] = $self->value;
    $self->{VALUE} = int(rand(5)) + 1;
    $self->{NUM_ROLLS}++;
}

sub info {
    my $self = shift;
    return sprintf("current value: %s, num_rolls: %d, history: %s",
                                     $self->value,
                                                    $self->num_rolls,
                                                                 join(
+" ",$self->history)
                  )
}

sub toString{
    my $self = shift;
    my $strings;
    $strings = {
        "1" => "one",
        "2" => "two",
        "3" => "three",
        "4" => "four",
        "5" => "five",
        "6" => "six",
    };
    return $$strings{$self->value};
}

sub toTextArt{
    my $self = shift;
    my $art;
    my $i;
    @dieFaces[1..6]=(
           ["/---\\",
            "|   |",
            "| * |",
            "|   |",
           "\\---/"],

           ["/---\\",
            "|  *|",
            "|   |",
            "|*  |",
           "\\---/"],
           
           ["/---\\",
            "|  *|",
            "| * |",
            "|*  |",
           "\\---/"],
           
           ["/---\\",
            "|* *|",
            "|   |",
            "|* *|",
           "\\---/"],
           
           ["/---\\",
            "|* *|",
            "| * |",
            "|* *|",
           "\\---/"],
           
           ["/---\\",
            "|* *|",
            "|* *|",
            "|* *|",
           "\\---/"]
        );
    for $i (0..$#{$dieFaces[$self->value]}) {
        $art = $art . $dieFaces[$self->value][$i] . "\n";
    }
    return $art
}

1;
[download]

As a bonus, here's a dumb test harness for A_Die:


#######################
# testing single die
#######################

use A_Die;

my $a_die;

$a_die = A_Die->new();
printf " Die value is: %s\n", $a_die->value;
printf " Die num_rolls is: %s\n", $a_die->num_rolls;
printf " Die history is: %s\n", $a_die->history;
print $a_die->info . "\n";
print $a_die->toString . "\n";
print $a_die->toTextArt . "\n";
for $i (0..3) {
    $a_die->roll();
    print $a_die->info . "\n";
    print $a_die->toString . "\n";
    print $a_die->toTextArt . "\n";
    
}

#######################
# testing group of dice
#######################

use Dice;

my $some_dice;

$some_dice = Dice->new();
printf "Dice num_dice is: %s\n", $some_dice->num_dice;
$some_dice->show_dice();

for $i (0..3) {
    $some_dice->add_die();
    printf "Dice num_dice is: %s\n", $some_dice->num_dice;
    $some_dice->show_dice();
}

print $some_dice->toTextArt() . "\n";
print "that's: " . $some_dice->toString() . "\n";

for $i (1..3) {
    $some_dice->roll_all();
    $some_dice->show_dice();
    print $some_dice->toTextArt() . "\n";
    print "that's: " . $some_dice->toString() . "\n";
}

print "Rolling only dice 2 and 4\n";
${$some_dice->dice}[1]->roll(); # zero offset
${$some_dice->dice}[3]->roll(); # zero offset
$some_dice->show_dice();
print $some_dice->toTextArt() . "\n";
print "that's: " . $some_dice->toString() . "\n";

print "\nremoving die from middle and end\n";
for $i (1..2) {
    print "removing die $i\n";
    print $some_dice->rem_die(${$some_dice->dice}[1]) . "\n";
    $some_dice->show_dice();
    print $some_dice->toTextArt() . "\n";
    print "that's: " . $some_dice->toString() . "\n";
}

print "\nremoving die from begining and removing last die\n";
for $i (1..2) {
    print "removing die $i\n";
    print $some_dice->rem_die(${$some_dice->dice}[0]) . "\n";
    $some_dice->show_dice();
    print $some_dice->toTextArt() . "\n";
    print "that's: " . $some_dice->toString() . "\n";
}
[download]

This is Dice.pm. It's a collection of A_Die objects and wrapper functions:


package Dice;

use A_Die;

my $debug = 0;

sub new{
    my $class = shift;
    my $self = {};
    $self->{NUM_DICE} = 0;
    $self->{DICE} = [];
    bless ($self, $class);
    return $self;
}

sub num_dice {
    my $self = shift;
    return $self->{NUM_DICE};
 
}
sub dice {
    my $self = shift;
    return ( $self->{DICE} );
}

sub add_die {
    my $self = shift;
    my $die = A_Die->new();
    ${$self->dice}[$#{$self->dice} + 1] = $die;
    $self->{NUM_DICE}++;
    print "new die added: " . $die->info() . "\n" if $debug;
    return $die;
}

sub show_dice {
    my $self = shift;
    my $i;
    print "No dice\n" unless @{$self->dice};
    for $i (0..$#{$self->dice}) {
        print ${$self->dice}[$i]->info() . "\n";
    }
}

sub rem_die {
    my $self = shift;
    return -1 if @_ != 1; # should be oaoo arg
    my $arg = shift;
    my $die;
    my $i;
    for ($i=0;$i<=$#{$self->dice};$i++) {
        last if $arg == ${$self->dice}[$i];
    } #assert: $i is the index of the array where die referenced by $a
+rg is located or is 1 greater than $#dice
    $die = splice(@{$self->dice},$i,1); #should remove that element an
+d return it
    $self->{NUM_DICE}--;
    if ($debug) {
        print ($die == $arg ? "die removed: \$die = $die\n" : "failed 
+to remove die: \$arg = $arg\n");
    }
    $die == $arg ? return $die : return -1;
}

sub roll_all {
    my $self = shift;
    for $i (0..$#{$self->dice}) {
        ${$self->dice}[$i]->roll();
    }
}

sub toString{
    my $self = shift;
    my $i;
    my $retstring;
    if (@{$self->dice} == 0) { 
        $retstring = "No dice\n" 
    } else {
        for $i (0..$#{$self->dice}) {
            $retstring = $retstring . ${$self->dice}[$i]->toString();
            $retstring = $retstring. " " unless $i == $#{$self->dice};
        }
    }
    return $retstring;
}

sub toTextArt{
    my $self = shift;
    my $art;
    my $textrow;
    my $NUM_ROWS = 5;
    @dieFaces[1..6]=(
           ["/---\\",
            "|   |",
            "| * |",
            "|   |",
           "\\---/"],

           ["/---\\",
            "|  *|",
            "|   |",
            "|*  |",
           "\\---/"],
           
           ["/---\\",
            "|  *|",
            "| * |",
            "|*  |",
           "\\---/"],
           
           ["/---\\",
            "|* *|",
            "|   |",
            "|* *|",
           "\\---/"],
           
           ["/---\\",
            "|* *|",
            "| * |",
            "|* *|",
           "\\---/"],
           
           ["/---\\",
            "|* *|",
            "|* *|",
            "|* *|",
           "\\---/"]
        );
    if (@{$self->dice} == 0) { 
        $art = "/---\\\n" . 
               "|   |\n" . 
               "|   |\n" . 
               "|   |\n" . 
              "\\---/\n"; 
    } else {
        for $textrow (0..$NUM_ROWS) {
            for $die (0..$#{$self->dice}) {        
                    $art = $art . $dieFaces[${$self->dice}[$die]->valu
+e][$textrow];
            }
            $art = $art . "\n";
        }
    }
    return $art
}

1;
[download]

And now, the much cleaner, oo-ier patr_obj.pl:

# implements the game Petals Around the Rose
# no arguments will roll 5 six sided die and report the score
# help will report the three things that a human is allowed to tell a 
+human player:
#     1) The name of the game is Petals Around the Rose. 
#     2) The name of the game is important. 
#     3) The score will always be zero or an even number. 
#     and report that the goal is to work out how to calculate the sco
+re 


use Getopt::Long;
use A_Die;
use Dice;


my @args;
@args = [@ARGV];
Getopt::Long::Configure("prefix_pattern=--|-|\/");
my $opt_help='';
GetOptions('help|?'=>\$opt_help);
usage() if $opt_help;


my $i;
my $dice;
my $die;
my $answer;
$dice = Dice->new();
$answer = 0;
for $i (1..5) {
    $die = $dice->add_die();
    $roll = $die->value;
    $answer += $roll -1 if int($roll / 2) != ($roll / 2);
}

print $dice->toTextArt();

print "\nThe score is ",$answer,"\n";


sub usage {
print "\nUsage: \n";
print "\t",$0," [/?]\n\n";
print <<ENDUSAGE

This usage text can be got with the argument \"?\" and can be
indicated as a swith only with \"/\".  
    
With no arguments, you just play the game.  I can only tell you 3 thin
+gs:    
    1) The name of the game is Petals Around the Rose. 
    2) The name of the game is important. 
    3) The score will always be zero or an even number. 
    
The goal is to work out how to calculate the score.    

Here's your first try:
ENDUSAGE
}
[download]

Enjoy! The point of this was to have fun and learn something. I did both. I hope you do too, but as to the learning I hope you learn the good and filter my bads. Caveat emptor.

I humbly seek wisdom.

Comment on Early OO self-taught using Petals Around the Rose Select or Download Code


Just another Perl shrine
	PerlMonks