--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/console.pas	Sun Dec 08 19:39:15 2013 +0100
@@ -0,0 +1,340 @@
+{ 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.
+