Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

upgraded Pod to next-gen S26

...essentially this means changing a lot of Pod comments to the '#=[]' form.
Also updated a few cases of stale Pod.
  • Loading branch information...
commit 79bc10ab288e41c5223eaae0a0931d2a0b8c918d 1 parent 0da8964
Carl Mäsak authored August 18, 2009
17  lib/Druid/Base.pm
... ...
@@ -1,21 +1,18 @@
  1
+#= Base class collecting ambient regexes, attributes and methods.
1 2
 class Druid::Base;
2 3
 
3  
-=begin SUMMARY
4  
-C<Druid::Base> is the base class of most other Druid classes, collecting
5  
-regexes, attributes and methods which most of these other classes need.
6  
-=end SUMMARY
7  
-
8 4
 # RAKUDO: Cannot use dashes here. [perl #64464]
9 5
 regex col_letter { <[a..z]> }
10 6
 regex row_number { \d+ }
11 7
 regex coords { <col_letter><row_number> }
12 8
 
13  
-our $.sarsen-move = /^ <coords> $/;
14  
-our $.lintel-move = /^ <coords> '-' <coords> $/;
15  
-our $.pass   = /^ ['pass'   | 'p'] $/;
16  
-our $.swap   = /^ ['swap'   | 's'] $/;
17  
-our $.resign = /^ ['resign' | 'r'] $/;
  9
+our $.sarsen-move = /^ <coords> $/;              #= A sarsen (length 1) move
  10
+our $.lintel-move = /^ <coords> '-' <coords> $/; #= A lintel (length 3) move
  11
+our $.pass   = /^ ['pass'   | 'p'] $/;           #= A passing (no-op) move
  12
+our $.swap   = /^ ['swap'   | 's'] $/;           #= A swap move
  13
+our $.resign = /^ ['resign' | 'r'] $/;           #= A forfeit
18 14
 
  15
+#= Returns (zero-based) row and column, given a C<Match> object
19 16
 method extract-coords(Match $m) {
20 17
     # RAKUDO: Hoping these explicit int(...) conversions won't be
21 18
     #         necessary in the long run.
61  lib/Druid/Game.pm
@@ -3,10 +3,7 @@ use v6;
3 3
 use Druid::Base;
4 4
 use Druid::Game::Subject;
5 5
 
6  
-class Druid::Game is Druid::Base does Druid::Game::Subject;
7  
-
8  
-=begin SUMMARY
9  
-An instance of C<Druid::Game> holds an ongoing (or finished) Druid game.
  6
+#=[An instance of C<Druid::Game> holds an ongoing (or finished) Druid game.
10 7
 It keeps track of the contents of the board, whose turn it is, the number
11 8
 of moves made, and whether the game is over. The methods in this class
12 9
 are created so as to disallow all illegal moves (or other actions) on the
@@ -15,22 +12,22 @@ always in a permitted states, according to the rules of Druid.
15 12
 
16 13
 The class does the role C<Druid::Game::Subject>, making it possible for
17 14
 instances of other classes to subscribe to updates from instances of this
18  
-class, in an B<observer> pattern.
19  
-=end SUMMARY
  15
+class, in an B<observer> pattern.]
  16
+class Druid::Game is Druid::Base does Druid::Game::Subject;
20 17
 
21  
-=attr The size of a side of the (always quadratic) board.
  18
+#=[ The size of a side of the (always quadratic) board. ]
22 19
 has $.size;
23  
-=attr An array of layers, each a C<$.size * $.size> AoA with color info.
  20
+#=[ An array of layers, each a C<$.size * $.size> AoA with color info. ]
24 21
 has @.layers;
25  
-=attr A C<$.size * $.size> AoA with height info.
  22
+#=[ A C<$.size * $.size> AoA with height info. ]
26 23
 has @.heights;
27  
-=attr A C<$.size * $.size> AoA with color info.
  24
+#=[ A C<$.size * $.size> AoA with color info. ]
28 25
 has @.colors;
29  
-=attr An integer (either 1 or 2) denoting whose turn it is to move.
  26
+#=[ An integer (either 1 or 2) denoting whose turn it is to move. ]
30 27
 has $.player-to-move;
31  
-=attr The number of moves made so far in the game, including swapping.
  28
