=pod
-------------------------------------------------------------------------------
                              PERL MIND version 0.08
-------------------------------------------------------------------------------
                    A MasterMind-clone written in obfusctaed Perl
                     by Andreas Hagelberg (aka The Logic Burner)
                            Copyright  A. Hagelberg 1999
-------------------------------------------------------------------------------

This is a version of the classical game MasterMind. The original game is played
on a grid with holes, formed in rows of six. Someone places a pattern of
colored  dots at th top row (and keeps it hidden from you). You will then have
to reconstruct this row yourself by placing patterns on the lower rows. Each
time you place a row of dots the other person is to place, next to it, a serie
of smaller black and white dots. A black dot means that one of your colored
dots are correctly placed, while a white dots means that one of your dots is of
the right color, but in the wrong place. With this information it is possible
to find the original row placed by your friend. In this version the colors are
replaced with the letters A through H, the black and white markers with '*' and
'+' and your friend with the computer.

   It starts out by creating the row that you are to find. It then enters a
while-loop that will call subroutine '&c' to process entered data and as long
as this sub returns a false value, the while-loop will continue. The loop then
calls subroutine '&d' to display the playfield and it then fetches any
user-input.

   The internal workings of this game is based on a couple of arrays - '@r'
which holds the correct row, and '@b' which is two-dimensional and holds all
previous guesses/tries made, together with the markers.




Below follows the a more detailed description of the code:
-------------------------------------------------------------------------------
=cut


# Initialize the random generator
srand;


# Create the row of letters that is to be found by the player.
for(0..5){
	$r[$_]=chr 65+rand 8
}


# Subroutine to display the play-field
sub d{

	# Put some space between each new display
	print$/x6;

	# Now loop through all cells in the array
	for(0..335){

		# Print the correct character for the current cell. For the
		# first six chars on the first row, print either 'O', or - if
		# the first parameter sent to the sub is true - the letters
		# from the answer (array '@r'). Is it the second row, print '-'
		# to form a line. Is it the last character of each row, print
		# a line-feed. Is it the 7th char on the row print '|' to form
		# the vertical line. Is it any other cell, print the
		# corresponding character from the '@b'-array, or if it is
		# undef, print a space.
		print$_<27&$_>13?'-':$_%14>12?"\n":$_<6?$_[0]?$r[$_]:'O':
			$_%14==6?'|':(split//,$b[int$_/14])[$_%14]||$"
	}

	# Display the instructions.
	print"Enter m/[A-Ha-h]{6}/\n"
}


# Subroutine for checking user-input etc.
sub c{

	# Make sure the user-input is in the right format (six letters A
	# through H); if not, bail out.
	return if/[^A-H]/||length()-6;

	# Split the user-input up and put the letters in the '@b'-array,
	# together with a trailing space (to make up for the vertical line when
	# displayed. 'uc' used here instead of '$_' for no particular reason
	# since '$_' is already upper-cased.
	@c=split//,${$f=\($b[24-++$w]=uc.$")};

	# Compare each letters in the entered row with the correct row (6x6=36),
	# but first check if any of the letters in the entered row are 100%
	# correct.
	for(-6..35){

		# If the index is less than zero then check if any of the
		# letters are in the right place. For each correct letter found,
		# increase '$n'. All correct letters found are marked so that
		# they are not checked again, both in the row being checked and
		# the correct row, using the arrays '@p' and '@q'.
		($p[$h]=1)&($q[$h]=1)&($$f.="*")&$n++
			if$_<0&&$c[$h=$_+6]eq$r[$h];

		# If the current index is zero or greater, then check all
		# combinations between the entered row and the correct row and
		# see if any of the letters in the correct row matches any of
		# the letters in the enetered row. If one is found then mark
		# the letters in question.
		!$p[$b]&&!$q[$d]&&($p[$b]=1)&($q[$d]=1)&($$f.="+")
			if$c[$d=$_%6]eq$r[$b=$_/6]&&$_>-1
	}

	# If six 100% correct letters have been found, show the gaming-board
	# with the original string uncovered, exit program and display "Done"
	# on the terminal - the player has won.
	(d$])&die"Done$/"if$n>5;

	# Empty the two arrays '@p' and '@q' as well as the scalar '$n'.
	$n=@p=@q=();

	# If the number of rows used exceeds 21, then return a true value - the
	# player has lost. What? This is not the way you're supposed to use
	# the variable '$;'? =)
	$w>21&&return$;
}


# The main-loop. Continue until sub '&c' returns a true value (no more rows
# left).
while(!c){

	# Display game-field by calling sub '&d', get the user-input, convert
	# it to upper-case and store it in the standard-variable.
	d|chop($_=uc<>)
}

# Display the game-field, but with the correct row revealed.
d$/;

# You lost!
print"$/Looser!$/"
