examples/tic_tac_toe.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Moose::Autobox;
   7 use Moose::Autobox::Undef;
   8
   9 use autobox UNDEF => 'Moose::Autobox::Undef';
  10
  11 sub print_board {
  12     my ($b) = @_;
  13     my $count = 0;
  14     $b->map(sub {
  15         print("$_ \t");
  16         print("\n") unless ((++$count) % 3);
  17     });
  18 }
  19
  20 my $board = [ ('.') x 9 ];
  21
  22 print_board($board);
  23
  24 my $choice = [ 1 .. 9 ]->any;
  25
  26 my $player = 'X';
  27 while ($board->any eq '.') {
  28
  29     INPUT: {
  30         print("Player ($player), enter the Position [1-9]: ");
  31         my $in = <>;
  32
  33         unless ($in == $choice) {
  34             print "\n\tPlease enter a value within 1-9\n\n";
  35             redo INPUT;
  36         }
  37
  38         my $idx = $in - 1;
  39         if ($board->[$idx] ne '.') {
  40             print "\n\tElement already entered at $in\n";
  41             redo INPUT;
  42         }
  43
  44         $board->[$idx] = $player;
  45     }
  46
  47     print_board($board);
  48
  49     [
  50         [ 0, 1, 2 ], [ 3, 4, 5 ], [ 6, 7, 8 ],
  51         [ 0, 3, 6 ], [ 1, 4, 7 ], [ 2, 5, 8 ],
  52         [ 0, 4, 8 ], [ 2, 4, 6 ],
  53     ]->map(sub {
  54
  55         my $row = $board->slice($_);
  56
  57         if (($row->all eq 'X') || ($row->all eq 'O')) {
  58             print("\n\tPlayer ($player) Wins\n");
  59             exit;
  60         }
  61
  62     });
  63
  64     $player = $player eq 'X' ? 'O' : 'X';
  65 }
  66
  67
  68 =pod
  69
  70 =head1 NAME
  71
  72 tic_tac_toe.p6 - Tic-Tac-Toe
  73
  74 =head1 DESCRIPTION
  75
  76 This is a Moose::Autobox port of a perl6 implementation
  77 of the classic Tic-Tac-Toe game.
  78
  79 This uses a modified version of the one Rob Kinyon created
  80 L<http://www.perlmonks.org/index.pl?node_id=451302>.
  81
  82 =head1 AUTHOR
  83
  84 Stevan Little, E<lt>stevan@iinteractive.comE<gt>
  85
  86 =head1 ACKNOLEDGEMENTS
  87
  88 This code was ported from the version in the Pugs examples/
  89 directory. The authors of that were:
  90
  91 mkirank L<http://www.perlmonks.org/index.pl?node_id=451261>
  92
  93 Rob Kinyon L<http://www.perlmonks.org/index.pl?node_id=451302>
  94
  95 Stevan Little, E<lt>stevan@iinteractive.comE<gt>
  96
  97 Audrey Tang
  98
  99 =cut
 100