{copyright Software Labs. 1983}
{$include:'b:demos.inc'}
implementation of demosunit;

{$include:'b:slib.inc'}      {Screen control routines }
{$include:'b:glib.inc'}      {Graphics       routines }
{$debug-}

const
  msgrow = 23;	msgcol = 0;
  inforow = 22; normal = 2; intensity = 15;
  blanks = '                              ';

var
  currentpage, currentmode, lastscan : integer;  lastch : char;



{***** column - print a column of numbers for labeling color table }
procedure colnum(row, col, snum, diff, count : integer);
var lastrow : integer;
begin
  lastrow := row+count;
  while row < lastrow do begin
    locate(0, row, col);
    putchar(0,normal, 1, chr(snum+ord('0')));
    snum := snum+diff;
    row := row+1;
  end;
end;  {colnum}





{***** lstringwrite - write an lstring at the specific position }
procedure lstringwrite(page, row, col, attribute : integer;const ls:lstring);
begin
  locate( page, row, col );
  putlstring(page, attribute, ls);
end;




{***** header - print the header for color tables }
procedure header;
begin
  screen( currentmode );					{ new screen }
  lstringwrite(currentpage,24,6,intensity,'(C) Copyright software Labs 1983');
  locate(currentpage, 0,32);
  writeln('mode =',currentmode:1);
  lstringwrite(currentpage,2,0,normal,'Locate a color/attribute(0..255)');
  lstringwrite(currentpage,3,0,normal,' by its row number(the first two digits)'
		);
  lstringwrite(currentpage,4,0,normal,' and its column number(the third digit)')
end; { header }



{***** demosdecimal  display all the colors in two tables indexed by decimals}
procedure demosdecimal;
const zeroto9 = '0123456789'; col = 0; startrow = 5;
var  st[static]: array [ 0 .. 1 ] of string(10);
     row, i,lastrow,sti,color  : integer;
value
  st[0] := '**Software'; st[1] := 'Labs(C)*83';

begin
  header;
  lstringwrite(currentpage,0,0,normal,'Color Table(Decimal Index)Mode');
  { the left table color 0 - 129 }
  locate(0, startrow, col+3); putlstring(0,normal,zeroto9);
  colnum(startrow+1,col,0,0,10); colnum(startrow+1,col+1,0,1,10);
  colnum(startrow+11,col,1,0,3); colnum(startrow+11,col+1,0,1,3);
  color := 0;  sti := 1;
  for row := startrow+1 to startrow+1+12 do begin
    locate(0,row,col+3);    if sti = 0 then sti := 1 else sti := 0;
    for i := 1 to 10 do begin
	putchar(0, color, 1,st[sti][i] );
	color := color+1;
    end;
  end;

  { right part for 130-256 }
  locate(0, startrow, col+18); putlstring(0,normal,zeroto9);
  colnum(startrow+1,col+15,1,0,7); colnum(startrow+1,col+16,3,1,7);
  colnum(startrow+8,col+15,2,0,6); colnum(startrow+8,col+16,0,1,6);
  sti := 1;
  for row := startrow+1 to startrow+1+12 do begin
    locate(0,row,col+18);   if sti = 0 then sti := 1 else sti := 0;
    for i := 1 to 10 do begin
       if color < 256 then
	putchar(0, color, 1,st[sti][i]);
       color := color+1;
    end;
  end;
end; {demosdecimal }





{***** demosoctal- display all the character colors by octal indexing }
procedure demosoctal;
const  startcol = 0;

  {***** octalcolor - internal procedure for display color for one table }
  procedure octalcolor(col, snum, color : integer);
  const zeroto7 = '01234567';  startrow = 5;
  var row, i, sti : integer;
      st [static] : array[0 .. 1 ] of string(8);

  value
     st[0] := 'Software'; st[1] := 'Labs*(C)';

  begin
    locate(0, startrow, col+3); putlstring(0,normal,zeroto7);
    colnum(startrow+1,col,snum,0,8); colnum(startrow+1,col+1,0,1,8);
    colnum(startrow+9,col,snum+1,0,8); colnum(startrow+9,col+1,0,1,8);
    sti := 1;
    for row := startrow+1 to startrow+1+15 do begin
      locate(0,row,col+3); if sti = 0 then sti := 1 else sti := 0;
      for i := 1 to 8 do begin
	putchar(0, color, 1,st[sti][i] );
	color := color+1;
      end;
    end;
  end; { octalcolor }