+#=[ The number of moves made so far in the game, including swapping. ]
32 29
 has $.moves-so-far;
33  
-=attr Whether the game has already ended.
  30
+#=[ Whether the game has already ended. ]
34 31
 has $.finished;
35 32
 
36 33
 has $!latest-move;
@@ -46,11 +43,9 @@ submethod BUILD(:$size = 3) {
46 43
     $!size = $size;
47 44
 }
48 45
 
49  
-=begin METHOD
50  
-Reports C<False> if the move is permissible in the given state of the game,
51  
-or a C<Str> explaining why if it isn't. (Thus 'bad' here means
52  
-'impermissible', but 'bad' is less to write.)
53  
-=end METHOD
  46
+#=[Reports C<False> if the move is permissible in the given state of
  47
+the game, or a C<Str> explaining why if it isn't. (Thus 'bad' here means
  48
+'impermissible', but 'bad' is less to write.)]
54 49
 method is-move-bad(Str $move) {
55 50
     my $color = $!player-to-move;
56 51
 
@@ -92,11 +87,9 @@ something like "b2" or something like "c1-c3" You can also "pass" or
92 87
     return False; # move is OK
93 88
 }
94 89
 
95  
-=begin METHOD
96  
-Returns, for given C<$row>, C<$column>, and C<$color>, the reason why
  90
+#=[Returns, for given C<$row>, C<$column>, and C<$color>, the reason why
97 91
 a sarsen (a one-block piece) of that color cannot be placed on that location,
98  
-or C<False> if the placing of the sarsen is permissible.
99  
-=end METHOD
  92
+or C<False> if the placing of the sarsen is permissible.]
100 93
 method is-sarsen-move-bad(Int $row, Int $column, Int $color) {
101 94
     return "The rightmost column is '{chr(ord('A')+$.size-1)}'"
102 95
         if $column >= $.size;
@@ -111,16 +104,14 @@ method is-sarsen-move-bad(Int $row, Int $column, Int $color) {
111 104
     return False; # The move is fine.
112 105
 }
113 106
 
114  
-=begin METHOD
115  
-Returns, for a given C<$row_1>, C<$row_2>, C<$column_1>, C<$column_2>, and
  107
+#=[Returns, for a given C<$row_1>, C<$row_2>, C<$column_1>, C<$column_2>, and
116 108
 C<$color>, the reason why a lintel (a three-block piece) of that color cannot
117 109
 be placed bridging these locations, or C<False> if the placing of the lintel
118 110
 is permissible.
119 111
 
120 112
 There are no preconditions on the coordinate parameters to be exactly two
121 113
 rows or two columns apart; instead, these conditions are also tested in this
122  
-method.
123  
-=end METHOD
  114
+method.]
124 115
 method is-lintel-move-bad(Int $row_1, Int $row_2,
125 116
                           Int $column_1, Int $column_2,
126 117
                           Int $color) {
@@ -164,10 +155,8 @@ method is-lintel-move-bad(Int $row_1, Int $row_2,
164 155
     return False; # The move is fine.
165 156
 }
166 157
 
167  
-=begin METHOD
168  
-Analyzes a given move, and makes the appropriate changes to the attributes
169  
-of this C<Druid::Game>. C<fail>s if the move isn't valid.
170  
-=end METHOD
  158
+#=[Analyzes a given move, and makes the appropriate changes to the attributes
  159
+of this C<Druid::Game>. C<fail>s if the move isn't valid.]
171 160
 method make-move(Str $move) {
172 161
 
173 162
     fail $reason
@@ -237,10 +226,8 @@ method make-move(Str $move) {
237 226
     return $move;
238 227
 }
239 228
 
240  
-=begin METHOD
241  
-Returns a C<Bool> indicating whether the latest move created a winning chain
242  
-across the board.
243  
-=end METHOD
  229
+#=[Returns a C<Bool> indicating whether the latest move created
  230
+a winning chain across the board.]
244 231
 submethod move-was-winning() {
245 232
 
246 233
     my ($row, $col) = self.extract-coords(
@@ -309,10 +296,8 @@ submethod move-was-winning() {
309 296
     return False;
310 297
 }
311 298
 
312  
-=begin METHOD
313  
-Returns a C<List> of the possible moves in this C<Druid::Game>, represented as
314  
-C<Str>s.
315  
-=end METHOD
  299
+#=[Returns a C<List> of the possible moves in this C<Druid::Game>,
  300
+represented as C<Str>s.]
316 301
 method possible-moves() {
317 302
     # We don't handle lintel moves yet. :( I have a nice O(1) algorithm,
318 303
     # but very little time.
20  lib/Druid/Game/Observer.pm
... ...
@@ -1,7 +1,4 @@
1  
-role Druid::Game::Observer;
2  
-
3  
-=begin SUMMARY
4  
-This role enables objects to I<observe> a C<Druid::Game::Subject>, i.e.
  1
+#=[This role enables objects to I<observe> a C<Druid::Game::Subject>, i.e.
5 2
 to be notified when that instance changes state in any of various ways.
6 3
 In concrete terms, an object doing C<Druid::Game::Observer> is added to
7 4
 a list of observers in a C<Druid::Game::Subject>, which then makes sure
@@ -9,19 +6,16 @@ to call the below methods on all observers in that list whenever the
9 6
 corresponding state change happens in the subject.
10 7
 
11 8
 Examples of classes which might want to observe a C<Druid::Game::Subject>
12  
-are classes derived from C<Druid::View> or C<Druid::Player>.
13  
-=end SUMMARY
  9
+are classes derived from C<Druid::View> or C<Druid::Player>.]
  10
+role Druid::Game::Observer;
14 11
 
15  
-=begin METHOD
16  
-Gets called any time the C<Druid::Game::Subject> adds a piece to its game
  12
+#=[Gets called any time the C<Druid::Game::Subject> adds a piece to its game
17 13
 board. Note that, for the purposes of this method, lintels are considered
18  
-to be three adjacent (but separate) pieces.
19  
-=end METHOD
  14
+to be three adjacent (but separate) pieces.]
20 15
 method add-piece($height, $row, $column, $color) { ... };
21 16
 
22  
-=begin METHOD
23  
-Gets called when the C<Druid::Game::Subject> swaps positions between the
24  
-two players.
  17
+#=[Gets called when the C<Druid::Game::Subject> swaps positions between the
  18
+two players.]
25 19
 =end METHOD
