perm filename DITEST.PAS[EAL,HE] blob sn#674798 filedate 1982-09-27 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	{ Routines to test the DISP.MAC routines }
C00004 00003
C00010 ENDMK
CāŠ—;
{ Routines to test the DISP.MAC routines }

type 
    ascii = char;
    asc10 = packed array[1..10] of ascii;
    asc30 = packed array[1..30] of ascii;
    listingarray = array[0..500] of ascii;

var
    i,j,k: integer;
    line, col : integer;
    ch : char;
    b: boolean;
    listing: listingarray;
    escapeI: boolean;

procedure escInit(var flg: boolean); external;
function initScreen(var l: listingarray): integer; external;	
procedure reInitScreen; external;
procedure resetScreen; external;
procedure clearScreen; external;
procedure echo(on: boolean); external;
procedure beep; external;

procedure showCursor(line,col: integer); external;
procedure outLine(line,col,start,length: integer); external;
function getChar: ascii; external;
function anyChar(var ch: ascii): boolean; external;
procedure outChar(line,col: integer; ch: ascii; bold: boolean); external;

procedure insChar(line,col: integer; ch: ascii); external;
procedure delChar(line,col: integer); external;
procedure insLine(line,num: integer); external;
procedure delLine(line,num: integer); external;
 
procedure detach; external;

  procedure put10 (where: integer; str: asc10);
  var i:integer;
  begin for i:=where to where+9 do listing[i] := str[i-where+1]; end;

  procedure put30 (where: integer; str: asc30);
  var i:integer;
  begin for i:=where to where+29 do listing[i] := str[i-where+1]; end;

begin {main prog}
detach;	{Detach since escInit doesn't do it anymore}
writeln('Hi there, here we go!');break(output);
i := initScreen(listing);
writeln('initScreen yields ',i:2); break(output);
reInitScreen;
escInit (escapeI);
echo(false);
beep;

{Now try some input}
writeln('Now we''ll try some input'); break(output);
showCursor(5,5);
repeat
  ch := getchar;
  write('["',ch,'"  (',ord(ch):-3,') ] '); break(output)
until ch = 'x';
writeln;
writeln('Now we''ll try anyChar; type one when you''re ready:');break(output);
ch := getchar;
i := 1;
while not anyChar(ch) do begin writeln(i); i:=i+1 end;
writeln('Got char; it is "',ch,'"   ord = ',ord(ch):-3);break(output);
ch := getchar;

clearscreen;
writeln('Now some more input:');break(output);
line := 10; col := 15;
showCursor(line,col);
repeat
  ch := getchar;
  b := ('A'<=ch) and (ch<='Z');		{Bold face if capital letter}
  outChar(line,col,ch,b);
  col := col + 1;
  showCursor(line,col);
until ch = 'X';

{Now try some output}
clearScreen;
outchar(3,2,'H',true); outchar(3,3,'i',true);
outchar(3,4,' ',false); outchar(3,5,'t',false); outchar(3,6,'h',false);
outchar(3,7,'e',false); outchar(3,8,'r',false); outchar(3,9,'e',false);
outchar(3,10,'!',true);
ch := getchar;
outchar(7,79,'H',false); outchar(7,80,'e',false); outchar(7,81,'r',false);
outchar(7,82,'e',false);
ch := getchar;

resetScreen;
writeln('OK, now we test out outLine'); break(output);
for i:=0 to 500 do listing[i]:='*';
put10(50,'Hi there.*');
outLine (5,10,50,9); 	ch:=getchar;
outLine (8,20,50,2);	ch:=getchar;
outLine (12,80,50,2); 	ch:=getchar;
outLine (3,76,53,5);	ch:=getchar;
put30(20,'This is a very long line to te');
put30(50,'st out how well it cuts the li');
put30(80,'nes in half when they are very');
put10(110,' long.****');
outLine (15,10,20,96); 	ch:=getchar;
outLine (20,70,28,30);	ch:=getchar;

{Now test smart tty routines}
resetscreen;
writeln('OK, now we test insertion/deletion routines');
for i:=0 to 20 do begin
  for j:=1 to 50 do listing[j] := chr(i+60B);
  outLine (i,1,1,50);
  end;
ch := getchar;
delLine(10,4); ch := getchar;
insLine (5,3); ch := getchar;
insChar (3,20,'H'); insChar(3,21,'i'); insChar(3,22,' '); ch := getchar;
for i:=1 to 5 do delchar(1,10); ch := getchar;

resetScreen;
writeln('Now we''ll look for control-C interrupts...');break(output);
escapeI := false;
i := 1;
while not escapeI do begin writeln(i); i:=i+1 end;
writeln('Got it!'); beep;
ch := getchar;

resetScreen;
writeln('That''s all for now, see you around!');break(output);
end.