Program Testnyet; {version 3.14 , 1990 may 8}
{$C-} {Allows 'Keypressed' to function as needed}
{**************************TODO LIST FOLLOWS********************************
rewrite help screens  to make context sensitive?
When pieces are falling I should make sure they contiune to fall while person
	makes moves
m_m=4 should allow for reading in of matrix, penalties, and inverse)
ought to allow for switching to move_mode=2 or 4 when it =3 and file runs out
	just like for piece_mode. But which to swich to? When to get weights?
consider allowing any part of 'status' to change at any time (files, modes,penalties)
allow command-lineoptions(e.g. to haver no screen output)
turn into standard pascal and run on mainframe
observe user's choices and show poss. penalty scheme (2 vars at a time?)
allow user to disagree with computer's choice? (Show all penalties);
'valley' should be defined more freely, e.g. if col hts are 10 11 11 12 11 6 5...
	then valley should start with 6, not with 11! (this bug makes it lose in
	unfavorable circumsatnces)
Make minitab results stored in clumps of 500 lines, say. Would be nice to get
	it into the form of a .mtw worksheet.
Use turbo WINDOW command? esp: when pieces or moves are read from files with
	large filenames, screen looks funny.

Possible penalties to calculate:
Height:
	max height of any piece (but I LIKE to have high pieces along walls)
	max height of a column with shorter columns somewhere on either side of it.
	min height of any piece on top of a column (but I DON'T LIKE canyons, so...)
	min height of a column with a shorter (or equal) column right next to it
	average height of tops of columns
	max diff in height between any two tops
	sum of abs. diffs of adjacent heights
	max depth of canyon
	no.of canyons of depth 2
	no of canyons of depth 3
	no of canyons of depth >=4
	penalty for too many or two deep 2x2-square holes
	no of flat regions (sum of their lengths, I guess)
	largest flat region
	sum of abs diffs in adjacent heights between first local min and last
Holes:
	depth of shallowest hole?
	sum of Dist from each hole to top
	somthing about having lots of hole in same row or adjacent and in same column
	Andrea says to watch for L-shaped holes.
	sum of dist of holes from BOTTOM
	some way to keep it from putting a piece over a hole it just made
		(ideal is just next to it so as not to have to spill over
		hole when smoothing off top layer)
}
{**************************DECLARATIONS FOLLOW*****************************}
Const
	NUMROWS=20;{some sort of bug in (un)write template if numrows <> 20}
	SHOWROWS=20; {size of screen. Must be <= NUMROWS in ShowEnvironment}
	NUMSTATES=22; {make this one or two bigger than NUMROWS}
	NUMCOLS=10;
	NUMPOSITION=40; {4 orientations x 10 columns}
	MAX_RATES=10; {allows for one more experimental}
	MATSIZ=8; {=num_Rates-2 not used + 1 const term}
	X_PP=2; Y_PP=3;
	X_RE=2; Y_RE=10;
	X_MSG=2; Y_MSG=17;
	X_ENV=30; Y_ENV=2;
	X_KEY=56; Y_KEY=3;
	X_DAT=56; Y_DAT=15;
	WIDE=2;
	block:array[1..WIDE] of char=(#219, #219);
	space:string[WIDE]='  ';
	first_shape: array[1..8] of integer=(1,2,4,6,8,12,16,20);
	width:array[1..19] of integer=(2,4,1,3,2,3,2,3,2,3,2,3,2,3,2,3,2,3,2);
	versno:String[4]='3.14';
	FULLROW=1023;

Type
	grid=array[1..NUMROWS] of integer;  {OK if NUMCOLS < 16}
	depths=array[1..NUMCOLS] of integer; {row-coord of top nonempty spot}
	filename=String[65]; {65=length of a path+file name}
	realmatrix=array[1..MATSIZ,1..MATSIZ] of real;
	realvector=array[1..MATSIZ] of real;
	penaltyset=array[1..MAX_RATES] of integer;{'integer' OK if w[8]=w[9]=0}
	byteset=array[1..4] of byte;
	bytefile=file of byte;
Var
	session_over: boolean;
	pause_amount, rows_cleared, pieces_placed, pp_offs: integer;
	num_rates, curr_height, piece, shape, position , displacement, drop: integer;
	piece_mode, move_mode, record_mode, minitab_mode : char;
	piece_source,piece_target: bytefile;
	move_source,move_target,minitab_target, results_target: text;
	piece_source_name, move_source_name, piece_target_name,
		move_target_name, 
		minitab_target_name, results_target_name: filename;
	environment:grid;
	pow_2:array[1..NUMCOLS] of integer;
	tops_environment:depths;
	weights:penaltyset;
	xs, ys: array[1..19,1..4] of integer;
	latest_xs, latest_ys:array[1..4] of integer;
	shape_depths : array[1..19, 1..4] of integer;
	sumpenalty: realvector;
	summatrix, suminverse: realmatrix;
	distribution: array[1..NUMSTATES] of integer; {watch for overflow}
	transits: array[1..NUMSTATES,1..9] of integer;
	inbyte,outbyte:byteset;

{**************************HELP MESSAGES FOLLOW********************************}
Procedure DisplayHelp;

const	data:array[1..131] of String[100]=(
'        Randomly shaped pieces appear at the top of the screen.  Your',
'job is to arrange them as they appear so that you can drop the greatest',
'number of pieces into the available volume.  You maneuver the pieces by',
'rotating them and moving them horizontally and vertically.  If you have',
'arranged the pieces so that a solid row of squares is formed',
'horizontally, that row will be eliminated, giving you some room.',
'        This program is an emulation and embellishment of the game NYET by',
'David Horworth. That game is available as a companion to this program. Please',
'read the documentation for it; it describes the relation of this game',
'to the game TETRIS.',
'        This program may be copied freely, but not sold commercially.  Please',
'forward comments, bug reports, and suggested improvements.',
' ',
'OPTIONS: 1. HOW THE PIECES ARE CHOSEN',
'        There are several ways to use this program. You may decide to have',
'the pieces be created randomly or read from a previously-created file.',
'(This feature is useful if you want to review a previous round or compare',
'your success with different techniques.) To instill a sense of humility, the',
'pieces may also be chosen so as to be as bad as possible.',
' ',
'2. HOW THE PIECES ARE MOVED.',
'        The positioning of the pieces may also be recreated from a file, or ',
'may be done manually, or may be done by the computer. In the first and third',
'cases, you may adjust the amount of time the computer allows you to stare at',
'the move as it is made. In the second case, you will position the piece using',
'the keys shown on the screen. (For historical reasons you may also use the',
'7-8-9 keys instead of J-K-L.) In order to recreate the original game of',
'TETRIS, an option is included to allow you to race against time. One subtle',
'difference is that you will not be allowed to slide the piece under an',
'overhang (This will make your session compatible with the play-back option',
'so that you can discuss your game with your friends.) The pieces fall a bit',
'faster with each row cleared. If you are impatient you can change the speed;',
'the number of rows one would need to clear before being forced to play at',
'this speed is shown in parentheses.',
'        If the computer is to make the moves, it will consider',
'all possible moves and choose the best one. In order to decide the best,',
'the computer assigns penalties based on the presence of some configurations,',
'and takes a weighted average of the penalties to get an aggregate rating.',
'The user must supply the weightings to be applied.',
'        Here are the configurations the computer scans for. The first six',
'depend only on the heights of the columns; the remainder also consider the',
'presence of holes below the surface.',
'        1. Height of tallest column.',
'        2. Number of canyons at least three spaces deep. A canyon is a',
'column which is shorter than the two columns adjacent to it. (The walls are',
'counted as infinitely tall columns here.)',
'        3. Sum of the depths of all canyons (even those only 1 space deep).',
'        4. Height difference between tallest column having shorter columns',
'somewhere on both sides of it, and lowest column. Think of this as being the',
'height of the biggest mountain in the valley, above the valley floor.',
'        5. Maximum difference in heights between any two columns.',
'        6. Deviation from a perfect U shape (that is, a shape with at most',
'one local minimum).',
'        7. Total number of holes underneath any amount of filled space.',
'        8. Sum of the depths of the holes from the top of their column.',
'        9. Sum of the number of filled spaces above each hole.',
' ',
'        You can also ask the computer to try to keep track of how bad the',
'environment tends to look and to adjust the penalties as it goes on; one',
'might say the computer is learning from its mistakes. This option',
'automatically performs the data-manipuation described below.',
' ',
'3. ANALYZING YOUR PERFORMANCE',
'        The overall goal is to be able to run this program for as long as',
'possible, trying to maximize either the number of pieces placed or the',
'number of rows eliminated. It is easier to have the computer carry out the',
'long sessions, so the problem revolves around choosing the penalties well.',
'The program allows you to record several kinds of data for later analysis.',
'(You may instead choose to record none of this kind of data.)',
'        The simplest kind of record consists of a listing of the penalties',
'recorded after each piece is placed. The computer will create a file with',
'one row of data for each piece; the row consists of the 9 numbers described',
'in the previous section. You might choose to study the frequency with',
'which these numbers appear, or the extent to which they are correlated.',
'        If you are willing to wait longer for the data to be collected, you',
'can ask the computer to add two more numbers to the end of each row. After',
'each piece is placed and the current configuration scanned as in the previous',
'paragraph, the computer will then consider how best it might play each of the',
'seven pieces that might appear next. For each one it will figure out the',
'total penalty that will be assigned to the resulting configuration. It then',
'writes to the file the average and the worst of those seven total penalties.',
'Remember, the goal of the assignment of penalties is to let you decide how',
'good your configuration is in the long run. If you have chosen these',
'penalties well, then on the average the assessment of the next configuration',
'should not differ much from the present one.',
'         Therefore, it is reasonable to ask what  weights might be assigned',
'to the penalties to try to predict as well as possible the total penalty',
'assigned to the NEXT configuration. Mathematically, this reduces to',
'regressing these additional bits of data against the previous 9 variables.',
'         One last form of data collection is still under development at this',
'writing; you will be able to ask the computer to write into a file the',
'matrix whose i-j entry is the sum of the products of the i-th and j-th',
'penalties for each configuration that appears on the screen. This is the',
'matrix involved in the calculation of the regression coefficients, although',
'if you have some other way of doing regressions, that is much easier.',
' ',
'4. INTERRUPTING THE ACTION',
'        This program can go very long or very fast. You can adjust the speed',
'of the display if you need more time to watch what is going on or are in a',
'hurry: see the options in the KEY table on the screen.',
'        If you want to have a chance to stare at one particular display, hit',
'the Escape key. The program will resume as soon as you hit anything else.',
'        If you need to take a break and do something else, but wish to',
'continue your session, type  B  and provide the name of a file in which the',
'program status can be stored. When you are ready to begin again, start up',
'the program as usual but answer  R  (restart) to the first question.',
'        Finally, if you want to give up for good, hit  Q  (quit) rather than',
'aborting in some unnatural way; this gives the program a chance to close files.',
'5. REVIEW OF A SESSION',
'        If you will need to review your simulation, take the option to',
'record it. The simplest record is just a summary file showing the parameters',
'you chose and the number of pieces placed by the end of the session. It also',
'records any unusual observations, such as the clearing of the environmnet.',
'The summary file is pretty short; you can just print it out or read',
'it from the screen with the DOS ''type'' command.',
'        You can also ask for a record of the pieces that appear. You can use',
'this file in subsequent sessions when selecting the ''piece mode'' if you want',
'to run an experiment facing the same sequences of pieces to place. Use this if',
'you and your friends want to compete!',
'        You can further ask for a record of where each of the pieces is',
'placed. You can use this file when selecting the ''move mode'' in a later',
'session if you want to watch present session again. This is handy if you want',
'to discuss your performance in a particular session with your teammates. (It',
'also allows you a way to show off if you did well!)',
'        In any of these cases, you will need to specify names for the files',
'in which to record the data. Be sure you dont overwrite old needed files.',
'Don''t forget to specify the A: drive if you are saving the data on a floppy',
'disk. If you have a question for your instructor, it is best to record',
'everything.',
' ',' '
	);
var	offset:integer;

Procedure Printlines(n:integer);
var	ch:char;
	i:integer;
begin
	for i:=1 to n do Writeln(data[offset+i]);
	Writeln('          ................Press any key when ready................');
	Read(kbd,ch);
	ClrScr;
	offset:=offset+n;
end;

begin
	ClrScr;
	Write('                             DA -- version ');
	Writeln(versno);
	offset:=0;
	Printlines(20);
	Printlines(22);
	Printlines(20);
	Printlines(23);
	Printlines(23);
	Printlines(22);
end;

{**************************GENERAL ROUTINES FOLLOW*****************************}

procedure freeze(n:integer);
var       ch:char;
begin
gotoxy(x_msg,y_msg); write(n);write(' ');
{$C+}
read(kbd,ch);
{$C-}
if ch=#27 then HALT;
end;

Procedure Make_xys;
var	i:integer;
begin
	for i:=1 to 4 do begin
		latest_xs[i]:=xs[shape][i];
		latest_ys[i]:=ys[shape][i];
	end;
end;

Function DropAmnt(t: depths; s, displ:integer):integer;
var	temp,this_dist:integer;
	j:integer;
begin
	temp:=NUMROWS;
	for j:=1 to width[s] do begin
		this_dist:=NUMROWS-t[j+displ]-shape_depths[s][j];
		if this_dist< temp then temp:=this_dist;
		end;
	DropAmnt:=temp;
end;

Procedure Pause;
var k:integer;
begin
	for k:=1 to pause_amount do k:=k;
	for k:=1 to pause_amount do k:=k;
	for k:=1 to pause_amount do k:=k;
	for k:=1 to pause_amount do k:=k;
	for k:=1 to pause_amount do k:=k;
end;

Function JthSpot(n:integer;j:integer):integer;
begin
	JthSpot:=(n shr (j-1)) mod 2;
end;
{returns 0 or 1: coeff of 2^(j-1) in binary expansion}

{*************************SCREEN ROUTINES ARE ALL HERE:**********************}
{contains the only gotoxy, x_re,...,y_dat; there are some writeln's in
help and init sections}

Procedure Drawbox(x1,y1,x2,y2:integer);
var i:integer;
begin
	GoToXY(x1,y1); Write(#218);
	for i:=x1+1 to x2-1 do Write(#196);
	Write(#191);
	GoToXY(x1,y2); Write(#192);
	for i:=x1+1 to x2-1 do Write(#196);
	Write(#217);
	for i:=y1+1 to y2-1 do begin
		GoToXY(x1,i);
		Write(#179);
		GoToXY(x2,i);
		Write(#179);
		end;
end;

Procedure EraseKeyBox;
var	i,j:integer;
begin
	for i:=0 to 10 do begin
		GoTOXY(X_KEY,y_key+i);
		for j:=0 to 19 do write(' ');
		end;
end;

Procedure FillKeyBox;
begin
	GoToXY(X_KEY+2, Y_KEY+5);Write('H: Help');
	GoToXY(X_KEY+2, Y_KEY+8);Write('Q: Quit');
	GoToXY(X_KEY+2, Y_KEY+4);Write('ESC: Pause');
	GoToXY(X_KEY+2, Y_KEY+9);Write('B: Break');
	GoToXY(X_KEY+2, Y_KEY+6);
	if move_mode='5' then Write('+: Faster') else Write('I: Raise');
	GoToXY(X_KEY+2, Y_KEY+7);Write('N: Lower');
	GoToXY(X_KEY+2, Y_KEY);Write('J: Move to left');
	GoToXY(X_KEY+2, Y_KEY+1);Write('K: Rotate');
	GoToXY(X_KEY+2, Y_KEY+2);Write('L: Move to right');
	GoToXY(X_KEY+2, Y_KEY+3);Write('Space: Drop piece');
end;

Procedure AltKeyBox;
begin
	GoToXY(X_KEY+2, Y_KEY+1);Write('H: Help');
	GoToXY(X_KEY+2, Y_KEY+2);Write('Q: Quit');
	GoToXY(X_KEY+2, Y_KEY+3);Write('ESC: Pause');
	GoToXY(X_KEY+2, Y_KEY+9);Write('B: Break');
	GoToXY(X_KEY+2, Y_KEY+4);Write('F: Fastest');
	GoToXY(X_KEY+2, Y_KEY+5);Write('+: Faster');
	GoToXY(X_KEY+2, Y_KEY+6);Write('-: Slower');
	GoToXY(X_KEY+2, Y_KEY+7);Write('S: Slowest');
	{refers to drawing  speed only!}
end;

Procedure ShowPieceMode;
begin
	GoToXY(X_DAT+1,Y_DAT);
	Write('                    ');
	GoToXY(X_DAT+1,Y_DAT);
	Write('Pieces ');
	if piece_mode='1' then Write('random');
	if piece_mode='2' then begin Write('from "'); Write(piece_source_name);Write('"');end;
	if piece_mode='3' then Write('made worst');
end;

procedure ShowMoveMode;
begin
	GoToXY(X_DAT+1,Y_DAT+1);
	Write('                    ');
	GoToXY(X_DAT+1,Y_DAT+1);
	Write('Moves ');
	if move_mode='1' then Write('by user');
	if move_mode='5' then Write('to beat fall');
	if move_mode='2' then Write('computed');
	if move_mode='4' then Write('being learned');
	if move_mode='3' then begin Write('from "'); Write(move_source_name);Write('"');end;
end;

Procedure ShowMinitabMode;
begin
	GoToXY(X_DAT+1,Y_DAT+2);
	if minitab_mode='2' then Write(num_rates);
	if minitab_mode='4' then Write(1);
	if minitab_mode='3' then Write(num_rates+2);
	Write(' columns in "'); Write(minitab_target_name);Write('"');
end;

Procedure ShowRecordMode;
begin
	if record_mode='4' then begin
		GoToXY(X_DAT+1,Y_DAT+3);
		Write('Moves to "',move_target_name,'"');
		end;
	if record_mode>='3' then begin
		GoToXY(X_DAT+1,Y_DAT+4);
		Write('Pieces to "',piece_target_name,'"');
		end;
	if record_mode>='2' then begin
		GoToXY(X_DAT+1,Y_DAT+5);
		Write('Results to "',results_target_name,'"');
		end;
end;

Procedure ShowWeights;
var	i:integer;
begin
	GoToXY(X_DAT+1, Y_DAT+6); Write('Weights assigned:');
	GoToXY(X_DAT+1,Y_DAT+7);
	for i:=1 to num_rates do begin
		Write(weights[i]);Write(' ');end;
end;

Procedure MakeWritingZones;
const	wall:array[1..WIDE] of char=(#177, #177);
var i: integer;
begin
	ClrScr;
	{}
	Drawbox(X_PP-1,Y_PP-1,X_PP+19,Y_PP+3);
	GoToXY(X_PP+3,Y_PP-1); Write('PIECES PLACED');
	{}
	Drawbox(X_RE-1,Y_RE-1,X_RE+19,Y_RE+3);
	GoToXY(X_RE+2,Y_RE-1); Write('ROWS ELIMINATED');
	{}
	Drawbox(X_MSG-1,Y_MSG-1,X_MSG+19,Y_MSG+3);
	GoToXY(X_MSG+5,Y_MSG-1);Write('MESSAGES');
	{}
	for i:=-1 to SHOWROWS do begin
		GoToXY(X_ENV-WIDE,Y_ENV+i);
		Write(wall);
		GoToXY(X_ENV+NUMCOLS*WIDE,Y_ENV+i);
		Write(wall);
		end;
	GoToXY(X_ENV-2,Y_ENV+SHOWROWS+1);
	for i:=0 to NUMCOLS+1 do Write(wall);
	{}
	Drawbox(X_KEY-1,Y_KEY-1,X_KEY+20,Y_KEY+10);
	GoToXY(X_KEY+8, Y_KEY-1);Write('KEY');
	if (move_mode='1') or (move_mode='5') then FillKeyBox else AltKeyBox;
	{}
	Drawbox(X_DAT-1,Y_DAT-1,X_DAT+22,Y_DAT+8);
	GoToXY(X_DAT+7, Y_DAT-1);Write('STATUS');
	ShowPieceMode;
	ShowMoveMode;
	if minitab_mode>'1' then ShowMinitabMode;
	if record_mode>'1' then ShowRecordMode;
	if (piece_mode='3') or (move_mode='2') or (minitab_mode='3') then ShowWeights;
end;

Procedure PrettyCursor;
begin
	GoToXY(1,24);
end;

Procedure WriteTemplate(updown, leftright: integer);
var	i: integer;
begin
	for i:=1 to 4 do begin
		GoToXY(X_ENV+(leftright+latest_ys[i]-1)*WIDE,Y_ENV+updown+latest_xs[i]);
		Write(block);
	end;
	PrettyCursor;
end;

Procedure UnWriteTemplate(updown, leftright: integer);
var	i: integer;
begin
	for i:=1 to 4 do begin
		GoToXY(X_ENV+(leftright+latest_ys[i]-1)*WIDE,Y_ENV+updown+latest_xs[i]);
		Write(space);
		end;
end;

Procedure ClearTemplateSpot;{no longer used}
var	Xspot,j:integer;
begin
	Xspot:=X_ENV+ (NUMCOLS - 4); {times WIDE, div 2 (for centering)}
	GoToXY(Xspot, Y_ENV-1);
	for j:=1 to 4 do Write(space);
	GoToXY(Xspot, Y_ENV);
	for j:=1 to 4 do Write(space);
end;

Procedure WritePP;
begin
	GoToXY(X_PP+9,Y_PP+1);
	Write(pieces_placed,' ');
end;

Procedure IncreaseOffs;
begin
	pp_offs:=pp_offs+1;
	Gotoxy(x_pp+1,y_pp+1);
	write(pp_offs);
end;

Procedure ShowSpeed(n:integer);
begin
	GoToXY(X_RE+1,Y_RE+1);
	Write('(',n,')');
end;

Procedure ShowEnvironment;
var	i,j,show_height :integer;
begin
	GoToXY(X_RE+9,Y_RE+1);
	Write(rows_cleared,' ');
	if curr_height+4>SHOWROWS then show_height:=SHOWROWS else show_height:=curr_height+4;
	for i:=1 to show_height do begin
		GoToXY(X_ENV,Y_ENV+SHOWROWS+1-i);
		for j:=1 to NUMCOLS do begin
			if JthSpot(environment[i],j)=1 then Write(block)
			else Write(space);
		end;
	end;
end;

Procedure EraseMessage;
var i:integer;
begin
	GoToXY(X_MSG,Y_MSG);
	for i:=1 to 18 do Write(' ');
	GoToXY(X_MSG,Y_MSG+1);
	for i:=1 to 18 do Write(' ');
end;

Procedure MessageIt(m,n:integer);
const	data:array[1..10] of String[32]=
	('File exhausted.',
	'Pieces random now.',
	'inverse failed',
	'Session Over',
	'Move_source out',
	'Moves computed now',
	'Game paused;',
	'Any key resumes',
	'Thinking...',' ');

var	i:integer;
begin
	EraseMessage;
	for i:=0 to n-1 do begin
		GoToXY(X_MSG+1, Y_MSG+i);
		Write(data[m+i]);
		end;
end;


{***********************FILE ROUTINES FOLLOW*********************************}
{contains all direct calls to files -assigns, close, write, read (not screen)}

Function Open(var fp:text; var Name:filename; mode:char): boolean;
var	proceed: boolean;
begin
{$I-}
	proceed:=TRUE;
	while proceed=TRUE do begin
		Write('Enter filename (hit return to abort): ');
		readln(Name);
		Assign(fp,Name);
		if mode='w' then rewrite(fp) else reset(fp);
		if IOresult <> 0 then begin
			if mode='r' then close(fp);
			Write('ERROR -- ');
			if mode='w' then write('File creation error:  ')
				else write('File not found: ');
			Writeln(Name);
			proceed:=TRUE;
			end
		else proceed:=FALSE;
		if Name='' then begin
			proceed:=FALSE;
			open:=False
			end
		else open:=TRUE;
		end;
end;
{$I+}

Function Openx(var fp:bytefile; var Name:filename; mode:char): boolean;
var	proceed: boolean;
begin
{$I-}
	proceed:=TRUE;
	while proceed=TRUE do begin
		Write('Enter filename (hit return to abort): ');
		readln(Name);
		Assign(fp,Name);
		if mode='w' then rewrite(fp) else reset(fp);
		if IOresult <> 0 then begin
			if mode='r' then close(fp);
			Write('ERROR -- ');
			if mode='w' then write('File creation error:  ')
				else write('File not found: ');
			Writeln(Name);
			proceed:=TRUE;
			end
		else proceed:=FALSE;
		if Name='' then begin
			proceed:=FALSE;
			openx:=False
			end
		else openx:=TRUE;
		end;
end;
{$I+}

Procedure RecordIt(m:integer; n:integer);
const	data:array[1..16] of String[80]=(
	'New weights established',
	'Pieces became random',
	'All rows cleared',
	'Iterations needed for convergence of inverse',
	'Max entry requiring smaller contribution to sum',
	'Rows cleared at end of session',
	'Latest revision of summatrix and sumpenalty',
	'Move_source exhausted',
	'Pieces_placed off by another 65536',
	'Rows_cleared off by another 65536',
	'User quit (chicken!)',
	'First few heights',
	'No more room to drop pieces',
	'Session interrupted',
	'Session  restarted ',
	'Session ended');
var	i:integer;
begin
	if record_mode>'1' then begin
		write(results_target,pieces_placed,' pieces: ',data[m]);
		if n<>0 then write(results_target,' = ',n);
		if m=1 then for i:=1 to num_rates do write(results_target,weights[i],',');
		Writeln(results_target,' ');
		flush(results_target)
		end;
end;

Procedure ShowDistribution;
var	i,j:integer;
begin
	if NOT (minitab_mode='3') then
		for i:=1 to NUMSTATES do write(results_target,distribution[i],',');
		writeln(results_target,' ');
	if minitab_mode='3' then
		for i:=1 to NUMSTATES do begin
			for j:=1 to 9 do write(results_target,transits[i,j],',');
			writeln(results_target,' ');
			end;
end;

{The following taken from Turbo 3.0 package}
Procedure WriteDateIn;
type
	DateStr = string[10];
	TimeString = string[8];
	regpack = record
		ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
		end;

function Date: DateStr;
var
	recpack:	regpack;
	month,day:	string[2];
	year:	string[4];
	dx,cx:	integer;
begin
	with recpack do ax := $2a shl 8;
	MsDos(recpack);                        { call function }
	with recpack do begin
		str(cx,year);                        {convert to string}
		str(dx mod 256,day);                     { " }
		str(dx shr 8,month);                     { " }
		end;
	date := month+'/'+day+'/'+year;
end;

function time: TimeString;
var	recpack:	regpack;
	ah,al,ch,cl,dh:	byte;
	hour,min,sec:	string[2];
begin
	ah := $2c;                             {initialize correct registers}
	with recpack do ax := ah shl 8 + al;
	intr($21,recpack);                     {call interrupt}
	with recpack do begin
		str(cx shr 8,hour);                  {convert to string}
		str(cx mod 256,min);                       { " }
		str(dx shr 8,sec);                         { " }
		end;
	time := hour+':'+min+':'+sec;
end;

begin {WriteDateIn}
	Writeln(results_target,'It is now ',time, ' on ', date);
end;

Procedure Shiftbytes(var b:byteset);
begin
	b[1]:=(b[1] shl 3) + (b[2] shr 5);
	b[2]:=(b[2] shl 3) + (b[3] shr 5);
	b[3]:=(b[3] shl 3) + piece;
	b[4]:=(b[4]+1) mod 8; {b[4] is a counter of number of shifts}
end;

Procedure ReadPiece;
begin
	if inbyte[4]=0 then read(piece_source, inbyte[1],inbyte[2],inbyte[3]);
	piece:=inbyte[1] shr 5;
	Shiftbytes(inbyte);
end;

Procedure WritePiece;
begin
	Shiftbytes(outbyte);
	if outbyte[4]=0 then Write(piece_target, outbyte[1],outbyte[2],outbyte[3]);
end;

Procedure Finish;
var	i:byte;
begin
	MessageIt(4,1);
	PrettyCursor;
	if piece_mode='2' then close(piece_source);
	if move_mode='3' then close(move_source);
	if record_mode='4' then begin
		Writeln(move_target,0);
		Close(move_target);
		end;
	if record_mode>='3' then begin
		piece:=0;
		for i:=1 to 8 do Writepiece;
		Close(piece_target);
		end;
	if record_mode>='2' then begin
		RecordIt(16,0);
		WriteDateIn;
		Recordit(6,rows_cleared);
		ShowDistribution;
		Close(results_target);
		end;
	if minitab_mode>'1' then Close(minitab_target);
	HALT;
end;

Procedure AbEnd;
begin
	RecordIt(11,0);
	Finish;
end;

Procedure Break;
var	store_file: text;
	store_file_name: Filename;
	i,j: integer;
begin
	PrettyCursor;
	if NOT Open(store_file, store_file_name, 'w') then begin
		Writeln('Sorry!'); HALT; end;
	Writeln(Store_file,pause_amount);
	Writeln(Store_file,num_rates);
	Writeln(Store_file,piece_mode);
	Writeln(Store_file,move_mode);
	Writeln(Store_file,record_mode);
	Writeln(Store_file,minitab_mode);
	if piece_mode='2' then Writeln(Store_file,piece_source_name);
	if move_mode='3' then Writeln(Store_file,move_source_name);
	if record_mode>'1' then Writeln(Store_file,results_target_name);
	if record_mode>'2' then Writeln(Store_file,piece_target_name);
	if record_mode>'3' then Writeln(Store_file,move_target_name);
	if minitab_mode>'1' then Writeln(Store_file,minitab_target_name);
	for i:=1 to num_rates do writeln(store_file,weights[i]);
	{sumpenalty, summatrix!}
	for i:=1 to NUMSTATES do writeln(store_file,distribution[i]);
	for i:=1 to NUMSTATES do for j:=1 to 9 do writeln(store_file,transits[i,j]);
	for i:=1 to NUMCOLS do writeln(store_file,tops_environment[i]);
	for i:=1 to NUMROWS do writeln(store_file,environment[i]);
	Writeln(Store_file,rows_cleared);
	Writeln(Store_file,pieces_placed-1); {restart will pass through nextpiece first}
	Writeln(store_file,pp_offs);
	Writeln(Store_file,curr_height);
	for i:=1 to 4 do Writeln(store_file,inbyte[i]);
	for i:=1 to 4 do Writeln(store_file,outbyte[i]);
	Close(store_file);
	if piece_mode='2' then close(piece_source);
	if move_mode='3' then close(move_source);
	if record_mode='4' then Close(move_target);
	if record_mode>='3' then Close(piece_target);
	if record_mode>='2' then begin
		RecordIt(14,0);
		WriteDateIn;
		Close(results_target);
		end;
	if minitab_mode>'1' then Close(minitab_target);
	HALT;
end;

Procedure Recover;
var	store_file: text;
	store_file_name:Filename;
	j: integer;
	i:integer;
	temp: char;
begin
	if NOT Open(store_file, store_file_name, 'r') then begin
		Writeln('Sorry!'); HALT; end;
	Readln(Store_file,pause_amount);
	Readln(Store_file,num_rates);
	Readln(Store_file,piece_mode);
	Readln(Store_file,move_mode);
	Readln(Store_file,record_mode);
	Readln(Store_file,minitab_mode);
	if piece_mode='2' then Readln(Store_file,piece_source_name);
	if move_mode='3' then Readln(Store_file,move_source_name);
	if record_mode>'1' then Readln(Store_file,results_target_name);
	if record_mode>'2' then Readln(Store_file,piece_target_name);
	if record_mode>'3' then Readln(Store_file,move_target_name);
	if minitab_mode>'1' then Readln(Store_file,minitab_target_name);
	for j:=1 to num_rates do Readln(store_file,weights[j]);
	{sumpenalty, summatrix!}
	for j:=1 to NUMSTATES do readln(store_file,distribution[j]);
	for i:=1 to NUMSTATES do for j:=1 to 9 do readln(store_file,transits[i,j]);
	for j:=1 to NUMCOLS do Readln(store_file,tops_environment[j]);
	for j:=1 to NUMROWS do Readln(store_file,environment[j]);
	Readln(Store_file,rows_cleared);
	Readln(Store_file,pieces_placed);
	readln(store_file,pp_offs);
	Readln(Store_file,curr_height);
	for j:=1 to 4 do REadln(store_file,inbyte[j]);
	for j:=1 to 4 do REadln(store_file,outbyte[j]);
	Close(Store_file);
	if piece_mode='2' then begin
		Assign(piece_source,piece_source_name);
		reset(piece_source);
		for i:=1 to pieces_placed-1 do ReadPiece;{Warning: fails if p_p>32767!}
		end;
	if move_mode='3' then begin
		Assign(move_source,move_source_name);
		reset(move_source);
		for i:=1 to pieces_placed-1 do Read(move_source,position);{Warning: fails if p_p>32767!}
		end;
	if record_mode='4' then begin
		Assign(move_target,move_target_name);
		Append(move_target);
		end;
	if record_mode>='3' then begin
		Assign(piece_target,piece_target_name);
		reset(piece_target);
		seek(piece_target,filesize(piece_target));
		end;
	if record_mode>='2' then begin
		Assign(results_target,results_target_name);
		Append(results_target);
		RecordIt(15,0);
		WriteDateIn;
		end;
	if minitab_mode>'1' then begin
		Assign(minitab_target,minitab_target_name);
		Append(minitab_target);
		end;
end;

Procedure WriteRecord(n:integer);
begin
	if (record_mode='4') then Writeln(move_target, n);
	if (record_mode>='3') then Writepiece;
	if (record_mode>='2') then begin
		if rows_cleared=32767 then RecordIt(10,0);
		{actually this is a bug; should only write when rows CHANGE to 32767}
		end;
end;

Procedure PreWriteResults;
var	i:integer;

begin
	writeln(results_target,' ');
	writeln(results_target,'DA, version ',versno);
	WriteDateIn;
	writeln(results_target,'piece_mode=',piece_mode);
	if piece_mode='2' then begin
		write(results_target,'piece_source_name=');
		writeln(results_target,piece_source_name);
		end;
	writeln(results_target,'move_mode=',move_mode);
	if move_mode='3' then begin
		write(results_target,'move_source_name=');
		writeln(results_target,move_source_name);
		end;
	writeln(results_target,'minitab_mode=',minitab_mode);
	if minitab_mode>'1' then begin
		write(results_target, 'minitab_target_name=');
		writeln(results_target, minitab_target_name);
		end;
	writeln(results_target,'record_mode=',record_mode);
	if record_mode='4' then
		writeln(results_target,'move_target_name=',move_target_name);
	if record_mode>='3' then
		writeln(results_target,'piece_target_name=',piece_target_name);
	writeln(results_target,'this file was named ',results_target_name);
	if (move_mode='2') or (piece_mode='3') or (minitab_mode='3') then begin
		write(results_target,'penalties used: ');
		for i:=1 to num_rates do begin
			write(results_target, weights[i]);
			write(results_target,' ');
			end;
		writeln(results_target,' ');
		end;
	RecordIt(3,0);
	Flush(results_target);
end;

Procedure PreWriteMtab(t:penaltyset);
var	i:integer;
begin
	for i:=1 to num_rates do write(minitab_target,t[i],',');
end;

Procedure JustWriteMtab(t:penaltyset);
begin
	PreWriteMtab(t);
	Writeln(minitab_target,' ');
end;

Procedure WriteNumber(n:integer);
begin
	Writeln(minitab_target,n);
end;

Procedure HandleOops;
begin
	if record_mode='4' then Writeln(move_target,'-1');
		{feature not yet of any value, so not advertised}
end;

Procedure WriteoutSums;
var i,j,k:integer;
begin
	Recordit(7,0);
	k:=num_rates-2;
	for i:=1 to k+1 do begin
		for j:=1 to k+1 do begin
			write(results_target, summatrix[i,j]);
			write(results_target, ' ');
			end;
		writeln(results_target, sumpenalty[i]);
		end;
	writeln(results_target,' ');
	Flush(results_target);
end;

Procedure OneLine(t:penaltyset;n,m:integer);
begin
	PreWriteMtab(t);
	n:=n div 7;
	Writeln(minitab_target,n,',',m);
	flush(minitab_target);
end;

{**************************INITIALIZE FOLLOWS*****************************}

Procedure MakeShapeDepths(n:integer);
var	i,j,k: integer;
begin
	for j:=1 to width[n] do begin
		i:=0;
		for k:=1 to 4 do if (ys[n][k]=j) AND
			(xs[n][k]>i) then i:=xs[n][k];
		shape_depths[n][j]:=i;
		end;
end;

Procedure ReadShape(n:integer);
var	k,l: integer;
const	data: array[1..7,1..8] of integer=
		((1,1,1,2,2,1,2,2),
		(1,1,1,2,1,3,1,4),
		(1,1,1,2,2,2,2,3),
		(1,2,1,3,2,2,2,1),
		(1,1,1,2,1,3,2,1),
		(1,1,1,2,1,3,2,3),
		(1,1,1,2,1,3,2,2));
begin
	l:=1;
	if n>1 then l:=(n div 2)+1;
	if n>9 then l:=(n div 4)+3;
	for k:=1 to 4 do begin
		xs[n][k]:=data[l][2*k-1];
		ys[n][k]:=data[l][2*k];
	end;
	MakeShapeDepths(n);
end;

Procedure Rotate(n:integer);
var	k,j: integer;
begin
	for k:=1 to 4 do begin
		ys[n+1][k]:=xs[n][k];
		xs[n+1][k]:=5-ys[n][k];
		end;
	j:=5;
	for k:=1 to 4 do if xs[n+1][k]<j then j:=xs[n+1][k];
	for k:=1 to 4 do xs[n+1][k]:=xs[n+1][k]-j+1;
	j:=5;
	for k:=1 to 4 do if ys[n+1][k]<j then j:=ys[n+1][k];
	for k:=1 to 4 do ys[n+1][k]:=ys[n+1][k]-j+1;
	MakeShapeDepths(n+1);
end;

Procedure ReadTwo(n:integer);
begin
	ReadShape(n);
	Rotate(n);
end;

Procedure ReadFour(n:integer);
begin
	ReadShape(n);
	Rotate(n);
	Rotate(n+1);
	Rotate(n+2);
end;

Procedure SetKludges;
var	i,j:integer;
const	data: realmatrix=
		((26.7915,0.013,6.662, 11.5425, 18.955, 14.178, 8.266, 4.6965),
		(0.013,0.0025,0.0095,0.011,0.011,0.01,0.002,0.0025),
		(6.662, 0.0095, 3.083, 3.8075, 5.032, 5.405, 1.753, 1.378),
		(11.5425, 0.011, 3.8075, 7.5165, 8.8335, 9.418, 2.9335, 2.2515),
		(18.955, 0.011, 5.032, 8.8335, 14.4125, 10.761, 4.889, 3.5075),
		(14.178, 0.01, 5.405, 9.418, 10.761,14.634, 3.633,3.015),
		(8.266,0.002,1.753,2.9335,4.889,3.633,3.546,1.275),
		(4.6965,0.0025,1.378,2.2515,3.5075,3.015,1.275,1));
	inverse: realmatrix=
		((13.413,0,0,0,0,0,0,0),
		(-2.087,409.113,0,0,0,0,0,0),
		(0.142,-2.399,1.142,0,0,0,0,0),
		(0.515,-1.532,-0.05,1.194,0,0,0,0),
		(-13.405,2.36,-0.2,-0.984,14.089,0,0,0),
		(-0.367,1.105,-0.232,-0.542,0.575,0.486,0,0),
		(-13.058,2.383,-0.148,-0.497,12.939,0.382,13.261,0),
		(0.431,0.888,-0.531,0.683,-2.203,-0.706,-0.797,9.043));
	column: realvector=
		(1574.44, 0.86, 410.65, 685.52, 1055.64, 888.21, 548.92, 274.78);
begin
	for i:=1 to MATSIZ do for j:=1 to MATSIZ do summatrix[i,j]:=data[i,j];
	for i:=1 to MATSIZ do for j:=1 to i do
		if j=i then suminverse[i,i]:=inverse[i,i] else begin
			suminverse[i,j]:=inverse[i,j]+inverse[j,i];
			suminverse[j,i]:=suminverse[i,j];
			end;
	for i:=1 to MATSIZ do sumpenalty[i]:=column[i];
end;

Procedure DefaultWeights;
begin
	weights[1]:=0;
	weights[2]:=52;
	weights[3]:=11;
	weights[4]:=0;
	weights[5]:=23;
	weights[6]:=11;
	weights[7]:=101;
	weights[8]:=0;
	weights[9]:=0;
	weights[10]:=0;
end;

Procedure ClearMemory;
var
	i,j :integer;
begin
	pause_amount:=15000;
	num_rates:=9;{I can add at least one here without changing the CONST's}
	session_over:= FALSE;
	pieces_placed:=0;
	pp_offs:=0;
	rows_cleared:=0;
	curr_height:=0;
	for i:=1 to NUMROWS do environment[i]:=0;
	for i:=1 to NUMCOLS do tops_environment[i]:=0;
	pow_2[1]:=1;
	for i:=2 to NUMCOLS do pow_2[i]:=2*pow_2[i-1];
	ReadShape(1);
	ReadTwo(2);
	ReadTwo(4);
	ReadTwo(6);
	ReadFour(8);
	ReadFour(12);
	ReadFour(16);
	Setkludges;
	DefaultWeights; {useful if move_mode='4'}
	for i:=1 to NUMSTATES do distribution[i]:=0;
	for i:=1 to NUMSTATES do for j:=1 to 9 do transits[i,j]:=0;
	for i:=1 to 4 do inbyte[i]:=0;
	for i:=1 to 4 do outbyte[i]:=0;
end;

Procedure PrintTitle;
begin
	Writeln('                  DA -- a pattern-fitting simulation program');
	Writeln('                       Copyright (c) 1990 by David Rusin');
	Writeln('                    Based on the game NYET by David Howorth,');
	Writeln('          an emulation of the game TETRIS by A.Pajitnov and V.Gerasimov');
	Writeln('                                  Version ',versno);
	Writeln(' ');
	Writeln('                             For further help hit H');
	Writeln('                                  To quit hit Q');
	Writeln(' ');
end;

Procedure SetWeights;
var	i:integer;
	ch:char;

const	message:array[1..MAX_RATES] of string[36]=
	('tallest height','number of canyons', 'sum of canyon depths',
	'highest internal column difference','worst height difference',
	'total variation',
	'number of holes', 'sum of hole depths', 'sum of hole cover sizes',
	' ');
begin
	Writeln(' ');
	Writeln('I will need to know how to compare alternatives; please tell me');
	Writeln('   how much to penalize for certain configurations.');
	i:=1;
	while i<=num_rates do begin
		Write('Weighting to be given to ',message[i],':  ');
		Readln(weights[i]);
		if (weights[i]<-100) or (weights[i]>110) then begin
			Writeln('Please use integers less than 100 in absolute value.');
			{'integer' to speed up; 'small' to avoid overflow}
			end
		else i:=i+1;
		end;
end;

Function EstablishPieceMode:boolean; {return T/F : Recovering?}
var	recov,readnow:boolean;
begin
	recov:=FALSE;
	readnow:=TRUE;
	while readnow=TRUE do begin
		Writeln('How shall the pieces be determined?');
		Writeln('   1. Piece selected randomly');
		Writeln('   2. Piece determined by file');
		Writeln('   3. Worst possible piece selected');
		Writeln('Type R now to recover from a previous session.');
		Write('Your choice: ');
		Read(kbd, piece_mode);
		Writeln(piece_mode);
		if (piece_mode='h') then DisplayHelp;
		if (piece_mode='q') then HALT;
		if (piece_mode='r') or (piece_mode='R') then begin
			recov:=TRUE;
			readnow:=FALSE;
			end;
		if (piece_mode>='1') AND (piece_mode<='3') then readnow:=FALSE;
		end;
	If (piece_mode='2') then if (NOT Openx(piece_source,piece_source_name,'r')) then begin
		Writeln('Random creation forced');
		piece_mode:='1';
		end;
	EstablishPieceMode:=recov;
end;

Procedure EstablishMoveMode;
var	readnow:boolean;
begin
	readnow:=TRUE;
	while readnow=TRUE do begin
		Writeln(' ');
		Writeln('How shall decisions be made about placing the pieces?');
		Writeln('   1. Human chooses moves');
		Writeln('   2. Computer chooses moves');
		Writeln('   3. Moves repeated from file');
		Writeln('   4. Computer learns from experience and chooses moves');
		Writeln('   5. Like (1) but pieces fall in time.');
		Write('Your choice: ');
		Read(kbd, move_mode);
		Writeln(move_mode);
		if (move_mode='h') then DisplayHelp;
		if (move_mode='q') then HALT;
		if (move_mode='3') AND (piece_mode='1') then begin
			Writeln('Come on! I could probably handle that, but does that make any sense');
			Writeln('   when the pieces are selected randomly?');
			move_mode:='0';
			end;
		if move_mode='4' then begin
			Writeln('Sorry - feature not yet operational');
			move_mode:='0';
			end;
		if (move_mode>='1') AND (move_mode<='5') then readnow:=FALSE;
		end;
	if (move_mode='3') then
		if (NOT Open(move_source,move_source_name,'r')) then begin
			Writeln('Manual entry required');
			move_mode:='1';
			end;
end;

Procedure EstablishMinitabMode;
var	readnow:boolean;
begin
	readnow:=TRUE;
	while readnow=TRUE do begin
		Writeln(' ');
		Writeln('What information about current environment should be stored in a file with each move?');
		Writeln('   1. Nothing');
		Writeln('   2. Assessments of all penalties for current configuration');
		Writeln('   3. (2), and average and worst total penalties for next piece');
		Writeln('   4. like (2) but only recording current max. height');
		Writeln('   5. (2), and, periodically, the regression-frequency matrix');
		Writeln('   6. (3) and (5) as appropriate');
		Write('Your choice: ');
		Read(kbd, minitab_mode);
		Writeln(minitab_mode);
		if minitab_mode>'4' then Writeln('Sorry, feature not yet operational');
		if (minitab_mode>='1') AND (minitab_mode<='4') then readnow:=FALSE;
		if (minitab_mode='h') then DisplayHelp;
		if (minitab_mode='q') then HALT;
		end;
	if (minitab_mode>'1') then if (NOT Open(minitab_target, minitab_target_name,'w')) then begin
		Writeln('We''ll just skip the Minitab part, what do you say?');
		minitab_mode:='1';
		end;
end;

Procedure EstablishRecordMode;
var	readnow:boolean;
begin
	readnow:=TRUE;
	while readnow=TRUE do begin
		Writeln(' ');
		Writeln('What kind of record should we make of this session?');
		Writeln('       1. None');
		Writeln('       2. Just a summary of important activity');
		Writeln('       3. (2) and a record of which pieces appeared');
		Writeln('       4. (3) and a record of where the pieces were placed');
		Read(kbd, record_mode);
		Writeln('Your choice: ',record_mode);
		if (record_mode='h') then DisplayHelp;
		if (record_mode='q') then HALT;
		if (record_mode>='1') AND (record_mode<='4') then readnow:=FALSE;
		end;
	if (record_mode>='2') then begin
		Write('Name of file into which to record results? ');
		if NOT Open(results_target,results_target_name,'w') then record_mode:='1';
		end;
	if (record_mode>='3') then begin
		Write('Name of file into which to record pieces? ');
		if NOT Openx(piece_target,piece_target_name,'w') then record_mode:='1';
		end;
	if (record_mode>='4') then begin
		Write('Name of file into which to record moves? ');
		if NOT Open(move_target,move_target_name,'w') then record_mode:='1';
		end;
end;

Procedure Initialize;
var	restart: boolean;

begin {Initialize}
	ClearMemory;
	ClrScr;
	PrintTitle;
	restart:=EstablishPieceMode;
	if restart=TRUE then Recover;
	if restart=FALSE then begin
		EstablishMoveMode;
		EstablishMinitabMode;
		EstablishRecordMode;
		if ((piece_mode='3') and (move_mode>'1') and (move_mode<'5'))
			or (move_mode='2') or (minitab_mode='3') then SetWeights;
		if record_mode>'1' then PreWriteResults;
		end;
	MakeWritingZones;
end;

{*******************ONCE-PER-PIECE STUFF FOLLOWS***********************}
Procedure ShowMove(pos, dr: integer);

Procedure GoSlow;
var	rotation, dis:integer;
begin
	rotation:=(pos-1) div NUMCOLS;
	dis:=pos-(rotation)*NUMCOLS - 1;
	shape:=first_shape[piece];
	Make_xys;
	displacement:=(NUMCOLS-width[shape]) div 2;
	UnWriteTemplate(-2,displacement);
	shape:=first_shape[piece]+((pos-1) div NUMCOLS);
	Make_xys;
	WriteTemplate(-2, dis);
	pause;
	UnWriteTemplate(-2, dis);
	WriteTemplate(dr, dis);
	pause;
end;

begin {showmove}
	if pause_amount>0 then GoSlow {else ClearTemplateSpot};
	WriteRecord(pos);
end;

Procedure ResetVariables;
begin
	session_over:=FALSE;
	shape:=first_shape[piece];
	drop:=-2;
	Make_xys;
end;

{**REMARK: "NEXTPIECE" SHOULD BE HERE TOO BUT IT INVOKES FIGUREPENALTIES**}
{****NOTE! Stuff from here on out is what needs to be optimized for speed!***}

{****************************PRETTYGRID FOLLOWS*****************************}

Function PrettyGrid(h:integer; var m:grid; var t:depths): integer;
{clears rows, adjusts tops, and returns number of rows cleared}

var	r, number:integer;
	found_full_row, found_empty_row: boolean;

Procedure AdjustTops;
var	j,k:integer;
	NotDone:boolean;
begin
	for j:=1 to NUMCOLS do begin
		k:=t[j];
		NotDone:=TRUE;
		while NotDone do begin
			k:=k-1;
			if k<1 then NotDone:=FALSE else
				if JthSpot(m[k],j)=1 then NotDone:=FALSE;
			end;
		t[j]:=k;
		end;
end;

Procedure ClearOneRow(n:integer);
var	i:integer;
begin
	for i:=n to h-1 do m[i]:=m[i+1];
	m[h]:=0;
	number:=number+1;
	AdjustTops;
end;

begin {PrettyGrid}
	number:=0;
	r:=0;
	repeat begin
		if m[r]=FULLROW then ClearOneRow(r) else r:=r+1;
		end
		until (r>h) OR (m[r]=0);
	PrettyGrid:=number;
end;

{**************************REQUESTMOVES FOLLOWS*****************************}

Function AddPiece(var m:grid; var t:depths):integer;
{returns greatest of heights that had to be adjusted}
var	newmax,i,a,b:integer;
begin
	newmax:=0;
	for i:=1 to 4 do begin
		a:=NUMROWS+1-latest_xs[i]-drop;
		b:=latest_ys[i]+displacement;
		if a>t[b] then begin
			t[b]:=a;
			if a>newmax then newmax:=a;
			end;
		m[a]:=m[a]+pow_2[b];
		end;
		AddPiece:=newmax;
end;

Procedure HandleInterrupt;
var ch:char;
begin
	Read(kbd,ch);
	if (ch='q') or (ch='Q') then AbEnd;
	if (ch='b') or (ch='b') then Break;
	if ((ch='h') or (ch='H')) then begin
		DisplayHelp;
		MakeWritingZones;
		ShowEnvironment;
		end;
	if (ch='o') or (ch='O') then HandleOops;
	if ch=#27 then begin
		MessageIt(7,2);
		repeat ch:=#00 until KeyPressed;
		EraseMessage;
		end;
	if (ch='f') or (ch='F') then pause_amount:=0;
	if (ch='+') then pause_amount:=(pause_amount) div 2;
	if (ch='-') and (pause_amount<7000)
		then pause_amount:=(2*pause_amount);
	if (ch='-') and (pause_amount=0) then pause_amount:=100;
	if (ch='s') or (ch='S') then pause_amount:=15000;
end;

Procedure RequestMoves;
var	keep_reading:boolean;
	possible_drop, rotation, new_shape, new_drop,
		new_displacement,pg,new_max:integer;

Function SetPossDrop(t:depths): boolean;
begin
	possible_drop:=DropAmnt(t, new_shape,new_displacement);
	if possible_drop<=0 then SetPossDrop:=FALSE else SetPossDrop:=TRUE;
end;

Function ChoiceAcceptable: boolean;
var	sofar: boolean;
begin
	sofar:=TRUE;
	if new_displacement <0 then sofar:=FALSE;
	if new_displacement > NUMCOLS-width[new_shape] then sofar:=FALSE;
	if SetPossDrop(tops_environment) then sofar:=sofar; {i.e., calculate poss_drop}
	if (new_drop < -2) or (possible_drop< 0) then sofar:=FALSE;
	if (new_drop > possible_drop) then sofar:=FALSE;
	ChoiceAcceptable:=sofar;
end;

Procedure DisplayNewSpot;
begin
	UnWriteTemplate(drop,displacement);
	shape:=new_shape;
	drop:=new_drop;
	displacement:=new_displacement;
	Make_xys;
	WriteTemplate(drop,displacement);
end;

Procedure ConsiderDoing(ch:char);
begin
	if ch=' ' then begin
		keep_reading:=FALSE;
		new_drop:=possible_drop;
		EraseMessage; {need to erase this sometimes}
		end;
	if (ch='o') or (ch='O') then HandleOops;
	if (ch='7') or (ch='j') or (ch='J') then new_displacement:=displacement-1;
	if (ch='9') or (ch='l') or (ch='L') then new_displacement:=displacement+1;
	if (ch=#27) then begin
		MessageIt(7,2);
		repeat ch:=#00 until KeyPressed;
		EraseMessage;
		end;
	if (ch='q') or (ch='Q') then AbEnd;
	if (ch='b') or (ch='b') then Break;
	if ((ch='i') or (ch='I')) then if NOT (move_mode='5') then new_drop:=drop-1;
	if ((ch='n') or (ch='N')) then new_drop:=drop+1;
	if ((ch='8') or (ch='k') or (ch='K')) then begin
		if shape+1<first_shape[piece+1] then
			new_shape:=shape+1
			else new_shape:=first_shape[piece];
		end;
	if (ch='+') then pause_amount:=pause_amount-200;
	if ((ch='h') or (ch='H')) then begin
		DisplayHelp;
		MakeWritingZones;
		ShowEnvironment;
		end;
	if ChoiceAcceptable then DisplayNewSpot;
end;

Procedure AskNextChoice;
var	ch:char;
begin
	if (possible_drop=drop) or (possible_drop<=0) then ch:=' ' else Read(Kbd, ch);
	ConsiderDoing(ch);
end;

Procedure InsistNextChoice;
var	count:integer;
	ch:char;
begin
	ch:='n';
	if pause_amount>2000-20*rows_cleared then pause_amount:=2000-20*rows_cleared;
	if pause_amount<1 then pause_amount:=1;
	ShowSpeed(100-((pause_amount+10) div 20));
	count:=pause_amount;
	while (count>0) do begin
		count:=count-1;
		if KeyPressed then begin read(kbd,ch); count:=0;end;
		end;
	if possible_drop=drop then considerdoing(' ') else ConsiderDoing(ch);
end;

Procedure RecallChoice;
var	rotation:integer;
begin
	while KeyPressed do Handleinterrupt;
	keep_reading:=FALSE;
	repeat Readln(move_source, position) until position >=0;
	{unused feature: I wanted to allow recording '-1' for a poor move}
	if position=0 then begin
		RecordIt(8,0);
		MessageIt(5,2);
		move_mode:='4';
		ShowMoveMode;
		EraseKeyBox;
		FillKeyBox;
		end;
	rotation:=(position-1) div NUMCOLS;
	new_displacement:=position-(rotation)*NUMCOLS - 1;
	new_shape:=first_shape[piece] + rotation;
	new_drop:=-2;
	Pause;
	DisplayNewSpot;
	if SetPossDrop(tops_environment) then new_drop:=possible_drop;
	Pause;
	DisplayNewSpot;
end;

begin {requestmoves}
	keep_reading:=TRUE;
	repeat begin
		new_shape:=shape;
		new_drop:=drop;
		new_displacement:=displacement;
		if NOT SetPossDrop(tops_environment) then session_over:=TRUE;
		if move_mode='1' then AskNextChoice;
		if move_mode='5' then InsistNextChoice;
		if move_mode='3' then RecallChoice;
		end
	until keep_reading=FALSE;
	new_max:=AddPiece(environment, tops_environment);
	if new_max>curr_height then curr_height:=new_max;
	pg:=PrettyGrid(curr_height,environment,tops_environment);
	rows_cleared:=rows_cleared+pg;
	curr_height:=curr_height-pg;
	if record_mode>='2' then begin
		rotation:=new_shape-first_shape[piece];
		position:=(rotation)*NUMCOLS+new_displacement+1;
		WriteRecord(position);
		end;
end;

{**************************EVALUATE FOLLOWS*************************}

Function Canyon(a,b,c: integer):integer;
var	temp: integer; {this one can be negative!}
begin
	temp:=a-b;
	if temp>c-b then temp:=c-b;
	if temp<0 then temp:=0;
	Canyon:=temp;
end;

Procedure FigurePenalties(var m:grid; var p:penaltyset; t:depths);
var	i,j,k,a,c,ohead,startvalley, endvalley, min, max: integer;
begin
	for k:=1 to MAX_RATES do p[k]:=0;
	{rating #1 = height of tallest column}
	{rating #2 = no. of canyons of depth > 2}
	{rating #3 = total depths of all canyons}
	{rating #4 = max height diff within valley}
	{rating #5 = max diff between highest and lowest - measures waviness. ~canyons.}
	{First find the valley}
	startvalley:=1;
	while (startvalley<NUMCOLS) AND (t[startvalley]>=t[startvalley+1]) do
		startvalley:=startvalley+1;
	endvalley:=NUMCOLS;
	while (endvalley>1) AND (t[endvalley]>=t[endvalley-1]) do
		endvalley:=endvalley-1;
	max:=0;
	min:=NUMROWS+1;
	{Now scan the valley}
	for k:=startvalley to endvalley do begin
		if t[k]<min then min:=t[k];
		if t[k]>max then max:=t[k];
		if k=1 then a:=NUMROWS+1 else a:=t[k-1];
		if k=NUMCOLS then c:=NUMROWS+1 else c:=t[k+1];
		j:=Canyon(a,t[k],c);
		if j>2 then p[2]:=p[2]+1;
		p[3]:=p[3]+j;
		if k<endvalley then p[6]:=p[6]+abs(t[k]-t[k+1]);
		end;
	p[4]:=max-min;
	p[6]:=p[6]-(t[startvalley]-min)-(t[endvalley]-min);
	{note: any u-shaped region has this penalty = 0}
	if startvalley>endvalley then begin
		{a single valley with flat bottom at least 2 spaces wide}
		if t[endvalley]<t[startvalley] then min:=t[endvalley] else min:=t[startvalley];
		max:=min;
		p[4]:=0;
		{p[2]:=p[3]:=0}
		p[6]:=0;
		end;
	{now the top-penalties not valley-specific}
	if t[1]>max then max:=t[1];
	if t[NUMCOLS]>max then max:=t[NUMCOLS];
	p[5]:=max-min;
	p[1]:=max;
	{}
	{Now hole penalties}
	for j:=1 to NUMCOLS do begin
		ohead:=1;
		for i:=t[j]-1 downto 1 do
			if JthSpot(m[i],j)=0 then begin
				p[7]:=p[7]+1;
				p[8]:=p[8]+(t[j]-i);
				p[9]:=p[9]+ohead;
				end
			else ohead:=ohead+1;
		end;
end;


{*****************************NEXTPIECE FOLLOWS**************************}

Procedure NextPiece;
var	t:penaltyset;
begin
	pieces_placed:=pieces_placed+1;
	if (pieces_placed=32767) then begin
		RecordIt(9,0);
		IncreaseOffs;
		end;
	WritePP;
	if pause_amount>0 then ShowEnvironment;
	if minitab_mode='2' then begin
		FigurePenalties(environment,t,tops_environment);
		JustWriteMtab(t);
		end;
	if minitab_mode='4' then WriteNumber(curr_height);
	distribution[curr_height+1]:=distribution[curr_height+1]+1;
	if piece_mode='1' then piece:=random(7)+1;
	if piece_mode='2' then Readpiece;
	{if piece_mode='3' then piece has been set in ConsiderOtherPieces}
	if piece=0 then begin
		piece_mode:='1';
		ShowPieceMode;
		piece:=1;{why make programming hard?}
		MessageIt(1,2);
		Recordit(2,0);
		end;
	ResetVariables;
	displacement:=(NUMCOLS-width[shape]) div 2;
	if NOT (piece_mode='3') then if pause_amount>0 then
		WriteTemplate(-2,displacement);
end;

{**************************ChooseBestMove FOLLOWS*************************}

Procedure Copygrid(var m,n: grid);
var	i: integer;
begin
	for i:=1 to NUMROWS do n[i]:=m[i];
end;

Procedure Copytops(var m,n: depths);
var	j: integer;
begin
	for j:=1 to NUMCOLS do n[j]:=m[j];
end;

Procedure ChooseBestMove2(var best_penalty:integer; var best_position,best_drop:integer);
var	alt_rows_cleared, best_rows_cleared, penalty: integer;
	best_displacement,best_height,pg,alt_height,new_max: integer;
	positions_remain: boolean;
	alternative:array[1..NUMPOSITION] of grid;
	t:array[1..NUMPOSITION] of depths;

Procedure Restart;
var	rotation:integer;
begin
	while Keypressed do HandleInterrupt;
	positions_remain:=TRUE;
	position:=1;
	rotation:=0;
	displacement:=0;
	drop:=0;
	session_over:=TRUE;
	best_penalty:=10000;
end;

Procedure NextPosition;
var	rotation:integer;
begin
	position:=position+1;
	drop:=0;
	displacement:=displacement+1;
	if displacement>NUMCOLS-width[shape] then begin
		displacement:=0;
		shape:=shape+1;
		rotation:=shape-first_shape[piece];
		position:=1+NUMCOLS*rotation;
		if shape = first_shape[piece+1] then positions_remain:=FALSE
			else Make_xys;
	end;
end;

Procedure UpdateBest;
begin
	best_penalty:=penalty;
	best_position:=position;
	best_drop:=drop;
	best_displacement:=displacement;
	best_rows_cleared:=alt_rows_cleared;
	best_height:=alt_height;
end;

Function Evaluate:integer;
var	penalties:penaltyset;
	k:integer;
	penalty:integer;
begin
	FigurePenalties(alternative[position],penalties,t[position]);
	penalty:=0;
	for k:=1 to num_rates do penalty:=penalty+penalties[k]*weights[k];
	if penalties[1]>NUMROWS then penalty:=10000;
		{kludge: should conclude here that piece didn't fit}
	Evaluate:=penalty;
end;

begin {ChooseBestMove2}
	Restart;
	repeat begin
		Copygrid(environment,alternative[position]);
		CopyTops(tops_environment,t[position]);
		alt_height:=curr_height;
		drop:=DropAmnt(tops_environment, shape,displacement);
		if drop>=0 then begin
			session_over:=FALSE;
			new_max:=AddPiece(alternative[position],t[position]);
			if new_max>alt_height then alt_height:=new_max;
			pg:=PrettyGrid(alt_height,alternative[position],t[position]);
			alt_rows_cleared:=rows_cleared+pg;
			alt_height:=alt_height-pg;
			penalty:=Evaluate;
			if penalty < best_penalty then UpDateBest;
			end;
		NextPosition;
		end
	until positions_remain=FALSE;
	curr_height:=best_height;
	rows_cleared:=best_rows_cleared;
	Copygrid(alternative[best_position], environment);
	CopyTops(t[best_position],tops_environment);
end;

Procedure ChooseBestMove;
var	dum1:integer; {penalty, position, drop}
	dum2,dum3:integer;
begin
	ChooseBestMove2(dum1,dum2,dum3);
	Showmove(dum2,dum3);
	if (dum1=0) then begin
		Recordit(3,0); 
		ShowDistribution;
		end;
end;

{***************************MATRIX STUFF FOLLOWS****************************}
Procedure Cmult(a:realmatrix; b:realvector; var c:realvector);
var	d:realvector;
	i,j:integer;
begin
	for i:=1 to MATSIZ do begin
		d[i]:=0;
		for j:=1 to MATSIZ do d[i]:=d[i]+a[i,j]*b[j];
		end;
	for i:=1 to MATSIZ do c[i]:=d[i];
end;

Procedure MMult(a,b:realmatrix; var c:realmatrix);
var	d:realmatrix;
	i,j,k:integer;
begin
	for i:=1 to MATSIZ do for j:=1 to MATSIZ do begin
		d[i,j]:=0;
		for k:=1 to MATSIZ do d[i,j]:=d[i,j]+a[i,k]*b[k,j];
		end;
	for i:=1 to MATSIZ do for j:=1 to MATSIZ do c[i,j]:=d[i,j];
end;

Procedure IsolateError(var a:realmatrix);
var	i,j: integer;
begin
	for i:=1 to MATSIZ do for j:=1 to MATSIZ do
		if i=j then a[i,j]:=1-a[i,j] else a[i,j]:=-a[i,j];
end;

Procedure MInvert(var a:realmatrix);{quick inversion if 1+a if a is small}
const	tolerance=0.0000001;
var	b,c:realmatrix;
	numtrials: integer;
	i,j:integer;
	doagain:boolean;
begin
	for i:=1 to MATSIZ do for j:=1 to MATSIZ do b[i,j]:=0;
	for i:=1 to MATSIZ do b[i,j]:=1;
	doagain:=TRUE;
	numtrials:=0;
	while (doagain=TRUE) AND (Numtrials < 100) do begin
		Mmult(a,b,c);
		for i:=1 to MATSIZ do c[i,i]:=c[i,i]+1;
		doagain:=FALSE;
		for i:=1 to MATSIZ do for j:=1 to MATSIZ do if abs(c[i,j]-b[i,j])>tolerance
			then doagain:=TRUE;
		for i:=1 to MATSIZ do for j:=1 to MATSIZ do b[i,j]:=c[i,j];
		numtrials:=numtrials+1;
		end;
	{
	if numtrials=100 then MessageIt(3,1);
	shouldnt happen: if a_max<.1, then (a^100)_max<2x10^-11}
	if (numtrials>20) then Recordit(4,numtrials);
	for i:=1 to MATSIZ do for j:=1 to MATSIZ do a[i,j]:=b[i,j];
end;
{more matrix stuff in ConsiderOtherPieces proper}
{**************************ConsiderOtherPieces FOLLOWS*****************************}

Procedure ConsiderOtherPieces;
var	real_piece, worst_piece: integer;
	worst_penalty:integer;
	r_c,c_h:array[1..8] of integer;
	b_p,b_d:array[1..8] of integer;
	keepgrid:array[1..8] of grid;
	keeptops: array[1..8] of depths;
	pieces_best_penalty: integer;
	t:depths;
	orig_rates:penaltyset;
	ave_penalty: integer; {rounded off after computing a sum}

Procedure AdjustInverse;
var	temp:realmatrix;
	tempo:realvector;
	r:integer;
	i,j:integer;
	change:boolean;
begin
	MMult(suminverse, summatrix, temp);
	IsolateError(temp);{temp:=I-temp}
	MInvert(temp);{temp:=I=temp+temp^2+temp^3+...}
	MMult(temp,suminverse,suminverse);
	CMult(suminverse,sumpenalty,tempo);
	change:=FALSE;
	for i:=1 to num_rates-2 do begin
		r:=round(tempo[i]);
		if (r<>weights[i]) then change:=TRUE;
		{if r<=0 then r:=1 else}
		weights[i]:=r;
		end;
	if change=TRUE then Recordit(1,0);
end;

Procedure AdjustMatrix;
var	i,j,k:integer;
	temp:realmatrix;
	tempo:realvector;
	max,r:real;
begin
	r:=0.0005;{will keep variation of weights to a min. ALso guarantees
			convergence of MINVERT if max (c_i) < 14}
	max:=0;
	k:=num_rates -2;
	for i:=1 to k do begin
		for j:=1 to i do begin
			temp[i,j]:=-summatrix[i,j]+orig_rates[i]*orig_rates[j];
			temp[j,i]:=temp[i,j];
			if (temp[i,j])>max then max:=abs(temp[i,j]);
			end;
		temp[i,k+1]:=-summatrix[i,k+1]+orig_rates[i];
		temp[k+1,i]:=temp[i,k+1];
		if (temp[i,k+1])>max then max:=abs(temp[i,k+1]);
		tempo[i]:=-sumpenalty[i]+orig_rates[i]*ave_penalty;
		end;
	tempo[k+1]:=-sumpenalty[k+1]+ave_penalty;
	temp[k+1,k+1]:=0;
	if (r*max>0.1 ) then begin
		r:=0.1/max;
		{else, won't be able to guarantee convergence!}
		Recordit(5,round(max));
		end;
	for i:=1 to k+1 do for j:=1 to k do summatrix[i,j]:=summatrix[i,j]+r*temp[i,j];
	for i:=1 to k+1 do sumpenalty[i]:=sumpenalty[i]+r*tempo[i];
end;

Procedure PutAway(n:integer);
begin
	r_c[n]:=rows_cleared;
	c_h[n]:=curr_height;
	CopyGrid(environment, keepgrid[n]);
	CopyTops(tops_environment,keeptops[n]);
end;

Procedure BringBack(n:integer);
begin
	rows_cleared:=r_c[n];
	curr_height:=c_h[n];
	CopyGrid(keepgrid[n], environment);
	CopyTops(keeptops[n], tops_environment);
end;

Procedure ChangeTransits;
var	n:integer;
begin
	for n:=1 to 7 do
		transits[c_h[8]+1,c_h[n]-c_h[8]+5]:=
			transits[c_h[8]+1,c_h[n]-c_h[8]+5]+1;
end;

begin {ConsiderOtherPieces}
	MessageIt(9,1);
	if piece_mode='3' then ClearTemplateSPot;
	worst_penalty:=0;
	ave_penalty:=0;
	real_piece:=piece;
	if (minitab_mode>'1') or (move_mode='4') then
		FigurePenalties(environment,orig_rates,tops_environment);
	PutAway(8);
	for piece:=1 to 7 do begin
		ResetVariables;
		BringBack(8);
		ChooseBestMove2(pieces_best_penalty,b_p[piece],b_d[piece]);
		ave_penalty:=ave_penalty+pieces_best_penalty;
		if pieces_best_penalty>worst_penalty then begin
			worst_penalty:=pieces_best_penalty;
			worst_piece:=piece;
			end;
		PutAway(piece);
		end;
	if (minitab_mode='3') and (worst_penalty<10000) then
		OneLine(orig_rates,ave_penalty,worst_penalty);
	if move_mode='4' then begin
		AdjustMatrix; {this may be desirablle inother modes too}
		AdjustInverse;
		if (pieces_placed mod 2000 = 0) then WriteOutSums;{ditto}
		end;
	if piece_mode='3' then piece:=worst_piece else piece:=real_piece;
	if pause_amount>0 then begin
		shape:=first_shape[piece];
		Make_xys;
		displacement:=(NUMCOLS-width[shape]) div 2;
		WriteTemplate(-2,displacement);
		drop:=-2;
{		pause;		position:=b_p[piece];}{use this when computer is making decsions, not }
{player; but follow with ShowMove or something}
		end;
	if (move_mode='2') or (move_mode='4') then begin
		BringBack(piece);
		if (record_mode>'1') and (minitab_mode='3') then ChangeTransits;
		EraseMessage;
		Showmove(b_p[piece], b_d[piece]);
		end
	else begin
		BringBack(8);
		EraseMessage;
		RequestMoves;
		end;
end;

Function set1:boolean;
{i.e., does the computer need to consider all the possible pieces that might fall?}
begin
	if (piece_mode='3') or (minitab_mode='3') then set1:=TRUE else set1:=FALSE;
end;

Function Set2:boolean;
{i.e., does the computer need to compute the moves on some basis?}
begin
	if ((move_mode='2') or (move_mode='4')) then set2:=TRUE else set2:=FALSE;
end;

{**************************MAIN PROGRAM FOLLOWS*****************************}

BEGIN
	Initialize;
	while session_over=FALSE do begin
		NextPiece;
		if (set1) then ConsiderOtherPieces;
		if (NOT set1) AND (set2) then ChooseBestMove;
		if (NOT set1) AND (NOT set2) then RequestMoves;
	end;
	RecordIt(13,0);
	Finish;
END.