Autooooooooobox
Stevan Little [Sun, 18 Jun 2006 17:09:17 +0000 (17:09 +0000)]
Build.PL
Changes
TODO [new file with mode: 0644]
examples/tic_tac_toe.t [new file with mode: 0644]
lib/Moose/Autobox/Array.pm
lib/Moose/Autobox/Code.pm
lib/Moose/Autobox/Ref.pm

index 7d0b930..2b699cb 100644 (file)
--- a/Build.PL
+++ b/Build.PL
@@ -6,8 +6,9 @@ my $build = Module::Build->new(
     module_name => 'Moose::Autobox',
     license => 'perl',
     requires => {
-        'autobox' => '1.03',
-        'Moose'   => '0.09_02',
+        'autobox'         => '1.03',
+        'Moose'           => '0.09_02',
+        'Perl6::Junction' => '1.10',
     },
     optional => {
     },
diff --git a/Changes b/Changes
index c3faf70..a559105 100644 (file)
--- a/Changes
+++ b/Changes
@@ -3,6 +3,13 @@ Revision history for Perl extension Moose::Autobox
 0.02 
     - fixed Moose::Autobox so that PAUSE won't try to 
       index SCALAR, ARRAY, HASH and CODE.
+    
+    * Moose::Autobox::Ref
+      - added &dump method which will use Data::Dumper
+        to return a dumped representation of the ref
+      
+    * Moose::Autobox::Array
+      - added Junctions support with Perl6::Junction
 
 0.01 Fri. June 9, 2006
     - Autoboxing, all the cool kids are doing it ;)
diff --git a/TODO b/TODO
new file mode 100644 (file)
index 0000000..aacfb19
--- /dev/null
+++ b/TODO
@@ -0,0 +1,3 @@
+Add create() to Moose::Meta::Class to allow for roles to be passed in.
+
+Change Moose::Autobox->import() to use that instead of an eval.
\ No newline at end of file
diff --git a/examples/tic_tac_toe.t b/examples/tic_tac_toe.t
new file mode 100644 (file)
index 0000000..18de440
--- /dev/null
@@ -0,0 +1,108 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Moose::Autobox;
+use Moose::Autobox::Undef;
+
+use autobox UNDEF => 'Moose::Autobox::Undef';
+
+sub ARRAY::print_board {
+    my ($b) = @_;
+    my $count = 0;
+    $b->map(sub {
+        print("$_ \t");
+        print("\n") unless ((++$count) % 3);
+    });
+}
+
+my $g = [ ('.') x 9 ];
+
+$g->print_board();
+
+my $players = { 'X' => 'Player 1', 'O' => 'Player 2' };
+
+my $player_character = [ 'X', 'O' ]->any;
+
+my $entered = {};
+my $choice = [ 1 .. 9 ]->any;
+
+my $player = 'X';
+while ($g->all == '.') {
+    
+    INPUT: {
+        print($players->{$player} . " Enter the Position [1-9]: ");
+        my $in = <>;
+
+        unless ($in == $choice) {
+            print "\n\tPlease enter a value within 1-9\n\n";  
+            redo INPUT;  
+        }
+
+        my $idx = $in - 1;
+        if ($entered->exists($idx)) {
+            print "\n\tElement already entered at $in\n";
+            redo INPUT;
+        }
+
+        $g->[$idx] = $player;
+        $entered->{$idx}++;
+    }
+
+    $g->print_board;
+    
+    [
+        [ 0, 1, 2 ], [ 3, 4, 5 ], [ 6, 7, 8 ],
+        [ 0, 3, 6 ], [ 1, 4, 7 ], [ 2, 5, 8 ],
+        [ 0, 4, 8 ], [ 2, 4, 6 ],
+    ]->map(sub {
+        
+        #my @row = @{$g}[$_->[0], $_->[1], $_->[2]];
+        #my $row = \@row;
+        #warn $row->dump;
+        # FIX ME
+        #(($row->all == 'X') || ($row->all == 'O'))&& warn "Wow, this worked";
+        
+        if ( ( $players->exists($g->[$_->[0]]) &&
+               $players->exists($g->[$_->[1]]) &&
+               $players->exists($g->[$_->[2]]) ) 
+             &&
+             ( ( $g->[$_->[0]] eq $g->[$_->[1]] ) && 
+               ( $g->[$_->[1]] eq $g->[$_->[2]] ) ) ) 
+        {
+            print("\n\t$players->{$player} Wins\n");
+            exit;
+        }
+    });
+
+    $player = $player eq 'X' ? 'O' : 'X';
+}
+
+
+=pod
+
+=head1 NAME
+
+tic_tac_toe.p6 - Tic-Tac-Toe
+
+=head1 DESCRIPTION
+
+This is a Moose::Autobox port of a perl6 implementation 
+of the classic Tic-Tac-Toe game.
+
+This uses a modified version of the one Rob Kinyon created
+L<http://www.perlmonks.org/index.pl?node_id=451302>. 
+
+=head1 AUTHORS
+
+mkirank L<http://www.perlmonks.org/index.pl?node_id=451261>
+
+Rob Kinyon L<http://www.perlmonks.org/index.pl?node_id=451302>
+
+Stevan Little, E<lt>stevan@iinteractive.comE<gt>
+
+Audrey Tang
+
+=cut
+
index 97ac19a..004e74e 100644 (file)
@@ -1,5 +1,6 @@
 package Moose::Autobox::Array;
 use Moose::Role 'with';
+use Perl6::Junction;
 use autobox;
 
 our $VERSION = '0.01';
@@ -111,6 +112,28 @@ sub kv {
     $array->keys->map(sub { [ $_, $array->[$_] ] });
 }
 
+## Junctions
+
+sub all {
+    my ($array) = @_;     
+    return Perl6::Junction::All->all(@$array);
+}
+
+sub any {
+    my ($array) = @_;     
+    return Perl6::Junction::Any->any(@$array);
+}
+
+sub none {
+    my ($array) = @_;     
+    return Perl6::Junction::None->none(@$array);
+}
+
+sub one {
+    my ($array) = @_; 
+    return Perl6::Junction::One->one(@$array);
+}
+
 1;
 
 __END__
@@ -196,6 +219,20 @@ This is a role to describe operations on the Array type.
 
 =back
 
+=head2 Junctions
+
+=over 4
+
+=item B<all>
+
+=item B<any>
+
+=item B<none>
+
+=item B<one>
+
+=back
+
 =over 4
 
 =item B<meta>
index 5101466..8902d72 100644 (file)
@@ -32,6 +32,12 @@ sub conjoin {
        return sub { $f->(@_) && $f2->(@_) }    
 }
 
+#sub dump {
+    #my ($self) = @_;
+    #require Data::Dump::Streamer;
+    #return Data::Dump::Streamer::Dump($self)->Out();
+#}
+
 1;
 
 __END__
index a524612..78ae17d 100644 (file)
@@ -5,6 +5,12 @@ our $VERSION = '0.01';
 
 with 'Moose::Autobox::Defined';
 
+sub dump {
+    my $self = shift;
+    require Data::Dumper;
+    return Data::Dumper::Dumper($self);
+}
+
 1;
 
 __END__
@@ -25,6 +31,8 @@ This is a role to describes a reference value.
 
 =item B<meta>
 
+=item B<dump>
+
 =back
 
 =head1 BUGS