{ Display and input routines. }

UNIT Console;

INTERFACE

USES Porting;

CONST	MSGCOL:BYTE=6;	{ Default messages color. }

PROCEDURE Msg(m:STRING);	{ Displays string as a message on the right of the screen. }
PROCEDURE Txt(m:STRING);	{ Displays string as a text on the left of the screen. }
PROCEDURE Stat(m:STRING);	{ Displays string in the upper right part of the screen. }
PROCEDURE PrepScr;		{ Prepares screen (actually does nothing) }
PROCEDURE ResetScr;		{ Brings the screen to previous condition. }
PROCEDURE ClrMsg;		{ Clears the messages window. }
PROCEDURE ClrTxt;		{ Clears the text/map window. }
PROCEDURE PutChr(x,y: INTEGER; c:CHAR; a:BYTE);	{ Displays a character on the screen. }
PROCEDURE Cursor(x,y: INTEGER);	{ Changes cursor position. }

FUNCTION  GetKey:CHAR;		{ Reads a character from keyboard. }
FUNCTION  GetString(l:BYTE):STRING;	{ Allows to input a string. L sets maximum string length. }

FUNCTION  Number(n: INTEGER):STRING;	{ Converts number into a string, three characters long. }
FUNCTION  Num(n: INTEGER):STRING;	{ Converts number into a string. }
FUNCTION  Replace(s,a,b:STRING):STRING;	{ Replaces the first occurance of A in string S with B. }
FUNCTION  Capitalize(s:STRING): STRING;	{ Changes the first letter in the string to upper case. }
FUNCTION  Plural(s:STRING):STRING;	{ Replaces '@s' and makes proper plural form. }

IMPLEMENTATION

VAR	nnl: BOOLEAN;		{ No new line -- should next msg change line? }
	line,txtline: INTEGER;

FUNCTION Capitalize(s:STRING):STRING;
VAR	t: STRING;
BEGIN
	IF s='' THEN Exit;
	t:=s;
	t[1]:=UpCase(t[1]);
	Capitalize:=t;
END;

FUNCTION Plural(s:STRING):STRING;
BEGIN
	s:=Replace(s, 'y@s' , 'ies'  );
	s:=Replace(s, 'fe@s', 'ves'  );
	s:=Replace(s, 'ff@s', 'ves'  );
	s:=Replace(s, 'ex@s', 'icies');
	s:=Replace(s, 'va@s', 'vae'  );
	s:=Replace(s, 's@s' , 'ses'  );
	s:=Replace(s, '@s'  , 's'    );
	
	Plural:=s;
END;

FUNCTION Replace(s,a,b:STRING):STRING;
VAR	d: INTEGER;
BEGIN
	d:=Pos(a,s);
	Replace:=s;
	IF d<=0 THEN Exit;
	Delete(s,d,Length(a));
	Insert(b,s,d);
	Replace:=s;
END;


PROCEDURE PutChr(x,y: INTEGER;c: CHAR; a:BYTE);
BEGIN
	IF (NOT pal_changed) THEN BEGIN
		IF (a=14) THEN a:=6;
		IF (a=13) THEN a:=14;
	END;
	PutChar(x,y,c,a);
END;

PROCEDURE Cursor(x,y: INTEGER);
BEGIN
	GotoXY(x,y);
END;

PROCEDURE ClrMsg;
VAR	x,y: INTEGER;
BEGIN
	FOR y:=5 TO 24 DO
		FOR x:=50 TO 79 DO PutChar(x,y,' ',$07);
	line:=0;
	nnl:=TRUE;
END;

PROCEDURE Msg(m:STRING);
VAR	i,p: INTEGER;
	a,l: BYTE;

PROCEDURE NewLine;
BEGIN
	IF line>=19 THEN ScrollWin(50,5,79,24)
		    ELSE Inc(line);
	i:=0;
END;

BEGIN
	IF NOT nnl THEN NewLine ELSE BEGIN
		FOR i:=50 TO 79 DO PutChar(i,line+5,' ',MSGCOL);
		i:=0;
	END;
	nnl:=FALSE;
	p:=1;
	a:=MSGCOL;
	l:=Length(m);
	REPEAT
		WHILE m[p]='@' DO BEGIN
			Inc(p);
			CASE m[p] OF
				'd': a:=0;
				'b': a:=1;
				'g': a:=2;
				'c': a:=3;
				'r': a:=4;
				'p': a:=5;
				'o': a:=6;
				'w': a:=7;
				'D': a:=8;				
				'B': a:=9;
				'G': a:=10;				
				'C': a:=11;
				'R': a:=12;				
				'P': a:=13;
				'O': a:=14;				
				'W': a:=15;
				'm': a:=MSGCOL;	
				'M': a:=MSGCOL XOR $08;
				'n': NewLine;
				'N': nnl:=TRUE;
				'@': Break;
			END;
			Inc(p);
		END;
		IF p>l THEN Exit;
		IF i>29 THEN NewLine;
		PutChar(50+i,line+5,m[p],a);
		Inc(i);
		Inc(p);
	UNTIL FALSE;