26 20
 method swap() { ... }
27 21
 
14  lib/Druid/Game/Subject.pm
... ...
@@ -1,22 +1,22 @@
1 1
 use v6;
2 2
 use Druid::Game::Observer;
3 3
 
4  
-role Druid::Game::Subject;
5  
-
6  
-=begin SUMMARY
7  
-This role enables objects to be I<observed> by one or more
8  
-C<Druid::Game::Observer>s, i.e. to be notify these when the object changes
  4
+#=[This role enables objects to be I<observed> by one or more
  5
+C<Druid::Game::Observer>s, i.e. to notify these when the object changes
9 6
 state in any of various ways. This role only handles the adding of observers;
10 7
 the actual state change notifications are made by classes doing this role.
11 8
 
12 9
 Examples of classes which might want to observe a C<Druid::Game::Subject>
13  
-are classes derived from C<Druid::View> or C<Druid::Player>.
14  
-=end SUMMARY
  10
+are classes derived from C<Druid::View> or C<Druid::Player>.]
  11
+role Druid::Game::Subject;
15 12
 
16 13
 # RAKUDO: Typed arrays don't really work yet
17 14
 #has Druid::Game::Observer @!observers;
18 15
 has @!observers;
19 16
 
  17
+#=[Attaches a C<Druid::Game::Observer> to this object. From now on,
  18
+notifications going out to all listening objects will also go out to the
  19