begin	{ main procedure for octal indexing color table }
  header;		{ print the header }
  lstringwrite(0,0,0,normal,'Color Table (Octal index) Mode');

  { left part 0-127 }
  octalcolor(startcol,0,0);

  { right part for 128-256 }
  octalcolor(startcol+15,2,128);
  end; {demosoctal}


{***** pressclear - press to exit }
procedure pressclear;
begin
  lstringwrite(currentpage, msgrow, msgcol, intensity,'Press any key to exit');
  while not inkey( lastch, lastscan) do ; { do nothing }
  screen( currentmode );
end;



{***** demosone -display all the character colors for the current mode }
procedure demos;
var numcolumn : integer;
begin
  currentmode := screenmode(currentpage, numcolumn);
  demosoctal;			{ color indexed by octal }
  pressclear;			{ prompt 'press any key to exit' }
  demosdecimal; 		{ color indexed by decimal }
  pressclear;
end; {demos}



{***** procedure delayawhile - delay unless a key is pressed }
{ returns true if a key is pressed }
{ returns false if no key is pressed in the delay period }
function delayawhile( delay : integer): boolean;
var
  count, i, x : integer;
begin
    delayawhile := false;
    count := 0;
    while not inkey( lastch, lastscan) do { delay unless a key is pressed}
      if count >= delay then return	  { no key is pressed }
      else begin
	for i := 1 to delay do	x := 1; { delay }
	count := count +1;
      end;
    delayawhile := true;
end; { delayawhile }




{***** demosall - demo all the color text table }
procedure demosall;
var
  numcolumn,  savemode : integer;

  {**** modecolor- demostrate all the color table for all the mode }
  procedure modecolor( startmode, endmode : integer);
  var  mode, color, palettenum : integer;
  begin
    for mode :=startmode to endmode do begin {for all the screen modes}
      currentmode := mode;
      demosoctal;				    { color indexed by octal }
      lstringwrite(currentpage,msgrow,msgcol,intensity,
	 'Press any key to enter the Driver mode');
      if currentmode = 1 then
      begin		{25x40 color text mode. display all the boarder color}
	for color := 0 to 31 do begin
	  boarder( color );
	  locate(currentpage, inforow, 0);
	  write('boarder(',color:3,' ) displaying boarder color');
	  if delayawhile(delay) then return;	   { true if a key is pressed}
	end;
	lstringwrite(currentpage, inforow, 0, normal , blanks); {erase message}
      end { currentmode = 1 }
      else
       if currentmode = 4 then	{ 320x200 graphics mode. display all palettes }
       begin
	 for palettenum := 0 to 1 do
	   for color := 0 to 15 do begin
	     palette( palettenum, color);      { palette and background color}
	     locate(currentpage, inforow, 0);
	     write('palette(',palettenum:3,',',color:3,' ) displaying');
	     if delayawhile(delay) then return;
	   end;
	lstringwrite(currentpage, inforow, 0, normal , blanks); {erase message}
	end   { currentmode = 4 }
       else
	 if delayawhile(delay) then return;
      demosdecimal;		    { color indexed by decimal }
      lstringwrite(currentpage,msgrow,msgcol,intensity,
	 'Press any key to enter the Driver mode');
      if delayawhile(delay) then return;
    end; { for }
  end; { procedure modecolor }


begin  { demosall }
  { display color tables for all the modes }
  currentmode := screenmode(currentpage, numcolumn);
  savemode := currentmode;
  if currentmode = 7
  then
    modecolor( 7, 7 )	{ mode 7 to mode 7 }
  else
    modecolor(0, 6);	{ mode 0 to 6 }
  screen( savemode);	{restore screen mode }
  currentmode := screenmode( currentpage, numcolumn);
 end; { demosall }

begin
end.