END;

PROCEDURE ClrTxt;
VAR	x,y: INTEGER;
BEGIN
	FOR y:=0 TO 24 DO
		FOR x:=0 TO 49 DO PutChar(x,y,' ',$07);
	txtline:=-1;
END;


PROCEDURE Txt(m:STRING);
VAR	i,p: INTEGER;
	a,l: BYTE;

PROCEDURE NewLine;
BEGIN
	IF txtline>=24 THEN ScrollWin(0,0,49,24)
		       ELSE Inc(txtline);
	i:=0;
END;

BEGIN
	NewLine;
	p:=1;
	a:=MSGCOL;
	l:=Length(m);
	REPEAT
		WHILE m[p]='@' DO BEGIN
			Inc(p);
			CASE m[p] OF
				'd': a:=0;
				'b': a:=1;
				'g': a:=2;
				'c': a:=3;
				'r': a:=4;
				'p': a:=5;
				'o': a:=6;
				'w': a:=7;
				'D': a:=8;				
				'B': a:=9;
				'G': a:=10;				
				'C': a:=11;
				'R': a:=12;				
				'P': a:=13;
				'O': a:=14;				
				'W': a:=15;
				'm': a:=MSGCOL;	
				'M': a:=MSGCOL XOR $08;
				'n': NewLine;
				'@': Break;
			END;
			Inc(p);
		END;
		IF p>l THEN Exit;
		IF i>49 THEN NewLine;
		PutChar(i,txtline,m[p],a);
		Inc(i);
		Inc(p);
	UNTIL FALSE;
END;

FUNCTION GetString(l:BYTE):STRING;
VAR	c: CHAR;
	s: STRING;
	i: INTEGER;
	a: BYTE;

PROCEDURE NewLine;
BEGIN
	IF line>=19 THEN ScrollWin(50,5,79,24)
		    ELSE Inc(line);
	i:=0;
END;

BEGIN
	IF l=0 THEN Exit;
	IF l>30 THEN l:=30;
	
	IF NOT nnl THEN NewLine ELSE BEGIN
		FOR i:=50 TO 79 DO PutChar(i,line+5,' ',MSGCOL);
		i:=0;
	END;


	a:=MSGCOL XOR $08;
	nnl:=TRUE;

	s:='';
	i:=0;
	REPEAT
		GotoXY(50+i,line+5);
		c:=GetKey;
		IF (i<l) AND (c>=' ') AND (c<#127) THEN BEGIN
			s:=Concat(s,c);
			PutChar(50+i,line+5,c,a);
			Inc(i);
		END;
		IF c=KEYCHR_BS THEN BEGIN
			IF i>0 THEN Dec(i);
			PutChar(50+i,line+5,' ',a);
			s:=Copy(s,1,length(s)-1);
		END;
	UNTIL (c=KEYCHR_CR);
	GetString:=s;
END;

PROCEDURE Stat(m:STRING);
VAR	a: BYTE;
	i,p: INTEGER;

PROCEDURE NewLine;
BEGIN
	ScrollWin(50,0,79,4);
	i:=0;
END;

BEGIN
	NewLine;
	p:=1;
	a:=MSGCOL;
	REPEAT
		WHILE m[p]='@' DO BEGIN
			Inc(p);
			CASE m[p] OF
				'd': a:=0;
				'b': a:=1;
				'g': a:=2;
				'c': a:=3;
				'r': a:=4;
				'p': a:=5;
				'o': a:=6;
				'w': a:=7;
				'D': a:=8;				
				'B': a:=9;
				'G': a:=10;				
				'C': a:=11;
				'R': a:=12;				
				'P': a:=13;
				'O': a:=14;				
				'W': a:=15;
				'm': a:=MSGCOL;
				'M': a:=MSGCOL XOR $08;
				'n': NewLine;
				'v': ;
				'@': Break;
			END;
			Inc(p);
		END;
		IF i>29 THEN NewLine;
		PutChar(50+i,4,m[p],a);
		Inc(p);
		Inc(i);
	UNTIL (p>Length(m));
END;

FUNCTION Number(n: INTEGER):STRING;
VAR	s: STRING[3];
BEGIN
	Str(n:3,s);
	Number:=s;
END;

FUNCTION Num(n: INTEGER):STRING;
VAR	s: STRING;
BEGIN
	Str(n,s);
	Num:=s;
END;

PROCEDURE PrepScr;
VAR	x,y: INTEGER;
BEGIN
{	FOR y:=0 TO 24 DO
		FOR x:=0 TO 79 DO PutChar(x,y,' ',$07);}
END;

PROCEDURE ResetScr;
VAR i,x,y:BYTE;
BEGIN
	FOR y:=0 TO 24 DO FOR x:=0 TO 79 DO PutChar(x,y,' ',$07);
	GotoXY(0,0);
	ResetPal;
END;

FUNCTION GetKey:CHAR;
BEGIN
	GetKey:=GetChr;
END;

BEGIN
	line:=0;
	nnl:=TRUE;
END.