+added C<Druid::Game::Observer>.]
20 20
 method attach(Druid::Game::Observer $observer) {
21 21
     unless @!observers ~~ (*, $observer, *) {
22 22
         @!observers.push($observer);
13  lib/Druid/Player.pm
@@ -3,17 +3,14 @@ use v6;
3 3
 use Druid::Game;
4 4
 use Druid::Game::Observer;
5 5
 
6  
-class Druid::Player is Druid::Base does Druid::Game::Observer;
7  
-
8  
-=begin SUMMARY
9  
-Represents a generic Druid player. A player belongs to a certain game, has
  6
+#=[Represents a generic Druid player. A player belongs to a certain game, has
10 7
 a piece color in that game, and is responsible for choosing legal moves
11  
-and making them.
12  
-=end SUMMARY
  8
+and making them.]
  9
+class Druid::Player is Druid::Base does Druid::Game::Observer;
13 10
 
14  
-=attr The game this C<Druid::Player> is playing.
  11
+#=[ The game this C<Druid::Player> is playing. ]
15 12
 has Druid::Game $!game handles <size layers colors heights make-move>;
16  
-=attr The color of this C<Druid::Player>'s pieces.
  13
+#=[ The color of this C<Druid::Player>'s pieces. ]
17 14
 has Int $.color where 1|2;
18 15
 
19 16
 submethod BUILD(Druid::Game :$game!, Int :$color! where { $_ == 1|2 }) {
8  lib/Druid/Player/Computer.pm
@@ -2,13 +2,11 @@ use v6;
2 2
 
3 3
 use Druid::Player;
4 4
 
  5
+#=[ A computer player. It currently tries to move close to its opponent's
  6
+last move or, failing that, entirely randomly. Thus it is almost
  7
+ridiculously easily defeatable.]
5 8
 class Druid::Player::Computer is Druid::Player;
6 9
 
7  
-=begin SUMMARY
8  
-A computer player. It currently only makes random sarsen moves, and is thus
9  
-ridiculously easily defeatable.
10  
-=end SUMMARY
11  
-
12 10
 has $!last-move;
13 11
 
14 12
 method choose-move() {
7  lib/Druid/Player/Human.pm
... ...
@@ -1,13 +1,10 @@
1 1
 use v6;
2 2
 use Druid::Player;
3 3
 
  4
+#=[A human player, i.e. a C<Druid::Player> whose moves are typed in on C<$*IN>
  5
+by a human.]
4 6
 class Druid::Player::Human is Druid::Player;
5 7
 
6  
-=begin SUMMARY
7  
-A human player, i.e. a C<Druid::Player> whose moves are typed in on C<$*IN>
8  
-by a human.
9  
-=end SUMMARY
10  
-
11 8
 method choose-move() {
12 9
     do Whatever until my $move = self.input-valid-move();
13 10
     return $move;
7  lib/Druid/View.pm
@@ -3,17 +3,14 @@ use v6;
3 3
 use Druid::Game;
4 4
 use Druid::Game::Observer;
5 5
 
  6
+#=[Base class for classes that represent a C<Druid::Game> visually.]
6 7
 class Druid::View is Druid::Base does Druid::Game::Observer;
7 8
 
8  
-=begin SUMMARY
9  
-Base class for classes that represent a C<Druid::Game> visually.
10  
-=end SUMMARY
11  
-
12 9
 has Druid::Game $!game handles <size layers colors heights>;
13 10
 
14 11
 submethod BUILD(Druid::Game :$game!) {
15 12
     $game.attach(self);
16  
-    # RAKUDO: These attributes should be auto-initialized
  13
+    # RAKUDO: This attribute should be auto-initialized
17 14
     $!game = $game;
18 15
 }
19 16
 
45  lib/Druid/View/Text.pm
@@ -3,13 +3,10 @@ use v6;
3 3
 use Druid::Game;
4 4
 use Druid::View;
5 5
 
6  
-class Druid::View::Text is Druid::View;
7  
-
8  
-=begin SUMMARY
9  
-A textual view of a C<Druid::Game>. Draws a large isometric 3D view, with
  6
+#=[A textual view of a C<Druid::Game>. Draws a large isometric 3D view, with
10 7
 the pieces rendered as ASCII blocks, and two smaller 2D views giving
11  
-information about the colors and heights of the pieces on the board.
12  
-=end SUMMARY
  8
+information about the colors and heights of the pieces on the board.]
  9
+class Druid::View::Text is Druid::View;
13 10
 
14 11
 has $!cached-board;
15 12
 
@@ -43,10 +40,8 @@ my $cover-top-right = '
43 40
        #
44 41
 ';
45 42
 
46  
-=begin METHOD
47  
-Returns a string containing an ASCII picture of an empty Druid board of
48  
-the given size. 
49  
-=end METHOD
  43
+#=[Returns a string containing an ASCII picture of an empty Druid board of
  44
+the given size.]
50 45
 sub make-empty-board($size) { 
51 46
     # The 'join $sep, gather { ... }' pattern allows us to put a long
52 47
     # string together, without having to refer to the same variable over
@@ -75,18 +70,14 @@ submethod BUILD() {
75 70
     $!cached-board = make-empty-board($!game.size);
76 71
 }
77 72
 
78  
-=begin METHOD
79  
-Prints the 3D game board and the two smaller sub-boards, reflecting the
80  
-current state of the game.
81  
-=end METHOD
  73
+#=[Prints the 3D game board and the two smaller sub-boards, reflecting the
  74
+current state of the game.]
82 75
 method show() {
83 76
     .print for $!cached-board, self.colors-and-heights();
84 77
 }
85 78
 
86  
-=begin METHOD
87  
-Returns the 3D game board and the two smaller sub-boards, reflecting the
88  
-current state of the game.
89  
-=end METHOD
  79
+#=[Returns the 3D game board and the two smaller sub-boards, reflecting the
  80
+current state of the game.]
90 81
 method Str() {
91 82
     return [~] $!cached-board, self.colors-and-heights();
92 83
 }
@@ -128,12 +119,10 @@ method build-layers($board is copy, $from) {
128 119
     return $board;
129 120
 }
130 121
 
131  
-=begin SUBROUTINE
132  
-Given a string representing a piece and one representing the board,
  122
+#=[Given a string representing a piece and one representing the board,
133 123
 returns a new board with the piece inserted into some coordinates. This
134 124
 sub assumes that pieces are drawn in an order that makes sense, so that
135  
-pieces in front cover those behind.
136  
-=end SUBROUTINE
  125
+pieces in front cover those behind.]
137 126
 sub put($piece, $board, $height, $row, $column) {
138 127
     my @lines = $board.split("\n");
139 128
 
@@ -153,8 +142,7 @@ sub put($piece, $board, $height, $row, $column) {
153 142
     return @lines.join("\n");
154 143
 }
155 144
 
156  
-=begin SUBROUTINE
157  
-Given a string (assumed to contain no newlines), replaces a section of
  145
+#=[Given a string (assumed to contain no newlines), replaces a section of
158 146
 that string, starting from $column, with the contents of $new.
159 147
 When replacing characters, two excpetions are made:
160 148
 =for item
@@ -162,8 +150,7 @@ When replacing characters, two excpetions are made:
162 150
     don't replace the old character,
163 151
 =for item
164 152
     octothorpes '#' insert actual spaces, i.e. act as a sort of
165  
-    escape character for spaces.
166  
-=end SUBROUTINE
  153
+    escape character for spaces.]
167 154
 sub merge($old, $new, $start) {
168 155
     my @old = $old.split('');
169 156
     my @new = $new.split('');
@@ -179,11 +166,9 @@ sub merge($old, $new, $start) {
179 166
     return @old.join('');
180 167
 }
181 168
 
182  
-=begin METHOD
183  
-Prints two smaller boards representing
  169
+#=[Prints two smaller boards representing
184 170
 =item who owns each location, and
185  
-=item how many stones have been piled on each location.
186  
-=end METHOD
  171
+=item how many stones have been piled on each location.]
187 172
 method colors-and-heights() {
188 173
 
189 174
     my &from-pretty    = { $^pretty.trans( ['>>',   '<<', '.']
7  lib/Test/Ix.pm
... ...
@@ -1,12 +1,9 @@
1 1
 use v6;
2 2
 use Test;
3 3
 
4  
-=begin SUMMARY
5  
-This module takes a recursive list of tests and autogenerates test subs
  4
+#=[This module takes a recursive list of tests and autogenerates test subs
6 5
 from it, injecting those subroutines into a given file. It also handles
7  
-traversing the same list in order to count or run the tests in a file.
8  
-=end SUMMARY
9  
-
  6
+traversing the same list in order to count or run the tests in a file.]
10 7
 sub inject-subs-in-file($file) {
11 8
     my $code = slurp($file)
12 9
         or die "Couldn't open $file";

0 notes on commit 79bc10a

Please sign in to comment.
Something went wrong with that request. Please try again.